Compiled (non-mutual) 'val rec'

5 files changed, 98 insertions, 28 deletions

diff --git a/src/cjr.sml b/src/cjr.sml
index 363fa762..8e8e6cab 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -58,6 +58,7 @@ datatype decl' =
          DStruct of int * (string * typ) list
        | DVal of string * int * typ * exp
        | DFun of string * int * (string * typ) list * typ * exp
+       | DFunRec of (string * int * (string * typ) list * typ * exp) list
 
 withtype decl = decl' located
 
diff --git a/src/cjr_env.sml b/src/cjr_env.sml
index bad365a5..a44359db 100644
--- a/src/cjr_env.sml
+++ b/src/cjr_env.sml
@@ -125,6 +125,13 @@ fun declBinds env (d, loc) =
         in
             pushENamed env fx n t
         end
+      | DFunRec vis =>
+        foldl (fn ((fx, n, args, ran, _), env) =>
+                  let
+                      val t = foldl (fn ((_, arg), t) => (TFun (arg, t), loc)) ran args
+                  in
+                      pushENamed env fx n t
+                  end) env vis
       | DStruct (n, xts) => pushStruct env n xts
 
 end
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 991315e5..68184acd 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -83,10 +83,21 @@ fun p_exp' par env (e, _) =
                                    string "(ctx, ",
                                    p_list (p_exp env) es,
                                    string ")"]
-      | EApp (e1, e2) => parenIf par (box [p_exp' true env e1,
-                                           string "(",
-                                           p_exp env e2,
-                                           string ")"])
+      | EApp (e1, e2) =>
+        let
+            fun unravel (f, acc) =
+                case #1 f of
+                    EApp (f', arg) => unravel (f', arg :: acc)
+                  | _ => (f, acc)
+
+            val (f, args) = unravel (e1, [e2])
+        in
+            parenIf par (box [p_exp' true env e1,
+                              string "(ctx,",
+                              space,
+                              p_list_sep (box [string ",", space]) (p_exp env) args,
+                              string ")"])
+        end
 
       | ERecord (i, xes) => box [string "({",
                                  space,
@@ -124,7 +135,34 @@ fun p_exp' par env (e, _) =
 
 and p_exp env = p_exp' false env
 
-fun p_decl env ((d, _) : decl) =
+fun p_fun env (fx, n, args, ran, e) =
+    let
+        val nargs = length args
+        val env' = foldl (fn ((x, dom), env) => E.pushERel env x dom) env args
+    in
+        box [string "static",
+             space,
+             p_typ env ran,
+             space,
+             string ("__lwn_" ^ fx ^ "_" ^ Int.toString n),
+             string "(",
+             p_list_sep (box [string ",", space]) (fn x => x)
+                        (string "lw_context ctx" :: ListUtil.mapi (fn (i, (_, dom)) =>
+                                                                      box [p_typ env dom,
+                                                                           space,
+                                                                           p_rel env' (nargs - i - 1)]) args),
+             string ")",
+             space,
+             string "{",
+             newline,
+             box[string "return(",
+                 p_exp env' e,
+                 string ");"],
+             newline,
+             string "}"]
+    end
+
+fun p_decl env (dAll as (d, _) : decl) =
     case d of
         DStruct (n, xts) =>
         box [string "struct",
@@ -149,31 +187,25 @@ fun p_decl env ((d, _) : decl) =
              space,
              p_exp env e,
              string ";"]
-      | DFun (fx, n, args, ran, e) =>
+      | DFun vi => p_fun env vi
+      | DFunRec vis =>
         let
-            val nargs = length args
-            val env' = foldl (fn ((x, dom), env) => E.pushERel env x dom) env args
+            val env = E.declBinds env dAll
         in
-            box [string "static",
-                 space,
-                 p_typ env ran,
-                 space,
-                 string ("__lwn_" ^ fx ^ "_" ^ Int.toString n),
-                 string "(",
-                 p_list_sep (box [string ",", space]) (fn x => x)
-                            (string "lw_context ctx" :: ListUtil.mapi (fn (i, (_, dom)) =>
-                                                                   box [p_typ env dom,
-                                                                        space,
-                                                                        p_rel env' (nargs - i - 1)]) args),
-                 string ")",
-                 space,
-                 string "{",
-                 newline,
-                 box[string "return(",
-                     p_exp env' e,
-                     string ");"],
+            box [p_list_sep newline (fn (fx, n, args, ran, _) =>
+                                        box [string "static",
+                                             space,
+                                             p_typ env ran,
+                                             space,
+                                             string ("__lwn_" ^ fx ^ "_" ^ Int.toString n),
+                                             string "(lw_context,",
+                                             space,
+                                             p_list_sep (box [string ",", space])
+                                                        (fn (_, dom) => p_typ env dom) args,
+                                             string ");"]) vis,
                  newline,
-                 string "}"]
+                 p_list_sep newline (p_fun env) vis,
+                 newline]
         end
 
 fun unurlify (t, loc) =
diff --git a/src/cjrize.sml b/src/cjrize.sml
index 5f2f69c0..cb2557f6 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -195,7 +195,36 @@ fun cifyDecl ((d, loc), sm) =
         in
             (SOME (d, loc), NONE, sm)
         end
-      | L.DValRec _ => raise Fail "Cjrize DValRec"
+      | L.DValRec vis =>
+        let
+            val (vis, sm) = ListUtil.foldlMap
+                            (fn ((x, n, t, e, _), sm) =>
+                                let                                    
+                                    val (t, sm) = cifyTyp (t, sm)
+
+                                    fun unravel (tAll as (t, _), eAll as (e, _)) =
+                                        case (t, e) of
+                                            (L'.TFun (dom, ran), L.EAbs (ax, _, _, e)) =>
+                                            let
+                                                val (args, t, e) = unravel (ran, e)
+                                            in
+                                                ((ax, dom) :: args, t, e)
+                                            end
+                                          | (L'.TFun _, _) =>
+                                            (ErrorMsg.errorAt loc "Function isn't explicit at code generation";
+                                             ([], tAll, eAll))
+                                          | _ => ([], tAll, eAll)
+                                                 
+                                    val (args, ran, e) = unravel (t, e)
+                                    val (e, sm) = cifyExp (e, sm)
+                              in
+                                  ((x, n, args, ran, e), sm)
+                              end)
+                            sm vis
+        in
+            (SOME (L'.DFunRec vis, loc), NONE, sm)
+        end        
+
       | L.DExport (s, n, ts) =>
         let
             val (ts, sm) = ListUtil.foldlMap cifyTyp sm ts
diff --git a/src/mono_print.sml b/src/mono_print.sml
index a4fda230..6f9c1b66 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -183,6 +183,7 @@ fun p_decl env (dAll as (d, _) : decl) =
                                    p_enamed env n,
                                    space,
                                    string "as",
+                                   space,
                                    string s,
                                    p_list_sep (string "") (fn t => box [space,
                                                                         string "(",