A pause mark on any column of a condition keeps what it binds, an as in parentheses gets its own refusal, and what an as finds is held in one slot.

TODO.org

@@ -819,6 +819,10 @@ One spelling for one operation; != stays, and not= is refused with a suggestion
 of !=.
 
 * Checker
+** TODO An error in a callee's condition adds a bogus one at main
+=fn f(a)= with a refused condition (=if n + 1= over an i32), and =fn main()= calling =f(3)=
+last, also reports "main returns i32 or nothing, not Never": the recovered body reads as
+Never and main's last form inherits it.
 ** TODO A u64 above the i64 maximum becomes -1 when it crosses into dyn
 =(+ z u)= and =(max u 0 z)= with u = u64 max read u as -1, silently. It should trap at
 the crossing, as a u64 field read through a view already does.

lib/ast.ml

@@ -91,6 +91,10 @@ and expr_kind =
      (Option T) tested by [x?] in the condition above it, read as its
      payload ([if x?] narrowing, decision 133). *)
   | Narrow of string list * expr
+  (* Made by the checker, never read: [body] with each [(g, h)] reading [g]
+     as the binding of the hidden name [h], what an [as] in the condition
+     above found (decision 136). *)
+  | Alias of (string * string) list * expr
   | Struct of string * (string * expr) list   (* (Cursor {.src s}) *)
   (* {.src s .pos 0} with no type written in front of it. The fields alone do
      not name a type, so this node carries no name and is only checkable where
@@ -480,6 +484,7 @@ let map_children f (e : expr) : expr =
     | IfLet (s, a, e) -> IfLet (ex s, arm a, Option.map ex e)
     | Chain (n, v, b) -> Chain (n, ex v, ex b)
     | Narrow (ns, b) -> Narrow (ns, ex b)
+    | Alias (ps, b) -> Alias (ps, ex b)
     | Struct (n, fs) -> Struct (n, List.map (fun (n, v) -> (n, ex v)) fs)
     | Bare fs -> Bare (List.map (fun (n, v) -> (n, ex v)) fs)
     | MapLit (tag, kvs) -> MapLit (tag, List.map (fun (k, v) -> (ex k, ex v)) kvs)
@@ -604,7 +609,14 @@ let mark_pause ?fn ~line ~col (ds : decl list) : decl list option =
          reports, and the line DWARF names, nowhere. *)
       { e with e = Do [ pause_call ?fn e.loc; e ] }
     end
-    else map_children walk e
+    else
+      match e.e with
+      (* A call's name is not a form of its own: a mark on it, the [?] of
+         [x?] or the [>] of [(> a b)], stops before the call. *)
+      | Call ({ e = Var _; loc = hl }, _) when at hl ->
+        hit := true;
+        { e with e = Do [ pause_call ?fn e.loc; e ] }
+      | _ -> map_children walk e
   in
   let body es = List.map walk es in
   let decl (d : decl) =
@@ -641,7 +653,18 @@ let as_name g =
   g <> "" && (match g.[0] with 'A' .. 'Z' -> false | _ -> true)
   && g <> "true" && g <> "false"
 
