diff options
| author |  Adam Chlipala <adam@chlipala.net> | 2011-08-07 16:53:06 -0400 |
|---|---|---|
| committer | Adam Chlipala <adam@chlipala.net> | 2011-08-07 16:53:06 -0400 |
| commit | e75a028e3ced5d05be1baa05c6fb1a83b277a45f (patch) | |
| tree | 3b71b2a102795dcd3b2bb3e106a0ee2309487376 /src | |
| parent | 4e0410306a4d4288dd36450dc8f9ea2e8bd0a154 (diff) | |
'-dumpTypes'
Diffstat (limited to 'src')
| -rw-r--r-- | src/elaborate.sig | 4 | ||||
| -rw-r--r-- | src/elaborate.sml | 54 | ||||
| -rw-r--r-- | src/main.mlton.sml | 3 |
3 files changed, 61 insertions, 0 deletions
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) |