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

4 files changed, 46 insertions, 33 deletions

diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml
index b72c4935..ce9f9cc4 100644
--- a/src/boot/fe/ast.ml
+++ b/src/boot/fe/ast.ml
@@ -94,7 +94,7 @@ and ty =
   | TY_task
 
   | TY_native of opaque_id
-  | TY_param of (ty_param_idx * effect)
+  | TY_param of (ty_param_idx * stratum)
   | TY_named of name
   | TY_type
 
@@ -181,7 +181,7 @@ and ty_fn = (ty_sig * ty_fn_aux)
 
 and ty_obj_header = (slot array * constrs)
 
-and ty_obj = (effect * ((ident,ty_fn) Hashtbl.t))
+and ty_obj = (stratum * ((ident,ty_fn) Hashtbl.t))
 
 and check_calls = (lval * (atom array)) array
 
@@ -434,7 +434,7 @@ and fn =
 and obj =
     {
       obj_state: header_slots;
-      obj_effect: effect;
+      obj_stratum: stratum;
       obj_constrs: constrs;
       obj_fns: (ident,fn identified) Hashtbl.t;
       obj_drop: block option;
@@ -449,10 +449,10 @@ and obj =
  * even if it's a type that's bound by a quantifier in its environment.
  *)
 
-and ty_param = ident * (ty_param_idx * effect)
+and ty_param = ident * (ty_param_idx * stratum)
 
 and mod_item' =
-    MOD_ITEM_type of (effect * ty)
+    MOD_ITEM_type of (stratum * ty)
   | MOD_ITEM_tag of (header_slots * opaque_id * int)
   | MOD_ITEM_mod of (mod_view * mod_items)
   | MOD_ITEM_fn of fn
@@ -810,7 +810,7 @@ and fmt_ty (ff:Format.formatter) (t:ty) : unit =
       fmt_ident_tys ff entries;
       fmt ff "@]"
 
