Monoize

10 files changed, 584 insertions, 3 deletions

diff --git a/src/compiler.sig b/src/compiler.sig
index c06ac765..3e6ed1a3 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -34,11 +34,13 @@ signature COMPILER = sig
     val corify : ElabEnv.env -> CoreEnv.env -> string -> Core.file option
     val reduce : ElabEnv.env -> CoreEnv.env -> string -> Core.file option
     val shake : ElabEnv.env -> CoreEnv.env -> string -> Core.file option
+    val monoize : ElabEnv.env -> CoreEnv.env -> string -> Mono.file option
 
     val testParse : string -> unit
     val testElaborate : string -> unit
     val testCorify : string -> unit
     val testReduce : string -> unit
     val testShake : string -> unit
+    val testMonoize : string -> unit
 
 end
diff --git a/src/compiler.sml b/src/compiler.sml
index 45fd88e4..20eb3ef5 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -70,17 +70,38 @@ fun elaborate env filename =
 fun corify eenv cenv filename =
     case elaborate eenv filename of
         NONE => NONE
-      | SOME (_, file) => SOME (Corify.corify file)
+      | SOME (_, file) =>
+        if ErrorMsg.anyErrors () then
+            NONE
+        else
+            SOME (Corify.corify file)
 
 fun reduce eenv cenv filename =
     case corify eenv cenv filename of
         NONE => NONE
-      | SOME file => SOME (Reduce.reduce (Shake.shake file))
+      | SOME file =>
+        if ErrorMsg.anyErrors () then
+            NONE
+        else
+            SOME (Reduce.reduce (Shake.shake file))
 
 fun shake eenv cenv filename =
     case reduce eenv cenv filename of
         NONE => NONE
-      | SOME file => SOME (Shake.shake file)
+      | SOME file =>
+        if ErrorMsg.anyErrors () then
+            NONE
+        else
+            SOME (Shake.shake file)
+
+fun monoize eenv cenv filename =
+    case shake eenv cenv filename of
+        NONE => NONE
+      | SOME file =>
+        if ErrorMsg.anyErrors () then
+            NONE
+        else
+            SOME (Monoize.monoize cenv file)
 
 fun testParse filename =
     case parse filename of
@@ -125,4 +146,13 @@ fun testShake filename =
     handle CoreEnv.UnboundNamed n =>
            print ("Unbound named " ^ Int.toString n ^ "\n")
 
+fun testMonoize filename =
+    (case monoize ElabEnv.basis CoreEnv.basis filename of
+         NONE => print "Failed\n"
+       | SOME file =>
+         (Print.print (MonoPrint.p_file MonoEnv.basis file);
+          print "\n"))
+    handle MonoEnv.UnboundNamed n =>
+           print ("Unbound named " ^ Int.toString n ^ "\n")
+
 end
