git.iko.soy/elk
on 21ccfbc help sign in
elk/src/AST/Variable.hs
275 lines 5.5 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
64isJavaScript :: Canonical -> Bool
65isJavaScript =
66 is ["JavaScript", "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"
83isStream :: Canonical -> Bool
84isStream =
85 is ["SignalTypes"] "Stream"
88isList :: Canonical -> Bool
89isList v =
90 v == Canonical BuiltIn "List"
93isTuple :: Canonical -> Bool
94isTuple v =
95 case v of
96 Canonical BuiltIn name -> Help.isTuple name
97 _ -> False
100isPrimitive :: Canonical -> Bool
101isPrimitive v =
102 case v of
103 Canonical BuiltIn name -> name `elem` ["Int","Float","String","Bool"]
104 _ -> False
107isPrim :: String -> Canonical -> Bool
108isPrim prim v =
109 case v of
110 Canonical BuiltIn name -> name == prim
111 _ -> False
114isText :: Canonical -> Bool
115isText =
116 is ["Text"] "Text"
119-- VARIABLE TO STRING
121class ToString a where
122 toString :: a -> String
125instance ToString Raw where
126 toString (Raw name) =
127 name
130instance ToString Canonical where
131 toString (Canonical home name) =
132 case home of
133 BuiltIn -> name
134 Module path -> List.intercalate "." (path ++ [name])
135 Local -> name
138-- LISTINGS
140-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
141data Listing a = Listing
142 { _explicits :: [a]
143 , _open :: Bool
144 } deriving (Eq,Ord,Show)
147openListing :: Listing a
148openListing =
149 Listing [] True
152closedListing :: Listing a
153closedListing =
154 Listing [] False
157listing :: [a] -> Listing a
158listing xs =
159 Listing xs False
162-- | A value that can be imported or exported
163data Value
164 = Value !String
165 | Alias !String
166 | Union !String !(Listing String)
167 deriving (Eq,Ord,Show)
170-- CATEGORIZING VALUES
172getValues :: [Value] -> [String]
173getValues values =
174 Maybe.mapMaybe getValue values
177getValue :: Value -> Maybe String
178getValue value =
179 case value of
180 Value name -> Just name
181 Alias _ -> Nothing
182 Union _ _ -> Nothing
185getAliases :: [Value] -> [String]
186getAliases values =
187 Maybe.mapMaybe getAlias values
190getAlias :: Value -> Maybe String
191getAlias value =
192 case value of
193 Value _-> Nothing
194 Alias name -> Just name
195 Union _ _ -> Nothing
198getUnions :: [Value] -> [(String, Listing String)]
199getUnions values =
200 Maybe.mapMaybe getUnion values
203getUnion :: Value -> Maybe (String, Listing String)
204getUnion value =
205 case value of
206 Value _ -> Nothing
207 Alias _ -> Nothing
208 Union name ctors -> Just (name, ctors)
211-- PRETTY VARIABLES
213instance Pretty Raw where
214 pretty (Raw name) =
215 variable name
218instance Pretty Canonical where
219 pretty var =
220 P.text (toString var)
223instance Pretty a => Pretty (Listing a) where
224 pretty (Listing explicits open) =
225 P.parens (commaCat (map pretty explicits ++ dots))
226 where
227 dots = [if open then P.text ".." else P.empty]
230instance Pretty Value where
231 pretty portable =
232 case portable of
233 Value name -> P.text name
234 Alias name -> P.text name
235 Union name ctors ->
236 P.text name <> pretty (ctors { _explicits = map P.text (_explicits ctors) })
239-- BINARY SERIALIZATION
241instance Binary Canonical where
242 put (Canonical home name) =
243 case home of
244 BuiltIn -> putWord8 0 >> put name
245 Module path -> putWord8 1 >> put path >> put name
246 Local -> putWord8 2 >> put name
248 get = do tag <- getWord8
249 case tag of
250 0 -> Canonical BuiltIn <$> get
251 1 -> Canonical . Module <$> get <*> get
252 2 -> Canonical Local <$> get
253 _ -> error "Unexpected tag when deserializing canonical variable"
256instance Binary Value where
257 put portable =
258 case portable of
259 Value name -> putWord8 0 >> put name
260 Alias name -> putWord8 1 >> put name
261 Union name ctors -> putWord8 2 >> put name >> put ctors
263 get = do tag <- getWord8
264 case tag of
265 0 -> Value <$> get
266 1 -> Alias <$> get
267 2 -> Union <$> get <*> get
268 _ -> error "Error reading valid import/export information from serialized string"
271instance (Binary a) => Binary (Listing a) where
272 put (Listing explicits open) =
273 put explicits >> put open
275 get = Listing <$> get <*> get