@@ -18,7 +18,7 @@ import qualified Reporting.Annotation as A
1818import qualified Reporting.Region as R
1919
2020
21−-- OPTIMIZE FOR TAIL CALLS
21+-- OPTIMIZE - turn a canonical module into a list of optimized defs
2222
2323optimize :: Module.CanonicalModule -> Module.Optimized
2424optimize module_ =
@@ -30,7 +30,7 @@ optimize module_ =
3030 flattenLets [] (Module.program (Module.body module_))
3131 in
3232 State.evalState
33− (concat <$> mapM (definition (Just home)) defs)
33+ (concat <$> mapM (optimizeDef (Just home)) defs)
3434 (Env False 0)
3535
3636
@@ -69,8 +69,8 @@ mapSnd func (x, a) =
6969
7070-- CONVERT DEFINITIONS
7171
72−definition :: Maybe ModuleName.Canonical -> Can.Def -> Optimizer [Opt.Def]
73−definition home (Can.Definition (Can.Facts deps) pattern@(A.A _ ptrn) expression _) =
72+optimizeDef :: Maybe ModuleName.Canonical -> Can.Def -> Optimizer [Opt.Def]
73+optimizeDef home (Can.Definition (Can.Facts deps) pattern@(A.A _ ptrn) expression _) =
7474 let
7575 (args, rawBody) =
7676 Expr.collectLambdas expression
@@ -100,14 +100,14 @@ definition home (Can.Definition (Can.Facts deps) pattern@(A.A _ ptrn) expression
100100 (P.Var name, []) ->
101101
102102 do hasTailCall <- State.gets _hasTailCall
103− body <- findTailCalls Nothing rawBody
103+ body <- optimizeExpr Nothing rawBody
104104 setTailCall hasTailCall
105105 return [ Opt.Def (Opt.Facts home deps) name body ]
106106
107107 (_, []) ->
108108
109109 do name <- freshName
110− optBody <- findTailCalls Nothing rawBody
110+ optBody <- optimizeExpr Nothing rawBody
111111 let optDef = Opt.Def (Opt.Facts home deps) name optBody
112112 return (optDef : patternToDefs home name pattern)
113113
@@ -124,7 +124,7 @@ optimizeFunction
124124 -> Optimizer ([String], Opt.Expr)
125125optimizeFunction maybeName patterns givenBody =
126126 do (argNames, body) <- M.foldM depatternArgs ([], givenBody) (reverse patterns)
127− optBody <- findTailCalls (makeContext argNames =<< maybeName) body
127+ optBody <- optimizeExpr (makeContext argNames =<< maybeName) body
128128 return (argNames, optBody)
129129
130130
@@ -189,21 +189,26 @@ substitutions expr (A.A _ pattern) =
189189 concat (zipWith (substitutions . Opt.DataAccess expr) [0..] patterns)
190190
191191
192−-- CONVERT EXPRESSIONS
192+-- OPTIMIZE EXPRESSIONS
193193
194194type Context = Maybe (String, Int, [String])
195195
196196
197−findTailCalls :: Context -> Can.Expr -> Optimizer Opt.Expr
198−findTailCalls context annExpr@(A.A region expression) =
197+{-| This optimizer detects tail calls. The `Context` holds a function name,
198+function arity, and list of argument names. If a tail call is possible, the
199+`Context` will be filled in and we check any function we run into. If we go
200+down a route that cannot possibly have tail calls, we remove the context.
201+-}
202+optimizeExpr :: Context -> Can.Expr -> Optimizer Opt.Expr
203+optimizeExpr context annExpr@(A.A region expression) =
199204 let
200205 keepLooking =
201− findTailCalls context
206+ optimizeExpr context
202207 -- this *might* find a tail call, use this when something is a potential
203208 -- tail call
204209
205210 justConvert =
206− findTailCalls Nothing
211+ optimizeExpr Nothing
207212 -- this will never find tail calls, use this when you are working with
208213 -- expressions that cannot be turned into tail calls
209214 in
@@ -262,7 +267,7 @@ findTailCalls context annExpr@(A.A region expression) =
262267 <*> keepLooking finally
263268
264269 Expr.Let defs body ->
265− do optDefs <- concat <$> T.traverse (definition Nothing) defs
270+ do optDefs <- concat <$> T.traverse (optimizeDef Nothing) defs
266271 Opt.Let optDefs <$> keepLooking body
267272
268273 Expr.Case expr rawBranches ->
@@ -405,35 +410,35 @@ optimizeBinop context region op leftExpr rightExpr =
405410 in
406411 if op == forwardApply then
407412
408− findTailCalls context (collect id left forwardApply binop)
413+ optimizeExpr context (collect id left forwardApply binop)
409414
410415 else if op == backwardApply then
411416
412− findTailCalls context (collect id right backwardApply binop)
417+ optimizeExpr context (collect id right backwardApply binop)
413418
414419 else if op == forwardCompose then
415420
416421 do var <- freshName
417422 let makeRoot func = ann (Expr.App func (ann (Expr.Var (Var.local var))))
418423 let body = collect makeRoot left forwardCompose binop
419− findTailCalls context (ann (Expr.Lambda (ann (P.Var var)) body))
424+ optimizeExpr context (ann (Expr.Lambda (ann (P.Var var)) body))
420425
421426 else if op == backwardCompose then
422427
423428 do var <- freshName
424429 let makeRoot func = ann (Expr.App func (ann (Expr.Var (Var.local var))))
425430 let body = collect makeRoot right backwardCompose binop
426− findTailCalls context (ann (Expr.Lambda (ann (P.Var var)) body))
431+ optimizeExpr context (ann (Expr.Lambda (ann (P.Var var)) body))
427432
428433 else if op == Var.Canonical Var.BuiltIn "::" then
429434
430− findTailCalls context (ann (Expr.Data "::" [ leftExpr, rightExpr ]))
435+ optimizeExpr context (ann (Expr.Data "::" [ leftExpr, rightExpr ]))
431436
432437 else
433438
434439 Opt.Binop op
435− <$> findTailCalls Nothing leftExpr
436− <*> findTailCalls Nothing rightExpr
440+ <$> optimizeExpr Nothing leftExpr
441+ <*> optimizeExpr Nothing rightExpr
437442
438443
439444-- left-associative ((x |> f) |> g)