@@ -5,12 +5,13 @@ import Control.Arrow (first,(***))
55import Control.Monad.State
66import qualified Data.List as List
77import qualified Data.Map as Map
8+import qualified Data.Maybe as Maybe
89import qualified Data.Set as Set
910import Language.ECMAScript3.PrettyPrint
1011import Language.ECMAScript3.Syntax
1112
1213import AST.Module
13−import AST.Expression.General
14+import AST.Expression.General as Expr
1415import qualified AST.Expression.Canonical as Canonical
1516import qualified AST.Helpers as Help
1617import AST.Literal
@@ -59,8 +60,10 @@ literal lit =
5960 Boolean b -> BoolLit () b
6061
6162
63+-- EXPRESSIONS
64+
6265expression :: Canonical.Expr -> State Int (Expression ())
63−expression (A.A region expr) =
66+expression annotatedExpr@(A.A region expr) =
6467 case expr of
6568 Var var ->
6669 return $ Var.canonical var
@@ -118,33 +121,8 @@ expression (A.A region expr) =
118121 Binop op e1 e2 ->
119122 binop region op e1 e2
120123
121− Lambda pattern rawBody@(A.A ann _) ->
122− do (args, body) <- foldM depattern ([], innerBody) (reverse patterns)
123− body' <- expression body
124− return $
125− case length args < 2 || length args > 9 of
126− True -> foldr (==>) body' (map (:[]) args)
127− False -> ref ("F" ++ show (length args)) <| (args ==> body')
128− where
129− depattern (args, body) pattern =
130− case pattern of
131− A.A _ (P.Var x) ->
132− return (args ++ [ Var.varName x ], body)
133−
134− _ ->
135− do arg <- Case.newVar
136− return
137− ( args ++ [arg]
138− , A.A ann (Case (A.A ann (localVar arg)) [(pattern, body)])
139− )
140−
141− (patterns, innerBody) =
142− collect [pattern] rawBody
143−
144− collect patterns lexpr@(A.A _ expr) =
145− case expr of
146− Lambda p e -> collect (p:patterns) e
147− _ -> (patterns, lexpr)
124+ Lambda _ _ ->
125+ generateFunction (Expr.collectLambdas annotatedExpr)
148126
149127 App e1 e2 ->
150128 do func' <- expression func
@@ -162,11 +140,10 @@ expression (A.A region expr) =
162140 (A.A _ (App f arg)) -> getArgs f (arg : args)
163141 _ -> (func, args)
164142
165− Let defs e ->
166− do let (defs',e') = flattenLets defs e
167− stmts <- concat <$> mapM definition defs'
168− exp <- expression e'
169− return $ function [] (stmts ++ [ ret exp ]) `call` []
143+ Let defs body ->
144+ do (stmts, bodyExpr) <- generateLetPieces defs body
145+ return $ function [] (stmts ++ [ ret bodyExpr ]) `call` []
146+
170147
171148 MultiIf branches ->
172149 do branches' <- forM branches $ \(b,e) -> (,) <$> expression b <*> expression e
@@ -224,6 +201,70 @@ expression (A.A region expr) =
224201 return (Port.task name expr' portType)
225202
226203
204+-- FUNCTIONS
205+
206+generateFunction
207+ :: ([P.CanonicalPattern], Canonical.Expr)
208+ -> State Int (Expression ())
209+generateFunction (args, initialBody) =
210+ do (argVars, patternDefs) <- destructuredArgs args
211+ (stmts, expr) <- generateLetPieces patternDefs initialBody
212+ return (generateFunctionWithArity argVars stmts expr)
213+
214+
215+generateFunctionWithArity :: [String] -> [Statement ()] -> Expression () -> Expression ()
216+generateFunctionWithArity args stmts expr =
217+ let
218+ arity = length args
219+ in
220+ if 2 <= arity && arity <= 9 then
221+ let
222+ fN = "F" ++ show arity
223+ in
224+ ref fN <| function args (stmts ++ [ret expr])
225+ else
226+ let
227+ (lastArg:otherArgs) = reverse args
228+ innerBody = function [lastArg] (stmts ++ [ret expr])
229+ in
230+ foldl (\body arg -> function [arg] [ret body]) innerBody otherArgs
231+
232+
233+destructuredArgs :: [P.CanonicalPattern] -> State Int ([String], [Canonical.Def])
234+destructuredArgs args =
235+ do (argVars, maybePatternDefs) <- unzip <$> mapM destructPattern args
236+ return (argVars, Maybe.catMaybes maybePatternDefs)
237+
238+
239+destructPattern :: P.CanonicalPattern -> State Int (String, Maybe Canonical.Def)
240+destructPattern pattern@(A.A ann pat) =
241+ case pat of
242+ P.Var x ->
243+ return (Var.varName x, Nothing)
244+
245+ _ ->
246+ do arg <- Case.newVar
247+ return
248+ ( arg
249+ , Just $ Canonical.Definition pattern (A.A ann (localVar arg)) Nothing
250+ )
251+
252+
253+-- LET EXPRESSIONS
254+
255+generateLetPieces
256+ :: [Canonical.Def]
257+ -> Canonical.Expr
258+ -> State Int ([Statement ()], Expression ())
259+generateLetPieces givenDefs givenBody =
260+ do let (defs, body) = flattenLets givenDefs givenBody
261+ stmts <- concat <$> mapM definition defs
262+ expr <- expression body
263+ return (stmts, expr)
264+
265+
266+-- DEFINITIONS
267+
227268definition :: Canonical.Def -> State Int [Statement ()]
228269definition (Canonical.Definition annPattern expr@(A.A region _) _) =
229270 do expr' <- expression expr