From e75a028e3ced5d05be1baa05c6fb1a83b277a45f Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 7 Aug 2011 16:53:06 -0400
Subject: '-dumpTypes'

---
 doc/manual.tex     |  2 ++
 src/elaborate.sig  |  4 ++++
 src/elaborate.sml  | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/main.mlton.sml |  3 +++
 4 files changed, 63 insertions(+)

diff --git a/doc/manual.tex b/doc/manual.tex
index a139310c..a39f8ef8 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -199,6 +199,8 @@ urweb -tc P
 \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 --git a/src/elaborate.sig b/src/elaborate.sig
index 0dbf36e3..6d1583a4 100644
--- a/src/elaborate.sig
+++ b/src/elaborate.sig
@@ -32,4 +32,8 @@ signature ELABORATE = sig
 
     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 --git a/src/elaborate.sml b/src/elaborate.sml
index 1b8a7dbe..f221f59e 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -38,6 +38,8 @@
  open ElabPrint
  open ElabErr
 
+ val dumpTypes = ref false
+
  structure IS = IntBinarySet
  structure IM = IntBinaryMap
 
@@ -4486,6 +4488,58 @@ fun elabFile basis topStr topSgn env file =
                 (!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 --git a/src/main.mlton.sml b/src/main.mlton.sml
index c26a9d10..debbce15 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -80,6 +80,9 @@ fun doArgs args =
       | "-tc" :: rest =>
         (tc := true;
          doArgs rest)
+      | "-dumpTypes" :: rest =>
+        (Elaborate.dumpTypes := true;
+         doArgs rest)
       | "-output" :: s :: rest =>
         (Settings.setExe (SOME s);
          doArgs rest)
-- 
cgit v1.2.3