First pass on splitting stratum and opacity off of effects. WIP.

7 files changed, 121 insertions, 46 deletions

diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml
index f81f614f..b72c4935 100644
--- a/src/boot/fe/ast.ml
+++ b/src/boot/fe/ast.ml
@@ -29,10 +29,20 @@ type slot_key =
  *)
 
 type effect =
-    PURE
-  | IO
-  | STATE
-  | UNSAFE
+    EFF_pure
+  | EFF_impure
+  | EFF_unsafe
+;;
+
+type stratum =
+    STRAT_value
+  | STRAT_state
+  | STRAT_gc
+;;
+
+type opacity =
+    OPA_transparent
+  | OPA_abstract
 ;;
 
 type mutability =
@@ -702,10 +712,48 @@ and fmt_effect
     (effect:effect)
     : unit =
   match effect with
-      PURE -> ()
-    | IO -> fmt ff "io"
-    | STATE -> fmt ff "state"
-    | UNSAFE -> fmt ff "unsafe"
+      EFF_pure -> ()
+    | EFF_impure -> fmt ff "impure"
+    | EFF_unsafe -> fmt ff "unsafe"
+
+and fmt_effect_qual
+    (ff:Format.formatter)
+    (e:effect)
+    : unit =
+  fmt_effect ff e;
+  if e <> EFF_pure then fmt ff " ";
+
+and fmt_stratum
+    (ff:Format.formatter)
+    (strat:stratum)
+    : unit =
+  match strat with
+      STRAT_value -> ()
+    | STRAT_state -> fmt ff "state"
+    | STRAT_gc -> fmt ff "gc"
+
+and fmt_stratum_qual
+    (ff:Format.formatter)
+    (s:stratum)
+    : unit =
+  fmt_stratum ff s;
+  if s <> STRAT_value then fmt ff " ";
+
+and fmt_opacity
+    (ff:Format.formatter)
+    (opa:opacity)
+    : unit =
+  match opa with
+      OPA_transparent -> ()
+    | OPA_abstract -> fmt ff "abs"
+
+and fmt_opacity_qual
+    (ff:Format.formatter)
+    (op:opacity)
+    : unit =
+  fmt_opacity ff op;
+  if op <> OPA_transparent then fmt ff " ";
+
 
 and fmt_ty_fn
     (ff:Format.formatter)
@@ -713,8 +761,7 @@ and fmt_ty_fn
     (tf:ty_fn)
     : unit =
   let (tsig, ta) = tf in
-    fmt_effect ff ta.fn_effect;
-    if ta.fn_effect <> PURE then fmt ff " ";
+    fmt_effect_qual ff ta.fn_effect;
     fmt ff "%s" (if ta.fn_is_iter then "iter" else "fn");
     begin
       match ident_and_params with
@@ -763,8 +810,7 @@ and fmt_ty (ff:Format.formatter) (t:ty) : unit =
       fmt_ident_tys ff entries;
       fmt ff "@]"
 
