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

Merge branch 'master' into worktree-agent-a26dff0627201f77b

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-26 12:55:06 +07:00
commit e5fd44920e
16 changed files with 1434 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
CLAUDE.md
View File

@ -23,10 +23,12 @@ saying what is now true, not what was done.
## Tests
`dune test --root .` must be green before a lane reports; grep its output for
FAIL, since the exit code alone has lied. `@checks` (`@page`, `@x86`, `@cells`),
`@sanitize` and `@valgrind` are slow and run once between batches of lanes, with
the author's permission, never inside a lane. ASan misses uninitialised stack
A lane never runs the full `dune test`: it builds with `-j 2` and runs only the
programs and test executables its change touches, one at a time, and lists them in
its report. After about five lanes merge, one tester agent runs `dune test --root .`
on master and fixes what broke; grep its output for FAIL, since the exit code alone
has lied. `@checks` (`@page`, `@x86`, `@cells`), `@sanitize` and `@valgrind` are
slow and run only with the author's permission. ASan misses uninitialised stack
reads; `@valgrind` catches them.
## Evidence

20
TODO.org
View File

@ -10,6 +10,12 @@ pointing at it. A CANCELLED entry carries the one-line reason, because an idea
rejected without a record is an idea that gets re-proposed.
* Language surface
** NEXT A typed char
Decided 2026-09-26 (127): =char= is a typed code point. A char literal is typed by local
inference like a number literal: u8 or i32 where typed code wants a number (a literal
above 127 is refused as a u8), =char= otherwise; a =char= crossing into dyn stays a char.
Rules out the fork where =f(\a)= printed =\a= and =let c = \a= then =f(c)= printed 97.
Waits on the dyn char lane and the literal inference lane.
** NEXT if let
Decided 2026-09-26 (126), Rust's spelling: =if let Some(g) = left= plus a block tests
the pattern and binds =g= in that block only; =elif=/=else= follow as for =if=. Any
@ -53,11 +59,19 @@ next free-temp. Rules out copy-in/copy-out at a call, and rooting the text in th
** NEXT Dyn unless annotated
Decided 2026-09-26, replacing the plain rule: number, bool and char literals are typed,
their type inferred from their uses inside the function (never across functions); an
unconstrained integer literal is int (i32) and a float literal float (f32); uses that
unconstrained integer literal is int (i32) and a float literal f64 (decision 121); uses that
disagree are refused with a request for an annotation. Vector, map and text literals
are dyn unless something typed wants them. A typed value is boxed where it goes into
dyn, and a dyn unboxed (checked) where typed code needs it; typed beside dyn in an
operator gives dyn. Dyn integers stay i64 and dyn floats f64.
Decision 121: f64 and not f32, because f32 locals lost precision silently — 0.1 summed a
million times printed 100958. A float literal is f32 only where inference finds typed code
wanting f32 (a parameter, field, return or operand). A literal local fed only by dyn takes
the dyn width, i64 or f64.
Done: local inference (check.ml [lit_session]), an integer and a float literal meeting
at the float. Waiting: text and vector literals dyn by default, on
dyn text to str and dyn vec to slice conversion (a lane after views); =FLAN_LIT=dyn=
measures it, and under it a let-bound one some typed use wants already stays typed.
** DONE Dynamic-first, and the dyn half of the language
CLOSED: [2026-09-20]
An unannotated parameter or return is =dyn=: a NaN-boxed value over a mark-sweep
@ -709,6 +723,10 @@ consecutive lets this way.
Rules out ~loop~/~recur~ anywhere the .fln reader reads, ~quote~ included; loops are
~while~/~until~/~dotimes~/~for~. The Lisp syntax and its macros' expansions keep them.
** DONE A .fln chain may mix < with <=, or > with >= (decision 124)
~0 <= r < rows~ is the ~and~ of its tests; like ~(< a b c)~ every operand runs once, left to right,
with no short-circuit. Direction changes and ~==~/~!=~ in a mix stay refused.
** TODO Hard-coded code in messages is still paren syntax in a .fln file
Types follow the code's syntax now (=Types.spell=). Hints written into a message's
text — =(Ptr %s)=, =(clone v)=, =(the T x)= in most of =check.ml= and =parse.ml=, the

785
lib/check.ml
View File

File diff suppressed because it is too large Load Diff

103
lib/indent_printer.ml
View File

