@@ -8,6 +8,7 @@ module AST.Expression.Optimized
88 where
99
1010
11+import Data.Binary
1112import qualified Data.Set as Set
1213import Data.Text (Text)
1314
@@ -90,3 +91,131 @@ data Decider a
9091data Choice
9192 = Inline Expr
9293 | Jump Int
94+
95+
96+
97+-- BINARY
98+
99+
100+instance Binary Decl where
101+ get =
102+ Decl <$> get <*> get <*> get
103+
104+ put (Decl deps fx body) =
105+ put deps >> put fx >> put body
106+
107+
108+instance Binary Def where
109+ get =
110+ do word <- getWord8
111+ case word of
112+ 0 -> Def <$> get
113+ 1 -> TailDef <$> get <*> get
114+ _ -> error "problem getting Opt.Def binary"
115+
116+ put def =
117+ case def of
118+ Def body ->
119+ putWord8 0 >> put body
120+
121+ TailDef args body ->
122+ putWord8 1 >> put args >> put body
123+
124+
125+instance Binary Expr where
126+ get =
127+ do word <- getWord8
128+ case word of
129+ 0 -> Literal <$> get
130+ 1 -> VarLocal <$> get
131+ 2 -> VarGlobal <$> get <*> get
132+ 3 -> List <$> get
133+ 4 -> Binop <$> get <*> get <*> get <*> get
134+ 5 -> Function <$> get <*> get
135+ 6 -> Call <$> get <*> get
136+ 7 -> TailCall <$> get <*> get <*> get
137+ 8 -> If <$> get <*> get
138+ 9 -> Let <$> get <*> get
139+ 10 -> Case <$> get <*> get <*> get
140+ 11 -> Ctor <$> get <*> get
141+ 12 -> CtorAccess <$> get <*> get
142+ 13 -> Access <$> get <*> get
143+ 14 -> Update <$> get <*> get
144+ 15 -> Record <$> get
145+ 16 -> Cmd <$> get <*> get
146+ 17 -> Sub <$> get <*> get
147+ 18 -> OutgoingPort <$> get <*> get
148+ 19 -> IncomingPort <$> get <*> get
149+ 20 -> Program <$> get <*> get
150+ 21 -> GLShader <$> get
151+ 22 -> Crash <$> get <*> get <*> get
152+ _ -> error "problem getting Opt.Expr binary"
153+
154+ put expr =
155+ case expr of
156+ Literal a -> putWord8 0 >> put a
157+ VarLocal a -> putWord8 1 >> put a
158+ VarGlobal a b -> putWord8 2 >> put a >> put b
159+ List a -> putWord8 3 >> put a
160+ Binop a b c d -> putWord8 4 >> put a >> put b >> put c >> put d
161+ Function a b -> putWord8 5 >> put a >> put b
162+ Call a b -> putWord8 6 >> put a >> put b
163+ TailCall a b c -> putWord8 7 >> put a >> put b >> put c
164+ If a b -> putWord8 8 >> put a >> put b
165+ Let a b -> putWord8 9 >> put a >> put b
166+ Case a b c -> putWord8 10 >> put a >> put b >> put c
167+ Ctor a b -> putWord8 11 >> put a >> put b
168+ CtorAccess a b -> putWord8 12 >> put a >> put b
169+ Access a b -> putWord8 13 >> put a >> put b
170+ Update a b -> putWord8 14 >> put a >> put b
171+ Record a -> putWord8 15 >> put a
172+ Cmd a b -> putWord8 16 >> put a >> put b
173+ Sub a b -> putWord8 17 >> put a >> put b
174+ OutgoingPort a b -> putWord8 18 >> put a >> put b
175+ IncomingPort a b -> putWord8 19 >> put a >> put b
176+ Program a b -> putWord8 20 >> put a >> put b
177+ GLShader a -> putWord8 21 >> put a
178+ Crash a b c -> putWord8 22 >> put a >> put b >> put c
179+
180+
181+instance (Binary a) => Binary (Decider a) where
182+ get =
183+ do word <- getWord8
184+ case word of
185+ 0 -> Leaf <$> get
186+ 1 -> Chain <$> get <*> get <*> get
187+ 2 -> FanOut <$> get <*> get <*> get
188+ _ -> error "problem getting Opt.Decider binary"
189+
190+ put decider =
191+ case decider of
192+ Leaf a ->
193+ do putWord8 0
194+ put a
195+
196+ Chain testChain success failure ->
197+ do putWord8 1
198+ put testChain
199+ put success
200+ put failure
201+
202+ FanOut path tests fallback ->
203+ do putWord8 2
204+ put path
205+ put tests
206+ put fallback
207+
208+
209+instance Binary Choice where
210+ put choice =
211+ case choice of
212+ Inline expr -> putWord8 0 >> put expr
213+ Jump index -> putWord8 1 >> put index
214+
215+ get =
216+ do word <- getWord8
217+ case word of
218+ 0 -> Inline <$> get
219+ 1 -> Jump <$> get
220+ _ -> error "problem getting Opt.Choice binary"
221+