@@ -36,6 +36,7 @@ ref name = VarRef () (var name)
3636prop name = PropId () (var name)
3737f <| x = CallExpr () f [x]
3838args ==> e = FuncExpr () Nothing (map var args) [ ReturnStmt () (Just e) ]
39+namedFunction name args e = FuncExpr () name (map var args) [ ReturnStmt () (Just e) ]
3940function args stmts = FuncExpr () Nothing (map var args) stmts
4041call = CallExpr ()
4142string = StringLit ()
@@ -113,26 +114,7 @@ expression (L span expr) =
113114
114115 Binop op e1 e2 -> binop span op e1 e2
115116
116− Lambda p e@(L s _) ->
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)
117+ Lambda pattern body -> lambda Nothing span pattern body
136118
137119 App e1 e2 ->
138120 do func' <- expression func
@@ -194,6 +176,11 @@ definition def =
194176 case def of
195177 TypeAnnotation _ _ -> return []
196178
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+
197184 Def pattern expr@(L span _) -> do
198185 expr' <- expression expr
199186 let assign x = varDecl x expr'
@@ -238,6 +225,31 @@ definition def =
238225 toDef y = definition $
239226 Def (PVar y) (L span $ Case (mkVar "$") [(pattern, mkVar y)])
240227
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+
241253match span mtch =
242254 case mtch of
243255 Match name clauses mtch' ->