diff src/compiler.sml @ 25:0a762c73824d

Monoize
author Adam Chlipala <adamc@hcoop.net>
date Tue, 10 Jun 2008 13:14:45 -0400
parents ea15905e598d
children 4ab19c19665f
line wrap: on
line diff
--- a/src/compiler.sml	Sun Jun 08 17:21:31 2008 -0400
+++ b/src/compiler.sml	Tue Jun 10 13:14:45 2008 -0400
@@ -70,17 +70,38 @@
 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 @@
     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