Translation to Cjr

29 files changed, 814 insertions, 50 deletions

diff --git a/src/cjr.sml b/src/cjr.sml
new file mode 100644
index 00000000..c0a2ea15
--- /dev/null
+++ b/src/cjr.sml
@@ -0,0 +1,64 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Cjr = struct
+
+type 'a located = 'a ErrorMsg.located
+
+datatype typ' =
+         TTop
+       | TFun
+       | TCode of typ * typ
+       | TRecord of int
+       | TNamed of int
+
+withtype typ = typ' located
+
+datatype exp' =
+         EPrim of Prim.t
+       | ERel of int
+       | ENamed of int
+       | ECode of int
+       | EApp of exp * exp
+
+       | ERecord of int * (string * exp) list
+       | EField of exp * string
+
+       | ELet of (string * typ * exp) list * exp
+
+withtype exp = exp' located
+
+datatype decl' =
+         DStruct of int * (string * typ) list
+       | DVal of string * int * typ * exp
+       | DFun of int * string * typ * typ * exp
+
+withtype decl = decl' located
+
+type file = decl list
+
+end
diff --git a/src/cjr_env.sig b/src/cjr_env.sig
new file mode 100644
index 00000000..a3e666d7
--- /dev/null
+++ b/src/cjr_env.sig
@@ -0,0 +1,55 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature CJR_ENV = sig
+
+    type env
+
+    val empty : env
+    val basis : env
+
+    exception UnboundRel of int
+    exception UnboundNamed of int
+    exception UnboundF of int
+
+    val pushTNamed : env -> string -> int -> Cjr.typ option -> env
+    val lookupTNamed : env -> int -> string * Cjr.typ option
+
+    val pushERel : env -> string -> Cjr.typ -> env
+    val lookupERel : env -> int -> string * Cjr.typ
+    val listERels : env -> (string * Cjr.typ) list
+    val countERels : env -> int
+
+    val pushENamed : env -> string -> int -> Cjr.typ -> env
+    val lookupENamed : env -> int -> string * Cjr.typ
+
+    val pushF : env -> int -> string -> Cjr.typ -> Cjr.typ -> env
+    val lookupF : env -> int -> string * Cjr.typ * Cjr.typ
+
+    val declBinds : env -> Cjr.decl -> env
+                                                 
+end
diff --git a/src/cjr_env.sml b/src/cjr_env.sml
new file mode 100644
index 00000000..44dad97a
--- /dev/null
+++ b/src/cjr_env.sml
@@ -0,0 +1,135 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure CjrEnv :> CJR_ENV = struct
+
+open Cjr
+
+structure IM = IntBinaryMap
+
+
+exception UnboundRel of int
+exception UnboundNamed of int
+exception UnboundF of int
+
+type env = {
+     namedT : (string * typ option) IM.map,
+
+     numRelE : int,
+     relE : (string * typ) list,
+     namedE : (string * typ) IM.map,
+
+     F : (string * typ * typ) IM.map
+}
+
+val empty = {
+    namedT = IM.empty,
+
+    numRelE = 0,
+    relE = [],
+    namedE = IM.empty,
+
+    F = IM.empty
+}
+
+fun pushTNamed (env : env) x n co =
+    {namedT = IM.insert (#namedT env, n, (x, co)),
+
+     numRelE = #numRelE env,
+     relE = #relE env,
+     namedE = #namedE env,
+
+     F = #F env}
+
+fun lookupTNamed (env : env) n =
+    case IM.find (#namedT env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun pushERel (env : env) x t =
+    {namedT = #namedT env,
+
+     numRelE = #numRelE env + 1,
+     relE = (x, t) :: #relE env,
+     namedE = #namedE env,
+
+     F = #F env}
+
+fun lookupERel (env : env) n =
+    (List.nth (#relE env, n))
+    handle Subscript => raise UnboundRel n
+
+fun countERels (env : env) = #numRelE env
+
+fun listERels (env : env) = #relE env
+
+fun pushENamed (env : env) x n t =
+    {namedT = #namedT env,
+
+     numRelE = #numRelE env,
+     relE = #relE env,
+     namedE = IM.insert (#namedE env, n, (x, t)),
+
+     F = #F env}
+
+fun lookupENamed (env : env) n =
+    case IM.find (#namedE env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun pushF (env : env) n x dom ran =
+    {namedT = #namedT env,
+
+     numRelE = #numRelE env,
+     relE = #relE env,
+     namedE = #namedE env,
+
+     F = IM.insert (#F env, n, (x, dom, ran))}
+
+fun lookupF (env : env) n =
+    case IM.find (#F env, n) of
+        NONE => raise UnboundF n
+      | SOME x => x
+
+fun declBinds env (d, _) =
+    case d of
+        DVal (x, n, t, _) => pushENamed env x n t
+      | DFun (n, x, dom, ran, _) => pushF env n x dom ran
+      | DStruct _ => env
+
+fun bbind env x =
+    case ElabEnv.lookupC ElabEnv.basis x of
+        ElabEnv.NotBound => raise Fail "CjrEnv.bbind: Not bound"
+      | ElabEnv.Rel _ => raise Fail "CjrEnv.bbind: Rel"
+      | ElabEnv.Named (n, _) => pushTNamed env x n NONE
+
+val basis = empty
+val basis = bbind basis "int"
+val basis = bbind basis "float"
+val basis = bbind basis "string"
+
+end
diff --git a/src/cjr_print.sig b/src/cjr_print.sig
new file mode 100644
index 00000000..2c860550
--- /dev/null
+++ b/src/cjr_print.sig
@@ -0,0 +1,37 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing Laconic/Web C jr. language *)
+
+signature CJR_PRINT = sig
+    val p_typ : CjrEnv.env -> Cjr.typ Print.printer
+    val p_exp : CjrEnv.env -> Cjr.exp Print.printer
+    val p_decl : CjrEnv.env -> Cjr.decl Print.printer
+    val p_file : CjrEnv.env -> Cjr.file Print.printer
+
+    val debug : bool ref
+end
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
new file mode 100644
index 00000000..c7263e3b
--- /dev/null
+++ b/src/cjr_print.sml
@@ -0,0 +1,197 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing C jr. *)
+
+structure CjrPrint :> CJR_PRINT = struct
+
+open Print.PD
+open Print
+
+open Cjr
+
+structure E = CjrEnv
+structure EM = ErrorMsg
+
+val debug = ref false
+
+val dummyTyp = (TNamed 0, ErrorMsg.dummySpan)
+
+fun p_typ' par env (t, loc) =
+    case t of
+        TTop =>
+        (EM.errorAt loc "Undetermined type";
+         string "?")
+      | TFun =>
+        (EM.errorAt loc "Undetermined function type";
+         string "?->")
+      | TCode (t1, t2) => parenIf par (box [p_typ' true env t2,
+                                            space,
+                                            string "(*)",
+                                            space,
+                                            string "(",
+                                            p_typ env t1,
+                                            string ")"])
+      | TRecord i => box [string "struct",
+                          space,
+                          string "__lws_",
+                          string (Int.toString i)]
+      | TNamed n =>
+        (string ("__lwt_" ^ #1 (E.lookupTNamed env n) ^ "_" ^ Int.toString n)
+         handle CjrEnv.UnboundNamed _ => string ("__lwt_UNBOUND__" ^ Int.toString n))
+
+and p_typ env = p_typ' false env
+
+fun p_rel env n = string ("__lwr_" ^ #1 (E.lookupERel env n) ^ "_" ^ Int.toString (E.countERels env - n - 1))
+    handle CjrEnv.UnboundRel _ => string ("__lwr_UNBOUND_" ^ Int.toString (E.countERels env - n - 1))
+
+fun p_exp' par env (e, _) =
+    case e of
+        EPrim p => Prim.p_t p
+      | ERel n => p_rel env n
+      | ENamed n =>
+        (string ("__lwn_" ^ #1 (E.lookupENamed env n) ^ "_" ^ Int.toString n)
+         handle CjrEnv.UnboundNamed _ => string ("__lwn_UNBOUND_" ^ Int.toString n))
+      | ECode n => string ("__lwc_" ^ Int.toString n)
+      | EApp (e1, e2) => parenIf par (box [p_exp' true env e1,
+                                           string "(",
+                                           p_exp env e2,
+                                           string ")"])
+
+      | ERecord (i, xes) => box [string "({",
+                                 space,
+                                 string "struct",
+                                 space,
+                                 string ("__lws_" ^ Int.toString i),
+                                 space,
+                                 string "__lw_tmp",
+                                 space,
+                                 string "=",
+                                 space,
+                                 string "{",
+                                 p_list (fn (_, e) =>
+                                            p_exp env e) xes,
+                                 string "};",
+                                 space,
+                                 string "__lw_tmp;",
+                                 space,
+                                 string "})" ]
+      | EField (e, x) =>
+        box [p_exp' true env e,
+             string ".",
+             string x]
+
+      | ELet (xes, e) =>
+        let
+            val (env, pps) = foldl (fn ((x, t, e), (env, pps)) =>
+                                       let
+                                           val env' = E.pushERel env x t
+                                       in
+                                           (env',
+                                            List.revAppend ([p_typ env t,
+                                                             space,
+                                                             p_rel env' 0,
+                                                             space,
+                                                             string "=",
+                                                             space,
+                                                             p_exp env e,
+                                                             string ";",
+                                                             newline],
+                                                            pps))
+                                       end)
+                                   (env, []) xes
+        in
+            box [string "({",
+                 newline,
+                 box (rev pps),
+                 p_exp env e,
+                 space,
+                 string ";",
+                 newline,
+                 string "})"]
+        end
+
+and p_exp env = p_exp' false env
+
+fun p_decl env ((d, _) : decl) =
+    case d of
+        DStruct (n, xts) =>
+        box [string "struct",
+             space,
+             string ("__lws_" ^ Int.toString n),
+             space,
+             string "{",
+             newline,
+             p_list_sep (box []) (fn (x, t) => box [p_typ env t,
+                                                    space,
+                                                    string x,
+                                                    string ";",
+                                                    newline]) xts,
+             string "};"]
+
+      | DVal (x, n, t, e) =>
+        box [p_typ env t,
+             space,
+             string ("__lwn_" ^ x ^ "_" ^ Int.toString n),
+             space,
+             string "=",
+             space,
+             p_exp env e,
+             string ";"]
+      | DFun (n, x, dom, ran, e) =>
+        let
+            val env' = E.pushERel env x dom
+        in
+            box [p_typ env ran,
+                 space,
+                 string ("__lwc_" ^ Int.toString n),
+                 string "(",
+                 p_typ env dom,
+                 space,
+                 p_rel env' 0,
+                 string ")",
+                 space,
+                 string "{",
+                 newline,
+                 box[string "return(",
+                     p_exp env' e,
+                     string ")"],
+                 newline,
+                 string "}"]
+        end
+
+fun p_file env file =
+    let
+        val (_, pds) = ListUtil.mapfoldl (fn (d, env) =>
+                                             (E.declBinds env d,
+                                              p_decl env d))
+                             env file
+    in
+        p_list_sep newline (fn x => x) pds
+    end
+
+end
diff --git a/src/cjrize.sig b/src/cjrize.sig
new file mode 100644
index 00000000..44bf4fd2
--- /dev/null
+++ b/src/cjrize.sig
@@ -0,0 +1,32 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature CJRIZE = sig
+
+    val cjrize : Flat.file -> Cjr.file
+
+end
diff --git a/src/cjrize.sml b/src/cjrize.sml
new file mode 100644
index 00000000..48d1dae3
--- /dev/null
+++ b/src/cjrize.sml
@@ -0,0 +1,179 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Cjrize :> CJRIZE = struct
+
+structure L = Flat
+structure L' = Cjr
+
+structure Sm :> sig
+    type t
+
+    val empty : t
+    val find : t * (string * L.typ) list * (string * L'.typ) list -> t * int
+
+    val declares : t -> (int * (string * L'.typ) list) list
+end = struct
+
+structure FM = BinaryMapFn(struct
+                           type ord_key = L.typ
+                           val compare = FlatUtil.Typ.compare
+                           end)
+
+type t = int * int FM.map * (int * (string * L'.typ) list) list
+
+val empty = (0, FM.empty, [])
+
+fun find ((n, m, ds), xts, xts') =
+    let
+        val t = (L.TRecord xts, ErrorMsg.dummySpan)
+    in
+        case FM.find (m, t) of
+            NONE => ((n+1, FM.insert (m, t, n), (n, xts') :: ds), n)
+          | SOME i => ((n, m, ds), i)
+    end
+
+fun declares (_, _, ds) = ds
+
+end
+
+fun cifyTyp ((t, loc), sm) =
+    case t of
+        L.TTop => ((L'.TTop, loc), sm)
+      | L.TFun (t1, t2) =>
+        let
+            val (_, sm) = cifyTyp (t1, sm)
+            val (_, sm) = cifyTyp (t2, sm)
+        in
+            ((L'.TFun, loc), sm)
+        end
+      | L.TCode (t1, t2) =>
+        let
+            val (t1, sm) = cifyTyp (t1, sm)
+            val (t2, sm) = cifyTyp (t2, sm)
+        in
+            ((L'.TCode (t1, t2), loc), sm)
+        end
+      | L.TRecord xts =>
+        let
+            val old_xts = xts
+            val (xts, sm) = ListUtil.foldlMap (fn ((x, t), sm) =>
+                                                  let
+                                                      val (t, sm) = cifyTyp (t, sm)
+                                                  in
+                                                      ((x, t), sm)
+                                                  end)
+                                              sm xts
+            val (sm, si) = Sm.find (sm, old_xts, xts)
+        in
+            ((L'.TRecord si, loc), sm)
+        end
+      | L.TNamed n => ((L'.TNamed n, loc), sm)
+
+fun cifyExp ((e, loc), sm) =
+    case e of
+        L.EPrim p => ((L'.EPrim p, loc), sm)
+      | L.ERel n => ((L'.ERel n, loc), sm)
+      | L.ENamed n => ((L'.ENamed n, loc), sm)
+      | L.ECode n => ((L'.ECode n, loc), sm)
+      | L.EApp (e1, e2) =>
+        let
+            val (e1, sm) = cifyExp (e1, sm)
+            val (e2, sm) = cifyExp (e2, sm)
+        in
+            ((L'.EApp (e1, e2), loc), sm)
+        end
+
+      | L.ERecord xes =>
+        let
+            val old_xts = map (fn (x, _, t) => (x, t)) xes
+
+            val (xets, sm) = ListUtil.foldlMap (fn ((x, e, t), sm) =>
+                                                  let
+                                                      val (e, sm) = cifyExp (e, sm)
+                                                      val (t, sm) = cifyTyp (t, sm)
+                                                  in
+                                                      ((x, e, t), sm)
+                                                  end)
+                            sm xes
+
+            val (sm, si) = Sm.find (sm, old_xts, map (fn (x, _, t) => (x, t)) xets)
+
+            val xes = map (fn (x, e, _) => (x, e)) xets
+            val xes = ListMergeSort.sort (fn ((x1, _), (x2, _)) => String.compare (x1, x2) = GREATER) xes
+        in
+            ((L'.ERecord (si, xes), loc), sm)
+        end
+      | L.EField (e, x) =>
+        let
+            val (e, sm) = cifyExp (e, sm)
+        in
+            ((L'.EField (e, x), loc), sm)
+        end
+
+      | L.ELet (xes, e) =>
+        let
+            val (xes, sm) = ListUtil.foldlMap (fn ((x, t, e), sm) =>
+                                                  let
+                                                      val (t, sm) = cifyTyp (t, sm)
+                                                      val (e, sm) = cifyExp (e, sm)
+                                                  in
+                                                      ((x, t, e), sm)
+                                                  end)
+                            sm xes
+            val (e, sm) = cifyExp (e, sm)
+        in
+            ((L'.ELet (xes, e), loc), sm)
+        end
+
+fun cifyDecl ((d, loc), sm) =
+    case d of
+        L.DVal (x, n, t, e) =>
+        let
+            val (t, sm) = cifyTyp (t, sm)
+            val (e, sm) = cifyExp (e, sm)
+        in
+            ((L'.DVal (x, n, t, e), loc), sm)
+        end
+      | L.DFun (n, x, dom, ran, e) =>
+        let
+            val (dom, sm) = cifyTyp (dom, sm)
+            val (ran, sm) = cifyTyp (ran, sm)
+            val (e, sm) = cifyExp (e, sm)
+        in
+            ((L'.DFun (n, x, dom, ran, e), loc), sm)
+        end
+
+fun cjrize ds =
+    let
+        val (ds, sm) = ListUtil.foldlMap cifyDecl Sm.empty ds
+    in
+        List.revAppend (map (fn v => (L'.DStruct v, ErrorMsg.dummySpan)) (Sm.declares sm),
+                        ds)
+    end
+
+end
diff --git a/src/cloconv.sml b/src/cloconv.sml
index fdf05363..93563010 100644
--- a/src/cloconv.sml
+++ b/src/cloconv.sml
@@ -115,13 +115,13 @@ fun ccExp env ((e, loc), D) =
             val (e1, D) = ccExp env (e1, D)
             val (e2, D) = ccExp env (e2, D)
         in
-            ((L'.ELet ([("closure", e1),
-                        ("arg", liftExpInExp 0 e2),
-                        ("code", (L'.EField ((L'.ERel 1, loc), "func"), loc)),
-                        ("env", (L'.EField ((L'.ERel 2, loc), "env"), loc))],
+            ((L'.ELet ([("closure", (L'.TTop, loc), e1),
+                        ("arg", (L'.TTop, loc), liftExpInExp 0 e2),
+                        ("code", (L'.TTop, loc), (L'.EField ((L'.ERel 1, loc), "func"), loc)),
+                        ("env", (L'.TTop, loc), (L'.EField ((L'.ERel 2, loc), "env"), loc))],
                        (L'.EApp ((L'.ERel 1, loc),
-                                 (L'.ERecord [("env", (L'.ERel 0, loc)),
-                                              ("arg", (L'.ERel 2, loc))], loc)), loc)), loc), D)
+                                 (L'.ERecord [("env", (L'.ERel 0, loc), (L'.TTop, loc)),
+                                              ("arg", (L'.ERel 2, loc), (L'.TTop, loc))], loc)), loc)), loc), D)
         end
       | L.EAbs (x, dom, ran, e) =>
         let
@@ -145,25 +145,27 @@ fun ccExp env ((e, loc), D) =
                                  subExpInExp (n, (L'.EField ((L'.ERel 1, loc), "fv" ^ Int.toString n), loc)) e)
                              e ns
             (*val () = Print.preface (" After", FlatPrint.p_exp FlatEnv.basis body)*)
-            val body = (L'.ELet ([("env", (L'.EField ((L'.ERel 0, loc), "env"), loc)),
-                                  ("arg", (L'.EField ((L'.ERel 1, loc), "arg"), loc))],
+            val body = (L'.ELet ([("env", (L'.TTop, loc), (L'.EField ((L'.ERel 0, loc), "env"), loc)),
+                                  ("arg", (L'.TTop, loc), (L'.EField ((L'.ERel 1, loc), "arg"), loc))],
                                  body), loc)
                               
             val envT = (L'.TRecord (map (fn n => ("fv" ^ Int.toString n, #2 (E.lookupERel env (n-1)))) ns), loc)
             val (D, fi) = Ds.func D (x, (L'.TRecord [("env", envT), ("arg", dom)], loc), ran, body)
         in
-            ((L'.ERecord [("code", (L'.ECode fi, loc)),
+            ((L'.ERecord [("code", (L'.ECode fi, loc), (L'.TTop, loc)),
                           ("env", (L'.ERecord (map (fn n => ("fv" ^ Int.toString n,
-                                                             (L'.ERel (n-1), loc))) ns), loc))], loc), D)
+                                                             (L'.ERel (n-1), loc),
+                                                             #2 (E.lookupERel env (n-1)))) ns), loc),
+                           envT)], loc), D)
         end
 
       | L.ERecord xes =>
         let
-            val (xes, D) = ListUtil.foldlMap (fn ((x, e), D) =>
+            val (xes, D) = ListUtil.foldlMap (fn ((x, e, t), D) =>
                                                  let
                                                      val (e, D) = ccExp env (e, D)
                                                  in
-                                                     ((x, e), D)
+                                                     ((x, e, ccTyp t), D)
                                                  end) D xes
         in
             ((L'.ERecord xes, loc), D)
diff --git a/src/compiler.sig b/src/compiler.sig
index 7faa85de..3c9eea8b 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -29,6 +29,8 @@
 
 signature COMPILER = sig
 
+    val compile : string -> unit
+
     val parse : string -> Source.file option
     val elaborate : ElabEnv.env -> string -> (ElabEnv.env * Elab.file) option
     val corify : ElabEnv.env -> CoreEnv.env -> string -> Core.file option
@@ -36,6 +38,7 @@ signature COMPILER = sig
     val shake : ElabEnv.env -> CoreEnv.env -> string -> Core.file option
     val monoize : ElabEnv.env -> CoreEnv.env -> string -> Mono.file option
     val cloconv : ElabEnv.env -> CoreEnv.env -> string -> Flat.file option
+    val cjrize : ElabEnv.env -> CoreEnv.env -> string -> Cjr.file option
 
     val testParse : string -> unit
     val testElaborate : string -> unit
@@ -44,5 +47,6 @@ signature COMPILER = sig
     val testShake : string -> unit
     val testMonoize : string -> unit
     val testCloconv : string -> unit
+    val testCjrize : string -> unit
 
 end
diff --git a/src/compiler.sml b/src/compiler.sml
index 26ff6e2b..4276ed46 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -112,6 +112,15 @@ fun cloconv eenv cenv filename =
         else
             SOME (Cloconv.cloconv file)
 
+fun cjrize eenv cenv filename =
+    case cloconv eenv cenv filename of
+        NONE => NONE
+      | SOME file =>
+        if ErrorMsg.anyErrors () then
+            NONE
+        else
+            SOME (Cjrize.cjrize file)
+
 fun testParse filename =
     case parse filename of
         NONE => print "Failed\n"
@@ -173,4 +182,25 @@ fun testCloconv filename =
     handle FlatEnv.UnboundNamed n =>
            print ("Unbound named " ^ Int.toString n ^ "\n")
 
+fun testCjrize filename =
+    (case cjrize ElabEnv.basis CoreEnv.basis filename of
+         NONE => print "Failed\n"
+       | SOME file =>
+         (Print.print (CjrPrint.p_file CjrEnv.basis file);
+          print "\n"))
+    handle CjrEnv.UnboundNamed n =>
+           print ("Unbound named " ^ Int.toString n ^ "\n")
+
+fun compile filename =
+    case cjrize ElabEnv.basis CoreEnv.basis filename of
+        NONE => ()
+      | SOME file =>
+        let
+            val outf = TextIO.openOut "/tmp/lacweb.c"
+            val s = TextIOPP.openOut {dst = outf, wid = 80}
+        in
+            Print.fprint s (CjrPrint.p_file CjrEnv.basis file);
+            TextIO.closeOut outf
+        end
+
 end
diff --git a/src/core.sml b/src/core.sml
index ca64959e..fa06f56a 100644
--- a/src/core.sml
+++ b/src/core.sml
@@ -63,7 +63,7 @@ datatype exp' =
        | ECApp of exp * con
        | ECAbs of string * kind * exp
 
-       | ERecord of (con * exp) list
+       | ERecord of (con * exp * con) list
        | EField of exp * con * { field : con, rest : con }
 
 withtype exp = exp' located
diff --git a/src/core_print.sml b/src/core_print.sml
index 5b020d84..a219ac4d 100644
--- a/src/core_print.sml
+++ b/src/core_print.sml
@@ -184,7 +184,7 @@ fun p_exp' par env (e, _) =
                                              p_exp (E.pushCRel env x k) e])
 
       | ERecord xes => box [string "{",
-                            p_list (fn (x, e) =>
+                            p_list (fn (x, e, _) =>
                                        box [p_name env x,
                                             space,
                                             string "=",
diff --git a/src/core_util.sml b/src/core_util.sml
index a9d022b6..8d9a6529 100644
--- a/src/core_util.sml
+++ b/src/core_util.sml
@@ -245,12 +245,14 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, bind} =
                                  (ECAbs (x, k', e'), loc)))
 
               | ERecord xes =>
-                S.map2 (ListUtil.mapfold (fn (x, e) =>
+                S.map2 (ListUtil.mapfold (fn (x, e, t) =>
                                              S.bind2 (mfc ctx x,
                                                    fn x' =>
-                                                      S.map2 (mfe ctx e,
-                                                           fn e' =>
-                                                              (x', e'))))
+                                                      S.bind2 (mfe ctx e,
+                                                            fn e' =>
+                                                               S.map2 (mfc ctx t,
+                                                                    fn t' =>
+                                                                       (x', e', t')))))
                                          xes,
                      fn xes' =>
                         (ERecord xes', loc))
diff --git a/src/corify.sml b/src/corify.sml
index 42fcfe81..f9433cff 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -72,7 +72,7 @@ fun corifyExp (e, loc) =
       | L.ECApp (e1, c) => (L'.ECApp (corifyExp e1, corifyCon c), loc)
       | L.ECAbs (_, x, k, e1) => (L'.ECAbs (x, corifyKind k, corifyExp e1), loc)
 
-      | L.ERecord xes => (L'.ERecord (map (fn (c, e) => (corifyCon c, corifyExp e)) xes), loc)
+      | L.ERecord xes => (L'.ERecord (map (fn (c, e, t) => (corifyCon c, corifyExp e, corifyCon t)) xes), loc)
       | L.EField (e1, c, {field, rest}) => (L'.EField (corifyExp e1, corifyCon c,
                                                        {field = corifyCon field, rest = corifyCon rest}), loc)
 
diff --git a/src/elab.sml b/src/elab.sml
index aac5eddb..ac1b4224 100644
--- a/src/elab.sml
+++ b/src/elab.sml
@@ -73,7 +73,7 @@ datatype exp' =
        | ECApp of exp * con
        | ECAbs of explicitness * string * kind * exp
 
-       | ERecord of (con * exp) list
+       | ERecord of (con * exp * con) list
        | EField of exp * con * { field : con, rest : con }
 
        | EError
diff --git a/src/elab_print.sml b/src/elab_print.sml
index 0611730c..37648068 100644
--- a/src/elab_print.sml
+++ b/src/elab_print.sml
@@ -199,7 +199,7 @@ fun p_exp' par env (e, _) =
                                                   p_exp (E.pushCRel env x k) e])
 
       | ERecord xes => box [string "{",
-                            p_list (fn (x, e) =>
+                            p_list (fn (x, e, _) =>
                                        box [p_name env x,
                                             space,
                                             string "=",
diff --git a/src/elab_util.sml b/src/elab_util.sml
index 1f204dce..39020652 100644
--- a/src/elab_util.sml
+++ b/src/elab_util.sml
@@ -237,12 +237,14 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, bind} =
                                  (ECAbs (expl, x, k', e'), loc)))
 
               | ERecord xes =>
-                S.map2 (ListUtil.mapfold (fn (x, e) =>
+                S.map2 (ListUtil.mapfold (fn (x, e, t) =>
                                              S.bind2 (mfc ctx x,
                                                    fn x' =>
-                                                      S.map2 (mfe ctx e,
+                                                      S.bind2 (mfe ctx e,
                                                            fn e' =>
-                                                              (x', e'))))
+                                                              S.map2 (mfc ctx t,
+                                                                   fn t' =>
+                                                                      (x', e', t')))))
                                          xes,
                      fn xes' =>
                         (ERecord xes', loc))
diff --git a/src/elaborate.sml b/src/elaborate.sml
index c89bc8e0..d6e1f287 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -704,7 +704,7 @@ fun typeof env (e, loc) =
            | _ => raise Fail "typeof: Bad ECApp")
       | L'.ECAbs (expl, x, k, e1) => (L'.TCFun (expl, x, k, typeof (E.pushCRel env x k) e1), loc)
 
-      | L'.ERecord xes => (L'.TRecord (L'.CRecord (ktype, map (fn (x, e) => (x, typeof env e)) xes), loc), loc)
+      | L'.ERecord xes => (L'.TRecord (L'.CRecord (ktype, map (fn (x, _, t) => (x, t)) xes), loc), loc)
       | L'.EField (_, _, {field, ...}) => field
 
       | L'.EError => cerror
@@ -821,7 +821,7 @@ fun elabExp env (e, loc) =
                                    (x', e', et)
                                end) xes
         in
-            ((L'.ERecord (map (fn (x', e', _) => (x', e')) xes'), loc),
+            ((L'.ERecord xes', loc),
              (L'.TRecord (L'.CRecord (ktype, map (fn (x', _, et) => (x', et)) xes'), loc), loc))
         end
 
diff --git a/src/flat.sml b/src/flat.sml
index 543cd42f..55c7397a 100644
--- a/src/flat.sml
+++ b/src/flat.sml
@@ -30,7 +30,8 @@ structure Flat = struct
 type 'a located = 'a ErrorMsg.located
 
 datatype typ' =
-         TFun of typ * typ
+         TTop
+       | TFun of typ * typ
        | TCode of typ * typ
        | TRecord of (string * typ) list
        | TNamed of int
@@ -44,10 +45,10 @@ datatype exp' =
        | ECode of int
        | EApp of exp * exp
 
-       | ERecord of (string * exp) list
+       | ERecord of (string * exp * typ) list
        | EField of exp * string
 
-       | ELet of (string * exp) list * exp
+       | ELet of (string * typ * exp) list * exp
 
 withtype exp = exp' located
 
diff --git a/src/flat_print.sig b/src/flat_print.sig
index 1271e811..627bfee9 100644
--- a/src/flat_print.sig
+++ b/src/flat_print.sig
@@ -35,4 +35,3 @@ signature FLAT_PRINT = sig
 
     val debug : bool ref
 end
-
diff --git a/src/flat_print.sml b/src/flat_print.sml
index c3aedde5..612291c0 100644
--- a/src/flat_print.sml
+++ b/src/flat_print.sml
@@ -42,7 +42,8 @@ val dummyTyp = (TNamed 0, ErrorMsg.dummySpan)
 
 fun p_typ' par env (t, _) =
     case t of
-        TFun (t1, t2) => parenIf par (box [p_typ' true env t1,
+        TTop => string "?"
+      | TFun (t1, t2) => parenIf par (box [p_typ' true env t1,
                                            space,
                                            string "->",
                                            space,
@@ -88,7 +89,7 @@ fun p_exp' par env (e, _) =
                                            p_exp' true env e2])
 
       | ERecord xes => box [string "{",
-                            p_list (fn (x, e) =>
+                            p_list (fn (x, e, _) =>
                                        box [string x,
                                             space,
                                             string "=",
@@ -102,7 +103,7 @@ fun p_exp' par env (e, _) =
 
       | ELet (xes, e) =>
         let
-            val (env, pps) = foldl (fn ((x, e), (env, pps)) =>
+            val (env, pps) = foldl (fn ((x, _, e), (env, pps)) =>
                                        (E.pushERel env x dummyTyp,
                                         List.revAppend ([space,
                                                         string "val",
diff --git a/src/flat_util.sml b/src/flat_util.sml
index e9656f5b..6bddd566 100644
--- a/src/flat_util.sml
+++ b/src/flat_util.sml
@@ -48,7 +48,8 @@ fun joinL f (os1, os2) =
 
 fun compare ((t1, _), (t2, _)) =
     case (t1, t2) of
-        (TFun (d1, r1), TFun (d2, r2)) =>
+        (TTop, TTop) => EQUAL
+      | (TFun (d1, r1), TFun (d2, r2)) =>
         join (compare (d1, d2), fn () => compare (r1, r2))
       | (TCode (d1, r1), TCode (d2, r2)) =>
         join (compare (d1, d2), fn () => compare (r1, r2))
@@ -61,6 +62,9 @@ fun compare ((t1, _), (t2, _)) =
         end
       | (TNamed n1, TNamed n2) => Int.compare (n1, n2)
 
+      | (TTop, _) => LESS
+      | (_, TTop) => GREATER
+
       | (TFun _, _) => LESS
       | (_, TFun _) => GREATER
 
@@ -83,7 +87,8 @@ fun mapfold fc =
 
         and mft' (cAll as (c, loc)) =
             case c of
-                TFun (t1, t2) =>
+                TTop => S.return2 cAll
+              | TFun (t1, t2) =>
                 S.bind2 (mft t1,
                       fn t1' =>
                          S.map2 (mft t2,
@@ -156,10 +161,12 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                                 (EApp (e1', e2'), loc)))
 
               | ERecord xes =>
-                S.map2 (ListUtil.mapfold (fn (x, e) =>
-                                             S.map2 (mfe ctx e,
+                S.map2 (ListUtil.mapfold (fn (x, e, t) =>
+                                             S.bind2 (mfe ctx e,
                                                   fn e' =>
-                                                     (x, e')))
+                                                     S.map2 (mft t,
+                                                          fn t' =>
+                                                             (x, e', t'))))
                                          xes,
                      fn xes' =>
                         (ERecord xes', loc))
@@ -169,10 +176,12 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                          (EField (e', x), loc))
 
               | ELet (xes, e) =>
-                S.bind2 (ListUtil.mapfold (fn (x, e) =>
-                                              S.map2 (mfe ctx e,
-                                                   fn e' =>
-                                                      (x, e')))
+                S.bind2 (ListUtil.mapfold (fn (x, t, e) =>
+                                              S.bind2 (mft t,
+                                                       fn t' =>
+                                                          S.map2 (mfe ctx e,
+                                                               fn e' =>
+                                                                  (x, t', e'))))
                                           xes,
                       fn xes' =>
                          S.map2 (mfe ctx e,
diff --git a/src/mono.sml b/src/mono.sml
index a23ec958..c94c3a46 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -43,7 +43,7 @@ datatype exp' =
        | EApp of exp * exp
        | EAbs of string * typ * typ * exp
 
-       | ERecord of (string * exp) list
+       | ERecord of (string * exp * typ) list
        | EField of exp * string
 
 withtype exp = exp' located
diff --git a/src/mono_print.sml b/src/mono_print.sml
index b8b73e17..6b259b7c 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -90,7 +90,7 @@ fun p_exp' par env (e, _) =
                                                p_exp (E.pushERel env x t) e])
 
       | ERecord xes => box [string "{",
-                            p_list (fn (x, e) =>
+                            p_list (fn (x, e, _) =>
                                        box [string x,
                                             space,
                                             string "=",
diff --git a/src/mono_util.sml b/src/mono_util.sml
index 8decf033..bbfd5842 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -114,10 +114,12 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                                           (EAbs (x, dom', ran', e'), loc))))
 
               | ERecord xes =>
-                S.map2 (ListUtil.mapfold (fn (x, e) =>
-                                             S.map2 (mfe ctx e,
+                S.map2 (ListUtil.mapfold (fn (x, e, t) =>
+                                             S.bind2 (mfe ctx e,
                                                   fn e' =>
-                                                     (x, e')))
+                                                     S.map2 (mft t,
+                                                             fn t' =>
+                                                                (x, e', t'))))
                                          xes,
                      fn xes' =>
                         (ERecord xes', loc))
diff --git a/src/monoize.sml b/src/monoize.sml
index b38bd5c0..c3e9e806 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -91,7 +91,7 @@ fun monoExp env (all as (e, loc)) =
           | L.ECApp _ => poly ()
           | L.ECAbs _ => poly ()
 
-          | L.ERecord xes => (L'.ERecord (map (fn (x, e) => (monoName env x, monoExp env e)) xes), loc)
+          | L.ERecord xes => (L'.ERecord (map (fn (x, e, t) => (monoName env x, monoExp env e, monoType env t)) xes), loc)
           | L.EField (e, x, _) => (L'.EField (monoExp env e, monoName env x), loc)
     end
 
diff --git a/src/print.sig b/src/print.sig
index 39daf5d0..07b8c1e2 100644
--- a/src/print.sig
+++ b/src/print.sig
@@ -30,6 +30,8 @@
 signature PRINT = sig
     structure PD : PP_DESC
                        where type PPS.token = string
+          and type PPS.device = TextIOPP.device
+          and type PPS.stream = TextIOPP.stream
 
     type 'a printer = 'a -> PD.pp_desc
 
diff --git a/src/reduce.sml b/src/reduce.sml
index d5449bac..c4397743 100644
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -145,9 +145,9 @@ fun exp env e =
         #1 (reduceExp env (subConInExp (0, c) e1))
 
       | EField ((ERecord xes, _), (CName x, _), _) =>
-        (case List.find (fn ((CName x', _), _) => x' = x
+        (case List.find (fn ((CName x', _), _, _) => x' = x
                           | _ => false) xes of
-             SOME (_, e) => #1 e
+             SOME (_, e, _) => #1 e
            | NONE => e)
 
       | _ => e
diff --git a/src/sources b/src/sources
index 83a6316c..8f1023d0 100644
--- a/src/sources
+++ b/src/sources
@@ -83,5 +83,16 @@ flat_print.sml
 cloconv.sig
 cloconv.sml
 
+cjr.sml
+
+cjr_env.sig
+cjr_env.sml
+
+cjr_print.sig
+cjr_print.sml
+
+cjrize.sig
+cjrize.sml
+
 compiler.sig
 compiler.sml