-  | TY_param (i, e) -> (fmt_effect ff e;
-                        if e <> PURE then fmt ff " ";
+  | TY_param (i, e) -> (fmt_effect_qual ff e;
                         fmt ff "<p#%d>" i)
   | TY_native oid -> fmt ff "<native#%d>" (int_of_opaque oid)
   | TY_named n -> fmt_name ff n
@@ -789,8 +835,7 @@ and fmt_ty (ff:Format.formatter) (t:ty) : unit =
 
   | TY_obj (effect, fns) ->
       fmt_obox ff;
-      fmt_effect ff effect;
-      if effect <> PURE then fmt ff " ";
+      fmt_effect_qual ff effect;
       fmt ff "obj ";
       fmt_obr ff;
       Hashtbl.iter
@@ -1584,8 +1629,7 @@ 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 ff e;
-  if e <> PURE then fmt ff " ";
+  fmt_effect_qual ff e;
   fmt_ident ff ident;
   fmt ff "=<p#%d>" i
 
@@ -1608,10 +1652,6 @@ and fmt_ident_and_params
   fmt_ident ff id;
   fmt_decl_params ff params
 
-and fmt_effect_qual (ff:Format.formatter) (e:effect) : unit =
-  fmt_effect ff e;
-  if e <> PURE then fmt ff " ";
-
 and fmt_fn
     (ff:Format.formatter)
     (id:ident)
diff --git a/src/boot/fe/cexp.ml b/src/boot/fe/cexp.ml
index 6828689f..3ca4ded7 100644
--- a/src/boot/fe/cexp.ml
+++ b/src/boot/fe/cexp.ml
@@ -181,7 +181,7 @@ and parse_cexp (ps:pstate) : cexp =
                   fun (ident, item) ->
                     htab_put items ident item
                 end
-                (Item.parse_mod_item_from_signature ps)
+                (Item.parse_native_mod_item_from_signature ps)
             in
               ignore (bracketed_zero_or_more
                         LBRACE RBRACE None get_item ps);
diff --git a/src/boot/fe/fuzz.ml b/src/boot/fe/fuzz.ml
index 47a708dc..e8db9f39 100644
--- a/src/boot/fe/fuzz.ml
+++ b/src/boot/fe/fuzz.ml
@@ -104,7 +104,7 @@ 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 = PURE in
+          let eff = Ast.EFF_pure in
             decl (MOD_ITEM_type (eff, ty))
       | _ ->
           let mis' = Hashtbl.create 0 in
diff --git a/src/boot/fe/item.ml b/src/boot/fe/item.ml
index c1746cc2..4c9bd556 100644
--- a/src/boot/fe/item.ml
+++ b/src/boot/fe/item.ml
@@ -154,8 +154,6 @@ and parse_stmts (ps:pstate) : Ast.stmt array =
     if (Array.length arr) == 0 then
       raise (err "statement does nothing" ps);
     arr
-        
-    
 
 (*
  * We have no way to parse a single Ast.stmt; any incoming syntactic statement
@@ -605,7 +603,11 @@ and parse_stmts_including_none (ps:pstate) : Ast.stmt array =
             expect ps SEMI;
             spans ps stmts apos (Ast.STMT_join lval)
 
-      | IO | STATE | UNSAFE | MOD | OBJ | TAG | TYPE | FN | USE | NATIVE ->
+
+       | STATE | GC
+       | IMPURE | UNSAFE
+       | ABS | NATIVE
+       | MOD | OBJ | TAG | TYPE | FN | USE ->
           let items = ctxt "stmt: decl" parse_mod_item ps in
           let bpos = lexpos ps in
             Array.map
@@ -689,6 +691,8 @@ 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 ident = Pexp.parse_ident ps in
   let i = !iref in
@@ -851,7 +855,7 @@ and parse_obj_item
       do
         let apos = lexpos ps in
           match peek ps with
-              IO | STATE | UNSAFE | FN | ITER ->
+              IMPURE | UNSAFE | FN | ITER ->
                 let effect = Pexp.parse_effect ps in
                 let is_iter = (peek ps) = ITER in
                   bump ps;
@@ -986,7 +990,10 @@ and parse_mod_item (ps:pstate)
 
     match peek ps with
 
-        IO | STATE | UNSAFE | TYPE | OBJ | TAG | FN | ITER ->
+        STATE | GC | IMPURE | UNSAFE | ABS
+      | TYPE | OBJ | TAG | FN | ITER ->
+          let _ = Pexp.parse_opacity ps in
+          let _ = Pexp.parse_stratum ps in
           let effect = Pexp.parse_effect ps in
             begin
               match peek ps with
@@ -1044,7 +1051,7 @@ and parse_mod_item (ps:pstate)
               expect ps MOD;
               let ident = Pexp.parse_ident ps in
               let path = parse_lib_name ident in
-              let items = parse_mod_items_from_signature ps in
+              let items = parse_native_mod_items_from_signature ps in
               let bpos = lexpos ps in
               let rlib = REQUIRED_LIB_c { required_libname = path;
                                           required_prefix = ps.pstate_depth }
@@ -1056,7 +1063,7 @@ and parse_mod_item (ps:pstate)
           end
       | _ -> raise (unexpected ps)
 
-and parse_mod_items_header_from_signature (ps:pstate) : Ast.mod_view =
+and parse_native_mod_header_from_signature (ps:pstate) : Ast.mod_view =
   let exports = Hashtbl.create 0 in
     while (peek ps = EXPORT)
     do
@@ -1068,11 +1075,11 @@ and parse_mod_items_header_from_signature (ps:pstate) : Ast.mod_view =
     then htab_put exports Ast.EXPORT_all_decls ();
     {empty_view with Ast.view_exports = exports}
 
-and parse_mod_items_from_signature
+and parse_native_mod_items_from_signature
     (ps:pstate)
     : (Ast.mod_view * Ast.mod_items) =
   expect ps LBRACE;
-  let view  = parse_mod_items_header_from_signature ps in
+  let view  = parse_native_mod_header_from_signature ps in
   let items = Hashtbl.create 0 in
     while not (peek ps = RBRACE)
     do
@@ -1080,24 +1087,24 @@ and parse_mod_items_from_signature
         (fun (ident, item) ->
            htab_put items ident item)
         (ctxt "mod items from sig: mod item"
-           parse_mod_item_from_signature ps)
+           parse_native_mod_item_from_signature ps)
     done;
     expect ps RBRACE;
     (view,items)
 
-and parse_mod_item_from_signature (ps:pstate)
+and parse_native_mod_item_from_signature (ps:pstate)
     : (Ast.ident * Ast.mod_item) array =
   let apos = lexpos ps in
     match peek ps with
         MOD ->
           bump ps;
           let (ident, params) = parse_ident_and_params ps "mod signature" in
-          let items = parse_mod_items_from_signature ps in
+          let items = parse_native_mod_items_from_signature ps in
           let bpos = lexpos ps in
             [| (ident,
                 span ps apos bpos (decl params (Ast.MOD_ITEM_mod items))) |]
 
-      | IO | STATE | UNSAFE | FN | ITER ->
+      | IMPURE | UNSAFE | FN | ITER ->
           let effect = Pexp.parse_effect ps in
           let is_iter = (peek ps) = ITER in
             bump ps;
@@ -1142,7 +1149,7 @@ and parse_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.UNSAFE, t)))) |]
+                  (decl params (Ast.MOD_ITEM_type (Ast.EFF_unsafe, t)))) |]
 
     | _ -> raise (unexpected ps)
 
