Mercurial > urweb
changeset 1983:0ff4f64b4309
Merge in upstream
| author | Patrick Hurst <phurst@mit.edu> |
|---|---|
| date | Wed, 29 Jan 2014 18:29:43 -0500 |
| parents | 2b95ecdd94eb 072656016dfa |
| children | 819756825c8d |
| files | |
| diffstat | 6 files changed, 24 insertions(+), 7 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/manual.tex Sat Jan 25 18:15:14 2014 -0500 +++ b/doc/manual.tex Wed Jan 29 18:29:43 2014 -0500 @@ -341,6 +341,8 @@ \item \texttt{-sql FILENAME}: Set where a database set-up SQL script is written. \item \texttt{-static}: Link the runtime system statically. The default is to link against dynamic libraries. + +\item \texttt{-stop PHASE}: Stop compilation after the named phase, printing the intermediate program to stderr. This flag is mainly useful for debugging the Ur/Web compiler itself. \end{itemize} There is an additional convenience method for invoking \texttt{urweb}. If the main argument is \texttt{FOO}, and \texttt{FOO.ur} exists but \texttt{FOO.urp} doesn't, then the invocation is interpreted as if called on a \texttt{.urp} file containing \texttt{FOO} as its only main entry, with an additional \texttt{rewrite all FOO/*} directive.
--- a/src/compiler.sig Sat Jan 25 18:15:14 2014 -0500 +++ b/src/compiler.sig Wed Jan 29 18:29:43 2014 -0500 @@ -202,4 +202,7 @@ val moduleOf : string -> string + val setStop : string -> unit + (* Stop compilation after this phase. *) + end
--- a/src/compiler.sml Sat Jan 25 18:15:14 2014 -0500 +++ b/src/compiler.sml Wed Jan 29 18:29:43 2014 -0500 @@ -86,6 +86,9 @@ val doDumpSource = ref (fn () => ()) +val stop = ref (NONE : string option) +fun setStop s = stop := SOME s + fun transform (ph : ('src, 'dst) phase) name = { func = fn input => let val () = if !debug then @@ -102,6 +105,10 @@ (!doDumpSource (); doDumpSource := (fn () => ()); NONE) + else if !stop = SOME name then + (Print.eprint (#print ph v); + ErrorMsg.error ("Stopped compilation after phase " ^ name); + NONE) else (if !dumpSource then doDumpSource := (fn () => Print.eprint (#print ph v))
--- a/src/elaborate.sml Sat Jan 25 18:15:14 2014 -0500 +++ b/src/elaborate.sml Wed Jan 29 18:29:43 2014 -0500 @@ -873,8 +873,9 @@ | _ => false} val (others1, others2) = eatMatching (fn (c1, c2) => - not (hasUnifs c1 andalso hasUnifs c2) - andalso consEq env loc (c1, c2)) (#others s1, #others s2) + c1 = c2 + orelse (not (hasUnifs c1 andalso hasUnifs c2) + andalso consEq env loc (c1, c2))) (#others s1, #others s2) (*val () = eprefaces "Summaries3" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}), ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*)
--- a/src/main.mlton.sml Sat Jan 25 18:15:14 2014 -0500 +++ b/src/main.mlton.sml Wed Jan 29 18:29:43 2014 -0500 @@ -133,6 +133,9 @@ | "-static" :: rest => (Settings.setStaticLinking true; doArgs rest) + | "-stop" :: phase :: rest => + (Compiler.setStop phase; + doArgs rest) | "-path" :: name :: path :: rest => (Compiler.addPath (name, path); doArgs rest)
--- a/src/mono_reduce.sml Sat Jan 25 18:15:14 2014 -0500 +++ b/src/mono_reduce.sml Wed Jan 29 18:29:43 2014 -0500 @@ -45,7 +45,7 @@ | TDatatype (n, _) => IS.member (tsyms, n) | _ => false) -fun simpleImpure (tsyms, syms) = +fun simpleImpure isGlobal (tsyms, syms) = U.Exp.existsB {typ = fn _ => false, exp = fn (env, e) => case e of @@ -65,6 +65,7 @@ in simpleTypeImpure tsyms t end + | EApp _ => not isGlobal | _ => false, bind = fn (env, b) => case b of @@ -325,7 +326,7 @@ case #1 e of ENamed n => IM.find (absCounts, n) | EApp (e, arg) => - if simpleImpure (timpures, impures) env arg then + if simpleImpure true (timpures, impures) env arg then NONE else (case remaining e of @@ -352,14 +353,14 @@ absCounts) | DVal (_, n, _, e, _) => (timpures, - if simpleImpure (timpures, impures) E.empty e then + if simpleImpure true (timpures, impures) E.empty e then IS.add (impures, n) else impures, IM.insert (absCounts, n, countAbs E.empty e)) | DValRec vis => (timpures, - if List.exists (fn (_, _, _, e, _) => simpleImpure (timpures, impures) E.empty e) vis then + if List.exists (fn (_, _, _, e, _) => simpleImpure true (timpures, impures) E.empty e) vis then foldl (fn ((_, n, _, _, _), impures) => IS.add (impures, n)) impures vis else @@ -532,7 +533,7 @@ end val impure = fn env => fn e => - simpleImpure (timpures, impures) env e andalso impure e + simpleImpure false (timpures, impures) env e andalso impure e andalso not (List.null (summarize ~1 e)) fun passive (e : exp) =