@ -173,6 +173,92 @@ let rec pat_names (t : Form.t) : string list option =
let binds n t = match pat_names t with Some ns -> List.mem n ns | None -> false
(* [f] as a comparison chain that mixes < with <=, or > with >=: its operands
and operators, when the reader would read the chain back as [f] itself.
The candidate is rebuilt by the reader's own [cmp_chain] and compared up to
the names its [let]s bind, so an [and] of tests that only looks like a
chain, or a [let] the reader would not have made, prints as it is. *)
let chain_of (f : Form.t) =
let rec eq env (a : Form.t) (b : Form.t) =
match a.v, b.v with
| Form.Sym x, Form.Sym y ->
(match List.assoc_opt x env with
| Some y' -> y = y'
| None -> x = y && not (List.exists (fun (_, y') -> y' = y) env))
| Form.List ({ v = Form.Sym "let"; _ } :: { v = Form.Vec bx; _ } :: xs),
Form.List ({ v = Form.Sym "let"; _ } :: { v = Form.Vec by; _ } :: ys) ->
let rec binds env bx by =
match bx, by with
| ({ Form.v = Form.Sym tx; _ }) :: vx :: bx', ({ Form.v = Form.Sym ty; _ }) :: vy :: by' ->
if eq env vx vy then binds ((tx, ty) :: env) bx' by' else None
| [], [] -> Some env
| _ -> None
in
(match binds env bx by with
| Some env -> List.length xs = List.length ys && List.for_all2 (eq env) xs ys
| None -> false)
| Form.List xs, Form.List ys | Form.Vec xs, Form.Vec ys | Form.Map xs, Form.Map ys ->
List.length xs = List.length ys && List.for_all2 (eq env) xs ys
| x, y -> x = y
in
let subst env (x : Form.t) =
match x.v with
| Form.Sym s -> Option.value (List.assoc_opt s env) ~default:x
| _ -> x
in
(* The tests, left to right, with each bound name replaced by its value. *)
let rec tests env (f : Form.t) =
match f.v with
| Form.List [ { v = Form.Sym "let"; _ }; { v = Form.Vec bs; _ }; body ] ->
let rec binds env = function
| ({ Form.v = Form.Sym t; _ }) :: v :: rest -> binds ((t, subst env v) :: env) rest
| [] -> Some env
| _ -> None
in
Option.bind (binds env bs) (fun env -> tests env body)
| Form.List ({ v = Form.Sym "and"; _ } :: (_ :: _ :: _ as cs)) ->
List.fold_left
(fun acc c -> Option.bind acc (fun l -> Option.map (( @ ) l) (tests env c)))
(Some []) cs
| Form.List [ { v = Form.Sym op; _ }; a; b ] when R.cmp_dir op <> None ->
Some [ (op, subst env a, subst env b) ]
| _ -> None
in
let rec linked = function
| (_, _, b) :: ((_, a, _) :: _ as rest) -> eq [] b a && linked rest
| _ -> true
in
(* In a template the paren text spells a [~cmp] name as the unquoted call
that makes it, [~(Form.Sym {.s "~cmp1"})]: read it as the name. *)
let rec unwrap (x : Form.t) =
match x.v with
| Form.List [ { v = Form.Sym "unquote"; _ };
{ v = Form.List [ { v = Form.Sym "Form.Sym"; _ };
{ v = Form.Map [ { v = Form.Sym ".s"; _ };
{ v = Form.Str n; _ } ]; _ } ]; _ } ]
when String.length n > 4 && String.sub n 0 4 = "~cmp" -> { x with v = Form.Sym n }
| Form.List l -> { x with v = Form.List (List.map unwrap l) }
| Form.Vec l -> { x with v = Form.Vec (List.map unwrap l) }
| _ -> x
in
match f.v with
| Form.List ({ v = Form.Sym ("and" | "let"); _ } :: _) ->
let f = unwrap f in
(match tests [] f with
| Some (((op1, x0, _) :: _ :: _) as ts)
when linked ts
&& List.for_all (fun (op, _, _) -> R.cmp_dir op = R.cmp_dir op1) ts
&& List.exists (fun (op, _, _) -> op <> op1) ts ->
let xs = x0 :: List.map (fun (_, _, b) -> b) ts in
let ops = List.map (fun (op, _, _) -> op) ts in
let n = ref 0 in
let fresh () = incr n; Printf.sprintf "~cmp%d" !n in
if eq [] f (R.cmp_chain ~fresh f.loc xs ops) then Some (xs, ops) else None
| _ -> None)
| _ -> None
let is_chain f = chain_of f <> None
(* Whether [f] mentions [n]: the name, or a field path or qualified name
starting with it. Any occurrence counts, a quoted one or one under an
unquote included. A macro whose expansion names a variable its call does
@ -266,7 +352,7 @@ let rename_let n n' (bs : Form.t list) (body : Form.t list) =
let flatten (f : Form.t) (rest : Form.t list) =
match f.v with
| Form.List (({ v = Form.Sym "let"; _ } as h) :: ({ v = Form.Vec bs; _ } as bv) :: (_ :: _ as body))
when rest <> [] && bs <> [] && List.length bs mod 2 = 0 ->
when rest <> [] && bs <> [] && List.length bs mod 2 = 0 && not (is_chain f) ->
Option.bind
(all pat_names (List.filteri (fun i _ -> i mod 2 = 0) bs))
(fun names ->
@ -326,6 +412,13 @@ let rec expr (f : Form.t) : string * int =
| Form.Vec xs -> ("[" ^ vec_text xs ^ "]", 13)
| Form.Map xs -> ("{" ^ map_text xs ^ "}", 13)
| Form.List [] -> ("()", 13)
| Form.List _ when is_chain f ->
let xs, ops = Option.get (chain_of f) in
let lvl = Option.get (R.binop_level (List.hd ops)) in
let ts = List.map (at (lvl + 1)) xs in
(List.hd ts
^ String.concat "" (List.map2 (fun op t -> " " ^ op ^ " " ^ t) ops (List.tl ts)),
lvl)
| Form.List (h :: args) -> in_quasi f (fun () -> list f h args)
and sym f s =
@ -605,6 +698,7 @@ let body_guess (h : Form.t) args =
lists goes in the block. *)
let stmt_like (a : Form.t) =
match a.v with
| Form.List _ when is_chain a -> false
| Form.List ({ v = Form.Sym h; _ } :: _) ->
List.mem h [ "let"; "set"; "when"; "unless"; "cond"; "while";
"until"; "dotimes"; "match"; "handler-case";
@ -641,7 +735,8 @@ let body_guess (h : Form.t) args =
let let_sugar (f : Form.t) =
match f.v with
| Form.List ({ v = Form.Sym "let"; _ } :: { v = Form.Vec bs; _ } :: _ :: _) ->
| Form.List ({ v = Form.Sym "let"; _ } :: { v = Form.Vec bs; _ } :: _ :: _)
when not (is_chain f) ->
(match pairs bs with None | Some [] -> false | Some _ -> true)
| _ -> false
@ -940,6 +1035,7 @@ and value_lines n prefix (v : Form.t) =
if n + String.length inline <= width then [ ind n ^ inline ]
else
match v.v with
| _ when is_chain v -> [ ind n ^ inline ]
| Form.List ({ v = Form.Sym h; _ } :: _)
when not (List.mem h sugar_heads || h = "fn" || h = "if") ->
wrapped n (prefix ^ " = ") v
@ -956,7 +1052,8 @@ and label_of = function
and sugar n (f : Form.t) : string list option =
let i = ind n in
match f.v with
| Form.List ({ v = Form.Sym "let"; _ } :: { v = Form.Vec bs; _ } :: (_ :: _ as body)) ->
| Form.List ({ v = Form.Sym "let"; _ } :: { v = Form.Vec bs; _ } :: (_ :: _ as body))
when not (is_chain f) ->
(match pairs bs with
| None | Some [] -> None
| Some prs -> Some (let_lines n prs body))

130
lib/indent_reader.ml
View File

@ -100,6 +100,49 @@ let compound (at : Loc.t) op (e : Form.t) (v : Form.t) span =
Form.List
[ Form.make (Form.Sym "update") at; e; Form.make (Form.Sym op) at; v ]
(* A comparison chain that mixes [<] with [<=], or [>] with [>=], is the
[and] of its neighbouring pairs: [0 <= r < rows] is
[(and (<= 0 r) (< r rows))]. It is evaluated as [(< a b c)] is: every
operand once, left to right, before any test, with no short-circuit. When
an operand is more than a name or a literal, every operand but a literal
is bound first, in order, to a fresh [~cmp] name, which no reader can
produce: a name too, since a call to its right may change it. The printer
rebuilds a candidate with this same function and prints the chain only
when the two agree. *)
let cmp_dir = function
| "<" | "<=" -> Some `Up
| ">" | ">=" -> Some `Down
| _ -> None
let cmp_chain ~fresh (l : Loc.t) (xs : Form.t list) (ops : string list) =
let mkf v = Form.make v l in
let s x = mkf (Form.Sym x) in
let literal (x : Form.t) =
match x.v with
| Form.Int _ | Form.UInt _ | Form.Float _ | Form.Str _ | Form.Byte _
| Form.Kw _ | Form.Sym ("true" | "false" | "nil") -> true
| _ -> false
in
let simple (x : Form.t) = literal x || (match x.v with Form.Sym _ -> true | _ -> false) in
let keep = if List.for_all simple xs then simple else literal in
let bound =
List.map (fun x -> if keep x then (None, x) else
let t = s (fresh ()) in (Some (t, x), t)) xs
in
let refs = List.map snd bound in
let rec tests = function
| a :: (b :: _ as rest), op :: ops -> mkf (Form.List [ s op; a; b ]) :: tests (rest, ops)
| _ -> []
in
let body = mkf (Form.List (s "and" :: tests (refs, ops))) in
match List.concat_map (function (Some (t, x), _) -> [ t; x ] | _ -> []) bound with
| [] -> body
| bs -> mkf (Form.List [ s "let"; mkf (Form.Vec bs); body ])
(* The reader's fresh names for [cmp_chain], counted per [read_all]. *)
let cmp_n = ref 0
let cmp_fresh () = incr cmp_n; Printf.sprintf "~cmp%d" !cmp_n
(* A [-] glued to one of these starts a negation: [-x] is [(- x)]. Anything
else keeps the Lisp reading, so [--], [->] and [-=] stay names. *)
let is_neg_char c =
@ -676,6 +719,30 @@ let no_loop loc word =
break leaves the loop early, and continue goes on to the next round."
word
(* A refused chain written out as the [and] of all its tests. A middle
operand that is more than a name or a literal is named by a [let] first,
so the rewrite does not run it twice. *)
let and_rewrite (xs : Form.t list) ops =
let n = List.length xs in
let lets = ref [] in
let texts =
List.mapi
(fun i (x : Form.t) ->
let plain = match x.v with Form.List _ | Form.Vec _ | Form.Map _ -> false | _ -> true in
if plain || i = 0 || i = n - 1 then text_of x
else begin
let m = if !lets = [] then "mid" else Printf.sprintf "mid%d" (List.length !lets + 1) in
lets := Printf.sprintf " let %s = %s\n" m (text_of x) :: !lets;
m
end)
xs
in
let rec tests = function
| a :: (b :: _ as rest), op :: ops -> Printf.sprintf "%s %s %s" a op b :: tests (rest, ops)
| _ -> []
in
String.concat "" (List.rev !lets) ^ " " ^ String.concat " and " (tests (texts, ops))
(* Expressions come back with their syntactic level: 13 an atom or a bracket,
12 a postfix chain, 11 a prefix [-] or [~~], 1-10 a binary operator's
level, 3 a [not], 0 a one-line [if] or a lambda. Anything under 11 is
@ -706,31 +773,62 @@ and binary p lvl : Form.t * int =
binop_level s = Some lvl
&& not ((peek_at p 1).tok = LP && not (peek_at p 1).sp)
in
let operator s =
let ot = advance p in
if not (ot.sp && (peek p).sp) then
failk "unspaced-operator" ot.loc
"%s is an operator here, and a binary operator has a space on each \
side: a %s b. Without them a-b is one name"
s s;
let rhs, _ = binary p (lvl + 1) in
(ot, rhs)
in
let rec run op operands =
match (peek p).tok with
| NAME s when binary_here s ->
let ot = advance p in
if not (ot.sp && (peek p).sp) then
failk "unspaced-operator" ot.loc
"%s is an operator here, and a binary operator has a space on each \
side: a %s b. Without them a-b is one name"
s s;
let rhs, _ = binary p (lvl + 1) in
let _, rhs = operator s in
if s = op then run op (rhs :: operands)
else begin
if lvl = 4 then
failk "mixed-comparison" ot.loc
"%s follows %s in one chain, and a chain compares with one \
operator. Join the tests with and, or parenthesise one side"
s op;
else
let folded, _ = close op operands in
run s [ rhs; folded ]
end
| _ -> close op operands
in
(* A comparison chain is read whole, then judged: one operator throughout
is the variadic call, one direction is [cmp_chain], anything else is
refused at the first operator that breaks it. *)
let rec chain acc =
match (peek p).tok with
| NAME s when binary_here s ->
let ot, rhs = operator s in
chain ((s, ot, rhs) :: acc)
| _ -> List.rev acc
in
let comparison () =
let links = chain [] in
let ops = List.map (fun (s, _, _) -> s) links in
let xs = first :: List.map (fun (_, _, x) -> x) links in
let op1 = List.hd ops in
if List.for_all (( = ) op1) ops then close op1 (List.rev xs)
else
let d = cmp_dir op1 in
Array.iteri
(fun i (op, (ot : token), _) ->
if i > 0 && (d = None || cmp_dir op <> d) then begin
let prev, _, _ = List.nth links (i - 1) in
failk "mixed-comparison" ot.loc
"%s follows %s in one chain. A chain may repeat one operator, \
or mix < with <=, or > with >=, as in 0 <= i < n. Write this \
one as tests joined with and:\n\n%s"
op prev (and_rewrite xs ops)
end)
(Array.of_list links);
(cmp_chain ~fresh:cmp_fresh (span p l0) xs ops, lvl)
in
(* [run] folds a different operator at the same level into the left
operand, so the first operator here only starts the first run. *)
match (peek p).tok with
| NAME s when binary_here s && (cmp_dir s <> None || s = "==" || s = "!=") ->
comparison ()
| NAME s when binary_here s -> run s [ first ]
| _ -> fst_
@ -2295,12 +2393,14 @@ let read_all ?(line = 1) ?col ?indent ?(global_let = true) ~file src =
let snippet = col <> None in
let col = Option.value col ~default:1 in
let saved = !source in
let saved_n = !cmp_n in
cmp_n := 0;
(* The quoted text is indexed by the buffer's lines, so a snippet that
starts on line 40 is padded to start there. *)
source :=
(file, Array.of_list (String.split_on_char '\n'
(String.make (line - 1) '\n' ^ String.make (col - 1) ' ' ^ src)));
Fun.protect ~finally:(fun () -> source := saved) (fun () ->
Fun.protect ~finally:(fun () -> source := saved; cmp_n := saved_n) (fun () ->
let toks = layout ~snippet ~base:col ?indent (lex ~line ~col ~file src) in
let s = { p = { toks; i = 0; closed = -1 }; lets = [] } in
(* At the top level, a [let] is a global, [(def x dyn v)]: a let there has

53
lib/paren_printer.ml
View File

@ -315,7 +315,60 @@ let rec layout ?(inside = fun _ -> false) spell col (f : Form.t) : string list =
| _ -> [ one ]
(** A whole file, with [source]'s comments and spellings when given. *)
(* A .fln comparison chain binds its operands to [~cmp] names, which paren
text cannot spell ([~] opens an unquote). Outside a template each gets a
name that nothing in its top-level form uses, so no reference there is
captured. Inside one a plain name would capture the caller's variable of
that name, and the paren syntax has no auto-gensym, so the name is made
where it lands: [~(Form.Sym {.s "~cmp1"})], a name no caller can write. *)
let readable_temps (f : Form.t) =
let is_temp s = String.length s > 4 && String.sub s 0 4 = "~cmp" in
let rec syms acc (f : Form.t) =
match f.v with
| Form.Sym s -> s :: acc
| Form.List l | Form.Vec l | Form.Map l -> List.fold_left syms acc l
| _ -> acc
in
let all = syms [] f in
let temps =
List.fold_left
(fun acc s -> if is_temp s && not (List.mem s acc) then s :: acc else acc)
[] (List.rev all)
|> List.rev
in
if temps = [] then f
else
let taken = ref all in
let rec pick i =
let n = if i = 1 then "mid" else Printf.sprintf "mid%d" i in
if List.mem n !taken then pick (i + 1) else (taken := n :: !taken; n)
in
let names = List.map (fun t -> (t, pick 1)) temps in
let rec go depth (f : Form.t) =
let sub l = List.map (go depth) l in
match f.v with
| Form.Sym s when is_temp s && depth > 0 ->
let m v = Form.make v f.loc in
m (Form.List
[ m (Form.Sym "unquote");
m (Form.List [ m (Form.Sym "Form.Sym");
m (Form.Map [ m (Form.Sym ".s"); m (Form.Str s) ]) ]) ])
| Form.Sym s ->
(match List.assoc_opt s names with Some n -> { f with v = Form.Sym n } | None -> f)
| Form.List [ ({ v = Form.Sym "quasiquote"; _ } as h); x ] ->
{ f with v = Form.List [ h; go (depth + 1) x ] }
| Form.List [ ({ v = Form.Sym ("unquote" | "unquote-splicing"); _ } as h); x ]
when depth > 0 ->
{ f with v = Form.List [ h; go (depth - 1) x ] }
| Form.List l -> { f with v = Form.List (sub l) }
| Form.Vec l -> { f with v = Form.Vec (sub l) }
| Form.Map l -> { f with v = Form.Map (sub l) }
| _ -> f
in
go 0 f
let program ?source (fs : Form.t list) : string =
let fs = List.map readable_temps fs in
let spell =
match source with Some src -> Source_text.spelling src | None -> fun _ -> None
in

79
runtime/flan_rt.c
View File

@ -1125,13 +1125,86 @@ _Noreturn void flan_restart_fail(const uint8_t *loc, int64_t loclen,
* dynamic stack, so the invoke site cannot see what it will find, and the
* frame cannot see who will find it. What each end knows is its own parameter
* list, so the message is both of them side by side. */
/* The top-level items of a signature "(a b c)", where an item may itself be
* bracketed: "(Ptr i32)", "[3 f64]". Up to [max]; answers how many. */
static int sig_items(const uint8_t *s, int64_t n, const uint8_t **at,
int64_t *len, int max) {
int count = 0, depth = 0;
int64_t start = -1;
for (int64_t i = 1; i + 1 < n; i++) {
uint8_t c = s[i];
if (c == ' ' && depth == 0) {
if (start >= 0 && count < max) { at[count] = s + start; len[count] = i - start; count++; }
start = -1;
continue;
}
if (start < 0) start = i;
if (c == '(' || c == '[') depth++;
else if (c == ')' || c == ']') depth--;
}
if (start >= 0 && count < max) { at[count] = s + start; len[count] = n - 1 - start; count++; }
return count;
}
static int is_number_type(const uint8_t *s, int64_t n) {
static const char *names[] = { "i8", "i16", "i32", "i64", "u8", "u16",
"u32", "u64", "f32", "f64" };
for (size_t k = 0; k < sizeof names / sizeof names[0]; k++)
if ((int64_t)strlen(names[k]) == n && memcmp(names[k], s, (size_t)n) == 0)
return 1;
return 0;
}
/* [got] is the invoke site's signature, then after each 0x1f: the syntax
* (i or p) and every argument as written. Where the two signatures differ
* only in which number type an argument is, the fix is that argument
* converted: (f64 2.5), or f64(2.5) in the indented syntax. */
_Noreturn void flan_restart_args_fail(const uint8_t *loc, int64_t loclen,
const uint8_t *name, int64_t namelen,
const uint8_t *want, int64_t wantlen,
const uint8_t *got, int64_t gotlen) {
flan_say(loc, loclen, "restart %.*s takes %.*s, given %.*s", (int)namelen,
(const char *)name, (int)wantlen, (const char *)want, (int)gotlen,
(const char *)got);
enum { MAX = 16 };
const uint8_t *part[MAX + 2];
int64_t plen[MAX + 2];
int parts = 0;
int64_t start = 0;
for (int64_t i = 0; i <= gotlen && parts < MAX + 2; i++)
if (i == gotlen || got[i] == 0x1f) {
part[parts] = got + start; plen[parts] = i - start; parts++;
start = i + 1;
}
const uint8_t *w[MAX], *g[MAX];
int64_t wl[MAX], gl[MAX];
int nw = sig_items(want, wantlen, w, wl, MAX);
int ng = sig_items(part[0], plen[0], g, gl, MAX);
char fix[512];
size_t used = 0;
fix[0] = 0;
int ok = parts >= 2 && nw == ng && ng == parts - 2 && ng > 0;
for (int k = 0; ok && k < ng; k++) {
if (wl[k] == gl[k] && memcmp(w[k], g[k], (size_t)wl[k]) == 0) continue;
if (!is_number_type(w[k], wl[k]) || !is_number_type(g[k], gl[k])) { ok = 0; break; }
int indented = plen[1] == 1 && part[1][0] == 'i';
int wrote = indented
? snprintf(fix + used, sizeof fix - used, "%s%.*s(%.*s)", used ? ", " : "",
(int)wl[k], (const char *)w[k], (int)plen[k + 2], (const char *)part[k + 2])
: snprintf(fix + used, sizeof fix - used, "%s(%.*s %.*s)", used ? ", " : "",
(int)wl[k], (const char *)w[k], (int)plen[k + 2], (const char *)part[k + 2]);
if (wrote < 0 || (size_t)wrote >= sizeof fix - used) { ok = 0; break; }
used += (size_t)wrote;
}
/* An argument the compiler could not spell is an ellipsis, and a fix with
* a hole in it is a conversion to make, not code to paste. */
int holed = strstr(fix, "\xe2\x80\xa6") != NULL;
if (ok && used > 0)
flan_say(loc, loclen, "restart %.*s takes %.*s, given %.*s. %s %s",
(int)namelen, (const char *)name, (int)wantlen, (const char *)want,
(int)plen[0], (const char *)part[0],
holed ? "Convert the argument with" : "Write", fix);
else
flan_say(loc, loclen, "restart %.*s takes %.*s, given %.*s", (int)namelen,
(const char *)name, (int)wantlen, (const char *)want, (int)plen[0],
(const char *)part[0]);
rt_trap((const uint8_t *)"RestartArity", 12);
}

15
spec-syntax.md
View File

@ -156,14 +156,25 @@ Each item: the proposal, then the reason in one line.
- **Precedence**, low to high: `or` < `and` < `not` < comparisons
(`== != < <= > >=`) < `||` < `^^` < `&&` < `<< >>` < `+ -` < `* / %` <
prefix `-` and `~~` < postfix (call, index, field). **Built.** Mixing
comparison operators in one chain, `a < b <= c`, is refused. An operator
prefix `-` and `~~` < postfix (call, index, field). **Built.** An operator
glued to `(` is always a call. The bit operators sit where Python and Rust
put them, so `x && mask == 0` is `(x && mask) == 0`.
- **The bit operators** are `a && b`, `a || b`, `a ^^ b` and `~~a`, reading
`(bit-and a b)`, `(bit-or a b)`, `(bit-xor a b)` and `(bit-not a)`. They take
integers; `and`, `or` and `not` are the logical ones. `~~` is one token, so a
nested unquote is written `~(~x)`. **Built.**
- **A comparison chain may mix `<` with `<=`, or `>` with `>=`** (decision
124). `0 <= r < rows` reads `(and (<= 0 r) (< r rows))`. It is evaluated as
`a < b < c` is: every operand once, left to right, before any test, with no
short-circuit. When an operand is more than a name or a literal, every
operand but a literal is bound first, in order, to a fresh name, so a name
is read before a call to its right runs: `a < f(x) <= b` reads
`(let [~cmp1 a ~cmp2 (f x) ~cmp3 b] (and (< ~cmp1 ~cmp2) (<= ~cmp2 ~cmp3)))`.
`flan convert` to parens names them `mid`, `mid2`, ..., or, inside a
template, `~(Form.Sym {.s "~cmp1"})`, which no caller can capture. A chain that
changes direction, `a < b > c`, or mixes in `==` or `!=`, is refused with the
whole chain rewritten as `and`, a middle call named by a `let` first. The
printer writes such an `and` back as the chain. **Built.**
- **`==` is `=`; `=` is assignment.** `x = v` reads `(set x v)`, `a[i] = v`
reads `(set (at a i) v)`, `p.x = v` reads `(set (.x p) v)`. `x += v` reads
`(set x (+ x v))` where every part of the place is a name or a literal, and

82
test/programs/literal-locals.flan Normal file
View File

@ -0,0 +1,82 @@
;;;; A number literal bound by let or loop takes its type from its uses in
;;;; the function. Each line's expected output is beside it.
;; A set of an i64 sum makes the accumulator an i64.
(defn total [xs [i64]] i64
(let [t 0]
(dotimes [i (length xs)]
(set t (+ t (at xs i))))
t))
;; The operand beside it: an f64 accumulator from a float literal.
(defn mean [xs [f64]] f64
(let [s 0.0]
(dotimes [i (length xs)]
(set s (+ s (at xs i))))
(/ s (f64 (length xs)))))
;; A counter compared with an i64 bound counts past i32.
(defn count-to [n i64] i64
(let [i 0]
(while (< i n)
(set i (+ i 1000000000)))
i))
;; A set of one literal local into another links them: b holds a value past
;; i32, so a is an i64 too.
(defn linked [] i64
(let [a 0 b 0]
(set b 3000000000)
(set a b)
a))
;; Two locals fed from each other: i is counted against an i64, and acc
;; sums a literal past i32.
(defn sum-to [n i64] i64
(let [i 0 acc 0]
(while (< i n)
(set acc (+ acc 1000000000))
(set i (+ i 1)))
acc))
;; Inside a generic body the literal takes the type variable.
(defn sum-of [xs [$t]] $t {:where (numeric? $t)}
(let [acc 0]
(dotimes [i (length xs)]
(set acc (+ acc (at xs i))))
acc))
;; A chain of sets settles however long it is.
(defn chained [x i64] i64
(let [a0 0 a1 0 a2 0 a3 0 a4 0 a5 0]
(set a0 x) (set a1 (+ a0 1)) (set a2 (+ a1 1)) (set a3 (+ a2 1))
(set a4 (+ a3 1)) (set a5 (+ a4 1))
a5))
;; A dyn number is an i64 or an f64, and so is a literal local it feeds.
(defn boxed [x] dyn x)
(defn from-dyn [] ()
(let [d (boxed 0.1) s 0.0 n 0]
(set s (+ s d))
(set n (+ n (boxed 5000000000)))
(println s n)))
(defn main [] i32
(let [xs (the [3 i64] [3000000000 4 5])
fs (the [2 f64] [0.5 0.25])
gs (the [2 u8] [200 50])]
(println (total (slice xs 0 3))) ; 3000000009
(println (mean (slice fs 0 2))) ; 0.375
(println (count-to 5000000000)) ; 5000000000
(println (linked)) ; 3000000000
(println (sum-to 3)) ; 3000000000
(println (sum-of (slice xs 0 3))) ; 3000000009
(println (sum-of (slice fs 0 2)))) ; 0.75
(println (chained 3000000000)) ; 3000000005
(from-dyn) ; 0.1 5000000000
(let [x 0.1]
(println (= (boxed x) (boxed 0.1)))) ; true
;; Nothing says otherwise: an i32 and an f64.
(let [n 7 f 1.5]
(println n f)) ; 7 1.5
0)

11
test/programs/restarts.flan
View File

@ -101,6 +101,15 @@
(handler-bind [(AssetMissing [c] (invoke-restart 'use-value 21))]
(shadowed n)))
;;; A number of another type: the refusal writes the conversion.
(defn widened [n i32] i32
(handler-bind [(AssetMissing [c] (let [big (i64 7)] (invoke-restart 'use-value big)))]
(supplied n)))
(defn doubled [n i32] i32
(handler-bind [(AssetMissing [c] (let [big (i64 7)] (invoke-restart 'use-value (* big 2))))]
(supplied n)))
(defn main [args [str]] i32
;; One argument selects a trap; none runs the table's case.
(if (> (length args) 1)
@ -110,6 +119,8 @@
(= k 2) (print (mistyped 91))
(= k 3) (print (overfull 92))
(= k 4) (print (mislaid 93))
(= k 5) (print (widened 94))
(= k 6) (print (doubled 95))
:else (println "?"))
(return 0)))

16
test/syntax/chain/macro.fln Normal file
View File

@ -0,0 +1,16 @@
;;;; A chain in a macro's template, converted to parens: the names it binds
;;;; must not capture the caller's, which here are the ones the converter
;;;; would otherwise pick.
defmacro(between, [lo x hi]):
quote
~lo <= ~x < ~hi
fn main() -> i32
let mid = 1
let mid2 = 2
let mid3 = 3
println(between(mid, 5, mid))
println(between(0, mid2, mid3))
println(between(mid3, mid2, mid))
0

76
test/syntax/handwritten/chain-mixed.fln Normal file
View File

@ -0,0 +1,76 @@
;;;; A comparison chain that mixes < with <=, or > with >=, is the and of its
;;;; neighbouring tests, evaluated as a < b < c is. Every operand below comes
;;;; through mark, which prints its tag, so each tag line is a transcript:
;;;; each operand runs exactly once, in source order, even after a false test.
once calls = 0
fn mark(tag: str, v: i32) -> i32
calls += 1
print(tag)
v
fn line(b: bool) -> ()
print(" -> ")
println(b)
; A name is read where it stands, before a call to its right changes it.
once level = 0
fn raise() -> i32
level = 10
5
fn dyn-mark(tag, v)
print(tag)
v
fn in-grid(r: i32, rows: i32) -> bool = 0 <= r < rows
fn dyn-between(lo, x, hi) = lo <= x < hi
fn main() -> i32
print(in-grid(0, 3))
print(" ")
print(in-grid(2, 3))
print(" ")
print(in-grid(3, 3))
print(" ")
print(in-grid(-1, 3))
println("")
let a = 1
let b = 2
let c = 2
let d = 5
print(a < b <= c < d)
print(" ")
print(a < b <= c < 2)
print(" ")
print(d >= c > 1)
print(" ")
print(d >= c > 2)
println("")
; A middle operand that is a call runs once although two tests name it.
line(mark("a", 1) < mark("b", 2) <= mark("c", 2))
line(mark("a", 1) < mark("b", 2) <= mark("c", 1))
; The first test is false, and every operand still runs.
line(mark("a", 3) < mark("b", 2) <= mark("c", 5))
line(mark("a", 1) <= mark("b", 2) < mark("c", 3) <= mark("d", 3))
line(mark("a", 9) >= mark("b", 5) > mark("c", 7) >= mark("d", 0))
println(calls)
; The same over dyn operands.
print(dyn-between(0, 0, 3))
print(" ")
print(dyn-between(0, 3, 3))
print(" ")
print(dyn-between(1.5, 2, 2.5))
println("")
line(dyn-mark("p", 1) < dyn-mark("q", 2) <= dyn-mark("r", 2))
line(dyn-mark("p", 5) < dyn-mark("q", 2) <= dyn-mark("r", 9))
print(level < raise() <= 7)
level = 0
print(" ")
println(<(level, raise(), 7))
0

12
test/syntax/handwritten/chain-mixed.out Normal file
View File

@ -0,0 +1,12 @@
true true false false
true false true false
abc -> true
abc -> false
abc -> false
abcd -> true
abcd -> false
17
true false true
pqr -> true
pqr -> false
true true

12
test/test_acceptance.ml
View File

@ -389,6 +389,14 @@ let () =
outputs "value semantics" "programs/values.flan" values_out;
outputs "machine surface" "programs/machine.flan" machine_out;
outputs "unit main exits 0" "programs/unit-main.flan" "ok\n";
let literal_locals_out =
"3000000009\n0.375\n5000000000\n3000000000\n3000000000\n3000000009\n\
0.75\n3000000005\n0.1 5000000000\ntrue\n7 1.5\n"
in
outputs "literal locals take their uses' type" "programs/literal-locals.flan"
literal_locals_out;
outputs ~x86:true "literal locals take their uses' type, --x86"
"programs/literal-locals.flan" literal_locals_out;
(* Comparisons over three operands and more. The lines that carry the
whole claim are the tag transcripts: [abc -> false] is a chain whose
*first* link already decided the answer and whose middle operand —
@ -1467,6 +1475,10 @@ let () =
have taken them is not consulted. *)
refuses "a shadowing clause of the same name and a different signature" "4"
"restart use-value takes (str), given (i32)";
refuses "a number of another type is refused with its conversion" "5"
"restart use-value takes (i32), given (i64). Write (i32 big)";
refuses "and the argument as it was written when it is an expression" "6"
"restart use-value takes (i32), given (i64). Write (i32 (* big 2))";
(try Sys.remove exe with Sys_error _ -> ())
in
restart_mismatch ();

47
test/test_flan.ml
View File

@ -1086,6 +1086,53 @@ let () =
two [infers] above still hold — and this is the position that had no way
to say it. *)
infers "array constructor" "(array 4 f32)" "[4 f32]";
(* A literal bound by a let takes its type from its uses in the function,
and two uses no one type satisfies are refused with the annotation. *)
accepts "a literal local takes the type set into it"
"(defn f [x i64] i64 (let [t 0] (set t (+ t x)) t))";
accepts "a literal local takes an operand's type"
"(defn f [x f64] f64 (let [s 0.0] (set s (+ s x)) s))";
accepts "recur rebinds a literal local at the type it brings"
"(defn f [n i64] i64 (loop [i 0 acc 0] (if (< i n) (recur (+ i 1) (+ acc n)) acc)))";
accepts "a set links two literal locals"
"(defn f [] i64 (let [a 0 b 0] (set b 3000000000) (set a b) a))";
accepts "a float literal local takes the f32 typed code wants"
"(defn f [x f32] f32 (let [s 0.0] (set s (+ s x)) s))";
rejects_check "a literal past f32's range where f32 is wanted"
~needle:"1e+39 does not fit in f32, whose largest value is about 3.4e38"
"(defn f [] f32 1e39)";
rejects_check "a literal f32 rounds to 0 where f32 is wanted"
~needle:"1e-50 is too small for f32, which rounds it to 0"
"(defn f [] f32 1e-50)";
infers "a literal past f32's range is an f64 like any other" "(+ 1.0 1e300)" "f64";
(* Chains through a second round, and through do, let and if arms that
merge without one. *)
accepts "a literal local fed through do, however long the chain"
"(defn f [x i64] i64 (let [a0 0 a1 0 a2 0 a3 0 a4 0 a5 0 a6 0 a7 0 a8 0 a9 0 a10 0 \
a11 0 a12 0] (set a0 x) (set a1 (do a0)) (set a2 (do a1)) (set a3 (do a2)) \
(set a4 (do a3)) (set a5 (do a4)) (set a6 (do a5)) (set a7 (do a6)) \
(set a8 (do a7)) (set a9 (do a8)) (set a10 (do a9)) (set a11 (do a10)) \
(set a12 (do a11)) a12))";
accepts "a literal local fed through a let"
"(defn f [x i64] i64 (let [a0 0 a1 0 a2 0] (set a0 x) (set a1 (let [t a0] t)) \
(set a2 (let [t a1] t)) a2))";
accepts "a literal local fed through both arms of an if"
"(defn f [x i64] i64 (let [a0 0 a1 0] (set a0 x) (set a1 (if true a0 a0)) a1))";
accepts "a literal local fed through a generic call settles in rounds"
"(defn same [x $t] $t x) (defn f [x i64] i64 (let [a0 0 a1 0 a2 0] (set a0 x) \
(set a1 (same a0)) (set a2 (same a1)) a2))";
rejects_check "a chain the rounds cannot follow names the local to annotate"
~needle:"the type of a7 depends on too long a chain of the values stored into \
it to be read off them. Write the type it should have: (i64 0)"
"(defn same [x $t] $t x) (defn f [x i64] i64 (let [a0 0 a1 0 a2 0 a3 0 a4 0 a5 0 \
a6 0 a7 0 a8 0 a9 0 a10 0] (set a0 x) (set a1 (same a0)) (set a2 (same a1)) \
(set a3 (same a2)) (set a4 (same a3)) (set a5 (same a4)) (set a6 (same a5)) \
(set a7 (same a6)) (set a8 (same a7)) (set a9 (same a8)) (set a10 (same a9)) a10))";
rejects_check "two uses of a literal local disagree"
~needle:"x is used as u32 and as i32, and 0 can have only one type. \
Write the one it should have: (u32 0)"
"(defn u [x u32] u32 x) (defn i [x i32] i32 x) \
(defn f [] i32 (let [x 0] (u x) (i x)) 0)";
infers "array of a struct" "(array 2 i32)" "[2 i32]";
infers "array of an array" "(array 2 [3 u8])" "[2 [3 u8]]";
(* (array-fill [r c] v): the same type at any rank, with the element type

53
test/test_syntax.ml
View File

@ -549,7 +549,25 @@ let () =
"(quasiquote (f (bit-not x) (unquote (bit-not y))))";
refuses "not-equal chain" "x = a != b != c" "indent/chained-not-equal" "!=(a, b, c)";
reads "not-equal call" "x = !=(a, b, c)" "(set x (!= a b c))";
refuses "mixed comparison" "x = a < b <= c" "indent/mixed-comparison" "and";
(* One direction mixes; each operand that is a call is bound once, in
order, before any test. *)
reads "mixed chain" "x = 0 <= r < rows" "(set x (and (<= 0 r) (< r rows)))";
reads "mixed chain of four" "x = a < b <= c < d"
"(set x (and (< a b) (<= b c) (< c d)))";
reads "mixed chain downward" "x = x >= y > 0" "(set x (and (>= x y) (> y 0)))";
(* A name is bound too once any operand is, so it is read in its turn. *)
reads "mixed chain over a call" "x = a < f(b) <= c"
"(set x (let [~cmp1 a ~cmp2 (f b) ~cmp3 c] (and (< ~cmp1 ~cmp2) (<= ~cmp2 ~cmp3))))";
reads "mixed chain over two calls" "x = 0 < f() <= g() < h()"
"(set x (let [~cmp1 (f) ~cmp2 (g) ~cmp3 (h)] (and (< 0 ~cmp1) (<= ~cmp1 ~cmp2) (< ~cmp2 ~cmp3))))";
refuses "chain that turns around" "x = a < b > c" "indent/mixed-comparison"
"a < b and b > c";
refuses "== in a chain" "x = a == b < c" "indent/mixed-comparison" "a == b and b < c";
refuses "== after a chain" "x = x < 1 <= 2 == true" "indent/mixed-comparison"
"x < 1 and 1 <= 2 and 2 == true";
refuses "a refused chain's middle call is named once" "x = a < f(b) <= g(c) > d"
"indent/mixed-comparison"
"let mid = f(b)\n let mid2 = g(c)\n a < mid and mid <= mid2 and mid2 > d";
(* Statements. *)
reads "lets merge" "fn f() -> i32\n let a = 1\n let b = 2\n a + b"
"(defn f [] i32 (let [a 1 b 2] (+ a b)))";
@ -946,6 +964,23 @@ let () =
fail "%s: read back %s from %S" name (describe_diff forms back) text
| exception e -> fail "%s: its text is refused: %s\n%s" name (diag_text e) text
in
round "a mixed chain" "(defn f [r i32 n i32] bool (and (<= 0 r) (< r n)))" "= 0 <= r < n";
round "an and of one operator stays an and"
"(defn f [r i32 n i32] bool (and (< 0 r) (< r n)))" "= 0 < r and r < n";
round "an and whose middles differ stays an and"
"(defn f [r i32 n i32] bool (and (<= 0 r) (< n 9)))" "= 0 <= r and n < 9";
round "a let the reader would not make stays a let"
"(defn f [a i32] bool (let [m (g)] (and (<= a m) (< m (h)))))" " let m = g()";
back "a chain's middle call gets a name paren text can spell"
"fn f(a, b) -> bool = a < g() <= b"
"(let [mid a mid2 (g) mid3 b] (and (< mid mid2) (<= mid2 mid3)))";
(* And the paren text prints as the chain again, up to the names. *)
let src = "(defn f [a i32 b i32] bool (let [mid a mid2 (g) mid3 b] (and (< mid mid2) (<= mid2 mid3))))" in
prints "a mixed chain over a call comes back a chain" src " a < g() <= b";
(let forms = Reader.read_all ~file:"<p>" src in
let back = Indent_reader.read_all ~file:"<p>" (Indent_printer.program ~source:src forms) in
if not (same_forms (List.map norm forms) (List.map norm back)) then
fail "a mixed chain over a call: read back %s" (describe_diff forms back));
round "bit operators print infix"
"(defn f [a i32 m i32] bool (= (bit-and a (bit-not m)) (bit-or (bit-xor a 1) (<< m 2))))"
"a && ~~m == a ^^ 1 || m << 2";
@ -1447,6 +1482,22 @@ let () =
[ "syntax/flat/shadows.flan"; "syntax/flat/macros.flan"; "syntax/flat/capture.flan" ];
run_both "syntax/mixed/main.flan" "12\n12\n0\n55\n";
run_both "syntax/mixed/main.fln" "25\n7\nfar\n3\n";
(* A chain in a template: its names made where the macro expands in the
paren text, and the chain printed back as one. *)
let src = In_channel.with_open_bin "syntax/chain/macro.fln" In_channel.input_all in
let want = "false\ntrue\nfalse\n" in
run_both "syntax/chain/macro.fln" want;
let forms = Indent_reader.read_all ~file:"syntax/chain/macro.fln" src in
let paren = Paren_printer.program ~source:src forms in
if not (Test_support.contains paren "~(Form.Sym {.s \"~cmp1\"}) ~lo") then
fail "a template's chain in parens: %s" paren;
let flan = Filename.concat scratch (Printf.sprintf "chain-macro-%d.flan" (Unix.getpid ())) in
Out_channel.with_open_bin flan (fun oc -> output_string oc paren);
run_both flan want;
let back = Indent_printer.program ~source:paren (Reader.read_all ~file:flan paren) in
(try Sys.remove flan with Sys_error _ -> ());
if not (Test_support.contains back "~lo <= ~x < ~hi") then
fail "a template's chain back from parens: %s" back;
(* Return types read off the body, in both spellings of [_]. *)
List.iter
(fun p -> run_both p "3\n2.5\n1.5\n2.5\nyes 0\n4\n0 5\n2\n1\n")