Merge master into the arity lane.

This commit is contained in:
Joseph Ferano 2026-09-26 18:29:54 +07:00
commit 1215db7d26
26 changed files with 1717 additions and 215 deletions

View File

@ -45,6 +45,21 @@ 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 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 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. found. Rules out =if let g = x= over a plain name, which is refused toward these.
** DONE A T is wrapped where a T? is wanted
CLOSED: [2026-09-26]
Decided (138), like Swift: one level per boundary, the literal built at T first; not
inside a container. Rules out implicit unwrapping: a T? where a T is wanted stays refused.
** DONE A kept when over an Option body flattens one level
CLOSED: [2026-09-26]
Decided (140), reversing 125a: a kept =when=, else-less =if=/=elif= or =if let= chain whose
arm is already a =T?= is a =T?=, and =T= beside =T?= arms is =T?=; a =T??= arm stays =T??=.
Where =T??= is wanted the arm is Some of it. Rules out telling "no branch matched" apart
from "a branch gave None" without asking for =T??=.
** 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 ** 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 =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. body gets a step point of its own.
@ -70,8 +85,8 @@ Option or a dyn holds (130); over any other type, and =_=, it is refused toward
** DONE when as a value, and get as a checked lookup ** DONE when as a value, and get as a checked lookup
CLOSED: [2026-09-26] CLOSED: [2026-09-26]
Every one-armed =if= (and a =cond= with no =:else=) is a =when=; kept — a =let= value, a Every one-armed =if= (and a =cond= with no =:else=) is a =when=; kept — a =let= value, a
call's argument, a lambda's return — it is =Option(T)=, nested over an Option body call's argument, a lambda's return — it is =Option(T)=, and body-or-nil where a dyn is
(Rust's =bool::then=), and body-or-nil where a dyn is wanted. A =_=-inferred return's wanted. Over an Option body it was nested (Rust's =bool::then=, 125a); 140 reversed that. A =_=-inferred return's
last form is not kept. =get= over dyn text or vec is nil when out of range; =.field= still traps. last form is not kept. =get= over dyn text or vec is nil when out of range; =.field= still traps.
** NEXT str and String ** NEXT str and String
@ -820,6 +835,10 @@ One spelling for one operation; != stays, and not= is refused with a suggestion
of !=. of !=.
* Checker * 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 ** 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 =(+ 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. the crossing, as a u64 field read through a view already does.
@ -1633,6 +1652,9 @@ are a dyn vector, except numbers with no common type, which are refused. Rules
out the first element typing the rest. out the first element typing the rest.
* Dev loop * Dev loop
** TODO eval-in-frame can assign names the program cannot
A loop index or a pattern binding in a stopped frame takes =x = …= through eval-expr, where
the program refuses it; only =as= names are marked read-only (=Tast.fn.as_slots=).
** WAIT Three dev-session tests fail intermittently under load ** WAIT Three dev-session tests fail intermittently under load
Parked 2026-09-26 until the features land: "a restart accepted with a read queued behind Parked 2026-09-26 until the features land: "a restart accepted with a read queued behind
it" (test_agent), "a parked session with no main" (test-flan.el), and a connect ENOENT in it" (test_agent), "a parked session with no main" (test-flan.el), and a connect ENOENT in

View File

@ -1854,6 +1854,19 @@ it, so a block pasted at another depth stays one block."
(defun flan-fln--fallback-re (heads) (defun flan-fln--fallback-re (heads)
(concat "^" (regexp-opt heads t) "(" flan-fln--name-re)) (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) (defun flan-fln--return-type-matcher (limit)
"Find the next return type up to LIMIT: after the `->' of a fn header, a "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." lambda or a `Fn(...)' type, and not after a match arm's."
@ -1931,8 +1944,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 ;; The words inside a line: `for i in range(n)', `if c then a else b', a
;; `where' constraint. ;; `where' constraint.
("[ \t]\\(then\\|else\\|in\\|where\\)[ \t]" 1 font-lock-keyword-face) ("[ \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) ("?[ \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'. ;; `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) ("\\_<\\(?:el\\)?if[ \t]+\\(let\\)[ \t]" 1 font-lock-keyword-face)
("[ \t=(,]\\(if\\|when\\)[ \t]" 1 font-lock-keyword-face) ("[ \t=(,]\\(if\\|when\\)[ \t]" 1 font-lock-keyword-face)

View File

@ -967,6 +967,16 @@ defconst(k, 3)
(search-forward "g!") (search-forward "g!")
(backward-char 1) (backward-char 1)
(test-flan-fln--is "the name at x! is x" (thing-at-point 'symbol t) "g")) (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--is "after if x? as g, one level deeper"
(test-flan-fln--tabs "fn f() -> ()\n if o? as g\n|" 1) 4) (test-flan-fln--tabs "fn f() -> ()\n if o? as g\n|" 1) 4)
(with-temp-buffer (with-temp-buffer

View File

@ -91,6 +91,10 @@ and expr_kind =
(Option T) tested by [x?] in the condition above it, read as its (Option T) tested by [x?] in the condition above it, read as its
payload ([if x?] narrowing, decision 133). *) payload ([if x?] narrowing, decision 133). *)
| Narrow of string list * expr | 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}) *) | 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 (* {.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 not name a type, so this node carries no name and is only checkable where
@ -485,6 +489,7 @@ let map_children f (e : expr) : expr =
| IfLet (s, a, e) -> IfLet (ex s, arm a, Option.map ex e) | IfLet (s, a, e) -> IfLet (ex s, arm a, Option.map ex e)
| Chain (n, v, b) -> Chain (n, ex v, ex b) | Chain (n, v, b) -> Chain (n, ex v, ex b)
| Narrow (ns, b) -> Narrow (ns, 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) | 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) | 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) | MapLit (tag, kvs) -> MapLit (tag, List.map (fun (k, v) -> (ex k, ex v)) kvs)
@ -609,7 +614,14 @@ let mark_pause ?fn ~line ~col (ds : decl list) : decl list option =
reports, and the line DWARF names, nowhere. *) reports, and the line DWARF names, nowhere. *)
{ e with e = Do [ pause_call ?fn e.loc; e ] } { e with e = Do [ pause_call ?fn e.loc; e ] }
end 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 in
let body es = List.map walk es in let body es = List.map walk es in
let decl (d : decl) = let decl (d : decl) =
@ -637,3 +649,29 @@ let mark_pause ?fn ~line ~col (ds : decl list) : decl list option =
in in
let ds = List.map decl ds in let ds = List.map decl ds in
if !hit then Some ds else None 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"
(* [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"; _ })
when as_name g -> g :: as_binds q
| _ -> []

File diff suppressed because it is too large Load Diff

View File

@ -4881,7 +4881,7 @@ let emit_startup m ?(hidden = false) (globals : Tast.global list) =
own to live in. *) own to live in. *)
List.iter (emit_global m ~hidden) flags; List.iter (emit_global m ~hidden) flags;
emit_fn m ~hidden 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; ret = Types.Unit; body; fdefers = []; fenv = None; fparent = None;
floc = (List.hd computed).Tast.ginit.Tast.loc }; floc = (List.hd computed).Tast.ginit.Tast.loc };
true true
@ -5072,6 +5072,7 @@ declare void @flan_alloc_set_budget(ptr, i64)
; ever looks inside one, so every operation on a dyn value is one of these. ; ever looks inside one, so every operation on a dyn value is one of these.
declare i64 @flan_dyn_nil() declare i64 @flan_dyn_nil()
declare i64 @flan_dyn_from_i64(i64) declare i64 @flan_dyn_from_i64(i64)
declare i64 @flan_dyn_from_u64(i64, ptr, i64)
declare i64 @flan_dyn_from_f64(double) declare i64 @flan_dyn_from_f64(double)
declare i64 @flan_dyn_from_bool(i32) declare i64 @flan_dyn_from_bool(i32)
declare i64 @flan_dyn_from_bytes(ptr, i64) declare i64 @flan_dyn_from_bytes(ptr, i64)
@ -5153,6 +5154,8 @@ declare ptr @flan_dev_literal(ptr, i64)
declare i64 @flan_dyn_need_i64(i64) declare i64 @flan_dyn_need_i64(i64)
declare double @flan_dyn_need_f64(i64) declare double @flan_dyn_need_f64(i64)
declare i32 @flan_dyn_need_bool(i64) declare i32 @flan_dyn_need_bool(i64)
declare double @flan_dyn_need_f64_at(i64, ptr, i64)
declare i32 @flan_dyn_need_bool_at(i64, ptr, i64)
declare i32 @flan_dyn_need_i32(i64, ptr, i64) declare i32 @flan_dyn_need_i32(i64, ptr, i64)
declare i64 @flan_dyn_need_int(i64, i32, ptr, i64) declare i64 @flan_dyn_need_int(i64, i32, ptr, i64)
declare i64 @flan_dyn_int_of(i64) declare i64 @flan_dyn_int_of(i64)

View File

