changeset 270:b9b02613c0c2

Parsing jobs
author Adam Chlipala <adamc@hcoop.net>
date Tue, 02 Sep 2008 10:31:16 -0400
parents fac9fae654e2
children 42dfb0d61cf0
files src/compiler.sig src/compiler.sml tests/query.urp
diffstat 3 files changed, 124 insertions(+), 38 deletions(-) [+]
line wrap: on
line diff
--- a/src/compiler.sig	Tue Sep 02 09:53:15 2008 -0400
+++ b/src/compiler.sig	Tue Sep 02 10:31:16 2008 -0400
@@ -29,15 +29,18 @@
 
 signature COMPILER = sig
 
-    type job = string list
-    val compile : job -> unit
+    type job = {
+         database : string option,
+         sources : string list
+    }
+    val compile : string -> unit
     val compileC : {cname : string, oname : string, ename : string} -> unit
 
     type ('src, 'dst) phase
     type ('src, 'dst) transform
 
     val transform : ('src, 'dst) phase -> string -> ('src, 'dst) transform
-    val o : ('a, 'b) transform * ('b, 'c) transform -> ('a, 'c) transform
+    val o : ('b, 'c) transform * ('a, 'b) transform -> ('a, 'c) transform
 
     val run : ('src, 'dst) transform -> 'src -> 'dst option
     val runPrint : ('src, 'dst) transform -> 'src -> unit
@@ -46,6 +49,7 @@
 
     val parseUr : (string, Source.file) phase
     val parseUrs : (string, Source.sgn_item list) phase
+    val parseUrp : (string, job) phase
 
     val parse : (job, Source.file) phase
     val elaborate : (Source.file, Elab.file) phase
@@ -62,21 +66,22 @@
     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 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
+    val toParseJob : (string, job) transform
+    val toParse : (string, Source.file) transform
+    val toElaborate : (string, Elab.file) transform
+    val toExplify : (string, Expl.file) transform
+    val toCorify : (string, Core.file) transform
+    val toShake1 : (string, Core.file) transform
+    val toTag : (string, Core.file) transform
+    val toReduce : (string, Core.file) transform
+    val toSpecialize : (string, Core.file) transform
+    val toShake2 : (string, Core.file) transform
+    val toMonoize : (string, Mono.file) transform
+    val toMono_opt1 : (string, Mono.file) transform
+    val toUntangle : (string, Mono.file) transform
+    val toMono_reduce : (string, Mono.file) transform
+    val toMono_shake : (string, Mono.file) transform
+    val toMono_opt2 : (string, Mono.file) transform
+    val toCjrize : (string, Cjr.file) transform
 
 end
--- 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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/query.urp	Tue Sep 02 10:31:16 2008 -0400
@@ -0,0 +1,3 @@
+database dbname=test
+
+query