# HG changeset patch # User Adam Chlipala # Date 1271172899 14400 # Node ID a7b773f1d053174f25c4b9545c2c0ca12ae9365e # Parent e799c8df3146ea3fdbcd96d443e238bd2700181e Command-line use of Iflow diff -r e799c8df3146 -r a7b773f1d053 src/compiler.sig --- 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 diff -r e799c8df3146 -r a7b773f1d053 src/compiler.sml --- 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 } diff -r e799c8df3146 -r a7b773f1d053 src/iflow.sml --- 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') diff -r e799c8df3146 -r a7b773f1d053 src/main.mlton.sml --- 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) diff -r e799c8df3146 -r a7b773f1d053 src/sources --- 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