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

A fn's arities are one form, fn f with a (params) -> R line per arity, and evaluating it replaces every arity at once.

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-26 17:35:18 +07:00
parent 3f59c18257
commit dd719766ee
17 changed files with 664 additions and 363 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
TODO.org
View File

@ -56,13 +56,12 @@ Decided 2026-09-26 (128) to pause: dyn vectors are mutable, so taking from the f
shifts every element. Options were a linked list (cons/first/rest) or storing the dyn
vector as a ring buffer with a cheap read-only rest view; the ring buffer was
recommended. Waits on a program that needs it.
** DONE A name has one version per arity (decision 135a)
** DONE One fn form holds every arity of a name (decision 139, replacing 135a)
CLOSED: [2026-09-26]
The call's argument count picks the version at compile time; each is renamed =f~N= only
when a name has two or more. Rules out overloading by type at one arity, rest parameters
on =fn= (refused already), and more than one =main=. In the dev loop another arity adds a
version rather than replacing, so an arity change is no longer a stale-call signature
change: only a same-arity one is.
Clojure's model: the grouped =fn f= is the unit of definition, a call's argument count picks
the arity, and each is renamed =f~N= only when there are two or more. Rules out adding an
arity from a separate definition (a second =fn f= is defined twice), overloading by type at
one arity, rest parameters on =fn=, and more than one =main=.
** DONE if let
CLOSED: [2026-09-26]
=(if-let [P v] then else)= in paren syntax; an elif chain is the else. With no else it

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

