git.iko.soy/elk
on ea77dcf help sign in
elk/src/AST/Optimized.hs
232 lines 5.5 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module AST.Optimized
3 ( Decl(..)
4 , Def(..)
5 , Expr(..)
6 , Main(..)
7 , Decider(..), Choice(..)
8 )
9 where
12import Control.Monad (liftM, liftM2, liftM3, liftM4)
13import Data.Binary
14import qualified Data.Set as Set
15import Data.Text (Text)
17import qualified AST.Literal as Literal
18import qualified AST.Module.Name as ModuleName
19import qualified AST.Variable as Var
20import qualified Optimize.DecisionTree as DT
21import qualified Reporting.Region as R
25-- EXPRESSIONS
28data Expr
29 = Literal Literal.Literal
30 | VarLocal Text
31 | VarGlobal Var.Global
32 | List [Expr]
33 | Binop Var.Global Expr Expr
34 | Function [Text] Expr
35 | Call Expr [Expr]
36 | TailCall Text [Text] [Expr]
37 | If [(Expr, Expr)] Expr
38 | Let [(Text, Def)] Expr
39 | Case Text (Decider Choice) [(Int, Expr)]
40 | Ctor Text [Expr]
41 | CtorAccess Expr Int
42 | Accessor Text
43 | Access Expr Text
44 | Update Expr [(Text, Expr)]
45 | Record [(Text, Expr)]
46 | Unit
47 | Tuple Expr Expr [Expr]
48 | GLShader Text
49 | Crash ModuleName.Canonical R.Region (Maybe Expr)
53-- DEFINITIONS
56data Def
57 = Def Expr
58 | TailDef [Text] Expr
62-- BRANCHING
65data Decider a
66 = Leaf a
67 | Chain
68 { _testChain :: [(DT.Path, DT.Test)]
69 , _success :: Decider a
70 , _failure :: Decider a
71 }
72 | FanOut
73 { _path :: DT.Path
74 , _tests :: [(DT.Test, Decider a)]
75 , _fallback :: Decider a
76 }
77 deriving (Eq)
80data Choice
81 = Inline Expr
82 | Jump Int
86-- OBJECT GRAPH
89data Graph =
90 Graph
91 { _nodes :: Map.Map Var.Global Node
92 }
96data Node
97 = Acyclic
98 { _deps :: [Var.Global]
99 , _body :: Expr
100 }
101 | TailCall
102 { _deps :: [Var.Global]
103 , _args :: [Text]
104 , _body :: Expr
105 }
106 | Cyclic Var.Global
107 | Cycle
108 { _deps :: [Var.Global]
109 , _values :: [(Var.Global, Expr)]
110 }
114-- BINARY
117instance Binary Expr where
118 put expr =
119 case expr of
120 Literal a -> putWord8 0 >> put a
121 VarLocal a -> putWord8 1 >> put a
122 VarGlobal a -> putWord8 2 >> put a
123 List a -> putWord8 3 >> put a
124 Binop a b c -> putWord8 4 >> put a >> put b >> put c
125 Function a b -> putWord8 5 >> put a >> put b
126 Call a b -> putWord8 6 >> put a >> put b
127 TailCall a b c -> putWord8 7 >> put a >> put b >> put c
128 If a b -> putWord8 8 >> put a >> put b
129 Let a b -> putWord8 9 >> put a >> put b
130 Case a b c -> putWord8 10 >> put a >> put b >> put c
131 Ctor a b -> putWord8 11 >> put a >> put b
132 CtorAccess a b -> putWord8 12 >> put a >> put b
133 Accessor a -> putWord8 13 >> put a
134 Access a b -> putWord8 14 >> put a >> put b
135 Update a b -> putWord8 15 >> put a >> put b
136 Record a -> putWord8 16 >> put a
137 Unit -> putWord8 17
138 Tuple a b c -> putWord8 18 >> put a >> put b >> put c
139 GLShader a -> putWord8 19 >> put a
140 Crash a b c -> putWord8 20 >> put a >> put b >> put c
142 get =
143 do word <- getWord8
144 case word of
145 0 -> liftM Literal get
146 1 -> liftM VarLocal get
147 2 -> liftM VarGlobal get
148 3 -> liftM List get
149 4 -> liftM3 Binop get get get
150 5 -> liftM2 Function get get
151 6 -> liftM2 Call get get
152 7 -> liftM3 TailCall get get get
153 8 -> liftM2 If get get
154 9 -> liftM2 Let get get
155 10 -> liftM3 Case get get get
156 11 -> liftM2 Ctor get get
157 12 -> liftM2 CtorAccess get get
158 13 -> liftM Accessor get
159 14 -> liftM2 Access get get
160 15 -> liftM2 Update get get
161 16 -> liftM Record get
162 17 -> pure Unit
163 18 -> liftM3 Tuple get get get
164 19 -> liftM GLShader get
165 20 -> liftM3 Crash get get get
166 _ -> error "problem getting Opt.Expr binary"
169instance Binary Decl where
170 put (Decl a b c d) =
171 put a >> put b >> put c >> put d
173 get =
174 liftM4 Decl get get get get
177instance Binary Def where
178 put def =
179 case def of
180 Def body -> putWord8 0 >> put body
181 TailDef args body -> putWord8 1 >> put args >> put body
183 get =
184 do word <- getWord8
185 case word of
186 0 -> Def <$> get
187 1 -> TailDef <$> get <*> get
188 _ -> error "problem getting Opt.Def binary"
191instance Binary Main where
192 put main =
193 case main of
194 Static -> putWord8 0
195 Dynamic expr -> putWord8 1 >> put expr
197 get =
198 do word <- getWord8
199 case word of
200 0 -> pure Static
201 1 -> liftM Dynamic get
202 _ -> error "problem getting Opt.Main binary"
205instance (Binary a) => Binary (Decider a) where
206 put decider =
207 case decider of
208 Leaf a -> putWord8 0 >> put a
209 Chain a b c -> putWord8 1 >> put a >> put b >> put c
210 FanOut a b c -> putWord8 2 >> put a >> put b >> put c
212 get =
213 do word <- getWord8
214 case word of
215 0 -> liftM Leaf get
216 1 -> liftM3 Chain get get get
217 2 -> liftM3 FanOut get get get
218 _ -> error "problem getting Opt.Decider binary"
221instance Binary Choice where
222 put choice =
223 case choice of
224 Inline expr -> putWord8 0 >> put expr
225 Jump index -> putWord8 1 >> put index
227 get =
228 do word <- getWord8
229 case word of
230 0 -> liftM Inline get
231 1 -> liftM Jump get
232 _ -> error "problem getting Opt.Choice binary"