git.iko.soy/elk
on 577fc17 help sign in
elk/compiler/AST/Variable.hs
152 lines 3.9 kB history raw
1{-# OPTIONS_GHC -W #-}
2module AST.Variable where
4import Data.Binary
5import Control.Applicative ((<$>), (<*>))
6import Text.PrettyPrint as P
7import qualified AST.Helpers as Help
8import AST.PrettyPrint
10newtype Raw = Raw String
11 deriving (Eq,Ord,Show)
13data Home
14 = BuiltIn
15 | Module !String
16 | Local
17 deriving (Eq,Ord,Show)
19data Canonical = Canonical
20 { home :: !Home
21 , name :: !String
22 } deriving (Eq,Ord,Show)
24local :: String -> Canonical
25local x = Canonical Local x
27builtin :: String -> Canonical
28builtin x = Canonical BuiltIn x
30-- To help with pattern matching on some common canonical variables:
31is :: String -> String -> Canonical -> Bool
32is home name var =
33 var == Canonical (Module home) name
35isJson :: Canonical -> Bool
36isJson = is "Json" "Value"
38isMaybe :: Canonical -> Bool
39isMaybe = is "Maybe" "Maybe"
41isArray :: Canonical -> Bool
42isArray = is "Array" "Array"
44isSignal :: Canonical -> Bool
45isSignal = is "Signal" "Signal"
47isList :: Canonical -> Bool
48isList v = v == Canonical BuiltIn "_List"
50isTuple :: Canonical -> Bool
51isTuple v =
52 case v of
53 Canonical BuiltIn name -> Help.isTuple name
54 _ -> False
56isPrimitive :: Canonical -> Bool
57isPrimitive v =
58 case v of
59 Canonical BuiltIn name -> name `elem` ["Int","Float","String","Bool"]
60 _ -> False
62isPrim :: String -> Canonical -> Bool
63isPrim prim v =
64 case v of
65 Canonical BuiltIn name -> name == prim
66 _ -> False
68isText :: Canonical -> Bool
69isText = is "Text" "Text"
71class ToString a where
72 toString :: a -> String
74instance ToString Raw where
75 toString (Raw x) = x
77instance ToString Canonical where
78 toString (Canonical home name) =
79 case home of
80 BuiltIn -> name
81 Module path -> path ++ "." ++ name
82 Local -> name
84-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
85data Listing a = Listing
86 { _explicits :: [a]
87 , _open :: Bool
88 } deriving (Eq,Ord,Show)
90openListing :: Listing a
91openListing = Listing [] True
93-- | A value that can be imported or exported
94data Value
95 = Value !String
96 | Alias !String
97 | ADT !String !(Listing String)
98 deriving (Eq,Ord,Show)
100instance Pretty Raw where
101 pretty (Raw var) = variable var
103instance Pretty Canonical where
104 pretty var = P.text (toString var)
106instance Pretty a => Pretty (Listing a) where
107 pretty (Listing explicits open) =
108 P.parens (commaCat (map pretty explicits ++ dots))
109 where
110 dots = [if open then P.text ".." else P.empty]
112instance Pretty Value where
113 pretty portable =
114 case portable of
115 Value name -> P.text name
116 Alias name -> P.text name
117 ADT name ctors ->
118 P.text name <> pretty (ctors { _explicits = map P.text (_explicits ctors) })
120instance Binary Canonical where
121 put (Canonical home name) =
122 case home of
123 BuiltIn -> putWord8 0 >> put name
124 Module path -> putWord8 1 >> put path >> put name
125 Local -> putWord8 2 >> put name
127 get = do tag <- getWord8
128 case tag of
129 0 -> Canonical BuiltIn <$> get
130 1 -> Canonical . Module <$> get <*> get
131 2 -> Canonical Local <$> get
132 _ -> error "Unexpected tag when deserializing canonical variable"
134instance Binary Value where
135 put portable =
136 case portable of
137 Value name -> putWord8 0 >> put name
138 Alias name -> putWord8 1 >> put name
139 ADT name ctors -> putWord8 2 >> put name >> put ctors
141 get = do tag <- getWord8
142 case tag of
143 0 -> Value <$> get
144 1 -> Alias <$> get
145 2 -> ADT <$> get <*> get
146 _ -> error "Error reading valid import/export information from serialized string"
148instance (Binary a) => Binary (Listing a) where
149 put (Listing explicits open) =
150 put explicits >> put open
152 get = Listing <$> get <*> get