diff --git a/src/mono.sml b/src/mono.sml
new file mode 100644
index 00000000..7a4b54ee
--- /dev/null
+++ b/src/mono.sml
@@ -0,0 +1,58 @@
+(* 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 Mono = struct
+
+type 'a located = 'a ErrorMsg.located
+
+datatype typ' =
+         TFun of typ * typ
+       | TRecord of (string * typ) list
+       | TNamed of int
+
+withtype typ = typ' located
+
+datatype exp' =
+         EPrim of Prim.t
+       | ERel of int
+       | ENamed of int
+       | EApp of exp * exp
+       | EAbs of string * typ * exp
+
+       | ERecord of (string * exp) list
+       | EField of exp * string
+
+withtype exp = exp' located
+
+datatype decl' =
+         DVal of string * int * typ * exp
+
+withtype decl = decl' located
+
+type file = decl list
+
+end
diff --git a/src/mono_env.sig b/src/mono_env.sig
new file mode 100644
index 00000000..f3936998
--- /dev/null
+++ b/src/mono_env.sig
@@ -0,0 +1,49 @@
+(* 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 MONO_ENV = sig
+
+    type env
+
+    val empty : env
+    val basis : env
+
+    exception UnboundRel of int
+    exception UnboundNamed of int
+
+    val pushTNamed : env -> string -> int -> Mono.typ option -> env
+    val lookupTNamed : env -> int -> string * Mono.typ option
+
+    val pushERel : env -> string -> Mono.typ -> env
+    val lookupERel : env -> int -> string * Mono.typ
+
+    val pushENamed : env -> string -> int -> Mono.typ -> Mono.exp option -> env
+    val lookupENamed : env -> int -> string * Mono.typ * Mono.exp option
+
+    val declBinds : env -> Mono.decl -> env
+                                                 
+end
diff --git a/src/mono_env.sml b/src/mono_env.sml
new file mode 100644
index 00000000..60c6f609
--- /dev/null
+++ b/src/mono_env.sml
@@ -0,0 +1,99 @@
+(* 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 MonoEnv :> MONO_ENV = struct
+
+open Mono
+
+structure IM = IntBinaryMap
+
+
+exception UnboundRel of int
+exception UnboundNamed of int
+
+type env = {
+     namedT : (string * typ option) IM.map,
+
+     relE : (string * typ) list,
+     namedE : (string * typ * exp option) IM.map
+}
+
+val empty = {
+    namedT = IM.empty,
+
+    relE = [],
+    namedE = IM.empty
+}
+
+fun pushTNamed (env : env) x n co =
+    {namedT = IM.insert (#namedT env, n, (x, co)),
+
+     relE = #relE env,
+     namedE = #namedE 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,
+
+     relE = (x, t) :: #relE env,
+     namedE = #namedE env}
+
+fun lookupERel (env : env) n =
+    (List.nth (#relE env, n))
+    handle Subscript => raise UnboundRel n
+
+fun pushENamed (env : env) x n t eo =
+    {namedT = #namedT env,
+
+     relE = #relE env,
+     namedE = IM.insert (#namedE env, n, (x, t, eo))}
+
+fun lookupENamed (env : env) n =
+    case IM.find (#namedE env, n) of
+        NONE => raise UnboundNamed n
+      | SOME x => x
+
+fun declBinds env (d, _) =
+    case d of
+        DVal (x, n, t, e) => pushENamed env x n t (SOME e)
+
+fun bbind env x =
+    case ElabEnv.lookupC ElabEnv.basis x of
+        ElabEnv.NotBound => raise Fail "MonoEnv.bbind: Not bound"
+      | ElabEnv.Rel _ => raise Fail "MonoEnv.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/mono_print.sig b/src/mono_print.sig
new file mode 100644
index 00000000..6f7f09a9
--- /dev/null
+++ b/src/mono_print.sig
@@ -0,0 +1,38 @@
+(* 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 monomorphic language *)
+
+signature MONO_PRINT = sig
+    val p_typ : MonoEnv.env -> Mono.typ Print.printer
+    val p_exp : MonoEnv.env -> Mono.exp Print.printer
+    val p_decl : MonoEnv.env -> Mono.decl Print.printer
+    val p_file : MonoEnv.env -> Mono.file Print.printer
+
+    val debug : bool ref
+end
+
diff --git a/src/mono_print.sml b/src/mono_print.sml
new file mode 100644
index 00000000..a23296f9
--- /dev/null
+++ b/src/mono_print.sml
@@ -0,0 +1,141 @@
+(* 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 monomorphic Laconic/Web *)
+
+structure MonoPrint :> MONO_PRINT = struct
+
+open Print.PD
+open Print
+
+open Mono
+
+structure E = MonoEnv
+
+val debug = ref false
+
+fun p_typ' par env (t, _) =
+    case t of
+        TFun (t1, t2) => parenIf par (box [p_typ' true env t1,
+                                           space,
+                                           string "->",
+                                           space,
+                                           p_typ env t2])
+      | TRecord xcs => box [string "{",
+                            p_list (fn (x, t) =>
+                                       box [string x,
+                                            space,
+                                            string ":",
+                                            space,
+                                            p_typ env t]) xcs,
+                            string "}"]
+      | TNamed n =>
+        if !debug then
+            string (#1 (E.lookupTNamed env n) ^ "__" ^ Int.toString n)
+        else
+            string (#1 (E.lookupTNamed env n))
+
+and p_typ env = p_typ' false env
+
+fun p_exp' par env (e, _) =
+    case e of
+        EPrim p => Prim.p_t p
+      | ERel n =>
+        if !debug then
+            string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n)
+        else
+            string (#1 (E.lookupERel env n))
+      | ENamed n =>
+        if !debug then
+            string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n)
+        else
+            string (#1 (E.lookupENamed env n))
+      | EApp (e1, e2) => parenIf par (box [p_exp env e1,
+                                           space,
+                                           p_exp' true env e2])
+      | EAbs (x, t, e) => parenIf par (box [string "fn",
+                                            space,
+                                            string x,
+                                            space,
+                                            string ":",
+                                            space,
+                                            p_typ env t,
+                                            space,
+                                            string "=>",
+                                            space,
+                                            p_exp (E.pushERel env x t) e])
+
+      | ERecord xes => box [string "{",
+                            p_list (fn (x, e) =>
+                                       box [string x,
+                                            space,
+                                            string "=",
+                                            space,
+                                            p_exp env e]) xes,
+                            string "}"]
+      | EField (e, x) =>
+        box [p_exp' true env e,
+             string ".",
+             string x]
+
+and p_exp env = p_exp' false env
+
+fun p_decl env ((d, _) : decl) =
+    case d of
+        DVal (x, n, t, e) =>
+        let
+            val xp = if !debug then
+                         box [string x,
+                              string "__",
+                              string (Int.toString n)]
+                     else
+                         string x        
+        in
+            box [string "val",
+                 space,
+                 xp,
+                 space,
+                 string ":",
+                 space,
+                 p_typ env t,
+                 space,
+                 string "=",
+                 space,
+                 p_exp env e]
+        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/monoize.sig b/src/monoize.sig
new file mode 100644
index 00000000..0e9c23c3
--- /dev/null
+++ b/src/monoize.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 MONOIZE = sig
+
+    val monoize : CoreEnv.env -> Core.file -> Mono.file
+
+end
diff --git a/src/monoize.sml b/src/monoize.sml
new file mode 100644
index 00000000..e72d7b1b
--- /dev/null
+++ b/src/monoize.sml
@@ -0,0 +1,121 @@
+(* 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 Monoize :> MONOIZE = struct
+
+structure E = ErrorMsg
+structure Env = CoreEnv
+
+structure L = Core
+structure L' = Mono
+
+val dummyTyp = (L'.TNamed 0, E.dummySpan)
+
+fun monoName env (all as (c, loc)) =
+    let
+        fun poly () =
+            (E.errorAt loc "Unsupported name constructor";
+             Print.eprefaces' [("Constructor", CorePrint.p_con env all)];
+             "")
+    in
+        case c of
+            L.CName s => s
+          | _ => poly ()
+    end
+
+fun monoType env (all as (c, loc)) =
+    let
+        fun poly () =
+            (E.errorAt loc "Unsupported type constructor";
+             Print.eprefaces' [("Constructor", CorePrint.p_con env all)];
+             dummyTyp)
+    in
+        case c of
+            L.TFun (c1, c2) => (L'.TFun (monoType env c1, monoType env c2), loc)
+          | L.TCFun _ => poly ()
+          | L.TRecord (L.CRecord ((L.KType, _), xcs), _) =>
+            (L'.TRecord (map (fn (x, t) => (monoName env x, monoType env t)) xcs), loc)
+          | L.TRecord _ => poly ()
+
+          | L.CRel _ => poly ()
+          | L.CNamed n => (L'.TNamed n, loc)
+          | L.CApp _ => poly ()
+          | L.CAbs _ => poly ()
+
+          | L.CName _ => poly ()
+
+          | L.CRecord _ => poly ()
+          | L.CConcat _ => poly ()
+    end
+
+val dummyExp = (L'.EPrim (Prim.Int 0), E.dummySpan)
+
+fun monoExp env (all as (e, loc)) =
+    let
+        fun poly () =
+            (E.errorAt loc "Unsupported expression";
+             Print.eprefaces' [("Expression", CorePrint.p_exp env all)];
+             dummyExp)
+    in
+        case e of
+            L.EPrim p => (L'.EPrim p, loc)
+          | L.ERel n => (L'.ERel n, loc)
+          | L.ENamed n => (L'.ENamed n, loc)
+          | L.EApp (e1, e2) => (L'.EApp (monoExp env e1, monoExp env e2), loc)
+          | L.EAbs (x, t, e) =>
+            (L'.EAbs (x, monoType env t, monoExp (Env.pushERel env x t) 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.EField (e, x, _) => (L'.EField (monoExp env e, monoName env x), loc)
+    end
+
+fun monoDecl env (all as (d, loc)) =
+    let
+        fun poly () =
+            (E.errorAt loc "Unsupported declaration";
+             Print.eprefaces' [("Declaration", CorePrint.p_decl env all)];
+             NONE)
+    in
+        case d of
+            L.DCon _ => NONE
+          | L.DVal (x, n, t, e) => SOME (Env.pushENamed env x n t (SOME e),
+                                         (L'.DVal (x, n, monoType env t, monoExp env e), loc))
+    end
+
+fun monoize env ds =
+    let
+        val (_, ds) = List.foldl (fn (d, (env, ds)) =>
+                                     case monoDecl env d of
+                                         NONE => (env, ds)
+                                       | SOME (env, d) => (env, d :: ds)) (env, []) ds
+    in
+        rev ds
+    end
+
+end
diff --git a/src/sources b/src/sources
index f10e0e90..adcda7e9 100644
--- a/src/sources
+++ b/src/sources
@@ -55,5 +55,16 @@ reduce.sml
 shake.sig
 shake.sml
 
+mono.sml
+
+monoize.sig
+monoize.sml
+
+mono_env.sig
+mono_env.sml
+
+mono_print.sig
+mono_print.sml
+
 compiler.sig
 compiler.sml