+(* [x] when [c] is [x] with a pause mark in front of it, [Do [pause; x]]:
+   [mark_pause] wraps whatever starts at the column marked, a test of a
+   condition's chain included, and the chain still means what it did. *)
+let unpause (c : expr) =
+  match c.e with
+  | Do [ { e = Call ({ e = Var _; _ }, []); loc }; x ] when loc = x.loc -> Some x
+  | _ -> None
+
 let rec as_binds (c : expr) =
+  match unpause c with
+  | Some x -> as_binds x
+  | None ->
   match c.e with
   | If (_, q, Some { e = Var "false"; _ }) -> as_binds q
   | IfLet (_, { pat = Pctor (g, []); body = [ q ]; _ }, Some { e = Var "false"; _ })

lib/check.ml

@@ -3184,8 +3184,12 @@ let unnarrowable_in (body : Ast.expr list) =
   List.iter (walk ~in_fn:false) body;
   !out
 
+(* A name an [as] bound to what an Option held: the slot holding the Option,
+   read as its payload, as a narrowed local is, but not assignable. *)
+let as_tag = "~as"
+
 let local_of loc (b : binding) =
-  if b.bwhat = Some narrowed_tag then
+  if b.bwhat = Some narrowed_tag || b.bwhat = Some as_tag then
     mk loc b.bty (Tast.Field (mk loc (Types.Option b.bty) (Tast.Local b.slot), 1))
   else mk loc b.bty (Tast.Local b.slot)
 
@@ -6559,6 +6563,15 @@ and check_value ctx ?want (e : Ast.expr) : Tast.expr =
   | Ast.Narrow (names, body) ->
     with_narrowed ctx names (fun () ->
         ctx.tail <- tail; ctx.used <- used; check ctx ?want body)
+  | Ast.Alias (pairs, body) ->
+    scoped ctx (fun () ->
+        List.iter
+          (fun (g, h) ->
+             match lookup ctx h with
+             | Some b -> ctx.scope <- (g, b) :: ctx.scope
+             | None -> ())
+          pairs;
+        ctx.tail <- tail; ctx.used <- used; check ctx ?want body)
   (* Constant integer arithmetic where a type variable is wanted is folded to
      the literal it computes first, so [(+ x (+ 1 2))] is admitted wherever
      [(+ x 3)] is. The instantiation re-checks the form unfolded, at a concrete
@@ -8542,11 +8555,7 @@ and check_if_tested ctx ~tail ~used ?want loc c t e =
          write, bound in the scope this if was given; the else is checked
          without it. *)
       let cv, named = as_cond ctx c in
-      let bnd (g, h) =
+      (cv, { t with Ast.e = Ast.Alias (named, t) })
-        { Ast.bname = g; bty = None; bval = { Ast.e = Ast.Var h; loc = t.Ast.loc };
-          bloc = t.Ast.loc }
-      in
-      (cv, { t with Ast.e = Ast.Let (List.map bnd named, [ t ]) })
   in
   (* Both arms are the tail, and a one-armed [if] counts: [(when c (recur ...))]
      is how nearly every loop is written, and the branch is still the last
@@ -10687,6 +10696,9 @@ and if_let_name ctx ~tail ~used ?want loc scrutinee n (arm : Ast.arm) els =
    in the block it guards (decision 133). Not through [or] or [not], where
    the test holding says nothing about [x]. *)
 and narrows (c : Ast.expr) =
+  match Ast.unpause c with
+  | Some x -> narrows x
+  | None ->
   match c.Ast.e with
   | Ast.Call ({ Ast.e = Ast.Var "?"; _ }, [ { Ast.e = Ast.Var x; _ } ]) -> [ x ]
   | Ast.If (p, q, Some { Ast.e = Ast.Var "false"; _ }) -> narrows p @ narrows q
@@ -10701,13 +10713,21 @@ and as_name g = Ast.as_name g
 (* A condition with [as] in it, as the bool it tests, and each name it binds
    with the hidden name the block reads it through. The chain runs left to
    right and stops at the first test that fails, so each value is found
-   once; what an [as] finds is copied into its name's slot there, and a
+   once. What an [as] tests is held in one slot, and its name reads that
-   later test and the block read that slot. *)
+   slot: the payload of an Option held there, or the dyn itself. *)
 and as_cond ctx (c : Ast.expr) =
   let named = ref [] in
   let no loc = mk loc Types.Bool (Tast.Bool false) in
   let rec go (c : Ast.expr) =
     let loc = c.Ast.loc in
+    match Ast.unpause c, c.Ast.e with
+    (* A pause mark on a test of the chain stops before it and leaves the
+       chain as it was. *)
+    | Some x, Ast.Do [ pause; _ ] ->
+      let pv = check ctx pause in
+      let xv = go x in
+      mk loc Types.Bool (Tast.Do [ pv; xv ])
+    | _, _ ->
     match c.Ast.e with
     | Ast.If (p, q, Some { Ast.e = Ast.Var "false"; _ }) when as_binds q <> [] ->
       let pv = check_truthy ctx p in
@@ -10718,10 +10738,10 @@ and as_cond ctx (c : Ast.expr) =
       let ev = check ctx e in
       let hs = fresh_slot ctx ev.Tast.ty in
       let hv = mk loc ev.Tast.ty (Tast.Local hs) in
-      let test, payload, ty =
+      let test, what, ty =
         match ev.Tast.ty with
-        | Types.Option t -> (opt_is_some loc hv, opt_payload loc t hv, t)
+        | Types.Option t -> (opt_is_some loc hv, Some as_tag, t)
-        | Types.Dyn -> (dyn_not_nil loc hv, hv, Types.Dyn)
+        | Types.Dyn -> (dyn_not_nil loc hv, None, Types.Dyn)
         | t ->
           Loc.failk "check/as-not-optional" e.Ast.loc
             "%s is %s, which always holds a value, so as has nothing to test. \
@@ -10730,21 +10750,12 @@ and as_cond ctx (c : Ast.expr) =
              name, as in i32(x)"
             (source_text e) (tyname loc t)
       in
