experiment: allow stable/flexible modifiers before top-level actor(class) declarations to flip defaults.

doc/md/examples/grammar.txt

@@ -7,6 +7,9 @@
     X
     X SEP <list(X, SEP)>
 
+<stab_actor_sort> ::= 
+    <stab_mod> 'actor'
+
 <obj_sort> ::= 
     'object'
     'actor'
@@ -268,6 +271,10 @@
     'flexible'
     'stable'
 
+<stab_mod> ::= 
+    'flexible'
+    'stable'
+
 <pat_plain> ::= 
     '_'
     <id>
@@ -303,16 +310,27 @@
 <dec_nonvar> ::= 
     'let' <pat> '=' <exp>
     'type' <id> ('<' <list(<typ_bind>, ',')> '>')? '=' <typ>
-    <obj_sort> <id>? (':' <typ>)? '='? <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>
+    <dec_obj<obj_sort>>
+    <dec_class(<obj_sort>?)>
+
+<dec_obj<sort>> ::= 
+    <sort> <id>? (':' <typ>)? '='? <obj_body>
+
+<dec_class<sort>> ::= 
+    <shared_pat_opt> <sort> 'class' <id>? <typ_params_opt> <pat_plain> (':' <typ>)? <class_body>
 
 <dec> ::= 
     <dec_var>
     <dec_nonvar>
     <exp_nondec>
     'let' <pat> '=' <exp> 'else' <exp_nest>
 
+<top_dec> ::= 
+    <dec>
+    <dec_obj<stab_actor_sort>>
+    <dec_class<stab_actor_sort>>
+
 <func_body> ::= 
     '=' <exp>
     <block>
@@ -328,7 +346,7 @@
     'import' <pat_nullary> '='? <text>
 
 <prog> ::= 
-    <list(<imp>, ';')> <list(<dec>, ';')> 
+    <list(<imp>, ';')> <list(<top_dec>, ';')> 
 
 
 

src/gen-grammar/grammar.sed

@@ -20,6 +20,8 @@ s/<start> //g
 s/<parse_prog>/<prog>/g
 s/(<bl>)//g
 s/(<ob>)//g
