@@ -81,39 +81,35 @@ toExpr code =
8181 case code of
8282 JsExpr expr ->
8383 expr
84+
8485 JsBlock stmts ->
8586 function [] stmts `call` []
8687
8788
88−-- TAIL CALL CONTEXT
89+-- DEFINITIONS
8990
90−type TailCallContext =
91− Maybe (String, [String], Label)
91+generateDef :: Opt.Def -> State Int (Statement ())
92+generateDef def =
93+ do (home, name, jsBody) <-
94+ case def of
95+ Opt.TailDef (Opt.Facts home _) name argNames body ->
96+ (,,) home name <$> generateTailFunction name argNames body
9297
98+ Opt.Def (Opt.Facts home _) name body ->
99+ (,,) home name <$> generateJsExpr body
93100
94−type Label =
95− Id ()
101+ return (VarDeclStmt () [ varDecl (Var.defName home name) jsBody ])
96102
97103
98104-- EXPRESSIONS
99105
100−toJsExpr :: Opt.Expr -> State Int (Expression ())
101−toJsExpr =
102− exprToJsExpr Nothing
103−
104−
105−toCode :: Opt.Expr -> State Int Code
106−toCode =
107− exprToCode Nothing
108−
109−
110−exprToJsExpr :: TailCallContext -> Opt.Expr -> State Int (Expression ())
111−exprToJsExpr tcc canonicalExpr =
112− toExpr <$> exprToCode tcc canonicalExpr
106+generateJsExpr :: Opt.Expr -> State Int (Expression ())
107+generateJsExpr optExpr =
108+ toExpr <$> generateCode optExpr
113109
114110
115−exprToCode :: TailCallContext -> Opt.Expr -> State Int Code
116−exprToCode tcc expr =
111+generateCode :: Opt.Expr -> State Int Code
112+generateCode expr =
117113 case expr of
118114 Var var ->
119115 jsExpr $ Var.canonical var
@@ -122,28 +118,28 @@ exprToCode tcc expr =
122118 jsExpr (Literal.literal lit)
123119
124120 Range lo hi ->
125− do lo' <- toJsExpr lo
126− hi' <- toJsExpr hi
121+ do lo' <- generateJsExpr lo
122+ hi' <- generateJsExpr hi
127123 jsExpr $ BuiltIn.range lo' hi'
128124
129125 Access record field ->
130− do record' <- toJsExpr record
126+ do record' <- generateJsExpr record
131127 jsExpr $ DotRef () record' (var (Var.safe field))
132128
133129 Update record fields ->
134130 let
135131 fieldToJs (field, value) =
136− do jsValue <- toJsExpr value
132+ do jsValue <- generateJsExpr value
137133 return (Var.safe field, jsValue)
138134 in
139− do jsRecord <- toJsExpr record
135+ do jsRecord <- generateJsExpr record
140136 jsFields <- mapM fieldToJs fields
141137 jsExpr $ BuiltIn.recordUpdate jsRecord jsFields
142138
143139 Record fields ->
144140 do fields' <-
145141 forM fields $ \(field, e) ->
146− (,) (Var.safe field) <$> toJsExpr e
142+ (,) (Var.safe field) <$> generateJsExpr e
147143
148144 let fieldMap =
149145 List.foldl' combine Map.empty fields'
@@ -171,8 +167,8 @@ exprToCode tcc expr =
171167 arity = length args
172168 aN = "A" ++ show arity
173169 in
174− do jsFunc <- toJsExpr func
175− jsArgs <- mapM toJsExpr args
170+ do jsFunc <- generateJsExpr func
171+ jsArgs <- mapM generateJsExpr args
176172 jsExpr $
177173 if 2 <= arity && arity <= 9 then
178174 ref aN `call` (jsFunc:jsArgs)
@@ -184,7 +180,7 @@ exprToCode tcc expr =
184180 reassign name tempName =
185181 ExprStmt () (AssignExpr () OpAssign (LVar () name) (ref tempName))
186182 in
187− do args' <- mapM toJsExpr args
183+ do args' <- mapM generateJsExpr args
188184 tempNames <- mapM (\_ -> Var.fresh) args
189185 jsBlock $
190186 VarDeclStmt () (zipWith varDecl tempNames args')
@@ -192,20 +188,22 @@ exprToCode tcc expr =
192188 ++ [ContinueStmt () (Just (Id () name))]
193189
194190 Let defs body ->
195− generateLet tcc defs body
191+ do stmts <- mapM generateDef defs
192+ code <- generateCode body
193+ jsBlock (stmts ++ toStatementList code)
196194
197195 If branches finally ->
198− generateIf tcc branches finally
196+ generateIf branches finally
199197
200198 Case expr decisionTree branches ->
201− generateCase tcc expr decisionTree branches
199+ generateCase expr decisionTree branches
202200
203201 ExplicitList elements ->
204− do jsElements <- mapM toJsExpr elements
202+ do jsElements <- mapM generateJsExpr elements
205203 jsExpr $ BuiltIn.list jsElements
206204
207205 Data tag members ->
208− do jsMembers <- mapM toJsExpr members
206+ do jsMembers <- mapM generateJsExpr members
209207 jsExpr $ ObjectLit () (ctor : fields jsMembers)
210208 where
211209 ctor = (prop "ctor", string tag)
@@ -213,7 +211,7 @@ exprToCode tcc expr =
213211 zipWith (\n e -> (prop ("_" ++ show n), e)) [ 0 :: Int .. ]
214212
215213 DataAccess dataExpr index ->
216− do jsDataExpr <- toJsExpr dataExpr
214+ do jsDataExpr <- generateJsExpr dataExpr
217215 jsExpr $ DotRef () jsDataExpr (var ("_" ++ show index))
218216
219217 GLShader _uid src _tipe ->
@@ -225,11 +223,11 @@ exprToCode tcc expr =
225223 jsExpr (Port.inbound name portType)
226224
227225 Expr.Out name expr portType ->
228− do expr' <- toJsExpr expr
226+ do expr' <- generateJsExpr expr
229227 jsExpr (Port.outbound name expr' portType)
230228
231229 Expr.Task name expr portType ->
232− do expr' <- toJsExpr expr
230+ do expr' <- generateJsExpr expr
233231 jsExpr (Port.task name expr' portType)
234232
235233 Crash ->
@@ -240,13 +238,13 @@ exprToCode tcc expr =
240238
241239generateFunction :: [String] -> Opt.Expr -> State Int Code
242240generateFunction args body =
243− do code <- exprToCode Nothing body
241+ do code <- generateCode body
244242 jsExpr (generateFunctionWithArity args code)
245243
246244
247245generateTailFunction :: String -> [String] -> Opt.Expr -> State Int (Expression ())
248246generateTailFunction name args body =
249− do code <- exprToCode Nothing body
247+ do code <- generateCode body
250248 return $ generateFunctionWithArity args $ JsBlock $ (:[]) $
251249 LabelledStmt ()
252250 (Id () name)
@@ -271,29 +269,16 @@ generateFunctionWithArity args code =
271269 foldl (\body arg -> function [arg] [ret body]) innerBody otherArgs
272270
273271
274−-- LET EXPRESSIONS
275−
276−generateLet
277− :: TailCallContext
278− -> [Opt.Def]
279− -> Opt.Expr
280− -> State Int Code
281−generateLet tcc defs body =
282− do stmts <- mapM generateDef defs
283− code <- exprToCode tcc body
284− jsBlock (stmts ++ toStatementList code)
285−
286−
287272-- GENERATE IFS
288273
289−generateIf :: TailCallContext -> [(Opt.Expr, Opt.Expr)] -> Opt.Expr -> State Int Code
290−generateIf tcc givenBranches givenFinally =
274+generateIf :: [(Opt.Expr, Opt.Expr)] -> Opt.Expr -> State Int Code
275+generateIf givenBranches givenFinally =
291276 let
292277 (branches, finally) =
293278 crushIfs givenBranches givenFinally
294279
295280 convertBranch (condition, expr) =
296− (,) <$> toJsExpr condition <*> exprToCode tcc expr
281+ (,) <$> generateJsExpr condition <*> generateCode expr
297282
298283 ifExpression (condition, branch) otherwise =
299284 CondExpr () condition branch otherwise
@@ -302,7 +287,7 @@ generateIf tcc givenBranches givenFinally =
302287 IfStmt () condition branch otherwise
303288 in
304289 do jsBranches <- mapM convertBranch branches
305− jsFinally <- exprToCode tcc finally
290+ jsFinally <- generateCode finally
306291
307292 if any isBlock (jsFinally : map snd jsBranches)
308293 then
@@ -341,32 +326,15 @@ crushIfsHelp visitedBranches unvisitedBranches finally =
341326 crushIfsHelp (visiting : visitedBranches) unvisited finally
342327
343328
344−
345−-- DEFINITIONS
346−
347−generateDef :: Opt.Def -> State Int (Statement ())
348−generateDef def =
349− do (home, name, jsBody) <-
350− case def of
351− Opt.TailDef (Opt.Facts home _) name argNames body ->
352− (,,) home name <$> generateTailFunction name argNames body
353−
354− Opt.Def (Opt.Facts home _) name body ->
355− (,,) home name <$> toJsExpr body
356−
357− return (VarDeclStmt () [ varDecl (Var.defName home name) jsBody ])
358−
359−
360329-- CASE EXPRESSIONS
361330
362331generateCase
363− :: TailCallContext
364− -> Opt.Expr
332+ :: Opt.Expr
365333 -> PM.DecisionTree Int
366334 -> Map.Map Int Opt.Expr
367335 -> State Int Code
368−generateCase tcc expr decisionTree branches =
369− error "TODO" tcc expr decisionTree branches
336+generateCase expr decisionTree branches =
337+ error "TODO" expr decisionTree branches
370338
371339
372340-- BINARY OPERATORS
@@ -378,7 +346,7 @@ binop
378346 -> State Int Code
379347binop func left right
380348 | func == Var.Canonical Var.BuiltIn "::" =
381− toCode (Data "::" [left,right])
349+ generateCode (Data "::" [left,right])
382350
383351 | func == forwardCompose =
384352 compose (collectLeftAssoc forwardCompose left right)
@@ -393,8 +361,8 @@ binop func left right
393361 pipe (collectRightAssoc backwardApply left right)
394362
395363 | otherwise =
396− do jsLeft <- toJsExpr left
397− jsRight <- toJsExpr right
364+ do jsLeft <- generateJsExpr left
365+ jsRight <- generateJsExpr right
398366 jsExpr (makeExpr func jsLeft jsRight)
399367
400368
@@ -407,13 +375,13 @@ apply arg func =
407375
408376compose :: [Opt.Expr] -> State Int Code
409377compose functions =
410− do jsFunctions <- mapM toJsExpr functions
378+ do jsFunctions <- mapM generateJsExpr functions
411379 jsExpr $ ["$"] ==> List.foldl' apply (ref "$") jsFunctions
412380
413381
414382pipe :: [Opt.Expr] -> State Int Code
415383pipe expressions =
416− do (value:functions) <- mapM toJsExpr expressions
384+ do (value:functions) <- mapM generateJsExpr expressions
417385 jsExpr $ List.foldl' apply value functions
418386
419387