Shift obj, type, param decls to have strata rather than effects.

2 files changed, 51 insertions, 26 deletions

diff --git a/src/boot/me/dwarf.ml b/src/boot/me/dwarf.ml
index 86a0c8a6..2a2ba2c7 100644
--- a/src/boot/me/dwarf.ml
+++ b/src/boot/me/dwarf.ml
@@ -1539,17 +1539,33 @@ let dwarf_visitor
       |]
   in
 
+  let encode_stratum eff =
+    (* Note: weird encoding: mutable+pure = gc. *)
+    let mut_byte, pure_byte =
+      match eff with
+          Ast.STRAT_value -> (0,1)
+        | Ast.STRAT_state -> (1,0)
+        | Ast.STRAT_gc -> (1,1)
+    in
+      SEQ [|
+        (* DW_AT_mutable: DW_FORM_flag *)
+        BYTE mut_byte;
+        (* DW_AT_pure: DW_FORM_flag *)
+        BYTE pure_byte;
+      |]
+  in
+
   (* Type-param DIEs. *)
 
-  let type_param_die (p:(ty_param_idx * Ast.effect)) =
-    let (idx, eff) = p in
+  let type_param_die (p:(ty_param_idx * Ast.stratum)) =
+    let (idx, s) = p in
       SEQ [|
         uleb (get_abbrev_code abbrev_rust_type_param);
         (* DW_AT_rust_type_code: DW_FORM_data1 *)
         BYTE (dw_rust_type_to_int DW_RUST_type_param);
         (* DW_AT_rust_type_param_index: DW_FORM_data4 *)
         WORD (word_ty_mach, IMM (Int64.of_int idx));
-        encode_effect eff;
+        encode_stratum s;
       |]
   in
 
@@ -1801,7 +1817,7 @@ let dwarf_visitor
           emit_die die
       in
 
-      let rust_type_param (p:(ty_param_idx * Ast.effect)) =
+      let rust_type_param (p:(ty_param_idx * Ast.stratum)) =
         let die = DEF (fix, type_param_die p) in
           emit_die die
       in
@@ -1872,11 +1888,11 @@ let dwarf_visitor
           emit_null_die ();
       in
 
-      let obj_type (eff,ob) =
+      let obj_type (str,ob) =
         let die =
           DEF (fix, SEQ [|
                  uleb (get_abbrev_code abbrev_obj_type);
-                 encode_effect eff;
+                 encode_stratum str;
                |])
         in
           emit_die die;
@@ -2239,8 +2255,8 @@ let dwarf_visitor
       curr_cu_line := []
   in
 
-  let type_param_decl_die (p:(Ast.ident * (ty_param_idx * Ast.effect))) =
-    let (ident, (idx, eff)) = p in
+  let type_param_decl_die (p:(Ast.ident * (ty_param_idx * Ast.stratum))) =
+    let (ident, (idx, str)) = p in
       SEQ [|
         uleb (get_abbrev_code abbrev_rust_type_param_decl);
         (* DW_AT_rust_type_code: DW_FORM_data1 *)
@@ -2249,7 +2265,7 @@ let dwarf_visitor
         ZSTRING (Filename.basename ident);
         (* DW_AT_rust_type_param_index: DW_FORM_data4 *)
         WORD (word_ty_mach, IMM (Int64.of_int idx));
-        encode_effect eff;
+        encode_stratum str;
       |]
   in
 
@@ -2344,7 +2360,7 @@ let dwarf_visitor
 
   let emit_typedef_die
       (id:Ast.ident)
-      (e:Ast.effect)
+      (s:Ast.stratum)
       (ty:Ast.ty)
       : unit =
     let abbrev_code = get_abbrev_code abbrev_typedef in
@@ -2353,7 +2369,7 @@ let dwarf_visitor
          uleb abbrev_code;
          (* DW_AT_name: DW_FORM_string *)
          ZSTRING id;
-         encode_effect e;
+         encode_stratum s;
          (* DW_AT_type: DW_FORM_ref_addr *)
          (ref_type_die ty);
        |])
@@ -2418,13 +2434,13 @@ let dwarf_visitor
                 emit_type_param_decl_dies item.node.Ast.decl_params;
             end
 
-        | Ast.MOD_ITEM_type (e, _) ->
+        | Ast.MOD_ITEM_type (s, _) ->
             begin
               log cx "walking typedef '%s' with %d type params"
                 (path_name())
                 (Array.length item.node.Ast.decl_params);
               emit_typedef_die
-                id e (Hashtbl.find cx.ctxt_all_type_items item.id);
+                id s (Hashtbl.find cx.ctxt_all_type_items item.id);
               emit_type_param_decl_dies item.node.Ast.decl_params;
             end
 
@@ -2893,12 +2909,21 @@ let rec extract_mod_items
       | _ -> failwith "bad effect encoding"
   in
 
+  let get_stratum die =
+    match (get_flag die DW_AT_mutable, get_flag die DW_AT_pure) with
+        (* Note: weird encoding: mutable+pure = gc. *)
+      | (false, true) -> Ast.STRAT_value
+      | (true, false) -> Ast.STRAT_state
+      | (true, true) -> Ast.STRAT_gc
+      | _ -> failwith "bad statum encoding"
+  in
+
   let get_name die = get_str die DW_AT_name in
 
   let get_type_param die =
     let idx = get_num die DW_AT_rust_type_param_index in
