experiment: add optional stability modifiers before body to control default

doc/md/examples/grammar.txt

@@ -303,7 +303,7 @@
 <dec_nonvar> ::= 
     'let' <pat> '=' <exp>
     'type' <id> ('<' <list(<typ_bind>, ',')> '>')? '=' <typ>
-    <obj_sort> <id>? (':' <typ>)? '='? <obj_body>
+    <obj_sort> <id>? (':' <typ>)? '='? <stab> <obj_body>
     <shared_pat_opt> 'func' <id>? <typ_params_opt> <pat_plain> (':' <typ>)? <func_body>
     <shared_pat_opt> <obj_sort>? 'class' <id>? <typ_params_opt> <pat_plain> (':' <typ>)? <class_body>
 
@@ -321,8 +321,8 @@
     '{' <list(<dec_field>, ';')> '}'
 
 <class_body> ::= 
-    '=' <id>? <obj_body>
-    <obj_body>
+    '=' <id>? <stab> <obj_body>
+    <stab> <obj_body>
 
 <imp> ::= 
     'import' <pat_nullary> '='? <text>

src/mo_frontend/parser.mly

@@ -162,13 +162,13 @@ let share_dec d =
   | LetD (p, e, f) -> LetD (p, share_exp e, f) @? d.at
   | _ -> d
 
-let share_stab stab_opt dec =
+let share_stab default_stab stab_opt dec =
   match stab_opt with
   | None ->
     (match dec.it with
      | VarD _
      | LetD _ ->
-       Some (Flexible @@ dec.at)
+       Some (default_stab @@ dec.at)
      | _ -> None)
   | _ -> stab_opt
 
@@ -179,12 +179,12 @@ let ensure_system_cap (df : dec_field) =
       { df with it = { df.it with dec = { df.it.dec with it } } }
     | _ -> df
 
-let share_dec_field (df : dec_field) =
+let share_dec_field default_stab (df : dec_field) =
   match df.it.vis.it with
   | Public _ ->
     {df with it = {df.it with
       dec = share_dec df.it.dec;
-      stab = share_stab df.it.stab df.it.dec}}
+      stab = share_stab Flexible df.it.stab df.it.dec}}
   | System -> ensure_system_cap df
   | _ when is_sugared_func_or_module (df.it.dec) ->
     {df with it =
@@ -193,7 +193,19 @@ let share_dec_field (df : dec_field) =
           | None -> Some (Flexible @@ df.it.dec.at)
           | some -> some}
     }
-  | _ -> df
+  | _ ->
+    {df with it =
+       {df.it with stab =
+          match df.it.stab with
+          | None ->
+             (match df.it.dec.it with
+             | ExpD _
+             | TypD _
+             | ClassD _ -> None
+             | _ -> Some (default_stab @@ df.it.dec.at))
+          | some -> some}
+    }
+
 
 and objblock s id ty dec_fields =
   List.iter (fun df ->
@@ -296,7 +308,7 @@ and objblock s id ty dec_fields =
 %type<Mo_def.Syntax.dec> dec imp dec_var dec_nonvar
 %type<Mo_def.Syntax.exp_field> exp_field
 %type<Mo_def.Syntax.dec_field> dec_field
-%type<Mo_def.Syntax.id * Mo_def.Syntax.dec_field list> class_body
+%type<Mo_def.Syntax.id * Mo_def.Syntax.stab option * Mo_def.Syntax.dec_field list> class_body
 %type<Mo_def.Syntax.case> catch case
 %type<Mo_def.Syntax.exp> bl ob
 %type<Mo_def.Syntax.dec list> import_list
@@ -865,18 +877,23 @@ dec_nonvar :
       LetD (p', e', None) @? at $sloc }
   | TYPE x=typ_id tps=type_typ_params_opt EQ t=typ
     { TypD(x, tps, t) @? at $sloc }
-  | s=obj_sort xf=id_opt t=annot_opt EQ? efs=obj_body
+  | s=obj_sort xf=id_opt t=annot_opt EQ? stab=stab efs=obj_body
     { let sort = Type.(match s.it with
                        | Actor -> "actor" | Module -> "module" | Object -> "object"
                        | _ -> assert false) in
       let named, x = xf sort $sloc in
       let e =
         if s.it = Type.Actor then
+          let default_stab =
+            match stab with
+            | None -> Flexible
+            | Some stab -> stab.it
+          in
           let id = if named then Some x else None in
           AwaitE
             (Type.Fut,
              AsyncE(Type.Fut, scope_bind (anon_id "async" (at $sloc)) (at $sloc),
-                    objblock s id t (List.map share_dec_field efs) @? at $sloc)
+                    objblock s id t (List.map (share_dec_field default_stab) efs) @? at $sloc)
              @? at $sloc) @? at $sloc
         else objblock s None t efs @? at $sloc
       in