-  | TY_param (i, e) -> (fmt_effect_qual ff e;
+  | TY_param (i, s) -> (fmt_stratum_qual ff s;
                         fmt ff "<p#%d>" i)
   | TY_native oid -> fmt ff "<native#%d>" (int_of_opaque oid)
   | TY_named n -> fmt_name ff n
@@ -833,9 +833,9 @@ and fmt_ty (ff:Format.formatter) (t:ty) : unit =
 
   | TY_constrained ctrd -> fmt_constrained ff ctrd
 
-  | TY_obj (effect, fns) ->
+  | TY_obj (stratum, fns) ->
       fmt_obox ff;
-      fmt_effect_qual ff effect;
+      fmt_stratum_qual ff stratum;
       fmt ff "obj ";
       fmt_obr ff;
       Hashtbl.iter
@@ -1628,8 +1628,8 @@ and fmt_slice (ff:Format.formatter) (slice:slice) : unit =
 
 
 and fmt_decl_param (ff:Format.formatter) (param:ty_param) : unit =
-  let (ident, (i, e)) = param in
-  fmt_effect_qual ff e;
+  let (ident, (i, s)) = param in
+  fmt_stratum_qual ff s;
   fmt_ident ff ident;
   fmt ff "=<p#%d>" i
 
@@ -1683,7 +1683,7 @@ and fmt_obj
     (obj:obj)
     : unit =
   fmt_obox ff;
-  fmt_effect_qual ff obj.obj_effect;
+  fmt_stratum_qual ff obj.obj_stratum;
   fmt ff "obj ";
   fmt_ident_and_params ff id params;
   fmt_header_slots ff obj.obj_state;
@@ -1719,8 +1719,8 @@ and fmt_mod_item (ff:Format.formatter) (id:ident) (item:mod_item) : unit =
   let params = Array.map (fun i -> i.node) params in
     begin
       match item.node.decl_item with
-          MOD_ITEM_type (e, ty) ->
-            fmt_effect_qual ff e;
+          MOD_ITEM_type (s, ty) ->
+            fmt_stratum_qual ff s;
             fmt ff "type ";
             fmt_ident_and_params ff id params;
             fmt ff " = ";
diff --git a/src/boot/fe/fuzz.ml b/src/boot/fe/fuzz.ml
index e8db9f39..734ef06c 100644
--- a/src/boot/fe/fuzz.ml
+++ b/src/boot/fe/fuzz.ml
@@ -104,8 +104,8 @@ let rec generate_mod_item (mis:mod_items) (cx:ctxt) : unit =
     match Random.int 2 with
         0 ->
           let ty = generate_ty cx in
-          let eff = Ast.EFF_pure in
-            decl (MOD_ITEM_type (eff, ty))
+          let st = Ast.STRAT_value in
+            decl (MOD_ITEM_type (st, ty))
       | _ ->
           let mis' = Hashtbl.create 0 in
           let view = { view_imports = Hashtbl.create 0;
diff --git a/src/boot/fe/item.ml b/src/boot/fe/item.ml
index 4c9bd556..fc144439 100644
--- a/src/boot/fe/item.ml
+++ b/src/boot/fe/item.ml
@@ -692,13 +692,12 @@ and parse_stmts_including_none (ps:pstate) : Ast.stmt array =
 and parse_ty_param (iref:int ref) (ps:pstate) : Ast.ty_param identified =
   let apos = lexpos ps in
   let _ = Pexp.parse_opacity ps in
-  let _ = Pexp.parse_stratum ps in
-  let e = Pexp.parse_effect ps in
+  let s = Pexp.parse_stratum ps in
   let ident = Pexp.parse_ident ps in
   let i = !iref in
   let bpos = lexpos ps in
     incr iref;
-    span ps apos bpos (ident, (i, e))
+    span ps apos bpos (ident, (i, s))
 
 and parse_ty_params (ps:pstate)
     : (Ast.ty_param identified) array =
@@ -843,7 +842,7 @@ and parse_optional_meta_pat (ps:pstate) (ident:Ast.ident) : Ast.meta_pat =
 and parse_obj_item
     (ps:pstate)
     (apos:pos)
-    (effect:Ast.effect)
+    (stratum:Ast.stratum)
     : (Ast.ident * Ast.mod_item) =
   expect ps OBJ;
   let (ident, params) = parse_ident_and_params ps "obj" in
@@ -872,7 +871,7 @@ and parse_obj_item
       expect ps RBRACE;
       let bpos = lexpos ps in
       let obj = { Ast.obj_state = state;
-                  Ast.obj_effect = effect;
+                  Ast.obj_stratum = stratum;
                   Ast.obj_constrs = constrs;
                   Ast.obj_fns = fns;
                   Ast.obj_drop = !drop }
@@ -884,7 +883,7 @@ and parse_obj_item
 and parse_tag_item
     (ps:pstate)
     (apos:pos)
-    (effect:Ast.effect)
+    (stratum:Ast.stratum)
     : (Ast.ident * Ast.mod_item) array =
   expect ps TAG;
   let (ident, params) = parse_ident_and_params ps "tag" in
@@ -946,14 +945,14 @@ and parse_tag_item
   let ty_item =
     (ident,
      span ps apos bpos
-       (decl params (Ast.MOD_ITEM_type (effect, ty))))
+       (decl params (Ast.MOD_ITEM_type (stratum, ty))))
   in
     Array.append [| ty_item |] constructors
 
 and parse_type_item
     (ps:pstate)
     (apos:pos)
-    (effect:Ast.effect)
+    (stratum:Ast.stratum)
     : (Ast.ident * Ast.mod_item) =
   expect ps TYPE;
   let (ident, params) = parse_ident_and_params ps "type" in
@@ -961,7 +960,7 @@ and parse_type_item
   let ty = ctxt "mod type item: ty" Pexp.parse_ty ps in
   let _ = expect ps SEMI in
   let bpos = lexpos ps in
-  let item = Ast.MOD_ITEM_type (effect, ty) in
+  let item = Ast.MOD_ITEM_type (stratum, ty) in
     (ident, span ps apos bpos (decl params item))
 
 and parse_mod_item (ps:pstate)
@@ -993,14 +992,25 @@ and parse_mod_item (ps:pstate)
         STATE | GC | IMPURE | UNSAFE | ABS
       | TYPE | OBJ | TAG | FN | ITER ->
           let _ = Pexp.parse_opacity ps in
-          let _ = Pexp.parse_stratum ps in
+          let stratum = Pexp.parse_stratum ps in
           let effect = Pexp.parse_effect ps in
             begin
               match peek ps with
-                  OBJ -> [| parse_obj_item ps apos effect |]
-                | TAG -> parse_tag_item ps apos effect
-                | TYPE -> [| parse_type_item ps apos effect |]
+                  OBJ ->
+                    if effect <> Ast.EFF_pure
+                    then raise (err "effect specified for obj" ps);
+                    [| parse_obj_item ps apos stratum |]
+                | TAG ->
+                    if effect <> Ast.EFF_pure
+                    then raise (err "effect specified for tag" ps);
+                    parse_tag_item ps apos stratum
+                | TYPE ->
+                    if effect <> Ast.EFF_pure
+                    then raise (err "effect specified for type" ps);
+                    [| parse_type_item ps apos stratum |]
                 | _ ->
+                    if stratum <> Ast.STRAT_value
+                    then raise (err "stratum specified for fn or iter" ps);
                     let is_iter = (peek ps) = ITER in
                       bump ps;
                       let (ident, params) = parse_ident_and_params ps "fn" in
@@ -1149,7 +1159,7 @@ and parse_native_mod_item_from_signature (ps:pstate)
           expect ps SEMI;
           let bpos = lexpos ps in
             [| (ident, span ps apos bpos
-                  (decl params (Ast.MOD_ITEM_type (Ast.EFF_unsafe, t)))) |]
+                  (decl params (Ast.MOD_ITEM_type (Ast.STRAT_value, t)))) |]
 
     | _ -> raise (unexpected ps)
 