-    let e = get_effect die in
-      (idx, e)
+    let s = get_stratum die in
+      (idx, s)
   in
 
   let get_native_id die =
@@ -3046,7 +3071,7 @@ let rec extract_mod_items
             end
 
         | DW_TAG_interface_type ->
-            let eff = get_effect die in
+            let str = get_stratum die in
             let fns = Hashtbl.create 0 in
               Array.iter
                 begin
@@ -3056,7 +3081,7 @@ let rec extract_mod_items
                       Hashtbl.add fns (get_name child) (get_ty_fn child)
                 end
                 die.die_children;
-              Ast.TY_obj (eff,fns)
+              Ast.TY_obj (str,fns)
 
         | DW_TAG_subroutine_type ->
             Ast.TY_fn (get_ty_fn die)
@@ -3162,10 +3187,10 @@ let rec extract_mod_items
   let die = Hashtbl.find dies i in
     match die.die_tag with
         DW_TAG_typedef ->
-          let effect = get_effect die in
+          let stratum = get_stratum die in
           let ident = get_name die in
           let ty = get_referenced_ty die in
-          let tyi = Ast.MOD_ITEM_type (effect, ty) in
+          let tyi = Ast.MOD_ITEM_type (stratum, ty) in
           let (params, islots) = get_formals die in
             assert ((Array.length islots) = 0);
             htab_put mis ident (decl params tyi)
diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index 1b65c0db..f7ad923e 100644
--- a/src/boot/me/semant.ml
+++ b/src/boot/me/semant.ml
@@ -729,7 +729,7 @@ type ('ty, 'tys, 'slot, 'slots, 'tag) ty_fold =
       ty_fold_vec : 'ty -> 'ty;
       ty_fold_rec : (Ast.ident * 'ty) array -> 'ty;
       ty_fold_fn : (('slots * Ast.constrs * 'slot) * Ast.ty_fn_aux) -> 'ty;
-      ty_fold_obj : (Ast.effect
+      ty_fold_obj : (Ast.stratum
                      * (Ast.ident, (('slots * Ast.constrs * 'slot) *
                                       Ast.ty_fn_aux)) Hashtbl.t) -> 'ty;
       ty_fold_chan : 'ty -> 'ty;
@@ -737,7 +737,7 @@ type ('ty, 'tys, 'slot, 'slots, 'tag) ty_fold =
       ty_fold_task : unit -> 'ty;
       ty_fold_native : opaque_id -> 'ty;
       ty_fold_tag : 'tag -> 'ty;
-      ty_fold_param : (int * Ast.effect) -> 'ty;
+      ty_fold_param : (int * Ast.stratum) -> 'ty;
       ty_fold_named : Ast.name -> 'ty;
       ty_fold_type : unit -> 'ty;
       ty_fold_box : 'ty -> 'ty;
@@ -909,7 +909,7 @@ let rec fold_ty_full
   | Ast.TY_chan t -> f.ty_fold_chan (fold_ty cx f t)
   | Ast.TY_port t -> f.ty_fold_port (fold_ty cx f t)
 
-  | Ast.TY_obj (eff,t) -> f.ty_fold_obj (eff, (fold_obj t))
+  | Ast.TY_obj (st,t) -> f.ty_fold_obj (st, (fold_obj t))
   | Ast.TY_task -> f.ty_fold_task ()
 
   | Ast.TY_native x -> f.ty_fold_native x
@@ -962,7 +962,7 @@ let ty_fold_rebuild (id:Ast.ty -> Ast.ty)
     ty_fold_task = (fun _ -> id Ast.TY_task);
     ty_fold_native = (fun oid -> id (Ast.TY_native oid));
     ty_fold_tag = (fun ttag -> id (Ast.TY_tag ttag));
-    ty_fold_param = (fun (i, mut) -> id (Ast.TY_param (i, mut)));
+    ty_fold_param = (fun (i, s) -> id (Ast.TY_param (i, s)));
     ty_fold_named = (fun n -> id (Ast.TY_named n));
     ty_fold_type = (fun _ -> id (Ast.TY_type));
     ty_fold_box = (fun t -> id (Ast.TY_box t));
@@ -1047,8 +1047,8 @@ let rec rebuild_ty_under_params
     in
     let rec rebuild_ty t =
       let base = ty_fold_rebuild (fun t -> t) in
-      let ty_fold_param (i, mut) =
-        let param = Ast.TY_param (i, mut) in
+      let ty_fold_param (i, s) =
+        let param = Ast.TY_param (i, s) in
           match htab_search pmap param with
               None -> param
             | Some arg -> arg
@@ -1629,7 +1629,7 @@ let ty_fn_of_fn (fn:Ast.fn) : Ast.ty_fn =
 ;;
 
 let ty_obj_of_obj (obj:Ast.obj) : Ast.ty_obj =
-  (obj.Ast.obj_effect,
+  (obj.Ast.obj_stratum,
    htab_map obj.Ast.obj_fns (fun i f -> (i, ty_fn_of_fn f.node)))
 ;;