git.iko.soy/elk
on master help sign in
Add names to functions in generated JS.
a4fdf06Evan Czaplicki
compiler/Generate/JavaScript.hs+32−20
compare with master
unifiedsplit
@@ -36,6 +36,7 @@ ref name = VarRef () (var name)
36prop name = PropId () (var name)
36prop name = PropId () (var name)
37f <| x = CallExpr () f [x]
37f <| x = CallExpr () f [x]
38args ==> e = FuncExpr () Nothing (map var args) [ ReturnStmt () (Just e) ]
38args ==> e = FuncExpr () Nothing (map var args) [ ReturnStmt () (Just e) ]
39+namedFunction name args e = FuncExpr () name (map var args) [ ReturnStmt () (Just e) ]
39function args stmts = FuncExpr () Nothing (map var args) stmts
40function args stmts = FuncExpr () Nothing (map var args) stmts
40call = CallExpr ()
41call = CallExpr ()
41string = StringLit ()
42string = StringLit ()
@@ -113,26 +114,7 @@ expression (L span expr) =
113
114
114 Binop op e1 e2 -> binop span op e1 e2
115 Binop op e1 e2 -> binop span op e1 e2
115
116
116− Lambda p e@(L s _) ->
117+ Lambda pattern body -> lambda Nothing span pattern body
117− do body' <- expression body
118− return $ case length args < 2 || length args > 9 of
119− True -> foldr (==>) body' (map (:[]) args)
120− False -> ref ("F" ++ show (length args)) <| (args ==> body')
121− where
122− (args, body) = foldr depattern ([], innerBody) (zip patterns [0..])
123−
124− depattern (pattern,n) (args, body) =
125− case pattern of
126− PVar x -> (args ++ [x], body)
127− _ -> let arg = "arg" ++ show n
128− in (args ++ [arg], L s (Case (L s (Var arg)) [(pattern, body)]))
129−
130− (patterns, innerBody) = collect [p] e
131−
132− collect patterns lexpr@(L _ expr) =
133− case expr of
134− Lambda p e -> collect (p:patterns) e
135− _ -> (patterns, lexpr)
136
118
137 App e1 e2 ->
119 App e1 e2 ->
138 do func' <- expression func
120 do func' <- expression func
@@ -194,6 +176,11 @@ definition def =
194 case def of
176 case def of
195 TypeAnnotation _ _ -> return []
177 TypeAnnotation _ _ -> return []
196
178
179+ Def (PVar f) (L span (Lambda pattern body))
180+ | not (isOp f) ->
181+ do expr <- lambda (Just (var f)) span pattern body
182+ return [ VarDeclStmt () [ varDecl f expr ] ]
183+
197 Def pattern expr@(L span _) -> do
184 Def pattern expr@(L span _) -> do
198 expr' <- expression expr
185 expr' <- expression expr
199 let assign x = varDecl x expr'
186 let assign x = varDecl x expr'
@@ -238,6 +225,31 @@ definition def =
238 toDef y = definition $
225 toDef y = definition $
239 Def (PVar y) (L span $ Case (mkVar "$") [(pattern, mkVar y)])
226 Def (PVar y) (L span $ Case (mkVar "$") [(pattern, mkVar y)])
240
227
228+
229+lambda name span outerPattern outerBody =
230+ do body' <- expression body
231+ return $ case args of
232+ [arg] -> namedFunction name args body'
233+ arg:rest ->
234+ case length args < 10 of
235+ True -> ref ("F" ++ show (length args)) <| (namedFunction name args body')
236+ False -> namedFunction name [arg] (foldr (==>) body' (map (:[]) rest))
237+ where
238+ (args, body) = foldr depattern ([], innerBody) (zip patterns [0..])
239+
240+ depattern (pattern,n) (args, body) =
241+ case pattern of
242+ PVar x -> (args ++ [x], body)
243+ _ -> let arg = "arg" ++ show n
244+ in (args ++ [arg], L span (Case (L span (Var arg)) [(pattern, body)]))
245+
246+ (patterns, innerBody) = collect [outerPattern] outerBody
247+
248+ collect patterns lexpr@(L _ expr) =
249+ case expr of
250+ Lambda p e -> collect (p:patterns) e
251+ _ -> (patterns, lexpr)
252+
241match span mtch =
253match span mtch =
242 case mtch of
254 case mtch of
243 Match name clauses mtch' ->
255 Match name clauses mtch' ->