+s/ S / <sort> /g
+s/(S)/(<sort>)/g
 s/(B)//g
 s/ B$/ <exp_obj>/g
 s/\[/(/g

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 ->
@@ -277,7 +289,7 @@ and objblock s id ty dec_fields =
 %type<Mo_def.Syntax.typ list> seplist(typ,COMMA)
 %type<Mo_def.Syntax.pat_field list> seplist(pat_field,semicolon)
 %type<Mo_def.Syntax.pat list> seplist(pat_bin,COMMA)
-%type<Mo_def.Syntax.dec list> seplist(imp,semicolon) seplist(imp,SEMICOLON) seplist(dec,semicolon) seplist(dec,SEMICOLON)
+%type<Mo_def.Syntax.dec list> seplist(imp,semicolon) seplist(imp,SEMICOLON) seplist(dec,semicolon) seplist(top_dec,SEMICOLON)
 %type<Mo_def.Syntax.exp list> seplist(exp_nonvar(ob),COMMA) seplist(exp(ob),COMMA)
 %type<Mo_def.Syntax.exp_field list> seplist1(exp_field,semicolon) seplist(exp_field,semicolon)
 %type<Mo_def.Syntax.exp list> separated_nonempty_list(AND, exp_post(ob))
@@ -313,7 +325,6 @@ and objblock s id ty dec_fields =
 %start<string -> Mo_def.Syntax.prog> parse_prog_interactive
 %start<unit> parse_module_header (* Result passed via the Parser_lib.Imports exception *)
 %start<string -> Mo_def.Syntax.stab_sig> parse_stab_sig
-
 %on_error_reduce exp_bin(ob) exp_bin(bl) exp_nondec(bl) exp_nondec(ob)
 %%
 
@@ -354,14 +365,17 @@ seplist1(X, SEP) :
   | (* empty *) { Const @@ no_region }
   | VAR { Var @@ at $sloc }
 
+%inline stab_actor_sort :
+  | s=stab_mod ACTOR { (s, Type.Actor @@ at $sloc) }
+
 %inline obj_sort :
-  | OBJECT { Type.Object @@ at $sloc }
-  | ACTOR { Type.Actor @@ at $sloc }
-  | MODULE { Type.Module @@ at $sloc }
+  | OBJECT { (None, Type.Object @@ at $sloc) }
+  | ACTOR { (None, Type.Actor @@ at $sloc) }
+  | MODULE { (None, Type.Module @@ at $sloc) }
 
 %inline obj_sort_opt :
-  | (* empty *) { Type.Object @@ no_region }
-  | s=obj_sort { s }
+  | (* empty *) { (None, Type.Object @@ no_region) }
+  | ds=obj_sort { ds }
 
 %inline query:
   | QUERY { Type.Query }
@@ -429,8 +443,9 @@ typ_pre :
     { AsyncT(Type.Fut, scopeT (at $sloc), t) @! at $sloc }
   | ASYNCSTAR t=typ_pre
     { AsyncT(Type.Cmp, scopeT (at $sloc), t) @! at $sloc }
-  | s=obj_sort tfs=typ_obj
-    { let tfs' =
+  | os=obj_sort tfs=typ_obj
+    { let (_, s) = os in
+      let tfs' =
         if s.it = Type.Actor then List.map share_typfield tfs else tfs
       in ObjT(s, tfs') @! at $sloc }
 
@@ -791,6 +806,9 @@ stab :
   | FLEXIBLE { Some (Flexible @@ at $sloc) }
   | STABLE { Some (Stable @@ at $sloc) }
 
+%inline stab_mod :
+  | FLEXIBLE { Some (Flexible @@ at $sloc) }
+  | STABLE { Some (Stable @@ at $sloc) }
 
 (* Patterns *)
 
@@ -865,36 +883,55 @@ 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
-    { let sort = Type.(match s.it with
+  | sp=shared_pat_opt FUNC xf=id_opt
+      tps=typ_params_opt p=pat_plain t=annot_opt fb=func_body
+    { (* This is a hack to support local func declarations that return a computed async.
+         These should be defined using RHS syntax EQ e to avoid the implicit AsyncE introduction
+         around bodies declared as blocks *)
+      let named, x = xf "func" $sloc in
+      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) }
+  | d=dec_obj(obj_sort)
+    { d }
+  | d=dec_class(obj_sort_opt)
+    { d }
+
+%inline dec_obj(S) :
+  | ds=S xf=id_opt t=annot_opt EQ? efs=obj_body
+    { let (stab, s) = ds in
+      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
       let_or_exp named x e.it e.at }
-  | sp=shared_pat_opt FUNC xf=id_opt
-      tps=typ_params_opt p=pat_plain t=annot_opt fb=func_body
-    { (* This is a hack to support local func declarations that return a computed async.
-         These should be defined using RHS syntax EQ e to avoid the implicit AsyncE introduction
-         around bodies declared as blocks *)
-      let named, x = xf "func" $sloc in
-      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
+
+%inline dec_class(S) :
+  | sp=shared_pat_opt ds=S CLASS xf=typ_id_opt
+      tps=typ_params_opt p=pat_plain t=annot_opt  cb=class_body
+    { let (stab, s) = ds in
+      let x, 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)
@@ -913,6 +950,14 @@ dec :
     { let p', e' = normalize_let p e in
       LetD (p', e', Some fail) @? at $sloc }
 
+top_dec :
+  | d=dec
+    { d }
+  | d=dec_obj(stab_actor_sort)
+    { d }
+  | d=dec_class(stab_actor_sort)
+    { d }
+
 func_body :
   | EQ e=exp(ob) { (false, e) }
   | e=block { (true, e) }
@@ -921,7 +966,7 @@ obj_body :
   | LCURLY dfs=seplist(dec_field, semicolon) RCURLY { dfs }
 
 class_body :
-  | EQ xf=id_opt dfs=obj_body { snd (xf "object" $sloc), dfs }
+  | EQ xf=id_opt dfs=obj_body { snd (xf "object" $sloc),  dfs }
   | dfs=obj_body { anon_id "object" (at $sloc) @@ at $sloc, dfs }
 
 
@@ -935,13 +980,13 @@ start : (* dummy non-terminal to satisfy ErrorReporting.ml, that requires a non-
   | (* empty *) { () }
 
 parse_prog :
-  | start is=seplist(imp, semicolon) ds=seplist(dec, semicolon) EOF
+  | start is=seplist(imp, semicolon) ds=seplist(top_dec, semicolon) EOF
     {
       let trivia = !triv_table in
       fun filename -> { it = is @ ds; at = at $sloc; note = { filename; trivia }} }
 
 parse_prog_interactive :
-  | start is=seplist(imp, SEMICOLON) ds=seplist(dec, SEMICOLON) SEMICOLON_EOL
+  | start is=seplist(imp, SEMICOLON) ds=seplist(top_dec, SEMICOLON) SEMICOLON_EOL
     {
       let trivia = !triv_table in
       fun filename -> {

src/mo_frontend/printers.ml

@@ -147,6 +147,7 @@ let string_of_symbol = function
   | X (N N_catch) -> "<catch>"
   | X (N N_class_body) -> "<class_body>"
   | X (N N_dec) -> "<dec>"
+  | X (N N_top_dec) -> "<top_dec>"
   | X (N N_dec_field) -> "<dec_field>"
   | X (N N_dec_nonvar) -> "<dec_nonvar>"
   | X (N N_dec_var) -> "<dec_var>"
@@ -193,7 +194,8 @@ let string_of_symbol = function
   | X (N N_path) -> "<path>"
   | X (N N_annot_opt) -> "<annot_opt>"
   | X (N N_seplist_case_semicolon_) ->  "seplist(<case>,<semicolon>)"
-  | X (N N_seplist_dec_SEMICOLON_) -> "seplist(<dec>,;)"
+  | X (N N_seplist_top_dec_SEMICOLON_) -> "seplist(<top_dec>,;)"
+  | X (N N_seplist_top_dec_semicolon_) -> "seplist(<top_dec>,<semicolon>)"
   | X (N N_seplist_dec_semicolon_) -> "seplist(<dec>,<semicolon>)"
   | X (N N_seplist_typ_dec_semicolon_) -> "seplist(<typ_dec>,<semicolon>)"
   | X (N N_seplist_dec_field_semicolon_) -> "seplist(<dec_field>,<semicolon>)"

test/fail/ok/syntax2.tc.ok

@@ -4,7 +4,7 @@ syntax2.mo:2.1-2.4: syntax error [M0001], unexpected token 'let', expected one o
   !
   <exp_nullary(ob)>
   <binop> <exp(ob)>
-  ; seplist(<dec>,<semicolon>)
+  ; seplist(<top_dec>,<semicolon>)
   |> <exp_bin(ob)>
   or <exp_bin(ob)>
   <unassign> <exp(ob)>

test/fail/ok/syntax4.tc.ok

@@ -1,4 +1,4 @@
 syntax4.mo:1.1-1.2: syntax error [M0001], unexpected token '*', expected one of token or <phrase> sequence:
   <eof>
-  seplist(<dec>,<semicolon>) <eof>
-  seplist(<imp>,<semicolon>) seplist(<dec>,<semicolon>) <eof>
+  seplist(<top_dec>,<semicolon>) <eof>
+  seplist(<imp>,<semicolon>) seplist(<top_dec>,<semicolon>) <eof>

test/fail/ok/syntax6.tc.ok

@@ -1,3 +1,3 @@
 syntax6.mo:1.8-1.9: syntax error [M0001], unexpected token '}', expected one of token or <phrase> sequence:
   <eof>
-  ; seplist(<dec>,<semicolon>)
+  ; seplist(<top_dec>,<semicolon>)

test/fail/ok/syntax7.tc.ok

@@ -1,3 +1,3 @@
 syntax7.mo:32.1-32.4: syntax error [M0001], unexpected token 'let', expected one of token or <phrase> sequence:
   <eof>
-  ; seplist(<dec>,<semicolon>)
+  ; seplist(<top_dec>,<semicolon>)

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:⛔";
+
+stable actor class Counter() {
+
+  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"