@ -1291,6 +1291,23 @@ Before it at the same level, else out to the line that owns this block."
;; shifts rigidly and only when the first line is at no valid column, and a
;; yank moves its lines together.
(defun flan-fln--arity-line-p (pos)
"Non-nil if POS's line is an arity of a fn with several: it starts with
`(' and the line it is indented under is `fn NAME' with nothing after it."
(save-excursion
(goto-char pos)
(back-to-indentation)
(and (eq (char-after) ?\()
(let ((col (current-column)) (p (flan-fln--prev-code (point))) found)
(while (and p (not found))
(if (< (flan-fln--indent-at p) col)
(setq found p)
(setq p (flan-fln--prev-code p))))
(and found
(progn
(goto-char (flan-fln--first-char found))
(looking-at "fn-?[ \t]+[^][ \t\n(){},;\":]+[ \t]*\\(?:;.*\\)?$")))))))
(defun flan-fln--opener-p (start last)
"Non-nil if the joined line START..LAST opens a block on the lines under it."
(or (save-excursion
@ -1314,6 +1331,12 @@ Before it at the same level, else out to the line that owns this block."
(looking-at "[ \t]+[^][ \t\n(){},;\":]+("))))
((member w '("if" "when" "elif")) (not (flan-fln--then start)))
(t t)))))
;; An arity under `fn f', `(a: i32) -> i32', opens its block unless
;; it is the one-line `(a: i32) -> i32 = a'.
(and (flan-fln--arity-line-p start)
(save-excursion
(goto-char (flan-fln--first-char start))
(not (re-search-forward "[ \t]=[ \t]" (flan-fln--code-end last) t))))
;; `let r = match n', `x = if c', `fn f(x) = match x', a lambda
;; header: the value goes on under the line.
(flan-fln--value-opens-p start)
@ -1854,8 +1877,11 @@ lambda or a `Fn(...)' type, and not after a match arm's."
(and open
(progn
(goto-char open)
(looking-back "\\(?:^[ \t]*fn-?[ \t]+[^][ \t\n(){},;\":]+\\|\\_<C?[fF]n\\)"
(line-beginning-position)))))))))))))
(or (looking-back "\\(?:^[ \t]*fn-?[ \t]+[^][ \t\n(){},;\":]+\\|\\_<C?[fF]n\\)"
(line-beginning-position))
;; An arity under `fn f'.
(and (looking-back "^[ \t]*" (line-beginning-position))
(flan-fln--arity-line-p (point)))))))))))))))
found))
(defvar flan-fln-font-lock-keywords

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

@ -907,6 +907,35 @@ defconst(k, 3)
(test-flan-fln--tabs "let colors =\n|" 1) 2)
(test-flan-fln--is "but not after a one-line fn"
(test-flan-fln--tabs "fn f() -> i32 = 1\n|" 1) 0)
;; A fn with several arities: `fn f' alone, a `(params) -> R' line per arity
;; under it, and each arity's block under that.
(test-flan-fln--is "after fn f alone, its arities go one level deeper"
(test-flan-fln--tabs "fn area\n|" 1) 2)
(test-flan-fln--is "after an arity, its block one level deeper again"
(test-flan-fln--tabs "fn area\n (w: i32) -> i32\n|" 1) 4)
(test-flan-fln--is "and after an untyped arity"
(test-flan-fln--tabs "fn scale\n (x, y)\n|" 1) 4)
(test-flan-fln--is "but not after a one-line arity"
(test-flan-fln--tabs "fn area\n (w: i32) -> i32 = w * w\n|" 1) 2)
(test-flan-fln--is "the next arity steps out to the arities' column"
(test-flan-fln--tabs "fn area\n (w: i32) -> i32\n w * w\n|" 2) 2)
(test-flan-fln--is "a parenthesised line in a plain fn's body is no arity"
(test-flan-fln--tabs "fn f() -> ()\n (a)\n|" 1) 2)
(test-flan-fln--in "fn area\n (w: i32) -> Area\n w * w\n (w: i32, h: i32) -> Area = w * h\n"
(font-lock-ensure)
(let ((case-fold-search nil)
(face (lambda (needle)
(save-excursion (goto-char (point-min)) (search-forward needle)
(get-text-property (match-beginning 0) 'face)))))
(test-flan-fln--is "a grouped fn's name is a function name"
(funcall face "area") 'font-lock-function-name-face)
(test-flan-fln--is "and fn is a keyword" (funcall face "fn") 'font-lock-keyword-face)
(test-flan-fln--is "an arity's return type is a type"
(funcall face "Area") 'font-lock-type-face)
(test-flan-fln--is "and the one-line arity's"
(save-excursion (goto-char (point-min)) (search-forward "Area =")
(get-text-property (match-beginning 0) 'face))
'font-lock-type-face)))
(test-flan-fln--is "after if let, one level deeper"
(test-flan-fln--tabs "fn f() -> ()\n if let Some(g) = o\n|" 1) 4)
(test-flan-fln--is "and after a when with a block"

175
lib/check.ml
View File

@ -223,10 +223,10 @@ type env = {
function can show it. Kept apart from [fparams] because a foreign
[declare] has a location and no parameter vector worth showing. *)
fn_locs : (string, Loc.t) Hashtbl.t;
(* A name with several versions, one per arity (decision 135a): the name as
written, to each version's arity and the name it was renamed to
([version_name]). A name with one version is not in here and keeps its
own name, so its symbol does not change. *)
(* A fn with several arities (decision 139): the name as written, to each
arity and the name it was renamed to ([version_name]). A fn with one
arity is not in here and keeps its own name, so its symbol does not
change. *)
versions : (string, (int * string) list) Hashtbl.t;
(* Every [defn-], by name, with where it was written and how far it is
visible. See [private_ref]. *)
@ -7050,29 +7050,41 @@ and var ctx ?(qualified = false) loc ~want name =
match Option.bind want fn_sig with
| Some (ps, _) when List.mem_assoc (List.length ps) vs ->
Some (List.assoc (List.length ps) vs)
| _ ->
let fln = fln_source loc in
let k, v0 = List.hd vs in
let xs =
match Hashtbl.find_opt ctx.env.fparams v0 with
| Some fs -> List.map (fun (f : Ast.field) -> f.Ast.fname) fs
| None -> List.init k (fun i -> Printf.sprintf "x%d" (i + 1))
| wanted ->
let arities =
String.concat "\n"
(List.map (fun (_, v) -> " " ^ version_text ctx.env loc v) vs)
in
Loc.failk "check/several-versions" loc
"%s has several versions, one per number of arguments, so \
the name alone does not say which function this is. Wrap \
it in a function that calls the one you mean, as in %s. \
Its versions are:\n%s"
name
(if fln then
Printf.sprintf "fn(%s) => %s(%s)" (String.concat ", " xs)
name (String.concat ", " xs)
else
Printf.sprintf "(fn [%s] (%s %s))" (String.concat " " xs)
name (String.concat " " xs))
(String.concat "\n"
(List.map (fun (_, v) -> " " ^ version_text ctx.env loc v)
vs))
(match wanted with
(* The function type wanted here takes a count none of them
does, and no wrapping changes that. *)
| Some (ps, _) ->
let k = List.length ps in
Loc.failk "check/several-versions" loc
"%s has no arity that takes %d argument%s, which the \
function type wanted here does. Its arities are:\n%s"
name k (if k = 1 then "" else "s") arities
| None ->
let fln = fln_source loc in
let k, v0 = List.hd vs in
let xs =
match Hashtbl.find_opt ctx.env.fparams v0 with
| Some fs -> List.map (fun (f : Ast.field) -> f.Ast.fname) fs
| None -> List.init k (fun i -> Printf.sprintf "x%d" (i + 1))
in
Loc.failk "check/several-versions" loc
"%s has several arities, one per number of arguments, so \
the name alone does not say which function this is. \
Wrap it in a function that calls the one you mean, as \
in %s. Its arities are:\n%s"
name
(if fln then
Printf.sprintf "fn(%s) => %s(%s)" (String.concat ", " xs)
name (String.concat ", " xs)
else
Printf.sprintf "(fn [%s] (%s %s))" (String.concat " " xs)
name (String.concat " " xs))
arities)
in
let name =
match wanted_version () with Some v -> v | None -> name
@ -16092,7 +16104,7 @@ and ordinary_call ctx ~want loc name args =
| None ->
let n = List.length args in
Loc.failk "check/no-version" loc
"%s has no version that takes %d argument%s. It has these:\n%s"
"%s has no arity that takes %d argument%s. It has these:\n%s"
name n (if n = 1 then "" else "s")
(String.concat "\n"
(List.map (fun (_, v) -> " " ^ version_text ctx.env loc v) vs)))
@ -17790,11 +17802,15 @@ let () =
qualified names, for the reason [shadows_builtin]'s [visible] gives —
[rl/get] is not [get] and shadows nothing. *)
let shadowed_builtins (decls : Ast.decl list) : Loc.diag list =
(* Once per name: the arities of one fn are one definition. *)
let said = Hashtbl.create 4 in
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with
| Ast.Defn fn
when Hashtbl.mem builtin_set fn.Ast.name
&& not (Hashtbl.mem said fn.Ast.name)
&& (Hashtbl.replace said fn.Ast.name (); true)
&& not (String.contains fn.Ast.name '/')
&& not (String.equal fn.Ast.nloc.Loc.file Prelude.file) ->
Some
@ -17936,42 +17952,24 @@ let check_parents env =
constant may be defined in terms of another declared after it. A constant
that still does not check once no progress is left has a real error, so
the last round is run without swallowing it. *)
(* ── One name, several arities (decision 135a) ─────────────────────────
[fn f(g: Grain)] and [fn f(r: i32, c: i32)] are two versions of [f], and a
call picks one by how many arguments it passes. Nothing past the checker
knows: each version is renamed here to a name of its own, and from then on
it is an ordinary function with an ordinary symbol, cell and stale-call
word. The [~] is what keeps the renamed name out of a program's reach — it
ends a symbol in both readers — as it does for [prelude~].
(* ── One fn, several arities (decision 139) ─────────────────────────────
[fn f] with [(g: Grain) -> bool] and [(r: i32, c: i32) -> bool] under it
is one function with two arities, and a call picks one by how many
arguments it passes. [Parse.splice] made one [defn] per arity, all at the
form's location; nothing past the checker knows either: each arity is
renamed here to a name of its own, and from then on it is an ordinary
function with an ordinary symbol, cell and stale-call word. The [~] is
what keeps the renamed name out of a program's reach — it ends a symbol in
both readers — as it does for [prelude~].
A name written once keeps its name, so its symbol does not move when a file
gains or loses an unrelated version elsewhere; only a name with two or more
versions is renamed, all of its versions alike, so no version is the
plain name's by accident of order.
Types play no part: two versions of one arity are one function defined
twice, whatever their parameter types. *)
(* How many parameters a [defn] takes, paired against [env]'s types: what a
session asks of a form it is about to merge, to tell a new version of a
name from a redefinition of one it has. A vector that does not pair against
[env] — it names a type the same form declares — is counted as pairing
would count it once the type exists: a capitalised name is a type. *)
let defn_arity env (fn : Ast.fn) =
match fn.Ast.praw with
| None -> List.length fn.Ast.params
| Some items ->
(try List.length (pair_params env items)
with Loc.Error _ | Loc.Errors _ ->
let rec go = function
| [] -> 0
| Ast.Pname _ :: Ast.Ptype _ :: rest -> 1 + go rest
| Ast.Pname _ :: Ast.Pname (t, _) :: rest
when t <> "" && Char.uppercase_ascii t.[0] = t.[0]
&& Char.lowercase_ascii t.[0] <> t.[0] -> 1 + go rest
| _ :: rest -> 1 + go rest
in
go items)
A fn with one arity keeps its name, so its symbol is what it always was;
only a name with two or more is renamed, all of its arities alike, so no
arity is the plain name's by accident of order.
The form is the unit of definition, Clojure's: the arities are closed, and
a second [fn f] anywhere is [f] defined twice whatever its arity, since
letting it add one would make which arities exist depend on which files
were read. Types play no part in the choice. *)
let split_versions env (decls : Ast.decl list) : Ast.decl list =
let arities = Hashtbl.create 16 in
List.iter
@ -17980,28 +17978,37 @@ let split_versions env (decls : Ast.decl list) : Ast.decl list =
| Ast.Defn fn ->
let n = fn.Ast.name and k = List.length fn.Ast.params in
let seen = Option.value ~default:[] (Hashtbl.find_opt arities n) in
(* [main] is called by the startup code, by its own name, so it has
one version. *)
(match seen with
| (_, first) :: _ when String.equal n "main" ->
| (_, _, group) :: _ when group <> d.Ast.dloc ->
let fln = fln_source d.Ast.dloc in
Loc.failk "check/defined-twice" d.Ast.dloc
~notes:[ Loc.note first "main is already defined here" ]
"main is defined twice. The program starts at main, so it has \
one version"
~notes:[ Loc.note group (n ^ " is already defined here") ]
"%s is defined twice. A function with several arities is one \
definition, each arity under it:\n\n%s"
n
(if fln then
Printf.sprintf
" fn %s\n (a: T) -> R\n ...\n \
(a: T, b: T) -> R\n ..." n
else
Printf.sprintf " (defn %s ([a T] R ...) ([a T b T] R ...))" n)
(* [main] is called by the startup code, by its own name, so it has
one arity. *)
| (_, first, _) :: _ when String.equal n "main" ->
Loc.failk "check/defined-twice" fn.Ast.nloc
~notes:[ Loc.note first "main's other arity is here" ]
"main has one arity: the program's startup calls it by its \
name"
| _ -> ());
(match List.assoc_opt k seen with
| Some (first : Loc.t) ->
let others = List.exists (fun (j, _) -> j <> k) seen in
Loc.failk "check/defined-twice" d.Ast.dloc
~notes:[ Loc.note first (n ^ " is already defined here") ]
"%s is defined twice%s" n
(if others then
Printf.sprintf " with %d parameter%s. Each version of a \
function takes a different number of \
arguments" k (if k = 1 then "" else "s")
else "")
(match List.find_opt (fun (j, _, _) -> j = k) seen with
| Some (_, first, _) ->
Loc.failk "check/defined-twice" fn.Ast.nloc
~notes:[ Loc.note first "the other one is here" ]
"%s has two arities with %d parameter%s. Each arity takes a \
different number of arguments, which is how a call picks one"
n k (if k = 1 then "" else "s")
| None -> ());
Hashtbl.replace arities n (seen @ [ (k, d.Ast.dloc) ])
Hashtbl.replace arities n (seen @ [ (k, fn.Ast.nloc, d.Ast.dloc) ])
| _ -> ())
decls;
Hashtbl.iter
@ -18009,7 +18016,7 @@ let split_versions env (decls : Ast.decl list) : Ast.decl list =
if List.length seen > 1 then
Hashtbl.replace env.versions n
(List.sort compare
(List.map (fun (k, _) -> (k, version_name n k)) seen)))
(List.map (fun (k, _, _) -> (k, version_name n k)) seen)))
arities;
if Hashtbl.length env.versions = 0 then decls
else
@ -18088,10 +18095,10 @@ let collect env (decls : Ast.decl list) =
| None -> ()
| Some n ->
(match Hashtbl.find_opt claimed n with
(* Two [defn]s of one name may be two versions of it, and whether
they are is a question about their arities, which are known only
once the parameter vectors are paired — [split_versions], below
[pair_decls]. *)
(* Two [defn]s of one name are either the arities of one fn or one
name defined twice, and the arities are known only once the
parameter vectors are paired — [split_versions], below
[pair_decls], says which. *)
| Some (_, true) when is_defn d -> ()
| Some (first, _) ->
(* The second one is the error, because it is the one to delete;

44
lib/dev.ml
View File

@ -687,6 +687,19 @@ let version_fns t name =
| None -> false))
t.session.Session.program.Tast.fns
(* The body a stack frame is running, by the name it was compiled under. A
frame can outlive its name: a fn given a second arity has its first
compiled under a new one, and the frame still running the old body names
the old — the process's own, which is what it was built with. *)
let frame_fn t name =
match find_fn t name with
| Some f -> Some f
| None ->
List.find_opt
(fun (f : Tast.fn) ->
String.equal f.Tast.name name && f.Tast.fparent = None)
t.session.Session.host.Tast.fns
let fn_loc t name =
match find_fn t name with
| Some f -> Loc.to_string f.Tast.floc
@ -2615,7 +2628,7 @@ let stopped_frame t ~frame ~what : (string * Tast.fn, string) result =
(name
^ " is a frame of the expression this break is inside, not of the program, so there is no record of what its slots are called")
else
match find_fn t name with
match frame_fn t name with
| None ->
Error
(name
@ -2717,7 +2730,7 @@ let locals t ~frame =
| Ok (name, fn) ->
if Emit.recorded_slots fn = 0 then
ok
[ ":frame " ^ Wire.quote name; ":locals ()"; ":refused ()";
[ ":frame " ^ Wire.quote (Check.shown_name name); ":locals ()"; ":refused ()";
":note " ^ Wire.quote "this frame has no named locals" ]
else
(match bound_slots t ~frame with
@ -2764,7 +2777,7 @@ let locals t ~frame =
| Error m -> error m
| Ok (entries, refused) ->
ok
[ ":frame " ^ Wire.quote name;
[ ":frame " ^ Wire.quote (Check.shown_name name);
":locals " ^ Wire.list entries;
":refused "
^ Wire.list
@ -2949,7 +2962,7 @@ let inspect t ~frame ~slot ~path =
| Error why -> error why
| Ok (label, ty, v, addr) ->
ok
([ ":frame " ^ Wire.quote name; ":name " ^ Wire.quote label;
([ ":frame " ^ Wire.quote (Check.shown_name name); ":name " ^ Wire.quote label;
":type " ^ Wire.quote ty; ":value " ^ Wire.quote v ]
@ (match addr with
(* Unsigned, as an address is. *)
@ -3069,7 +3082,7 @@ let set_slot t ~frame ~slot ~path ~edits ~expect_stop =
the program's truth, which is the only reason it is
worth redrawing. *)
ok
[ ":frame " ^ Wire.quote name; ":name " ^ Wire.quote label;
[ ":frame " ^ Wire.quote (Check.shown_name name); ":name " ^ Wire.quote label;
":type " ^ Wire.quote ty; ":value " ^ Wire.quote v;
":wrote " ^ string_of_int (List.length edits);
":at-stop "
@ -3489,7 +3502,7 @@ let globals_op t =
program; its thunk is not part of the session, so there is no \
record of what it refers to"
else
match find_fn t name with
match frame_fn t name with
| None ->
skip
"not a function this session holds; a lifted handler clause \
@ -4483,14 +4496,25 @@ let disassemble t ~name ~form =
(* A name with several versions answers with each, as a generic with
several copies does. *)
| None when version_fns t name <> [] ->
(* Each arity under the name written, with its count beside it: the
name it is compiled under is nobody's to read. *)
let entry (f : Tast.fn) =
let own =
[ ":name " ^ Wire.quote name;
":arity " ^ string_of_int (List.length f.Tast.params) ]
in
match disassemble_fn t ~name:f.Tast.name ~form f with
| Ok fields -> Wire.list fields
| Ok fields ->
Wire.list
(own
@ List.filter
(fun fl -> not (String.starts_with ~prefix:":name " fl))
fields)
| Error m ->
Wire.list
[ ":name " ^ Wire.quote f.Tast.name;
":signature " ^ Wire.quote (signature_of_fn f);
":refused " ^ Wire.quote m ]
(own
@ [ ":signature " ^ Wire.quote (signature_of_fn f);
":refused " ^ Wire.quote m ])
in
ok
[ ":name " ^ Wire.quote name; ":form " ^ Wire.quote form;

96
lib/indent_printer.ml
View File

@ -1088,6 +1088,45 @@ and label_of = function
| ({ Form.v = Form.Kw k; _ }) :: rest when kw_ok k -> (":" ^ k ^ " ", rest)
| rest -> ("", rest)
(* One arity of a [defn] at indent [n]: [pre] and its parenthesised
parameters, the arrow and where clause, then the body as [= x] on the line
or as a block under it. [pre] is [fn name] for a one-arity fn and empty for
an arity line under a grouped one. *)
and arity_lines (f : Form.t) n pre ps (ret : Form.t) body =
let i = ind n in
match params_text ~shaped:true ps with
| None -> None
| Some pt ->
let where_, body =
match body with
| { Form.v = Form.Map [ { Form.v = Form.Kw "where"; _ }; x ]; _ } :: rest ->
let preds =
match x.v with
| Form.Vec (_ :: _ :: _ as xs) -> commas xs
| _ -> at 0 x
in
(" where " ^ preds, rest)
| _ -> ("", body)
in
let head =
i ^ pre ^ "(" ^ pt ^ ")"
(* [_] is what the reader makes of no arrow at all. *)
^ (match ret.v with Form.Sym "_" -> "" | _ -> " -> " ^ ty ret)
^ where_
in
(match body with
| [] -> Some [ head ]
| [ x ] when (match x.v with
| Form.List (({ v = Form.Sym h; _ } as hf) :: args) ->
(* A call that takes a block is a statement, not a value. *)
not (List.mem h sugar_heads) && body_split hf args = None
&& lambda_value (n + 2) "" x = None
| _ -> lambda_value (n + 2) "" x = None)
&& String.length head + 3 + String.length (at 0 x) <= width
&& not (!inside f) ->
Some [ head ^ " = " ^ unit_text x ]
| _ -> Some (head :: block (n + 2) body))
and sugar n (f : Form.t) : string list option =
let i = ind n in
match f.v with
@ -1289,41 +1328,34 @@ and sugar n (f : Form.t) : string list option =
| _ when (match lambda_parts f with Some (_, body) -> wants_block f body | None -> false) ->
let head, body = Option.get (lambda_parts f) in
Some ((i ^ head ^ " =>") :: lambda_block n body)
(* Several arities, Clojure's [(defn f ([a] ...) ([a b] ...))]: [fn f] and
a line per arity under it (decision 139). *)
| Form.List ({ v = Form.Sym (("defn" | "defn-") as d); _ } :: { v = Form.Sym name; _ }
:: (_ :: _ as clauses))
when def_name name
&& List.for_all
(fun (c : Form.t) ->
match c.v with
| Form.List ({ v = Form.Vec _; _ } :: _ :: _) -> true
| _ -> false)
clauses ->
let arities =
List.map
(fun (c : Form.t) ->
match c.v with
| Form.List ({ v = Form.Vec ps; _ } :: ret :: body) ->
arity_lines f (n + 2) "" ps ret body
| _ -> None)
clauses
in
if List.mem None arities then None
else
Some ((i ^ (if d = "defn" then "fn " else "fn- ") ^ name)
:: List.concat_map Option.get arities)
| Form.List ({ v = Form.Sym (("defn" | "defn-") as d); _ } :: { v = Form.Sym name; _ }
:: { v = Form.Vec ps; _ } :: ret :: body)
when def_name name ->
(match params_text ~shaped:true ps with
| None -> None
| Some pt ->
let where_, body =
match body with
| { v = Form.Map [ { v = Form.Kw "where"; _ }; x ]; _ } :: rest ->
let preds =
match x.v with
| Form.Vec (_ :: _ :: _ as xs) -> commas xs
| _ -> at 0 x
in
(" where " ^ preds, rest)
| _ -> ("", body)
in
let head =
i ^ (if d = "defn" then "fn " else "fn- ") ^ name ^ "(" ^ pt ^ ")"
(* [_] is what the reader makes of no arrow at all. *)
^ (match ret.v with Form.Sym "_" -> "" | _ -> " -> " ^ ty ret)
^ where_
in
(match body with
| [] -> Some [ head ]
| [ x ] when (match x.v with
| Form.List (({ v = Form.Sym h; _ } as hf) :: args) ->
(* A call that takes a block is a statement, not a value. *)
not (List.mem h sugar_heads) && body_split hf args = None
&& lambda_value (n + 2) "" x = None
| _ -> lambda_value (n + 2) "" x = None)
&& String.length head + 3 + String.length (at 0 x) <= width
&& not (!inside f) ->
Some [ head ^ " = " ^ unit_text x ]
| _ -> Some (head :: block (n + 2) body)))
arity_lines f n ((if d = "defn" then "fn " else "fn- ") ^ name) ps ret body
| Form.List ({ v = Form.Sym (("def" | "defonce" | "defconst") as d); _ }
:: { v = Form.Sym name; _ } :: rest)
when def_name name ->

41
lib/indent_reader.ml
View File

@ -2497,7 +2497,10 @@ and header (s : st) w : Form.t =
match w with
| "fn" | "fn-" ->
let name = name_tok p ~what:"the function's name" in
let lp = glued_lp p ~what:"the parameters, in parentheses glued to the name" in
let head = if w = "fn" then "defn" else "defn-" in
(* One arity: the parameters, from their open paren on, through the end
of the body. *)
let arity (lp : token) =
let ps = params p lp in
let rp = last p in
(* No arrow reads the return type off the body: the paren syntax's [_]
@ -2564,8 +2567,40 @@ and header (s : st) w : Form.t =
if (peek p).tok = INDENT then block s ~after:"fn" else []
| _ -> stray p ~after:ret_text
in
named (if w = "fn" then "defn" else "defn-")
(name :: Form.make (Form.Vec ps) lp.loc :: ret :: (where_clause @ body))
Form.make (Form.Vec ps) lp.loc :: ret :: (where_clause @ body)
in
(match (peek p).tok with
(* [fn f] with its arities under it, one [(params) -> R] line each
(decision 139). Reads [(defn f ([a T] R body) ([a T b T] R body))],
Clojure's multi-arity defn. *)
| NEWLINE when (peek_at p 1).tok = INDENT ->
ignore (advance p);
ignore (advance p);
let rec arities acc =
match (peek p).tok with
| DEDENT -> ignore (advance p); List.rev acc
| EOF -> List.rev acc
| NEWLINE -> ignore (advance p); arities acc
| LP ->
let lp = advance p in
let items = arity lp in
arities (mk p lp.loc (Form.List items) :: acc)
| tk ->
failk "fn-arity" (where_ p)
"under fn %s each line is one arity, its parameters in \
parentheses and its block under it, as in (a: i32) -> i32. \
Found %s"
(text_of name) (show tk)
in
(match arities [] with
| [] ->
failk "fn-arity" l0 "fn %s has no arities under it" (text_of name)
| cs -> named head (name :: cs))
| _ ->
let lp =
glued_lp p ~what:"the parameters, in parentheses glued to the name"
in
named head (name :: arity lp))
| "def" | "once" | "const" -> def_form s w t l0
| "struct" | "union" ->
let name = name_tok p ~what:"the type's name" in

9
lib/paren_printer.ml
View File

@ -304,8 +304,15 @@ let rec layout ?(inside = fun _ -> false) spell col (f : Form.t) : string list =
in
go 0 rest
in
(* A defn with several arities keeps only its name on the head's
line, and each arity goes on a line of its own. *)
let k =
match h, rest with
| ("defn" | "defn-"), _ :: { Form.v = Form.List ({ Form.v = Form.Vec _; _ } :: _); _ } :: _ -> 1
| _ -> kept h
in
bracket "(" ")" items
~keep:(1 + label + max (min lead (n - 1)) (min (kept h) (n - label)))
~keep:(1 + label + max (min lead (n - 1)) (min k (n - label)))
else fill items
| Form.List items -> bracket "(" ")" items ~keep:0
| Form.Vec items -> bracket "[" "]" items ~keep:0

21
lib/parse.ml
View File

@ -2277,6 +2277,27 @@ let rec splice (f : Form.t) : Form.t list =
match f.Form.v with
| Form.List ({ Form.v = Form.Sym "do"; _ } :: items) ->
List.concat_map splice items
(* A defn with several arities, Clojure's [(defn f ([a] ...) ([a b] ...))]
(decision 139), is one [defn] per arity from here on. They keep the
whole form's location as theirs, which is what tells [Check] they were
written as one definition and not as two of one name; each name carries
its own arity's location, where a message about that arity points. *)
| Form.List
({ Form.v = Form.Sym ("defn" | "defn-"); _ } as head
:: ({ Form.v = Form.Sym _; _ } as n) :: (_ :: _ as clauses))
when List.for_all
(fun (c : Form.t) ->
match c.Form.v with
| Form.List ({ Form.v = Form.Vec _; _ } :: _) -> true
| _ -> false)
clauses ->
List.map
(fun (c : Form.t) ->
match c.Form.v with
| Form.List items ->
{ f with Form.v = Form.List (head :: { n with Form.loc = c.Form.loc } :: items) }
| _ -> assert false)
clauses
| _ -> [ f ]
let parse_forms ~keep_going (forms : Form.t list) : Ast.decl list =

166
lib/session.ml
View File

@ -187,6 +187,14 @@ let stale_sites ?(live = SM.empty) ?(running = false)
else " of " ^ Filename.basename l.Loc.file))
| _ -> None
in
let arities n =
List.filter_map
(fun (f : Tast.fn) ->
if f.Tast.fparent = None && String.equal (Check.written_name f.Tast.name) n
then Some (Emit.sig_text f.Tast.params f.Tast.ret)
else None)
p.Tast.fns
in
(* Named by the declaration a body belongs to: a clause lifted out of
[step] is [step]'s call, and a generic's copy is the generic's. *)
let from ~kept m acc =
@ -200,7 +208,20 @@ let stale_sites ?(live = SM.empty) ?(running = false)
{ caller = b.owner; target = st.callee; compiled = st.csig;
current = now; at = st.sloc; running; cause = cause st }
:: acc
| _ -> acc)
| Some _ -> acc
| None ->
(* The callee's name is still a function, under other arities
than the one this site was compiled for: that arity was
removed, or the name's arities were renamed around it. A
caller that still checked was compiled again, so what is
left here is one that no longer can. *)
(match arities (Check.written_name st.callee) with
| [] -> acc
| now ->
{ caller = b.owner; target = st.callee; compiled = st.csig;
current = String.concat " or " now; at = st.sloc; running;
cause = None }
:: acc))
acc b.sites)
m acc
in
@ -964,55 +985,44 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = tr
*generic's*. Naming it here is what makes [C-c C-c] on a defmethod reach
a call site compiled before the method existed, which is the whole of why
this feature is usable in the loop the project exists for. *)
(* A [defn] is one version of its name, the one with its number of
parameters (decision 135a): it replaces that version and leaves the
others alone, and a number the name had no version for adds one. *)
let arity_of (d : Ast.decl) =
match d.Ast.d with
| Ast.Defn fn -> Some (Check.defn_arity t.env fn)
| _ -> None
in
(* The bodies a version is compiled under are named for it when the name
has several; which of the two a check makes is decided there, so both
are named and whichever the program has is the one installed. *)
(* A fn form is every arity of its name (decision 139), so it replaces all
of them: an arity the new form lacks is gone, and its compiled callers
are stale. The names here are the names written; the bodies of a fn
with several arities are compiled under names of their own, which only
the check knows ([arity_syms] below). *)
let names =
List.filter_map Ast.declared_name incoming
@ List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with
| Ast.Defmethod m -> Some m.Ast.mgen
| Ast.Defn fn ->
Option.map (Check.version_name fn.Ast.name) (arity_of d)
| _ -> None)
match d.Ast.d with Ast.Defmethod m -> Some m.Ast.mgen | _ -> None)
incoming
in
let replaces (old_ : Ast.decl) (nd : Ast.decl) =
match Ast.declared_name old_, Ast.declared_name nd with
| Some a, Some b when String.equal a b ->
(match arity_of old_, arity_of nd with
| Some i, Some j -> i = j
| _ -> true)
| _ -> false
let incoming_named n =
List.filter (fun (d : Ast.decl) -> Ast.declared_name d = Some n) incoming
in
(* Replaced in place and appended only when genuinely new, so declaration
order — which is emission order for globals — does not shuffle on every
evaluation. A declaration that replaces several — a defonce sent over a
name that had two versions — takes the place of the first and the rest
go. *)
let used = ref [] in
evaluation. The first declaration of a name takes everything the form
declares under it, and any later one of that name goes. *)
let replaced = ref [] in
let kept =
List.filter_map
List.concat_map
(fun (d : Ast.decl) ->
match List.find_opt (replaces d) incoming with
| Some nd when List.memq nd !used -> None
| Some nd -> used := nd :: !used; Some nd
| None -> Some d)
match Ast.declared_name d with
| Some n when List.mem n !replaced -> []
| Some n ->
(match incoming_named n with
| [] -> [ d ]
| nds -> replaced := n :: !replaced; nds)
| None -> [ d ])
t.decls
in
let added =
List.filter
(fun (d : Ast.decl) ->
Ast.declared_name d <> None && not (List.memq d !used))
match Ast.declared_name d with
| Some n -> not (List.mem n !replaced)
| None -> false)
incoming
in
let decls = kept @ added in
@ -1049,9 +1059,12 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = tr
let stale_site (st : site) =
match now st.callee with
| Some n -> not (String.equal n st.csig)
| None -> false
(* An arity the name's new fn form lacks: the name is still there. *)
| None ->
let w = Check.written_name st.callee in
Hashtbl.mem env.Check.versions w || Hashtbl.mem env.Check.fns w
in
(not (List.mem name names))
(not (List.mem (Check.written_name name) names))
&& SM.exists
(fun fname b ->
(String.equal b.owner name || String.equal fname name
@ -1138,14 +1151,25 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = tr
it has to be found by being an instantiation that the running process
lacks. [Emit.redefinition] then writes it as a new by-name cell, which is
the same path a [defn] the process was never built with already takes. *)
let declared_fns =
List.filter
(* Every function the program has, by name, for the lookups below: a
session's program can hold thousands. *)
let in_program = Hashtbl.create 256 in
List.iter
(fun (f : Tast.fn) -> Hashtbl.replace in_program f.Tast.name f)
program.Tast.fns;
(* A name the form declared with several arities is compiled under one name
per arity. *)
let arity_syms =
List.concat_map
(fun n ->
List.exists
(fun (f : Tast.fn) -> String.equal f.Tast.name n)
program.Tast.fns)
match Hashtbl.find_opt env.Check.versions n with
| Some vs -> List.map snd vs
| None -> [])
names
in
let declared_fns =
List.filter (Hashtbl.mem in_program) (names @ arity_syms)
in
(* ── What evaluating a [def] does to the value ────────────────────────
[def] is Common Lisp's [defparameter], and evaluating a defparameter
assigns. That is the whole difference from [defvar] — [defonce] here —
@ -1214,7 +1238,7 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = tr
program.Tast.fns)
(Check.instantiations env n)
else [])
names
(names @ arity_syms)
in
let new_instances =
List.filter_map
@ -1272,44 +1296,46 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = tr
| _ -> None)
program.Tast.fns
in
(* A name that gains a second version in the loop is renamed, all of its
versions alike ([Check.split_versions]), so the body the process has
under the plain name is no longer the program's: the version it became
is a new symbol and is installed, and every compiled body that called the
plain name is compiled again, to call the version its arguments pick.
Asked of any callee the program no longer has, which is the same fact
seen from the call site: nothing else takes a function out of a program
whose callers still check. *)
(* A fn form that changes how many arities its name has renames them
([Check.split_versions]: [f] alone, [f~1] and [f~2] beside each other), so
a compiled call can name a body the program no longer has under that
name. The caller is compiled again when its source still checks — it
then calls whichever arity its arguments pick — and is a stale caller,
tolerated above and listed by [stale_sites], when it does not. *)
let versions_moved =
let has n =
List.exists (fun (f : Tast.fn) -> String.equal f.Tast.name n)
program.Tast.fns
(* Only a form that gives a name several arities, or had one that had
them, renames anything, so only then is there anything to look for. *)
let touched =
List.exists
(fun n ->
Hashtbl.mem env.Check.versions n || Hashtbl.mem t.env.Check.versions n)
names
in
let fresh =
List.filter_map
if not touched then []
else
let has n = Hashtbl.mem in_program n in
let written = Hashtbl.create 256 in
List.iter
(fun (f : Tast.fn) ->
if Check.version_of f.Tast.name <> None
&& not (known t f.Tast.name || SM.mem f.Tast.name t.built)
then Some f.Tast.name
else None)
program.Tast.fns
in
let callers =
Hashtbl.replace written (Check.written_name f.Tast.name) ())
program.Tast.fns;
let still_named n = Hashtbl.mem written (Check.written_name n) in
SM.fold
(fun fname (b : built) acc ->
if has fname
&& List.exists (fun (st : site) -> not (has st.callee)) b.sites
&& not (List.mem b.owner tolerated)
&& List.exists
(fun (st : site) -> not (has st.callee) && still_named st.callee)
b.sites
then
match
List.find_opt (fun (f : Tast.fn) -> String.equal f.Tast.name fname)
program.Tast.fns
with
| Some { Tast.fparent = Some p; _ } when p <> "<thick>" -> p :: acc
(* A lifted body is compiled with the function it came from; a
global's initialiser has no such function, and is itself. *)
match Hashtbl.find_opt in_program fname with
| Some { Tast.fparent = Some p; _ } when p <> "<thick>" && has p ->
p :: acc
| _ -> fname :: acc
else acc)
t.built []
in
if fresh = [] then [] else fresh @ callers
in
let fns =
List.sort_uniq String.compare

32
spec-syntax.md
View File

@ -422,16 +422,28 @@ Each item: the proposal, then the reason in one line.
becomes `where is-ordered($t)` after the return type. **Built**; with no
`-> R` the return is `_`, read off the body. Several predicates are
`where p, q`.
- A name may have several versions, one per number of parameters:
`fn area(w: i32)` and `fn area(w: i32, h: i32)`. A call picks the version by
how many arguments it passes; types play no part, so two versions with the
same number of parameters are one function defined twice. A version may be
generic, and may call the others. `main` has one version. The name alone is
a value only where the wanted `Fn` type says how many parameters, as in
`apply(area, 6)` against `f: Fn(i32) -> i32`; anywhere else write a lambda,
`fn(w) => area(w, 2)`. In the dev loop a definition replaces the version with
its number of parameters and leaves the others; another number adds a
version. **Built** (decision 135a).
- A fn with several arities is one definition: `fn area` alone on its line,
and under it one line per arity, its parameters in parentheses, with its
block under that or `= expr` on the line:
```
fn area
(w: i32) -> i32 = w * w
(w: i32, h: i32) -> i32
w * h
```
It reads `(defn area ([w i32] i32 (* w w)) ([w i32 h i32] i32 (* w h)))`,
Clojure's multi-arity `defn`. A call picks the arity by how many arguments it
passes; types play no part, so two arities of one count are refused. An arity
may be generic, carry its own `where`, and call the others. The arities are
closed: a second `fn area` anywhere is `area` defined twice, whatever its
arity, and extension is `generic`/`method`'s. `main` has one arity. The name
alone is a value only where the wanted `Fn` type says how many parameters,
as in `apply(area, 6)` against `f: Fn(i32) -> i32`; anywhere else write a
lambda, `fn(w) => area(w, 2)`. In the dev loop the form replaces every arity
at once: one it no longer has is gone, and its compiled callers are listed
as stale. **Built** (decision 139).
- A `let` at the top level is a global: `let x = v`, `let x: T = v`,
`let scratch: [4 u8] = uninit` read `(def x dyn v)`, `(def x T v)`;
`once x: T`, `once x = v`, `const n = 3`. **Built.** `let x = v` and

13
test/programs/dev-versions.fln
View File

@ -1,12 +1,11 @@
;; A name with two versions in a running program: redefining one version
;; from the editor replaces it alone, and the other keeps running.
;; A fn with two arities in a running program: evaluating the fn form again
;; from the editor replaces its arities, and a call to each reaches the new
;; bodies.
import agent "vendor:agent"
fn area(w: i32) -> i32
w * w
fn area(w: i32, h: i32) -> i32
w * h
fn area
(w: i32) -> i32 = w * w
(w: i32, h: i32) -> i32 = w * h
fn main() -> i32
agent/start("/tmp/flan-dev-versions-fallback.sock")

82
test/programs/versions.fln
View File

@ -1,53 +1,51 @@
;; One name, several versions: the number of arguments picks one (decision 135a).
;; One fn, several arities: the number of arguments picks one (decision 139).
struct Grain
kind: i32
fn is-empty-cell(g: Grain) -> bool
g.kind == 0
;; One arity calling another.
fn is-empty-cell
(g: Grain) -> bool
g.kind == 0
(r: i32, c: i32) -> bool
is-empty-cell(Grain{.kind r * c})
;; One version calling another.
fn is-empty-cell(r: i32, c: i32) -> bool
is-empty-cell(Grain{.kind r * c})
;; One-line arities.
fn area
(w: i32) -> i32 = w * w
(w: i32, h: i32) -> i32 = w * h
(w: i32, h: i32, d: i32) -> i32
area(w, h) * d
fn area(w: i32) -> i32
w * w
;; A generic arity beside another, each with its own where clause.
fn pick
(x: $t) -> $t
x
(x: $t, y: $t, first: bool) -> $t where is-ordered($t)
if first then min(x, y) else max(x, y)
fn area(w: i32, h: i32) -> i32
w * h
;; An arity that recurses on itself and one that calls it.
fn count
(n: i32) -> i32
count(n, 0)
(n: i32, acc: i32) -> i32
if n == 0 then acc else count(n - 1, acc + n)
fn area(w: i32, h: i32, d: i32) -> i32
area(w, h) * d
;; defer runs per arity.
fn noisy
(a: i32) -> i32
defer println("leaving noisy/1")
a
(a: i32, b: i32) -> i32
defer println("leaving noisy/2")
a + b
;; A generic version beside a plain one.
fn pick(x: $t) -> $t
x
fn pick(x: $t, y: $t, first: bool) -> $t
if first then x else y
;; A version that recurses on itself and calls the other.
fn count(n: i32) -> i32
count(n, 0)
fn count(n: i32, acc: i32) -> i32
if n == 0 then acc else count(n - 1, acc + n)
;; defer runs per version.
fn noisy(a: i32) -> i32
defer println("leaving noisy/1")
a
fn noisy(a: i32, b: i32) -> i32
defer println("leaving noisy/2")
a + b
;; Untyped versions take dyn arguments, and the count still picks.
fn scale(x)
x * 10
fn scale(x, y)
x * y
;; Untyped arities take dyn arguments, and the count still picks.
fn scale
(x)
x * 10
(x, y)
x * y
fn apply(f: Fn(i32) -> i32, x: i32) -> i32
f(x)
@ -62,7 +60,7 @@ fn main()
println(area(3, 4, 5))
println(pick(7))
println(pick(1.5, 2.5, false))
println(pick("a", "b", true))
println(pick(3, 9, true))
println(count(10))
println(noisy(1))
println(noisy(1, 2))

4
test/test_acceptance.ml
View File

@ -2248,9 +2248,9 @@ let () =
let if_let_kept_out =
"1\n4\nnone\n6\nnone\n9\n2\nnone\n3\nnone\n5\nnil\n7\n"
in
(* One name, several versions, picked by the number of arguments. *)
(* One fn, several arities, picked by the number of arguments. *)
let versions_out =
"true\nfalse\ntrue\nfalse\n9\n12\n60\n7\n2.5\na\n55\n\
"true\nfalse\ntrue\nfalse\n9\n12\n60\n7\n2.5\n3\n55\n\
leaving noisy/1\n1\nleaving noisy/2\n3\n40\n5\n36\n12\n"
in
outputs "versions by arity" "programs/versions.fln" versions_out;

45
test/test_dev.ml
View File

@ -5551,7 +5551,7 @@ let () =
if not (await ~ms:10000 (fun () -> not (alive ()))) then
fail "--two-process: the new child did not finish"
else begin
let r = ev "(defn helper [] f64 1.25)" in
let r = ev "(defn helper [x i64] i64 x)" in
if status r <> "ok" then
fail "--two-process: a change while the child has ended: %s"
(Option.value ~default:"" (Wire.string_field r "message"));
@ -5568,7 +5568,7 @@ let () =
(fun code ->
if status (ev code) <> "ok" then
fail "--two-process: %s was refused" code)
[ "(defn user [] i64 (i64 (* (helper) 4.0)))"; "(defn step [] i64 (user))" ];
[ "(defn user [] i64 (helper 5))"; "(defn step [] i64 (user))" ];
Buffer.clear seen;
let r = ask "(:op \"rerun\")" in
if status r <> "ok" then
@ -7540,9 +7540,9 @@ let () =
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ fsock; fout ])
[ "x86"; "llvm" ];
(* ── One name, two versions (decision 135a) ──────────────────────────
Redefining one version of a running program's function from a .fln
buffer replaces that version alone: the other still answers, and the
(* ── One fn, two arities (decision 139) ─────────────────────────────
Evaluating a running program's fn form again from a .fln buffer
replaces its arities: a call to each reaches the new body, and the
listing shows the name once with both signatures. *)
List.iter
(fun backend ->
@ -7583,23 +7583,34 @@ let () =
if not (await ~ms:20000 (fun () -> status (ask "1") = "ok")) then
fail "--%s: the versions program never took an expression" backend
else begin
is "the one-argument version" "area(3)" "9";
is "the two-argument version" "area(3, 4)" "12";
is "the one-argument arity" "area(3)" "9";
is "the two-argument arity" "area(3, 4)" "12";
let r =
request c
(Printf.sprintf "(:op \"eval\" :code %s :file %s)"
(Wire.quote "fn area(w: i32, h: i32) -> i32\n w * h + 100")
(Wire.quote
"fn area\n (w: i32) -> i32 = w * w + 1\n \
(w: i32, h: i32) -> i32 = w * h + 100")
(Wire.quote file))
in
if status r <> "ok" then
fail "--%s: redefining one version: %s" backend
fail "--%s: evaluating the fn form again: %s" backend
(Option.value ~default:(status r) (Wire.string_field r "message"));
is "the redefined version" "area(3, 4)" "112";
is "the version left alone" "area(3)" "9";
let defs = request c "(:op \"defs\")" in
let text = Form.to_string defs in
is "the new two-argument arity" "area(3, 4)" "112";
is "the new one-argument arity" "area(3)" "10";
let text = Form.to_string (request c "(:op \"defs\")") in
if not (contains_sub text "area [i32] i32 | area [i32 i32] i32") then
fail "--%s: defs did not list both versions of area: %s" backend text
fail "--%s: defs did not list both arities of area: %s" backend text;
(* Each arity's code, under the name written and its count. *)
let d =
request c "(:op \"disassemble\" :name \"area\" :form \"ir\")"
in
let text = Form.to_string d in
if status d <> "ok" || not (contains_sub text ":arity 2")
|| contains_sub text ":name \"area~"
then
fail "--%s: disassembling area answered %s" backend
(String.sub text 0 (min 300 (String.length text)))
end;
(try Unix.close c with Unix.Unix_error _ -> ());
(try Unix.kill vpid Sys.sigkill with Unix.Unix_error _ -> ());
@ -8451,7 +8462,7 @@ let () =
| v ->
fail "--%s: a capturing fn at the prompt answered %s" backend
(Option.value ~default:"nothing" v));
let r = eval "(defn scale [x f64] i64 (i64 (* x 3.0)))" in
let r = eval "(defn scale [x i64 k i64] i64 (* x k))" in
if status r <> "ok" then
fail "--%s: a signature change was refused: %s" backend (said r)
else begin
@ -8483,7 +8494,7 @@ let () =
if not (contains_sub fields want) then
fail "--%s: StaleCall's fields do not show %S: %s"
backend want fields)
[ "scale"; "[i64] i64"; "[f64] i64" ];
[ "scale"; "[i64] i64"; "[i64 i64] i64" ];
(match Wire.string_field (request c "(:op \"break\")") "site" with
| Some site when contains_sub site "dev-stale.flan:23:" -> ()
| Some site -> fail "--%s: the stale call's site is %s" backend site
@ -8492,7 +8503,7 @@ let () =
let r =
eval
"(defn step [] i64 (set ticks (+ ticks 1)) \
(set seen (scale (f64 ticks))) seen)"
(set seen (scale ticks 3)) seen)"
in
if status r <> "ok" then
fail "--%s: recompiling the stale caller: %s" backend (said r)

55
test/test_flan.ml
View File

@ -1507,37 +1507,44 @@ let () =
refuses_all ~fln:true "~~ in .fln" "fn f(a: bool) -> i32\n ~~a\n" "~~ works on the bits";
refuses_all ~fln:true "^^ in .fln" "fn f(a: bool, b: bool) -> bool\n a ^^ b == 0\n"
"write a != b";
(* ── One name, several versions (decision 135a) ─────────────────── *)
let two = "fn f(a: i32) -> i32\n a\n\nfn f(a: i32, b: i32) -> i32\n a + b\n\n" in
refuses_all ~fln:true "two versions of one arity are defined twice"
(two ^ "fn f(x: i64, y: i64) -> i64\n x\n")
"f is defined twice with 2 parameters";
refuses_all ~fln:true "one arity written twice is defined twice"
"fn g(a: i32) -> i32\n a\n\nfn g(b: bool) -> i32\n 0\n"
"g is defined twice";
refuses_all ~fln:true "main has one version"
"fn main()\n 0\n\nfn main(x: i32)\n 0\n" "main is defined twice";
refuses_all ~fln:true "a call no version takes lists the versions"
(* ── One fn, several arities (decision 139) ─────────────────────── *)
let two = "fn f\n (a: i32) -> i32 = a\n (a: i32, b: i32) -> i32 = a + b\n\n" in
refuses_all ~fln:true "a second fn of one name is defined twice, whatever its arity"
"fn f(a: i32) -> i32\n a\n\nfn f(a: i32, b: i32) -> i32\n a + b\n"
"f is defined twice. A function with several arities is one definition, \
each arity under it:\n\n fn f\n (a: T) -> R";
refuses_all "and in parens, the grouped defn"
"(defn f [a i32] i32 a) (defn f [a i32 b i32] i32 (+ a b))"
"(defn f ([a T] R ...) ([a T b T] R ...))";
refuses_all ~fln:true "a second fn beside a grouped one is defined twice"
(two ^ "fn f(x: i64, y: i64, z: i64) -> i64\n x\n") "f is defined twice";
refuses_all ~fln:true "two arities of one count"
"fn g\n (a: i32) -> i32 = a\n (b: bool) -> i32 = 0\n"
"g has two arities with 1 parameter";
refuses_all ~fln:true "main has one arity"
"fn main\n () = 0\n (x: i32) = 0\n" "main has one arity";
refuses_all ~fln:true "a line under fn f that is not an arity"
"fn f\n (a: i32) -> i32 = a\n x = 3\n" "under fn f each line is one arity";
refuses_all ~fln:true "a call no arity takes lists the arities"
(two ^ "fn h() -> i32\n f(1, 2, 3)\n")
"f has no version that takes 3 arguments. It has these:\n f(a: i32)\n \
"f has no arity that takes 3 arguments. It has these:\n f(a: i32)\n \
f(a: i32, b: i32)";
refuses_all "and in parens, in the file's own spelling"
"(defn f [a i32] i32 a) (defn f [a i32 b i32] i32 (+ a b)) \
(defn h [] i32 (f))"
"(defn f ([a i32] i32 a) ([a i32 b i32] i32 (+ a b))) (defn h [] i32 (f))"
"It has these:\n (f [a i32])\n (f [a i32 b i32])";
refuses_all ~fln:true "the name alone is not a value"
(two ^ "fn h() -> i32\n let g = f\n 0\n")
"f has several versions, one per number of arguments, so the name alone \
"f has several arities, one per number of arguments, so the name alone \
does not say which function this is. Wrap it in a function that calls \
the one you mean, as in fn(a) => f(a)";
refuses_all ~fln:true "a wanted Fn type of another arity picks nothing"
(two ^ "fn h() -> i32\n let g: Fn(i32, i32, i32) -> i32 = f\n 0\n")
"f has several versions";
"f has no arity that takes 3 arguments, which the function type wanted here does";
refuses_all ~fln:true "an argument's refusal names the function as written"
(two ^ "fn h() -> i32\n f(true)\n")
"this is the 1st argument of f";
refuses_all ~fln:true "fn takes no rest parameter to overlap a version"
"fn f(a: i32) -> i32\n a\n\nfn f(a: i32, & xs) -> i32\n a\n"
refuses_all ~fln:true "an arity takes no rest parameter"
"fn f\n (a: i32) -> i32 = a\n (a: i32, & xs) -> i32 = a\n"
"& (a rest parameter) is not one";
rejects_check "popcount of a float"
"(defn f [a f64] f64 (popcount a))" ~needle:"popcount takes integers, found f64";
@ -6207,11 +6214,19 @@ let () =
kind_is "a name defined twice has a kind"
"(defn f [] i32 1)\n(defn f [] i32 2)" "check/defined-twice";
kind_is "a call no version takes has a kind"
"(defn f [] i32 1)\n(defn f [a i32] i32 a)\n(defn g [] i32 (f 1 2))"
"(defn f ([] i32 1) ([a i32] i32 a))\n(defn g [] i32 (f 1 2))"
"check/no-version";
kind_is "a name with versions as a value has a kind"
"(defn f [] i32 1)\n(defn f [a i32] i32 a)\n(defn g [] i32 (let [h f] 0))"
"(defn f ([] i32 1) ([a i32] i32 a))\n(defn g [] i32 (let [h f] 0))"
"check/several-versions";
check "a fn with several arities over a builtin is warned about once"
(List.length
(Check.shadowed_builtins
(Parse.program (read "(defn get ([a i32] i32 a) ([a i32 b i32] i32 b))")))
= 1);
check "an arity's compiled name is shown as the name written"
(Check.shown_name "helper~2" = "helper"
&& Check.written_name "gen~1-i32" = "gen-i32");
(* The note is the half a location and a string could never carry: the
*other* place, with its own span and its own explanation. *)

174
test/test_session.ml
View File

@ -54,15 +54,14 @@ let () =
each of these installs and names no stale caller. Dyn-ness is part of a
signature like anything else; the last two are the changes the source
does not spell out as a type. *)
let installs ?(fn = "outer") ?(stale = []) name src =
let installs name src =
let t, _ = Session.create ~file:"programs/reload.flan" () in
match Session.eval t src with
| c ->
if not (List.mem fn c.Session.fns) then
if not (List.mem "outer" c.Session.fns) then
fail "%s installed %s" name (String.concat " " c.Session.fns);
if List.map (fun (x : Session.stale) -> x.Session.caller) c.Session.stale
<> stale
then fail "%s left the wrong callers behind" name
if c.Session.stale <> [] then
fail "%s left a caller behind that nothing has" name
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "%s was refused: %s" name m
in
(* A session's defn named as a prelude macro shadows it for a later form
@ -78,51 +77,112 @@ let () =
(String.concat " " c.Session.fns)
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "a call to a session's clamp was expanded as the macro: %s" m);
(* A changed parameter keeps the number of them: another number is another
version of the name (decision 135a), below. [helper] is called from
[bump], which is left compiled against the old signature. *)
installs ~fn:"helper" ~stale:[ "bump" ] "a changed parameter type"
"(defn helper [x f64] i64 (i64 x))";
installs "a changed parameter type" "(defn outer [x i64] i64 (bump))";
installs "a changed return type" "(defn outer [] i32 (i32 (bump)))";
installs "a changed arity" "(defn outer [a i64 b i64] i64 (bump))";
installs "a return type that became dyn" "(defn outer [] dyn (bump))";
installs ~fn:"helper" ~stale:[ "bump" ] "a parameter that became dyn"
"(defn helper [x] i64 7)";
installs "a parameter that became dyn" "(defn outer [x] i64 (bump))";
(* Another number of parameters is another version of the name. Both
versions are renamed for their arities, so the one the process had under
the plain name is installed again under its new one; redefining one
version then replaces it alone and leaves the other in the program. *)
(* A fn form with several arities (decision 139) is every arity of its name:
each is compiled under a name of its own, evaluating the form again
replaces all of them, and an arity it no longer has is gone. *)
(let t, _ = Session.create ~file:"programs/reload.flan" () in
match Session.eval t "(defn outer [a i64 b i64] i64 (+ a b (bump)))" with
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "a second version was refused: %s" m
| c ->
if List.sort compare c.Session.fns <> [ "outer~0"; "outer~2" ] then
fail "a second version installed %s" (String.concat " " c.Session.fns);
if c.Session.stale <> [] then fail "a second version left a caller behind";
(match Session.eval t "(defn outer [a i64 b i64] i64 (* a b))" with
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "redefining one version was refused: %s" m
| c ->
if c.Session.fns <> [ "outer~2" ] then
fail "redefining one version installed %s"
(String.concat " " c.Session.fns);
let names =
List.map (fun (f : Tast.fn) -> f.Tast.name) t.Session.program.Tast.fns
in
if not (List.mem "outer~0" names && List.mem "outer~2" names) then
fail "redefining one version lost the other"));
(* A compiled caller of the plain name is compiled again, to call the
version its arguments pick: [bump] calls [helper] with one argument. *)
let names () =
List.map (fun (f : Tast.fn) -> f.Tast.name) t.Session.program.Tast.fns
in
let eval what src =
match Session.eval t src with
| c -> Some c
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "%s was refused: %s" what m; None
in
(match eval "two arities" "(defn outer ([] i64 (bump)) ([a i64 b i64] i64 (+ a b)))" with
| Some c ->
if List.sort compare c.Session.fns <> [ "outer~0"; "outer~2" ] then
fail "two arities installed %s" (String.concat " " c.Session.fns);
if c.Session.stale <> [] then fail "two arities left a caller behind"
| None -> ());
(match eval "the form again" "(defn outer ([] i64 (bump)) ([a i64 b i64] i64 (* a b)))" with
| Some c ->
if List.sort compare c.Session.fns <> [ "outer~0"; "outer~2" ] then
fail "the form again installed %s" (String.concat " " c.Session.fns)
| None -> ());
(match eval "one arity left" "(defn outer [a i64 b i64] i64 (* a b))" with
| Some c ->
if c.Session.fns <> [ "outer" ] then
fail "one arity left installed %s" (String.concat " " c.Session.fns);
if List.mem "outer~0" (names ()) || List.mem "outer~2" (names ()) then
fail "a removed arity is still in the program"
| None -> ()));
(* The arities' renaming reaches every kind of caller. A global whose
initialiser calls the name, or holds it as a value, is compiled again as
the initialiser it is and not as a function of its name; a caller of a
generic's copy calls the renamed copy; and a type declared in the same
form as a signature that names it is no reason to refuse the form. *)
(let t, _ = Session.create ~file:"programs/reload.flan" () in
let eval what src =
match Session.eval t src with
| c -> Some c
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "%s was refused: %s" what m; None
in
ignore (eval "a global calling helper" "(def n i64 (helper 4))");
ignore
(eval "a global holding helper"
"(defstruct Box [f (CFn [i64] i64)]) (def bx Box (Box {.f helper}))");
ignore (eval "a generic" "(defn gen [x $t] $t x)");
ignore (eval "its caller" "(defn gen-user [] i32 (gen 5))");
(match eval "helper's second arity past the globals"
"(defn helper ([x i64] i64 (* x 3)) ([x i64 y i64] i64 (+ x y)))" with
| Some c ->
List.iter
(fun n ->
if List.mem n c.Session.fns then
fail "helper's second arity installed the global %s as a function" n)
[ "n"; "bx" ]
| None -> ());
(match eval "gen's second arity" "(defn gen ([x $t] $t x) ([x $t y $t] $t y))" with
| Some c ->
List.iter
(fun n ->
if not (List.mem n c.Session.fns) then
fail "gen's second arity did not install %s: %s" n
(String.concat " " c.Session.fns))
[ "gen~1-i32"; "gen-user" ]
| None -> ());
ignore
(eval "a same-arity helper over a type the form declares"
"(defstruct Fresh [a i64]) (defn helper [x Fresh] i64 (.a x))"));
(* [bump] calls [helper] with one argument. Giving [helper] a second arity
compiles [bump] again, to call the arity its argument picks; taking the
one-argument arity away leaves [bump] a stale caller. *)
(let t, _ = Session.create ~file:"programs/reload.flan" () in
(match
Session.eval t "(defn helper ([x i64] i64 (* x 3)) ([x i64 y i64] i64 (+ x y)))"
with
| c ->
if List.sort compare c.Session.fns <> [ "bump"; "helper~1"; "helper~2" ] then
fail "a second arity of a called function installed %s"
(String.concat " " c.Session.fns);
if c.Session.stale <> [] then
fail "a second arity of a called function left a caller behind"
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "a second arity of a called function was refused: %s" m);
match Session.eval t "(defn helper [x i64 y i64] i64 (+ x y))" with
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "a second version of a called function was refused: %s" m
| c ->
if List.sort compare c.Session.fns <> [ "bump"; "helper~1"; "helper~2" ] then
fail "a second version of a called function installed %s"
(String.concat " " c.Session.fns);
if c.Session.stale <> [] then
fail "a second version of a called function left a caller behind");
(match c.Session.stale with
| [ x ] when x.Session.caller = "bump" && x.Session.target = "helper~1"
&& x.Session.compiled = "[i64] i64"
&& x.Session.current = "[i64 i64] i64" -> ()
| l ->
fail "a removed arity's stale callers were %s"
(String.concat ", "
(List.map
(fun (x : Session.stale) ->
x.Session.caller ^ "->" ^ x.Session.target ^ " "
^ x.Session.current)
l)))
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "removing an arity was refused: %s" m);
(* [main] is the exception: the startup code calls it, and that call was
compiled into the program when it started. *)
refuses ~file:"programs/dev-stale.flan" "a changed main"
@ -134,7 +194,7 @@ let () =
with both signatures. [step]'s source no longer checks against the new
arity, and that is not a reason to refuse: it is not being recompiled. *)
(let t, _ = Session.create ~file:"programs/dev-stale.flan" () in
match Session.eval t "(defn scale [x f64] i64 (i64 (* x 2.0)))" with
match Session.eval t "(defn scale [x i64 k i64] i64 (* x k))" with
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "a signature change with compiled callers was refused: %s" m
| c ->
@ -148,12 +208,12 @@ let () =
c.Session.stale
in
let want =
[ ("step", "scale", "[i64] i64", "[f64] i64", 23);
("pick", "scale", "[i64] i64", "[f64] i64", 26);
[ ("step", "scale", "[i64] i64", "[i64 i64] i64", 23);
("pick", "scale", "[i64] i64", "[i64 i64] i64", 26);
(* The clause's call is named for the function it is written in,
not for the lifted function it became. *)
("guarded", "scale", "[i64] i64", "[f64] i64", 45);
("guarded", "scale", "[i64] i64", "[f64] i64", 46) ]
("guarded", "scale", "[i64] i64", "[i64 i64] i64", 45);
("guarded", "scale", "[i64] i64", "[i64 i64] i64", 46) ]
in
if named <> want then
fail "the stale callers were %s"
@ -164,7 +224,7 @@ let () =
(* Recompiling a stale caller clears it, and only it. *)
(match
Session.eval t
"(defn step [] i64 (set ticks (+ ticks 1)) (set seen (scale (f64 ticks))) seen)"
"(defn step [] i64 (set ticks (+ ticks 1)) (set seen (scale ticks 3)) seen)"
with
| c ->
(match c.Session.stale with
@ -216,9 +276,9 @@ let () =
in
let main_src =
"(defn main [] i32 (agent/start \"/tmp/x.sock\") \
(dotimes [i 6000] (agent/wait 5) (restart-case (step) (skip-frame [] 0))) 0)"
(dotimes [i 6000] (agent/wait 5) (restart-case (step 1) (skip-frame [] 0))) 0)"
in
(match Session.eval t "(defn step [] i32 (set seen (scale ticks)) (i32 seen))" with
(match Session.eval t "(defn step [x i64] i64 (set seen (scale x)) seen)" with
| c ->
if mains c <> [ true ] then fail "a stale call in main was not flagged as running"
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "changing step: %s" m);
@ -233,10 +293,10 @@ let () =
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "after a re-run: %s" m));
(let t, _ = Session.create ~file:"programs/dev-stale.flan" () in
ignore
(Session.eval ~running:false t "(defn step [] i32 (set seen (scale ticks)) (i32 seen))");
(Session.eval ~running:false t "(defn step [x i64] i64 (set seen (scale x)) seen)");
match
Session.eval ~running:false t
"(defn main [] i32 (dotimes [i 3] (restart-case (step) (skip-frame [] 0))) 0)"
"(defn main [] i32 (dotimes [i 3] (restart-case (step 1) (skip-frame [] 0))) 0)"
with
| c ->
if List.exists (fun (x : Session.stale) -> x.Session.caller = "main")
@ -266,7 +326,7 @@ let () =
tolerance is for a body compiled against a signature that changed, and
[twice] here is new, in the form, and wrong. *)
refuses ~file:"programs/dev-stale.flan" "a form that is wrong on its own"
"(defn scale [x f64] i64 (i64 x)) (defn twice [] i64 (scale ticks))"
"(defn scale [x i64 k i64] i64 (* x k)) (defn twice [] i64 (scale 1))"
"scale";
(* The storage exists and has a shape: reusing it reads at the wrong offsets,
@ -964,7 +1024,7 @@ let () =
(let tp, _ = Session.create ~file:"programs/pkg-private.flan" () in
match
Session.eval ~origin:"programs/pkgs/secret/secret.flan" tp
"(defn- combine [a i32 b i64] i32 (mix a (i32 b)))"
"(defn- combine [a i32 b i32 c i32] i32 (mix a (+ b c)))"
with
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "a package function's signature change was refused: %s" m
@ -982,7 +1042,7 @@ let () =
(List.map (fun (n, f, l) -> Printf.sprintf "%s %s:%d" n f l) where));
(match
Session.eval ~origin:"programs/pkg-private.flan" tp
"(defn main [] i32 (print (secret/combine 1 2)) 0)"
"(defn main [] i32 (print (secret/combine 1 2 3)) 0)"
with
| _ -> fail "a stale caller recompiled past a defn- was accepted"
| exception Loc.Error { Loc.dmsg = m; _ } ->
@ -991,7 +1051,7 @@ let () =
(let tp, _ = Session.create ~file:"programs/pkg-private.flan" () in
match
Session.eval ~origin:"programs/pkgs/secret/secret.flan" tp
"(defn- mix [a i32 b i64] i32 (+ (* a 10) (i32 b)))"
"(defn- mix [a i32 b i32 c i32] i32 (+ (* a 10) (+ b c)))"
with
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "a private package function's signature change was refused: %s" m