A name an as bound is refused as itself when assigned, in the program and in a stopped frame alike.

lib/check.ml

@@ -834,6 +834,8 @@ type ctx = {
      here rather than recovered later because this scope list is the only place
      that ever knows it. *)
   mutable slot_names : string option list;
+  (* The slots an [as] bound in this function: [Tast.fn.as_slots]. *)
+  mutable as_slots : int list;
   mutable scope : (string * binding) list;   (* innermost first *)
   (* Deferred forms, most recently registered first — which is also the order
      they run in. [defer] is function-scoped, so this list belongs to the
@@ -3184,6 +3186,10 @@ let unnarrowable_in (body : Ast.expr list) =
   List.iter (walk ~in_fn:false) body;
   !out
 
+(* The [bwhat] of a name an [as] bound (decision 136), for the refusal to
+   assign it. *)
+let as_tag = "~as"
+
 let local_of loc (b : binding) =
   if b.bwhat = Some narrowed_tag then
     mk loc b.bty (Tast.Field (mk loc (Types.Option b.bty) (Tast.Local b.slot), 1))
@@ -4919,7 +4925,7 @@ let thick_thunk env loc ps r =
     env.lifted <-
       { Tast.name; params = ps;
         slots = Array.of_list (ps @ [ fty ]);
-        snames = Array.make (n + 1) None;
+        snames = Array.make (n + 1) None; as_slots = [];
         ret = r; body = [ mk loc r (Tast.CallPtr (callee, args)) ];
         fdefers = []; fenv = Some n; fparent = Some "<thick>"; floc = loc }
       :: env.lifted;
@@ -5277,7 +5283,7 @@ let with_recovery env ~on f =
   end
 
 let invented_ctx env ret =
-  { env; ret; lits = None; slots = 0; slot_tys = []; slot_names = []; scope = [];
+  { env; ret; lits = None; slots = 0; slot_tys = []; slot_names = []; as_slots = []; scope = [];
     defers = []; defer_slot = None; outer = []; outer_what = None; caught = []; place_ok = false; envslot = None; parent = None; in_frames = None; loops = []; tail = false; used = false; kept = [];
     in_defer = false; defer_ok = false; defer_block = "a nested form";
     owner = "<none>" }
@@ -5337,7 +5343,7 @@ let condition_desc ctx loc name =
       ctx.env.lifted <-
         { Tast.name = fname; params = [ Types.Ptr (Types.Mut, ty) ];
           slots = Array.of_list (List.rev hctx.slot_tys);
-          snames = Array.of_list (List.rev hctx.slot_names);
+          snames = Array.of_list (List.rev hctx.slot_names); as_slots = hctx.as_slots;
           ret = Types.Unit; body; fdefers = [];
           fenv = None; fparent = Some ctx.owner; floc = loc }
         :: ctx.env.lifted;
@@ -5457,7 +5463,7 @@ and struct_key_pair env loc n =
        The body is filled in below; nothing can call these in between. *)
     let placeholder name ret params =
       { Tast.name; params; slots = Array.of_list params;
-        snames = Array.make (List.length params) None;
+        snames = Array.make (List.length params) None; as_slots = [];
         ret; body = []; fdefers = []; fenv = None; fparent = None; floc = loc }
     in
     env.lifted <-
@@ -5540,7 +5546,7 @@ and struct_key_pair env loc n =
     let finish name ret params ctx body =
       { Tast.name; params;
         slots = Array.of_list (List.rev ctx.slot_tys);
-        snames = Array.of_list (List.rev ctx.slot_names);
+        snames = Array.of_list (List.rev ctx.slot_names); as_slots = ctx.as_slots;
         ret; body; fdefers = []; fenv = None; fparent = None; floc = loc }
     in
     env.lifted <-
@@ -5588,7 +5594,7 @@ and array_key_pair env loc n e =
     let eparams = [ pty; pty; Types.Int Types.I64 ] in
     let placeholder name ret params =
       { Tast.name; params; slots = Array.of_list params;
-        snames = Array.make (List.length params) None;
+        snames = Array.make (List.length params) None; as_slots = [];
         ret; body = []; fdefers = []; fenv = None; fparent = None; floc = loc }
     in
     env.lifted <-
@@ -5663,7 +5669,7 @@ and array_key_pair env loc n e =
     let finish name ret params ctx body =
       { Tast.name; params;
         slots = Array.of_list (List.rev ctx.slot_tys);
-        snames = Array.of_list (List.rev ctx.slot_names);
+        snames = Array.of_list (List.rev ctx.slot_names); as_slots = ctx.as_slots;
         ret; body; fdefers = []; fenv = None; fparent = None; floc = loc }
     in
     env.lifted <-
@@ -7321,7 +7327,7 @@ and check_fn ctx ~want ?gen loc (params : string list) body =
   let lifted =
     { Tast.name = fname; params = pts;
       slots = Array.of_list (List.rev fctx.slot_tys);
-      snames = Array.of_list (List.rev fctx.slot_names);
+      snames = Array.of_list (List.rev fctx.slot_names); as_slots = fctx.as_slots;
       ret; body = prefix fbody; fdefers = [];
       fenv; fparent = Some ctx.owner; floc = loc }
   in
@@ -7444,7 +7450,7 @@ and check_handler_bind ctx ?want ?(what = "handler-bind") loc clauses body =
          let lifted =
            { Tast.name = fname; params = [ Types.Ptr (Types.Mut, ty) ];
              slots = Array.of_list (List.rev hctx.slot_tys);
-             snames = Array.of_list (List.rev hctx.slot_names);
+             snames = Array.of_list (List.rev hctx.slot_names); as_slots = hctx.as_slots;
              ret = Types.Unit; body = prefix hbody; fdefers = [];
              fenv; fparent = Some ctx.owner; floc = c.Ast.hloc }
          in
@@ -10830,7 +10836,8 @@ and as_cond ctx (c : Ast.expr) =
          its payload copied into [g]'s once the test holds. *)
       let bound ty =
         scoped ctx (fun () ->
-            let slot = bind ctx g ty ~assignable:false in
+            let slot = bind ctx ~what:as_tag g ty ~assignable:false in
+            ctx.as_slots <- slot :: ctx.as_slots;
             let b = Option.get (lookup ctx g) in
             incr held_n;
             named := (g, Printf.sprintf "~as%d" !held_n, b) :: !named;
@@ -11318,7 +11325,7 @@ and struct_of ctx (target : Ast.expr) (t : Tast.expr) : Tast.expr * string =
             "%s is tested with %s? above, so here it is what the Option \
              holds, %s, and %s has no fields"
             n n (tyname target.Ast.loc other) (tyname target.Ast.loc other)
-        | Some { bwhat = Some w; _ } ->
+        | Some { bwhat = Some w; _ } when w <> as_tag ->
           fail target.Ast.loc
             "%s is %s — the pattern bound it to %s, so the value is already \
              in hand and there is no field left to read"
@@ -11402,6 +11409,11 @@ and check_place ?(store = true) ctx loc (p : Ast.place) : Tast.place * Types.t =
          (match List.assoc_opt name ctx.caught with
           | Some (_, slot) when slot = b.slot -> captured_set ctx loc name
           | _ -> ());
+         if b.bwhat = Some as_tag then
+           fail loc
+             "%s names what an as test found, and it cannot be given a new \
+              value. To change it, copy it into a local first: let %s2 = %s"
+             name name name;
          fail loc
            "%s is a parameter, and a parameter is not assignable — bind a \
             local with let" name
@@ -17172,7 +17184,7 @@ and trial ctx f =
      Only [Loc.Error] is caught. A timeout or a stack overflow is not a
      refusal to reconsider, and silently continuing past one would turn a
      resource failure into a wrong answer. *)
-  let[@warning "+9"] { env = _; ret = _; lits = _; slots; slot_tys; slot_names; scope;
+  let[@warning "+9"] { env = _; ret = _; lits = _; slots; slot_tys; slot_names; as_slots; scope;
                        defers; defer_slot; defer_ok; defer_block; outer = _;
                        outer_what; caught; place_ok; envslot; parent = _;
                        in_frames; loops; tail; used; kept; in_defer;
@@ -17183,7 +17195,7 @@ and trial ctx f =
   | exception Loc.Error d ->
     undo ();
     ctx.slots <- slots; ctx.slot_tys <- slot_tys;
-    ctx.slot_names <- slot_names; ctx.scope <- scope;
+    ctx.slot_names <- slot_names; ctx.as_slots <- as_slots; ctx.scope <- scope;
     ctx.defers <- defers; ctx.defer_slot <- defer_slot;
     ctx.defer_ok <- defer_ok; ctx.defer_block <- defer_block;
     ctx.outer_what <- outer_what; ctx.in_frames <- in_frames;
@@ -18960,7 +18972,7 @@ let rec check_fn ?sign env (fn : Ast.fn) : Tast.fn =
   let checked =
   { Tast.name = fn.Ast.name; params;
     slots = Array.of_list (List.rev ctx.slot_tys);
-    snames = Array.of_list (List.rev ctx.slot_names);
+    snames = Array.of_list (List.rev ctx.slot_names); as_slots = ctx.as_slots;
     (* The same defers again, for the transfer exit path §5 describes. The
        normal path has them spliced into [body] above; this one is guarded on
        the count, because a transfer can start above a defer that the text has
@@ -19591,7 +19603,7 @@ let lift_ginit ctx loc n ty (v : Tast.expr) =
   ctx.env.lifted <-
     { Tast.name = fname; params = [];
       slots = Array.of_list (List.rev ctx.slot_tys);
-      snames = Array.of_list (List.rev ctx.slot_names);
+      snames = Array.of_list (List.rev ctx.slot_names); as_slots = ctx.as_slots;
       (* An initialiser is a nested form as far as [defer_ok] is concerned, so
          nothing can register one here and both of these are empty. Written the
          same way [check_fn] writes them anyway, so that the day the rule
@@ -20772,13 +20784,15 @@ let expressions env (es : (Types.t option * Ast.expr) list) :
    expression's own frame, and which slot is answered beside the name, so the
    caller can point every use of it at the stopped frame's storage instead
    ([Tast.rewrite_locals]). *)
-let expression_in_scope env ~(scope : (string * Types.t * bool) list)
+let expression_in_scope env ~(scope : (string * Types.t * bool * bool) list)
     (e : Ast.expr) :
   Tast.expr * Types.t array * string option array * (string * int) list =
   let ctx = invented_ctx env Types.Unit in
   let bound =
     List.map
-      (fun (name, ty, assignable) -> (name, bind ctx name ty ~assignable))
+      (fun (name, ty, assignable, by_as) ->
+         let what = if by_as then Some as_tag else None in
+         (name, bind ctx ?what name ty ~assignable:(assignable && not by_as)))
       scope
   in
   let t = expect ctx e.Ast.loc ~want:None (check ctx e) in

lib/emit.ml

@@ -4876,7 +4876,7 @@ let emit_startup m ?(hidden = false) (globals : Tast.global list) =
        own to live in. *)
     List.iter (emit_global m ~hidden) flags;
     emit_fn m ~hidden
-      { Tast.name = ".init-globals"; params = []; slots = [||]; snames = [||];
+      { Tast.name = ".init-globals"; params = []; slots = [||]; snames = [||]; as_slots = [];
         ret = Types.Unit; body; fdefers = []; fenv = None; fparent = None;
         floc = (List.hd computed).Tast.ginit.Tast.loc };
     true

lib/session.ml

@@ -1371,7 +1371,7 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = tr
         { Tast.name = Printf.sprintf "install/%d" t.thunks;
           params = []; ret = Types.Unit; body;
           fdefers = []; fenv = None; fparent = None; floc = loc;
-          slots = [||]; snames = [||] }
+          slots = [||]; snames = [||]; as_slots = [] }
   in
   let ir =
     match run_thunk with
@@ -2122,7 +2122,8 @@ let write_slot ?(origin = "<set>") t ~frame ~(fn : Tast.fn) ~slot ~path
                       scratch and have none to keep. *)
                    snames =
                      Array.append bnames
-                       (Array.make (List.length !extra) None) }
+                       (Array.make (List.length !extra) None);
+                   as_slots = [] }
                in
                (* A struct copy the values named first, laid out in this
                   module and kept, as [eval_expr] keeps one. *)
@@ -2258,7 +2259,8 @@ let arm_restart ?(origin = "<restart>") t ~index ~(params : Types.t list)
           @ [ nullary "flan/dev-end" ];
         fdefers = []; fenv = None; fparent = None; floc = loc;
         slots = Array.append base (Array.of_list (List.rev !extra));
-        snames = Array.append bnames (Array.make (List.length !extra) None) }
+        snames = Array.append bnames (Array.make (List.length !extra) None);
+      as_slots = [] }
     in
     let copies = Check.fresh_copies t.env t.program.Tast.structs in
     let program =
