diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-07-31 16:28:55 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-07-31 16:28:55 -0400 |
| commit | 16d3d1c3a6d1e78faab91076c20b76fdcb90edb9 (patch) | |
| tree | ef54b557b346fa95b4322478bf5fbec431944f18 /src/expl_print.sml | |
| parent | d668886a45158cf3a292fdef3fa81498efd77652 (diff) | |
Case through explify
Diffstat (limited to 'src/expl_print.sml')
| -rw-r--r-- | src/expl_print.sml | 55 |
1 files changed, 55 insertions, 0 deletions
diff --git a/src/expl_print.sml b/src/expl_print.sml index 7d0bfebd..3595f65a 100644 --- a/src/expl_print.sml +++ b/src/expl_print.sml @@ -155,6 +155,48 @@ and p_name env (all as (c, _)) = CName s => string s | _ => p_con env all +fun p_patCon env pc = + case pc of + PConVar n => + ((if !debug then + string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n) + else + string (#1 (E.lookupENamed env n))) + handle E.UnboundRel _ => string ("UNBOUND_NAMED" ^ Int.toString n)) + | PConProj (m1, ms, x) => + let + val m1x = #1 (E.lookupStrNamed env m1) + handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1 + + val m1s = if !debug then + m1x ^ "__" ^ Int.toString m1 + else + m1x + in + p_list_sep (string ".") string (m1x :: ms @ [x]) + end + +fun p_pat' par env (p, _) = + case p of + PWild => string "_" + | PVar s => string s + | PPrim p => Prim.p_t p + | PCon (pc, NONE) => p_patCon env pc + | PCon (pc, SOME p) => parenIf par (box [p_patCon env pc, + space, + p_pat' true env p]) + | PRecord xps => + box [string "{", + p_list_sep (box [string ",", space]) (fn (x, p) => + box [string x, + space, + string "=", + space, + p_pat env p]) xps, + string "}"] + +and p_pat x = p_pat' false x + fun p_exp' par env (e, loc) = case e of EPrim p => Prim.p_t p @@ -264,6 +306,19 @@ fun p_exp' par env (e, loc) = p_exp env e, string ")"] + | ECase (e, pes, _) => parenIf par (box [string "case", + space, + p_exp env e, + space, + string "of", + space, + p_list_sep (box [space, string "|", space]) + (fn (p, e) => box [p_pat env p, + space, + string "=>", + space, + p_exp env e]) pes]) + and p_exp env = p_exp' false env fun p_named x n = |