Command-line use of Iflow

5 files changed, 33 insertions, 23 deletions

diff --git a/src/compiler.sig b/src/compiler.sig
index d3b4e696..cc23fe74 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -164,6 +164,7 @@ signature COMPILER = sig
     val toSqlify : (string, Cjr.file) transform
 
     val debug : bool ref
+    val doIflow : bool ref
 
     val addPath : string * string -> unit
     val addModuleRoot : string * string -> unit
diff --git a/src/compiler.sml b/src/compiler.sml
index bb55dfce..def0e6c3 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -75,6 +75,7 @@ type ('src, 'dst) transform = {
 }
 
 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_shake = transform mono_shake "mono_shake1" o toMono_reduce
 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
 }
 
diff --git a/src/iflow.sml b/src/iflow.sml
index f0dfd1f3..24d9d4a6 100644
--- a/src/iflow.sml
+++ b/src/iflow.sml
@@ -502,7 +502,7 @@ fun p_rep n =
     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 @@ fun evalExp env (e as (_, loc), st) =
                 (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 @@ fun evalExp env (e as (_, loc), st) =
                                       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')
 
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index c6ca61c9..f4f74be2 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -82,6 +82,9 @@ fun doArgs args =
       | "-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)
diff --git a/src/sources b/src/sources
index ba8dac38..3e35c7c7 100644
--- a/src/sources
+++ b/src/sources
@@ -169,6 +169,9 @@ untangle.sml
 mono_shake.sig
 mono_shake.sml
 
+fuse.sig
+fuse.sml
+
 iflow.sig
 iflow.sml
 
@@ -178,9 +181,6 @@ jscomp.sml
 pathcheck.sig
 pathcheck.sml
 
-fuse.sig
-fuse.sml
-
 cjr.sml
 
 postgres.sig