@ -1005,7 +1005,7 @@ let no_place (e : Form.t) =
failk "chain-assign" e.loc failk "chain-assign" e.loc
"%s is an optional chain, and a chain cannot be assigned to: when it \ "%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 \ 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 (text_of e) r r r
| Form.List [ { v = Form.Sym "!!"; _ }; x ] -> | Form.List [ { v = Form.Sym "!!"; _ }; x ] ->
let r = text_of x in let r = text_of x in
@ -1456,6 +1456,13 @@ and primary p : Form.t * int =
(match (peek p).tok with (match (peek p).tok with
| RP -> ignore (advance p) | RP -> ignore (advance p)
| EOF -> unclosed p '(' l0 | 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 -> | COMMA ->
failk "tuple" (peek p).loc failk "tuple" (peek p).loc
"parentheses group one value, and this comma starts a second. \ "parentheses group one value, and this comma starts a second. \
@ -1487,12 +1494,7 @@ and if_expr p =
let t = advance p in let t = advance p in
let word = match t.tok with NAME w -> w | _ -> "if" 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 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 c = match letp with Some m -> m | None -> cond_head p 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
(match (peek p).tok with (match (peek p).tok with
| NAME "then" -> ignore (advance p) | NAME "then" -> ignore (advance p)
| _ -> | _ ->
@ -1533,53 +1535,89 @@ and if_let_head p =
failk "if-let-name" pat.loc failk "if-let-name" pat.loc
"if let %s = %s has no pattern to test. To test that %s holds a \ "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 \ 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 g (text_of v) (text_of v) (text_of v) (text_of v) g
| _ -> ()); | _ -> ());
Some (mk p lt.loc (Form.Vec [ pat; v ])) Some (mk p lt.loc (Form.Vec [ pat; v ]))
| _ -> None | _ -> None
(* [e? as g]: after a test [e?], the name what [e] holds is bound to, as (* A condition, where [e as g] may stand as a test of a top-level [and]
the head [[g e]] an [if let] over a plain name stands as (decision 133). *) chain (decisions 133, 136): [e] holds a value, and [g] names it for the
and as_head p (c : Form.t) = 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 match (peek p).tok with
| NAME "as" -> | NAME "as" -> as_chain p x lvl
let at = advance p in | _ -> x
(match c.v with
| Form.List [ { v = Form.Sym "?"; _ }; e ] -> and as_chain p (x : Form.t) lvl =
let g = let at = advance p in
match (peek p).tok with let refuse_or loc =
| NAME g when g <> "" && g.[0] <> '.' -> failk "as-or" loc
let gt = advance p in "as names what a test found, for the rest of an and chain and the \
check_name gt g; block. With or, the block can run when that test did not hold, and \
sym gt.loc g there would be nothing to name. Bind with as in an if of its own, and \
| tk -> test the rest inside it"
failk "as-name" (where_ p) "as takes the name to bind, and found %s" (show tk) in
in let items (f : Form.t) =
Some (Form.make (Form.Vec [ g; e ]) c.loc) match f.v with
| _ -> | Form.List ({ v = Form.Sym "and"; _ } :: (_ :: _ as xs)) -> xs
(* [a |> f? as g] would test [f] alone: a compound test is bracketed. *) | _ -> [ f ]
let t = text_of c in in
let compound = (* Level 1 is an [or], or a pipe, which is loosest: [a |> f(1) as v]
let depth = ref 0 and quoted = ref false and hit = ref false in names what the pipe answers. *)
String.iteri let is_or (f : Form.t) =
(fun i ch -> match f.v with Form.List ({ v = Form.Sym "or"; _ } :: _) -> true | _ -> false
if !quoted then in
(if ch = '"' && (i = 0 || t.[i - 1] <> '\\') then quoted := false) if lvl = 1 && is_or x then refuse_or x.loc;
else let before, last =
match ch with match List.rev (if lvl = 2 then items x else [ x ]) with
| '"' -> quoted := true | last :: rb -> (List.rev rb, last)
| '(' | '[' | '{' -> incr depth | [] -> ([], x)
| ')' | ']' | '}' -> decr depth in
| ' ' when !depth = 0 -> hit := true (match last.v with
| _ -> ()) | Form.List ({ v = Form.Sym "not"; _ } :: _) ->
t; failk "as-not" at.loc
!hit "as names what a test found, and not turns the test around: the \
in block runs when %s holds nothing, so there is nothing to name. Bind \
failk "as-test" at.loc with as, and put what runs when it is absent in the else"
"as names what a test found, and %s is not one. Write %s? as name" (text_of last)
t (if compound then "(" ^ t ^ ")" else t)) | Form.List ({ v = Form.Sym "or"; _ } :: _) -> refuse_or last.loc
| _ -> None | _ -> ());
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] >= 'A' && g.[0] <= 'Z' ->
failk "as-name" (where_ p)
"as binds a name to what %s holds, and %s is a case, not a name. \
Match a pattern with if let, as in if let %s(v) = %s"
(text_of e) g g (text_of e)
| 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 = mk p last.loc (Form.List [ sym at.loc "as"; g; e ]) 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 && is_or y 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 -> mk p x.loc (Form.List (sym x.loc "and" :: xs))
(* The if an [if let] head was read into, rewritten to (if-let [P v] then (* 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 else): [(if [P v] a b)], [(when [P v] body ...)] and an elif chain's
@ -2855,12 +2893,7 @@ and header (s : st) w : Form.t =
form [ alias; path ] form [ alias; path ]
| "if" | "when" -> | "if" | "when" ->
let letp = if w = "if" then if_let_head p else None in 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 c = match letp with Some m -> m | None -> cond_head p 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
(* The elif and else clauses at the if's column, then the whole form. (* 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 [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. *) one-line too, [elif c then x] and [else y], or take blocks. *)
@ -2877,11 +2910,7 @@ and header (s : st) w : Form.t =
let c = let c =
match if_let_head p with match if_let_head p with
| Some m -> elif_lets := m :: !elif_lets; m | Some m -> elif_lets := m :: !elif_lets; m
| None -> | None -> cond_head p
let c = fst (binary p 1) in
(match as_head p c with
| Some m -> elif_lets := m :: !elif_lets; m
| None -> c)
in in
(match (peek p).tok with (match (peek p).tok with
| NAME "then" when oneline -> | NAME "then" when oneline ->
@ -2993,21 +3022,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 ] | KW k, n when n <> NEWLINE -> let kt = advance p in [ Form.make (Form.Kw k) kt.loc ]
| _ -> [] | _ -> []
in in
let c, _ = expr p in let c = cond_head p in
(match (if w = "while" then as_head p c else None) with let binds =
(* [while e? as g]: [(while true (if-let [g e] (do body) (break)))]. A let is_as (f : Form.t) =
break or continue in the body is this loop's. *) match f.v with Form.List ({ v = Form.Sym "as"; _ } :: _) -> true | _ -> false
| Some m -> in
expect_line_end p ~after:(w ^ " " ^ text_of c ^ " as ..."); match c.v with
let body = block s ~after:w in | 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 at = c.Form.loc in
let f items = Form.make (Form.List items) at in let f items = Form.make (Form.List items) at in
form (label @ [ sym at "true"; form (label @ [ sym at "true"; f [ sym at "if"; c; f (sym at "do" :: body); f [ sym at "break" ] ] ])
f [ sym at "if-let"; m; f (sym at "do" :: body); f [ sym at "break" ] ] ]) else form (label @ (c :: body))
| None ->
expect_line_end p ~after:(w ^ " " ^ text_of c);
let body = block s ~after:w in
form (label @ (c :: body)))
| "for" -> | "for" ->
let label = let label =
match (peek p).tok with match (peek p).tok with

View File

@ -255,7 +255,9 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr =
(bound, []) bs (bound, []) bs
in in
Ast.Let (List.rev bs, List.map (rename_expr owned alias bound) body) 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) | 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 (* A loop's names are its own and are never imported; its initial
values and its body are ordinary expressions. *) values and its body are ordinary expressions. *)
@ -295,6 +297,7 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr =
| Ast.Chain (n, v, b) -> | Ast.Chain (n, v, b) ->
Ast.Chain (n, go v, rename_expr owned alias (n :: bound) b) Ast.Chain (n, go v, rename_expr owned alias (n :: bound) b)
| Ast.Narrow (ns, b) -> Ast.Narrow (ns, go 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. (* A quoted symbol naming something the package declares.
[(Form.Sym {.s "Cursor"})] is what a quasiquote desugars to, and it is [(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 the one place a package's name survives into a *string* — which is
@ -858,7 +861,7 @@ let rec expr_uses acc (e : Ast.expr) =
go sc; List.iter (fun (a : Ast.arm) -> gos a.Ast.body) arms 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.IfLet (sc, a, e') -> go sc; gos a.Ast.body; Option.iter go e'
| Ast.Chain (_, v, b) -> go v; go b | 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) -> | Ast.Struct (n, kvs) ->
acc := (n, e.Ast.loc) :: !acc; acc := (n, e.Ast.loc) :: !acc;
List.iter (fun (_, v) -> go v) kvs List.iter (fun (_, v) -> go v) kvs

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)") | _ -> fail f "?. is (?. [name value] body)")
(* Short-circuiting, so they cannot be ordinary calls. *) (* 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 "and" -> shortcircuit f args ~is_and:true
| Sym "or" -> shortcircuit f args ~is_and:false | Sym "or" -> shortcircuit f args ~is_and:false
@ -1303,6 +1305,33 @@ and cond f (args : Form.t list) : Ast.expr =
actually fix it is check_if preferring the arm that is not a compiler temp 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 when it reports, which is check.ml's call. Written up in TODO.org, "and's
last operand gets a misdirected caret". *) 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 =
(* 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
| ({ 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
(* 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 = and shortcircuit f (args : Form.t list) ~is_and : Ast.expr =
let mk e = { Ast.e; loc = f.loc } in let mk e = { Ast.e; loc = f.loc } in
let rec go = function let rec go = function

View File

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

View File

@ -354,6 +354,10 @@ type fn = {
backend is free to ignore it entirely -- nothing is *resolved* through it, backend is free to ignore it entirely -- nothing is *resolved* through it,
and a slot is still only ever referred to by index. *) and a slot is still only ever referred to by index. *)
snames : string option array; 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; ret : Types.t;
body : expr list; body : expr list;
(* The defers again, innermost first. [body] already has them spliced onto (* The defers again, innermost first. [body] already has them spliced onto

View File

@ -1909,6 +1909,26 @@ flan_dyn flan_dyn_from_i64(int64_t x) {
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
} }
/* A u64 has a dyn int to become only up to the largest i64; past it the trap
* names the number, which read as an i64 would be a different one. [what] is
* "u64" for a scalar crossing and "u64 element" for one read through a view,
* so both say the same sentence. */
static flan_dyn u64_to_dyn(const uint8_t *loc, int64_t loclen, const char *op,
const char *what, uint64_t x) {
if (x > (uint64_t)INT64_MAX) {
flan_say(loc, loclen,
"dyn%s%s: this %s is %llu, above the largest dyn int "
"(9223372036854775807), so it has no dyn value",
op[0] ? " " : "", op, what, (unsigned long long)x);
dyn_trap((const uint8_t *)"DynRange", 8);
}
return flan_dyn_from_i64((int64_t)x);
}
flan_dyn flan_dyn_from_u64(uint64_t x, const uint8_t *loc, int64_t loclen) {
return u64_to_dyn(loc, loclen, "", "u64", x);
}
flan_dyn flan_dyn_from_f64(double x) { flan_dyn flan_dyn_from_f64(double x) {
flan_dyn v; flan_dyn v;
/* Every NaN becomes the one positive quiet NaN, which is what keeps a /* Every NaN becomes the one positive quiet NaN, which is what keeps a
@ -2797,11 +2817,14 @@ int64_t flan_dyn_need_i64(flan_dyn v) {
* makes rather than a surprise somebody meets. Softening the check here is the * makes rather than a surprise somebody meets. Softening the check here is the
* option not to take: this function sees a tag and nothing else, so it could * option not to take: this function sees a tag and nothing else, so it could
* not tell (g 1) from (g (length xs)). */ * not tell (g 1) from (g (length xs)). */
double flan_dyn_need_f64(flan_dyn v) { /* The _at forms trap at the site the checker hands over; the plain ones are
* for C callers that have none. */
double flan_dyn_need_f64_at(flan_dyn v, const uint8_t *loc, int64_t loclen) {
if (flan_dyn_tag(v) != FLAN_DYN_TAG_FLOAT) if (flan_dyn_tag(v) != FLAN_DYN_TAG_FLOAT)
trap1(NULL, 0, TYPE_TRAP, "f64", "a float was wanted", v); trap1(loc, loclen, TYPE_TRAP, "f64", "a float was wanted", v);
return dyn_num_value(v); return dyn_num_value(v);
} }
double flan_dyn_need_f64(flan_dyn v) { return flan_dyn_need_f64_at(v, NULL, 0); }
static const char *an(const char *w); /* forward: "a" or "an" */ static const char *an(const char *w); /* forward: "a" or "an" */
@ -2894,11 +2917,12 @@ uint32_t flan_dyn_need_char(flan_dyn v, const uint8_t *loc, int64_t loclen) {
flan_trap((const uint8_t *)"DynType", 7); flan_trap((const uint8_t *)"DynType", 7);
} }
uint8_t flan_dyn_need_bool(flan_dyn v) { uint8_t flan_dyn_need_bool_at(flan_dyn v, const uint8_t *loc, int64_t loclen) {
if (flan_dyn_tag(v) != FLAN_DYN_TAG_BOOL) if (flan_dyn_tag(v) != FLAN_DYN_TAG_BOOL)
trap1(NULL, 0, TYPE_TRAP, "bool", "a bool was wanted", v); trap1(loc, loclen, TYPE_TRAP, "bool", "a bool was wanted", v);
return (uint8_t)(dyn_payload(v) ? 1 : 0); return (uint8_t)(dyn_payload(v) ? 1 : 0);
} }
uint8_t flan_dyn_need_bool(flan_dyn v) { return flan_dyn_need_bool_at(v, NULL, 0); }
/* ── A numeric cast opening a box ─────────────────────────────────────── /* ── A numeric cast opening a box ───────────────────────────────────────
* *
@ -4046,14 +4070,7 @@ static flan_dyn view_read(const uint8_t *loc, int64_t loclen, const char *op,
case 'L': { case 'L': {
uint64_t x; uint64_t x;
memcpy(&x, p, 8); memcpy(&x, p, 8);
if (x > (uint64_t)INT64_MAX) { return u64_to_dyn(loc, loclen, op, "u64 element", x);
flan_say(loc, loclen,
"dyn %s: this u64 element is %llu, above the largest dyn int "
"(9223372036854775807), so it has no dyn value",
op, (unsigned long long)x);
dyn_trap((const uint8_t *)"DynRange", 8);
}
return flan_dyn_from_i64((int64_t)x);
} }
case 'f': { float x; memcpy(&x, p, 4); return flan_dyn_from_f64((double)x); } case 'f': { float x; memcpy(&x, p, 4); return flan_dyn_from_f64((double)x); }
case 'd': { double x; memcpy(&x, p, 8); return flan_dyn_from_f64(x); } case 'd': { double x; memcpy(&x, p, 8); return flan_dyn_from_f64(x); }

View File

@ -86,6 +86,8 @@ typedef struct flan_desc {
flan_dyn flan_dyn_nil(void); flan_dyn flan_dyn_nil(void);
flan_dyn flan_dyn_from_i64(int64_t x); flan_dyn flan_dyn_from_i64(int64_t x);
/* Traps at [loc] on a u64 above the largest i64, which no dyn int holds. */
flan_dyn flan_dyn_from_u64(uint64_t x, const uint8_t *loc, int64_t loclen);
flan_dyn flan_dyn_from_f64(double x); flan_dyn flan_dyn_from_f64(double x);
flan_dyn flan_dyn_from_bool(uint8_t b); flan_dyn flan_dyn_from_bool(uint8_t b);
@ -304,6 +306,9 @@ void flan_dyn_emit_watch(flan_dyn v);
int64_t flan_dyn_need_i64(flan_dyn v); int64_t flan_dyn_need_i64(flan_dyn v);
double flan_dyn_need_f64(flan_dyn v); double flan_dyn_need_f64(flan_dyn v);
uint8_t flan_dyn_need_bool(flan_dyn v); uint8_t flan_dyn_need_bool(flan_dyn v);
/* The same, trapping at the site [loc] names. */
double flan_dyn_need_f64_at(flan_dyn v, const uint8_t *loc, int64_t loclen);
uint8_t flan_dyn_need_bool_at(flan_dyn v, const uint8_t *loc, int64_t loclen);
/* For a typed integer of width [kind], 0..7 for i8 u8 i16 u16 i32 u32 i64 /* For a typed integer of width [kind], 0..7 for i8 u8 i16 u16 i32 u32 i64
* u64: an int in range, or a char's code point where it fits (ASCII only * u64: an int in range, or a char's code point where it fits (ASCII only
* into a byte), as an i64 the caller narrows. Anything else traps at [loc]. * into a byte), as an i64 the caller narrows. Anything else traps at [loc].

View File

@ -244,6 +244,16 @@ Each item: the proposal, then the reason in one line.
holds — `a?.f(x)`, `a?[i]`, `a?.b.c`. A result that is already an Option holds — `a?.f(x)`, `a?[i]`, `a?.b.c`. A result that is already an Option
is not wrapped again, so `a?.b?.c` is one Option. A rest with no value is not wrapped again, so `a?.b?.c` is one Option. A rest with no value
makes the whole a statement. `~o1` is a fresh name no reader produces. makes the whole a statement. `~o1` is a fresh name no reader produces.
- A `T` where a `T?` is wanted is `Some` of it (decision 138): an
assignment, a `let` with a type, an argument, a return, a struct field, an
array or `Vec` element, and an `if` or `match` arm beside an Option arm.
A literal is built at `T` first, so `s = -1` over an `i64?` is `Some(-1)`
at i64. One level at a time: a `T` into a `T??` is `Some(Some(t))`, a `T?`
into a `T??` is `Some` of it. A `$t` meeting `$u?` binds `$u` to `T`.
Never inside a container (`Vec(i32)` is not a `Vec(i32?)`), and never the
other way: a `T?` where a `T` is wanted still needs `!`, `??`, `x?` or
`as`. A kept chain whose arms are a `T` and a `T?` is a `T?` (decision
140, under `when c`). **Built.**
- **Casts and type-taking builtins are calls:** `i32(x)`, `vec-new(u8)`, - **Casts and type-taking builtins are calls:** `i32(x)`, `vec-new(u8)`,
`max-value(u8)`, `the([3 f32], [1 2 3.5])`. A pointer cast is the type `max-value(u8)`, `the([3 f32], [1 2 3.5])`. A pointer cast is the type
called: `Ptr(Color)(p)` reads `((Ptr Color) p)`. **Built.** called: `Ptr(Color)(p)` reads `((Ptr Color) p)`. **Built.**
@ -307,14 +317,20 @@ Each item: the proposal, then the reason in one line.
A `when` whose value is kept (a `let`'s value, an argument, a return) gives A `when` whose value is kept (a `let`'s value, an argument, a return) gives
`Some(a)` when `c` holds and `None` when it does not; where a `dyn` is `Some(a)` when `c` holds and `None` when it does not; where a `dyn` is
wanted, `a` or `nil`. As a statement it gives nothing. An `if`/`elif` chain wanted, `a` or `nil`. As a statement it gives nothing. An `if`/`elif` chain
with no `else` is the same when kept: `None` when no test holds. **Built.** with no `else` is the same when kept: `None` when no test holds. When `a`
is already an Option it is not wrapped again (decision 140): `when c then
o` over an `i32?` is an `i32?`, `None` when `c` fails or `o` is `None`, and
a chain mixing `T` and `T?` arms is a `T?`. One level only: an arm that is
a `T??` gives a `T??`. Where an Option of the arm's type is wanted, as a
`T??` over a `T?` arm, the arm is `Some` of its value and a failed test is
the outer `None`. `if let` with no `else` follows the same rule. **Built.**
- **`if let P = v`** plus a block reads as `(if-let [P v] then)`; `elif` and - **`if let P = v`** plus a block reads as `(if-let [P v] then)`; `elif` and
`else` follow as for `if`, the rest of the chain being the `if-let`'s else. `else` follow as for `if`, the rest of the chain being the `if-let`'s else.
`elif let P = v` is a further `if-let` nested in that else. `elif let P = v` is a further `if-let` nested in that else.
Kept with no `else` at the end of its chain, it gives an Option as `when` does. 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 `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 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.** **Built.**
- **`x?` tests that a value is present** (decision 133): a bool, true when an - **`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?`, Option is `Some` and when a dyn is not `nil`. It reads `(? x)`. In `if x?`,
@ -326,15 +342,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 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 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 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 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. read as a type, so a local tested this way needs a lowercase name.
**Built.** **Built.**
- **`e? as g`** names what a test found, for an `e` that is not a plain name: - **`e as g`** tests that `e` holds a value and names it `g` (decisions 133,
`if get(grid, r, c)? as cell` reads `(if-let [cell (get grid r c)] …)`, an 136): an Option that is `Some` binds its payload, a dyn that is not `nil`
`if-let` over a plain name, which binds what an Option holds or a dyn that binds itself. `e? as g` is the same test. Over any other type it is
is not `nil`. It works after `if`, `elif` and `while`; `while e? as g` plus refused; `as` is never a conversion, which is written `i32(x)`. It stands
a block reads `(while true (if-let [g e] (do …) (break)))`. **Built.** 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.** - **`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 - **`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 `dotimes`. `range` here is syntax, not a function. `..` is avoided because

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)

View File

@ -0,0 +1,92 @@
;; 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)
if half(6) as h and n? and n + h > 40
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)

148
test/programs/autowrap.fln Normal file
View File

@ -0,0 +1,148 @@
;; A T where a T? is wanted is Some of it (decision 138): each position,
;; a literal built at the payload's type, nested Options, generics, and the
;; arms of an if, a match and a kept chain.
struct P
a: i64?
b: i32?
fn show(o: i32?) -> i32 = o ?? -9
fn back(b: bool, x: i32) -> i32?
if b
return x
None
fn pick(b: bool, x: i32) -> i32?
if b then x else None
fn pick2(b: bool, x: i32) -> i32?
if b then None else x
fn two(o: Option(i32?)) -> str
match o
Some(i) -> if i? then "some some" else "some none"
None -> "none"
fn first(o: $u?) -> $u = o!
fn wrap(x: $t) -> $t? = x
;; A generic body's own $t handed to a $u? parameter.
fn through(x: $t) -> $t = first(x)
;; A None arm first takes its type from the arms after it.
fn arms(k: i32, x: i32) -> i32?
match k
5 -> None
4 -> x
_ -> 0
fn big(x: i64?) -> i64 = x ?? 0
;; A T?? is wanted, so each arm is Some of its value and the chain's None is
;; the outer one.
fn chain(a: bool, b: bool, opt: i32?) -> Option(i32?)
if a
1
elif b
opt
;; Nothing wanted: a T arm beside a T? arm makes the chain a T?, flattened
;; one level (decision 140).
fn flat(a: bool, b: bool, opt: i32?) -> i32?
let r =
if a
1
elif b
opt
r
fn main()
;; assignment, and a literal at the payload's width
let s: i64? = None
s = -1
println(s ?? 0)
;; a let with an annotation, from a literal, a name and arithmetic
let x: i32 = 4
let a: i32? = x + 1
let w: i64? = x
let f: f64? = 2
println(a ?? 0, w ?? 0, f ?? 0.0)
;; an argument and a return value
println(show(7), back(true, 8) ?? -1, back(false, 8) ?? -1)
;; a struct field
let p = P{.a 3 .b x}
println(p.a ?? 0, p.b ?? 0)
p.b = 7
println(p.b ?? 0)
;; an array and a Vec element
let xs: [3 i32?] = [1, None, x]
println(xs[0] ?? 0, xs[1] ?? 0, xs[2] ?? 0)
xs[1] = 5
println(xs[1] ?? 0)
let v: Vec(i32?) = vec-new(i32?)
push(v, 6)
push(v, None)
println(length(v), v[0] ?? 0, v[1] ?? 0)
;; the arms of an if and a match
println(pick(true, 2) ?? -1, pick(false, 2) ?? -1, pick2(true, 2) ?? -1, pick2(false, 2) ?? -1)
let m = match x
4 -> x
_ -> None
println(m ?? 0)
println(arms(5, 3) ?? -1, arms(4, 3) ?? -1, arms(1, 3) ?? -1)
;; nested: a T into a T?? is Some(Some(t)), a T? is Some of it
let nn: Option(i32?) = 5
let none: i32? = None
let nn2: Option(i32?) = none
println(two(nn), two(nn2))
;; kept chains over T and T? arms
println(two(chain(true, false, none)), two(chain(false, true, none)), two(chain(false, false, none)))
println(flat(true, false, none) ?? -1, flat(false, true, Some(6)) ?? -1, flat(false, true, none) ?? -1, flat(false, false, none) ?? -1)
let kk =
if x > 9
none
elif x > 1
1
println(kk ?? -1)
;; generics
println(first(9), first(Some(8)), wrap(3) ?? 0, through(5))
;; a literal local takes the payload's type from an Option use, as it
;; takes T from a T use: each pair prints the same
let la = 4
let wa: i64? = la
let lb = 4
let wb: i64 = lb
println(la * 1000000000, lb * 1000000000, wa ?? 0, wb)
let lc = 4
println(big(lc), lc * 1000000000)
let lf = 7
let wf: f64? = lf
let lg = 7
let wg: f64 = lg
println(lf / 2, lg / 2, wf ?? 0.0, wg)
let lu = 200
let wu: u8? = lu
let lv = 200
let wv: u8 = lv
println(wu ?? 0, wv)
;; and from a typed array's element, with or without an Option
let la2 = 3
let xa: [1 i64] = [la2]
let lb2 = 3
let xb: [2 i64?] = [lb2, None]
println(la2 * 1000000000, lb2 * 1000000000, xa[0], xb[0] ?? 0)
;; None first in an if, as in a match
let e1 = if x > 1 then None else 5
let e2 = if x > 1 then 5 else None
println(e1 ?? -1, e2 ?? -1)
;; an Option around an array of Options
let ao: [2 i32?]? = [1, None]
let ai = ao!
println(ai[0] ?? 0, ai[1] ?? 0)
;; a narrowed name still takes a payload value
let o: i32? = Some(1)
if o?
o = 10
println(o)

26
test/programs/dev-as.fln Normal file
View File

@ -0,0 +1,26 @@
;; A program that stops inside an if o as g block (decision 136): the break
;; loop's locals list g, with the value the test found, on both backends.
import agent "vendor:agent"
struct Boom
why: i32
let ticks: i64 = 0
fn look(o: i32?, d) -> i64
if o as g and g > 1 and d as e
restart-case
error(Boom{.why g})
0
restart carry-on()
5
else
0
fn main() -> i32
agent/start("/tmp/flan-dev-as-fallback.sock")
println(look(Some(41), "hi"))
for i in range(4000)
agent/wait(5)
ticks += 1
0

View File

@ -0,0 +1,94 @@
;;;; Typed values crossing into dyn beside a dyn operand: a u64, a dyn nil past
;;;; a fold's pair (a bare nil is refused, see test_flan), and an is-numeric $t.
;;;; With an argument, the program runs the trap that argument names instead.
(defn add-dyn [x $t] dyn
{:where (is-numeric $t)}
(+ x (the dyn 1)))
(defn add-late [x $t d dyn] dyn
{:where (is-numeric $t)}
(+ x 1 d))
(defn dyn-first [x $t d dyn] dyn
{:where (is-numeric $t)}
(* d x 2))
(defn less-late [x $t d dyn] bool
{:where (is-numeric $t)}
(< x 10 d))
(defn biggest [x $t d dyn] dyn
{:where (is-numeric $t)}
(max x d 0))
(defn low-bits [x $t d dyn] dyn
{:where (is-integer $t)}
(bit-and x 7 d))
(defn boxed [x $t] dyn
{:where (is-numeric $t)}
(the dyn x))
(defn main [args [str]] i32
(let [z (the dyn 0)
n (the dyn 4)
small (the u64 9223372036854775807)
big (the u64 18446744073709551615)
nothing (the dyn nil)]
;; A u64 up to the largest i64 crosses as its value.
(println (+ z small) (max small 0 z) (the dyn small) (= small (+ z small)))
;; A $t at i32, f64 and u64, beside a dyn in any position.
(println (add-dyn 2) (add-dyn 2.5) (add-dyn (the u64 7)))
(println (add-late 2 n) (add-late 2.5 n) (dyn-first 3 n) (dyn-first 1.5 n))
(println (less-late 1 n) (less-late 1 (the dyn 20)) (less-late 0.5 (the dyn 10.5)))
(println (biggest 3 n) (biggest -2.5 (the dyn -1)) (low-bits 13 n) (low-bits (the u8 255) n))
(println (boxed 7) (boxed 0.25) (boxed small))
;; A nil past the pair is compared, not refused.
(println (= 1 1 nothing) (!= 1 2 nothing) (= 1 1 (the dyn nil)))
(when (> (length args) 1)
(let [a (at args 1)]
(when (= a "u64") (println (+ z big)))
(when (= a "u64-max") (println (max big 0 z)))
(when (= a "u64-generic") (println (boxed big)))
(when (= a "nil-first") (println (+ (the dyn nil) 1 2)))
(when (= a "nil-last") (println (+ 1 2 (the dyn nil))))
(when (= a "nil-less") (println (< 1 2 (the dyn nil))))
(when (= a "nil-min") (println (min 1 2 nothing)))
(when (= a "nil-bits") (println (bit-or 1 2 nothing)))
;; At a typed want too: the dyn nil traps in any position.
(let [r (the i32 0)]
(when (= a "nil-want-first") (set r (+ (the dyn nil) 1 2)))
(when (= a "nil-want-last") (set r (+ 1 2 (the dyn nil))))
(set r (+ r (at-i32 a))) (the-literal a)
(println r)))))
0)
;; A dyn beside typed operands at an i32 want: the whole form is dyn, and only
;; its answer is opened at i32, so every position wraps nowhere and traps alike.
(defn at-i32 [a str] i32
(let [big (the dyn 2147483647)
none (the dyn nil)]
(cond
(= a "big-first") (+ big 1 1)
(= a "big-mid") (+ 1 big 1)
(= a "big-last") (+ 1 1 big)
(= a "big-pair") (+ 1 big)
(= a "big-shift") (<< big 1)
(= a "i32-nil-first") (+ none 1 1)
(= a "i32-nil-mid") (+ 1 none 1)
(= a "i32-nil-last") (+ 1 1 none)
:else 0)))
;; (the dyn <literal>) is a dyn like any other: beside nil it traps at run
;; time, as a dyn bound to a name does. And opening one at f64 or bool names
;; its site.
(defn the-literal [a str] ()
(let [x (the f64 0.0)
b false]
(when (= a "lit-int") (println (+ (the dyn 1) nil)))
(when (= a "lit-float") (println (+ (the dyn 1.5) nil)))
(when (= a "lit-bool") (println (+ (the dyn true) nil)))
(when (= a "lit-let") (let [d (the dyn 1)] (println (+ d nil))))
(when (= a "want-f64") (set x (the dyn 3)) (println x))
(when (= a "want-bool") (set b (the dyn 3)) (println b))))

View File

@ -21,6 +21,28 @@ fn early(a: Option(i32)) -> Option(i32)
elif true elif true
3 3
;; An arm that is already an Option is the whole, flattened (decision 140).
fn flat(a: Option(i32), o: Option(i32)) -> Option(i32)
if let Some(x) = a then o
;; An Option of it wanted: the arm is Some of its value, and no match is the
;; outer None.
fn nest(a: Option(i32), o: Option(i32)) -> Option(Option(i32))
if let Some(x) = a then o
fn level(oo: Option(Option(i32)))
match oo
Some(o) -> if o? then println(o) else println("some none")
None -> println("none")
fn flat_chain(a: Option(i32), k: i32)
let r =
if let Some(x) = a
x
elif k > 0
None
show(r)
fn dyn_only(a: Option(i32)) -> dyn fn dyn_only(a: Option(i32)) -> dyn
if let Some(x) = a then x if let Some(x) = a then x
@ -40,6 +62,15 @@ fn main()
show(lead(1, None)) show(lead(1, None))
show(early(None)) show(early(None))
show(early(Some(1))) show(early(Some(1)))
show(flat(Some(1), Some(4)))
show(flat(Some(1), None))
show(flat(None, Some(4)))
level(nest(Some(1), Some(4)))
level(nest(Some(1), None))
level(nest(None, Some(4)))
flat_chain(Some(3), 0)
flat_chain(None, 1)
flat_chain(None, 0)
println(dyn_only(Some(5))) println(dyn_only(Some(5)))
println(dyn_only(None)) println(dyn_only(None))
;; As a statement it is unchanged. ;; As a statement it is unchanged.

View File

@ -1,7 +1,8 @@
;;;; A when whose value is kept answers an Option: Some of its body when the ;;;; A when whose value is kept answers an Option: Some of its body when the
;;;; test holds, None when it does not. As a statement it answers nothing. ;;;; test holds, None when it does not. As a statement it answers nothing.
;;;; Where a dyn is wanted it answers the body or nil, since dyn has no ;;;; Where a dyn is wanted it answers the body or nil, since dyn has no
;;;; Option. A body that is already an Option is not flattened. ;;;; Option. A body that is already an Option is that Option, flattened one
;;;; level (decision 140), unless an Option of it is what is wanted.
(defn show [o (Option i32)] () (defn show [o (Option i32)] ()
(match o (Some v) (println v) None (println "none"))) (match o (Some v) (println v) None (println "none")))
@ -9,10 +10,13 @@
;; Returned: the return type is the want. ;; Returned: the return type is the want.
(defn half [n i32] (Option i32) (when (= 0 (% n 2)) (/ n 2))) (defn half [n i32] (Option i32) (when (= 0 (% n 2)) (/ n 2)))
;; Nested, as Rust's bool::then: None from the body stays apart from a ;; An (Option (Option i32)) is wanted, so the body is Some of it and the
;; failed test. ;; failed test is the outer None.
(defn wrap [c bool o (Option i32)] (Option (Option i32)) (when c o)) (defn wrap [c bool o (Option i32)] (Option (Option i32)) (when c o))
;; Flattened: None from the body and a failed test are one answer.
(defn flat [c bool o (Option i32)] (Option i32) (when c o))
(defn level [oo (Option (Option i32))] () (defn level [oo (Option (Option i32))] ()
(match oo (match oo
(Some o) (match o (Some v) (println v) None (println "some none")) (Some o) (match o (Some v) (println v) None (println "some none"))
@ -45,6 +49,12 @@
(level (wrap true (Some 1))) (level (wrap true (Some 1)))
(level (wrap true None)) (level (wrap true None))
(level (wrap false (Some 1))) (level (wrap false (Some 1)))
(show (flat true (Some 4)))
(show (flat true None))
(show (flat false (Some 4)))
(let [o (the (Option i32) (Some 8))
f (when true o)]
(show f))
(println (dyn-when true)) (println (dyn-when true))
(println (dyn-when nil)) (println (dyn-when nil))
(show (early None)) (show (early None))

View File

@ -2226,8 +2226,8 @@ let () =
dyn_if_truthy_out; dyn_if_truthy_out;
(* A kept when is an Option; get is a checked lookup; if let. *) (* A kept when is an Option; get is a checked lookup; if let. *)
let when_value_out = let when_value_out =
"5\nnone\n42\nnone\n9\n1\nsome none\nnone\n5\nnil\n3\nnone\n6\nnone\n20\nnone\n2\n\ "5\nnone\n42\nnone\n9\n1\nsome none\nnone\n4\nnone\nnone\n8\n5\nnil\n3\nnone\n6\nnone\n\
a\nnil\ncond stmt\nran\nend\n" 20\nnone\n2\na\nnil\ncond stmt\nran\nend\n"
in in
outputs "when as a value" "programs/when-value.flan" when_value_out; outputs "when as a value" "programs/when-value.flan" when_value_out;
outputs ~opt:"-O0" "when as a value, -O0" "programs/when-value.flan" when_value_out; outputs ~opt:"-O0" "when as a value, -O0" "programs/when-value.flan" when_value_out;
@ -2246,7 +2246,8 @@ let () =
"5\n100\n0\n9\n1\n20\n100\n0\n1\n7\nabsent\nnorth\n6\n-1\n-2\n14\nwhen block\n" "5\n100\n0\n9\n1\n20\n100\n0\n1\n7\nabsent\nnorth\n6\n-1\n-2\n14\nwhen block\n"
in in
let if_let_kept_out = let if_let_kept_out =
"1\n4\nnone\n6\nnone\n9\n2\nnone\n3\nnone\n5\nnil\n7\n" "1\n4\nnone\n6\nnone\n9\n2\nnone\n3\nnone\n4\nnone\nnone\n4\nsome none\nnone\n\
3\nnone\nnone\n5\nnil\n7\n"
in in
(* One fn, several arities, picked by the number of arguments. *) (* One fn, several arities, picked by the number of arguments. *)
let versions_out = let versions_out =
@ -2282,8 +2283,18 @@ let () =
outputs ~opt:"-O0" (path ^ ", -O0") ("programs/" ^ path) want; outputs ~opt:"-O0" (path ^ ", -O0") ("programs/" ^ path) want;
outputs ~x86:true (path ^ ", --x86") ("programs/" ^ path) want) outputs ~x86:true (path ^ ", --x86") ("programs/" ^ path) want)
[ ("optionals.fln", optionals_out); ("optionals-dyn.fln", optionals_dyn_out); [ ("optionals.fln", optionals_out); ("optionals-dyn.fln", optionals_dyn_out);
(* A T where a T? is wanted is Some of it (decision 138). *)
("autowrap.fln",
"-1\n5 4 2\n7 8 -1\n3 4\n7\n1 0 4\n5\n2 6 0\n2 -1 -1 2\n4\n-1 3 0\n\
some some some none\nsome some some none none\n1 6 -1 -1\n1\n9 8 3 5\n\
4000000000 4000000000 4 4\n4 4000000000\n3.5 3.5 7 7\n200 200\n3000000000 3000000000 3 3\n-1 5\n1 0\n10\n");
(* x? tests and narrows, e? as g names what it found (decision 133). *) (* 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\n43\n-4 5\n");
("as-chain-dyn.fln", "dog nobody ann\n4 nil nil\n6 2\n5\n-1\n") ];
(* The pipe (decision 137): chains, multi-line, qualified, dyn, and the (* The pipe (decision 137): chains, multi-line, qualified, dyn, and the
left side run before the other arguments (the last 1 2 3). *) left side run before the other arguments (the last 1 2 3). *)
(let want = "7\n6\n6\n60\n10\n8\nfalse\n30\n7\n7 -1\n6\n7\n1\n2\n3\n-4\n" in (let want = "7\n6\n6\n60\n10\n8\nfalse\n30\n7\n7 -1\n6\n7\n1\n2\n3\n-4\n" in
@ -5679,6 +5690,68 @@ level "1"
(if x86 then ", --x86" else "") text code (if x86 then ", --x86" else "") text code
end) end)
[ false; true ]; [ false; true ];
(* A u64, a dyn nil past the pair and an is-numeric $t, each beside a
dyn: the typed value crosses, and what cannot cross traps at its site. *)
let crossing_out =
"9223372036854775807 9223372036854775807 9223372036854775807 true\n\
3 3.5 8\n7 7.5 24 12\nfalse true true\n4 0 4 4\n\
7 0.25 9223372036854775807\nfalse true false\n"
in
outputs "dyn: typed values crossing beside a dyn" "programs/dyn-crossing.flan"
crossing_out;
outputs ~opt:"-O0" "dyn: typed values crossing beside a dyn, -O0"
"programs/dyn-crossing.flan" crossing_out;
outputs ~x86:true "dyn: typed values crossing beside a dyn, --x86"
"programs/dyn-crossing.flan" crossing_out;
let too_big = "dyn: this u64 is 18446744073709551615, above the largest \
dyn int (9223372036854775807), so it has no dyn value" in
let too_wide n =
"dyn: an i32 is wanted here, and the int " ^ n ^ " is outside an i32's range" in
let crossing_traps =
[ "u64", "51:36", too_big;
"u64-max", "52:40", too_big;
"u64-generic", "31:12", too_big;
"nil-first", "54:42", "dyn +: nil and int, and it takes two numbers — (+ nil 1)";
"nil-last", "55:41", "dyn +: int and nil, and it takes two numbers — (+ 3 nil)";
"nil-less", "56:41", "dyn <: int and nil";
"nil-min", "57:40", "dyn min: int and nil";
"nil-bits", "58:41", "dyn bit-or: int and nil";
"nil-want-first", "61:47", "dyn +: nil and int, and it takes two numbers — (+ nil 1)";
"nil-want-last", "62:46", "dyn +: int and nil, and it takes two numbers — (+ 3 nil)";
(* At an i32 want the form is dyn in every position and only its
answer is opened: no position wraps. *)
"big-first", "73:25", too_wide "2147483649";
"big-mid", "74:23", too_wide "2147483649";
"big-last", "75:24", too_wide "2147483649";
"big-pair", "76:24", too_wide "2147483648";
"big-shift", "77:25", too_wide "4294967294";
"i32-nil-first", "78:29", "dyn +: nil and int, and it takes two numbers — (+ nil 1)";
"i32-nil-mid", "79:27", "dyn +: int and nil, and it takes two numbers — (+ 1 nil)";
"i32-nil-last", "80:28", "dyn +: int and nil, and it takes two numbers — (+ 2 nil)";
(* (the dyn <literal>) beside nil traps as a named dyn does, and an
f64 or bool opening names its site. *)
"lit-int", "89:36", "dyn +: int and nil, and it takes two numbers — (+ 1 nil)";
"lit-float", "90:38", "dyn +: float and nil, and it takes two numbers — (+ 1.5 nil)";
"lit-bool", "91:37", "dyn +: bool and nil, and it takes two numbers — (+ true nil)";
"lit-let", "92:57", "dyn +: int and nil, and it takes two numbers — (+ 1 nil)";
"want-f64", "93:35", "dyn f64: int, and a float was wanted — (f64 3)";
"want-bool", "94:36", "dyn bool: int, and a bool was wanted — (bool 3)" ]
in
List.iter
(fun x86 ->
let exe = compile ~x86 "programs/dyn-crossing.flan" in
List.iter
(fun (arg, at, msg) ->
let code, text = run exe (Some arg) in
let want = "programs/dyn-crossing.flan:" ^ at ^ ": " ^ msg in
if code <> 134 || not (contains text want) then begin
incr failures;
Printf.printf "FAIL dyn: crossing trap %s%s\n \
got: %S (exit %d)\n"
arg (if x86 then ", --x86" else "") text code
end)
crossing_traps)
[ false; true ];
List.iter List.iter
(fun x86 -> (fun x86 ->
let exe = compile ~x86 "programs/char-arith.flan" in let exe = compile ~x86 "programs/char-arith.flan" in

View File

@ -2483,6 +2483,104 @@ let () =
null_park "--llvm"; null_park "--llvm";
null_park "--x86"; null_park "--x86";
(* A stop inside an [if o as g and ... and d as e] block (decision 136):
each name an [as] binds is a slot of its own under its name, so the
locals list it with what the test found. *)
let as_locals backend =
let asock = tmp ("as" ^ backend ^ ".sock") and aout = tmp ("as" ^ backend ^ ".out") in
(try Sys.remove asock with Sys_error _ -> ());
let afd = Unix.openfile aout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
let apid =
Unix.create_process flan
[| flan; "dev"; "programs/dev-as.fln"; "-s"; asock; backend |]
Unix.stdin afd Unix.stderr
in
Unix.close afd;
if not (listening ~pid:apid asock) then begin
fail "the as daemon (%s) %s" backend !listen_why;
(try Unix.kill apid Sys.sigkill with Unix.Unix_error _ -> ())
end
else begin
let c = connect asock in
let ask sexp = Wire.parse (Wire.send c sexp; Wire.recv c) in
let stopped r =
match Wire.field r "stopped" with
| Some { Form.v = Form.Sym "t"; _ } -> true
| _ -> false
in
if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then
fail "the as program never stopped (%s)" backend
else begin
let r = ask "(:op \"locals\" :frame 0)" in
let rows =
match Wire.field r "locals" with
| Some { Form.v = Form.List l; _ } ->
List.filter_map
(fun (e : Form.t) ->
match e.Form.v with
| Form.List ({ Form.v = Form.Str n; _ } :: { Form.v = Form.Str ty; _ }
:: { Form.v = Form.Str v; _ } :: _) -> Some (n, (ty, v))
| _ -> None)
l
| _ -> []
in
(match List.assoc_opt "g" rows with
| Some ("i32", "41") -> ()
| Some (ty, v) -> fail "locals show g as %s %s (%s)" ty v backend
| None ->
fail "locals do not show g (%s): %s" backend
(String.concat " " (List.map fst rows)));
(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);
(* 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;
if not
(await ~ms:5000 (fun () ->
match Unix.waitpid [ Unix.WNOHANG ] apid with
| 0, _ -> false
| _ -> true
| exception Unix.Unix_error _ -> true))
then begin
(try Unix.kill apid Sys.sigkill with Unix.Unix_error _ -> ());
(try ignore (Unix.waitpid [] apid) with Unix.Unix_error _ -> ())
end
end
in
as_locals "--llvm";
as_locals "--x86";
(* ── The locals of a stopped frame ─────────────────────────────── *) (* ── The locals of a stopped frame ─────────────────────────────── *)
(* A third daemon, over a program that stops with something worth looking (* A third daemon, over a program that stops with something worth looking

View File

@ -1563,6 +1563,15 @@ let () =
refuses_all ~fln:true "an arity takes no rest parameter" refuses_all ~fln:true "an arity takes no rest parameter"
"fn f\n (a: i32) -> i32 = a\n (a: i32, & xs) -> i32 = a\n" "fn f\n (a: i32) -> i32 = a\n (a: i32, & xs) -> i32 = a\n"
"& (a rest parameter) is not one"; "& (a rest parameter) is not one";
(* 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" rejects_check "popcount of a float"
"(defn f [a f64] f64 (popcount a))" ~needle:"popcount takes integers, found f64"; "(defn f [a f64] f64 (popcount a))" ~needle:"popcount takes integers, found f64";
rejects_check "a rotation's count does not widen the value" rejects_check "a rotation's count does not widen the value"
@ -2122,6 +2131,86 @@ let () =
rejects_check "nil at a bare T is refused at compile time" rejects_check "nil at a bare T is refused at compile time"
"(defn take [n i32] i32 n)\n(defn main [] i32 (take nil))" "(defn take [n i32] i32 n)\n(defn main [] i32 (take nil))"
~needle:"nil has no None to become"; ~needle:"nil has no None to become";
(* A bare nil in an arithmetic, bitwise or ordering operator with nothing
else dyn is refused in every position, with or without a want; a dyn that
holds nil is left to trap at run time (dyn-crossing.flan). *)
(* The 1-based column of [sub] in [form], placed at column [base]. *)
let col_of base form sub =
let n = String.length sub in
let rec at i = if String.sub form i n = sub then i else at (i + 1) in
base + at 0
in
List.iter
(fun form ->
List.iter
(fun (what, base, src) ->
let col = col_of base form "nil" in
match
(try ignore (checked src); None with Loc.Error d -> Some d)
with
| Some d when contains d.Loc.dmsg "nil has no None to become at i32"
&& d.Loc.dloc.Loc.col = col -> ()
| Some d ->
incr failures;
Printf.printf "FAIL a bare nil in %s, %s: got %d: %s\n" form what
d.Loc.dloc.Loc.col d.Loc.dmsg
| None ->
incr failures;
Printf.printf "FAIL a bare nil in %s, %s: accepted\n" form what)
[ "at a want", 16,
Printf.sprintf "(defn f [] i32 %s)\n(defn main [] i32 (f))" form;
"with none", 25,
Printf.sprintf "(defn f [] i32 (println %s) 0)\n(defn main [] i32 (f))" form ])
[ "(+ nil 1 2)"; "(+ 1 nil 2)"; "(+ 1 2 nil)"; "(+ 1 nil)";
"(< nil 1 2)"; "(< 1 2 nil)"; "(min 1 2 nil)"; "(bit-or nil 1 2)";
"(bit-or 1 2 nil)" ];
accepts "a dyn holding nil in a fold is left to the run time"
"(defn f [p dyn] i32 (+ 1 2 p (the dyn nil)))\n\
(defn g [] i32 (let [r (the i32 0)] (set r (+ (the dyn nil) 1 2)) r))\n\
(defn main [] i32 (println (< 1 2 (the dyn nil))) 0)";
accepts "nil beside (the dyn <literal>) is left to the run time"
"(defn main [] i32\n\
(println (+ (the dyn 1) nil) (+ (the dyn 1.5) nil) (+ (the dyn true) nil)\n\
(< (the dyn 1) nil) (min 2 (the dyn 1.5) nil)) 0)";
accepts "nil beside a real dyn in a fold is left to the run time"
"(defn f [p dyn] dyn (+ 1 2 p nil))\n(defn main [] i32 0)";
(* An operand past the pair asked on its own terms records nothing: the
float y is blamed, not the int x it would have merged with. *)
List.iter
(fun form ->
let col = col_of 45 form "y)" in
match
(try ignore (checked ("(defn main [] i32 (let [x 5 y 2.5] (println "
^ form ^ ")) 0)")); None
with Loc.Error d -> Some d)
with
| Some d when d.Loc.dloc.Loc.col = col -> ()
| Some d ->
incr failures;
Printf.printf "FAIL %s blames col %d, not y at %d: %s\n" form
d.Loc.dloc.Loc.col col d.Loc.dmsg
| None -> incr failures; Printf.printf "FAIL %s: accepted\n" form)
[ "(+ (the i64 1) 2 (+ x y))"; "(* (the i64 1) 2 (* x y))";
"(max (the i64 1) 2 (max x y))"; "(< (the i64 1) 2 (+ x y))" ];
rejects_check "a wide literal at dyn with nothing to retype"
"(defn main [] i32 (println (the dyn 0xFFFFFFFFFFFFFFFF)) 0)"
~needle:"0xFFFFFFFFFFFFFFFF, which is above the largest dyn int \
(9223372036854775807), so it has no dyn value";
rejects_check "a wide literal beside a dyn"
"(defn main [] i32 (println (+ (the dyn 0) 0xFFFFFFFFFFFFFFFF)) 0)"
~needle:"so it has no dyn value";
(* A $t crosses into dyn only under a bound every type of which has a dyn
value; an unbounded one could be a pointer, refused at no call site. *)
rejects_check "an unbounded $t does not cross into dyn"
"(defn f [x $t] dyn (+ x (the dyn 1)))\n\
(defn main [] i32 (println (f 2)) 0)"
~needle:"$t may be a type with no dyn value, such as a pointer or an \
enum, so it crosses into dyn only as a number. Write \
{:where (is-numeric $t)}";
rejects_check "an is-ordered $t does not cross into dyn"
"(defn f [x $t] dyn {:where (is-ordered $t)} (the dyn x))\n\
(defn main [] i32 (println (f 2)) 0)"
~needle:"crosses into dyn only as a number";
rejects_check "nil at a bare T is refused at compile time, return position" rejects_check "nil at a bare T is refused at compile time, return position"
"(defn f [] i64 nil)\n(defn main [] i32 0)" "(defn f [] i64 nil)\n(defn main [] i32 0)"
~needle:"nil has no None to become"; ~needle:"nil has no None to become";
@ -8088,11 +8177,11 @@ let () =
parse_rejects "a wide enum member is refused for its range" parse_rejects "a wide enum member is refused for its range"
"(defenum E [A 0xFFFFFFFFFFFFFFFF B])" "(defenum E [A 0xFFFFFFFFFFFFFFFF B])"
~needle:"the member A of E is 0xFFFFFFFFFFFFFFFF, which does not fit i32"; ~needle:"the member A of E is 0xFFFFFFFFFFFFFFFF, which does not fit i32";
rejects_check "a wide literal in a dyn global names the u64 cast" rejects_check "a wide literal in a dyn global names the type u64"
"(defonce big 0xFFFFFFFFFFFFFFFF)" "(defonce big 0xFFFFFFFFFFFFFFFF)"
~needle:"Write (u64 0xFFFFFFFFFFFFFFFF) for the u64"; ~needle:"so it has no dyn value. Give big the type u64";
accepts "the cast the dyn refusal names compiles" accepts "the type the dyn refusal names compiles"
"(defonce big (u64 0xFFFFFFFFFFFFFFFF))"; "(defonce big u64 0xFFFFFFFFFFFFFFFF)";
(* A macro's Form has one integer case; the literal comes back wide all the (* A macro's Form has one integer case; the literal comes back wide all the
same, and is refused where it would have been refused unexpanded. *) same, and is refused where it would have been refused unexpanded. *)
rejects_check "a wide literal through a macro is still wide" rejects_check "a wide literal through a macro is still wide"
@ -8472,6 +8561,26 @@ let () =
parse_rejects "_ in a defgeneric's return slot" parse_rejects "_ in a defgeneric's return slot"
~needle:"defgeneric's methods each have their own" ~needle:"defgeneric's methods each have their own"
"(defgeneric area [s] _)"; "(defgeneric area [s] _)";
(* Decision 138: a T is wrapped where a T? is wanted, and never the other
way. The program half is programs/autowrap.fln. *)
accepts "a T is Some of it at a T?" "(defn f [] (Option i64) -1)\n(defn main [] ())";
rejects_check "a T? is not unwrapped at a T" ~needle:"expected i32, found (Option i32)"
"(defn f [o (Option i32)] i32 o)\n(defn main [] ())";
rejects_check "a T? argument is not unwrapped" ~needle:"expected i32, found (Option i32)"
"(defn g [x i32] i32 x)\n(defn f [o (Option i32)] i32 (g o))\n(defn main [] ())";
rejects_check "a payload that does not fit is refused at the Option"
~needle:"expected (Option i32), found str"
"(defn f [] (Option i32) \"no\")\n(defn main [] ())";
rejects_check "a literal that does not fit is refused at the Option"
~needle:"expected (Option str), found the integer literal 5"
"(defn f [] (Option str) 5)\n(defn main [] ())";
rejects_check "a narrowing is not wrapped" ~needle:"expected (Option i32), found i64"
"(defn f [x i64] (Option i32) x)\n(defn main [] ())";
rejects_check "no wrap inside a container" ~needle:"expected (Vec (Option i32)), found (Vec i32)"
"(defn f [v (Vec i32)] (Vec (Option i32)) v)\n(defn main [] ())";
rejects_check "a narrowed name still refuses an Option"
~needle:"it cannot be given an Option here"
"(defn main [] () (let [o (the (Option i32) (Some 1))] (when (? o) (set o (Some 2)))))";
(* A plain name binds what an Option or a dyn holds; over anything else (* A plain name binds what an Option or a dyn holds; over anything else
it cannot fail, and is refused toward let. The program half is it cannot fail, and is refused toward let. The program half is
programs/if-let.flan and programs/optionals.fln. *) programs/if-let.flan and programs/optionals.fln. *)

View File

@ -1947,7 +1947,7 @@ let () =
{ Tast.name = "f"; params = []; ret = Types.Unit; body = []; { Tast.name = "f"; params = []; ret = Types.Unit; body = [];
fdefers = []; fenv = None; fparent = None; floc = Loc.unknown; fdefers = []; fenv = None; fparent = None; floc = Loc.unknown;
slots = Array.make (Array.length snames) (Types.Int Types.I32); slots = Array.make (Array.length snames) (Types.Int Types.I32);
snames } snames; as_slots = [] }
in in
(match Session.shown_names (fn [| Some "k~2"; None |]) with (match Session.shown_names (fn [| Some "k~2"; None |]) with
| [| Some "k"; None |] -> () | [| Some "k"; None |] -> ()
@ -2180,4 +2180,59 @@ let () =
| exception Loc.Error _ -> () | exception Loc.Error _ -> ()
| exception Loc.Errors _ -> fail "one error came as a list")); | 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 copied once, into g's own named slot, which the
rest of the chain and the block read: two bindings, the Option held
and g, where another copy 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 <> 2 then fail "if o? as g binds %d slots, wanted 2" !n;
if not (Array.exists (fun x -> x = Some "g") f.Tast.snames) then
fail "if o? as g has no slot named g");
Test_support.report ~label:"session" () Test_support.report ~label:"session" ()

View File

@ -1409,14 +1409,46 @@ let () =
found; if let over a plain name is refused toward those. *) 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" 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?, 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 "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" 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))"; "(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-let [h y] h 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)" reads "while e? as g" "while pop(s)? as x\n f(x)"
"(while true (if-let [x (pop s)] (do (f x)) (break)))"; "(while true (if (as 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"; (* 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 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";
"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" ];
(* Decision 137: x |> f(a) is f(x, a), below or. *) (* Decision 137: x |> f(a) is f(x, a), below or. *)
reads "|> into a call" "y = x |> f(1, 2)" "(set y (f x 1 2))"; reads "|> into a call" "y = x |> f(1, 2)" "(set y (f x 1 2))";
reads "|> into an empty call" "y = x |> f()" "(set y (f x))"; reads "|> into an empty call" "y = x |> f()" "(set y (f x))";
@ -1456,11 +1488,10 @@ let () =
refuses "|> before a test" "y = a |> f?" "indent/pipe-target" "\n (a |> f)?"; refuses "|> before a test" "y = a |> f?" "indent/pipe-target" "\n (a |> f)?";
refuses "|> chained before ==" "y = a |> b |> f(1) == 2" "indent/pipe-target" refuses "|> chained before ==" "y = a |> b |> f(1) == 2" "indent/pipe-target"
"\n (a |> b |> f(1)) == 2"; "\n (a |> b |> f(1)) == 2";
refuses "|> before as" "if a |> f(1) as v\n v" "indent/as-test" "Write (a |> f(1))? as name"; reads "as names what a pipe answers" "if a |> f(1) as v and v > 0\n v"
refuses "|> before as over a pattern" "if a |> f as Some(v)\n v" "indent/as-test" "(when (and (as v (f a 1)) (> v 0)) v)";
"Write (a |> f)? as name"; refuses "as before a pattern" "if a |> f as Some(v)\n v" "indent/as-name"
refuses "a call before as is not bracketed" "if f(x) as v\n v" "indent/as-test" "if let Some(v) = a |> f";
"Write f(x)? as name";
reads "|> into a macro passes the place" "y = x |> set(5)" "(set y (set x 5))"; reads "|> into a macro passes the place" "y = x |> set(5)" "(set y (set x 5))";
refuses "|> into parentheses" "y = x |> (f)" "indent/pipe-target" "(f) is neither"; refuses "|> into parentheses" "y = x |> (f)" "indent/pipe-target" "(f) is neither";
refuses "|> unspaced on the right" "y = x |>[f]" "indent/unspaced-operator" "x |> f(a)"; refuses "|> unspaced on the right" "y = x |>[f]" "indent/unspaced-operator" "x |> f(a)";
@ -1478,7 +1509,7 @@ let () =
refused "narrowed-set.fln" refused "narrowed-set.fln"
"fn main()\n let x: i32? = Some(1)\n if x?\n x = None\n println(x ?? 0)\n" "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"; [ "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" 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" "fn main()\n let x: i32? = None\n if x?\n println(x + 1)\n else\n println(x + 1)\n"
[ "Option(i32)" ]; [ "Option(i32)" ];
@ -1512,7 +1543,7 @@ let () =
reads "a trailing ? tests the whole chain" "y = o?.i?" reads "a trailing ? tests the whole chain" "y = o?.i?"
"(set y (? (?. [~o1 o] (.i ~o1))))"; "(set y (? (?. [~o1 o] (.i ~o1))))";
reads "and ? then as binds the chain's result" "if d?.k? as k\n k" 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" refused "narrowed-param.fln"
"fn f(x: i32?)\n if x?\n x += 100\n\nfn main()\n f(Some(1))\n" "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" ]; [ "x is a parameter, and a parameter is not assignable" ];
@ -1520,7 +1551,7 @@ let () =
"fn main()\n let x: i32? = Some(1)\n if x?\n x.n = 1\n" "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" ]; [ "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" 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" refused "lowercase-type-arg.fln"
"struct grain\n w: i32\n\nfn main()\n let v = vec-new(grain?)\n" "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"; [ "grain? here is the test that a value is present, and grain is a type";
@ -1528,7 +1559,7 @@ let () =
refused "addr-taken.fln" refused "addr-taken.fln"
"fn clear(p: Ptr(i32?))\n deref(p) = None\n\nfn main()\n let x: i32? = Some(1)\n\ "fn clear(p: Ptr(i32?))\n deref(p) = None\n\nfn main()\n let x: i32? = Some(1)\n\
\ let p = addr(x)\n if x?\n clear(p)\n println(x + 1)\n" \ let p = addr(x)\n if x?\n clear(p)\n println(x + 1)\n"
[ "expected Option(i32)" ]; [ "+ takes numbers, found Option(i32)" ];
refused "capital-local.fln" "fn main()\n let X: i32? = Some(1)\n println(X?)\n" refused "capital-local.fln" "fn main()\n let X: i32? = Some(1)\n println(X?)\n"
[ "To test the local X, give it a lowercase name, as in x?" ]; [ "To test the local X, give it a lowercase name, as in x?" ];
checks "addr-taken-test.fln" checks "addr-taken-test.fln"
@ -1881,9 +1912,9 @@ let () =
| _ -> fail "addr-taken-note.fln checked" | _ -> fail "addr-taken-note.fln checked"
| exception (Loc.Error d | Loc.Errors (d :: _)) -> | exception (Loc.Error d | Loc.Errors (d :: _)) ->
if not (List.exists 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) 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) | exception e -> fail "addr-taken-note.fln: %s" (diag_text e)
let () = Test_support.report ~label:"syntax" () let () = Test_support.report ~label:"syntax" ()