@@ -36,7 +36,6 @@ 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) ]
4039function args stmts = FuncExpr () Nothing (map var args) stmts
4140call = CallExpr ()
4241string = StringLit ()
@@ -114,7 +113,26 @@ expression (L span expr) =
114113
115114 Binop op e1 e2 -> binop span op e1 e2
116115
117− Lambda pattern body -> lambda Nothing span pattern body
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)
118136
119137 App e1 e2 ->
120138 do func' <- expression func
@@ -176,11 +194,6 @@ definition def =
176194 case def of
177195 TypeAnnotation _ _ -> return []
178196
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−
184197 Def pattern expr@(L span _) -> do
185198 expr' <- expression expr
186199 let assign x = varDecl x expr'
@@ -225,31 +238,6 @@ definition def =
225238 toDef y = definition $
226239 Def (PVar y) (L span $ Case (mkVar "$") [(pattern, mkVar y)])
227240
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−
253241match span mtch =
254242 case mtch of
255243 Match name clauses mtch' ->