git @ Cat's Eye Technologies Lanthorn / 169f821
Allow `letrec` to bind functions that differ in their arity. Chris Pressey 6 months ago
2 changed file(s) with 18 addition(s) and 16 deletion(s). Raw diff Collapse all Expand all
9797
9898 * The transformation should make more effort at name mangling
9999 hygiene.
100 * The transformation should retain the names of the original
101 arguments of the functions.
102100
103101 Appendix A
104102 ----------
00 module Language.Lanthorn.LetRec where
11
22 import Language.Lanthorn.AST
3 import Language.Lanthorn.Pretty
34
45
56 convert (Fun formals body) = Fun formals (convert body)
1920 convertToLetStar :: [(String, Expr)] -> Expr -> Expr
2021 convertToLetStar bindings body =
2122 let
22 injecteds = map (fst) bindings
23 -- For each binding, we need to send down the relevant parts of all
24 -- the bindings in the letrec, so it can compose the recursive call.
25 -- The relevant parts are the *name* of each binding and its *formals*.
26 -- We call such a pair an "injected", for no terribly good reason
27 -- (possibly because it is "injected" into every binding in the letrec).
28 getInjected (name, (Fun formals body)) = (name, formals)
29 injecteds = map (getInjected) bindings
2330 enrichedBindings = createEnrichedBindings bindings injecteds
2431 wrapperBindings = createWrapperBindings bindings injecteds
2532 in
2936 wrapperNameInner name = name ++ "1"
3037
3138 createEnrichedBindings [] injecteds = []
32 createEnrichedBindings ((name, (Fun formals body)):rest) injecteds =
39 createEnrichedBindings (binding@(name, (Fun formals body)):rest) injecteds =
3340 let
3441 name' = wrapperNameOuter name
35 -- FIXME we need to create one of these for each injected, using different base formals --
36 -- those of the injected, not of the current functions!
37 formals' = formals ++ (map (wrapperNameInner) injecteds)
38 body' = (LetStar (createLocalBindings injecteds injecteds formals) body)
42 injectedNames = map (fst) injecteds
43 formals' = formals ++ (map (wrapperNameInner) injectedNames)
44 body' = (LetStar (createLocalBindings injecteds injectedNames) body)
3945 expr' = (Fun formals' body')
4046 binding = (name', expr')
4147 in
4349 createEnrichedBindings (binding:rest) injecteds =
4450 (binding:createEnrichedBindings rest injecteds)
4551
46 -- FIXME we need to attach a list of formals to every injected
47 createLocalBindings [] _ _ = []
48 createLocalBindings (injected:injecteds) allInjecteds formals =
52 createLocalBindings [] _ = []
53 createLocalBindings (injected@(injectedName, formals):injecteds) allInjectedNames =
4954 let
5055 formals' = map (wrapperNameInner) formals
51 actuals = map (ValueOf) (formals' ++ (map (wrapperNameInner) allInjecteds))
52 binding = (injected, Fun formals' (Apply (wrapperNameInner injected) actuals))
53 rest = createLocalBindings injecteds allInjecteds formals
56 actuals = map (ValueOf) (formals' ++ (map (wrapperNameInner) allInjectedNames))
57 binding = (injectedName, Fun formals' (Apply (wrapperNameInner injectedName) actuals))
5458 in
55 (binding:rest)
59 (binding:createLocalBindings injecteds allInjectedNames)
5660
5761 createWrapperBindings [] injecteds = []
5862 createWrapperBindings ((name, (Fun formals body)):rest) injecteds =
5963 let
6064 name' = name
61 actuals = map (ValueOf) (formals ++ (map (wrapperNameOuter) injecteds))
65 actuals = map (ValueOf) (formals ++ (map (\x -> wrapperNameOuter $ fst x) injecteds))
6266 expr' = Fun formals (Apply (wrapperNameOuter name) actuals)
6367 binding = (name', expr')
6468 in