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

e as g is any test of a condition's and chain, binding g for the rest of the chain and the block.

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-26 17:07:01 +07:00
parent edd2955383
commit c1916ed819
13 changed files with 435 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
TODO.org
View File

@ -34,6 +34,11 @@ Decided (133): =x?= is a bool; =if x?=, =elif x?=, =while x?= and the rest of an
make a local Option its payload in the block, in place (not a copy). Assigning an Option
to it there is refused rather than ending the narrowing; =e? as g= names what a test
found. Rules out =if let g = x= over a plain name, which is refused toward these.
** DONE e as g inside an and chain
CLOSED: [2026-09-26]
Decided (136): =e as g= (or =e? as g=) is any test of a condition's =and= chain, binding =g=
for the rest of the chain and the block, and a kept =when= with one is one flat Option. Rules
out =as= as a cast (only an Option or a dyn), and a binding under =or=, =not= or =until=.
** TODO The stepper does not step inside an optional chain
=Ast.step_expr= treats a =Chain= as a leaf (its catch-all), so nothing in a chain's
body gets a step point of its own.

16
emacs/flan-fln-mode.el
View File

@ -1807,6 +1807,19 @@ it, so a block pasted at another depth stays one block."
(defun flan-fln--fallback-re (heads)
(concat "^" (regexp-opt heads t) "(" flan-fln--name-re))
(defun flan-fln--as-matcher (limit)
"Find the next `as' of a condition up to LIMIT, `if e as g and ...': an
`as' before a name, on a line an `if', `elif', `while' or `when' comes first on."
(let (found)
(while (and (not found)
(re-search-forward "[ \t]\\(as\\)[ \t]+[^][ \t\n(){},;\":]" limit t))
(setq found (save-excursion
(save-match-data
(goto-char (match-beginning 1))
(re-search-backward "\\_<\\(?:if\\|elif\\|while\\|when\\)\\_>"
(line-beginning-position) t)))))
found))
(defun flan-fln--return-type-matcher (limit)
"Find the next return type up to LIMIT: after the `->' of a fn header, a
lambda or a `Fn(...)' type, and not after a match arm's."
@ -1881,8 +1894,9 @@ lambda or a `Fn(...)' type, and not after a match arm's."
;; The words inside a line: `for i in range(n)', `if c then a else b', a
;; `where' constraint.
("[ \t]\\(then\\|else\\|in\\|where\\)[ \t]" 1 font-lock-keyword-face)
;; A test's `as', `if e? as g'.
;; A test's `as', `if e? as g', and a condition's, `if e as g and ...'.
("?[ \t]+\\(as\\)[ \t]" 1 font-lock-keyword-face)
(flan-fln--as-matcher 1 font-lock-keyword-face)
;; `if let Some(g) = x', and a value's `if' or `when', `x = when c then a'.
("\\_<\\(?:el\\)?if[ \t]+\\(let\\)[ \t]" 1 font-lock-keyword-face)
("[ \t=(,]\\(if\\|when\\)[ \t]" 1 font-lock-keyword-face)

10
emacs/test-flan-fln.el
View File

@ -938,6 +938,16 @@ defconst(k, 3)
(search-forward "g!")
(backward-char 1)
(test-flan-fln--is "the name at x! is x" (thing-at-point 'symbol t) "g"))
;; A condition's `as' with no `?' before it, twice on a line; an `as' outside
;; a condition is left alone.
(test-flan-fln--in "fn f()\n left = when get(grid, r) as g and b(g) as h then g\n x = as y\n"
(font-lock-ensure)
(let ((face (lambda (needle)
(save-excursion (goto-char (point-min)) (search-forward needle)
(get-text-property (match-beginning 0) 'face)))))
(test-flan-fln--is "a condition's as is a keyword" (funcall face "as g") 'font-lock-keyword-face)
(test-flan-fln--is "and a second one" (funcall face "as h") 'font-lock-keyword-face)
(test-flan-fln--is "an as outside a condition is not" (funcall face "as y") nil)))
(test-flan-fln--is "after if x? as g, one level deeper"
(test-flan-fln--tabs "fn f() -> ()\n if o? as g\n|" 1) 4)
(with-temp-buffer

15
lib/ast.ml
View File

@ -632,3 +632,18 @@ let mark_pause ?fn ~line ~col (ds : decl list) : decl list option =
in
let ds = List.map decl ds in
if !hit then Some ds else None
(* The names the [as] tests of condition [c] bind (decision 136), for the
block [c] guards. [Parse.as_chain] reads the chain to this shape: each
test an [If] with [false] for its else, each [as] an [IfLet] over a plain
name with the rest of the chain as its body and [false] for its else. *)
let as_name g =
g <> "" && (match g.[0] with 'A' .. 'Z' -> false | _ -> true)
&& g <> "true" && g <> "false"
let rec as_binds (c : expr) =
match c.e with
| If (_, q, Some { e = Var "false"; _ }) -> as_binds q
| IfLet (_, { pat = Pctor (g, []); body = [ q ]; _ }, Some { e = Var "false"; _ })
when as_name g -> g :: as_binds q
| _ -> []

83
lib/check.ml
View File

@ -6480,7 +6480,7 @@ and check_value ctx ?want (e : Ast.expr) : Tast.expr =
fail loc
"%s is tested with %s? above, so in this block it is %s, and it \
cannot be given an Option here: the block reads it as present \
throughout. Assign a %s, or test a new name, as in while %s? as \
throughout. Assign a %s, or test a new name, as in while %s as \
item, and assign %s from that"
n n (tyname loc b.bty) (tyname loc b.bty) n n
| _ -> raise (Loc.Error d)))
@ -8525,12 +8525,29 @@ and check_if ctx ?(tail = false) ?(used = false) ?want loc c t e =
raise ex)
and check_if_once ctx ~tail ~used ?want loc c t e =
if as_binds c = [] then check_if_tested ctx ~tail ~used ?want loc c t e
else scoped ctx (fun () -> check_if_tested ctx ~tail ~used ?want loc c t e)
and check_if_tested ctx ~tail ~used ?want loc c t e =
let t =
match narrows c with
| [] -> t
| names -> { t with Ast.e = Ast.Narrow (names, t) }
in
let c = check_truthy ctx c in
let c, t =
match as_binds c with
| [] -> (check_truthy ctx c, t)
| _ ->
(* What an [as] named reaches the block through a name no reader can
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 ]) })
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
thing the body does. Both arms are kept when the [if] is. *)
@ -10673,8 +10690,68 @@ and narrows (c : Ast.expr) =
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
| Ast.IfLet (_, { Ast.pat = Ast.Pctor (g, []); body = [ q ]; _ },
Some { Ast.e = Ast.Var "false"; _ }) when as_name g -> narrows q
| _ -> []
and as_binds c = Ast.as_binds c
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. *)
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 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
let qv = with_narrowed ctx (narrows p) (fun () -> go q) in
mk loc Types.Bool (Tast.If (pv, qv, no loc))
| Ast.IfLet (e, { Ast.pat = Ast.Pctor (g, []); body = [ q ]; _ },
Some { Ast.e = Ast.Var "false"; _ }) when as_name g ->
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 =
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)
| t ->
Loc.failk "check/as-not-optional" e.Ast.loc
"%s is %s, which always holds a value, so as has nothing to test. \
as names what an Option or a dyn holds, when it holds something. \
It is not a conversion: a number is converted with its type's \
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
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)) ]))
| _ -> check_truthy ctx c
in
let cv = go c in
let named = List.rev !named in
List.iter (fun (_, h, b) -> ctx.scope <- (h, b) :: ctx.scope) named;
(cv, List.map (fun (g, h, _) -> (g, h)) named)
(* [f] with each of [names] that is a local (Option T) read as its payload:
the same slot, so a field set through it lands in the Option itself. A
dyn stays as it is; a name that is not a local is not narrowed. Assigning
@ -10717,7 +10794,7 @@ and with_narrowed : 'a. ctx -> string list -> (unit -> 'a) -> 'a = fun ctx names
(Printf.sprintf
"%s? does not make %s its payload here: %s's address \
is taken, or a fn assigns it, in this function, so \
something else could clear it. Write if %s? as g, \
something else could clear it. Write if %s as g, \
which copies what it holds into g"
n n n n) ] }
in

147
lib/indent_reader.ml
View File

@ -994,7 +994,7 @@ let no_place (e : Form.t) =
failk "chain-assign" e.loc
"%s is an optional chain, and a chain cannot be assigned to: when it \
holds nothing there is no place to write. Test it first: if %s?, and \
in the block %s is what it holds, or if %s? as g, then assign through g"
in the block %s is what it holds, or if %s as g, then assign through g"
(text_of e) r r r
| Form.List [ { v = Form.Sym "!!"; _ }; x ] ->
let r = text_of x in
@ -1376,12 +1376,7 @@ and if_expr p =
let t = advance p in
let word = match t.tok with NAME w -> w | _ -> "if" in
let letp = if word = "if" then if_let_head p else None in
let c = match letp with Some m -> m | None -> fst (binary p 1) in
let letp, c =
match letp with
| Some _ -> (letp, c)
| None -> (match as_head p c with Some m when word = "if" -> (Some m, m) | _ -> (None, c))
in
let c = match letp with Some m -> m | None -> cond_head p in
(match (peek p).tok with
| NAME "then" -> ignore (advance p)
| _ ->
@ -1422,35 +1417,79 @@ and if_let_head p =
failk "if-let-name" pat.loc
"if let %s = %s has no pattern to test. To test that %s holds a \
value, write if %s?, and in the block it is what it holds; to name \
what it holds, write if %s? as %s"
what it holds, write if %s as %s"
g (text_of v) (text_of v) (text_of v) (text_of v) g
| _ -> ());
Some (mk p lt.loc (Form.Vec [ pat; v ]))
| _ -> None
(* [e? as g]: after a test [e?], the name what [e] holds is bound to, as
the head [[g e]] an [if let] over a plain name stands as (decision 133). *)
and as_head p (c : Form.t) =
(* A condition, where [e as g] may stand as a test of a top-level [and]
chain (decisions 133, 136): [e] holds a value, and [g] names it for the
rest of the chain and the block. [e? as g] is the same test. Each binding
reads [(as g e)] in its test's place, in one flat [(and ...)]; the checker
gives [g] its scope. It cannot stand under [or] or [not], where the test
holding would not mean [e] held anything. *)
and cond_head p =
let x, lvl = binary p 1 in
match (peek p).tok with
| NAME "as" ->
let at = advance p in
(match c.v with
| Form.List [ { v = Form.Sym "?"; _ }; e ] ->
let g =
match (peek p).tok with
| NAME g when g <> "" && g.[0] <> '.' ->
let gt = advance p in
check_name gt g;
sym gt.loc g
| tk ->
failk "as-name" (where_ p) "as takes the name to bind, and found %s" (show tk)
in
Some (Form.make (Form.Vec [ g; e ]) c.loc)
| _ ->
failk "as-test" at.loc
"as names what a test found, and %s is not one. Write %s? as name"
(text_of c) (text_of c))
| _ -> None
| NAME "as" -> as_chain p x lvl
| _ -> x
and as_chain p (x : Form.t) lvl =
let at = advance p in
let refuse_or loc =
failk "as-or" loc
"as names what a test found, for the rest of an and chain and the \
block. With or, the block can run when that test did not hold, and \
there would be nothing to name. Bind with as in an if of its own, and \
test the rest inside it"
in
let items (f : Form.t) =
match f.v with
| Form.List ({ v = Form.Sym "and"; _ } :: (_ :: _ as xs)) -> xs
| _ -> [ f ]
in
if lvl = 1 then refuse_or x.loc;
let before, last =
match List.rev (if lvl = 2 then items x else [ x ]) with
| last :: rb -> (List.rev rb, last)
| [] -> ([], x)
in
(match last.v with
| Form.List ({ v = Form.Sym "not"; _ } :: _) ->
failk "as-not" at.loc
"as names what a test found, and not turns the test around: the \
block runs when %s holds nothing, so there is nothing to name. Bind \
with as, and put what runs when it is absent in the else"
(text_of last)
| Form.List ({ v = Form.Sym "or"; _ } :: _) -> refuse_or last.loc
| _ -> ());
let e = match last.v with Form.List [ { v = Form.Sym "?"; _ }; e ] -> e | _ -> last in
let g =
match (peek p).tok with
| NAME g when g <> "" && g.[0] <> '.' && not (is_op_word g) ->
let gt = advance p in
check_name gt g;
sym gt.loc g
| tk -> failk "as-name" (where_ p) "as takes the name to bind, and found %s" (show tk)
in
let bound = Form.make (Form.List [ sym at.loc "as"; g; e ]) last.loc in
let rest =
match (peek p).tok with
| NAME "and" ->
ignore (advance p);
let y, ylvl = binary p 1 in
(match (peek p).tok with
| NAME "as" -> items (as_chain p y ylvl)
| _ ->
if ylvl = 1 then refuse_or y.loc;
if ylvl = 2 then items y else [ y ])
| NAME "or" -> refuse_or (peek p).loc
| _ -> []
in
match before @ (bound :: rest) with
| [ one ] -> one
| xs -> Form.make (Form.List (sym x.loc "and" :: xs)) x.loc
(* The if an [if let] head was read into, rewritten to (if-let [P v] then
else): [(if [P v] a b)], [(when [P v] body ...)] and an elif chain's
@ -2691,12 +2730,7 @@ and header (s : st) w : Form.t =
form [ alias; path ]
| "if" | "when" ->
let letp = if w = "if" then if_let_head p else None in
let c = match letp with Some m -> m | None -> fst (binary p 1) in
let letp, c =
match letp with
| Some _ -> (letp, c)
| None -> (match as_head p c with Some m when w = "if" -> (Some m, m) | _ -> (None, c))
in
let c = match letp with Some m -> m | None -> cond_head p in
(* The elif and else clauses at the if's column, then the whole form.
[oneline] when the if was [if c then a]: its clauses may then be
one-line too, [elif c then x] and [else y], or take blocks. *)
@ -2713,11 +2747,7 @@ and header (s : st) w : Form.t =
let c =
match if_let_head p with
| Some m -> elif_lets := m :: !elif_lets; m
| None ->
let c = fst (binary p 1) in
(match as_head p c with
| Some m -> elif_lets := m :: !elif_lets; m
| None -> c)
| None -> cond_head p
in
(match (peek p).tok with
| NAME "then" when oneline ->
@ -2829,21 +2859,30 @@ and header (s : st) w : Form.t =
| KW k, n when n <> NEWLINE -> let kt = advance p in [ Form.make (Form.Kw k) kt.loc ]
| _ -> []
in
let c, _ = expr p in
(match (if w = "while" then as_head p c else None) with
(* [while e? as g]: [(while true (if-let [g e] (do body) (break)))]. A
break or continue in the body is this loop's. *)
| Some m ->
expect_line_end p ~after:(w ^ " " ^ text_of c ^ " as ...");
let body = block s ~after:w in
let c = cond_head p in
let binds =
let is_as (f : Form.t) =
match f.v with Form.List ({ v = Form.Sym "as"; _ } :: _) -> true | _ -> false
in
match c.v with
| Form.List ({ v = Form.Sym "and"; _ } :: xs) -> List.exists is_as xs
| _ -> is_as c
in
if binds && w = "until" then
failk "as-until" c.Form.loc
"until runs while its test does not hold, so as would name what a \
test found when it found nothing. Write while, with the test the \
other way round";
expect_line_end p ~after:(w ^ " " ^ text_of c);
let body = block s ~after:w in
if binds then
(* [while c]: [(while true (if c (do body) (break)))], so what [c]
binds reaches the body. A break or continue in the body is this
loop's, and a continue tests [c] again. *)
let at = c.Form.loc in
let f items = Form.make (Form.List items) at in
form (label @ [ sym at "true";
f [ sym at "if-let"; m; f (sym at "do" :: body); f [ sym at "break" ] ] ])
| None ->
expect_line_end p ~after:(w ^ " " ^ text_of c);
let body = block s ~after:w in
form (label @ (c :: body)))
form (label @ [ sym at "true"; f [ sym at "if"; c; f (sym at "do" :: body); f [ sym at "break" ] ] ])
else form (label @ (c :: body))
| "for" ->
let label =
match (peek p).tok with

4
lib/load.ml
View File

@ -255,7 +255,9 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr =
(bound, []) bs
in
Ast.Let (List.rev bs, List.map (rename_expr owned alias bound) body)
| Ast.If (c, t, e') -> Ast.If (go c, go t, Option.map go e')
(* What an [as] in the condition binds is bound in the block. *)
| Ast.If (c, t, e') ->
Ast.If (go c, rename_expr owned alias (Ast.as_binds c @ bound) t, Option.map go e')
| Ast.While (l, c, body) -> Ast.While (l, go c, gos body)
(* A loop's names are its own and are never imported; its initial
values and its body are ordinary expressions. *)

24
lib/parse.ml
View File

@ -508,6 +508,8 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr =
| _ -> fail f "?. is (?. [name value] body)")
(* Short-circuiting, so they cannot be ordinary calls. *)
| Sym "and" when List.exists is_as args -> as_chain f args
| Sym "as" -> as_chain f [ f ]
| Sym "and" -> shortcircuit f args ~is_and:true
| Sym "or" -> shortcircuit f args ~is_and:false
@ -1303,6 +1305,28 @@ and cond f (args : Form.t list) : Ast.expr =
actually fix it is check_if preferring the arm that is not a compiler temp
when it reports, which is check.ml's call. Written up in TODO.org, "and's
last operand gets a misdirected caret". *)
(* [(as g e)]: the test that [e] holds a value, naming it [g] (decision
136). The reader writes one only as a condition or a test of the [and]
chain that is one. Each test of that chain is an [If] whose else is
[false], and each [as] an [IfLet] over the plain name [g] whose body is
the rest of the chain and whose else is [false]; [Check.as_cond] reads
that shape and gives [g] to the block the condition guards as well. *)
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
let rec go = function
| [] -> { Ast.e = Ast.Var "true"; loc = f.loc }
| [ x ] when not (is_as x) -> expr x
| ({ v = List [ { v = Sym "as"; _ }; { v = Sym g; _ }; e ]; _ } as x) :: rest ->
let arm = { Ast.pat = Ast.Pctor (g, []); body = [ go rest ]; aloc = x.loc } in
{ Ast.e = Ast.IfLet (expr e, arm, Some (no x)); loc = x.loc }
| 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
and shortcircuit f (args : Form.t list) ~is_and : Ast.expr =
let mk e = { Ast.e; loc = f.loc } in
let rec go = function

32
spec-syntax.md
View File

@ -287,7 +287,7 @@ Each item: the proposal, then the reason in one line.
Kept with no `else` at the end of its chain, it gives an Option as `when` does.
`P` is any `match` pattern, and its names are bound in the block only. One
line: `if let Some(g) = o then g else 0`. A plain name, `if let g = o`, is
refused toward `if o?` and `if o? as g` below; `_` is refused toward `let`.
refused toward `if o?` and `if o as g` below; `_` is refused toward `let`.
**Built.**
- **`x?` tests that a value is present** (decision 133): a bool, true when an
Option is `Some` and when a dyn is not `nil`. It reads `(? x)`. In `if x?`,
@ -299,15 +299,33 @@ Each item: the proposal, then the reason in one line.
present; giving it an Option is refused, and a parameter or a captured copy
is no more assignable than outside it. A local whose address is taken, or
that a `fn` assigns, anywhere in the function is not narrowed (something
else could clear it); `if x? as g` copies what it holds instead. A `?` after
else could clear it); `if x as g` copies what it holds instead. A `?` after
a chain tests the whole chain: `o?.i?`. A capitalised name before `?` is
read as a type, so a local tested this way needs a lowercase name.
**Built.**
- **`e? as g`** names what a test found, for an `e` that is not a plain name:
`if get(grid, r, c)? as cell` reads `(if-let [cell (get grid r c)] …)`, an
`if-let` over a plain name, which binds what an Option holds or a dyn that
is not `nil`. It works after `if`, `elif` and `while`; `while e? as g` plus
a block reads `(while true (if-let [g e] (do …) (break)))`. **Built.**
- **`e as g`** tests that `e` holds a value and names it `g` (decisions 133,
136): an Option that is `Some` binds its payload, a dyn that is not `nil`
binds itself. `e? as g` is the same test. Over any other type it is
refused; `as` is never a conversion, which is written `i32(x)`. It stands
after `if`, `elif`, `while` and a one-line `if … then` or kept `when`, as
the whole condition or as any test of an `and` chain, and `g` is bound for
the rest of that chain and for the block: Swift's `if let g = e, c`.
```
if get(grid, r + 1, c - 1) as g and is-empty-cell(g)
move(g)
if a as x and b as y and x < y
println(x, y)
let left = when get(grid, r + 1, c - 1) as g and is-empty-cell(g) then g
```
The tests run left to right and stop at the first that fails, so each
value is found once. `g` is not bound in the `else`, in an `elif` or after
the block. It is refused under `or` and `not`, and after `until`, where the
block could run with nothing found. `x?` on a plain local narrows beside it
in the same chain. Reads `(as g e)` in the test's place, `(when (and a (as
g e) (f g)) …)`; `while c` with one reads `(while true (if c (do …)
(break)))`. **Built.**
- **`while c`, `until c`**, optional label first: `while :outer c`. **Built.**
- **`for i in range(n)`**, `range(a, b)`, `range(a, b, step)` read as
`dotimes`. `range` here is syntax, not a function. `..` is avoided because

31
test/programs/as-chain-dyn.fln Normal file
View File

@ -0,0 +1,31 @@
;; e as g over a dyn inside an and chain (decision 136): g is bound when e
;; is not nil, for the rest of the chain and the block.
fn pet-name(m)
if m.pet as pet and pet != "cat"
pet
elif m.name as who and who != "bo"
who
else
"nobody"
fn first-big(xs, lo)
let found = when get(xs, 0) as x and x > lo then x
found
fn run(m, xs, a, b)
println(pet-name(m), pet-name({:pet "cat" :name "bo"}), pet-name({:name "ann"}))
println(first-big(xs, 0), first-big(xs, 5), first-big([], 0))
let i = 0
let total = 0
while get(xs, i) as x and x > 0
total += x
i += 1
println(total, i)
if a? and get(xs, 1) as y and a + y > 4
println(a + y)
let v = if b as z and z > 1 then z else -1
println(v)
fn main()
run({:pet "dog" :name "ann"}, [4, 2, 0, 7], 3, nil)

90
test/programs/as-chain.fln Normal file
View File

@ -0,0 +1,90 @@
;; e as g inside an and chain (decision 136): g is bound for the rest of the
;; chain and for the block, and not in the else, an elif or after the block.
;; e? as g is the same test.
struct Grain
color-idx: i32
let calls: i32 = 0
fn get-cell(grid: [4 i32], i: i32) -> Grain?
calls += 1
if i < 0 or i >= 4
return None
Some(Grain{.color-idx grid[i]})
fn is-empty-cell(g: Grain) -> bool
g.color-idx < 0
fn tick(n: i32) -> i32
calls += 1
print(n, "")
n
fn half(n: i32) -> i32?
calls += 1
if n % 2 == 0 then Some(n / 2) else None
fn classify(grid: [4 i32], i: i32) -> str
if get-cell(grid, i) as g and is-empty-cell(g)
"empty"
elif get-cell(grid, i) as g and g.color-idx > 1
"big"
elif half(i) as h and h > 0
"half"
else
"other"
fn main()
let grid = [1, -1, 2, -3]
;; A block if, with an else that does not see g.
let g = 100
if get-cell(grid, 1) as g and is-empty-cell(g)
println("empty", g.color-idx)
if get-cell(grid, 0) as g and is-empty-cell(g)
println("empty", g.color-idx)
else
println("else sees the outer g", g)
println("after", g)
;; A kept when gives a Grain?.
let left = when get-cell(grid, 3) as g and is-empty-cell(g) then g
println(left!.color-idx)
let none: Grain? = when get-cell(grid, 0)? as g and is-empty-cell(g) then g
println(none?)
;; Two bindings, and a test over both.
let a: i32? = Some(3)
let b: i32? = Some(5)
if a as x and b as y and x < y
println(x, y)
if a as x and b as y and x > y
println(x, y)
else
println("not less")
;; One line, in a let.
let v = if half(8) as h and h > 3 then h * 10 else -1
let w = if half(6) as h and h > 3 then h * 10 else -1
println(v, w)
;; An elif chain.
println(classify(grid, 1), classify(grid, 2), classify(grid, 0), classify(grid, 4), classify(grid, 5))
;; Each value is found once, left to right, and a failed test stops the chain.
calls = 0
if tick(1) > 0 and half(tick(2)) as h and tick(3) + h > 0
println("ran", h)
println(calls)
calls = 0
if tick(1) > 0 and half(tick(3)) as h and tick(5) + h > 0
println("ran", h)
else
println("stopped")
println(calls)
;; x? narrows beside as in one chain.
let n: i32? = Some(40)
if n? and half(n) as h and n + h > 50
println(n + h)
;; while: pop while the next cell is empty.
let i = 1
let seen = 0
while get-cell(grid, i) as c and is-empty-cell(c)
seen += c.color-idx
i += 2
println(seen, i)

7
test/test_acceptance.ml
View File

@ -2275,7 +2275,12 @@ let () =
outputs ~x86:true (path ^ ", --x86") ("programs/" ^ path) want)
[ ("optionals.fln", optionals_out); ("optionals-dyn.fln", optionals_dyn_out);
(* x? tests and narrows, e? as g names what it found (decision 133). *)
("presence.fln", "true false true\n6\n-1\n3\n101 209 0\n11\n42\n2\nabsent\n6\nfalse true\n3\n6\n15\n"); ("presence-dyn.fln", "true false\n103 209 0\nno pet\nann\n3 2\n") ];
("presence.fln", "true false true\n6\n-1\n3\n101 209 0\n11\n42\n2\nabsent\n6\nfalse true\n3\n6\n15\n"); ("presence-dyn.fln", "true false\n103 209 0\nno pet\nann\n3 2\n");
(* e as g inside an and chain, typed and dyn (decision 136). *)
("as-chain.fln",
"empty -1\nelse sees the outer g 100\nafter 100\n-3\nfalse\n3 5\nnot less\n40 -1\n\
empty big other half other\n1 2 3 ran 1\n4\n1 3 stopped\n3\n60\n-4 5\n");
("as-chain-dyn.fln", "dog nobody ann\n4 nil nil\n6 2\n5\n-1\n") ];
(* x! over nothing traps at its site and names the expression. *)
List.iter
(fun (x86, arg, want) ->

48
test/test_syntax.ml
View File

@ -1409,21 +1409,49 @@ let () =
found; if let over a plain name is refused toward those. *)
refuses "if let over a plain name" "if let g = x\n g" "indent/if-let-name"
"write if x?, and in the block it is what it holds; to name what it holds, \
write if x? as g";
write if x as g";
reads "x? is a test" "y = f(x)? and not z.w?" "(set y (and (? (f x)) (not (? (.w z)))))";
reads "e? as g" "if f(x)? as g\n g\nelif y? as h\n h\nelse\n 0"
"(if-let [g (f x)] g (if-let [h y] h 0))";
reads "one-line e? as g" "v = if y? as h then h else 0" "(set v (if-let [h y] h 0))";
"(cond (as g (f x)) g (as h y) h :else 0)";
reads "one-line e? as g" "v = if y? as h then h else 0" "(set v (if (as h y) h 0))";
reads "while e? as g" "while pop(s)? as x\n f(x)"
"(while true (if-let [x (pop s)] (do (f x)) (break)))";
refuses "as after no test" "if x as y\n y" "indent/as-test" "Write x? as name";
"(while true (if (as x (pop s)) (do (f x)) (break)))";
(* Decision 136: e as g without the ?, and inside an and chain. *)
reads "e as g" "if f(x) as g\n g" "(when (as g (f x)) g)";
reads "as in an and chain" "if a and f(x) as g and g > 1 and b\n g"
"(when (and a (as g (f x)) (> g 1) b) g)";
reads "two as in one chain" "v = if a as x and b? as y and x < y then x else y"
"(set v (if (and (as x a) (as y b) (< x y)) x y))";
reads "a kept when with as" "left = when get(grid, r + 1, c - 1) as g and is-empty-cell(g) then g"
"(set left (when (and (as g (get grid (+ r 1) (- c 1))) (is-empty-cell g)) g))";
reads "while as and" "while pop(s) as x and x > 0\n f(x)"
"(while true (if (and (as x (pop s)) (> x 0)) (do (f x)) (break)))";
reads "elif as and" "if a\n 1\nelif f(x) as g and g > 1\n g"
"(cond a 1 (and (as g (f x)) (> g 1)) g)";
refuses "as under or" "if a or f(x) as g\n g" "indent/as-or" "Bind with as in an if of its own";
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 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";
"It is not a conversion" ];
refused "as-not-in-else.fln"
"fn f(o: i32?) -> i32\n if o as g and g > 1\n g\n else\n g\n\nfn main()\n println(f(None))\n"
[ "unknown name g" ];
refused "as-not-in-elif.fln"
"fn f(o: i32?) -> i32\n if o as g and g > 1\n g\n elif g > 0\n 1\n else\n 0\n\nfn main()\n println(f(None))\n"
[ "unknown name g" ];
refused "as-not-after.fln"
"fn f(o: i32?) -> i32\n if o as g and g > 1\n println(g)\n g\n\nfn main()\n println(f(None))\n"
[ "unknown name g" ];
refused "present-i32.fln" "fn main()\n let x = 5\n println(x?)\n"
[ "x is i32, which always holds a value, so x? has nothing to test";
"a yes-or-no name starts with is- or has-, as in is-x" ];
refused "narrowed-set.fln"
"fn main()\n let x: i32? = Some(1)\n if x?\n x = None\n println(x ?? 0)\n"
[ "x is tested with x? above, so in this block it is i32";
"while x? as item" ];
"while x as item" ];
refused "not-narrowed-in-else.fln"
"fn main()\n let x: i32? = None\n if x?\n println(x + 1)\n else\n println(x + 1)\n"
[ "Option(i32)" ];
@ -1457,7 +1485,7 @@ let () =
reads "a trailing ? tests the whole chain" "y = o?.i?"
"(set y (? (?. [~o1 o] (.i ~o1))))";
reads "and ? then as binds the chain's result" "if d?.k? as k\n k"
"(if-let [k (?. [~o1 d] (.k ~o1))] k)";
"(when (as k (?. [~o1 d] (.k ~o1))) k)";
refused "narrowed-param.fln"
"fn f(x: i32?)\n if x?\n x += 100\n\nfn main()\n f(Some(1))\n"
[ "x is a parameter, and a parameter is not assignable" ];
@ -1465,7 +1493,7 @@ let () =
"fn main()\n let x: i32? = Some(1)\n if x?\n x.n = 1\n"
[ "so here it is what the Option holds, i32, and i32 has no fields" ];
refuses "a chain is no place, and the fix is a test" "q?.x = 5" "indent/chain-assign"
"Test it first: if q?, and in the block q is what it holds, or if q? as g";
"Test it first: if q?, and in the block q is what it holds, or if q as g";
refused "lowercase-type-arg.fln"
"struct grain\n w: i32\n\nfn main()\n let v = vec-new(grain?)\n"
[ "grain? here is the test that a value is present, and grain is a type";
@ -1826,9 +1854,9 @@ let () =
| _ -> fail "addr-taken-note.fln checked"
| exception (Loc.Error d | Loc.Errors (d :: _)) ->
if not (List.exists
(fun (n : Loc.note) -> Test_support.contains n.Loc.nmsg "Write if x? as g")
(fun (n : Loc.note) -> Test_support.contains n.Loc.nmsg "Write if x as g")
d.Loc.notes)
then fail "addr-taken-note.fln: no note naming if x? as g on: %s" d.Loc.dmsg
then fail "addr-taken-note.fln: no note naming if x as g on: %s" d.Loc.dmsg
| exception e -> fail "addr-taken-note.fln: %s" (diag_text e)
let () = Test_support.report ~label:"syntax" ()