@@ -890,11 +907,15 @@ dec_nonvar :
       let is_sugar, e = desugar_func_body sp x t fb in
       let_or_exp named x (func_exp x.it sp tps p t is_sugar e) (at $sloc) }
   | sp=shared_pat_opt s=obj_sort_opt CLASS xf=typ_id_opt
-      tps=typ_params_opt p=pat_plain t=annot_opt cb=class_body
-    { let x, dfs = cb in
+      tps=typ_params_opt p=pat_plain t=annot_opt  cb=class_body
+    { let x, stab, dfs = cb in
       let dfs', tps', t' =
         if s.it = Type.Actor then
-          (List.map share_dec_field dfs,
+          let default_stab = match stab with
+            | None -> Flexible
+            | Some stab -> stab.it
+          in
+          (List.map (share_dec_field default_stab) dfs,
 	   ensure_scope_bind "" tps,
            (* Not declared async: insert AsyncT but deprecate in typing *)
 	   ensure_async_typ t)
@@ -921,8 +942,8 @@ obj_body :
   | LCURLY dfs=seplist(dec_field, semicolon) RCURLY { dfs }
 
 class_body :
-  | EQ xf=id_opt dfs=obj_body { snd (xf "object" $sloc), dfs }
-  | dfs=obj_body { anon_id "object" (at $sloc) @@ at $sloc, dfs }
+  | EQ xf=id_opt stab=stab dfs=obj_body { snd (xf "object" $sloc), stab, dfs }
+  | stab=stab dfs=obj_body { anon_id "object" (at $sloc) @@ at $sloc, stab,  dfs }
 
 
 (* Programs *)

test/run-drun/ok/stable-counter-class.drun.ok

@@ -0,0 +1,8 @@
+ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101
+ingress Completed: Reply: 0x4449444c0000
+debug.print: 1
+ingress Completed: Reply: 0x4449444c00017d01
+debug.print: {pre = 1}
+ingress Completed: Reply: 0x4449444c0000
+debug.print: 2
+ingress Completed: Reply: 0x4449444c00017d02

test/run-drun/ok/stable-counter.drun.ok

@@ -0,0 +1,8 @@
+ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101
+ingress Completed: Reply: 0x4449444c0000
+debug.print: 1
+ingress Completed: Reply: 0x4449444c00017d01
+debug.print: {pre = 1}
+ingress Completed: Reply: 0x4449444c0000
+debug.print: 2
+ingress Completed: Reply: 0x4449444c00017d02

test/run-drun/stable-counter-class.drun

@@ -0,0 +1,4 @@
+install $ID stable-counter-class/stable-counter-class.mo ""
+ingress $ID inc "DIDL\x00\x00"
+upgrade $ID stable-counter-class/stable-counter-class.mo ""
+ingress $ID inc "DIDL\x00\x00"

test/run-drun/stable-counter-class/stable-counter-class.mo

@@ -0,0 +1,21 @@
+import Prim "mo:⛔";
+
+actor class Counter() stable {
+
+  var count : Nat = 0;
+
+  public func inc() : async Nat {
+    count += 1;
+    Prim.debugPrint (debug_show(count));
+    count
+  };
+
+  system func preupgrade() {
+    Prim.debugPrint (debug_show({pre=count}));
+  }
+
+  // let f = func(){}; // rejected as unstable
+
+}
+
+

test/run-drun/stable-counter.drun

@@ -0,0 +1,4 @@
+install $ID stable-counter/stable-counter.mo ""
+ingress $ID inc "DIDL\x00\x00"
+upgrade $ID stable-counter/stable-counter.mo ""
+ingress $ID inc "DIDL\x00\x00"

test/run-drun/stable-counter/stable-counter.mo

@@ -0,0 +1,21 @@
+import Prim "mo:⛔";
+
+actor Counter stable {
+
+  var count : Nat = 0;
+
+  public func inc() : async Nat {
+    count += 1;
+    Prim.debugPrint (debug_show(count));
+    count
+  };
+
+  system func preupgrade() {
+    Prim.debugPrint (debug_show({pre=count}));
+  }
+
+  // let f = func(){}; // rejected as unstable
+
+}
+
+