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 =