From a0cc4817e952f1a022b1ad9c01793db1735a579e Mon Sep 17 00:00:00 2001
From: Or Brostovski <tohava@gmail.com>
Date: Thu, 5 Aug 2010 03:44:29 +0300
Subject: [PATCH] Added AST logging, and modified AST for consistent handling
 of alt stmts.

- Modified the arm types, instead of a single arm type, there are now 2 (soon to be 3) arm types, one for each type of alt statement
- Added AST logging for constrained type (see fmt_constrained)
- Added AST logging for STMT_alt_type
- Created a generic fmt_arm for use with all alt statements
---
 src/boot/fe/ast.ml  | 75 ++++++++++++++++++++++++++++++++++-----------
 src/boot/me/dead.ml |  3 +-
 2 files changed, 59 insertions(+), 19 deletions(-)

diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml
index 651b1e653d7..d4ace045439 100644
--- a/src/boot/fe/ast.ml
+++ b/src/boot/fe/ast.ml
@@ -247,13 +247,13 @@ and stmt = stmt' identified
 and stmt_alt_tag =
     {
       alt_tag_lval: lval;
-      alt_tag_arms: arm array;
+      alt_tag_arms: tag_arm array;
     }
 
 and stmt_alt_type =
     {
       alt_type_lval: lval;
-      alt_type_arms: (ident * slot * stmt) array;
+      alt_type_arms: type_arm array;
       alt_type_else: stmt option;
     }
 
@@ -318,8 +318,11 @@ and pat =
   | PAT_slot of ((slot identified) * ident)
   | PAT_wild
 
-and arm' = pat * block
-and arm = arm' identified
+and tag_arm' = pat * block
+and tag_arm = tag_arm' identified
+
+and type_arm' = ident * slot * block
+and type_arm = type_arm' identified
 
 and atom =
     ATOM_literal of (lit identified)
@@ -646,6 +649,16 @@ and fmt_iso (ff:Format.formatter) (tiso:ty_iso) : unit =
   done;
   fmt ff "@]]@]"
 
+and fmt_constrained ff (ty, constrs) : unit =
+  fmt ff "@[";
+  fmt_ty ff ty;
+  fmt ff " : ";
+  fmt ff "@[";
+  fmt_constrs ff constrs;
+  fmt ff "@]";
+  fmt ff "@]";
+    
+
 and fmt_ty (ff:Format.formatter) (t:ty) : unit =
   match t with
     TY_any -> fmt ff "any"
@@ -687,7 +700,7 @@ and fmt_ty (ff:Format.formatter) (t:ty) : unit =
   | TY_tag ttag -> fmt_tag ff ttag
   | TY_iso tiso -> fmt_iso ff tiso
   | TY_idx idx -> fmt ff "<idx#%d>" idx
-  | TY_constrained _ -> fmt ff "?constrained?"
+  | TY_constrained ctrd -> fmt_constrained ff ctrd 
 
   | TY_obj (effect, fns) ->
       fmt_obox ff;
@@ -707,7 +720,13 @@ and fmt_ty (ff:Format.formatter) (t:ty) : unit =
 
 
 and fmt_constrs (ff:Format.formatter) (cc:constr array) : unit =
-  Array.iter (fmt_constr ff) cc
+  for i = 0 to (Array.length cc) - 1
+  do
+    if i != 0
+    then fmt ff ",@ ";
+    fmt_constr ff cc.(i)
+  done;
+  (* Array.iter (fmt_constr ff) cc *)
 
 and fmt_decl_constrs (ff:Format.formatter) (cc:constr array) : unit =
   if Array.length cc = 0
@@ -1204,25 +1223,45 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
           fmt_lval ff at.alt_tag_lval;
           fmt ff ") ";
           fmt_obr ff;
-          Array.iter (fmt_arm ff) at.alt_tag_arms;
+          Array.iter (fmt_tag_arm ff) at.alt_tag_arms;
           fmt_cbb ff;
 
-      | STMT_alt_type _ -> fmt ff "?stmt_alt_type?"
+      | STMT_alt_type at -> 
+          fmt_obox ff;
+          fmt ff "alt type (";
+          fmt_lval ff at.alt_type_lval;
+          fmt ff ") ";
+          fmt_obr ff;
+          Array.iter (fmt_type_arm ff) at.alt_type_arms;
+          fmt_cbb ff;
+          
       | STMT_alt_port _ -> fmt ff "?stmt_alt_port?"
       | STMT_note _ -> fmt ff "?stmt_note?"
       | STMT_slice _ -> fmt ff "?stmt_slice?"
   end
 
-and fmt_arm (ff:Format.formatter) (arm:arm) : unit =
-  let (pat, block) = arm.node in
-    fmt ff "@\n";
-    fmt_obox ff;
-    fmt ff "case (";
-    fmt_pat ff pat;
-    fmt ff ") ";
-    fmt_obr ff;
-    fmt_stmts ff block.node;
-    fmt_cbb ff;
+and fmt_arm 
+    (ff:Format.formatter) 
+    (fmt_arm_case_expr : Format.formatter -> unit)
+    (block : block) 
+    : unit =
+  fmt ff "@\n";
+  fmt_obox ff;
+  fmt ff "case (";
+  fmt_arm_case_expr ff;
+  fmt ff ") ";
+  fmt_obr ff;
+  fmt_stmts ff block.node;
+  fmt_cbb ff;
+  
+and fmt_tag_arm (ff:Format.formatter) (tag_arm:tag_arm) : unit =
+  let (pat, block) = tag_arm.node in
+    fmt_arm ff (fun ff -> fmt_pat ff pat) block;
+    
+and fmt_type_arm (ff:Format.formatter) (type_arm:type_arm) : unit =
+  let (_, slot, block) = type_arm.node in
+    fmt_arm ff (fun ff -> fmt_slot ff slot) block;
+      
 
 and fmt_pat (ff:Format.formatter) (pat:pat) : unit =
   match pat with
diff --git a/src/boot/me/dead.ml b/src/boot/me/dead.ml
index 61aa846a50c..7ef4bf8e3e3 100644
--- a/src/boot/me/dead.ml
+++ b/src/boot/me/dead.ml
@@ -70,7 +70,8 @@ let dead_code_visitor
 
         | Ast.STMT_alt_type { Ast.alt_type_arms = arms;
                               Ast.alt_type_else = alt_type_else } ->
-            let arm_ids = Array.map (fun (_, _, block) -> block.id) arms in
+            let arm_ids = Array.map (fun { node = (_, _, block) } -> 
+                                       block.id) arms in
             let else_ids =
               begin
                 match alt_type_else with