diff --git a/src/boot/fe/lexer.mll b/src/boot/fe/lexer.mll
index 151af827..84aeb9ab 100644
--- a/src/boot/fe/lexer.mll
+++ b/src/boot/fe/lexer.mll
@@ -95,8 +95,12 @@
                 ("claim", CLAIM);
                 ("prove", PROVE);
 
-                ("io", IO);
+                ("abs", ABS);
+
                 ("state", STATE);
+                ("gc", GC);
+
+                ("impure", IMPURE);
                 ("unsafe", UNSAFE);
 
                 ("native", NATIVE);
diff --git a/src/boot/fe/pexp.ml b/src/boot/fe/pexp.ml
index 85eb32c4..59cfaf75 100644
--- a/src/boot/fe/pexp.ml
+++ b/src/boot/fe/pexp.ml
@@ -140,12 +140,22 @@ and parse_optional_trailing_constrs (ps:pstate) : Ast.constrs =
       COLON -> (bump ps; parse_constrs ps)
     | _ -> [| |]
 
+and parse_opacity (ps:pstate) : Ast.opacity =
+  match peek ps with
+      ABS -> bump ps; Ast.OPA_abstract
+    |  _ -> Ast.OPA_transparent
+
+and parse_stratum (ps:pstate) : Ast.stratum =
+  match peek ps with
+      STATE -> bump ps; Ast.STRAT_state
+    | GC -> bump ps; Ast.STRAT_gc
+    |  _ -> Ast.STRAT_value
+
 and parse_effect (ps:pstate) : Ast.effect =
   match peek ps with
-      IO -> bump ps; Ast.IO
-    | STATE -> bump ps; Ast.STATE
-    | UNSAFE -> bump ps; Ast.UNSAFE
-    | _ -> Ast.PURE
+      IMPURE -> bump ps; Ast.EFF_impure
+    | UNSAFE -> bump ps; Ast.EFF_unsafe
+    | _ -> Ast.EFF_pure
 
 and parse_mutability (ps:pstate) : Ast.mutability =
   match peek ps with
@@ -263,7 +273,9 @@ and parse_atomic_ty (ps:pstate) : Ast.ty =
         bump ps;
         Ast.TY_mach m
 
-    | IO | STATE | UNSAFE | OBJ | FN | ITER ->
+    | ABS | STATE | GC | IMPURE | UNSAFE | OBJ | FN | ITER ->
+        let _ = parse_opacity ps in
+        let _ = parse_stratum ps in
         let effect = parse_effect ps in
           begin
             match peek ps with
diff --git a/src/boot/fe/token.ml b/src/boot/fe/token.ml
index cd41ec2f..6c2282de 100644
--- a/src/boot/fe/token.ml
+++ b/src/boot/fe/token.ml
@@ -80,9 +80,15 @@ type token =
   | CLAIM
   | PROVE
 
-  (* Effect keywords *)
-  | IO
+  (* Opacity keywords *)
+  | ABS
+
+  (* Stratum keywords *)
   | STATE
+  | GC
+
+  (* Effect keywords *)
+  | IMPURE
   | UNSAFE
 
   (* Type qualifiers *)
@@ -237,9 +243,15 @@ let rec string_of_tok t =
     | CLAIM      -> "claim"
     | PROVE      -> "prove"
 
-    (* Effect keywords *)
-    | IO         -> "io"
+    (* Opacity keywords *)
+    | ABS        -> "abs"
+
+    (* Stratum keywords *)
     | STATE      -> "state"
+    | GC         -> "gc"
+
+    (* Effect keywords *)
+    | IMPURE     -> "impure"
     | UNSAFE     -> "unsafe"
 
     (* Type qualifiers *)