-      let slot, qv =
+      let b = { slot = hs; bty = ty; assignable = false; bwhat = what; blit = None } in
-        scoped ctx (fun () ->
+      incr held_n;
-            let slot = bind ctx g ty ~assignable:false in
+      named := (g, Printf.sprintf "~as%d" !held_n, b) :: !named;
-            (match lookup ctx g with
+      let qv = scoped ctx (fun () -> ctx.scope <- (g, b) :: ctx.scope; go q) in
-             | Some b ->
-               incr held_n;
-               named := (g, Printf.sprintf "~as%d" !held_n, b) :: !named
-             | None -> ());
-            (slot, go q))
-      in
       mk loc Types.Bool
-        (Tast.Let ([ (hs, ev) ],
+        (Tast.Let ([ (hs, ev) ], [ mk loc Types.Bool (Tast.If (test, qv, no loc)) ]))
-                   [ mk loc Types.Bool
-                       (Tast.If (test, mk loc Types.Bool (Tast.Let ([ (slot, payload) ], [ qv ])),
-                                 no loc)) ]))
     | _ -> check_truthy ctx c
   in
   let cv = go c in

lib/indent_reader.ml

@@ -1456,6 +1456,13 @@ and primary p : Form.t * int =
       (match (peek p).tok with
        | RP -> ignore (advance p)
        | EOF -> unclosed p '(' l0
+       | NAME "as" ->
+         failk "as-paren" (peek p).loc
+           "as names what a test found for the block of the if, elif, while \
+            or when it is a test of, so it stands in that condition's and \
+            chain and not inside parentheses. Write it without them: if %s as \
+            g and ..."
+           (text_of e)
        | COMMA ->
          failk "tuple" (peek p).loc
            "parentheses group one value, and this comma starts a second. \

lib/load.ml

@@ -297,6 +297,7 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr =
     | Ast.Chain (n, v, b) ->
       Ast.Chain (n, go v, rename_expr owned alias (n :: bound) b)
     | Ast.Narrow (ns, b) -> Ast.Narrow (ns, go b)
+    | Ast.Alias (ps, b) -> Ast.Alias (ps, go b)
     (* A quoted symbol naming something the package declares.
        [(Form.Sym {.s "Cursor"})] is what a quasiquote desugars to, and it is
        the one place a package's name survives into a *string* — which is
@@ -860,7 +861,7 @@ let rec expr_uses acc (e : Ast.expr) =
     go sc; List.iter (fun (a : Ast.arm) -> gos a.Ast.body) arms
   | Ast.IfLet (sc, a, e') -> go sc; gos a.Ast.body; Option.iter go e'
   | Ast.Chain (_, v, b) -> go v; go b
-  | Ast.Narrow (_, b) -> go b
+  | Ast.Narrow (_, b) | Ast.Alias (_, b) -> go b
   | Ast.Struct (n, kvs) ->
     acc := (n, e.Ast.loc) :: !acc;
     List.iter (fun (_, v) -> go v) kvs

lib/parse.ml

@@ -1315,7 +1315,9 @@ and is_as (f : Form.t) =
   match f.v with List ({ v = Sym "as"; _ } :: _) -> true | _ -> false
 
 and as_chain f (args : Form.t list) : Ast.expr =
-  let no (x : Form.t) = { Ast.e = Ast.Var "false"; loc = x.loc } in
+  (* At no position, so a pause mark cannot land on the chain's own
+     [false]: it has none in the source. *)
+  let no (_ : Form.t) = { Ast.e = Ast.Var "false"; loc = Loc.unknown } in
   let rec go = function
     | [] -> { Ast.e = Ast.Var "true"; loc = f.loc }
     | [ x ] when not (is_as x) -> expr x
@@ -1325,7 +1327,10 @@ and as_chain f (args : Form.t list) : Ast.expr =
     | x :: _ when is_as x -> fail x "as is (as name value)"
     | x :: rest -> { Ast.e = Ast.If (expr x, go rest, Some (no x)); loc = x.loc }
   in
-  go args
+  (* The chain's own node is at the [and], so a pause mark there has a form
+     to stop before. *)
+  let top = go args in
+  { top with Ast.loc = f.loc }
 
 and shortcircuit f (args : Form.t list) ~is_and : Ast.expr =
   let mk e = { Ast.e; loc = f.loc } in

test/test_session.ml

@@ -2038,4 +2038,57 @@ let () =
     | exception Loc.Error _ -> ()
     | exception Loc.Errors _ -> fail "one error came as a list"));
 
+  (* A pause mark at any column of a condition leaves what it binds bound:
+     an [as] (decision 136), and an [x?] narrowing through [and] (133).
+     [mark_pause] wraps a test of the chain in [(do (pause) test)]. *)
+  (let t, _ = Session.create ~file:"programs/reload.flan" () in
+   let marks name origin src line =
+     let text = List.nth (String.split_on_char '\n' src) (line - 1) in
+     let hits = ref 0 in
+     for col = 1 to String.length text do
+       let syntax = if Filename.check_suffix origin ".fln" then Source.Indented else Source.Paren in
+       match
+         Source.with_code ~syntax ~at:None (fun () ->
+             Session.eval ~origin ~pause:(line, col) t src)
+       with
+       | _ -> incr hits
+       | exception Loc.Error d when has d.Loc.dmsg "nothing to pause" -> ()
+       | exception Loc.Error d ->
+         fail "%s, a mark at %d:%d: %s" name line col d.Loc.dmsg
+       | exception e -> fail "%s, a mark at %d:%d: %s" name line col (Printexc.to_string e)
+     done;
+     if !hits < 3 then fail "%s: only %d columns took a mark" name !hits
+   in
+   marks "if o? as g" "mark-a.fln" "fn pa(o: i32?) -> i32\n  if o? as g then g else 0\n" 2;
+   marks "if o as g and" "mark-b.fln" "fn pb(o: i32?) -> i32\n  if o as g and g > 1 then g else 0\n" 2;
+   marks "if o? and" "mark-c.fln" "fn pc(o: i32?) -> i32\n  if o? and o > 1 then o else 0\n" 2;
+   let paren = "(defn pd [o (Option i32)] i32 (if (and (as g o) (> g 1)) g 0))" in
+   marks "(and (as g o) ...)" "<eval>" paren 1;
+   (* The chain has a node of its own at the [(and]. *)
+   let col =
+     let rec find i = if String.sub paren i 4 = "(and" then i + 1 else find (i + 1) in
+     find 0
+   in
+   (match Session.eval ~pause:(1, col) t paren with
+    | _ -> ()
+    | exception Loc.Error d -> fail "a mark at (and: %s" d.Loc.dmsg);
+   (* What an as finds is held once, and its name reads that slot: one
+      binding in the function, where a copy into g's own slot and another
+      into the block's would be three. *)
+   ignore
+     (Source.with_code ~syntax:Source.Indented ~at:None (fun () ->
+          Session.eval ~origin:"copies.fln" t
+            "fn pe(o: i32?) -> i32\n  if o? as g and g > 1 then g + 1 else 0\n"));
+   match
+     List.find_opt (fun (f : Tast.fn) -> f.Tast.name = "pe") t.Session.program.Tast.fns
+   with
+   | None -> fail "pe was not installed"
+   | Some f ->
+     let n = ref 0 in
+     List.iter
+       (Tast.walk (fun (e : Tast.expr) ->
+            match e.Tast.e with Tast.Let (bs, _) -> n := !n + List.length bs | _ -> ()))
+       f.Tast.body;
+     if !n <> 1 then fail "if o? as g binds %d slots, wanted 1" !n);
+
   Test_support.report ~label:"session" ()

test/test_syntax.ml

@@ -1432,6 +1432,10 @@ let () =
   refuses "or after as" "if f(x) as g or b\n  g" "indent/as-or" "nothing to name";
   refuses "or later in the chain" "if f(x) as g and a or b\n  g" "indent/as-or" "nothing to name";
   refuses "as under not" "if not f(x) as g\n  g" "indent/as-not" "not turns the test around";
+  refuses "as in parentheses under not" "if not (a as g)\n  g" "indent/as-paren"
+    "not inside parentheses";
+  refuses "as in a bracketed chain" "if (a as g and g > 1) and b\n  g" "indent/as-paren"
+    "if a as g and";
   refuses "as after until" "until f(x) as g\n  g" "indent/as-until" "Write while";
   refused "as-not-optional.fln" "fn main()\n  let n = 5\n  if n as g and g > 1\n    println(g)\n"
     [ "n is i32, which always holds a value, so as has nothing to test";