@@ -1,5 +1,5 @@
11{-# OPTIONS_GHC -Wall #-}
2−module AST.Expression.Optimized
2+module AST.Optimized
33 ( Decl(..)
44 , Def(..)
55 , Expr(..)
@@ -14,7 +14,6 @@ import Data.Binary
1414import qualified Data.Set as Set
1515import Data.Text (Text)
1616
17−import qualified AST.Effects as Effects
1817import qualified AST.Literal as Literal
1918import qualified AST.Module.Name as ModuleName
2019import qualified AST.Variable as Var
@@ -23,16 +22,31 @@ import qualified Reporting.Region as R
2322
2423
2524
26−-- TOP LEVEL DECLARATIONS
25+-- EXPRESSIONS
2726
2827
29−data Decl =
30− Decl
31− { _direct :: Set.Set Var.Global
32− , _indirect :: Set.Set Var.Global
33− , _effects :: Maybe Effects.ManagerType
34− , _body :: !Def
35− }
28+data 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)
3650
3751
3852
@@ -45,90 +59,86 @@ data Def
4559
4660
4761
48−-- EXPRESSIONS
49−
50−
51−data Expr
52− = Literal Literal.Literal
53− | VarLocal Text
54− | VarGlobal Var.Global
55− | List [Expr]
56− | Binop Var.Global Expr Expr
57− | Function [Text] Expr
58− | Call Expr [Expr]
59− | TailCall Text [Text] [Expr]
60− | If [(Expr, Expr)] Expr
61− | Let [(Text, Def)] Expr
62− | Case Text (Decider Choice) [(Int, Expr)]
63− | Ctor Text [Expr]
64− | CtorAccess Expr Int
65− | Access Expr Text
66− | Update Expr [(Text, Expr)]
67− | Record [(Text, Expr)]
68− | Cmd ModuleName.Canonical Effects.ManagerType
69− | Sub ModuleName.Canonical Effects.ManagerType
70− | OutgoingPort Text Expr
71− | IncomingPort Text Expr
72− | Program Main Expr
73− | GLShader Text
74− | Crash ModuleName.Canonical R.Region (Maybe Expr)
75−
76−
77−data Main
78− = Static
79− | Dynamic Expr
62+-- BRANCHING
8063
8164
8265data Decider a
83− = Leaf a
84− | Chain
85− { _testChain :: [(DT.Path, DT.Test)]
86− , _success :: Decider a
87− , _failure :: Decider a
88− }
89− | FanOut
90− { _path :: DT.Path
91− , _tests :: [(DT.Test, Decider a)]
92− , _fallback :: Decider a
93− }
94− deriving (Eq)
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)
9578
9679
9780data Choice
98− = Inline Expr
99− | Jump Int
81+ = Inline Expr
82+ | Jump Int
10083
10184
10285
103−-- BINARY
86+-- OBJECT GRAPH
10487
10588
106−instance Binary Decl where
107− get =
108− liftM4 Decl get get get get
89+data Graph =
90+ Graph
91+ { _nodes :: Map.Map Var.Global Node
92+ }
10993
110− put (Decl direct indirect fx body) =
111− put direct >> put indirect >> put fx >> put body
11294
11395
114−instance Binary Def where
115− get =
116− do word <- getWord8
117− case word of
118− 0 -> Def <$> get
119− 1 -> TailDef <$> get <*> get
120− _ -> error "problem getting Opt.Def binary"
96+data 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+ }
111+
121112
122− put def =
123− case def of
124− Def body ->
125− putWord8 0 >> put body
126113
127− TailDef args body ->
128− putWord8 1 >> put args >> put body
114+-- BINARY
129115
130116
131117instance 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
141+
132142 get =
133143 do word <- getWord8
134144 case word of
@@ -145,43 +155,37 @@ instance Binary Expr where
145155 10 -> liftM3 Case get get get
146156 11 -> liftM2 Ctor get get
147157 12 -> liftM2 CtorAccess get get
148− 13 -> liftM2 Access get get
149− 14 -> liftM2 Update get get
150− 15 -> liftM Record get
151− 16 -> liftM2 Cmd get get
152− 17 -> liftM2 Sub get get
153− 18 -> liftM2 OutgoingPort get get
154− 19 -> liftM2 IncomingPort get get
155− 20 -> liftM2 Program get get
156− 21 -> liftM GLShader get
157− 22 -> liftM3 Crash get 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
158166 _ -> error "problem getting Opt.Expr binary"
159167
160− put expr =
161− case expr of
162− Literal a -> putWord8 0 >> put a
163− VarLocal a -> putWord8 1 >> put a
164− VarGlobal a -> putWord8 2 >> put a
165− List a -> putWord8 3 >> put a
166− Binop a b c -> putWord8 4 >> put a >> put b >> put c
167− Function a b -> putWord8 5 >> put a >> put b
168− Call a b -> putWord8 6 >> put a >> put b
169− TailCall a b c -> putWord8 7 >> put a >> put b >> put c
170− If a b -> putWord8 8 >> put a >> put b
171− Let a b -> putWord8 9 >> put a >> put b
172− Case a b c -> putWord8 10 >> put a >> put b >> put c
173− Ctor a b -> putWord8 11 >> put a >> put b
174− CtorAccess a b -> putWord8 12 >> put a >> put b
175− Access a b -> putWord8 13 >> put a >> put b
176− Update a b -> putWord8 14 >> put a >> put b
177− Record a -> putWord8 15 >> put a
178− Cmd a b -> putWord8 16 >> put a >> put b
179− Sub a b -> putWord8 17 >> put a >> put b
180− OutgoingPort a b -> putWord8 18 >> put a >> put b
181− IncomingPort a b -> putWord8 19 >> put a >> put b
182− Program a b -> putWord8 20 >> put a >> put b
183− GLShader a -> putWord8 21 >> put a
184− Crash a b c -> putWord8 22 >> put a >> put b >> put c
168+
169+instance Binary Decl where
170+ put (Decl a b c d) =
171+ put a >> put b >> put c >> put d
172+
173+ get =
174+ liftM4 Decl get get get get
175+
176+
177+instance 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
182+
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"
185189
186190
187191instance Binary Main where
@@ -199,6 +203,12 @@ instance Binary Main where
199203
200204
201205instance (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
211+
202212 get =
203213 do word <- getWord8
204214 case word of
@@ -207,30 +217,12 @@ instance (Binary a) => Binary (Decider a) where
207217 2 -> liftM3 FanOut get get get
208218 _ -> error "problem getting Opt.Decider binary"
209219
210− put decider =
211− case decider of
212− Leaf a ->
213− do putWord8 0
214− put a
215−
216− Chain testChain success failure ->
217− do putWord8 1
218− put testChain
219− put success
220− put failure
221−
222− FanOut path tests fallback ->
223− do putWord8 2
224− put path
225− put tests
226− put fallback
227−
228220
229221instance Binary Choice where
230222 put choice =
231223 case choice of
232224 Inline expr -> putWord8 0 >> put expr
233− Jump index -> putWord8 1 >> put index
225+ Jump index -> putWord8 1 >> put index
234226
235227 get =
236228 do word <- getWord8
@@ -238,4 +230,3 @@ instance Binary Choice where
238230 0 -> liftM Inline get
239231 1 -> liftM Jump get
240232 _ -> error "problem getting Opt.Choice binary"
241−