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) =