# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1312750386 14400
# Node ID 7efcf8f4a44ad41a26308b9922c6fef3bbdde356
# Parent  09c56e03beafc104c5bb93565fca731d9e72599f
'-dumpTypes'

diff -r 09c56e03beaf -r 7efcf8f4a44a doc/manual.tex
--- a/doc/manual.tex	Sun Aug 07 13:47:15 2011 -0400
+++ b/doc/manual.tex	Sun Aug 07 16:53:06 2011 -0400
@@ -199,6 +199,8 @@
 \end{verbatim}
 It is often worthwhile to run \cd{urweb} in this mode, because later phases of compilation can take significantly longer than type-checking alone, and the type checker catches many errors that would traditionally be found through debugging a running application.
 
+A related option is \cd{-dumpTypes}, which, as long as parsing succeeds, outputs to stdout a summary of the kinds of all identifiers declared with \cd{con} and the types of all identifiers declared with \cd{val} or \cd{val rec}.  This information is dumped even if there are errors during type inference.  Compiler error messages go to stderr, not stdout, so it is easy to distinguish the two kinds of output programmatically.
+
 To output information relevant to CSS stylesheets (and not finish regular compilation), run
 \begin{verbatim}
 urweb -css P
diff -r 09c56e03beaf -r 7efcf8f4a44a src/elaborate.sig
--- a/src/elaborate.sig	Sun Aug 07 13:47:15 2011 -0400
+++ b/src/elaborate.sig	Sun Aug 07 16:53:06 2011 -0400
@@ -32,4 +32,8 @@
 
     val resolveClass : ElabEnv.env -> Elab.con -> Elab.exp option
 
+    val dumpTypes : bool ref
+    (* After elaboration (successful or failed), should I output a mapping from
+     * all identifiers to their kinds/types? *)
+
 end
diff -r 09c56e03beaf -r 7efcf8f4a44a src/elaborate.sml
--- a/src/elaborate.sml	Sun Aug 07 13:47:15 2011 -0400
+++ b/src/elaborate.sml	Sun Aug 07 16:53:06 2011 -0400
@@ -38,6 +38,8 @@
  open ElabPrint
  open ElabErr
 
+ val dumpTypes = ref false
+
  structure IS = IntBinarySet
  structure IM = IntBinaryMap
 
@@ -4486,6 +4488,58 @@
                 (!delayedExhaustives);
 
         (*preface ("file", p_file env' file);*)
+
+        if !dumpTypes then
+            let
+                open L'
+                open Print.PD
+                open Print
+
+                fun dumpDecl (d, env) =
+                    case #1 d of
+                        DCon (x, _, k, _) => (print (box [string x,
+                                                          space,
+                                                          string "::",
+                                                          space,
+                                                          p_kind env k,
+                                                          newline,
+                                                          newline]);
+                                              E.declBinds env d)
+                      | DVal (x, _, t, _) => (print (box [string x,
+                                                          space,
+                                                          string ":",
+                                                          space,
+                                                          p_con env t,
+                                                          newline,
+                                                          newline]);
+                                              E.declBinds env d)
+                      | DValRec vis => (app (fn (x, _, t, _) => print (box [string x,
+                                                                            space,
+                                                                            string ":",
+                                                                            space,
+                                                                            p_con env t,
+                                                                            newline,
+                                                                            newline])) vis;
+                                        E.declBinds env d)
+                      | DStr (x, _, _, str) => (print (box [string ("<" ^ x ^ ">"),
+                                                            newline,
+                                                            newline]);
+                                                dumpStr (str, env);
+                                                print (box [string ("</" ^ x ^ ">"),
+                                                            newline,
+                                                            newline]);
+                                                E.declBinds env d)
+                      | _ => E.declBinds env d
+
+                and dumpStr (str, env) =
+                    case #1 str of
+                        StrConst ds => ignore (foldl dumpDecl env ds)
+                      | _ => ()
+            in
+                ignore (foldl dumpDecl env' file)
+            end
+        else
+            ();
         
         (L'.DFfiStr ("Basis", basis_n, sgn), ErrorMsg.dummySpan)
         :: ds
diff -r 09c56e03beaf -r 7efcf8f4a44a src/main.mlton.sml
--- a/src/main.mlton.sml	Sun Aug 07 13:47:15 2011 -0400
+++ b/src/main.mlton.sml	Sun Aug 07 16:53:06 2011 -0400
@@ -80,6 +80,9 @@
       | "-tc" :: rest =>
         (tc := true;
          doArgs rest)
+      | "-dumpTypes" :: rest =>
+        (Elaborate.dumpTypes := true;
+         doArgs rest)
       | "-output" :: s :: rest =>
         (Settings.setExe (SOME s);
          doArgs rest)