Mercurial > urweb
diff src/expl_print.sml @ 176:33d4a8eea484
Case through explify
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 31 Jul 2008 16:28:55 -0400 |
parents | 80192edca30d |
children | d11754ffe252 |
line wrap: on
line diff
--- a/src/expl_print.sml Thu Jul 31 13:08:57 2008 -0400 +++ b/src/expl_print.sml Thu Jul 31 16:28:55 2008 -0400 @@ -155,6 +155,48 @@ 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 @@ 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 =