changeset 1235:a7b773f1d053

Command-line use of Iflow
author Adam Chlipala <adamc@hcoop.net>
date Tue, 13 Apr 2010 11:34:59 -0400
parents e799c8df3146
children d5ecceb7d1a1
files src/compiler.sig src/compiler.sml src/iflow.sml src/main.mlton.sml src/sources
diffstat 5 files changed, 33 insertions(+), 23 deletions(-) [+]
line wrap: on
line diff
--- a/src/compiler.sig	Tue Apr 13 11:15:43 2010 -0400
+++ b/src/compiler.sig	Tue Apr 13 11:34:59 2010 -0400
@@ -164,6 +164,7 @@
     val toSqlify : (string, Cjr.file) transform
 
     val debug : bool ref
+    val doIflow : bool ref
 
     val addPath : string * string -> unit
     val addModuleRoot : string * string -> unit
--- a/src/compiler.sml	Tue Apr 13 11:15:43 2010 -0400
+++ b/src/compiler.sml	Tue Apr 13 11:34:59 2010 -0400
@@ -75,6 +75,7 @@
 }
 
 val debug = ref false
+val doIflow = ref false
 
 fun transform (ph : ('src, 'dst) phase) name = {
     func = fn input => let
@@ -1072,7 +1073,7 @@
 val toMono_opt2 = transform mono_opt "mono_opt2" o toMono_shake
 
 val iflow = {
-    func = (fn file => (Iflow.check file; file)),
+    func = (fn file => (if !doIflow then Iflow.check file else (); file)),
     print = MonoPrint.p_file MonoEnv.empty
 }
 
--- a/src/iflow.sml	Tue Apr 13 11:15:43 2010 -0400
+++ b/src/iflow.sml	Tue Apr 13 11:34:59 2010 -0400
@@ -502,7 +502,7 @@
     case !(#Rep (unNode n)) of
         SOME n => p_rep n
       | NONE =>
-        box [string (Int.toString (Unsafe.cast n) ^ ":"),
+        box [string (Int.toString 0(*Unsafe.cast n*) ^ ":"),
              space,
              case #Variety (unNode n) of
                  Nothing => string "?"
@@ -2182,7 +2182,7 @@
                 (Func (Other ("Cl" ^ Int.toString n), es), st)
             end
 
-          | EQuery {query = q, body = b, initial = i, ...} =>
+          | EQuery {query = q, body = b, initial = i, state = state, ...} =>
             let
                 val (_, st) = evalExp env (q, st)
                 val (i, st) = evalExp env (i, st)
@@ -2203,23 +2203,28 @@
                                       end)
                               (AllCols (Var r)) q
 
-                val (st, res) = if varInP acc (St.ambient st') then
-                                    let
-                                        val (st, r) = St.nextVar st
-                                    in
-                                        (st, Var r)
-                                    end
-                                else
-                                    let
-                                        val (st', out) = St.nextVar st'
-                                                  
-                                        val p = And (St.ambient st,
-                                                     Or (Reln (Eq, [Var out, i]),
-                                                         And (Reln (Eq, [Var out, b]),
-                                                              And (qp, amb))))
-                                    in
-                                        (St.setAmbient (st', p), Var out)
-                                    end
+                val (st, res) =
+                    case #1 state of
+                        TRecord [] =>
+                        (st, Func (DtCon0 "unit", []))
+                      | _ =>
+                        if varInP acc (St.ambient st') then
+                            let
+                                val (st, r) = St.nextVar st
+                            in
+                                (st, Var r)
+                            end
+                        else
+                            let
+                                val (st', out) = St.nextVar st'
+                                                 
+                                val p = And (St.ambient st,
+                                             Or (Reln (Eq, [Var out, i]),
+                                                 And (Reln (Eq, [Var out, b]),
+                                                      And (qp, amb))))
+                            in
+                                (St.setAmbient (st', p), Var out)
+                            end
 
                 val sent = map (fn ((loc, e, p), fl) => ((loc, e, And (qp, p)), fl)) (St.sent st')
 
--- a/src/main.mlton.sml	Tue Apr 13 11:15:43 2010 -0400
+++ b/src/main.mlton.sml	Tue Apr 13 11:34:59 2010 -0400
@@ -82,6 +82,9 @@
       | "-sigfile" :: name :: rest =>
         (Settings.setSigFile (SOME name);
          doArgs rest)
+      | "-iflow" :: rest =>
+        (Compiler.doIflow := true;
+         doArgs rest)
       | arg :: rest =>
         (if size arg > 0 andalso String.sub (arg, 0) = #"-" then
              raise Fail ("Unknown flag " ^ arg)
--- a/src/sources	Tue Apr 13 11:15:43 2010 -0400
+++ b/src/sources	Tue Apr 13 11:34:59 2010 -0400
@@ -169,6 +169,9 @@
 mono_shake.sig
 mono_shake.sml
 
+fuse.sig
+fuse.sml
+
 iflow.sig
 iflow.sml
 
@@ -178,9 +181,6 @@
 pathcheck.sig
 pathcheck.sml
 
-fuse.sig
-fuse.sml
-
 cjr.sml
 
 postgres.sig