Mercurial > urweb
diff src/core_print.sml @ 193:8a70e2919e86
Specialization of single-parameter datatypes
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Fri, 08 Aug 2008 17:55:51 -0400 |
| parents | 9bbf4d383381 |
| children | df5fd8f6913a |
line wrap: on
line diff
--- a/src/core_print.sml Fri Aug 08 10:59:06 2008 -0400 +++ b/src/core_print.sml Fri Aug 08 17:55:51 2008 -0400 @@ -199,10 +199,14 @@ string (#1 (E.lookupERel env n))) handle E.UnboundRel _ => string ("UNBOUND_" ^ Int.toString n)) | ENamed n => p_enamed env n - | ECon (_, pc, _, NONE) => p_patCon env pc - | ECon (_, pc, _, SOME e) => parenIf par (box [p_patCon env pc, - space, - p_exp' true env e]) + | ECon (_, pc, _, NONE) => box [string "[", + p_patCon env pc, + string "]"] + | ECon (_, pc, _, SOME e) => box [string "[", + p_patCon env pc, + space, + p_exp' true env e, + string "]"] | EFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"] | EFfiApp (m, x, es) => box [string "FFI(", string m, @@ -301,7 +305,7 @@ space, string "=>", space, - p_exp env e]) pes]) + p_exp (E.patBinds env p) e]) pes]) | EWrite e => box [string "write(", p_exp env e, @@ -349,10 +353,15 @@ val k = (KType, ErrorMsg.dummySpan) val env = E.pushCNamed env x n (KType, ErrorMsg.dummySpan) NONE val env = foldl (fn (x, env) => E.pushCRel env x k) env xs + + val xp = if !debug then + string (x ^ "__" ^ Int.toString n) + else + string x in box [string "datatype", space, - string x, + xp, p_list_sep (box []) (fn x => box [space, string x]) xs, space, string "=", @@ -360,7 +369,7 @@ p_list_sep (box [space, string "|", space]) (fn (x, n, NONE) => if !debug then (string (x ^ "__" ^ Int.toString n)) else string x - | (x, _, SOME t) => box [if !debug then (string (x ^ "__" ^ Int.toString n)) + | (x, n, SOME t) => box [if !debug then (string (x ^ "__" ^ Int.toString n)) else string x, space, string "of", space, p_con env t]) cons] end