@@ -2310,7 +2312,10 @@ let in_frame t ~frame:(index, (fn : Tast.fn), bound) (parsed : Ast.expr) =
     @ List.filter (fun (i, _) -> List.mem i bound) named
   in
   let scope =
-    List.map (fun (i, name) -> (name, fn.Tast.slots.(i), i >= nparams)) order
+    List.map
+      (fun (i, name) ->
+         (name, fn.Tast.slots.(i), i >= nparams, List.mem i fn.Tast.as_slots))
+      order
   in
   let checked, base, bnames, syn = Check.expression_in_scope t.env ~scope parsed in
   let table = List.map2 (fun (i, name) (_, j) -> (j, (i, name))) order syn in
@@ -2436,7 +2441,8 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) ?frame t src : change =
       slots = Array.append base (Array.of_list (List.rev !extra));
       (* The expression's own [let]s keep their names; the slots [render] added
          behind them are the walk's own scratch and have none to keep. *)
-      snames = Array.append bnames (Array.make (List.length !extra) None) }
+      snames = Array.append bnames (Array.make (List.length !extra) None);
+      as_slots = [] }
   in
   (* Built against the program but never spliced into it: an evaluation is not
      a declaration, and adding one would leave the session carrying an eval/N

lib/tast.ml

@@ -354,6 +354,10 @@ type fn = {
      backend is free to ignore it entirely -- nothing is *resolved* through it,
      and a slot is still only ever referred to by index. *)
   snames  : string option array;
+  (* The slots an [as] bound (decision 136): named, and read-only, so
+     evaluating in a stopped frame may read them and may not assign them,
+     as the program itself may not. *)
+  as_slots : int list;
   ret     : Types.t;
   body    : expr list;
   (* The defers again, innermost first. [body] already has them spliced onto

test/test_dev.ml

@@ -2533,7 +2533,36 @@ let () =
           (match List.assoc_opt "e" rows with
            | Some ("dyn", v) when Test_support.contains v "hi" -> ()
            | Some (ty, v) -> fail "locals show e as %s %s (%s)" ty v backend
-           | None -> fail "locals do not show e (%s)" backend)
+           | None -> fail "locals do not show e (%s)" backend);
+          (* Eval-in-frame reads them and, as the program may not, cannot
+             assign them. *)
+          let eval code =
+            ask
+              (Printf.sprintf "(:op \"eval-expr\" :frame 0 :code %s :syntax \"indented\")"
+                 (Wire.quote code))
+          in
+          let r = eval "g + 1" in
+          if Wire.string_field r "value" <> Some "42" then
+            fail "eval-in-frame g + 1 (%s): %s" backend
+              (Option.value ~default:(status r) (Wire.string_field r "message"));
+          List.iter
+            (fun (code, name) ->
+               let r = eval code in
+               if status r = "ok" then
+                 fail "eval-in-frame %s was accepted (%s)" code backend
+               else if
+                 not
+                   (Test_support.contains
+                      (Option.value ~default:"" (Wire.string_field r "message"))
+                      (name ^ " names what an as test found"))
+               then
+                 fail "eval-in-frame %s (%s) said: %s" code backend
+                   (Option.value ~default:"" (Wire.string_field r "message")))
+            [ ("g = 7", "g"); ("e = 1", "e") ];
+          let r = eval "g" in
+          if Wire.string_field r "value" <> Some "41" then
+            fail "g changed after a refused assignment (%s): %s" backend
+              (Option.value ~default:(status r) (Wire.string_field r "value"))
         end;
         ignore (ask "(:op \"close\")");
         Unix.close c;

test/test_flan.ml

@@ -1507,6 +1507,15 @@ let () =
   refuses_all ~fln:true "~~ in .fln" "fn f(a: bool) -> i32\n  ~~a\n" "~~ works on the bits";
   refuses_all ~fln:true "^^ in .fln" "fn f(a: bool, b: bool) -> bool\n  a ^^ b == 0\n"
     "write a != b";
+  (* A name an as bound is read-only, and says so as itself, not as a
+     parameter (decision 136). *)
+  refuses_all ~fln:true "assigning an as name"
+    "fn f(o: i32?, d) -> i32\n  if o as g and d as e\n    g = 5\n    g\n  else\n    0\n"
+    "g names what an as test found, and it cannot be given a new value. To \
+     change it, copy it into a local first: let g2 = g";
+  refuses_all ~fln:true "assigning a dyn as name"
+    "fn f(o: i32?, d) -> i32\n  if o as g and d as e\n    e = 5\n    g\n  else\n    0\n"
+    "e names what an as test found";
   rejects_check "popcount of a float"
     "(defn f [a f64] f64 (popcount a))" ~needle:"popcount takes integers, found f64";
   rejects_check "a rotation's count does not widen the value"

test/test_session.ml

@@ -1805,7 +1805,7 @@ let () =
      { Tast.name = "f"; params = []; ret = Types.Unit; body = [];
        fdefers = []; fenv = None; fparent = None; floc = Loc.unknown;
        slots = Array.make (Array.length snames) (Types.Int Types.I32);
-       snames }
+       snames; as_slots = [] }
    in
    (match Session.shown_names (fn [| Some "k~2"; None |]) with
     | [| Some "k"; None |] -> ()