Mercurial > urweb
diff src/compiler.sml @ 193:8a70e2919e86
Specialization of single-parameter datatypes
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Fri, 08 Aug 2008 17:55:51 -0400 |
parents | 88d46972de53 |
children | f2cac0dba9bf |
line wrap: on
line diff
--- a/src/compiler.sml Fri Aug 08 10:59:06 2008 -0400 +++ b/src/compiler.sml Fri Aug 08 17:55:51 2008 -0400 @@ -214,10 +214,19 @@ if ErrorMsg.anyErrors () then NONE else - SOME (Reduce.reduce (Shake.shake file)) + SOME (Reduce.reduce file) + +fun specialize job = + case reduce job of + NONE => NONE + | SOME file => + if ErrorMsg.anyErrors () then + NONE + else + SOME (Specialize.specialize file) fun shake job = - case reduce job of + case specialize job of NONE => NONE | SOME file => if ErrorMsg.anyErrors () then @@ -332,8 +341,8 @@ handle CoreEnv.UnboundNamed n => print ("Unbound named " ^ Int.toString n ^ "\n") -fun testTag job = - (case tag job of +fun testReduce job = + (case reduce job of NONE => print "Failed\n" | SOME file => (Print.print (CorePrint.p_file CoreEnv.empty file); @@ -341,8 +350,17 @@ handle CoreEnv.UnboundNamed n => print ("Unbound named " ^ Int.toString n ^ "\n") -fun testReduce job = - (case reduce job of +fun testSpecialize job = + (case specialize job of + NONE => print "Failed\n" + | SOME file => + (Print.print (CorePrint.p_file CoreEnv.empty file); + print "\n")) + handle CoreEnv.UnboundNamed n => + print ("Unbound named " ^ Int.toString n ^ "\n") + +fun testTag job = + (case tag job of NONE => print "Failed\n" | SOME file => (Print.print (CorePrint.p_file CoreEnv.empty file);