diff src/compiler.sml @ 270:b9b02613c0c2

Parsing jobs
author Adam Chlipala <adamc@hcoop.net>
date Tue, 02 Sep 2008 10:31:16 -0400
parents bacd0ba869e1
children 42dfb0d61cf0
line wrap: on
line diff
--- a/src/compiler.sml	Tue Sep 02 09:53:15 2008 -0400
+++ b/src/compiler.sml	Tue Sep 02 10:31:16 2008 -0400
@@ -35,7 +35,10 @@
                          structure Lex = Lex
                          structure LrParser = LrParser)
 
-type job = string list
+type job = {
+     database : string option,
+     sources : string list
+}
 
 type ('src, 'dst) phase = {
      func : 'src -> 'dst,
@@ -73,7 +76,7 @@
               end
 }
 
-fun op o (tr1 : ('a, 'b) transform, tr2 : ('b, 'c) transform) = {
+fun op o (tr2 : ('b, 'c) transform, tr1 : ('a, 'b) transform) = {
     func = fn input => case #func tr1 input of
                            NONE => NONE
                          | SOME v => #func tr2 v,
@@ -187,11 +190,86 @@
               handle LrParser.ParseError => [],
      print = SourcePrint.p_file}    
 
+fun p_job {database, sources} =
+    let
+        open Print.PD
+        open Print
+    in
+        box [case database of
+                 NONE => string "No database."
+               | SOME db => string ("Database: " ^ db),
+             newline,
+             string "Sources:",
+             p_list string sources,
+             newline]
+    end
+
+fun trim s =
+    let
+        val (_, s) = Substring.splitl Char.isSpace s
+        val (s, _) = Substring.splitr Char.isSpace s
+    in
+        s
+    end
+
+val parseUrp = {
+    func = fn filename =>
+              let
+                  val dir = OS.Path.dir filename
+                  val inf = TextIO.openIn (OS.Path.joinBaseExt {base = filename, ext = SOME "urp"})
+
+                  fun readSources acc =
+                      case TextIO.inputLine inf of
+                          NONE => rev acc
+                        | SOME line =>
+                          let
+                              val acc = if CharVector.all Char.isSpace line then
+                                            acc
+                                        else
+                                            let
+                                                val fname = String.implode (List.filter (fn x => not (Char.isSpace x))
+                                                                                        (String.explode line))
+                                                val fname = OS.Path.concat (dir, fname)
+                                            in
+                                                fname :: acc
+                                            end
+                          in
+                              readSources acc
+                          end
+
+                  fun read database =
+                      case TextIO.inputLine inf of
+                          NONE => {database = database, sources = []}
+                        | SOME "\n" => {database = database, sources = readSources []}
+                        | SOME line =>
+                          let
+                              val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
+                              val cmd = Substring.string (trim cmd)
+                              val arg = Substring.string (trim arg)
+                          in
+                              case cmd of
+                                  "database" =>
+                                  (case database of
+                                       NONE => ()
+                                     | SOME _ => ErrorMsg.error "Duplicate 'database' directive";
+                                   read (SOME arg))
+                                | _ => (ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
+                                        read database)
+                          end
+              in
+                  read NONE
+                  before TextIO.closeIn inf
+              end,
+    print = p_job
+}
+
+val toParseJob = transform parseUrp "parseJob"
+
 fun capitalize "" = ""
   | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
 
 val parse = {
-    func = fn fnames =>
+    func = fn {database, sources = fnames} =>
               let
                   fun nameOf fname = capitalize (OS.Path.file fname)
 
@@ -230,7 +308,7 @@
     print = SourcePrint.p_file
 }
 
-val toParse = transform parse "parse"
+val toParse = transform parse "parse" o toParseJob
 
 val elaborate = {
     func = fn file => let
@@ -241,95 +319,95 @@
     print = ElabPrint.p_file ElabEnv.empty
 }
 
-val toElaborate = toParse o transform elaborate "elaborate"
+val toElaborate = transform elaborate "elaborate" o toParse
 
 val explify = {
     func = Explify.explify,
     print = ExplPrint.p_file ExplEnv.empty
 }
 
-val toExplify = toElaborate o transform explify "explify"
+val toExplify = transform explify "explify" o toElaborate
 
 val corify = {
     func = Corify.corify,
     print = CorePrint.p_file CoreEnv.empty
 }
 
-val toCorify = toExplify o transform corify "corify"
+val toCorify = transform corify "corify" o toExplify
 
 val shake = {
     func = Shake.shake,
     print = CorePrint.p_file CoreEnv.empty
 }
 
-val toShake1 = toCorify o transform shake "shake1"
+val toShake1 = transform shake "shake1" o toCorify
 
 val tag = {
     func = Tag.tag,
     print = CorePrint.p_file CoreEnv.empty
 }
 
-val toTag = toShake1 o transform tag "tag"
+val toTag = transform tag "tag" o toShake1
 
 val reduce = {
     func = Reduce.reduce,
     print = CorePrint.p_file CoreEnv.empty
 }
 
-val toReduce = toTag o transform reduce "reduce"
+val toReduce = transform reduce "reduce" o toTag
 
 val specialize = {
     func = Specialize.specialize,
     print = CorePrint.p_file CoreEnv.empty
 }
 
-val toSpecialize = toReduce o transform specialize "specialize"
+val toSpecialize = transform specialize "specialize" o toReduce
 
-val toShake2 = toSpecialize o transform shake "shake2"
+val toShake2 = transform shake "shake2" o toSpecialize
 
 val monoize = {
     func = Monoize.monoize CoreEnv.empty,
     print = MonoPrint.p_file MonoEnv.empty
 }
 
-val toMonoize = toShake2 o transform monoize "monoize"
+val toMonoize = transform monoize "monoize" o toShake2
 
 val mono_opt = {
     func = MonoOpt.optimize,
     print = MonoPrint.p_file MonoEnv.empty
 }
 
-val toMono_opt1 = toMonoize o transform mono_opt "mono_opt1"
+val toMono_opt1 = transform mono_opt "mono_opt1" o toMonoize
 
 val untangle = {
     func = Untangle.untangle,
     print = MonoPrint.p_file MonoEnv.empty
 }
 
-val toUntangle = toMono_opt1 o transform untangle "untangle"
+val toUntangle = transform untangle "untangle" o toMono_opt1
 
 val mono_reduce = {
     func = MonoReduce.reduce,
     print = MonoPrint.p_file MonoEnv.empty
 }
 
-val toMono_reduce = toUntangle o transform mono_reduce "mono_reduce"
+val toMono_reduce = transform mono_reduce "mono_reduce" o toUntangle
 
 val mono_shake = {
     func = MonoShake.shake,
     print = MonoPrint.p_file MonoEnv.empty
 }
 
-val toMono_shake = toMono_reduce o transform mono_shake "mono_shake1"
+val toMono_shake = transform mono_shake "mono_shake1" o toMono_reduce
 
-val toMono_opt2 = toMono_shake o transform mono_opt "mono_opt2"
+val toMono_opt2 = transform mono_opt "mono_opt2" o toMono_shake
 
 val cjrize = {
     func = Cjrize.cjrize,
     print = CjrPrint.p_file CjrEnv.empty
 }
 
-val toCjrize = toMono_opt2 o transform cjrize "cjrize"
+val toCjrize = transform cjrize "cjrize" o toMono_opt2
 
 fun compileC {cname, oname, ename} =
     let