Mercurial > urweb
comparison src/elaborate.sml @ 1531:7efcf8f4a44a
'-dumpTypes'
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Sun, 07 Aug 2011 16:53:06 -0400 |
parents | a8a538800278 |
children | 396e8d881205 |
comparison
equal
deleted
inserted
replaced
1530:09c56e03beaf | 1531:7efcf8f4a44a |
---|---|
35 structure D = Disjoint | 35 structure D = Disjoint |
36 | 36 |
37 open Print | 37 open Print |
38 open ElabPrint | 38 open ElabPrint |
39 open ElabErr | 39 open ElabErr |
40 | |
41 val dumpTypes = ref false | |
40 | 42 |
41 structure IS = IntBinarySet | 43 structure IS = IntBinarySet |
42 structure IM = IntBinaryMap | 44 structure IM = IntBinaryMap |
43 | 45 |
44 structure SK = struct | 46 structure SK = struct |
4484 NONE => () | 4486 NONE => () |
4485 | SOME p => expError env (Inexhaustive (loc, p))) | 4487 | SOME p => expError env (Inexhaustive (loc, p))) |
4486 (!delayedExhaustives); | 4488 (!delayedExhaustives); |
4487 | 4489 |
4488 (*preface ("file", p_file env' file);*) | 4490 (*preface ("file", p_file env' file);*) |
4491 | |
4492 if !dumpTypes then | |
4493 let | |
4494 open L' | |
4495 open Print.PD | |
4496 open Print | |
4497 | |
4498 fun dumpDecl (d, env) = | |
4499 case #1 d of | |
4500 DCon (x, _, k, _) => (print (box [string x, | |
4501 space, | |
4502 string "::", | |
4503 space, | |
4504 p_kind env k, | |
4505 newline, | |
4506 newline]); | |
4507 E.declBinds env d) | |
4508 | DVal (x, _, t, _) => (print (box [string x, | |
4509 space, | |
4510 string ":", | |
4511 space, | |
4512 p_con env t, | |
4513 newline, | |
4514 newline]); | |
4515 E.declBinds env d) | |
4516 | DValRec vis => (app (fn (x, _, t, _) => print (box [string x, | |
4517 space, | |
4518 string ":", | |
4519 space, | |
4520 p_con env t, | |
4521 newline, | |
4522 newline])) vis; | |
4523 E.declBinds env d) | |
4524 | DStr (x, _, _, str) => (print (box [string ("<" ^ x ^ ">"), | |
4525 newline, | |
4526 newline]); | |
4527 dumpStr (str, env); | |
4528 print (box [string ("</" ^ x ^ ">"), | |
4529 newline, | |
4530 newline]); | |
4531 E.declBinds env d) | |
4532 | _ => E.declBinds env d | |
4533 | |
4534 and dumpStr (str, env) = | |
4535 case #1 str of | |
4536 StrConst ds => ignore (foldl dumpDecl env ds) | |
4537 | _ => () | |
4538 in | |
4539 ignore (foldl dumpDecl env' file) | |
4540 end | |
4541 else | |
4542 (); | |
4489 | 4543 |
4490 (L'.DFfiStr ("Basis", basis_n, sgn), ErrorMsg.dummySpan) | 4544 (L'.DFfiStr ("Basis", basis_n, sgn), ErrorMsg.dummySpan) |
4491 :: ds | 4545 :: ds |
4492 @ (L'.DStr ("Top", top_n, topSgn, topStr), ErrorMsg.dummySpan) | 4546 @ (L'.DStr ("Top", top_n, topSgn, topStr), ErrorMsg.dummySpan) |
4493 :: ds' @ file | 4547 :: ds' @ file |