Merge master into the arity lane.
This commit is contained in:
commit
1215db7d26
26
TODO.org
26
TODO.org
@ -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
|
||||||
|
|||||||
@ -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)
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
40
lib/ast.ml
40
lib/ast.ml
@ -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
|
||||||
|
| _ -> []
|
||||||
|
|||||||
647
lib/check.ml
647
lib/check.ml
File diff suppressed because it is too large
Load Diff
@ -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)
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
29
lib/parse.ml
29
lib/parse.ml
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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); }
|
||||||
|
|||||||
@ -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].
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
31
test/programs/as-chain-dyn.fln
Normal file
31
test/programs/as-chain-dyn.fln
Normal 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)
|
||||||
92
test/programs/as-chain.fln
Normal file
92
test/programs/as-chain.fln
Normal 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
148
test/programs/autowrap.fln
Normal 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
26
test/programs/dev-as.fln
Normal 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
|
||||||
94
test/programs/dyn-crossing.flan
Normal file
94
test/programs/dyn-crossing.flan
Normal 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))))
|
||||||
@ -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.
|
||||||
|
|||||||
@ -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))
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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. *)
|
||||||
|
|||||||
@ -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" ()
|
||||||
|
|||||||
@ -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" ()
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user