Places are evaluated once, enums have a predicate, CFn values live in structs, and a program's names cannot break the prelude
This commit is contained in:
commit
89e4f53895
68
TODO.org
68
TODO.org
@ -630,12 +630,6 @@ generic binding — saying =$= marks a
|
||||
type variable and naming the bare spelling. A =defn= parameter was already
|
||||
refused, as a type in a name slot.
|
||||
|
||||
** NEXT A container parameter the function grows is warned at
|
||||
Decided 2026-09-25: Odin's behaviour stays — a Vec or Map passed by value is a
|
||||
copy of its header, so growth inside the callee does not reach the caller. A
|
||||
parameter the function grows (push, put, reserve, anything that can reallocate)
|
||||
gets a warning at the parameter suggesting (Ptr ...).
|
||||
|
||||
** CANCELLED not= as a spelling of !=
|
||||
CLOSED: [2026-09-25]
|
||||
One spelling for one operation; != stays, and not= is refused with a suggestion
|
||||
@ -680,14 +674,6 @@ A machine-type target needs =numeric?=; an enum target needs =integer?=;
|
||||
by what it claims, not by the set it happens to denote this week — which is why
|
||||
=ordered?= is refused even though every type it admits today converts.
|
||||
|
||||
** NEXT There is now no generic enum to integer conversion
|
||||
Decided 2026-09-25: build =enum?= as described.
|
||||
Recorded as a loss. The one spelling that worked did so by not asking about the
|
||||
operand at all, so removing it was still right. =enum?= is the eventual answer —
|
||||
it would entail =ordered?= and =equal?= and not =numeric?=, so the cast rule
|
||||
becomes a disjunction and the refusal has to name whichever the reader meant. Each
|
||||
part of that is a decision and the author has not been asked.
|
||||
|
||||
** DONE The Ptr and union arms of the fill boundary are relaxable
|
||||
CLOSED: [2026-09-25]
|
||||
A =Ptr= may be byte-filled, and an untagged union is filled over its whole
|
||||
@ -856,34 +842,12 @@ CLOSED: [2026-09-20]
|
||||
typed conditions stay strict =bool=. =and= and =or= hand back the operand that
|
||||
decided them, Clojure's rule, through a desugaring that evaluates each test once.
|
||||
|
||||
** NEXT A bool arm and a dyn arm joining as dyn
|
||||
Decided 2026-09-25: they join as =dyn=, the =bool= boxed — Clojure's rule, so =(or false (box "s"))= answers ="s"=.
|
||||
With both arms of a desugared =and=/=or= holding real values, a non-bool =dyn= on
|
||||
the losing side meets the strict =bool= boundary and traps —
|
||||
=(or false (box "s"))= is the case. Whether a =bool= arm and a =dyn= arm should
|
||||
join as =dyn= is the author's call and is not settled.
|
||||
|
||||
** NEXT A truthiness failure re-runs the whole failing subtree
|
||||
Decided 2026-09-25: fix it without changing any message — the retry reuses what the first pass settled for each subtree (memoised by node), so nested =not= is linear. Test with a deep nest that must fail fast and with the existing message tests unchanged.
|
||||
The retry exists to keep a refused literal's message unchanged and re-runs the
|
||||
subtree rather than the leaf, which is exponential in nested =not= depth on a
|
||||
program that does not type-check. Moot for anything that compiles; only the
|
||||
daemon's half-typed recompiles could feel it. A cheaper retry was tried and
|
||||
shelved because it changes which literal gets the nicer message.
|
||||
|
||||
** DONE and's last operand gets a misdirected caret
|
||||
CLOSED: [2026-09-25]
|
||||
Already fixed by 3672da2, which blames the arm that is not a compiler temp; the
|
||||
caret is on the last operand and =test/test_flan.ml= asserts its column. Rules
|
||||
out relabelling the else arm, a bool sentinel, and inverting the condition.
|
||||
|
||||
** NEXT Signature pairing's cold-rebuild edge
|
||||
Decided 2026-09-25: the type takes precedence, as today. The warning is at the parameter site: where a name in a parameter vector is read as a program-declared type but could also have been read as a parameter name, the parameter vector gets a warning naming the type and where it is declared.
|
||||
Whether a parameter vector reads as one annotated parameter or two dyn ones
|
||||
depends on what type names exist, so adding a type can silently re-pair an
|
||||
existing signature between compiles. A changed-pairing warning was proposed and
|
||||
not queued.
|
||||
|
||||
** DONE A typed container crosses into dyn as a view, and only from permanent storage
|
||||
CLOSED: [2026-09-20]
|
||||
The descriptor is pointer, length and element type — a slice plus the piece a
|
||||
@ -1006,13 +970,10 @@ at all, which is what the diagnosis predicted. A =map= that *changes* the elemen
|
||||
type is the one shape that did not come with them: one copy per ordered pair of
|
||||
types rather than per type.
|
||||
|
||||
** NEXT CFn in a struct or a fixed array
|
||||
Decided 2026-09-25: allowed. A call through a null =CFn= is a named runtime condition on both backends, and parks in a dev build.
|
||||
A zeroed function value is a null pointer, so a function value is refused in any
|
||||
position zero-initialisation would conjure one — =CFn= included. An =(Option
|
||||
(CFn ...))= field is already legal. A table of function pointers is exactly what
|
||||
=CFn= is for, and the objection is about zero-initialisation rather than about
|
||||
capture.
|
||||
** DONE CFn in a struct or a fixed array
|
||||
CLOSED: [2026-09-25]
|
||||
A zeroed =CFn= is admitted everywhere and a call through a null one signals
|
||||
=NullCall= before its arguments run. =(Fn ...)= stays refused in those positions.
|
||||
|
||||
** DONE Structural compatibility is identical layout
|
||||
Same fields, same types, same order, so structural compatibility is "the same
|
||||
@ -1655,12 +1616,6 @@ a defcustom.
|
||||
The agent keeps the condition pointer beside its name and a verb hands it back, so
|
||||
the editor can render the condition's own fields rather than only its class.
|
||||
|
||||
** NEXT The type identity of a local is not qualified
|
||||
Decided 2026-09-25: a local's type prints package-qualified in the break buffer and the inspector, as a field's and a condition's already do.
|
||||
Settled for conditions and for structs, because =Load= qualifies every declaration
|
||||
at import. Still open for locals, where the debug information gives a bare name and
|
||||
nothing qualifies it.
|
||||
|
||||
** NEXT The render-thunk-per-inspection design
|
||||
Decided 2026-09-25: the inspector reads a value through the type layouts the compiler records, with no compile per inspection, which lets it hold a value.
|
||||
An inspection still compiles a thunk per request. A redesign rather than a
|
||||
@ -1930,21 +1885,6 @@ CLOSED: [2026-09-25]
|
||||
=put= on an instance still checks a declared slot's type and still inserts an
|
||||
undeclared key; only =set= refuses one, since a slot it writes has to exist.
|
||||
|
||||
** NEXT update: change a place by applying a function to it
|
||||
Decided 2026-09-25: every place evaluates each of its subexpressions once, C's compound-assignment rule, which also fixes =++= and =--=; =update= is built on that. Rules out refusing side effects in a place.
|
||||
=(set (.velocity g) (inc (.velocity g)))= names the place twice. Clojure's
|
||||
=update= would be a macro over the same two steps, for a struct field and a
|
||||
class slot alike.
|
||||
|
||||
Blocked on the double-evaluation question, which =++=, =--= and any
|
||||
compound assignment share: =(update (at grid (next-index) c) inc)= evaluates
|
||||
=(next-index)= twice, and a place with a side effect is then wrong rather than
|
||||
slow. Either places get a general single-evaluation rule — bind every
|
||||
subexpression of a place to a temp once, which is what C's compound assignment
|
||||
does — or the language says a place must be side-effect free and refuses
|
||||
otherwise. The first is the real fix and it is a change to how every place
|
||||
lowers, not to one macro.
|
||||
|
||||
** TODO A session eval reported (CFn [] ()) does not cross into dyn yet
|
||||
At =sand.flan:46:20=, the =:pause= in =(when (get state :pause) (return))=,
|
||||
where =state= is a =defclass= instance with a =pause= slot. =(CFn [] ())= is
|
||||
|
||||
@ -3890,7 +3890,7 @@ before this landed, so `macro-unless.flan` is a test written after the feature.
|
||||
### The line between a special form and a macro
|
||||
|
||||
A form the prelude itself relies on is built into the parser: `cond`, `when` and `dotimes`. A form only programs use
|
||||
is a prelude macro: `inc`, `++`, `into`, `unless`, `until` and `comment`. The reason is `Macro.reduce`: a prelude
|
||||
is a prelude macro: `inc`, `++`, `update`, `into`, `unless`, `until` and `comment`. The reason is `Macro.reduce`: a prelude
|
||||
function that calls a macro is left out of the module that runs macros, so a form the prelude's own functions use
|
||||
cannot be a macro without taking those functions away from every macro body. `until` peels an optional leading label
|
||||
and answers `(while :label (not test) body ...)`.
|
||||
@ -4339,8 +4339,9 @@ implemented.
|
||||
refusal's witness now runs. The escape refusal that replaced it is gone too; see "Escape: only an escaping
|
||||
closure's environment is the collector's".*
|
||||
- **An `fn` with nothing to say what it takes** (`fn-no-type.flan`), above.
|
||||
- **A position that would zero one** (`fn-in-struct.flan`): a struct field, a global, a fixed array's element,
|
||||
`(zeroed)`. ZII fills an omitted field with all-bytes-zero, and **a zeroed function value is a null pointer, which
|
||||
- **A position that would zero an `(Fn ...)`** (`fn-in-struct.flan`): a struct field, a global, a fixed array's element,
|
||||
`(zeroed)`. A `(CFn ...)` is admitted in all four: every call through one tests for null and signals `NullCall`
|
||||
(`fn-cfn-table.flan`). ZII fills an omitted field with all-bytes-zero, and **a zeroed function value is a null pointer, which
|
||||
is the one kind of zero that is not a value the type can have** — every other type's zero is one: `0`, `false`, an
|
||||
empty slice, `None`, a union's first case. A parameter, a return type and a `let` binding are not on the list
|
||||
because none of them is ever conjured, and an `(Option (Fn ...))` is not either, because a `None`'s tag is what
|
||||
|
||||
579
lib/check.ml
579
lib/check.ml
@ -891,18 +891,24 @@ let no_such_rand name =
|
||||
|
||||
Odin's [where] clause is the same shape ([core/slice/slice.odin:289] is
|
||||
[where intrinsics.type_is_ordered(T)]) with forty-one predicates against
|
||||
these five. There is no [copyable?] any more and no Odin counterpart
|
||||
these six. There is no [copyable?] any more and no Odin counterpart
|
||||
either: Odin has no move semantics, and since the repeal neither does this
|
||||
language, so [$T] never has to answer the question.
|
||||
|
||||
[integer?] is the narrowest of the five and exists because [numeric?] was
|
||||
[integer?] is the narrowest numeric bound and exists because [numeric?] was
|
||||
one type too wide for a family of bodies: an integer body under [numeric?]
|
||||
is instantiated at f32 and f64 too, and (if (< x 0) (- 0 x) x) at -0.0 is
|
||||
the wrong abs while %, the bitwise operators and the shifts have no float
|
||||
meaning at all. A function that can be generalized should not need a
|
||||
variant per numeric type, and [integer?] is what lets the integer-only
|
||||
ones say exactly what they need. *)
|
||||
let predicate_names = [ "ordered?"; "equal?"; "hashable?"; "numeric?"; "integer?" ]
|
||||
ones say exactly what they need.
|
||||
|
||||
[enum?] admits exactly the enums. It entails [ordered?] and [equal?] and
|
||||
not [numeric?]: an enum compares, and it converts to a number, but it is
|
||||
not one — no arithmetic, no literal. It is what licenses the generic
|
||||
enum-to-number conversion, beside [numeric?]. *)
|
||||
let predicate_names =
|
||||
[ "ordered?"; "equal?"; "hashable?"; "numeric?"; "integer?"; "enum?" ]
|
||||
|
||||
(* ── What a type owns, transitively ────────────────────────────────────
|
||||
The one structural ownership question that survived the repeal, because it
|
||||
@ -1041,6 +1047,7 @@ let pred_holds p (t : Types.t) =
|
||||
| "hashable?" -> Types.keyable t
|
||||
| "numeric?" -> Types.is_numeric t
|
||||
| "integer?" -> Types.is_integer t
|
||||
| "enum?" -> (match t with Types.Enum _ -> true | _ -> false)
|
||||
| _ -> false
|
||||
|
||||
(* What one declared predicate *also* gives you. These are entailments over
|
||||
@ -1053,8 +1060,8 @@ let pred_holds p (t : Types.t) =
|
||||
let pred_entails ~declared ~wanted =
|
||||
String.equal declared wanted
|
||||
|| match wanted, declared with
|
||||
| "ordered?", ("numeric?" | "integer?") -> true
|
||||
| "equal?", ("numeric?" | "ordered?" | "integer?") -> true
|
||||
| "ordered?", ("numeric?" | "integer?" | "enum?") -> true
|
||||
| "equal?", ("numeric?" | "ordered?" | "integer?" | "enum?") -> true
|
||||
(* Every integer type is a number, so [integer?] gives a body everything
|
||||
[numeric?] does — the arithmetic, the written 0, the untyped integer
|
||||
literal — on top of the operations only it admits. The reverse is
|
||||
@ -1145,12 +1152,19 @@ let fn_sig (t : Types.t) =
|
||||
|
||||
let callable_ty t = fn_sig t <> None
|
||||
|
||||
(* A (CFn ...) is not on the list: it is one code address, and every call
|
||||
through one tests for null and signals NullCall (see [Emit.null_check]), so
|
||||
a zeroed one is an empty slot rather than a crash. That is what lets a table
|
||||
of function pointers be a struct or a fixed array. An (Fn ...) stays
|
||||
refused: a call through one is not tested, and (Option (Fn ...)) is the
|
||||
field that holds one. *)
|
||||
let rec no_zeroed_fn loc what (t : Types.t) =
|
||||
match t with
|
||||
| Types.Fn _ | Types.CFn _ ->
|
||||
| Types.Fn _ ->
|
||||
fail loc
|
||||
"%s cannot be %s — it would be zeroed, and a zeroed function value is a \
|
||||
null pointer. Pass it as a parameter, or hold it in a let"
|
||||
null pointer. Pass it as a parameter, hold it in a let, or store a \
|
||||
(CFn ...) if it captures nothing"
|
||||
what (Types.to_string t)
|
||||
| Types.Array (_, e) -> no_zeroed_fn loc what e
|
||||
| _ -> ()
|
||||
@ -1635,9 +1649,37 @@ let dyn_param_or_typo env n loc =
|
||||
parameters are lowercase"
|
||||
n
|
||||
|
||||
let pair_params ?(also = fun _ -> false) env (items : Ast.pitem list)
|
||||
: Ast.field list =
|
||||
let is_type_name env n = is_type_name env n || also n in
|
||||
(* The pairings a parameter vector owes to a type the program declares under
|
||||
a name that is also a legal parameter name — a lowercase one, since a
|
||||
capitalised name is refused as a parameter. [(defn f [p point] ...)] is one
|
||||
parameter while [point] is a type and two dyn ones the moment it is not,
|
||||
so adding or removing the type re-pairs the signature with no edit to it.
|
||||
The type still wins; this is the warning at the parameter, filled by
|
||||
[pair_decls] and printed by [build_program] with the other warnings. *)
|
||||
let pairing_warnings : Loc.diag list ref = ref []
|
||||
|
||||
let pair_params ?(also = fun _ -> false) ?(declared = fun _ -> None)
|
||||
?(hide = fun _ -> false) env (items : Ast.pitem list) : Ast.field list =
|
||||
let is_type_name env n = (is_type_name env n && not (hide n)) || also n in
|
||||
let warn_pairing n t tloc =
|
||||
let bare =
|
||||
match String.rindex_opt t '/' with
|
||||
| Some i -> String.sub t (i + 1) (String.length t - i - 1)
|
||||
| None -> t
|
||||
in
|
||||
match declared t with
|
||||
| Some (what, (at : Loc.t))
|
||||
when bare <> "" && bare.[0] >= 'a' && bare.[0] <= 'z' ->
|
||||
pairing_warnings :=
|
||||
Loc.diag ~kind:"check/parameter-reads-a-type" tloc
|
||||
(Printf.sprintf
|
||||
"[%s %s] is one parameter %s of type %s, the %s declared at %s, \
|
||||
and not two dyn parameters. If two were meant, give the second \
|
||||
a name no type has"
|
||||
n t n t what (Loc.to_string at))
|
||||
:: !pairing_warnings
|
||||
| _ -> ()
|
||||
in
|
||||
let dyn loc = { Ast.t = Ast.Tname "dyn"; tloc = loc } in
|
||||
let rec go = function
|
||||
| [] -> []
|
||||
@ -1653,6 +1695,7 @@ let pair_params ?(also = fun _ -> false) env (items : Ast.pitem list)
|
||||
| Ast.Pname (n, loc) :: Ast.Ptype t :: rest ->
|
||||
{ Ast.fname = n; fty = t; floc = loc } :: go rest
|
||||
| Ast.Pname (n, loc) :: Ast.Pname (t, tloc) :: rest when is_type_name env t ->
|
||||
warn_pairing n t tloc;
|
||||
{ Ast.fname = n; fty = { Ast.t = Ast.Tname t; tloc }; floc = loc } :: go rest
|
||||
(* The slot after this one is not a type, so this one is a parameter with
|
||||
no type written — unless the slot after it only *looks* unlike a type
|
||||
@ -1782,13 +1825,42 @@ let pair_decls env (decls : Ast.decl list) : Ast.decl list =
|
||||
match d.Ast.d with Ast.Defclass (n, _) -> Some n | _ -> None)
|
||||
decls
|
||||
in
|
||||
let fn (f : Ast.fn) =
|
||||
(* The types the program declares, with what kind and where, for
|
||||
[pair_params]'s warning. The prelude's are left out: its names are the
|
||||
language's, not a declaration the reader made. *)
|
||||
let types = Hashtbl.create 16 in
|
||||
List.iter
|
||||
(fun (d : Ast.decl) ->
|
||||
let add n what =
|
||||
if d.Ast.dloc.Loc.file <> Prelude.file
|
||||
&& not (List.mem n Types.primitive_names) then
|
||||
Hashtbl.replace types n (what, d.Ast.dloc)
|
||||
in
|
||||
match d.Ast.d with
|
||||
| Ast.Defstruct (n, _, _) -> add n "struct"
|
||||
| Ast.Defenum (n, _) -> add n "enum"
|
||||
| Ast.Defalias (n, _) -> add n "alias"
|
||||
| Ast.Defdata (n, _) -> add n "data type"
|
||||
| Ast.Defunion (n, _) -> add n "union"
|
||||
| _ -> ())
|
||||
decls;
|
||||
pairing_warnings := [];
|
||||
(* A prelude signature is paired against the prelude's types alone: a
|
||||
program's type named [t] must not turn the prelude's parameter [t] into
|
||||
a type. *)
|
||||
let fn ~prelude (f : Ast.fn) =
|
||||
match f.Ast.praw with
|
||||
| None -> f
|
||||
| Some items -> { f with Ast.params = pair_params env items; praw = None }
|
||||
| Some items ->
|
||||
let hide n = prelude && Hashtbl.mem types n in
|
||||
{ f with
|
||||
Ast.params =
|
||||
pair_params ~hide ~declared:(Hashtbl.find_opt types) env items;
|
||||
praw = None }
|
||||
in
|
||||
List.map
|
||||
(fun (d : Ast.decl) ->
|
||||
let prelude = String.equal d.Ast.dloc.Loc.file Prelude.file in
|
||||
match d.Ast.d with
|
||||
(* A class's slot vector is paired here and nowhere earlier, for the
|
||||
reason a [defn]'s is, and its constructor is written from the
|
||||
@ -1802,9 +1874,9 @@ let pair_decls env (decls : Ast.decl list) : Ast.decl list =
|
||||
(f.Ast.fname, slot_of env ~classes n f.Ast.fname f.Ast.fty))
|
||||
slots);
|
||||
Classes.constructor n slots d.Ast.dloc
|
||||
| Ast.Defn f -> { d with Ast.d = Ast.Defn (fn f) }
|
||||
| Ast.Declare (f, c) -> { d with Ast.d = Ast.Declare (fn f, c) }
|
||||
| Ast.DeclareC (f, c) -> { d with Ast.d = Ast.DeclareC (fn f, c) }
|
||||
| Ast.Defn f -> { d with Ast.d = Ast.Defn (fn ~prelude f) }
|
||||
| Ast.Declare (f, c) -> { d with Ast.d = Ast.Declare (fn ~prelude f, c) }
|
||||
| Ast.DeclareC (f, c) -> { d with Ast.d = Ast.DeclareC (fn ~prelude f, c) }
|
||||
| _ -> d)
|
||||
decls
|
||||
|
||||
@ -2447,6 +2519,49 @@ and const_steps ro (ty : Types.t) n =
|
||||
let const_copy env (e : Types.t) =
|
||||
if owning env e || holds_dyn env e then None else Some "(clone v)"
|
||||
|
||||
(* Whether (clone x) accepts a value of this type — the same arms the clone
|
||||
builtin takes: a Vec or a Map whose elements own nothing, or a slice whose
|
||||
elements neither own storage nor hold a dyn. *)
|
||||
let clone_accepts env (t : Types.t) =
|
||||
match t with
|
||||
| Types.Vec _ | Types.Map _ -> not (region_only env t)
|
||||
| Types.Slice (_, e) -> not (owning env e || holds_dyn env e)
|
||||
| _ -> false
|
||||
|
||||
(* The end of clone's refusal for a container of owning elements. Pushing
|
||||
the elements themselves into a second container would copy their headers
|
||||
and share their blocks, so the advice is a copy of each element where
|
||||
clone takes one, and otherwise that there is no copy to make. *)
|
||||
let insert_copies env (t : Types.t) =
|
||||
let elem =
|
||||
match t with
|
||||
| Types.Vec e | Types.Slice (_, e) | Types.Map (_, e) -> Some e
|
||||
| _ -> None
|
||||
in
|
||||
match elem with
|
||||
| Some e when clone_accepts env e ->
|
||||
"Build a second container and push a (clone x) of each element into it"
|
||||
| Some e ->
|
||||
Printf.sprintf
|
||||
"Nothing copies what a %s owns either, so read the elements where they \
|
||||
are"
|
||||
(Types.to_string e)
|
||||
| None -> "Build a second container and insert into it"
|
||||
|
||||
(* A call written back out as source, for a fix that has to repeat what the
|
||||
reader wrote: names, integers and calls of those. Anything else is [None]
|
||||
and the caller says the fix in words. *)
|
||||
let rec spell_form (a : Ast.expr) =
|
||||
match a.Ast.e with
|
||||
| Ast.Var v -> Some v
|
||||
| Ast.Int n -> Some (Int64.to_string n)
|
||||
| Ast.UInt (_, s) -> Some s
|
||||
| Ast.Call (f, args) ->
|
||||
let parts = List.map spell_form (f :: args) in
|
||||
if List.mem None parts then None
|
||||
else Some ("(" ^ String.concat " " (List.filter_map Fun.id parts) ^ ")")
|
||||
| _ -> None
|
||||
|
||||
(* A store through a read-only view: a [[const T]] or a (Ptr const T). *)
|
||||
let refuse_const_place env loc (view : Types.t) =
|
||||
match view with
|
||||
@ -4227,6 +4342,101 @@ let tracked_call loc env name (tr : Shim.track) ret (args : Tast.expr list) =
|
||||
(* Every expression goes through here, and [check_value] is the one that
|
||||
knows the forms. What this adds is [refuse_owned_copy], asked of whatever
|
||||
came back unless the form was checked as the target of a place. *)
|
||||
|
||||
(* The conditions [check_truthy] has refused, each with the body it was
|
||||
checked in and its diagnostic, for as long as the outermost call is on the
|
||||
stack — see [check_truthy]. Physical identity on both, since a generic's
|
||||
body is the same syntax checked again at another type. *)
|
||||
let truthy_failed :
|
||||
(Ast.expr * (string * binding) list * Types.t * Loc.diag) list ref = ref []
|
||||
|
||||
(* Whether two scopes bind the same names at the same types, which is what a
|
||||
refusal under them can depend on — the slots are fresh on every pass. A
|
||||
memo keyed on less would replay a refusal after a retry changed a type. *)
|
||||
let same_scope (a : (string * binding) list) (b : (string * binding) list) =
|
||||
a == b
|
||||
|| List.equal
|
||||
(fun (n, (x : binding)) (m, (y : binding)) ->
|
||||
String.equal n m && Types.equal x.bty y.bty)
|
||||
a b
|
||||
let truthy_depth = ref 0
|
||||
|
||||
(* The same for an [if], keyed on its condition and the expectation:
|
||||
an [if] whose else arm is tried on its own terms first (see [check_if])
|
||||
would otherwise be re-checked, refused, by the trial of every [if] above
|
||||
it — the square of a refused or/and chain's length. *)
|
||||
let if_failed :
|
||||
(Loc.t,
|
||||
Ast.expr * ((string * binding) list * Types.t) * Types.t option * Loc.diag)
|
||||
Hashtbl.t =
|
||||
Hashtbl.create 16
|
||||
let if_depth = ref 0
|
||||
|
||||
|
||||
(* A Vec or a Map parameter is a copy of the caller's header — Odin's rule —
|
||||
so growing it reallocates a block only this function's copy points at, and
|
||||
the caller's container never sees the elements. The function being checked
|
||||
and its container parameters, by slot, and the warnings found so far, one
|
||||
per parameter, printed by [build_program]. A stack because a generic's copy
|
||||
is checked from inside the body that called it. *)
|
||||
let grow_params : (ctx * (int * Ast.field) list) list ref = ref []
|
||||
let grow_warnings : Loc.diag list ref = ref []
|
||||
|
||||
let note_grown ctx op loc (target : Tast.expr) =
|
||||
(* The parameter the container is reached from, through struct fields
|
||||
taken by value — a field of a parameter is in the parameter's copy too —
|
||||
and the path written back out. A [Deref] ends the walk: through a
|
||||
pointer the caller's own storage is what grows. *)
|
||||
let rec root (e : Tast.expr) =
|
||||
match e.Tast.e with
|
||||
| Tast.Local s -> Some (s, fun p -> p)
|
||||
| Tast.Field (inner, i) ->
|
||||
(match inner.Tast.ty with
|
||||
| Types.Named n ->
|
||||
(match Hashtbl.find_opt ctx.env.structs n with
|
||||
| Some st when i < List.length st.Tast.fields ->
|
||||
let f = (List.nth st.Tast.fields i).Tast.fname in
|
||||
Option.map
|
||||
(fun (s, path) -> (s, fun p -> Printf.sprintf "(.%s %s)" f (path p)))
|
||||
(root inner)
|
||||
| _ -> None)
|
||||
| _ -> None)
|
||||
| _ -> None
|
||||
in
|
||||
match target.Tast.ty, root target, !grow_params with
|
||||
| ((Types.Vec _ | Types.Map _) as t), Some (s, path), (c, ps) :: _ when c == ctx ->
|
||||
(match List.assoc_opt s ps with
|
||||
| Some (p : Ast.field)
|
||||
when not
|
||||
(List.exists
|
||||
(fun (d : Loc.diag) -> d.Loc.dloc = p.Ast.floc)
|
||||
!grow_warnings) ->
|
||||
let ts = Types.to_string t in
|
||||
let msg =
|
||||
match target.Tast.e with
|
||||
| Tast.Local _ ->
|
||||
Printf.sprintf
|
||||
"%s is a %s passed by value, a copy of the caller's header, so \
|
||||
the %s at %s grows this function's copy and the caller's \
|
||||
container never sees it. Take it as (Ptr %s) and write (%s \
|
||||
(deref %s) ...), and each caller passes (addr c) for its \
|
||||
container c"
|
||||
p.Ast.fname ts op (Loc.to_string loc) ts op p.Ast.fname
|
||||
| _ ->
|
||||
let pt = Types.to_string (List.nth ctx.slot_tys (ctx.slots - 1 - s)) in
|
||||
Printf.sprintf
|
||||
"%s is a %s passed by value, a copy of the caller's, so the %s \
|
||||
at %s grows %s in this function's copy and the caller's never \
|
||||
sees it. Take it as (Ptr %s), where %s reaches the caller's own, \
|
||||
and each caller passes (addr c) for its %s c"
|
||||
p.Ast.fname pt op (Loc.to_string loc) (path p.Ast.fname) pt
|
||||
(path p.Ast.fname) pt
|
||||
in
|
||||
grow_warnings :=
|
||||
Loc.diag ~kind:"check/grown-parameter" p.Ast.floc msg :: !grow_warnings
|
||||
| _ -> ())
|
||||
| _ -> ()
|
||||
|
||||
(* Recovery, when [env.recovering] is on: a subexpression that is refused is
|
||||
recorded and stands as a [poison] of type [Never], which fits any want, so
|
||||
checking carries on around it and every error in a body is reported. What
|
||||
@ -6089,12 +6299,12 @@ and check_recur ctx ~tail loc args =
|
||||
literals gets the nicer message, not just the speed. The cost that
|
||||
buys is real: nested [not] on a program that does not type-check re-runs
|
||||
this whole function once per level of nesting inside the level above it,
|
||||
which is exponential in how deep the nesting goes — moot for a program
|
||||
that compiles, since neither retry ever fires, and moot for ordinary
|
||||
nesting depths, but visible within a second or so around twenty levels
|
||||
of a [not] wrapped in a [not] wrapped in .... The dev daemon is the one
|
||||
caller that could feel this, recompiling a half-typed form on every
|
||||
edit; nobody has hit it in practice and it is not fixed here.
|
||||
which would be exponential in how deep the nesting goes. What keeps it
|
||||
linear is [truthy_failed]: a condition this function has already refused,
|
||||
in the same body, is refused again with the same diagnostic rather than
|
||||
re-checked, so a retry re-walks its subtree once and stops at the first
|
||||
condition below it that was settled. The message is the one the first
|
||||
pass produced, so no message changes.
|
||||
|
||||
Keywords are a separate, deliberate loss rather than a bug: a bare
|
||||
[:kw] used to be checked here with [want:Types.Bool] from the start, so
|
||||
@ -6109,6 +6319,30 @@ and check_recur ctx ~tail loc args =
|
||||
test_flan.ml pins the new answer down so it is not lost again by
|
||||
accident. *)
|
||||
and check_truthy ctx c =
|
||||
(* Only where a refusal is raised: while recovering, one is recorded where
|
||||
it happens and the check goes on, so a replayed one would hide others. *)
|
||||
if ctx.env.recovering && ctx.env.speculating = 0 then check_truthy_once ctx c
|
||||
else
|
||||
match
|
||||
List.find_opt
|
||||
(fun (n, sc, r, _) -> n == c && r == ctx.ret && same_scope sc ctx.scope)
|
||||
!truthy_failed
|
||||
with
|
||||
| Some (_, _, _, d) -> raise (Loc.Error d)
|
||||
| None ->
|
||||
let scope = ctx.scope in
|
||||
incr truthy_depth;
|
||||
Fun.protect
|
||||
~finally:(fun () ->
|
||||
decr truthy_depth;
|
||||
if !truthy_depth = 0 then truthy_failed := [])
|
||||
(fun () ->
|
||||
try check_truthy_once ctx c
|
||||
with Loc.Error d as ex ->
|
||||
truthy_failed := (c, scope, ctx.ret, d) :: !truthy_failed;
|
||||
raise ex)
|
||||
|
||||
and check_truthy_once ctx c =
|
||||
let loc = c.Ast.loc in
|
||||
(* Speculative, because a refusal here is answered by asking again at
|
||||
[bool]; and that second ask is guarded, because its refusal is re-worded
|
||||
@ -6163,6 +6397,30 @@ and check_truthy ctx c =
|
||||
| exception Loc.Error _ -> check ctx ~want:Types.Bool c
|
||||
|
||||
and check_if ctx ?(tail = false) ?want loc c t e =
|
||||
if ctx.env.recovering && ctx.env.speculating = 0 then
|
||||
check_if_once ctx ~tail ?want loc c t e
|
||||
else
|
||||
match
|
||||
List.find_opt
|
||||
(fun (n, (sc, r), w, _) ->
|
||||
n == c && r == ctx.ret && w = want && same_scope sc ctx.scope)
|
||||
(Hashtbl.find_all if_failed c.Ast.loc)
|
||||
with
|
||||
| Some (_, _, _, d) -> raise (Loc.Error d)
|
||||
| None ->
|
||||
let scope = ctx.scope in
|
||||
incr if_depth;
|
||||
Fun.protect
|
||||
~finally:(fun () ->
|
||||
decr if_depth;
|
||||
if !if_depth = 0 then Hashtbl.reset if_failed)
|
||||
(fun () ->
|
||||
try check_if_once ctx ~tail ?want loc c t e
|
||||
with Loc.Error d as ex ->
|
||||
Hashtbl.add if_failed c.Ast.loc (c, (scope, ctx.ret), want, d);
|
||||
raise ex)
|
||||
|
||||
and check_if_once ctx ~tail ?want loc c t e =
|
||||
let c = check_truthy ctx c in
|
||||
(* Both arms are the tail, and a one-armed [if] counts: [(when c (recur ...))]
|
||||
is how nearly every loop is written, and the branch is still the last
|
||||
@ -6206,6 +6464,34 @@ and check_if ctx ?(tail = false) ?want loc c t e =
|
||||
want = None
|
||||
&& (match t.Tast.ty with Types.Slice _ | Types.Ptr _ -> true | _ -> false)
|
||||
in
|
||||
(* A bool arm and a dyn arm meet at dyn, the bool boxed — Clojure's rule,
|
||||
so (or false (box "s")) answers "s" rather than unboxing the string at
|
||||
bool and trapping. The other order already met at dyn, the then arm
|
||||
deciding. So after a bool then arm the else arm is checked on its own
|
||||
terms first, since checking it at bool is what unboxes it, and kept
|
||||
when it is a bool or a dyn. Anything else is abandoned and checked at
|
||||
bool as before, for that path's messages. A chain whose arms all fit
|
||||
is checked once; a refused one re-checks each level below the refusal
|
||||
once more, the square of its depth. *)
|
||||
let own_else =
|
||||
if want = None && t.Tast.ty = Types.Bool then
|
||||
match
|
||||
trial ctx (fun () ->
|
||||
let v = branch ctx (fun () -> in_tail (fun () -> check ctx e)) in
|
||||
match v.Tast.ty with
|
||||
| Types.Bool | Types.Dyn | Types.Never -> v
|
||||
| _ -> raise (Loc.Error (Loc.diag v.Tast.loc "not bool or dyn")))
|
||||
with
|
||||
| Ok v -> Some v
|
||||
| Error _ -> None
|
||||
else None
|
||||
in
|
||||
let t =
|
||||
match own_else with
|
||||
| Some v when v.Tast.ty = Types.Dyn ->
|
||||
expect ctx t.Tast.loc ~want:(Some Types.Dyn) t
|
||||
| _ -> t
|
||||
in
|
||||
let ewant =
|
||||
match want with
|
||||
| Some _ -> want
|
||||
@ -6227,6 +6513,9 @@ and check_if ctx ?(tail = false) ?want loc c t e =
|
||||
location; and with an expectation in hand both arms are checked against
|
||||
it rather than against each other, so nothing here runs. *)
|
||||
let e =
|
||||
match own_else with
|
||||
| Some v -> v
|
||||
| None ->
|
||||
let reworded = want = None && and_sentinel e in
|
||||
match
|
||||
branch ctx (fun () ->
|
||||
@ -7972,9 +8261,16 @@ and not_numeric name what (a : Tast.expr) =
|
||||
so that the family says it one way: a body with no clause is given the
|
||||
whole clause, and a body that already has one is told which predicate to
|
||||
add rather than a clause that would drop the ones it has. *)
|
||||
and cast_operand ctx loc name ~needs ~what ~is v =
|
||||
if declares ctx.env.tvpreds v needs then ()
|
||||
and cast_operand ctx loc name ~needs ?also ~what ~is v =
|
||||
if declares ctx.env.tvpreds v needs
|
||||
|| (match also with
|
||||
| Some (p, _) -> declares ctx.env.tvpreds v p
|
||||
| None -> false)
|
||||
then ()
|
||||
else
|
||||
(* A conversion two bounds license is refused naming both, since which one
|
||||
the reader meant is theirs to say. *)
|
||||
let is = match also with Some (_, is') -> is ^ " or " ^ is' | None -> is in
|
||||
let declared =
|
||||
List.filter_map
|
||||
(fun (p : Ast.pred) ->
|
||||
@ -7990,10 +8286,19 @@ and cast_operand ctx loc name ~needs ~what ~is v =
|
||||
(String.concat " and " ps) is
|
||||
in
|
||||
let fix =
|
||||
let alt clause =
|
||||
match also with
|
||||
| Some (p, is') ->
|
||||
Printf.sprintf ", or %s for %s"
|
||||
(Printf.sprintf clause p v) is'
|
||||
| None -> ""
|
||||
in
|
||||
if ctx.env.tvpreds = [] then
|
||||
Printf.sprintf "write {:where (%s $%s)} at the head of the body"
|
||||
needs v
|
||||
else Printf.sprintf "add (%s $%s) to the where clause" needs v
|
||||
Printf.sprintf "write {:where (%s $%s)} at the head of the body%s"
|
||||
needs v (alt "{:where (%s $%s)}")
|
||||
else
|
||||
Printf.sprintf "add (%s $%s) to the where clause%s" needs v
|
||||
(alt "(%s $%s)")
|
||||
in
|
||||
Loc.failk "check/unconstrained-type-variable" loc
|
||||
"%s converts %s. %s — %s" name what known fix
|
||||
@ -8288,14 +8593,20 @@ and file_guard ctx loc ~path_slot ~op mk_steps =
|
||||
missing annotation for a program that had written one. One list, read by
|
||||
both callers, so the next kind of type added cannot be added to one of
|
||||
them. *)
|
||||
(* A global value that a bare name in a type position would reach instead of
|
||||
a type. A type variable in scope is not shadowed by one: the prelude's
|
||||
generics write [(vec-new t)], and a program's [(defonce t ...)] must not
|
||||
change what the prelude means. *)
|
||||
and global_value ctx n =
|
||||
Hashtbl.mem ctx.env.globals n && not (tyvar_in_scope ctx.env n)
|
||||
|
||||
(* An argument written as a type: a type expression, or a bare name that is a
|
||||
type and not a local or a global of the same spelling. *)
|
||||
and type_arg ctx (a : Ast.expr) =
|
||||
type_of_expr a <> None
|
||||
|| (match a.Ast.e with
|
||||
| Ast.Var n ->
|
||||
lookup ctx n = None && (not (Hashtbl.mem ctx.env.globals n))
|
||||
&& type_named ctx n
|
||||
lookup ctx n = None && not (global_value ctx n) && type_named ctx n
|
||||
| _ -> false)
|
||||
|
||||
and type_named ctx n =
|
||||
@ -8328,9 +8639,7 @@ and vec_new_elem ctx ~want loc args =
|
||||
| a :: rest when type_of_expr a <> None ->
|
||||
Some (resolve ctx.env (Option.get (type_of_expr a)), rest)
|
||||
| { Ast.e = Ast.Var n; _ } :: rest
|
||||
when lookup ctx n = None
|
||||
&& (not (Hashtbl.mem ctx.env.globals n))
|
||||
&& type_named ctx n ->
|
||||
when lookup ctx n = None && not (global_value ctx n) && type_named ctx n ->
|
||||
Some (resolve_name ctx.env ~seen:[] loc n, rest)
|
||||
| _ -> None
|
||||
in
|
||||
@ -8393,9 +8702,7 @@ and map_kv loc what (t : Types.t) =
|
||||
says half of a type and half is not a type. *)
|
||||
and map_new_types ctx ~want loc args =
|
||||
let is_type n =
|
||||
lookup ctx n = None
|
||||
&& (not (Hashtbl.mem ctx.env.globals n))
|
||||
&& type_named ctx n
|
||||
lookup ctx n = None && not (global_value ctx n) && type_named ctx n
|
||||
in
|
||||
(* A type position holds a bare name or a type expression Parse has read
|
||||
as one, as [vec-new]'s does. *)
|
||||
@ -9324,6 +9631,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
[ target; check ctx ~want:Types.Dyn x; here loc ])
|
||||
else begin
|
||||
let elem = vec_elem loc "push" target.Tast.ty in
|
||||
note_grown ctx "push" loc target;
|
||||
let x = check ctx ~want:elem x in
|
||||
(* The element is bound before the loop so that a [retry] re-attempts
|
||||
the allocation and not the expression that produced the value. *)
|
||||
@ -9355,6 +9663,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
let target = check_target ctx target in
|
||||
refuse_const_change ctx loc target;
|
||||
let n = check ctx ~want:index_ty n in
|
||||
note_grown ctx "reserve" loc target;
|
||||
let n64 =
|
||||
mk loc (Types.Int Types.I64) (Tast.Prim (Tast.Cast (Types.Int Types.I64), [ n ]))
|
||||
in
|
||||
@ -9482,6 +9791,57 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
"free takes a Vec, a Map, or a slice (bytes s) or (clone xs) made — \
|
||||
found %s"
|
||||
(Types.to_string other))
|
||||
(* Emitted by the prelude's [into] when no (map f) is in the chain, so that
|
||||
every element pushed is a source element as it stands. A push copies an
|
||||
element's header, and for an element that owns storage the copy and the
|
||||
source then share one block: growing an element through either side
|
||||
reallocates it and frees the block the other still points at. That is a
|
||||
use after free the program never wrote, under a name that promised a
|
||||
copy, so it is refused here. A bare (push w (at v 0)) is not: it copies a
|
||||
header in plain sight, the Odin contract every container follows.
|
||||
Arguments are the source, then the destination and the transforms as
|
||||
written — those two only to be spelled back in the fix, never checked. *)
|
||||
| "into-copies-elements" ->
|
||||
(match args with
|
||||
| src :: dst :: transforms ->
|
||||
let s = check ctx src in
|
||||
let elem =
|
||||
match s.Tast.ty with
|
||||
| Types.Vec e | Types.Slice (_, e) | Types.Array (_, e) -> Some e
|
||||
| _ -> None
|
||||
in
|
||||
(match elem with
|
||||
| Some e when owning ctx.env e ->
|
||||
let v = spell_arg "v" src in
|
||||
let et = Types.to_string e in
|
||||
let fix =
|
||||
if clone_accepts ctx.env e then
|
||||
match spell_form dst, List.map spell_form transforms with
|
||||
| Some d, ts when not (List.mem None ts) ->
|
||||
Printf.sprintf
|
||||
"Add (map clone) to the chain, which copies what each \
|
||||
element owns: (into %s)"
|
||||
(String.concat " "
|
||||
((v :: d :: List.filter_map Fun.id ts) @ [ "(map clone)" ]))
|
||||
| _ ->
|
||||
"Add (map clone) to the chain, which copies what each element \
|
||||
owns"
|
||||
else
|
||||
Printf.sprintf
|
||||
"Nothing copies what a %s owns, so no copy of %s can stand on \
|
||||
its own: read the elements where they are, or build each new \
|
||||
element and push that"
|
||||
et v
|
||||
in
|
||||
Loc.failk "check/into-shares-elements" src.Ast.loc
|
||||
"into copies each element of %s as it stands, and an element of \
|
||||
%s is a %s, which owns storage — the copy would share each \
|
||||
element's block with %s, and growing either one frees the block \
|
||||
the other points at. %s"
|
||||
v v et v fix
|
||||
| _ -> ());
|
||||
expect ctx loc ~want (mk loc Types.Unit Tast.Unit)
|
||||
| _ -> expect ctx loc ~want (mk loc Types.Unit Tast.Unit))
|
||||
(* (clone v) uses the current allocator, (clone v a) names one. A deep,
|
||||
independent copy: spec-memory.md's "copying is always explicit". *)
|
||||
| "clone" ->
|
||||
@ -9517,9 +9877,9 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
| (Types.Vec _ | Types.Map _) when region_only ctx.env target.Tast.ty ->
|
||||
fail loc
|
||||
"%s cannot be cloned — its elements own storage, and nothing here \
|
||||
can walk one to copy what it owns. Build a second container and \
|
||||
insert into it"
|
||||
can walk one to copy what it owns. %s"
|
||||
(Types.to_string target.Tast.ty)
|
||||
(insert_copies ctx.env target.Tast.ty)
|
||||
(* A slice's elements, copied into a block from the allocator and
|
||||
answered as a slice over it — what (bytes s) does for a string's
|
||||
bytes, and the same lowering. The same refusal as a Vec's, for the
|
||||
@ -9527,9 +9887,9 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
| Types.Slice (_, elem) when owning ctx.env elem ->
|
||||
fail loc
|
||||
"%s cannot be cloned — its elements own storage, and nothing here \
|
||||
can walk one to copy what it owns. Build a container and insert \
|
||||
into it"
|
||||
can walk one to copy what it owns. %s"
|
||||
(Types.to_string target.Tast.ty)
|
||||
(insert_copies ctx.env target.Tast.ty)
|
||||
(* The copy is a block from an allocator, which the collector does not
|
||||
walk, so a dyn in it would be a root nothing marks. *)
|
||||
| Types.Slice (_, elem) when holds_dyn ctx.env elem ->
|
||||
@ -9639,6 +9999,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
check ctx ~want:Types.Dyn v; here loc ])
|
||||
else begin
|
||||
let kt, vt = map_kv loc "put" target.Tast.ty in
|
||||
note_grown ctx "put" loc target;
|
||||
let k = check ctx ~want:kt k in
|
||||
let v = check ctx ~want:vt v in
|
||||
(* Deferred: the arguments are checked — so a move here is still a move
|
||||
@ -10871,8 +11232,8 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
[ordered?] admits a type that does not, and that day is why the
|
||||
question is asked of the predicate and not of the set it denotes. *)
|
||||
| Types.Var v ->
|
||||
cast_operand ctx loc name ~needs:"numeric?" ~what:"a number"
|
||||
~is:"a number" v
|
||||
cast_operand ctx loc name ~needs:"numeric?" ~also:("enum?", "an enum")
|
||||
~what:"a number or an enum" ~is:"a number" v
|
||||
| t -> fail loc "%s converts a number, found %s" name (Types.to_string t));
|
||||
prim (Tast.Cast target) target [ a ]
|
||||
| _ when is_cast name && List.length args = 1 ->
|
||||
@ -10903,8 +11264,8 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
machine type, so what is in question is only the operand, and the
|
||||
[where] clause is what answers it. *)
|
||||
| Types.Var v ->
|
||||
cast_operand ctx loc name ~needs:"numeric?" ~what:"a number"
|
||||
~is:"a number" v
|
||||
cast_operand ctx loc name ~needs:"numeric?" ~also:("enum?", "an enum")
|
||||
~what:"a number or an enum" ~is:"a number" v
|
||||
| t -> fail loc "%s converts a number, found %s" name (Types.to_string t));
|
||||
(match a.Tast.ty with
|
||||
| Types.Dyn -> cast_dyn ctx loc target a
|
||||
@ -10956,6 +11317,14 @@ and ordinary_call ctx ~want loc name args =
|
||||
match capture ctx loc name with
|
||||
| Some b -> call_value ctx ~want loc (mk loc b.bty (Tast.Local b.slot)) args
|
||||
| None -> assert false)
|
||||
(* A global holding a function value — a (CFn ...) table entry's cousin,
|
||||
since a global is one of the zeroed positions a CFn may sit in. Called
|
||||
by its name the way a local one is. *)
|
||||
| _ when (match Hashtbl.find_opt ctx.env.globals name with
|
||||
| Some (ty, _) -> callable_ty ty
|
||||
| None -> false) ->
|
||||
let ty, _ = Hashtbl.find ctx.env.globals name in
|
||||
call_value ctx ~want loc (mk loc ty (Tast.Global name)) args
|
||||
| _ when Hashtbl.mem ctx.env.gsigs name ->
|
||||
private_ref ctx loc name;
|
||||
let vars, params, ret = Hashtbl.find ctx.env.gsigs name in
|
||||
@ -12100,6 +12469,10 @@ let builtins : (string * string * string) list =
|
||||
its allocator's free-all. Refused for elements that own \
|
||||
storage: a bytewise copy would alias the original's blocks under a \
|
||||
name promising otherwise.");
|
||||
("into-copies-elements", "into-copies-elements [src dst transform...] ()",
|
||||
"What into writes when its chain has no (map f). Refuses a source whose \
|
||||
elements own storage, because pushing them as they stand would share \
|
||||
their blocks. Not meant to be written by hand.");
|
||||
|
||||
(* (Map K V) *)
|
||||
("map-new", "map-new [K? V? Allocator?] (Map K V)",
|
||||
@ -12993,6 +13366,55 @@ let check_union_members env =
|
||||
|
||||
(* ── Declarations: pass 2, check bodies ────────────────────────────── *)
|
||||
|
||||
(* The names a body hands back or stores into: every name mentioned in a value
|
||||
it answers — its last form's tails, a [return]'s value — and the name at
|
||||
the root of every [set] place. A parameter among them is not warned at for
|
||||
growing: the grown copy goes back to the caller, or the copy is the
|
||||
function's own business. *)
|
||||
let escaping_names ~returns (body : Ast.expr list) : string list =
|
||||
let names = ref [] in
|
||||
let rec mentions (e : Ast.expr) =
|
||||
(match e.Ast.e with Ast.Var n -> names := n :: !names | _ -> ());
|
||||
ignore (Ast.map_children (fun x -> mentions x; x) e)
|
||||
in
|
||||
let rec tails (e : Ast.expr) =
|
||||
match e.Ast.e with
|
||||
| Ast.Do es | Ast.Let (_, es) ->
|
||||
(match List.rev es with x :: _ -> tails x | [] -> ())
|
||||
| Ast.If (_, a, b) -> tails a; Option.iter tails b
|
||||
| Ast.Match (_, arms) ->
|
||||
List.iter
|
||||
(fun (a : Ast.arm) ->
|
||||
match List.rev a.Ast.body with x :: _ -> tails x | [] -> ())
|
||||
arms
|
||||
(* A value that is the parameter, a field of it, or a literal built with
|
||||
it. A call's result is its callee's business, and a unit form — the
|
||||
push itself, last in a function that returns nothing — answers
|
||||
nothing. *)
|
||||
| Ast.Var _ | Ast.Field _ | Ast.Struct _ | Ast.Bare _ | Ast.Arr _
|
||||
| Ast.MapLit _ -> mentions e
|
||||
| _ -> ()
|
||||
in
|
||||
let rec root (e : Ast.expr) =
|
||||
match e.Ast.e with
|
||||
| Ast.Var n -> names := n :: !names
|
||||
| Ast.Field (x, _) -> root x
|
||||
| Ast.Call ({ Ast.e = Ast.Var ("at" | "deref"); _ }, x :: _) -> root x
|
||||
| _ -> ()
|
||||
in
|
||||
let rec walk (e : Ast.expr) =
|
||||
(match e.Ast.e with
|
||||
| Ast.Return (Some x) -> tails x
|
||||
| Ast.Set (Ast.Pvar n, _) -> names := n :: !names
|
||||
| Ast.Set ((Ast.Pfield (x, _) | Ast.Pindex (x, _) | Ast.Pderef x
|
||||
| Ast.Pslot (x, _)), _) -> root x
|
||||
| _ -> ());
|
||||
ignore (Ast.map_children (fun x -> walk x; x) e)
|
||||
in
|
||||
List.iter walk body;
|
||||
if returns then (match List.rev body with x :: _ -> tails x | [] -> ());
|
||||
!names
|
||||
|
||||
let rec check_fn env (fn : Ast.fn) : Tast.fn =
|
||||
let params, ret = Hashtbl.find env.fns fn.Ast.name in
|
||||
let ctx = { (invented_ctx env ret) with owner = fn.Ast.name } in
|
||||
@ -13015,6 +13437,41 @@ let rec check_fn env (fn : Ast.fn) : Tast.fn =
|
||||
end;
|
||||
ignore (bind ctx p.Ast.fname ty ~assignable:false))
|
||||
fn.Ast.params params;
|
||||
let grow_before = !grow_warnings in
|
||||
let grow_saved = !grow_params in
|
||||
grow_params :=
|
||||
( ctx,
|
||||
List.filter_map
|
||||
(fun (p : Ast.field) ->
|
||||
Option.map (fun b -> (b.slot, p)) (List.assoc_opt p.Ast.fname ctx.scope))
|
||||
fn.Ast.params )
|
||||
:: grow_saved;
|
||||
let escaping =
|
||||
lazy
|
||||
(let names =
|
||||
escaping_names ~returns:(not (Types.equal ret Types.Unit)) fn.Ast.fbody
|
||||
in
|
||||
List.filter_map
|
||||
(fun (p : Ast.field) ->
|
||||
if List.mem p.Ast.fname names then Some p.Ast.floc else None)
|
||||
fn.Ast.params)
|
||||
in
|
||||
Fun.protect
|
||||
~finally:(fun () ->
|
||||
grow_params := grow_saved;
|
||||
let added =
|
||||
List.filteri
|
||||
(fun i _ -> i < List.length !grow_warnings - List.length grow_before)
|
||||
!grow_warnings
|
||||
in
|
||||
if added <> [] then
|
||||
grow_warnings :=
|
||||
List.filter
|
||||
(fun (d : Loc.diag) ->
|
||||
not (List.mem d.Loc.dloc (Lazy.force escaping)))
|
||||
added
|
||||
@ grow_before)
|
||||
@@ fun () ->
|
||||
let body =
|
||||
match fn.Ast.fbody with
|
||||
| [] ->
|
||||
@ -14135,30 +14592,37 @@ let shown_name n =
|
||||
else n
|
||||
|
||||
let shadow_prelude (prelude : Ast.decl list) (decls : Ast.decl list) =
|
||||
let fn_name (d : Ast.decl) =
|
||||
(* A value name, and whether it is a function's. A program's global takes
|
||||
a prelude function's name over as a program's function does: both are
|
||||
names a call or a read reaches, and the prelude's own uses keep the
|
||||
prelude's. *)
|
||||
let value_name (d : Ast.decl) =
|
||||
match d.Ast.d with
|
||||
| Ast.Defn fn | Ast.Declare (fn, _) | Ast.DeclareC (fn, _) -> Some fn.Ast.name
|
||||
| Ast.Defn fn | Ast.Declare (fn, _) | Ast.DeclareC (fn, _) ->
|
||||
Some (fn.Ast.name, true)
|
||||
| Ast.Defvar (n, _, _, _) | Ast.Defconst (n, _, _) -> Some (n, false)
|
||||
| _ -> None
|
||||
in
|
||||
let theirs = List.filter_map fn_name prelude in
|
||||
let theirs = List.map fst (List.filter_map value_name prelude) in
|
||||
let taken =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match fn_name d with
|
||||
| Some n when List.mem n theirs -> Some (n, d.Ast.dloc)
|
||||
match value_name d with
|
||||
| Some (n, f) when List.mem n theirs -> Some (n, d.Ast.dloc, f)
|
||||
| _ -> None)
|
||||
decls
|
||||
in
|
||||
let warnings =
|
||||
List.map
|
||||
(fun (n, at) ->
|
||||
(fun (n, at, f) ->
|
||||
Loc.diag ~kind:"check/shadows-prelude" at
|
||||
(Printf.sprintf
|
||||
"%s shadows the prelude's %s — every call in this file now \
|
||||
"%s shadows the prelude's %s — every %s in this file now \
|
||||
reaches your definition"
|
||||
n n))
|
||||
n n (if f then "call" else "use")))
|
||||
taken
|
||||
in
|
||||
let taken = List.map (fun (n, at, _) -> (n, at)) taken in
|
||||
let prelude, decls =
|
||||
List.fold_left
|
||||
(fun (prelude, decls) (n, (at : Loc.t)) ->
|
||||
@ -14265,7 +14729,14 @@ let build_program ~keep_going ?tolerate (decls : Ast.decl list) :
|
||||
time it runs every signature is sound, so a body that fails to check
|
||||
cannot make the next body fail — which is what makes a declaration a
|
||||
resync point that needs no resynchronising. *)
|
||||
grow_warnings := [];
|
||||
let decls = collect env decls in
|
||||
if !print_warnings then
|
||||
List.iter
|
||||
(fun (d : Loc.diag) ->
|
||||
prerr_endline
|
||||
(Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg))
|
||||
(List.rev !pairing_warnings);
|
||||
check_finite env;
|
||||
check_union_members env;
|
||||
let s = Loc.sink ~on:keep_going in
|
||||
@ -14319,6 +14790,12 @@ let build_program ~keep_going ?tolerate (decls : Ast.decl list) :
|
||||
| _ -> None)
|
||||
decls
|
||||
in
|
||||
if !print_warnings then
|
||||
List.iter
|
||||
(fun (d : Loc.diag) ->
|
||||
prerr_endline
|
||||
(Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg))
|
||||
(List.rev !grow_warnings);
|
||||
Loc.finish s;
|
||||
(* The handler clauses lifted out along the way. They are ordinary functions
|
||||
from here down; nothing in the backend knows they were written inside
|
||||
|
||||
19
lib/emit.ml
19
lib/emit.ml
@ -3177,6 +3177,9 @@ and call_ptr ?at f ret callee args =
|
||||
code, Some ("ptr " ^ env)
|
||||
| _ -> c, None
|
||||
in
|
||||
(match callee.Tast.ty, at with
|
||||
| Types.CFn _, Some loc -> null_check f loc callee.Tast.ty code
|
||||
| _ -> ());
|
||||
let vs = map_lr (fun (a : Tast.expr) ->
|
||||
let v = value f a in Printf.sprintf "%s %s" (ll a.Tast.ty) v) args in
|
||||
Option.iter (mark_call f) at;
|
||||
@ -3184,6 +3187,19 @@ and call_ptr ?at f ret callee args =
|
||||
if at <> None then clear_call f;
|
||||
r
|
||||
|
||||
(* A (CFn ...) may be a zeroed field, array element or global, and a zeroed
|
||||
one is a null address. Tested before the arguments are evaluated, so a
|
||||
call that is not going to be made runs none of them — the x86 backend
|
||||
tests at the same point. [flan_null_call] signals [NullCall] and returns
|
||||
only when something transferred, the shape of a bounds failure. *)
|
||||
and null_check f loc ty code =
|
||||
let ok = fresh f in
|
||||
ins f "%s = icmp ne ptr %s, null" ok code;
|
||||
signal_block f loc ~guard:(fun () -> guard f) ok (fun id n ->
|
||||
let tys = fst (fi_bytes f.md (Types.to_string ty ^ "\000")) in
|
||||
ins f "call void @flan_null_call(ptr %s, i64 %d, ptr %s, ptr %s)"
|
||||
id n tys xfer_param)
|
||||
|
||||
(* The code address behind one of the three [fnref]s, which is the same string
|
||||
whether it is wanted as a bare [(Ptr ())] or as the first word of a
|
||||
function value.
|
||||
@ -4925,6 +4941,9 @@ declare void @flan_arith_error(ptr, i64, i32, i64, i64, ptr) cold
|
||||
; as C strings, then the cell and the channel. Signals StaleCall; returns when
|
||||
; something answered.
|
||||
declare void @flan_stale_call(ptr, ptr, ptr, ptr, ptr) cold
|
||||
; A call through a (CFn ...) holding null: the site, the value's type as a C
|
||||
; string and the channel. Signals NullCall; returns when something answered.
|
||||
declare void @flan_null_call(ptr, i64, ptr, ptr) cold
|
||||
declare ptr @flan_context_allocator()
|
||||
declare ptr @flan_context_use(ptr, i64)
|
||||
declare void @flan_context_value(ptr)
|
||||
|
||||
@ -200,13 +200,17 @@ and inline_text ?(lvl = 0) (f : Form.t) =
|
||||
w ^ " :" ^ k
|
||||
| Form.List [ { v = Form.Sym "return"; _ }; v ] -> "return " ^ at (max lvl 1) v
|
||||
| Form.List [ { v = Form.Sym "set"; _ }; t; v ] -> assign_text ~lvl t v
|
||||
| Form.List [ { v = Form.Sym "update"; _ }; t; { v = Form.Sym (("+" | "-" | "*" | "/") as op); _ }; w ]
|
||||
when not (R.simple_place t) ->
|
||||
at 9 t ^ " " ^ op ^ "= " ^ at (max lvl 1) w
|
||||
| _ -> at lvl f
|
||||
|
||||
(* [t = v], or [t += w] when [v] is [(+ t w)]. *)
|
||||
and assign_text ?(lvl = 0) t v =
|
||||
let tt = at 9 t in
|
||||
match v.v with
|
||||
| Form.List [ { v = Form.Sym (("+" | "-" | "*" | "/") as op); _ }; a; w ] when same a t ->
|
||||
| Form.List [ { v = Form.Sym (("+" | "-" | "*" | "/") as op); _ }; a; w ]
|
||||
when same a t && R.simple_place t ->
|
||||
tt ^ " " ^ op ^ "= " ^ at (max lvl 1) w
|
||||
| _ -> tt ^ " = " ^ at (max lvl 1) v
|
||||
|
||||
@ -325,7 +329,7 @@ let body_split (h : Form.t) args =
|
||||
let sugar_heads =
|
||||
[ "let"; "set"; "if"; "when"; "cond"; "while"; "until"; "dotimes"; "match";
|
||||
"handler-case"; "handler-bind"; "restart-case"; "return"; "defer"; "do";
|
||||
"quasiquote" ]
|
||||
"quasiquote"; "update" ]
|
||||
|
||||
let rec block n (fs : Form.t list) : string list =
|
||||
let rec go = function
|
||||
@ -441,6 +445,9 @@ and sugar n ~last (f : Form.t) : string list option =
|
||||
(match pairs bs with
|
||||
| None | Some [] -> None
|
||||
| Some prs -> Some (let_lines n ~last prs body))
|
||||
| Form.List [ { v = Form.Sym "update"; _ }; t; { v = Form.Sym ("+" | "-" | "*" | "/"); _ }; _ ]
|
||||
when not (R.simple_place t) ->
|
||||
Some [ i ^ guard (inline_text f) ]
|
||||
| Form.List [ { v = Form.Sym "set"; _ }; t; v ] ->
|
||||
let line = i ^ guard (assign_text t v) in
|
||||
if String.length line <= width then Some [ line ]
|
||||
|
||||
@ -64,6 +64,35 @@ let is_op_word s = is_binop s || s = "not" || s = "="
|
||||
|
||||
let assign_ops = [ ("+=", "+"); ("-=", "-"); ("*=", "*"); ("/=", "/") ]
|
||||
|
||||
(* A place whose parts are all names and literals reads the same however
|
||||
often it is evaluated, so [x += v] over one is [(set x (+ x v))], the form
|
||||
the Lisp side writes. Any other place — an index that is a call — reads
|
||||
[(update p + v)], which evaluates each part of the place once. The printer
|
||||
asks the same question, so the round trip is exact either way. *)
|
||||
let rec simple_place (f : Form.t) =
|
||||
let atom (x : Form.t) =
|
||||
match x.v with
|
||||
| Form.Sym _ | Form.Int _ | Form.Kw _ | Form.Byte _ -> true
|
||||
| _ -> false
|
||||
in
|
||||
match f.v with
|
||||
| Form.Sym _ -> true
|
||||
| Form.List [ { v = Form.Sym h; _ }; t ]
|
||||
when (String.length h > 1 && h.[0] = '.') || h = "deref" ->
|
||||
simple_place t
|
||||
| Form.List ({ v = Form.Sym "at"; _ } :: t :: (_ :: _ as idx)) ->
|
||||
simple_place t && List.for_all atom idx
|
||||
| _ -> false
|
||||
|
||||
let compound (at : Loc.t) op (e : Form.t) (v : Form.t) span =
|
||||
if simple_place e then
|
||||
Form.List
|
||||
[ Form.make (Form.Sym "set") at; e;
|
||||
Form.make (Form.List [ Form.make (Form.Sym op) at; e; v ]) span ]
|
||||
else
|
||||
Form.List
|
||||
[ Form.make (Form.Sym "update") at; e; Form.make (Form.Sym op) at; v ]
|
||||
|
||||
(* 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 =
|
||||
@ -713,11 +742,7 @@ and inline_stmt p : Form.t =
|
||||
| NAME op when List.mem_assoc op assign_ops ->
|
||||
let eq = advance p in
|
||||
let v, _ = expr p in
|
||||
mk p t.loc
|
||||
(Form.List
|
||||
[ sym eq.loc "set"; e;
|
||||
Form.make (Form.List [ sym eq.loc (List.assoc op assign_ops); e; v ])
|
||||
(span p e.loc) ])
|
||||
mk p t.loc (compound eq.loc (List.assoc op assign_ops) e v (span p e.loc))
|
||||
| _ -> e
|
||||
|
||||
(* [fn(a, b) = body] is a lambda; [fn(...)] followed by anything else is the
|
||||
@ -1114,10 +1139,7 @@ and expr_stmt (s : st) : Form.t =
|
||||
let eq = advance p in
|
||||
let v = value_line s ~after:(text_of e ^ " " ^ op) in
|
||||
let o = List.assoc op assign_ops in
|
||||
mk p t0.loc
|
||||
(Form.List
|
||||
[ sym eq.loc "set"; e;
|
||||
Form.make (Form.List [ sym eq.loc o; e; v ]) (span p e.loc) ])
|
||||
mk p t0.loc (compound eq.loc o e v (span p e.loc))
|
||||
| COLON ->
|
||||
let before = (last p).tok in
|
||||
let c = advance p in
|
||||
|
||||
@ -1618,6 +1618,7 @@ let program ?(parse = Parse.program) ~file (forms : Form.t list) : t =
|
||||
in
|
||||
let decls =
|
||||
Parse.with_imported ~decls:(imported.decls @ !Parse.imported_decls)
|
||||
~fns:!Parse.shadowing_fns
|
||||
(macro_union imported.macros !Parse.imported_macros)
|
||||
(fun () -> parse forms)
|
||||
in
|
||||
|
||||
29
lib/macro.ml
29
lib/macro.ml
@ -585,10 +585,39 @@ let with_module (l : loaded) (f : unit -> 'a) : 'a =
|
||||
left in them, so a second pass only reaches the calls to the new names. A
|
||||
macro that defines a macro whose expansion defines another costs one pass
|
||||
per level, and the fuel is the same bound [settle] uses. *)
|
||||
(* The names these forms define as functions. A program's [defn] shadows a
|
||||
macro of the same name — the prelude's [clamp] or [update], or an
|
||||
imported one — as it shadows a prelude function: every call in the file
|
||||
reaches the definition, and [Check.shadow_prelude] says so. So such a
|
||||
name is not expanded here. A [defmacro] is a [defn] too once parsed, but
|
||||
not yet: [macro_name] is what finds those, and they are left alone. *)
|
||||
let defined_fns (forms : Form.t list) =
|
||||
List.filter_map
|
||||
(fun (f : Form.t) ->
|
||||
match f.Form.v with
|
||||
| Form.List ({ Form.v = Form.Sym ("defn" | "defn-"); _ }
|
||||
:: { Form.v = Form.Sym n; _ } :: _) -> Some n
|
||||
| _ -> None)
|
||||
forms
|
||||
|
||||
let rec program_n left (forms : Form.t list) : Form.t list =
|
||||
match loaded_for forms with
|
||||
| None -> forms
|
||||
| Some l ->
|
||||
(* Never the prelude's own forms: they are parsed inside a session's
|
||||
evaluation too, and their calls are to their own macros. *)
|
||||
let prelude =
|
||||
match forms with
|
||||
| f :: _ -> String.equal f.Form.loc.Loc.file Prelude.file
|
||||
| [] -> false
|
||||
in
|
||||
let shadowed =
|
||||
if prelude then [] else defined_fns forms @ !Parse.shadowing_fns
|
||||
in
|
||||
let l =
|
||||
if shadowed = [] then l
|
||||
else { l with fns = List.filter (fun (n, _) -> not (List.mem n shadowed)) l.fns }
|
||||
in
|
||||
let before = macros_in forms in
|
||||
let out = with_module l (fun () -> List.map (expand_form l) forms) in
|
||||
let fresh = List.filter (fun n -> not (List.mem n before)) (macros_in out) in
|
||||
|
||||
154
lib/parse.ml
154
lib/parse.ml
@ -30,6 +30,32 @@ let no_sigil (f : Form.t) =
|
||||
|
||||
let dname (f : Form.t) = no_sigil f; sym f
|
||||
|
||||
(* A global's name. One spelled like a built-in type would stand where the
|
||||
type is written — [(vec-new u8)] — and change what that means, in the
|
||||
program and in the prelude alike, so it is refused where it is declared. *)
|
||||
let gname (f : Form.t) =
|
||||
(match f.v with
|
||||
| Sym s when List.mem s Types.primitive_names ->
|
||||
Loc.failk "parse/global-named-type" f.loc
|
||||
"%s is a type, so it cannot also name a global — (vec-new %s) would \
|
||||
not know which was meant. Name it %s-value, or any name that is not \
|
||||
a type"
|
||||
s s s
|
||||
| _ -> ());
|
||||
dname f
|
||||
|
||||
(* A type's name. A built-in type's is taken: a second [u8] would stand for
|
||||
one or the other wherever a type is written, the prelude's included. *)
|
||||
let tname (f : Form.t) =
|
||||
(match f.v with
|
||||
| Sym s when List.mem s Types.primitive_names ->
|
||||
Loc.failk "parse/type-named-builtin" f.loc
|
||||
"%s is a built-in type, so it cannot be declared again. Give the new \
|
||||
type a name of its own"
|
||||
s
|
||||
| _ -> ());
|
||||
dname f
|
||||
|
||||
(* Names for the temporaries this file mints — the value is bound once and
|
||||
everything that needs it reads *that*, so a destructuring pattern over a
|
||||
call calls it once and a short-circuit operand is evaluated once. [~] is a
|
||||
@ -449,6 +475,14 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr =
|
||||
| [ target; value ] -> mk (Ast.Set (place target, expr value))
|
||||
| _ -> fail f "set is (set place value)")
|
||||
|
||||
(* What [update], [++] and [--] expand into: (update~ PLACE g NEW), where
|
||||
NEW is written over the name [g]. The name has a [~] in it so no program
|
||||
can write it; only a prelude macro builds one. See [modify]. *)
|
||||
| Sym "update~" ->
|
||||
(match args with
|
||||
| [ target; { v = Sym g; _ }; value ] -> modify f target g value
|
||||
| _ -> fail f "internal: update~ is (update~ place name value) — a compiler bug")
|
||||
|
||||
(* ── (vec-new [u8]) and (map-new string [u8]) ───────────────────────
|
||||
The type positions of these two take a type expression. Whether this call
|
||||
is the builtin at all is the checker's to know — a program may define its
|
||||
@ -1174,17 +1208,10 @@ and cond f (args : Form.t list) : Ast.expr =
|
||||
[f.loc] would blame the enclosing (and ...) for whichever operand is
|
||||
actually wrong.
|
||||
|
||||
What answering the operand costs, for both forms alike: the two arms are
|
||||
now both real values, so mixing a dyn operand with a typed bool one makes
|
||||
check_if unify them, and the then arm decides. A non-bool dyn value on
|
||||
the losing side then meets the strict bool boundary at run time —
|
||||
(or false (box "s")) and (and (box nil) some-bool) both trap, verified on
|
||||
this tree. Each form used to be safe in exactly one of those directions,
|
||||
because the sentinel it answered was a bool literal that boxed to fit
|
||||
whatever the real branch was; neither is now, and they are at least
|
||||
symmetric about it. Making bool and dyn arms join as dyn is a check_if
|
||||
question, noted in TODO.org, "A bool arm and a dyn arm joining as dyn",
|
||||
and not decided here.
|
||||
The two arms are both real values, so mixing a dyn operand with a typed
|
||||
bool one makes check_if unify them: a bool arm and a dyn arm meet at dyn
|
||||
with the bool boxed, whichever side each is on, so (or false (box "s"))
|
||||
answers "s" and (and (box nil) some-bool) answers nil.
|
||||
|
||||
One known wart, measured rather than guessed, and left alone deliberately.
|
||||
In a want-free position — [(println (and true true (vec-new i32)))] — the
|
||||
@ -1252,6 +1279,65 @@ and place (f : Form.t) : Ast.place =
|
||||
(deref p), or a class slot (get inst :slot)"
|
||||
(Form.to_string f)
|
||||
|
||||
(* A read-modify-write of a place, with every subexpression of the place
|
||||
evaluated once — C's rule for compound assignment. (update (at grid (next)
|
||||
c) inc) calls [next] once, and the read and the write land on the same
|
||||
element.
|
||||
|
||||
Each index, key and pointer is bound to a temp first, outermost and
|
||||
leftmost first. The container a field or an index is taken from is not: it
|
||||
has to stay a path to the storage, since a temp would be a copy of a struct
|
||||
or an array and the write would land in the copy. Only a path made of
|
||||
names, fields, indexes and derefs stays one; anything else in container
|
||||
position — a call answering a Vec, say — is a value, and is bound like an
|
||||
index. Then [g] is bound to the place's current value, and [value], written
|
||||
over [g], is stored back through the same path. *)
|
||||
and modify f target g value : Ast.expr =
|
||||
let mk e = { Ast.e; loc = f.loc } in
|
||||
let binds = ref [] in
|
||||
let temp (e : Ast.expr) =
|
||||
match e.Ast.e with
|
||||
| Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ | Ast.Str _ | Ast.Kw _ -> e
|
||||
| _ ->
|
||||
let t = fresh_temp "place" in
|
||||
binds := { Ast.bname = t; bty = None; bval = e; bloc = e.Ast.loc } :: !binds;
|
||||
{ e with Ast.e = Ast.Var t }
|
||||
in
|
||||
let rec path (e : Ast.expr) =
|
||||
match e.Ast.e with
|
||||
| Ast.Var _ -> e
|
||||
| Ast.Field (t, n) -> { e with Ast.e = Ast.Field (path t, n) }
|
||||
| Ast.Call (({ Ast.e = Ast.Var "at"; _ } as h), t :: idx) when idx <> [] ->
|
||||
let t = path t in
|
||||
{ e with Ast.e = Ast.Call (h, t :: List.map temp idx) }
|
||||
| Ast.Call (({ Ast.e = Ast.Var "deref"; _ } as h), [ p ]) ->
|
||||
{ e with Ast.e = Ast.Call (h, [ temp p ]) }
|
||||
| _ -> temp e
|
||||
in
|
||||
let p =
|
||||
match place target with
|
||||
| Ast.Pvar _ as p -> p
|
||||
| Ast.Pfield (t, n) -> Ast.Pfield (path t, n)
|
||||
| Ast.Pindex (t, idx) ->
|
||||
let t = path t in
|
||||
Ast.Pindex (t, List.map temp idx)
|
||||
| Ast.Pderef p -> Ast.Pderef (temp p)
|
||||
| Ast.Pslot (t, k) ->
|
||||
let t = temp t in
|
||||
Ast.Pslot (t, temp k)
|
||||
in
|
||||
let at e = { Ast.e; loc = target.loc } in
|
||||
let read =
|
||||
match p with
|
||||
| Ast.Pvar n -> at (Ast.Var n)
|
||||
| Ast.Pfield (t, n) -> at (Ast.Field (t, n))
|
||||
| Ast.Pindex (t, idx) -> at (Ast.Call (at (Ast.Var "at"), t :: idx))
|
||||
| Ast.Pderef p -> at (Ast.Call (at (Ast.Var "deref"), [ p ]))
|
||||
| Ast.Pslot (t, k) -> at (Ast.Call (at (Ast.Var "get"), [ t; k ]))
|
||||
in
|
||||
let old = { Ast.bname = g; bty = None; bval = read; bloc = target.loc } in
|
||||
mk (Ast.Let (List.rev (old :: !binds), [ mk (Ast.Set (p, expr value)) ]))
|
||||
|
||||
and arms f (items : Form.t list) : Ast.arm list =
|
||||
let rec go = function
|
||||
| [] -> []
|
||||
@ -1343,7 +1429,13 @@ let rec decl (f : Form.t) : Ast.decl =
|
||||
|
||||
| List ({ v = Sym "defalias"; _ } :: args) ->
|
||||
(match args with
|
||||
| [ n; t ] -> mk (Ast.Defalias (dname n, texpr t))
|
||||
(* int and float restate a builtin alias, which the checker takes up;
|
||||
any other built-in type's name is refused as tname refuses it. *)
|
||||
| [ n; t ] ->
|
||||
let name =
|
||||
match n.v with Sym ("int" | "float") -> dname n | _ -> tname n
|
||||
in
|
||||
mk (Ast.Defalias (name, texpr t))
|
||||
| _ -> fail f "defalias is (defalias Name Type)")
|
||||
|
||||
(* A parent comes before the fields, where Common Lisp's define-condition
|
||||
@ -1353,16 +1445,16 @@ let rec decl (f : Form.t) : Ast.decl =
|
||||
| List ({ v = Sym "defstruct"; _ } :: args) ->
|
||||
(match args with
|
||||
| [ n; { v = Vec fs; _ } ] ->
|
||||
mk (Ast.Defstruct (dname n, fields f fs, None))
|
||||
mk (Ast.Defstruct (tname n, fields f fs, None))
|
||||
| [ n; { v = Kw "parent"; _ }; p; { v = Vec fs; _ } ] when fs <> [] ->
|
||||
mk (Ast.Defstruct (dname n, fields f fs, Some (texpr p)))
|
||||
mk (Ast.Defstruct (tname n, fields f fs, Some (texpr p)))
|
||||
(* An empty field vector is the same category as none. *)
|
||||
| [ n; { v = Kw "parent"; _ }; p ] | [ n; { v = Kw "parent"; _ }; p; { v = Vec []; _ } ] ->
|
||||
let str name =
|
||||
{ Ast.fname = name; fty = { Ast.t = Ast.Tname "string"; tloc = f.loc };
|
||||
floc = f.loc }
|
||||
in
|
||||
mk (Ast.Defstruct (dname n, [ str "name"; str "message" ], Some (texpr p)))
|
||||
mk (Ast.Defstruct (tname n, [ str "name"; str "message" ], Some (texpr p)))
|
||||
| _ ->
|
||||
fail f
|
||||
"defstruct is (defstruct Name [field Type ...]), or with a parent \
|
||||
@ -1370,7 +1462,7 @@ let rec decl (f : Form.t) : Ast.decl =
|
||||
|
||||
| List ({ v = Sym "defdata"; _ } :: args) ->
|
||||
(match args with
|
||||
| [ n; { v = Vec vs; _ } ] -> mk (Ast.Defdata (dname n, List.map variant vs))
|
||||
| [ n; { v = Vec vs; _ } ] -> mk (Ast.Defdata (tname n, List.map variant vs))
|
||||
| _ -> fail f "defdata is (defdata Name [(Case [field Type ...]) ...])")
|
||||
|
||||
(* C's union: one storage, as many ways of reading it as there are members.
|
||||
@ -1413,7 +1505,7 @@ let rec decl (f : Form.t) : Ast.decl =
|
||||
[member Type ...]). This reads as a tagged sum — write \
|
||||
(defdata Name [(Case [field Type ...]) ...])")
|
||||
ms;
|
||||
mk (Ast.Defunion (dname n, fields f ms))
|
||||
mk (Ast.Defunion (tname n, fields f ms))
|
||||
| _ -> fail f "defunion is (defunion Name [member Type ...])")
|
||||
|
||||
(* The slot after the parameters is unconditionally the return type. It used
|
||||
@ -1538,7 +1630,7 @@ let rec decl (f : Form.t) : Ast.decl =
|
||||
List.iter
|
||||
(fun (s : Form.t) -> match s.v with Sym _ -> no_sigil s | _ -> ())
|
||||
slots;
|
||||
mk (Ast.Defclass (dname n, pitems slots))
|
||||
mk (Ast.Defclass (tname n, pitems slots))
|
||||
| _ -> fail f "defclass is (defclass Name [slot Type ...])")
|
||||
|
||||
| List ({ v = Sym ("defgeneric" | "defmulti" as which); _ } :: args) ->
|
||||
@ -1631,7 +1723,7 @@ let rec decl (f : Form.t) : Ast.decl =
|
||||
| List ({ v = Sym "defenum"; _ } :: args) ->
|
||||
(match args with
|
||||
| [ n; { v = Form.Vec ms; _ } ] ->
|
||||
let ename = dname n in
|
||||
let ename = tname n in
|
||||
(* An enum member is an [i32] at run time. [Shim] lowers the type to
|
||||
int32_t for C's benefit and [Check] builds every member as a
|
||||
[Tast.Int (v, I32)] -- but the reader hands this pass an [int64], so
|
||||
@ -1781,11 +1873,11 @@ let rec decl (f : Form.t) : Ast.decl =
|
||||
(match args with
|
||||
| [ n; t ] ->
|
||||
let ty, init = defvar3 t in
|
||||
mk (Ast.Defvar (dname n, Some ty, init, kind))
|
||||
mk (Ast.Defvar (gname n, Some ty, init, kind))
|
||||
| [ n; t; { v = Sym "uninit"; _ } ] ->
|
||||
mk (Ast.Defvar (dname n, Some (texpr t), Ast.Uninit, kind))
|
||||
mk (Ast.Defvar (gname n, Some (texpr t), Ast.Uninit, kind))
|
||||
| [ n; t; v ] ->
|
||||
mk (Ast.Defvar (dname n, Some (texpr t), Ast.Init (expr v), kind))
|
||||
mk (Ast.Defvar (gname n, Some (texpr t), Ast.Init (expr v), kind))
|
||||
| _ ->
|
||||
fail f
|
||||
"%s is (%s name Type value?) or (%s name value) — a third element \
|
||||
@ -1824,8 +1916,8 @@ let rec decl (f : Form.t) : Ast.decl =
|
||||
|
||||
| List ({ v = Sym "defconst"; _ } :: args) ->
|
||||
(match args with
|
||||
| [ n; v ] -> mk (Ast.Defconst (dname n, None, expr v))
|
||||
| [ n; t; v ] -> mk (Ast.Defconst (dname n, Some (texpr t), expr v))
|
||||
| [ n; v ] -> mk (Ast.Defconst (gname n, None, expr v))
|
||||
| [ n; t; v ] -> mk (Ast.Defconst (gname n, Some (texpr t), expr v))
|
||||
| _ -> fail f "defconst is (defconst name Type? value)")
|
||||
|
||||
(* A macro is an ordinary function, and this is where it becomes one:
|
||||
@ -2002,15 +2094,25 @@ let expansion_macros : Form.t list ref = ref []
|
||||
written twice, in the file where the two copies could disagree silently. *)
|
||||
let imported_decls : Ast.decl list ref = ref []
|
||||
|
||||
let with_imported ?(decls = []) (ms : Form.t list) (f : unit -> 'a) : 'a =
|
||||
(* Functions a session already holds, by name. A program's [defn] shadows a
|
||||
macro of its name, and a session's form is expanded alone, long after the
|
||||
[defn] that shadows — so the session says which names those are, as it
|
||||
says which macros it has. *)
|
||||
let shadowing_fns : string list ref = ref []
|
||||
|
||||
let with_imported ?(decls = []) ?(fns = []) (ms : Form.t list)
|
||||
(f : unit -> 'a) : 'a =
|
||||
let saved = !imported_macros in
|
||||
let saved_decls = !imported_decls in
|
||||
let saved_fns = !shadowing_fns in
|
||||
imported_macros := ms;
|
||||
imported_decls := decls;
|
||||
shadowing_fns := fns;
|
||||
Fun.protect
|
||||
~finally:(fun () ->
|
||||
imported_macros := saved;
|
||||
imported_decls := saved_decls)
|
||||
imported_decls := saved_decls;
|
||||
shadowing_fns := saved_fns)
|
||||
f
|
||||
|
||||
(* Two entry points and not one function with a flag, and the reason is the
|
||||
|
||||
@ -197,6 +197,17 @@ let source = {flan|
|
||||
;; nothing a handler supplies makes the old arguments fit the new body.
|
||||
(defstruct StaleCall :parent Error [callee string compiled string current string])
|
||||
|
||||
;; A call through a (CFn ...) that holds no function. A CFn may be a struct
|
||||
;; field, a fixed array's element or a global, and each of those starts out
|
||||
;; zeroed, which for a function value is no address at all. Every call
|
||||
;; through one tests first and signals this instead of jumping to nothing.
|
||||
;; `type` is the value's type as written, "(CFn [i32] i32)".
|
||||
;;
|
||||
;; Signalled from the runtime — flan_null_call in runtime/flan_rt.c — so
|
||||
;; **this field is a C struct that has to agree with this one**. No restart is
|
||||
;; established at the call, BoundsError's decision for BoundsError's reason.
|
||||
(defstruct NullCall :parent Error [type string])
|
||||
|
||||
;; What a generic function signals when no method answers. `generic` is the
|
||||
;; name written at the defgeneric or defmulti, and `value` is what the
|
||||
;; dispatch actually produced -- the class of the first argument for a
|
||||
@ -2299,16 +2310,12 @@ let source = {flan|
|
||||
;; because a macro does not have a type at all; the expansion is checked at the
|
||||
;; call site as if it had been written there.
|
||||
;;
|
||||
;; **++ and -- read the place twice, and that is an accepted cost.** The
|
||||
;; expansion is (set PLACE (+ PLACE 1)), so PLACE is evaluated once to read
|
||||
;; and once to write. For a variable, a field or a deref that is free and
|
||||
;; means nothing. For (at arr (next-index)) — an index with a side effect —
|
||||
;; it means next-index runs twice and the read and the write land on different
|
||||
;; elements. That is not a bug to be fixed here: macros are non-hygienic by
|
||||
;; decision (plan.org, open decision 2), a macro cannot bind a temporary for
|
||||
;; the *place* without a reference type it does not have, and
|
||||
;; rl/with-drawing and rl/with-mode-2d already take the same trade on their
|
||||
;; arguments. Write the index out first if it does anything.
|
||||
;; **++ and -- evaluate the place once.** Each index, key and pointer in the
|
||||
;; place is bound to a temp before the read, so (++ (at arr (next-index)))
|
||||
;; calls next-index once and reads and writes the same element — C's rule for
|
||||
;; compound assignment. They are update with + and -, spelled as the form
|
||||
;; update~ that update itself expands into (a prelude macro may not call a
|
||||
;; macro); lib/parse.ml's [modify] is where the place is taken apart.
|
||||
(defmacro inc [& args]
|
||||
(if (!= (length args) 1)
|
||||
`(inc-takes-one-number)
|
||||
@ -2322,12 +2329,31 @@ let source = {flan|
|
||||
(defmacro ++ [& args]
|
||||
(if (!= (length args) 1)
|
||||
`(++-takes-one-place)
|
||||
`(set ~(at args 0) (+ ~(at args 0) 1))))
|
||||
(let [g (gensym)]
|
||||
`(~(Form.Sym {.s "update~"}) ~(at args 0) ~g (+ ~g 1)))))
|
||||
|
||||
(defmacro -- [& args]
|
||||
(if (!= (length args) 1)
|
||||
`(---takes-one-place)
|
||||
`(set ~(at args 0) (- ~(at args 0) 1))))
|
||||
(let [g (gensym)]
|
||||
`(~(Form.Sym {.s "update~"}) ~(at args 0) ~g (- ~g 1)))))
|
||||
|
||||
;; ── update: change a place by applying a function to it ────────────────
|
||||
;;
|
||||
;; (update (.velocity g) inc)
|
||||
;; (update (at grid r c) + 10)
|
||||
;;
|
||||
;; (update place f args ...) stores (f old args ...) back into the place, where
|
||||
;; old is what the place held. f is written as the head of a call, so it may be
|
||||
;; a function, an operator or a macro such as inc. Every place set takes is a
|
||||
;; place here too — a name, a field, an element, a deref, a class slot — and
|
||||
;; the place is evaluated once, as ++ says above. It answers what set answers.
|
||||
(defmacro update [& args]
|
||||
(if (< (length args) 2)
|
||||
`(update-takes-a-place-and-a-function)
|
||||
(let [g (gensym)]
|
||||
`(~(Form.Sym {.s "update~"}) ~(at args 0) ~g
|
||||
(~(at args 1) ~g ~@(form-rest args 2))))))
|
||||
|
||||
;; ── into: a fused transformation, and not a transducer ────────────────
|
||||
;;
|
||||
@ -2400,6 +2426,15 @@ let source = {flan|
|
||||
(form-sym? head "filter") (recur (- k 1) `(when (~f ~x) ~body))
|
||||
:else `(into-transform-is-map-or-filter ~t))))))))
|
||||
|
||||
;; Whether any transform in the chain is a (map f).
|
||||
(defn into-maps? [ts [Form]] bool
|
||||
(loop [k 0]
|
||||
(cond
|
||||
(= k (length ts)) false
|
||||
(let [items (form-items (at ts k))]
|
||||
(and (> (length items) 0) (form-sym? (at items 0) "map"))) true
|
||||
:else (recur (+ k 1)))))
|
||||
|
||||
;; The items of a list form, and the empty slice for anything else — a
|
||||
;; non-list transform falls into the arity complaint above rather than needing
|
||||
;; a case of its own.
|
||||
@ -2452,10 +2487,19 @@ let source = {flan|
|
||||
named? (form-is-sym? from)
|
||||
src (if named? from (gensym))
|
||||
bind (if named? (form-nil) (form-pair src from))
|
||||
;; With no (map f) in the chain every element pushed is a source
|
||||
;; element as it stands, which copies only its header: the checker
|
||||
;; refuses that for an element that owns storage. The destination and
|
||||
;; the transforms ride along unevaluated, to be written back in the fix.
|
||||
shares (if (into-maps? (form-rest args 2))
|
||||
(form-nil)
|
||||
(form-cons `(into-copies-elements ~src ~(at args 1) ~@(form-rest args 2))
|
||||
(form-nil)))
|
||||
dst (gensym)
|
||||
x (gensym)
|
||||
i (gensym)]
|
||||
`(let [~dst ~(at args 1) ~@bind]
|
||||
~@shares
|
||||
(dotimes [~i (length ~src)]
|
||||
(let [~x (at ~src ~i)]
|
||||
~(into-wrap (form-rest args 2) dst x)))
|
||||
|
||||
@ -800,6 +800,18 @@ let rehost t =
|
||||
t.built <- record_built env p p.Tast.fns SM.empty;
|
||||
t.live <- SM.empty
|
||||
|
||||
(* The session's own functions whose names a macro also has — see
|
||||
[Parse.shadowing_fns]. A [defmacro] is a [defn] once parsed, so the
|
||||
session's macros are taken back out. *)
|
||||
let shadowing_fns t origin =
|
||||
let macros = List.filter_map Macro.macro_name (macros_for t origin) in
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with
|
||||
| Ast.Defn fn when not (List.mem fn.Ast.name macros) -> Some fn.Ast.name
|
||||
| _ -> None)
|
||||
t.decls
|
||||
|
||||
(* [forms], when given, are [src] already read — [pruned] runs this over a
|
||||
file a form fewer each round and has no text for the subset. [base] is the
|
||||
file an [(import ...)] in them is resolved against, the session's own when
|
||||
@ -812,7 +824,7 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = tr
|
||||
(* What an annotated listing quotes for this form is what was sent, not what
|
||||
the file on disk said when it was last read. *)
|
||||
Loc.remember ~file:origin src;
|
||||
Parse.with_imported ~decls:(package_decls t) (macros_for t origin) @@ fun () ->
|
||||
Parse.with_imported ~decls:(package_decls t) ~fns:(shadowing_fns t origin) (macros_for t origin) @@ fun () ->
|
||||
(* Through [Load] like any other source, so an evaluated (import ...) means
|
||||
what it means in a file. Its expansion is what gets spliced, which is also
|
||||
why the accumulated list is the post-Load one: re-evaluating a file that
|
||||
@ -2628,7 +2640,7 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) ?frame t src : change =
|
||||
a cold macro module costs its ~300ms before that clock starts,
|
||||
and the non-termination refusals raise [Loc.Error] out of this call, which
|
||||
the daemon already answers as an error rather than a silence. *)
|
||||
let parsed = Parse.with_imported ~decls:(package_decls t) (macros_for t origin) (fun () -> Parse.expr form) in
|
||||
let parsed = Parse.with_imported ~decls:(package_decls t) ~fns:(shadowing_fns t origin) (macros_for t origin) (fun () -> Parse.expr form) in
|
||||
(* CIDER's rule: an expression sent from a package's file means what it
|
||||
would mean written in that file, so [(integrate 1.0)] in physics/step.flan
|
||||
reaches [physics/integrate]. The qualification [eval] gives a declaration
|
||||
@ -2805,7 +2817,7 @@ let macroexpand ?(origin = "<eval>") ~(all : bool) t (src : string) : expansion
|
||||
let before = Expand.quasiquote form in
|
||||
(* And the session's macros in front of it, as [eval] and [eval_expr] both
|
||||
put them: [Macro.program] reads [Parse.imported_macros] directly. *)
|
||||
Parse.with_imported ~decls:(package_decls t) (macros_for t origin) @@ fun () ->
|
||||
Parse.with_imported ~decls:(package_decls t) ~fns:(shadowing_fns t origin) (macros_for t origin) @@ fun () ->
|
||||
let after, name =
|
||||
if all then Macro.expand_all before else Macro.expand_step before
|
||||
in
|
||||
|
||||
23
lib/x86.ml
23
lib/x86.ml
@ -1927,6 +1927,9 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit =
|
||||
| Types.Fn _ -> Some (Aint (shift c 8, Types.Ptr (Types.Mut, Types.Unit)))
|
||||
| _ -> None
|
||||
in
|
||||
(match callee.Tast.ty with
|
||||
| Types.CFn _ -> null_check f e.Tast.loc callee.Tast.ty c
|
||||
| _ -> ());
|
||||
call_flan f ?env ~at:e.Tast.loc ~target:(`Loc c) ~args ~rty:t dst
|
||||
| Tast.Do body -> block f body dst t
|
||||
| Tast.Let (bs, body) ->
|
||||
@ -2713,6 +2716,26 @@ and elements f (base : loc) (ty : Types.t) (is : Tast.expr list) : loc =
|
||||
That is also the answer to "does a bounds trap run defers": an answered one
|
||||
does, because it leaves through the innermost pad; an unanswered one still
|
||||
does not, because it is a die inside C. Identical on both backends. *)
|
||||
(* [Emit.null_check]: a (CFn ...) holding null is not called. Tested before
|
||||
the arguments, as the LLVM backend does, and [flan_null_call] returns only
|
||||
when something transferred. *)
|
||||
and null_check f (loc : Loc.t) ty (c : loc) =
|
||||
load_loc f ~reg:rax c ty;
|
||||
test_rr f.b ~a:rax ~c:rax;
|
||||
let ok = new_label f "fnok" in
|
||||
jcc_lbl f.b ~cc:cc_ne ok;
|
||||
note f "A null (CFn ...): the site, the type as a C string and the channel.";
|
||||
str_args f ~preg:rdi ~nreg:rsi (Loc.to_string loc);
|
||||
let tys, _ = fi_bytes f (Types.to_string ty ^ "\000") in
|
||||
lea f.b ~dst:rdx ~mm:(Sym (tys, 0));
|
||||
chan_into f ~reg:rcx;
|
||||
mark_at f loc;
|
||||
xor_rr f.b ~dst:rax ~src:rax;
|
||||
call_sym f.b "flan_null_call";
|
||||
guard f;
|
||||
ud2 f.b;
|
||||
lbl f.b ok
|
||||
|
||||
and bounds_call f sym (loc : Loc.t) (extra : int list) =
|
||||
note f (Printf.sprintf
|
||||
"Out of bounds: the location string, the operands, and this frame's channel, \
|
||||
|
||||
11
plan.org
11
plan.org
@ -248,11 +248,12 @@ and on a managed ~class~ instance. An ordinary ~struct~ never carries one.
|
||||
already refused so nothing else it could be. ~sort~ declares ~ordered?~ of its
|
||||
variable, the abstract pass then allows ~<~ in the body, and each instantiation
|
||||
checks the concrete type satisfies the predicate and refuses the call site if it
|
||||
does not. There are *five* predicates — ~ordered?~, ~equal?~, ~hashable?~,
|
||||
~numeric?~, ~integer?~ — against Odin's forty-one, and they entail one another
|
||||
in one direction, so one clause usually does: ~integer?~ gives ~numeric?~,
|
||||
~numeric?~ gives ~ordered?~, and ~ordered?~ gives ~equal?~. ~integer?~ exists
|
||||
because ~numeric?~ admits floats.
|
||||
does not. There are *six* predicates — ~ordered?~, ~equal?~, ~hashable?~,
|
||||
~numeric?~, ~integer?~, ~enum?~ — against Odin's forty-one, and they entail one
|
||||
another in one direction, so one clause usually does: ~integer?~ gives
|
||||
~numeric?~, ~numeric?~ gives ~ordered?~, and ~ordered?~ gives ~equal?~.
|
||||
~integer?~ exists because ~numeric?~ admits floats. ~enum?~ gives ~ordered?~
|
||||
and a conversion to a number, and not arithmetic.
|
||||
~hashable?~ is what lets a variable *key a map*: without it the type
|
||||
~(Map $t i32)~ is refused where it is written, and with it the refusal moves to
|
||||
the call site that names an unhashable key.
|
||||
|
||||
@ -1538,6 +1538,51 @@ void flan_stale_call(const char *site, const char *callee, const char *want,
|
||||
rt_die();
|
||||
}
|
||||
|
||||
/* ── A call through a null (CFn ...) ───────────────────────────────────
|
||||
*
|
||||
* A (CFn ...) may sit in a struct field, a fixed array or a global, all of
|
||||
* which zero-initialise, and a zeroed one is a null address. Every call
|
||||
* through a CFn value tests it first and lands here on null, so the call is
|
||||
* not made. It signals NullCall with `error` — BoundsError's shape and its
|
||||
* decision about restarts: no value a handler supplies turns into a function
|
||||
* to call, so what answers it is a restart the program already has, or the
|
||||
* break loop in a dev build.
|
||||
*
|
||||
* `type` is copied and never freed, for flan_stale_call's reason: the text
|
||||
* lives in the image of the module that compiled the call, which may be a
|
||||
* thunk that is unloaded once it returns. Must agree with the prelude's
|
||||
* (defstruct NullCall :parent Error [type string]). */
|
||||
|
||||
typedef struct { flan_slice type; } flan_nullcall_cond;
|
||||
|
||||
static const uint8_t flan_nullcall_name[] = "NullCall";
|
||||
#define FLAN_NULLCALL_NAMELEN 8
|
||||
|
||||
static void nullcall_sentence(const char *ty) {
|
||||
rt_sentence("this call is through a %s that holds no function — a field, "
|
||||
"an array element or a global of that type starts out empty. "
|
||||
"Store a function in it before calling it, or hold it as an "
|
||||
"(Option %s) and match on it",
|
||||
ty, ty);
|
||||
}
|
||||
|
||||
void flan_null_call(const uint8_t *loc, int64_t loclen, const char *ty,
|
||||
void *xfer) {
|
||||
flan_nullcall_cond c;
|
||||
flan_condesc d;
|
||||
uint32_t chain[2];
|
||||
c.type = flan_stale_copy(ty);
|
||||
nullcall_sentence(ty);
|
||||
rt_condesc(&d, chain, flan_nullcall_name, FLAN_NULLCALL_NAMELEN, loc,
|
||||
loclen);
|
||||
flan_signal(&d, &c, xfer);
|
||||
if (*(void **)xfer != NULL) return;
|
||||
nullcall_sentence(ty); /* in full; see flan_bounds_signal */
|
||||
if (rt_error_break(&d, &c, xfer)) return;
|
||||
rt_print_sentence(loc, loclen);
|
||||
rt_die();
|
||||
}
|
||||
|
||||
/* ── Allocators, spec-memory.md ────────────────────────────────────────
|
||||
*
|
||||
* One type-erased procedure plus an opaque data pointer, which is Odin's
|
||||
|
||||
@ -268,12 +268,14 @@ instantiates it:
|
||||
> field-free storage. It does **not** support `=`, `<`, `+`, or `hash`.
|
||||
|
||||
What makes that liveable is a `where` clause of compile-time type predicates,
|
||||
written as a map at the head of the body. There are five — `ordered?`,
|
||||
`equal?`, `hashable?`, `numeric?`, `integer?` — they are not type classes
|
||||
written as a map at the head of the body. There are six — `ordered?`,
|
||||
`equal?`, `hashable?`, `numeric?`, `integer?`, `enum?` — they are not type classes
|
||||
because a predicate carries no implementations and merely gates a builtin the
|
||||
compiler already has, and they entail one another in one direction, so one
|
||||
clause usually does: `integer?` admits every integer kind and no float, and
|
||||
entails `numeric?`, which entails `ordered?`, which entails `equal?`.
|
||||
`enum?` admits exactly the enums and entails `ordered?` and `equal?`, not
|
||||
`numeric?`.
|
||||
`integer?` is what admits the bitwise operators, the shifts and an
|
||||
integer-only body like `abs`'s — under `numeric?` those bodies would be
|
||||
instantiated at the floats too (TODO.org, "abs is one generic, and a bound joins
|
||||
@ -354,14 +356,14 @@ where the type is written, so neither is refused at the variable. A conversion
|
||||
was never a claim that the value survives. The conversion *to* an enum needs
|
||||
`integer?` exactly, because an enum is an `i32` and a float has no enum
|
||||
reading, and `numeric?` would admit an `f32` copy the concrete rule refuses.
|
||||
The conversion *from* an enum to a number needs `enum?` or `numeric?`, and
|
||||
its refusal names both.
|
||||
`ordered?`, `equal?` and `hashable?` admit no conversion at all: they say what
|
||||
can be compared or keyed, not what is a number — and that is a claim about
|
||||
what the predicate says, not about the set it denotes today, which currently
|
||||
does admit only numbers and enums. The refusal names the predicate to write
|
||||
(TODO.org, "A conversion is legal at a bounded variable when it is legal at every
|
||||
type the bound admits"). One consequence is recorded as open: no predicate now
|
||||
licenses a generic enum → integer conversion (TODO.org, "There is now no generic
|
||||
enum to integer conversion").
|
||||
type the bound admits").
|
||||
|
||||
**A type variable is not instantiated at `dyn`.** Two models answer "one body,
|
||||
many types" and they are not rivals: this one copies per written type at
|
||||
|
||||
@ -155,8 +155,9 @@ Each item: the proposal, then the reason in one line.
|
||||
`a < b <= c`, is refused. An operator glued to `(` is always a call.
|
||||
- **`==` 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))`; like `++` today, the place is evaluated twice. **Built**
|
||||
(also `-=`, `*=`, `/=`).
|
||||
`(set x (+ x v))` where every part of the place is a name or a literal, and
|
||||
`(update x + v)` otherwise, so the place is evaluated once either way, as
|
||||
with `++`. **Built** (also `-=`, `*=`, `/=`).
|
||||
- **A run of the same operator flattens** (variadics, section 3):
|
||||
`a + b + c` reads `(+ a b c)`, `a < b < c` reads `(< a b c)` (Flan's chain
|
||||
semantics, `test/programs/chain.flan`). This keeps the converter round trip
|
||||
|
||||
26
test/programs/dev-break-nullcall.flan
Normal file
26
test/programs/dev-break-nullcall.flan
Normal file
@ -0,0 +1,26 @@
|
||||
;;;; A program that stops on a call through a null CFn, for driving the break
|
||||
;;;; loop over one. Nothing handles NullCall here, so the signal reaches the
|
||||
;;;; break hook and the program parks, as a bad index does in
|
||||
;;;; dev-break-bounds.flan; the program's own continue is the way on.
|
||||
(import agent "vendor:agent")
|
||||
|
||||
(defonce table [2 (CFn [i32] i32)])
|
||||
(defonce skipped i64)
|
||||
(defonce ticks i64)
|
||||
|
||||
(defn call-slot [i i32] i32 ((at table i) 5))
|
||||
|
||||
(defn frame [i i32] ()
|
||||
(restart-case
|
||||
(do (println (call-slot i)) (println "frame done"))
|
||||
(continue [] (set skipped (+ skipped 1)))))
|
||||
|
||||
(defn main [] i32
|
||||
(agent/start "/tmp/flan-dev-break-nullcall-fallback.sock")
|
||||
;; Slot 1 was never set, so it is null.
|
||||
(frame 1)
|
||||
(print skipped) (println "")
|
||||
(dotimes [i 4000]
|
||||
(agent/wait 5)
|
||||
(set ticks (+ ticks 1)))
|
||||
0)
|
||||
@ -11,8 +11,10 @@
|
||||
;;;; The other locals are the shapes a path step has to walk and that an
|
||||
;;;; expression cannot reach at all: an option's payload, which has no
|
||||
;;;; accessor form in the language, and a union case's field, whose offset
|
||||
;;;; depends on which case the value is in.
|
||||
;;;; depends on which case the value is in. And a local of a package's type,
|
||||
;;;; which is named as the checker names it everywhere else: qualified.
|
||||
(import agent "vendor:agent")
|
||||
(import shape "pkgs/shape")
|
||||
|
||||
(defstruct Point [x f32 y f32])
|
||||
(defstruct Boom [why i32])
|
||||
@ -38,7 +40,8 @@
|
||||
(let [mark (Point {.x 1.5 .y 2.5})
|
||||
xs [10 20 30]
|
||||
box (Some (Point {.x 4.5 .y 5.5}))
|
||||
s (Shape.Rect {.w 3 .h 6})]
|
||||
s (Shape.Rect {.w 3 .h 6})
|
||||
pk (shape/box 3 4)]
|
||||
(deeper)))
|
||||
|
||||
(defonce ticks i64)
|
||||
|
||||
@ -92,6 +92,13 @@
|
||||
;; used to trap trying to unbox "x" as a strict bool.
|
||||
(println (or (box nil) (box "x")))
|
||||
(println (or (box 5) (box "unreached")))
|
||||
;; A typed bool operand beside a dyn one: the two meet at dyn, the bool
|
||||
;; boxed, so the dyn one comes back whichever side of the if it lands on.
|
||||
(println (or false (box "s")))
|
||||
(println (or (= 1 2) (box nil)))
|
||||
(println (and (box nil) (= 1 1)))
|
||||
(println (and true (box "y")))
|
||||
(println (or true (box "unreached")))
|
||||
|
||||
;; One operand is that operand, whatever it is -- no test, no sentinel.
|
||||
(println (and (box nil)))
|
||||
|
||||
28
test/programs/enum-generic.flan
Normal file
28
test/programs/enum-generic.flan
Normal file
@ -0,0 +1,28 @@
|
||||
;;;; A generic conversion from an enum, licensed by {:where (enum? $t)}. enum?
|
||||
;;;; admits exactly the enums and entails ordered? and equal?, so a body under
|
||||
;;;; it may convert, compare and test for equality, at any enum.
|
||||
|
||||
(defenum Color [red green blue])
|
||||
(defenum Size [small 10 large 20])
|
||||
|
||||
(defn code [x $t] i32
|
||||
{:where (enum? $t)}
|
||||
(i32 x))
|
||||
|
||||
(defn later? [a $t b $t] bool
|
||||
{:where (enum? $t)}
|
||||
(> a b))
|
||||
|
||||
(defn same? [a $t b $t] bool
|
||||
{:where (enum? $t)}
|
||||
(and (= a b) (<= a b)))
|
||||
|
||||
(defn main [] i32
|
||||
(let [c (Color 2)
|
||||
s (Size 20)]
|
||||
(println (code c)) ; 2
|
||||
(println (code s)) ; 20
|
||||
(println (later? c (Color 0))) ; true
|
||||
(println (same? (Color 1) (Color 1))) ; true
|
||||
(println (f64 (code s)))) ; 20
|
||||
0)
|
||||
55
test/programs/fn-cfn-table.flan
Normal file
55
test/programs/fn-cfn-table.flan
Normal file
@ -0,0 +1,55 @@
|
||||
;; A (CFn ...) in the places that zero-initialise: a struct field, a fixed
|
||||
;; array's element and a global. A table of bare code addresses is what the
|
||||
;; narrow function type is for, and the zero is the only objection there ever
|
||||
;; was — a zeroed CFn is a null address. So a call through one tests it first
|
||||
;; and signals NullCall rather than jumping to nothing.
|
||||
;;
|
||||
;; With no argument the empty calls are answered and the program carries on;
|
||||
;; with "1" nothing answers and it dies, with the site and the type.
|
||||
|
||||
(defn double [x i32] i32 (* x 2))
|
||||
(defn negate [x i32] i32 (- 0 x))
|
||||
|
||||
(defstruct Ops [name string run (CFn [i32] i32)])
|
||||
|
||||
(defonce table [3 (CFn [i32] i32)])
|
||||
(defonce hook (CFn [i32] i32))
|
||||
(defonce evaluated i32 0)
|
||||
(defonce caught i32 0)
|
||||
(defonce seen string "")
|
||||
|
||||
(defn arg [x i32] i32
|
||||
(set evaluated (+ evaluated 1))
|
||||
x)
|
||||
|
||||
(defn try-call [f (CFn [i32] i32) x i32] ()
|
||||
(restart-case
|
||||
(do (print (f (arg x))) (println ""))
|
||||
(continue [] (println "empty"))))
|
||||
|
||||
(defn main [args [string]] i32
|
||||
(set (at table 0) double)
|
||||
(set (at table 2) negate)
|
||||
(let [ops (Ops {.name "half-built"})]
|
||||
(if (> (length args) 1)
|
||||
;; Unanswered: the process dies at the call.
|
||||
(do (print ((at table 1) 5)) (println "") 0)
|
||||
(do
|
||||
(handler-bind
|
||||
[(NullCall [c]
|
||||
(set caught (+ caught 1))
|
||||
(set seen (.type c))
|
||||
(invoke-restart 'continue))]
|
||||
(dotimes [i 3] (try-call (at table i) 7)) ; 14, empty, -7
|
||||
(try-call (.run ops) 1) ; empty
|
||||
(try-call hook 2) ; empty
|
||||
(set hook double)
|
||||
(try-call hook 2)) ; 4
|
||||
;; The argument of a call that is not made is never evaluated.
|
||||
(print evaluated) (println "") ; 3
|
||||
(print caught) (println "") ; 3
|
||||
(println seen) ; (CFn [i32] i32)
|
||||
;; And a filled field calls as any CFn does.
|
||||
(let [full (Ops {.name "full" .run negate})]
|
||||
(print ((.run full) 9)) (println "")) ; -9
|
||||
0))))
|
||||
@ -9,10 +9,8 @@
|
||||
;; the collector and may be kept anywhere, and (Option (Fn ...)) is the field
|
||||
;; that holds one — see fn-escape.flan.
|
||||
;;
|
||||
;; Which means a (CFn ...) field is refused too, and for the zero alone —
|
||||
;; a table of function pointers is exactly what that type is for, and nothing
|
||||
;; about capture stands in its way. An (Option (CFn ...)) field is already
|
||||
;; legal and is the shape that works; TODO.org, "CFn in a struct or a fixed array", carries the rest as its own item.
|
||||
;; A (CFn ...) field is not refused: every call through one tests for null and
|
||||
;; signals NullCall, so its zero is an empty slot — fn-cfn-table.flan.
|
||||
(defstruct Ops [run (Fn [i32] i32)])
|
||||
|
||||
(defn main [] i32 0)
|
||||
|
||||
35
test/programs/grow-param.flan
Normal file
35
test/programs/grow-param.flan
Normal file
@ -0,0 +1,35 @@
|
||||
;;;; A container parameter is a copy of the caller's header. Growing it grows
|
||||
;;;; the copy, so the caller's container does not see the push; the function
|
||||
;;;; is warned at, at the parameter, and the fix it names is the (Ptr ...)
|
||||
;;;; below, which reaches the caller's own header. A struct passed by value
|
||||
;;;; is a copy too, with its Vec fields in it, and is warned at the same way.
|
||||
|
||||
(defstruct Bag [items (Vec i32) n i32])
|
||||
(defstruct Box [bag Bag])
|
||||
|
||||
(defn add-copy [v (Vec i32)] () (push v 1) (free v))
|
||||
(defn add-ptr [v (Ptr (Vec i32))] () (push (deref v) 2))
|
||||
(defn put-ptr [m (Ptr (Map i32 i32))] () (put (deref m) 7 8))
|
||||
(defn bag-copy [b Bag] () (push (.items b) 1) (free (.items b)))
|
||||
(defn bag-ptr [x (Ptr Box)] () (push (.items (.bag x)) 3))
|
||||
|
||||
(defn main [] i32
|
||||
(let [v (vec-new i32)
|
||||
m (map-new i32 i32)]
|
||||
(add-copy v)
|
||||
(println (length v)) ; 0
|
||||
(add-ptr (addr v))
|
||||
(add-ptr (addr v))
|
||||
(println (length v)) ; 2
|
||||
(println (at v 1)) ; 2
|
||||
(put-ptr (addr m))
|
||||
(println (length m)) ; 1
|
||||
(free v)
|
||||
(free m))
|
||||
(let [x (Box {.bag (Bag {.items (vec-new i32) .n 0})})]
|
||||
(bag-copy (.bag x))
|
||||
(println (length (.items (.bag x)))) ; 0
|
||||
(bag-ptr (addr x))
|
||||
(println (at (.items (.bag x)) 0)) ; 3
|
||||
(free (.items (.bag x))))
|
||||
0)
|
||||
22
test/programs/into-owning.flan
Normal file
22
test/programs/into-owning.flan
Normal file
@ -0,0 +1,22 @@
|
||||
;;;; into over elements that own storage. Without a (map f) in the chain the
|
||||
;;;; elements are pushed as they stand, which copies their headers and shares
|
||||
;;;; their blocks — so that is refused, and (map clone) is the copy that
|
||||
;;;; compiles. The outer Vecs are in an arena, as a container of owning
|
||||
;;;; elements has to be; the inner ones are on the heap, where growing one
|
||||
;;;; through a shared header would free the block the other still points at.
|
||||
|
||||
(defn main [] i32
|
||||
(let [a (arena-new 65536)
|
||||
v (vec-new (Vec i32) a)]
|
||||
(push v (vec-new i32))
|
||||
(push (at v 0) 1)
|
||||
(let [w (into v (vec-new (Vec i32) a) (map clone))]
|
||||
(dotimes [i 100] (push (at w 0) i))
|
||||
(println (at (at v 0) 0)) ; 1
|
||||
(println (length (at v 0))) ; 1
|
||||
(println (length (at w 0))) ; 101
|
||||
(println (at (at w 0) 100)) ; 99
|
||||
(free (at w 0)))
|
||||
(free (at v 0))
|
||||
(arena-destroy a)
|
||||
0))
|
||||
22
test/programs/prelude-names.flan
Normal file
22
test/programs/prelude-names.flan
Normal file
@ -0,0 +1,22 @@
|
||||
;;;; A program's names do not change what the prelude means. The prelude's
|
||||
;;;; generics write their type variable bare, (vec-new t), and name
|
||||
;;;; parameters t, k and v; a global or a type the program declares under one
|
||||
;;;; of those names is the program's, and the prelude's own reading stands.
|
||||
|
||||
(defonce t [4 i32])
|
||||
(defstruct k [x i32])
|
||||
(defenum v [lo hi])
|
||||
|
||||
(defn even? [x i32] bool (= (% x 2) 0))
|
||||
|
||||
(defn main [] i32
|
||||
(set (at t 0) 7)
|
||||
(let [xs [1 2 3 4 5 6]
|
||||
evens (filter (slice xs) even?)]
|
||||
(println (length evens)) ; 3
|
||||
(println (at evens 2)) ; 6
|
||||
(free evens))
|
||||
(println (at t 0)) ; 7
|
||||
(println (.x (k {.x 5}))) ; 5
|
||||
(println (i32 (v 1))) ; 1
|
||||
0)
|
||||
14
test/programs/shadow-prelude-global.flan
Normal file
14
test/programs/shadow-prelude-global.flan
Normal file
@ -0,0 +1,14 @@
|
||||
;;;; A program's global named as a prelude function takes the name over for
|
||||
;;;; its own file, as a program's function does, and the prelude's own calls
|
||||
;;;; keep the prelude's: sort still swaps with the prelude's swap.
|
||||
(defonce swap i32 3)
|
||||
(defonce clamp i32 4)
|
||||
(defconst reverse i32 5)
|
||||
|
||||
(defn main [] i32
|
||||
(println (+ swap clamp reverse)) ; 12
|
||||
(let [xs [3 1 2]]
|
||||
(sort (slice xs))
|
||||
(println (at xs 0)) ; 1
|
||||
(println (at xs 2))) ; 3
|
||||
0)
|
||||
@ -1,13 +1,23 @@
|
||||
;;;; A program's function named as a prelude function takes the name over for
|
||||
;;;; the calls in its own file, and the prelude's own calls keep the prelude's:
|
||||
;;;; ceil-f32 is written over the prelude's floor-f32, and still answers 3.
|
||||
;;;; A prelude macro is taken over the same way: clamp and update below are
|
||||
;;;; the program's functions, and format-f64, which the prelude writes with
|
||||
;;;; its own clamp, still clamps its precision to 9.
|
||||
(defn abs-f32 [v f32] f32 (if (< v 0.0) (- v) (+ v (f32 100.0))))
|
||||
(defn floor-f32 [x f32] f32 (f32 999.0))
|
||||
(defn abs [x i32] i32 (* x 10))
|
||||
(defn clamp [x i32 lo i32 hi i32] i32 (+ x lo hi))
|
||||
(defn update [x i32] i32 (* x 7))
|
||||
(defn main [] i32
|
||||
(println (abs-f32 (f32 -2.5)))
|
||||
(println (abs-f32 (f32 2.5)))
|
||||
(println (floor-f32 (f32 2.3)))
|
||||
(println (ceil-f32 (f32 2.3)))
|
||||
(println (abs -3))
|
||||
(println (clamp 1 2 3))
|
||||
(println (update 6))
|
||||
(let [s (format-f64 0.5 40)]
|
||||
(println (length s))
|
||||
(free s))
|
||||
0)
|
||||
|
||||
55
test/programs/update-place.flan
Normal file
55
test/programs/update-place.flan
Normal file
@ -0,0 +1,55 @@
|
||||
;;;; update, ++ and -- evaluate every subexpression of their place once, as
|
||||
;;;; C's compound assignment does. `calls` counts the index function: one call
|
||||
;;;; per form, and the read and the write land on the same element.
|
||||
|
||||
(defonce calls i32 0)
|
||||
|
||||
(defn next-index [] i32
|
||||
(set calls (+ calls 1))
|
||||
(- calls 1))
|
||||
|
||||
(defstruct Body [velocity i32 hits [3 i32]])
|
||||
|
||||
(defn add [x i32 y i32] i32 (+ x y))
|
||||
|
||||
(defclass counter [n i32])
|
||||
|
||||
(defn which-slot [] dyn
|
||||
(set calls (+ calls 1))
|
||||
:n)
|
||||
|
||||
(defn main [] i32
|
||||
(let [xs [10 20 30]
|
||||
v (vec-new i32)
|
||||
g (Body {.velocity 5})]
|
||||
(push v 1) (push v 2) (push v 3)
|
||||
;; next-index answers 0, then 1, then 2.
|
||||
(++ (at xs (next-index)))
|
||||
(-- (at v (next-index)))
|
||||
(update (at xs (next-index)) * 3)
|
||||
(println calls) ; 3
|
||||
(println (at xs 0) (at xs 1) (at xs 2)) ; 11 20 90
|
||||
(println (at v 0) (at v 1) (at v 2)) ; 1 1 3
|
||||
;; A field, with a macro as the function, and with arguments after it.
|
||||
(update (.velocity g) inc)
|
||||
(update (.velocity g) add 10)
|
||||
(println (.velocity g)) ; 16
|
||||
;; A path through a field into an element: the struct is written in place,
|
||||
;; not in a copy.
|
||||
(set calls 0)
|
||||
(update (at (.hits g) (next-index)) + 7)
|
||||
(++ (at (.hits g) (next-index)))
|
||||
(println calls) ; 2
|
||||
(println (at (.hits g) 0) (at (.hits g) 1)) ; 7 1
|
||||
;; Through a pointer.
|
||||
(let [p (addr (.velocity g))]
|
||||
(update (deref p) * 2)
|
||||
(println (.velocity g))) ; 32
|
||||
(free v))
|
||||
;; A class slot, with the key computed once.
|
||||
(let [c (counter 4)]
|
||||
(set calls 0)
|
||||
(++ (get c (which-slot)))
|
||||
(update (get c (which-slot)) * 10)
|
||||
(println calls (get c :n))) ; 2 50
|
||||
0)
|
||||
@ -432,6 +432,13 @@ let () =
|
||||
match_enum_out;
|
||||
outputs ~dev:true "match over an enum, dev" "programs/match-enum.flan"
|
||||
match_enum_out;
|
||||
(* update, ++ and -- evaluate their place's subexpressions once: the
|
||||
counts are the number of calls an index or a key function got. *)
|
||||
let update_out = "3\n11 20 90\n1 1 3\n16\n2\n7 1\n32\n2 50\n" in
|
||||
outputs "update evaluates its place once" "programs/update-place.flan"
|
||||
update_out;
|
||||
outputs ~x86:true "update evaluates its place once, --x86"
|
||||
"programs/update-place.flan" update_out;
|
||||
(* The count is [length] so that [len] is left to programs, and this is
|
||||
the claim that it really is one: a local holding a count, a
|
||||
parameter, and a defn the program calls by its bare name, all of
|
||||
@ -581,10 +588,15 @@ let () =
|
||||
"programs/array-mixed.flan" mixed_out;
|
||||
(* A program's function named as a prelude function takes the name over
|
||||
for its own file; the prelude's own calls keep the prelude's. *)
|
||||
let sp_out = "2.5\n102.5\n999\n3\n-30\n" in
|
||||
let sp_out = "2.5\n102.5\n999\n3\n-30\n6\n42\n11\n" in
|
||||
outputs "a prelude function shadowed" "programs/shadow-prelude.flan" sp_out;
|
||||
outputs ~x86:true "a prelude function shadowed, x86"
|
||||
"programs/shadow-prelude.flan" sp_out;
|
||||
(* And by a program's global, the same way. *)
|
||||
outputs "a prelude function shadowed by a global"
|
||||
"programs/shadow-prelude-global.flan" "12\n1\n3\n";
|
||||
outputs ~x86:true "a prelude function shadowed by a global, x86"
|
||||
"programs/shadow-prelude-global.flan" "12\n1\n3\n";
|
||||
(* (max-value T) and (min-value T), concrete and inside a generic. *)
|
||||
let maxof_out =
|
||||
"255\n0\n127\n-128\n2147483647\n-9223372036854775808\n\
|
||||
@ -613,6 +625,20 @@ let () =
|
||||
source transformed in two orders, which have to differ. *)
|
||||
outputs "into" "programs/into.flan"
|
||||
"7 8 9 \n2 4 6 8 10 12 \n4 8 12 \n21\n6 2 4 \n3 1 2 \n3 4 \n2 4 \n1\n";
|
||||
(* The fix into's refusal names for owning elements, (map clone): the
|
||||
copy's inner Vec grows on the heap and the source's is untouched. *)
|
||||
(* Program names that spell the prelude's own leave the prelude alone. *)
|
||||
outputs "a program's names and the prelude's" "programs/prelude-names.flan"
|
||||
"3\n6\n7\n5\n1\n";
|
||||
outputs ~x86:true "a program's names and the prelude's, --x86"
|
||||
"programs/prelude-names.flan" "3\n6\n7\n5\n1\n";
|
||||
(* A grown container parameter reaches the caller only through a Ptr. *)
|
||||
outputs "a grown parameter" "programs/grow-param.flan" "0\n2\n2\n1\n0\n3\n";
|
||||
outputs ~x86:true "a grown parameter, --x86" "programs/grow-param.flan"
|
||||
"0\n2\n2\n1\n0\n3\n";
|
||||
outputs "into with (map clone)" "programs/into-owning.flan" "1\n1\n101\n99\n";
|
||||
outputs ~x86:true "into with (map clone), --x86" "programs/into-owning.flan"
|
||||
"1\n1\n101\n99\n";
|
||||
(* The prelude's slice algorithms. Every assertion here is over an input a
|
||||
wrong implementation fails: unsorted with duplicates, negatives and an
|
||||
odd length; a reverse-sorted slice; and a sort of a subslice whose
|
||||
@ -1947,7 +1973,7 @@ let () =
|
||||
let dyn_if_truthy_out =
|
||||
"falsey\nfalsey\ntruthy\ntruthy\ntruthy\ntruthy\ntruthy\ntruthy\ntruthy\n\
|
||||
truthy\ntruthy\ntruthy\nwhen 0 ran\nwhen empty-string ran\nb\nb\n\
|
||||
:kw\nfalse\nnil\n\n0\nfalse\nx\n5\n\
|
||||
:kw\nfalse\nnil\n\n0\nfalse\nx\n5\ns\nnil\nnil\ny\ntrue\n\
|
||||
nil\n\nnil\n0\ntrue\nfalse\n\
|
||||
nil\nand-reached\n2\n7\nor-reached\n1\n\
|
||||
and-decider\nnil\nor-decider\n9\n\
|
||||
@ -4197,6 +4223,11 @@ level "1"
|
||||
lo\nmid\nhi\nother\n"
|
||||
in
|
||||
outputs "enum conversion" "programs/enum-convert.flan" enum_conv_out;
|
||||
(* The generic enum-to-number conversion enum? licenses. *)
|
||||
outputs "a generic enum conversion" "programs/enum-generic.flan"
|
||||
"2\n20\ntrue\ntrue\n20\n";
|
||||
outputs ~x86:true "a generic enum conversion, --x86"
|
||||
"programs/enum-generic.flan" "2\n20\ntrue\ntrue\n20\n";
|
||||
outputs ~opt:"-O0" "enum conversion, -O0" "programs/enum-convert.flan"
|
||||
enum_conv_out;
|
||||
|
||||
@ -4691,6 +4722,35 @@ level "1"
|
||||
outputs ~dev:true "the two function types, dev" "programs/fn-cfn.flan"
|
||||
fn_ptr_out;
|
||||
|
||||
(* A CFn in a struct field, a fixed array and a global, each zeroed until
|
||||
stored into. A call through an empty one signals NullCall, before its
|
||||
arguments run; answered, the program carries on, and unanswered it dies
|
||||
naming the site and the type — on both backends. *)
|
||||
let cfn_table_out =
|
||||
"14\nempty\n-7\nempty\nempty\n4\n3\n3\n(CFn [i32] i32)\n-9\n"
|
||||
in
|
||||
outputs "a CFn table" "programs/fn-cfn-table.flan" cfn_table_out;
|
||||
outputs ~x86:true "a CFn table, --x86" "programs/fn-cfn-table.flan"
|
||||
cfn_table_out;
|
||||
outputs ~dev:true "a CFn table, dev" "programs/fn-cfn-table.flan"
|
||||
cfn_table_out;
|
||||
List.iter
|
||||
(fun x86 ->
|
||||
let exe = compile ~x86 "programs/fn-cfn-table.flan" in
|
||||
let code, text = run exe (Some "1") in
|
||||
if code <> 134
|
||||
|| not (contains text "programs/fn-cfn-table.flan:")
|
||||
|| not (contains text "this call is through a (CFn [i32] i32) \
|
||||
that holds no function")
|
||||
then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL an unanswered empty CFn call dies%s\n \
|
||||
got: %S (exit %d)\n"
|
||||
(if x86 then ", --x86" else "") text code
|
||||
end;
|
||||
(try Sys.remove exe with Sys_error _ -> ()))
|
||||
[ false; true ];
|
||||
|
||||
(* Two signatures that flatten to one string under [mangle_ty], which is
|
||||
how the thunk memo used to be keyed. Keyed on the name, the second
|
||||
widening reuses the first's thunk at the wrong arity — a miscompile
|
||||
@ -4946,6 +5006,17 @@ level "1"
|
||||
"(defn main [] i32 (++) 0)" "++-takes-one-place";
|
||||
macro_arity "-- with two arguments"
|
||||
"(defn main [] i32 (let [a 1 b 2] (-- a b)) 0)" "---takes-one-place";
|
||||
macro_arity "update with no function"
|
||||
"(defn main [] i32 (let [a 1] (update a)) 0)"
|
||||
"update-takes-a-place-and-a-function";
|
||||
(* A place update takes is a place set takes, and is refused the same way. *)
|
||||
macro_arity "update of something that is not a place"
|
||||
"(defn main [] i32 (update 5 inc) 0)" "5 is not assignable";
|
||||
macro_arity "update of a parameter"
|
||||
"(defn f [a i32] () (update a inc))" "a is a parameter";
|
||||
macro_arity "update whose function answers the wrong type"
|
||||
"(defn yes [x i32] bool true)\n(defn f [] () (let [a 1] (update a yes)))"
|
||||
"expected i32";
|
||||
(* unless keeps a guard, and it is now the narrower one: a body may be
|
||||
missing, a test may not. *)
|
||||
macro_arity "unless with no test at all"
|
||||
@ -7140,6 +7211,9 @@ level "1"
|
||||
(let code, text = cli "check programs/shadow-prelude.flan" in
|
||||
if code <> 0 || contains text "prelude~"
|
||||
|| not (contains text "defn floor-f32")
|
||||
(* A macro taken over is warned about as a function is. *)
|
||||
|| not (contains text "clamp shadows the prelude's clamp")
|
||||
|| not (contains text "update shadows the prelude's update")
|
||||
then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
|
||||
@ -2376,6 +2376,88 @@ let () =
|
||||
pointer: the bytes-view write that first crashed no longer compiles. *)
|
||||
trap_park ~refault:true "segfault" "dev-segv.flan" "SegFault" [];
|
||||
|
||||
(* ── A break over a call through a null CFn ─────────────────────────
|
||||
|
||||
NullCall is a condition, signalled as a bad index is: nothing handles
|
||||
it in dev-break-nullcall.flan, so the program parks with NullCall
|
||||
named, the program's own continue on offer and takeable, and taking it
|
||||
resumes — the transcript's 1 is continue's clause having run. On both
|
||||
backends, since the null test before the call is emitted by each. *)
|
||||
let null_park backend =
|
||||
let nsock = tmp ("nullcall" ^ backend ^ ".sock")
|
||||
and nout = tmp ("nullcall" ^ backend ^ ".out") in
|
||||
(try Sys.remove nsock with Sys_error _ -> ());
|
||||
let nfd =
|
||||
Unix.openfile nout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
|
||||
in
|
||||
let npid =
|
||||
Unix.create_process flan
|
||||
[| flan; "dev"; "programs/dev-break-nullcall.flan"; "-s"; nsock; backend |]
|
||||
Unix.stdin nfd Unix.stderr
|
||||
in
|
||||
Unix.close nfd;
|
||||
if not (listening ~pid:npid nsock) then begin
|
||||
fail "the null-call daemon (%s) %s" backend !listen_why;
|
||||
(try Unix.kill npid Sys.sigkill with Unix.Unix_error _ -> ())
|
||||
end
|
||||
else begin
|
||||
let out = Buffer.create 64 in
|
||||
let c = connect nsock in
|
||||
let ask sexp =
|
||||
let r = Wire.parse (Wire.send c sexp; Wire.recv c) in
|
||||
(match Wire.string_field r "output" with
|
||||
| Some t -> Buffer.add_string out t
|
||||
| None -> ());
|
||||
r
|
||||
in
|
||||
let stopped r =
|
||||
match Wire.field r "stopped" with
|
||||
| Some { Form.v = Form.Sym "t"; _ } -> true
|
||||
| _ -> false
|
||||
in
|
||||
let last = ref (Wire.parse "()") in
|
||||
if not (await (fun () -> last := ask "(:op \"describe\")"; stopped !last))
|
||||
then fail "a null CFn call never stopped the program (%s)" backend
|
||||
else begin
|
||||
(match Wire.string_field !last "condition" with
|
||||
| Some "NullCall" -> ()
|
||||
| c ->
|
||||
fail "a null CFn call is reported as %S (%s)"
|
||||
(Option.value ~default:"" c) backend);
|
||||
let r = ask "(:op \"break\")" in
|
||||
(match Wire.field r "restarts" with
|
||||
| Some { Form.v = Form.List l; _ }
|
||||
when List.exists
|
||||
(fun (n : Form.t) -> n.Form.v = Form.Str "continue") l -> ()
|
||||
| _ -> fail "a null CFn call offers no continue (%s)" backend);
|
||||
let r = ask "(:op \"restart\" :name \"continue\")" in
|
||||
if status r <> "ok" then
|
||||
fail "continuing past a null CFn call (%s): %s" backend
|
||||
(Option.value ~default:"" (Wire.string_field r "message"));
|
||||
if not
|
||||
(await (fun () ->
|
||||
ignore (ask "(:op \"describe\")");
|
||||
List.mem "1"
|
||||
(String.split_on_char '\n' (Buffer.contents out))))
|
||||
then fail "the program never resumed past a null CFn call (%s)" backend
|
||||
end;
|
||||
ignore (ask "(:op \"close\")");
|
||||
Unix.close c;
|
||||
if not
|
||||
(await ~ms:5000 (fun () ->
|
||||
match Unix.waitpid [ Unix.WNOHANG ] npid with
|
||||
| 0, _ -> false
|
||||
| _ -> true
|
||||
| exception Unix.Unix_error _ -> true))
|
||||
then begin
|
||||
(try Unix.kill npid Sys.sigkill with Unix.Unix_error _ -> ());
|
||||
(try ignore (Unix.waitpid [] npid) with Unix.Unix_error _ -> ())
|
||||
end
|
||||
end
|
||||
in
|
||||
null_park "--llvm";
|
||||
null_park "--x86";
|
||||
|
||||
(* ── The locals of a stopped frame ─────────────────────────────── *)
|
||||
|
||||
(* A third daemon, over a program that stops with something worth looking
|
||||
@ -2731,6 +2813,21 @@ let () =
|
||||
want "box" "(some)" "Point" "(Point {.x 4.5 .y 5.5})";
|
||||
want "box" "(some \"x\")" "f32" "4.5";
|
||||
want "s" "(\"Shape.Rect.w\")" "i32" "3";
|
||||
(* A package's type is its qualified name, in the inspector and in
|
||||
the listing both, as a field's and a condition's already are:
|
||||
two packages may each declare a Box. *)
|
||||
want "pk" "()" "shape/Box" "(shape/Box {.w 3 .h 4})";
|
||||
(match Wire.field listing "locals" with
|
||||
| Some { Form.v = Form.List l; _ }
|
||||
when List.exists
|
||||
(fun (e : Form.t) ->
|
||||
match e.Form.v with
|
||||
| Form.List
|
||||
({ Form.v = Form.Str "pk"; _ }
|
||||
:: { Form.v = Form.Str "shape/Box"; _ } :: _) -> true
|
||||
| _ -> false)
|
||||
l -> ()
|
||||
| _ -> fail "the listing does not name pk's type as shape/Box");
|
||||
(* Where each value is stored. The struct and its first field share
|
||||
an address and the second field is one f32 further on, so the
|
||||
number is the layout's and not a label. *)
|
||||
|
||||
@ -3190,6 +3190,45 @@ let () =
|
||||
rejects_check "clone on a slice of owning elements"
|
||||
"(defn f [v [(Vec i32)]] i32 (length (clone v)))"
|
||||
~needle:"[(Vec i32)] cannot be cloned";
|
||||
(* into with no (map f) pushes the source's elements as they stand, which
|
||||
for an owning element shares its block — pushing through the copy then
|
||||
frees the source's. The fix it names is programs/into-owning.flan. *)
|
||||
rejects_check "into copying owning elements, refused at the source"
|
||||
"(defn f [a Allocator] i32\n\
|
||||
\ (let [v (vec-new (Vec i32) a)\n\
|
||||
\ w (into v (vec-new (Vec i32) a) (filter nonempty?))] (length w)))\n\
|
||||
(defn nonempty? [x (Vec i32)] bool (> (length x) 0))"
|
||||
~needle:"into copies each element of v as it stands, and an element of v \
|
||||
is a (Vec i32), which owns storage — the copy would share each \
|
||||
element's block with v, and growing either one frees the block \
|
||||
the other points at. Add (map clone) to the chain, which copies \
|
||||
what each element owns: (into v (vec-new (Vec i32) a) (filter \
|
||||
nonempty?) (map clone))";
|
||||
accepts "into with (map clone) over owning elements"
|
||||
"(defn f [a Allocator] i32\n\
|
||||
\ (let [v (vec-new (Vec i32) a)\n\
|
||||
\ w (into v (vec-new (Vec i32) a) (map clone))] (length w)))";
|
||||
accepts "into of plain elements is untouched"
|
||||
"(defn f [v [i32]] () (let [w (into v (vec-new i32))] (free w)))";
|
||||
rejects_check "into copying elements clone cannot copy, explained"
|
||||
"(defstruct B [xs (Vec i32)])\n\
|
||||
(defn f [v [B] a Allocator] i32 (let [w (into v (vec-new B a))] (length w)))"
|
||||
~needle:"Nothing copies what a B owns, so no copy of v can stand on its \
|
||||
own";
|
||||
rejects_check "clone's refusal names a clone of each element"
|
||||
"(defn f [v [(Vec i32)]] i32 (length (clone v)))"
|
||||
~needle:"push a (clone x) of each element into it";
|
||||
(* A program's names cannot change what the prelude means: a global or a
|
||||
type spelled like a built-in type is refused where it is declared, and
|
||||
the rest are programs/prelude-names.flan. *)
|
||||
rejects_check "a global named like a built-in type"
|
||||
"(defonce u8 i32)"
|
||||
~needle:"u8 is a type, so it cannot also name a global";
|
||||
rejects_check "a type named like a built-in type"
|
||||
"(defstruct i32 [x i32])"
|
||||
~needle:"i32 is a built-in type, so it cannot be declared again";
|
||||
accepts "a global and a type named after the prelude's type variables"
|
||||
"(defonce t [4 i32])\n(defstruct k [x i32])\n(defenum v [lo hi])";
|
||||
accepts "clone on a slice, with and without an allocator"
|
||||
"(defn f [v [f64] a Allocator] i32 (+ (length (clone v)) (length (clone v a))))";
|
||||
|
||||
@ -3569,6 +3608,23 @@ let () =
|
||||
"(defn h [x i32] i32 x) (defn g [i i32] (Fn [i32] i32) h)\n\
|
||||
(defn f [] i32 (let [a (array-gen [2] g)] 0))"
|
||||
~needle:"a fixed array's element cannot be (Fn [i32] i32)";
|
||||
(* A (CFn ...) is not refused in any of them: a call through one tests for
|
||||
null and signals NullCall, so its zero is an empty slot. *)
|
||||
accepts "a CFn struct field"
|
||||
"(defstruct Ops [run (CFn [i32] i32)])\n\
|
||||
(defn f [o Ops] i32 ((.run o) 1))";
|
||||
accepts "a fixed array of CFn"
|
||||
"(defonce tbl [4 (CFn [i32] i32)])\n(defn f [] i32 ((at tbl 0) 1))";
|
||||
accepts "a CFn global with no initialiser"
|
||||
"(defonce hook (CFn [] ()))\n(defn f [] () (hook))";
|
||||
accepts "(zeroed) at a CFn"
|
||||
"(defn f [] i32 (let [g (the (CFn [i32] i32) (zeroed))] (g 1)))";
|
||||
accepts "an array-gen of CFn"
|
||||
"(defn h [x i32] i32 x) (defn g [i i32] (CFn [i32] i32) h)\n\
|
||||
(defn f [] i32 (let [a (array-gen [2] g)] ((at a 1) 3)))";
|
||||
rejects_check "an Fn struct field is still refused"
|
||||
"(defstruct Ops [run (Fn [i32] i32)])"
|
||||
~needle:"the field run cannot be (Fn [i32] i32)";
|
||||
|
||||
(* The inline form, the design's canonical one. An fn normally takes its
|
||||
types from a (Fn ...) want, and this position has none — the *form*
|
||||
@ -5639,6 +5695,42 @@ let () =
|
||||
rejects_check "and offers no comparison at all for a type that has none"
|
||||
"(defstruct P [x i32]) (defn f [] i32 (let [p (P {.x 1})] (if p 1 0)))"
|
||||
~needle:"a condition is a bool or a dyn, and this is P";
|
||||
(* A deep nest of not over a condition that is refused. Each level retries
|
||||
the level below it for its message, and a refusal already settled is
|
||||
answered from memory, so two hundred levels fail at once — re-walking
|
||||
each subtree doubled the work per level. The message is the innermost
|
||||
condition's, as it is at one level. *)
|
||||
(let deep =
|
||||
let rec nest k e = if k = 0 then e else nest (k - 1) ("(not " ^ e ^ ")") in
|
||||
"(defn g [x i32] bool " ^ nest 200 "x" ^ ")"
|
||||
in
|
||||
let t0 = Unix.gettimeofday () in
|
||||
match checked deep with
|
||||
| _ -> check "a deep not nest over an i32 is refused" false
|
||||
| exception Loc.Error { Loc.dmsg; _ } ->
|
||||
check "a deep not nest over an i32 fails fast"
|
||||
(Unix.gettimeofday () -. t0 < 3.0);
|
||||
check "a deep not nest keeps the one-level message"
|
||||
(dmsg = "a condition is a bool or a dyn, and this is i32 — test it, as \
|
||||
(!= x 0)"));
|
||||
(* A long or chain refused at its last operand, with nothing expected of it.
|
||||
Each if tries its else arm on its own terms before checking it at bool,
|
||||
and a refused if is answered from memory, so a thousand operands fail
|
||||
at once rather than in the square of that. *)
|
||||
(let deep =
|
||||
"(defn g [x i32] bool (let [b (or "
|
||||
^ String.concat " " (List.init 1000 (Printf.sprintf "(= x %d)"))
|
||||
^ " 5)] b))"
|
||||
in
|
||||
(* Timed rather than under [Watchdog.within]: a catch-all inside the
|
||||
checker can swallow the alarm's exception. *)
|
||||
let t0 = Unix.gettimeofday () in
|
||||
match checked deep with
|
||||
| _ -> check "a refused or chain is refused" false
|
||||
| exception Loc.Error { Loc.dmsg; _ } ->
|
||||
check "a refused or chain fails fast" (Unix.gettimeofday () -. t0 < 3.0);
|
||||
check "a refused or chain keeps the one-operand message"
|
||||
(dmsg = "expected bool, found the integer literal 5"));
|
||||
(* A literal still names itself: that message knows something the rule does
|
||||
not, so the re-check's answer is kept wherever it is more specific. *)
|
||||
rejects_check "a literal condition keeps its own message"
|
||||
@ -5754,6 +5846,97 @@ let () =
|
||||
(match checked shadow_src with
|
||||
| _ -> true
|
||||
| exception Loc.Error _ -> false);
|
||||
(* A parameter vector paired by a lowercase type the program declares reads
|
||||
as two dyn parameters the day the type goes, so the pairing is warned at,
|
||||
naming the type and where it is declared. A capitalised type cannot be a
|
||||
parameter name, so it has nothing to warn about. *)
|
||||
(match
|
||||
checked "(defstruct point [x i32])\n(defstruct Vec2 [x i32])\n\
|
||||
(defn px [p point] i32 (.x p))\n(defn vx [v Vec2] i32 (.x v))"
|
||||
with
|
||||
| _ ->
|
||||
(match !Check.pairing_warnings with
|
||||
| [ d ] ->
|
||||
check "a lowercase declared type in a parameter vector is warned at"
|
||||
(d.Loc.kind = "check/parameter-reads-a-type"
|
||||
&& d.Loc.dloc.Loc.line = 3 && d.Loc.dloc.Loc.col = 13
|
||||
&& d.Loc.dmsg
|
||||
= "[p point] is one parameter p of type point, the struct \
|
||||
declared at <test>:1:1, and not two dyn parameters. If two \
|
||||
were meant, give the second a name no type has")
|
||||
| ds ->
|
||||
check
|
||||
(Printf.sprintf "one pairing warning, not %d" (List.length ds))
|
||||
false)
|
||||
| exception Loc.Error _ -> check "the paired program checks" false);
|
||||
(* A Vec or Map parameter is the caller's header copied, so growing it is
|
||||
warned at the parameter, once, naming the (Ptr ...) that reaches the
|
||||
caller's own. A pointer parameter and a local are not warned at. The
|
||||
running side is programs/grow-param.flan. *)
|
||||
let grown src =
|
||||
match checked src with
|
||||
| _ -> Some !Check.grow_warnings
|
||||
| exception Loc.Error _ -> None
|
||||
in
|
||||
(match
|
||||
grown "(defn f [v (Vec i32) m (Map i32 i32)] ()\n\
|
||||
\ (push v 1) (reserve v 8) (put m 1 2))"
|
||||
with
|
||||
| Some [ dm; dv ] ->
|
||||
check "a grown Vec parameter is warned at the parameter"
|
||||
(dv.Loc.kind = "check/grown-parameter"
|
||||
&& dv.Loc.dloc.Loc.line = 1 && dv.Loc.dloc.Loc.col = 10
|
||||
&& dv.Loc.dmsg
|
||||
= "v is a (Vec i32) passed by value, a copy of the caller's header, \
|
||||
so the push at <test>:2:3 grows this function's copy and the \
|
||||
caller's container never sees it. Take it as (Ptr (Vec i32)) \
|
||||
and write (push (deref v) ...), and each caller passes (addr c) \
|
||||
for its container c");
|
||||
check "and a grown Map parameter names put"
|
||||
(dm.Loc.dloc.Loc.col = 22
|
||||
&& Test_support.contains dm.Loc.dmsg "the put at <test>:2:28")
|
||||
| Some ds ->
|
||||
check (Printf.sprintf "two grow warnings, not %d" (List.length ds)) false
|
||||
| None -> check "the grown-parameter program checks" false);
|
||||
(* A struct parameter is a copy with its Vec fields in it, through any
|
||||
depth of fields taken by value; through a pointer, not. *)
|
||||
(match
|
||||
grown "(defstruct Bag [items (Vec i32)])\n(defstruct Box [bag Bag])\n\
|
||||
(defn f [x Box] () (push (.items (.bag x)) 1))\n\
|
||||
(defn g [x (Ptr Box)] () (push (.items (.bag x)) 1))"
|
||||
with
|
||||
| Some [ d ] ->
|
||||
check "a grown field of a struct parameter is warned at the parameter"
|
||||
(d.Loc.dloc.Loc.line = 3 && d.Loc.dloc.Loc.col = 10
|
||||
&& d.Loc.dmsg
|
||||
= "x is a Box passed by value, a copy of the caller's, so the push \
|
||||
at <test>:3:20 grows (.items (.bag x)) in this function's copy \
|
||||
and the caller's never sees it. Take it as (Ptr Box), where \
|
||||
(.items (.bag x)) reaches the caller's own, and each caller \
|
||||
passes (addr c) for its Box c")
|
||||
| Some ds ->
|
||||
check (Printf.sprintf "one field grow warning, not %d" (List.length ds)) false
|
||||
| None -> check "the grown-field program checks" false);
|
||||
(* Not when the grown copy goes back to the caller — the parameter, or the
|
||||
struct holding the field, is what the function answers — nor when the
|
||||
field is given a container of the function's own before it grows. *)
|
||||
check "a grown parameter the function returns is not warned at"
|
||||
(grown "(defstruct Bag [items (Vec i32)])\n\
|
||||
(defn add [v (Vec i32) x i32] (Vec i32) (push v x) v)\n\
|
||||
(defn early [v (Vec i32) c bool] (Vec i32) (push v 1) \
|
||||
(when c (return v)) v)\n\
|
||||
(defn bag [b Bag] Bag (push (.items b) 1) b)\n\
|
||||
(defn items [b Bag] (Vec i32) (push (.items b) 1) (.items b))"
|
||||
= Some []);
|
||||
check "a field reassigned before it grows is not warned at"
|
||||
(grown "(defstruct Bag [items (Vec i32)])\n\
|
||||
(defn f [b Bag] ()\n\
|
||||
\ (set (.items b) (vec-new i32)) (push (.items b) 1) (free (.items b)))"
|
||||
= Some []);
|
||||
check "a pointer parameter and a local are not warned at"
|
||||
(grown "(defn f [v (Ptr (Vec i32))] ()\n\
|
||||
\ (push (deref v) 1) (let [w (vec-new i32)] (push w 1) (free w)))"
|
||||
= Some []);
|
||||
check "a program that shadows nothing is warned at not at all"
|
||||
(Check.shadowed_builtins (program "(defn f [] i32 1)") = []);
|
||||
(* A prelude function's name is taken over the same way, for the calls in
|
||||
@ -5772,6 +5955,20 @@ let () =
|
||||
| _ -> check "a defn of a prelude function's name warns exactly once" false);
|
||||
accepts "a defn of a prelude function's name is not defined twice"
|
||||
prelude_src;
|
||||
(* A global takes the name over the same way, with the same warning. *)
|
||||
(match
|
||||
snd (Check.shadow_prelude (Parse.program (Prelude.forms ()))
|
||||
(program "(defonce swap i32 3)"))
|
||||
with
|
||||
| [ d ] ->
|
||||
check "a global of a prelude function's name warns once"
|
||||
(d.Loc.kind = "check/shadows-prelude"
|
||||
&& d.Loc.dmsg
|
||||
= "swap shadows the prelude's swap — every use in this file now \
|
||||
reaches your definition")
|
||||
| _ -> check "a global of a prelude function's name warns exactly once" false);
|
||||
accepts "a global of a prelude function's name is not defined twice"
|
||||
"(defonce swap i32 3)\n(defn f [] i32 swap)";
|
||||
rejects_check "a struct of a prelude type's name is still defined twice"
|
||||
"(defstruct Form [x i32])" ~needle:"Form is defined twice";
|
||||
(* An operator is a builtin like any other and shadows like any other.
|
||||
@ -6145,7 +6342,8 @@ let () =
|
||||
and the message says which predicate to write. *)
|
||||
rejects_check "ordered? does not admit a conversion"
|
||||
~needle:"The where clause says t is ordered?, and that does not make it \
|
||||
a number — add (numeric? $t) to the where clause"
|
||||
a number or an enum — add (numeric? $t) to the where clause, or \
|
||||
(enum? $t) for an enum"
|
||||
"(defn to32 [x $t] i32 {:where (ordered? $t)} (i32 x))";
|
||||
rejects_check "nor does equal?"
|
||||
~needle:"add (numeric? $t) to the where clause"
|
||||
@ -6156,9 +6354,28 @@ let () =
|
||||
(* With no clause at all the message hands over the whole clause rather
|
||||
than a predicate to add to one that is not there. *)
|
||||
rejects_check "an unbounded variable does not convert"
|
||||
~needle:"i32 converts a number. Nothing here says t is a number — write \
|
||||
{:where (numeric? $t)} at the head of the body"
|
||||
~needle:"i32 converts a number or an enum. Nothing here says t is a \
|
||||
number or an enum — write {:where (numeric? $t)} at the head of \
|
||||
the body, or {:where (enum? $t)} for an enum"
|
||||
"(defn to32 [x $t] i32 (i32 x))";
|
||||
(* enum? is the other bound a conversion to a number takes: it admits the
|
||||
enums, which convert as an i32, and entails ordered? and equal? but not
|
||||
numeric?. The running side is programs/enum-generic.flan. *)
|
||||
accepts "enum? admits the conversion from an enum"
|
||||
"(defn code [x $t] i32 {:where (enum? $t)} (i32 x))";
|
||||
accepts "and compares, being ordered? and equal?"
|
||||
"(defn later? [a $t b $t] bool {:where (enum? $t)} (and (> a b) (= a b)))";
|
||||
rejects_check "but is not a number"
|
||||
~needle:"$t"
|
||||
"(defn sum [a $t b $t] $t {:where (enum? $t)} (+ a b))";
|
||||
rejects_check "and admits no integer at the call"
|
||||
~needle:"i32 is not enum?"
|
||||
"(defn code [x $t] i32 {:where (enum? $t)} (i32 x))\n\
|
||||
(defn f [] i32 (code (i32 3)))";
|
||||
rejects_check "nor the conversion to an enum, which needs an integer"
|
||||
~needle:"add (integer? $t) to the where clause"
|
||||
"(defenum K [lo -1 hi 1])\n\
|
||||
(defn as-k [n $t] K {:where (enum? $t)} (K n))";
|
||||
(* The operand of a cast to a *variable* target is asked the same question
|
||||
the target was: the target's bound says nothing about a second variable
|
||||
standing in the argument. *)
|
||||
|
||||
@ -64,6 +64,19 @@ let () =
|
||||
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
|
||||
sent alone, as the same defn does in a file. *)
|
||||
(let t, _ = Session.create ~file:"programs/reload.flan" () in
|
||||
match
|
||||
ignore (Session.eval t "(defn clamp [x i64] i64 (+ x 1))");
|
||||
Session.eval t "(defn clamped [] i64 (clamp 4))"
|
||||
with
|
||||
| c ->
|
||||
if not (List.mem "clamped" c.Session.fns) then
|
||||
fail "a call to a session's clamp installed %s"
|
||||
(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);
|
||||
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))";
|
||||
|
||||
@ -354,6 +354,9 @@ let () =
|
||||
reads "elif" "if a\n 1\nelif b\n 2\nelse\n 3" "(cond a 1 b 2 :else 3)";
|
||||
reads "one-line if" "x = if a then 1 else 2" "(set x (if a 1 2))";
|
||||
reads "assignment ops" "a[i] += 1" "(set (at a i) (+ (at a i) 1))";
|
||||
(* A place with a call in it is evaluated once: it reads as update. *)
|
||||
reads "assignment op over a call's place" "a[next()] += 1"
|
||||
"(update (at a (next)) + 1)";
|
||||
reads "for" "for :outer i in range(1, n)\n f(i)" "(dotimes :outer [i 1 n] (f i))";
|
||||
reads "unit statement" "restart-case\n f()\nrestart continue()\n ()"
|
||||
"(restart-case (f) (continue [] (do)))";
|
||||
@ -413,6 +416,8 @@ let () =
|
||||
| exception e -> fail "%s: %s" name (diag_text e)
|
||||
in
|
||||
prints "compound assignment" "(defn f [] () (set x (+ x 1)))" " x += 1";
|
||||
prints "compound update" "(defn f [] () (update (at a (next)) + 1))"
|
||||
" a[next()] += 1";
|
||||
prints "arm statements" "(defn f [] () (match s 1 (break) _ (return 2)))"
|
||||
"1 -> break\n _ -> return 2";
|
||||
prints "then and else statements" "(defn f [] () (if c (return 1) (set x 2)))"
|
||||
|
||||
@ -1277,13 +1277,14 @@ $t)} at the head of the body, or take the operation as a parameter — a
|
||||
<p>What makes that liveable is a <code>where</code> clause, written as a Clojure-style
|
||||
map at the head of the body — <code>{:where (ordered? $t)}</code>, or a vector when
|
||||
there is more than one: <code>{:where [(ordered? $t) (hashable? $u)]}</code>. There
|
||||
are five predicates, and each gates builtins the compiler already has:</p>
|
||||
are six predicates, and each gates builtins the compiler already has:</p>
|
||||
|
||||
<div class="scroll">
|
||||
<table>
|
||||
<tr><th>Predicate</th><th>What it admits</th></tr>
|
||||
<tr><td><code>integer?</code></td><td><code>bit-and</code> <code>bit-or</code> <code>bit-xor</code> <code><<</code> <code>>></code> — every integer type, no float</td></tr>
|
||||
<tr><td><code>numeric?</code></td><td><code>+</code> <code>-</code> <code>*</code> <code>/</code> <code>%</code>, and a cast <code>(t x)</code></td></tr>
|
||||
<tr><td><code>enum?</code></td><td>a cast to a number, <code>(i32 x)</code> — every enum type</td></tr>
|
||||
<tr><td><code>ordered?</code></td><td><code><</code> <code><=</code> <code>></code> <code>>=</code> <code>min</code> <code>max</code></td></tr>
|
||||
<tr><td><code>equal?</code></td><td><code>=</code> and <code>!=</code></td></tr>
|
||||
<tr><td><code>hashable?</code></td><td>the variable as a <code>Map</code> key — <code>(map-new t V)</code>, <code>get</code>, <code>put</code>, <code>has-key?</code></td></tr>
|
||||
@ -1292,7 +1293,8 @@ are five predicates, and each gates builtins the compiler already has:</p>
|
||||
|
||||
<p>They entail each other in one direction, so one clause usually does:
|
||||
<code>integer?</code> gives <code>numeric?</code>, <code>numeric?</code> gives
|
||||
<code>ordered?</code>, and <code>ordered?</code> gives <code>equal?</code>. A
|
||||
<code>ordered?</code>, and <code>ordered?</code> gives <code>equal?</code>;
|
||||
<code>enum?</code> gives <code>ordered?</code> too. A
|
||||
<code>sort</code> that compares its elements declares <code>ordered?</code> and
|
||||
nothing else, and the prelude's <code>abs</code> declares <code>integer?</code>
|
||||
alone — the bound is what keeps its integer body away from the floats, whose
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user