git.iko.soy/elk
on 19293da help sign in
elk/src/AST/Variable.hs
270 lines 5.4 kB history raw
1module AST.Variable where
3import Control.Applicative ((<$>), (<*>))
4import Data.Binary
5import qualified Data.List as List
6import qualified Data.Maybe as Maybe
7import Text.PrettyPrint as P
8import qualified AST.Helpers as Help
9import AST.PrettyPrint
12-- VARIABLES
14newtype Raw = Raw String
15 deriving (Eq,Ord,Show)
18data Home
19 = BuiltIn
20 | Module [String]
21 | Local
22 deriving (Eq,Ord,Show)
25data Canonical = Canonical
26 { home :: !Home
27 , name :: !String
28 }
29 deriving (Eq,Ord,Show)
32local :: String -> Canonical
33local x = Canonical Local x
36builtin :: String -> Canonical
37builtin x = Canonical BuiltIn x
40fromModule :: [String] -> String -> Canonical
41fromModule home name =
42 Canonical (Module home) name
45toEffectName :: Int -> String
46toEffectName lineNumber =
47 "$perform$" ++ show lineNumber
50fromEffectName :: String -> Maybe String
51fromEffectName name =
52 case List.splitAt 9 name of
53 ("$perform$", number) -> Just number
54 _ -> Nothing
57-- VARIABLE RECOGNIZERS
59is :: [String] -> String -> Canonical -> Bool
60is home name var =
61 var == Canonical (Module home) name
64isJson :: Canonical -> Bool
65isJson =
66 is ["Json", "Encode"] "Value"
69isMaybe :: Canonical -> Bool
70isMaybe =
71 is ["Maybe"] "Maybe"
73isArray :: Canonical -> Bool
74isArray =
75 is ["Array"] "Array"
78isTask :: Canonical -> Bool
79isTask =
80 is ["Task"] "Task"
83isList :: Canonical -> Bool
84isList v =
85 v == Canonical BuiltIn "List"
88isTuple :: Canonical -> Bool
89isTuple v =
90 case v of
91 Canonical BuiltIn name -> Help.isTuple name
92 _ -> False
95isPrimitive :: Canonical -> Bool
96isPrimitive v =
97 case v of
98 Canonical BuiltIn name -> name `elem` ["Int","Float","String","Bool"]
99 _ -> False
102isPrim :: String -> Canonical -> Bool
103isPrim prim v =
104 case v of
105 Canonical BuiltIn name -> name == prim
106 _ -> False
109isText :: Canonical -> Bool
110isText =
111 is ["Text"] "Text"
114-- VARIABLE TO STRING
116class ToString a where
117 toString :: a -> String
120instance ToString Raw where
121 toString (Raw name) =
122 name
125instance ToString Canonical where
126 toString (Canonical home name) =
127 case home of
128 BuiltIn -> name
129 Module path -> List.intercalate "." (path ++ [name])
130 Local -> name
133-- LISTINGS
135-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
136data Listing a = Listing
137 { _explicits :: [a]
138 , _open :: Bool
139 } deriving (Eq,Ord,Show)
142openListing :: Listing a
143openListing =
144 Listing [] True
147closedListing :: Listing a
148closedListing =
149 Listing [] False
152listing :: [a] -> Listing a
153listing xs =
154 Listing xs False
157-- | A value that can be imported or exported
158data Value
159 = Value !String
160 | Alias !String
161 | Union !String !(Listing String)
162 deriving (Eq,Ord,Show)
165-- CATEGORIZING VALUES
167getValues :: [Value] -> [String]
168getValues values =
169 Maybe.mapMaybe getValue values
172getValue :: Value -> Maybe String
173getValue value =
174 case value of
175 Value name -> Just name
176 Alias _ -> Nothing
177 Union _ _ -> Nothing
180getAliases :: [Value] -> [String]
181getAliases values =
182 Maybe.mapMaybe getAlias values
185getAlias :: Value -> Maybe String
186getAlias value =
187 case value of
188 Value _-> Nothing
189 Alias name -> Just name
190 Union _ _ -> Nothing
193getUnions :: [Value] -> [(String, Listing String)]
194getUnions values =
195 Maybe.mapMaybe getUnion values
198getUnion :: Value -> Maybe (String, Listing String)
199getUnion value =
200 case value of
201 Value _ -> Nothing
202 Alias _ -> Nothing
203 Union name ctors -> Just (name, ctors)
206-- PRETTY VARIABLES
208instance Pretty Raw where
209 pretty (Raw name) =
210 variable name
213instance Pretty Canonical where
214 pretty var =
215 P.text (toString var)
218instance Pretty a => Pretty (Listing a) where
219 pretty (Listing explicits open) =
220 P.parens (commaCat (map pretty explicits ++ dots))
221 where
222 dots = [if open then P.text ".." else P.empty]
225instance Pretty Value where
226 pretty portable =
227 case portable of
228 Value name -> P.text name
229 Alias name -> P.text name
230 Union name ctors ->
231 P.text name <> pretty (ctors { _explicits = map P.text (_explicits ctors) })
234-- BINARY SERIALIZATION
236instance Binary Canonical where
237 put (Canonical home name) =
238 case home of
239 BuiltIn -> putWord8 0 >> put name
240 Module path -> putWord8 1 >> put path >> put name
241 Local -> putWord8 2 >> put name
243 get = do tag <- getWord8
244 case tag of
245 0 -> Canonical BuiltIn <$> get
246 1 -> Canonical . Module <$> get <*> get
247 2 -> Canonical Local <$> get
248 _ -> error "Unexpected tag when deserializing canonical variable"
251instance Binary Value where
252 put portable =
253 case portable of
254 Value name -> putWord8 0 >> put name
255 Alias name -> putWord8 1 >> put name
256 Union name ctors -> putWord8 2 >> put name >> put ctors
258 get = do tag <- getWord8
259 case tag of
260 0 -> Value <$> get
261 1 -> Alias <$> get
262 2 -> Union <$> get <*> get
263 _ -> error "Error reading valid import/export information from serialized string"
266instance (Binary a) => Binary (Listing a) where
267 put (Listing explicits open) =
268 put explicits >> put open
270 get = Listing <$> get <*> get