Mercurial > urweb
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)