diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-07-13 12:06:47 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-07-13 12:06:47 -0400 |
| commit | b3379c2a4d9b23c49c286b31ab24850129b5bb1e (patch) | |
| tree | 20b0b499f8ea47e7b6d8f7fad4ac05d24fc4cad3 /src/monoize.sml | |
| parent | 95d278b9b8e9c314541b8251a34a32fe6deeb896 (diff) | |
Closure code generation almost there
Diffstat (limited to 'src/monoize.sml')
| -rw-r--r-- | src/monoize.sml | 41 |
1 files changed, 31 insertions, 10 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index 2e21a2bf..266a031a 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -79,14 +79,35 @@ fun monoType env (all as (c, loc)) = val dummyExp = (L'.EPrim (Prim.Int 0), E.dummySpan) -fun attrifyExp (e, tAll as (t, loc)) = - case t of - L'.TFfi ("Basis", "string") => (L'.EFfiApp ("Basis", "attrifyString", [e]), loc) - | L'.TFfi ("Basis", "int") => (L'.EFfiApp ("Basis", "attrifyInt", [e]), loc) - | L'.TFfi ("Basis", "float") => (L'.EFfiApp ("Basis", "attrifyFloat", [e]), loc) - | _ => (E.errorAt loc "Don't know how to encode attribute type"; - Print.eprefaces' [("Type", MonoPrint.p_typ MonoEnv.empty tAll)]; - dummyExp) +fun attrifyExp env (e, tAll as (t, loc)) = + case #1 e of + L'.EClosure (fnam, args) => + let + val (_, ft, _, s) = Env.lookupENamed env fnam + val ft = monoType env ft + + fun attrify (args, ft, e) = + case (args, ft) of + ([], _) => e + | (arg :: args, (L'.TFun (t, ft), _)) => + (L'.EStrcat (e, + (L'.EStrcat ((L'.EPrim (Prim.String "/"), loc), + attrifyExp env (arg, t)), loc)), loc) + | _ => (E.errorAt loc "Type mismatch encoding attribute"; + e) + in + attrify (args, ft, (L'.EPrim (Prim.String s), loc)) + end + | _ => + case t of + L'.TFfi ("Basis", "string") => (L'.EFfiApp ("Basis", "attrifyString", [e]), loc) + | L'.TFfi ("Basis", "int") => (L'.EFfiApp ("Basis", "attrifyInt", [e]), loc) + | L'.TFfi ("Basis", "float") => (L'.EFfiApp ("Basis", "attrifyFloat", [e]), loc) + | L'.TRecord [] => (L'.EPrim (Prim.String ""), loc) + + | _ => (E.errorAt loc "Don't know how to encode attribute type"; + Print.eprefaces' [("Type", MonoPrint.p_typ MonoEnv.empty tAll)]; + dummyExp) fun monoExp env (all as (e, loc)) = let @@ -155,7 +176,7 @@ fun monoExp env (all as (e, loc)) = in (L'.EStrcat (s, (L'.EStrcat ((L'.EPrim (Prim.String xp), loc), - (L'.EStrcat (attrifyExp (e, t), + (L'.EStrcat (attrifyExp env (e, t), (L'.EPrim (Prim.String "\""), loc)), loc)), loc)), loc) @@ -193,7 +214,7 @@ fun monoExp env (all as (e, loc)) = | L.EFold _ => poly () | L.EWrite e => (L'.EWrite (monoExp env e), loc) - | L.EClosure _ => raise Fail "Monoize EClosure" + | L.EClosure (n, es) => (L'.EClosure (n, map (monoExp env) es), loc) end fun monoDecl env (all as (d, loc)) = |