git.iko.soy/elk
on 0ff8a91 help sign in
elk/src/AST/Variable.hs
329 lines 5.6 kB history raw
1module AST.Variable where
3import Data.Binary
4import qualified Data.Maybe as Maybe
6import qualified AST.Helpers as Help
7import qualified AST.Module.Name as ModuleName
11-- RAW NAMES
14newtype Raw = Raw String
15 deriving (Eq, Ord)
19-- TOP LEVEL NAMES
22data TopLevel = TopLevelVar
23 { topHome :: ModuleName.Canonical
24 , topName :: String
25 }
26 deriving (Eq, Ord)
30-- CANONICAL NAMES
33data Home
34 = BuiltIn
35 | Module ModuleName.Canonical
36 | TopLevel ModuleName.Canonical
37 | Local
38 deriving (Eq, Ord)
41data Canonical = Canonical
42 { home :: !Home
43 , name :: !String
44 }
45 deriving (Eq, Ord)
48local :: String -> Canonical
49local x =
50 Canonical Local x
53topLevel :: ModuleName.Canonical -> String -> Canonical
54topLevel home x =
55 Canonical (TopLevel home) x
58builtin :: String -> Canonical
59builtin x =
60 Canonical BuiltIn x
63fromModule :: ModuleName.Canonical -> String -> Canonical
64fromModule home name =
65 Canonical (Module home) name
68inCore :: ModuleName.Raw -> String -> Canonical
69inCore home name =
70 Canonical (Module (ModuleName.inCore home)) name
73cmd :: Canonical
74cmd =
75 inCore ["Platform","Cmd"] "Cmd"
78sub :: Canonical
79sub =
80 inCore ["Platform","Sub"] "Sub"
84-- VARIABLE RECOGNIZERS
87isLocalHome :: Home -> Bool
88isLocalHome home =
89 case home of
90 BuiltIn ->
91 False
93 Module _ ->
94 False
96 TopLevel _ ->
97 True
99 Local ->
100 True
103is :: ModuleName.Raw -> String -> Canonical -> Bool
104is home name var =
105 var == inCore home name
108isJson :: Canonical -> Bool
109isJson =
110 is ["Json", "Encode"] "Value"
113isMaybe :: Canonical -> Bool
114isMaybe =
115 is ["Maybe"] "Maybe"
117isArray :: Canonical -> Bool
118isArray =
119 is ["Array"] "Array"
122isTask :: Canonical -> Bool
123isTask =
124 is ["Task"] "Task"
127isList :: Canonical -> Bool
128isList v =
129 v == Canonical BuiltIn "List"
132isTuple :: Canonical -> Bool
133isTuple v =
134 case v of
135 Canonical BuiltIn name -> Help.isTuple name
136 _ -> False
139isPrimitive :: Canonical -> Bool
140isPrimitive v =
141 case v of
142 Canonical BuiltIn name ->
143 name `elem` ["Int","Float","String","Bool"]
144 _ ->
145 False
148isPrim :: String -> Canonical -> Bool
149isPrim prim (Canonical home name) =
150 case home of
151 BuiltIn ->
152 name == prim
154 _ ->
155 False
158isLocal :: (String -> Bool) -> Canonical -> Bool
159isLocal check (Canonical home name) =
160 case home of
161 Local ->
162 check name
164 _ ->
165 False
169-- VARIABLE TO STRING
172class ToString a where
173 toString :: a -> String
176instance ToString Raw where
177 toString (Raw name) =
178 name
181instance ToString Canonical where
182 toString (Canonical home name) =
183 case home of
184 BuiltIn ->
185 name
187 Module moduleName ->
188 ModuleName.canonicalToString moduleName ++ "." ++ name
190 TopLevel _ ->
191 name
193 Local ->
194 name
198-- LISTINGS
201-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
202data Listing a = Listing
203 { _explicits :: [a]
204 , _open :: Bool
205 }
206 deriving (Eq, Ord)
209openListing :: Listing a
210openListing =
211 Listing [] True
214closedListing :: Listing a
215closedListing =
216 Listing [] False
219listing :: [a] -> Listing a
220listing xs =
221 Listing xs False
224-- | A value that can be imported or exported
225data Value
226 = Value !String
227 | Alias !String
228 | Union !String !(Listing String)
229 deriving (Eq, Ord)
233-- CATEGORIZING VALUES
236getValues :: [Value] -> [String]
237getValues values =
238 Maybe.mapMaybe getValue values
241getValue :: Value -> Maybe String
242getValue value =
243 case value of
244 Value name -> Just name
245 Alias _ -> Nothing
246 Union _ _ -> Nothing
249getAliases :: [Value] -> [String]
250getAliases values =
251 Maybe.mapMaybe getAlias values
254getAlias :: Value -> Maybe String
255getAlias value =
256 case value of
257 Value _-> Nothing
258 Alias name -> Just name
259 Union _ _ -> Nothing
262getUnions :: [Value] -> [(String, Listing String)]
263getUnions values =
264 Maybe.mapMaybe getUnion values
267getUnion :: Value -> Maybe (String, Listing String)
268getUnion value =
269 case value of
270 Value _ -> Nothing
271 Alias _ -> Nothing
272 Union name ctors -> Just (name, ctors)
276-- BINARY SERIALIZATION
279instance Binary Canonical where
280 put (Canonical home name) =
281 case home of
282 BuiltIn ->
283 putWord8 0 >> put name
285 Module path ->
286 putWord8 1 >> put path >> put name
288 TopLevel path ->
289 putWord8 2 >> put path >> put name
291 Local ->
292 putWord8 3 >> put name
294 get =
295 do tag <- getWord8
296 case tag of
297 0 -> Canonical BuiltIn <$> get
298 1 -> Canonical . Module <$> get <*> get
299 2 -> Canonical . TopLevel <$> get <*> get
300 3 -> Canonical Local <$> get
301 _ -> error "Unexpected tag when deserializing canonical variable"
304instance Binary Value where
305 put portable =
306 case portable of
307 Value name ->
308 putWord8 0 >> put name
310 Alias name ->
311 putWord8 1 >> put name
313 Union name ctors ->
314 putWord8 2 >> put name >> put ctors
316 get =
317 do tag <- getWord8
318 case tag of
319 0 -> Value <$> get
320 1 -> Alias <$> get
321 2 -> Union <$> get <*> get
322 _ -> error "Error reading valid import/export information from serialized string"
325instance (Binary a) => Binary (Listing a) where
326 put (Listing explicits open) =
327 put explicits >> put open
329 get = Listing <$> get <*> get