diff --git a/src/boot/fe/pexp.ml b/src/boot/fe/pexp.ml
index 59cfaf75..1b26431d 100644
--- a/src/boot/fe/pexp.ml
+++ b/src/boot/fe/pexp.ml
@@ -273,14 +273,15 @@ and parse_atomic_ty (ps:pstate) : Ast.ty =
         bump ps;
         Ast.TY_mach m
 
-    | ABS | STATE | GC | IMPURE | UNSAFE | OBJ | FN | ITER ->
-        let _ = parse_opacity ps in
-        let _ = parse_stratum ps in
+    | STATE | GC | IMPURE | UNSAFE | OBJ | FN | ITER ->
+        let stratum = parse_stratum ps in
         let effect = parse_effect ps in
           begin
             match peek ps with
                 OBJ ->
                   bump ps;
+                  if effect <> Ast.EFF_pure
+                  then raise (err "effect specified for obj" ps);
                   let methods = Hashtbl.create 0 in
                   let parse_method ps =
                     let effect = parse_effect ps in
@@ -294,9 +295,11 @@ and parse_atomic_ty (ps:pstate) : Ast.ty =
                   in
                     ignore (bracketed_zero_or_more LBRACE RBRACE
                               None parse_method ps);
-                    Ast.TY_obj (effect, methods)
+                    Ast.TY_obj (stratum, methods)
 
               | FN | ITER ->
+                  if stratum <> Ast.STRAT_value
+                  then raise (err "stratum specified for fn or iter" ps);
                   Ast.TY_fn (fst (parse_ty_fn effect ps))
               | _ -> raise (unexpected ps)
           end