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