# HG changeset patch # User Adam Chlipala # Date 1218567305 14400 # Node ID af5bd54cbbd704e2934da722fb337bfcbf45034e # Parent f2cac0dba9bfdc2c173f74aa91e82590423d430d Finish moving all phases to the new interface diff -r f2cac0dba9bf -r af5bd54cbbd7 src/compiler.sig --- a/src/compiler.sig Tue Aug 12 14:40:07 2008 -0400 +++ b/src/compiler.sig Tue Aug 12 14:55:05 2008 -0400 @@ -30,7 +30,7 @@ signature COMPILER = sig type job = string list - (*val compile : job -> unit*) + val compile : job -> unit val compileC : {cname : string, oname : string, ename : string} -> unit type ('src, 'dst) phase @@ -51,10 +51,32 @@ val elaborate : (Source.file, Elab.file) phase val explify : (Elab.file, Expl.file) phase val corify : (Expl.file, Core.file) phase + val shake : (Core.file, Core.file) phase + val tag : (Core.file, Core.file) phase + val reduce : (Core.file, Core.file) phase + val specialize : (Core.file, Core.file) phase + val monoize : (Core.file, Mono.file) phase + val mono_opt : (Mono.file, Mono.file) phase + val untangle : (Mono.file, Mono.file) phase + val mono_reduce : (Mono.file, Mono.file) phase + val mono_shake : (Mono.file, Mono.file) phase + val cjrize : (Mono.file, Cjr.file) phase val toParse : (job, Source.file) transform val toElaborate : (job, Elab.file) transform val toExplify : (job, Expl.file) transform - val toCorify : (job, Core.file) transform + val toCorify : (job, Core.file) transform + val toShake1 : (job, Core.file) transform + val toTag : (job, Core.file) transform + val toReduce : (job, Core.file) transform + val toSpecialize : (job, Core.file) transform + val toShake2 : (job, Core.file) transform + val toMonoize : (job, Mono.file) transform + val toMono_opt1 : (job, Mono.file) transform + val toUntangle : (job, Mono.file) transform + val toMono_reduce : (job, Mono.file) transform + val toMono_shake : (job, Mono.file) transform + val toMono_opt2 : (job, Mono.file) transform + val toCjrize : (job, Cjr.file) transform end diff -r f2cac0dba9bf -r af5bd54cbbd7 src/compiler.sml --- a/src/compiler.sml Tue Aug 12 14:40:07 2008 -0400 +++ b/src/compiler.sml Tue Aug 12 14:55:05 2008 -0400 @@ -257,256 +257,79 @@ val toCorify = toExplify o transform corify "corify" -(*fun shake' job = - case corify job of - NONE => NONE - | SOME file => - if ErrorMsg.anyErrors () then - NONE - else - SOME (Shake.shake file) +val shake = { + func = Shake.shake, + print = CorePrint.p_file CoreEnv.empty +} -fun tag job = - case shake' job of - NONE => NONE - | SOME file => - if ErrorMsg.anyErrors () then - NONE - else - SOME (Tag.tag file) +val toShake1 = toCorify o transform shake "shake1" -fun reduce job = - case tag job of - NONE => NONE - | SOME file => - if ErrorMsg.anyErrors () then - NONE - else - SOME (Reduce.reduce file) +val tag = { + func = Tag.tag, + print = CorePrint.p_file CoreEnv.empty +} -fun specialize job = - case reduce job of - NONE => NONE - | SOME file => - if ErrorMsg.anyErrors () then - NONE - else - SOME (Specialize.specialize file) +val toTag = toShake1 o transform tag "tag" -fun shake job = - case specialize job of - NONE => NONE - | SOME file => - if ErrorMsg.anyErrors () then - NONE - else - SOME (Shake.shake file) +val reduce = { + func = Reduce.reduce, + print = CorePrint.p_file CoreEnv.empty +} -fun monoize job = - case shake job of - NONE => NONE - | SOME file => - if ErrorMsg.anyErrors () then - NONE - else - SOME (Monoize.monoize CoreEnv.empty file) +val toReduce = toTag o transform reduce "reduce" -fun mono_opt' job = - case monoize job of - NONE => NONE - | SOME file => - if ErrorMsg.anyErrors () then - NONE - else - SOME (MonoOpt.optimize file) +val specialize = { + func = Specialize.specialize, + print = CorePrint.p_file CoreEnv.empty +} -fun untangle job = - case mono_opt' job of - NONE => NONE - | SOME file => - if ErrorMsg.anyErrors () then - NONE - else - SOME (Untangle.untangle file) +val toSpecialize = toReduce o transform specialize "specialize" -fun mono_reduce job = - case untangle job of - NONE => NONE - | SOME file => - if ErrorMsg.anyErrors () then - NONE - else - SOME (MonoReduce.reduce file) +val toShake2 = toSpecialize o transform shake "shake2" -fun mono_shake job = - case mono_reduce job of - NONE => NONE - | SOME file => - if ErrorMsg.anyErrors () then - NONE - else - SOME (MonoShake.shake file) +val monoize = { + func = Monoize.monoize CoreEnv.empty, + print = MonoPrint.p_file MonoEnv.empty +} -fun mono_opt job = - case mono_shake job of - NONE => NONE - | SOME file => - if ErrorMsg.anyErrors () then - NONE - else - SOME (MonoOpt.optimize file) +val toMonoize = toShake2 o transform monoize "monoize" -fun cjrize job = - case mono_opt job of - NONE => NONE - | SOME file => - if ErrorMsg.anyErrors () then - NONE - else - SOME (Cjrize.cjrize file) +val mono_opt = { + func = MonoOpt.optimize, + print = MonoPrint.p_file MonoEnv.empty +} -fun testParse job = - case parse job of - NONE => print "Failed\n" - | SOME file => - (Print.print (SourcePrint.p_file file); - print "\n") +val toMono_opt1 = toMonoize o transform mono_opt "mono_opt1" -fun testElaborate job = - (case elaborate job of - NONE => print "Failed\n" - | SOME file => - (print "Succeeded\n"; - Print.print (ElabPrint.p_file ElabEnv.empty file); - print "\n")) - handle ElabEnv.UnboundNamed n => - print ("Unbound named " ^ Int.toString n ^ "\n") +val untangle = { + func = Untangle.untangle, + print = MonoPrint.p_file MonoEnv.empty +} -fun testExplify job = - (case explify job of - NONE => print "Failed\n" - | SOME file => - (Print.print (ExplPrint.p_file ExplEnv.empty file); - print "\n")) - handle ExplEnv.UnboundNamed n => - print ("Unbound named " ^ Int.toString n ^ "\n") +val toUntangle = toMono_opt1 o transform untangle "untangle" -fun testCorify job = - (case corify 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") +val mono_reduce = { + func = MonoReduce.reduce, + print = MonoPrint.p_file MonoEnv.empty +} -fun testShake' job = - (case shake' 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") +val toMono_reduce = toUntangle o transform mono_reduce "mono_reduce" -fun testReduce job = - (case reduce 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") +val mono_shake = { + func = MonoShake.shake, + print = MonoPrint.p_file MonoEnv.empty +} -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") +val toMono_shake = toMono_reduce o transform mono_shake "mono_shake" -fun testTag job = - (case tag 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") +val toMono_opt2 = toMono_shake o transform mono_opt "mono_opt2" -fun testShake job = - (case shake 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") +val cjrize = { + func = Cjrize.cjrize, + print = CjrPrint.p_file CjrEnv.empty +} -fun testMonoize job = - (case monoize job of - NONE => print "Failed\n" - | SOME file => - (Print.print (MonoPrint.p_file MonoEnv.empty file); - print "\n")) - handle MonoEnv.UnboundNamed n => - print ("Unbound named " ^ Int.toString n ^ "\n") - -fun testMono_opt' job = - (case mono_opt' job of - NONE => print "Failed\n" - | SOME file => - (Print.print (MonoPrint.p_file MonoEnv.empty file); - print "\n")) - handle MonoEnv.UnboundNamed n => - print ("Unbound named " ^ Int.toString n ^ "\n") - -fun testUntangle job = - (case untangle job of - NONE => print "Failed\n" - | SOME file => - (Print.print (MonoPrint.p_file MonoEnv.empty file); - print "\n")) - handle MonoEnv.UnboundNamed n => - print ("Unbound named " ^ Int.toString n ^ "\n") - -fun testMono_reduce job = - (case mono_reduce job of - NONE => print "Failed\n" - | SOME file => - (Print.print (MonoPrint.p_file MonoEnv.empty file); - print "\n")) - handle MonoEnv.UnboundNamed n => - print ("Unbound named " ^ Int.toString n ^ "\n") - -fun testMono_shake job = - (case mono_shake job of - NONE => print "Failed\n" - | SOME file => - (Print.print (MonoPrint.p_file MonoEnv.empty file); - print "\n")) - handle MonoEnv.UnboundNamed n => - print ("Unbound named " ^ Int.toString n ^ "\n") - -fun testMono_opt job = - (case mono_opt job of - NONE => print "Failed\n" - | SOME file => - (Print.print (MonoPrint.p_file MonoEnv.empty file); - print "\n")) - handle MonoEnv.UnboundNamed n => - print ("Unbound named " ^ Int.toString n ^ "\n") - -fun testCjrize job = - (case cjrize job of - NONE => print "Failed\n" - | SOME file => - (Print.print (CjrPrint.p_file CjrEnv.empty file); - print "\n")) - handle CjrEnv.UnboundNamed n => - print ("Unbound named " ^ Int.toString n ^ "\n")*) +val toCjrize = toMono_opt2 o transform cjrize "cjrize" fun compileC {cname, oname, ename} = let @@ -521,25 +344,22 @@ print "Success\n" end -(*fun compile job = - case cjrize job of +fun compile job = + case run toCjrize job of NONE => print "Laconic compilation failed\n" | SOME file => - if ErrorMsg.anyErrors () then - print "Laconic compilation failed\n" - else - let - val cname = "/tmp/lacweb.c" - val oname = "/tmp/lacweb.o" - val ename = "/tmp/webapp" + let + val cname = "/tmp/lacweb.c" + val oname = "/tmp/lacweb.o" + val ename = "/tmp/webapp" - val outf = TextIO.openOut cname - val s = TextIOPP.openOut {dst = outf, wid = 80} - in - Print.fprint s (CjrPrint.p_file CjrEnv.empty file); - TextIO.closeOut outf; + val outf = TextIO.openOut cname + val s = TextIOPP.openOut {dst = outf, wid = 80} + in + Print.fprint s (CjrPrint.p_file CjrEnv.empty file); + TextIO.closeOut outf; - compileC {cname = cname, oname = oname, ename = ename} - end*) + compileC {cname = cname, oname = oname, ename = ename} + end end