JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-26 17:52:06 +07:00
parent c4547adb25
commit e4d0e9c60e
8 changed files with 137 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
TODO.org
View File

@ -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.

25
lib/ast.ml
View File

@ -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"; _ })

61
lib/check.ml
View File

@ -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) =
{ 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 ]) })
(cv, { t with Ast.e = Ast.Alias (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
later test and the block read that slot. *)
once. What an [as] tests is held in one slot, and its name reads that
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.Dyn -> (dyn_not_nil loc hv, hv, Types.Dyn)
| Types.Option t -> (opt_is_some loc hv, Some as_tag, t)
| 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 =
scoped ctx (fun () ->
let slot = bind ctx g ty ~assignable:false in
(match lookup ctx g with
| Some b ->
incr held_n;
named := (g, Printf.sprintf "~as%d" !held_n, b) :: !named
| None -> ());
(slot, go q))
in
let b = { slot = hs; bty = ty; assignable = false; bwhat = what; blit = None } in
incr held_n;
named := (g, Printf.sprintf "~as%d" !held_n, b) :: !named;
let qv = scoped ctx (fun () -> ctx.scope <- (g, b) :: ctx.scope; go q) in
mk loc Types.Bool
(Tast.Let ([ (hs, ev) ],
[ mk loc Types.Bool
(Tast.If (test, mk loc Types.Bool (Tast.Let ([ (slot, payload) ], [ qv ])),
no loc)) ]))
(Tast.Let ([ (hs, ev) ], [ mk loc Types.Bool (Tast.If (test, qv, no loc)) ]))
| _ -> check_truthy ctx c
in
let cv = go c in

7
lib/indent_reader.ml
View File

@ -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. \

3
lib/load.ml
View File

@ -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

9
lib/parse.ml
View File

@ -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

53
test/test_session.ml
View File

@ -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" ()

4
test/test_syntax.ml
View File

@ -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";