Six small refusals and conversions say what the program wrote
This commit is contained in:
commit
00f116ea29
81
TODO.org
81
TODO.org
@ -73,11 +73,13 @@ is wrong where it was written rather than aborting the compile with no location.
|
|||||||
The prelude's own =unless= has not been converted and still answers a bare
|
The prelude's own =unless= has not been converted and still answers a bare
|
||||||
undefined name.
|
undefined name.
|
||||||
|
|
||||||
** TODO gensym's counter restarts in a second module
|
** DONE gensym's counter restarts in a second module
|
||||||
The counter lives in the loaded module and a module is dlopened once per compiler
|
CLOSED: [2026-09-25]
|
||||||
process, so it is process-wide in practice — but the rounds already build more
|
The counter is C data in the runtime (=flan_gensym_n=), and =lib/macro.ml= writes
|
||||||
than one module for a program whose macros call macros. Seed it from the module's
|
the compiler's own count into the module before every macro call and reads it
|
||||||
index.
|
back after. It counts across every module a compiler process loads — each round,
|
||||||
|
the program's module, and every expansion in a session. Rules out a counter per
|
||||||
|
module, seeded or not.
|
||||||
|
|
||||||
** TODO A quasiquote inside a quasiquote is refused
|
** TODO A quasiquote inside a quasiquote is refused
|
||||||
Nothing counts nesting levels — not the reader, deliberately, and not the
|
Nothing counts nesting levels — not the reader, deliberately, and not the
|
||||||
@ -141,11 +143,18 @@ as words the reader will not read back. =(/ 1.0 0.0)= is the only route to an
|
|||||||
infinity, and the constant folder is integers only, so it cannot be a =defconst=.
|
infinity, and the constant folder is integers only, so it cannot be a =defconst=.
|
||||||
Closing it needs a reader literal or a float-capable folding pass.
|
Closing it needs a reader literal or a float-capable folding pass.
|
||||||
|
|
||||||
** TODO A u64 constant above 2^63 cannot be written in decimal
|
** DONE A u64 constant above 2^63 cannot be written in decimal
|
||||||
The reader reads a decimal integer literal as a signed 64-bit number; hex is read
|
CLOSED: [2026-09-25]
|
||||||
as a bit pattern and works. The same limit has a second face: a cast's argument is
|
An integer written at or above 2^63 — a decimal up to 2^64 - 1, or hex with the
|
||||||
checked against the default type, so =(u64 2935910691)= is refused for not fitting
|
top bit set — reads as =Form.UInt=, its pattern and its spelling. It is accepted
|
||||||
in an =i32=.
|
where the type is =u64=, a =(u64 ...)= cast included, and refused everywhere else
|
||||||
|
in the spelling it was written in. Hex with the top bit set was accepted as a
|
||||||
|
negative at any integer type before this; it is refused now too. A negative
|
||||||
|
decimal is still a =u64= bit pattern. A cast's integer literal that does not fit
|
||||||
|
=i32= is checked at the cast's type; one that fits keeps the =i32= default, so
|
||||||
|
=(u32 -1)= still means what it did. A wide literal that passes through a macro
|
||||||
|
comes back as an ordinary =Int=, because the macro side's =Form= has one integer
|
||||||
|
case. Rules out a second integer case in the prelude's =Form=.
|
||||||
|
|
||||||
** DONE {.row .col} binds same-named locals
|
** DONE {.row .col} binds same-named locals
|
||||||
CLOSED: [2026-09-20]
|
CLOSED: [2026-09-20]
|
||||||
@ -790,14 +799,11 @@ 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
|
daemon's half-typed recompiles could feel it. A cheaper retry was tried and
|
||||||
shelved because it changes which literal gets the nicer message.
|
shelved because it changes which literal gets the nicer message.
|
||||||
|
|
||||||
** TODO and's last operand gets a misdirected caret
|
** DONE and's last operand gets a misdirected caret
|
||||||
=(println (and true true (vec-new i32)))= puts the caret on the second =true=. The
|
CLOSED: [2026-09-25]
|
||||||
last operand of an =and= is the then arm and the then arm is typed first, so the
|
Already fixed by 3672da2, which blames the arm that is not a compiler temp; the
|
||||||
mismatch is blamed on the else arm, which carries the previous operand's location.
|
caret is on the last operand and =test/test_flan.ml= asserts its column. Rules
|
||||||
The fix is preferring the arm that is not a compiler temp when deciding whom to
|
out relabelling the else arm, a bool sentinel, and inverting the condition.
|
||||||
blame. Three others were considered and rejected: relabelling the else arm reads
|
|
||||||
backwards, a bool sentinel reverts the =or= fix, and inverting the condition costs
|
|
||||||
a =not= per operand.
|
|
||||||
|
|
||||||
** TODO Signature pairing's cold-rebuild edge
|
** TODO Signature pairing's cold-rebuild edge
|
||||||
Whether a parameter vector reads as one annotated parameter or two dyn ones
|
Whether a parameter vector reads as one annotated parameter or two dyn ones
|
||||||
@ -841,14 +847,21 @@ Iteration is built; the remaining refusal is generics. A =defn= has to name its
|
|||||||
types and =(defn map-keys [m (Map K V)] (Vec K))= has no =K=. The loop is three
|
types and =(defn map-keys [m (Map K V)] (Vec K))= has no =K=. The loop is three
|
||||||
lines at the call site, where =K= is known.
|
lines at the call site, where =K= is known.
|
||||||
|
|
||||||
** TODO (vec-new [u8]) is refused
|
** DONE (vec-new [u8]) is refused
|
||||||
The element type must be a bare symbol naming a type, so a =(Vec [u8])= can only
|
CLOSED: [2026-09-25]
|
||||||
be made where the context names it. The fix is letting it take a type expression —
|
The type positions of =vec-new= and =map-new= take a type expression: brackets, or
|
||||||
the same parser that already reads =[u8]= in a parameter list.
|
a parenthesised =Ptr=, =Option=, =Vec=, =Map=, =Fn= or =CFn=. The arguments stay
|
||||||
|
ordinary expressions and the builtin reads the type back out of one
|
||||||
|
(=Check.type_of_expr=), so a program's own =vec-new= still gets values; only a
|
||||||
|
type an expression cannot hold, such as =(Fn [i32] ())=, is parsed as
|
||||||
|
=Ast.TypeArg=. Rules out a type expression anywhere else in expression position.
|
||||||
|
|
||||||
** TODO An array literal cannot say it is [f32]
|
** TODO An array literal cannot say it is [f32]
|
||||||
A float literal defaults to =f64=, an array literal has no context, and a =let=
|
A float literal defaults to =f64=, an array literal has no context, and a =let=
|
||||||
has no annotation. Same shape as =(vec-new [u8])= and probably the same fix.
|
has no annotation. Same shape as =(vec-new [u8])= and probably the same fix.
|
||||||
|
Not the same fix: a bracket literal has no argument to put a type in. Decision:
|
||||||
|
how a literal names its element type — a spelling of its own, or a =let=
|
||||||
|
annotation.
|
||||||
|
|
||||||
** TODO A let binding takes no type annotation
|
** TODO A let binding takes no type annotation
|
||||||
Everything under the surface is there — the binding carries a type slot and the
|
Everything under the surface is there — the binding carries a type slot and the
|
||||||
@ -1860,12 +1873,12 @@ instrumented copy; the equivalent here is a dev-build-only instrumented
|
|||||||
redefinition, which the cell indirection already makes deliverable. Open:
|
redefinition, which the cell indirection already makes deliverable. Open:
|
||||||
whether stepping suspends the frame loop, and what it does to a game's clock.
|
whether stepping suspends the frame loop, and what it does to a game's clock.
|
||||||
|
|
||||||
** TODO A NaN cast says "does not fit", which reads as too big
|
** DONE A NaN cast says "does not fit", which reads as too big
|
||||||
=runtime/flan_rt.c:1008= covers every out-of-range float with one sentence, so
|
CLOSED: [2026-09-25]
|
||||||
=(i32 nan)= reports the =i32= bounds as if the value had overshot them. NaN and
|
Two more =ArithError= codes: 5 for a cast of NaN and 6 for a cast of an infinity,
|
||||||
the infinities convert to no integer at all and want saying so by name. Found
|
each with its own sentence. Both backends choose the code on the cold path, so the
|
||||||
by filling a struct holding an =f32= with =(filled 0xFF)=, where every bit set
|
guard is still two compares. =lhs= and =rhs= still carry the range. Rules out
|
||||||
is NaN.
|
carrying the float value in the condition.
|
||||||
|
|
||||||
** TODO The break buffer prints fields, not the sentence the runtime wrote
|
** TODO The break buffer prints fields, not the sentence the runtime wrote
|
||||||
=ArithError — op 4, lhs -2147483648, rhs 2147483647= where the runtime's own
|
=ArithError — op 4, lhs -2147483648, rhs 2147483647= where the runtime's own
|
||||||
@ -1892,12 +1905,12 @@ when it opens, so =M-g M-n= walks the stop and then each frame with a file.
|
|||||||
Refusals — the prelude, a relative path, a missing file — are one function
|
Refusals — the prelude, a relative path, a missing file — are one function
|
||||||
shared with =M-.=.
|
shared with =M-.=.
|
||||||
|
|
||||||
** TODO loop's bindings should be sequential, like let's
|
** DONE loop's bindings should be sequential, like let's
|
||||||
=check_loop= (=lib/check.ml:4741=) checks every initialiser before binding any,
|
CLOSED: [2026-09-25]
|
||||||
so =(loop [curr-r r next-r (inc curr-r)] ...)= cannot see =curr-r= and the
|
=check_loop= binds each name before checking the next initialiser; =recur= still
|
||||||
refusal reads as an unknown name. Every binding form is sequential — there is
|
rebinds all at once. No other form had the gap: =let= was already sequential,
|
||||||
no =let*= here and there is not going to be one. Check the other binding forms
|
=dotimes= binds one name, and =fn=, =defn=, =match= and the handler and restart
|
||||||
for the same gap while fixing it.
|
clauses bind parameters with no initialisers.
|
||||||
|
|
||||||
** TODO C-c C-c reports one error, not every error in the form
|
** TODO C-c C-c reports one error, not every error in the form
|
||||||
Whole-file paths use =Check.program_all= and report every bad declaration. The
|
Whole-file paths use =Check.program_all= and report every bad declaration. The
|
||||||
|
|||||||
11
lib/ast.ml
11
lib/ast.ml
@ -36,6 +36,7 @@ type expr = { e : expr_kind; loc : Loc.t }
|
|||||||
|
|
||||||
and expr_kind =
|
and expr_kind =
|
||||||
| Int of int64
|
| Int of int64
|
||||||
|
| UInt of int64 * string (* 18446744073709551615 — u64 only *)
|
||||||
| Float of float
|
| Float of float
|
||||||
| Byte of int
|
| Byte of int
|
||||||
| Str of string
|
| Str of string
|
||||||
@ -97,6 +98,12 @@ and expr_kind =
|
|||||||
fails on an unknown name. This is that position's answer, and it says what
|
fails on an unknown name. This is that position's answer, and it says what
|
||||||
it does rather than looking like a vector of two things. *)
|
it does rather than looking like a vector of two things. *)
|
||||||
| ArrayOf of texpr (* the whole array type, built by Parse *)
|
| ArrayOf of texpr (* the whole array type, built by Parse *)
|
||||||
|
(* (vec-new [u8]) and (map-new string [u8]) — a type written where an
|
||||||
|
argument goes. Only the type positions of those two forms read one, and
|
||||||
|
only when the form's shape says type and not value: brackets, or a
|
||||||
|
parenthesised Ptr, Option, Vec, Map, Fn or CFn. A bare name stays a
|
||||||
|
[Var], which the checker already answers as a type. *)
|
||||||
|
| TypeArg of texpr
|
||||||
(* (array-fill [r c] v) and (array-gen [r c] f) — a fixed array of any rank
|
(* (array-fill [r c] v) and (array-gen [r c] f) — a fixed array of any rank
|
||||||
as an *expression*, which is what [ArrayOf] and [dotimes] between them
|
as an *expression*, which is what [ArrayOf] and [dotimes] between them
|
||||||
could not be: [ArrayOf] produces the zeroed value only, and [dotimes] is
|
could not be: [ArrayOf] produces the zeroed value only, and [dotimes] is
|
||||||
@ -402,8 +409,8 @@ let map_children f (e : expr) : expr =
|
|||||||
in
|
in
|
||||||
let kind =
|
let kind =
|
||||||
match e.e with
|
match e.e with
|
||||||
| Int _ | Float _ | Byte _ | Str _ | Kw _ | Quote _ | Var _ | ArrayOf _
|
| Int _ | UInt _ | Float _ | Byte _ | Str _ | Kw _ | Quote _ | Var _ | ArrayOf _
|
||||||
| Break _ | Continue _ -> e.e
|
| TypeArg _ | Break _ | Continue _ -> e.e
|
||||||
| Do es -> Do (List.map ex es)
|
| Do es -> Do (List.map ex es)
|
||||||
| Let (bs, es) -> Let (List.map bind bs, List.map ex es)
|
| Let (bs, es) -> Let (List.map bind bs, List.map ex es)
|
||||||
| If (c, a, b) -> If (ex c, ex a, Option.map ex b)
|
| If (c, a, b) -> If (ex c, ex a, Option.map ex b)
|
||||||
|
|||||||
134
lib/check.ml
134
lib/check.ml
@ -395,6 +395,7 @@ let spell_arg stand_for (a : Ast.expr) =
|
|||||||
match a.Ast.e with
|
match a.Ast.e with
|
||||||
| Ast.Var v -> v
|
| Ast.Var v -> v
|
||||||
| Ast.Int n -> Int64.to_string n
|
| Ast.Int n -> Int64.to_string n
|
||||||
|
| Ast.UInt (_, s) -> s
|
||||||
| _ -> stand_for
|
| _ -> stand_for
|
||||||
|
|
||||||
(* What a [break] or a [continue] may be talking about, innermost first.
|
(* What a [break] or a [continue] may be talking about, innermost first.
|
||||||
@ -1958,7 +1959,9 @@ let check_fn_ref : (env -> Ast.fn -> Tast.fn) ref =
|
|||||||
(* Untyped literals: their machine type comes from context, so when one is an
|
(* Untyped literals: their machine type comes from context, so when one is an
|
||||||
operand of a binary operator we look at the *other* operand first. *)
|
operand of a binary operator we look at the *other* operand first. *)
|
||||||
let is_literal (e : Ast.expr) =
|
let is_literal (e : Ast.expr) =
|
||||||
match e.Ast.e with Ast.Int _ | Ast.Float _ | Ast.Byte _ -> true | _ -> false
|
match e.Ast.e with
|
||||||
|
| Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ -> true
|
||||||
|
| _ -> false
|
||||||
|
|
||||||
(* [addr] takes the address of a place, but the parser only builds places for
|
(* [addr] takes the address of a place, but the parser only builds places for
|
||||||
[set]. Recover one from the expression it parsed instead. *)
|
[set]. Recover one from the expression it parsed instead. *)
|
||||||
@ -3317,6 +3320,7 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
|
|||||||
ctx.tail <- false;
|
ctx.tail <- false;
|
||||||
match e.Ast.e with
|
match e.Ast.e with
|
||||||
| Ast.Int n -> int_literal loc ~want ~preds:ctx.env.tvpreds n
|
| Ast.Int n -> int_literal loc ~want ~preds:ctx.env.tvpreds n
|
||||||
|
| Ast.UInt (n, s) -> wide_literal loc ~want n s
|
||||||
| Ast.Byte b ->
|
| Ast.Byte b ->
|
||||||
int_literal loc ~want ~preds:ctx.env.tvpreds ~default:Types.U8
|
int_literal loc ~want ~preds:ctx.env.tvpreds ~default:Types.U8
|
||||||
(Int64.of_int b)
|
(Int64.of_int b)
|
||||||
@ -3567,6 +3571,11 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
|
|||||||
| Ast.ArrayOf t ->
|
| Ast.ArrayOf t ->
|
||||||
let ty = resolve ctx.env t in
|
let ty = resolve ctx.env t in
|
||||||
expect ctx loc ~want (mk loc ty (Tast.Zero ty))
|
expect ctx loc ~want (mk loc ty (Tast.Zero ty))
|
||||||
|
(* Parse writes one only into a type position of a call named vec-new or
|
||||||
|
map-new, and the builtins read it before it could get here. A program's
|
||||||
|
own function of that name does not. *)
|
||||||
|
| Ast.TypeArg _ ->
|
||||||
|
fail loc "this is a type, and a value is wanted here"
|
||||||
| Ast.ArrayFill (dims, v) -> check_array_fill ctx ~want loc dims v
|
| Ast.ArrayFill (dims, v) -> check_array_fill ctx ~want loc dims v
|
||||||
| Ast.ArrayGen (dims, f) -> check_array_gen ctx ~want loc dims f
|
| Ast.ArrayGen (dims, f) -> check_array_gen ctx ~want loc dims f
|
||||||
| Ast.Match (scrutinee, arms) -> check_match ctx ~tail ?want loc scrutinee arms
|
| Ast.Match (scrutinee, arms) -> check_match ctx ~tail ?want loc scrutinee arms
|
||||||
@ -3747,6 +3756,29 @@ and int_literal loc ~want ?(preds = []) ?(default = Types.I32) n =
|
|||||||
(Types.to_string other) n
|
(Types.to_string other) n
|
||||||
| _ -> mk loc (Types.Int default) (Tast.Int (in_range loc default n, default))
|
| _ -> mk loc (Types.Int default) (Tast.Int (in_range loc default n, default))
|
||||||
|
|
||||||
|
(* An integer written at or above 2^63, in decimal or in hex. Only a u64 holds
|
||||||
|
one, so it is accepted there and refused everywhere else, in the spelling it
|
||||||
|
was written in — its pattern read as an i64 is a different number. *)
|
||||||
|
and wide_literal loc ~want n s =
|
||||||
|
match want with
|
||||||
|
| Some (Types.Int Types.U64) -> mk loc (Types.Int Types.U64) (Tast.Int (n, Types.U64))
|
||||||
|
| Some (Types.Int k) ->
|
||||||
|
Loc.failk literal_at_want loc "%s does not fit in %s" s (Types.ikind_name k)
|
||||||
|
| Some (Types.Float _ as t) ->
|
||||||
|
Loc.failk literal_at_want loc
|
||||||
|
"%s is too large for any integer type but u64, and an integer literal \
|
||||||
|
where %s is wanted is read as one — write (%s (u64 %s))"
|
||||||
|
s (Types.to_string t) (Types.to_string t) s
|
||||||
|
| Some Types.Never | None ->
|
||||||
|
Loc.failk literal_at_want loc
|
||||||
|
"%s does not fit in i32, the type an integer literal takes when nothing \
|
||||||
|
says otherwise — write (u64 %s) for a u64"
|
||||||
|
s s
|
||||||
|
| Some other ->
|
||||||
|
Loc.failk literal_at_want loc
|
||||||
|
"expected %s, found the integer literal %s, which only a u64 holds"
|
||||||
|
(Types.to_string other) s
|
||||||
|
|
||||||
(* Arithmetic wraps, but a literal that does not fit its type is a typo, not a
|
(* Arithmetic wraps, but a literal that does not fit its type is a typo, not a
|
||||||
wrap — 300 is never what someone meant by a u8. *)
|
wrap — 300 is never what someone meant by a u8. *)
|
||||||
and in_range loc k n =
|
and in_range loc k n =
|
||||||
@ -3757,13 +3789,10 @@ and in_range loc k n =
|
|||||||
|| (Int64.compare n (Int64.neg (Int64.shift_left 1L (bits - 1))) >= 0
|
|| (Int64.compare n (Int64.neg (Int64.shift_left 1L (bits - 1))) >= 0
|
||||||
&& Int64.compare n (Int64.shift_left 1L (bits - 1)) < 0)
|
&& Int64.compare n (Int64.shift_left 1L (bits - 1)) < 0)
|
||||||
else if bits = 64 then
|
else if bits = 64 then
|
||||||
(* A u64 literal is its 64-bit pattern, so anything at or above 2^63
|
(* A literal at or above 2^63 is a [UInt] and never reaches here; see
|
||||||
arrives here as a negative [int64] and is still in range —
|
[wide_literal]. A negative decimal is accepted as a u64's bit pattern,
|
||||||
0xcbf29ce484222325 is a real u64 and not an error. The cost is that a
|
which is a settled rule. Narrower unsigned types keep the strict
|
||||||
negative *decimal* literal is accepted as a u64 too, because the
|
check, which is where a typo like 300 for a u8 actually shows up. *)
|
||||||
reader records only the value and not how it was written. Narrower
|
|
||||||
unsigned types keep the strict check, which is where a typo like 300
|
|
||||||
for a u8 actually shows up. *)
|
|
||||||
true
|
true
|
||||||
else
|
else
|
||||||
Int64.compare n 0L >= 0
|
Int64.compare n 0L >= 0
|
||||||
@ -4757,8 +4786,10 @@ and check_dotimes ctx ~want loc label name (b : Ast.bounds) body =
|
|||||||
and check_loop ctx ?want loc bs body =
|
and check_loop ctx ?want loc bs body =
|
||||||
scoped ctx (fun () ->
|
scoped ctx (fun () ->
|
||||||
(* Each initial value is evaluated once, before the loop, exactly as a
|
(* Each initial value is evaluated once, before the loop, exactly as a
|
||||||
[let]'s is and as [dotimes]'s bound is. *)
|
[let]'s is and as [dotimes]'s bound is — and bound before the next is
|
||||||
let inits =
|
checked, as a [let]'s is, so a later initialiser sees an earlier
|
||||||
|
name. *)
|
||||||
|
let binds =
|
||||||
map_lr
|
map_lr
|
||||||
(fun (n, v) ->
|
(fun (n, v) ->
|
||||||
let v = check ctx v in
|
let v = check ctx v in
|
||||||
@ -4767,12 +4798,9 @@ and check_loop ctx ?want loc bs body =
|
|||||||
fail v.Tast.loc "%s would be bound to %s, which is not a value" n
|
fail v.Tast.loc "%s would be bound to %s, which is not a value" n
|
||||||
(Types.to_string v.Tast.ty)
|
(Types.to_string v.Tast.ty)
|
||||||
| _ -> ());
|
| _ -> ());
|
||||||
(n, v))
|
(bind ctx n v.Tast.ty ~assignable:true, v))
|
||||||
bs
|
bs
|
||||||
in
|
in
|
||||||
let binds =
|
|
||||||
List.map (fun (n, v) -> (bind ctx n v.Tast.ty ~assignable:true, v)) inits
|
|
||||||
in
|
|
||||||
let names = List.map (fun (slot, v) -> (slot, v.Tast.ty)) binds in
|
let names = List.map (fun (slot, v) -> (slot, v.Tast.ty)) binds in
|
||||||
(* The singleton is [in_loop]'s doing: it sits in this recursive group and
|
(* The singleton is [in_loop]'s doing: it sits in this recursive group and
|
||||||
is therefore monomorphic, and every other caller hands it a list. *)
|
is therefore monomorphic, and every other caller hands it a list. *)
|
||||||
@ -6585,12 +6613,16 @@ and type_named ctx n =
|
|||||||
|| Hashtbl.mem ctx.env.enums n
|
|| Hashtbl.mem ctx.env.enums n
|
||||||
|| Hashtbl.mem ctx.env.aliases n
|
|| Hashtbl.mem ctx.env.aliases n
|
||||||
|
|
||||||
(* The element type for [vec-new]: a leading bare symbol naming a type, or the
|
(* The element type for [vec-new]: a leading bare symbol naming a type, a
|
||||||
expectation at the site. A bare symbol shadowed by a local or a global is
|
leading type expression — [(vec-new [u8])], [(vec-new (Ptr Cell))], which
|
||||||
that binding — an allocator, in practice — and not a type. *)
|
Parse has already read as one — or the expectation at the site. A bare
|
||||||
|
symbol shadowed by a local or a global is that binding — an allocator, in
|
||||||
|
practice — and not a type. *)
|
||||||
and vec_new_elem ctx ~want loc args =
|
and vec_new_elem ctx ~want loc args =
|
||||||
let named =
|
let named =
|
||||||
match args with
|
match args with
|
||||||
|
| 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
|
| { Ast.e = Ast.Var n; _ } :: rest
|
||||||
when lookup ctx n = None
|
when lookup ctx n = None
|
||||||
&& (not (Hashtbl.mem ctx.env.globals n))
|
&& (not (Hashtbl.mem ctx.env.globals n))
|
||||||
@ -6608,6 +6640,39 @@ and vec_new_elem ctx ~want loc args =
|
|||||||
"nothing here says what (vec-new) is a Vec of — write the element \
|
"nothing here says what (vec-new) is a Vec of — write the element \
|
||||||
type, as (vec-new i32), or give the binding a type")
|
type, as (vec-new i32), or give the binding a type")
|
||||||
|
|
||||||
|
(* A type written as an argument to vec-new or map-new, read back out of the
|
||||||
|
expression Parse made of it. Only the shapes that cannot be a value there:
|
||||||
|
brackets — an allocator is never an array — or a parenthesised Ptr,
|
||||||
|
Option, Vec, Map, Fn or CFn. A bare name is not one of them, because there
|
||||||
|
it may be an allocator's name; the callers ask about that themselves. *)
|
||||||
|
and type_of_expr (e : Ast.expr) : Ast.texpr option =
|
||||||
|
let mk t = { Ast.t; tloc = e.Ast.loc } in
|
||||||
|
let inner (e : Ast.expr) =
|
||||||
|
match e.Ast.e with
|
||||||
|
| Ast.Var s -> Some { Ast.t = Ast.Tname s; tloc = e.Ast.loc }
|
||||||
|
| _ -> type_of_expr e
|
||||||
|
in
|
||||||
|
let all es =
|
||||||
|
let ts = List.filter_map inner es in
|
||||||
|
if List.length ts = List.length es then Some ts else None
|
||||||
|
in
|
||||||
|
match e.Ast.e with
|
||||||
|
| Ast.TypeArg t -> Some t
|
||||||
|
| Ast.Arr [ x ] -> Option.map (fun t -> mk (Ast.Tslice t)) (inner x)
|
||||||
|
| Ast.Arr [ { Ast.e = Ast.Int n; _ }; x ] ->
|
||||||
|
Option.map (fun t -> mk (Ast.Tarray (Ast.Lint n, t))) (inner x)
|
||||||
|
| Ast.Arr [ { Ast.e = Ast.Var n; _ }; x ] ->
|
||||||
|
Option.map (fun t -> mk (Ast.Tarray (Ast.Lname n, t))) (inner x)
|
||||||
|
| Ast.Call ({ Ast.e = Ast.Var (("Fn" | "CFn") as which); _ },
|
||||||
|
[ { Ast.e = Ast.Arr ps; _ }; r ]) ->
|
||||||
|
(match all ps, inner r with
|
||||||
|
| Some ps, Some r -> Some (mk (Ast.Tfn (which = "Fn", ps, r)))
|
||||||
|
| _ -> None)
|
||||||
|
| Ast.Call ({ Ast.e = Ast.Var (("Ptr" | "Option" | "Vec" | "Map") as c); _ },
|
||||||
|
(_ :: _ as args)) ->
|
||||||
|
Option.map (fun ts -> mk (Ast.Tapp (c, ts))) (all args)
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
(* The key and value types, or the reason this is not a Map. *)
|
(* The key and value types, or the reason this is not a Map. *)
|
||||||
and map_kv loc what (t : Types.t) =
|
and map_kv loc what (t : Types.t) =
|
||||||
match t with
|
match t with
|
||||||
@ -6625,10 +6690,21 @@ and map_new_types ctx ~want loc args =
|
|||||||
&& (not (Hashtbl.mem ctx.env.globals n))
|
&& (not (Hashtbl.mem ctx.env.globals n))
|
||||||
&& type_named ctx n
|
&& type_named ctx n
|
||||||
in
|
in
|
||||||
|
(* A type position holds a bare name or a type expression Parse has read
|
||||||
|
as one, as [vec-new]'s does. *)
|
||||||
|
let as_type (a : Ast.expr) =
|
||||||
|
match a.Ast.e, type_of_expr a with
|
||||||
|
| _, Some t -> Some (resolve ctx.env t)
|
||||||
|
| Ast.Var n, None when is_type n -> Some (resolve_name ctx.env ~seen:[] loc n)
|
||||||
|
| _ -> None
|
||||||
|
in
|
||||||
match args with
|
match args with
|
||||||
| { Ast.e = Ast.Var k; _ } :: { Ast.e = Ast.Var v; _ } :: rest
|
| k :: v :: rest when as_type k <> None && as_type v <> None ->
|
||||||
when is_type k && is_type v ->
|
Option.get (as_type k), Option.get (as_type v), rest
|
||||||
resolve_name ctx.env ~seen:[] loc k, resolve_name ctx.env ~seen:[] loc v, rest
|
| a :: _ when type_of_expr a <> None ->
|
||||||
|
fail loc
|
||||||
|
"(map-new) names a key and no value — write both, as (map-new string \
|
||||||
|
i32), or give the binding a type"
|
||||||
| { Ast.e = Ast.Var k; _ } :: rest when is_type k && rest = [] ->
|
| { Ast.e = Ast.Var k; _ } :: rest when is_type k && rest = [] ->
|
||||||
fail loc
|
fail loc
|
||||||
"(map-new %s) names a key and no value — write both, as (map-new %s \
|
"(map-new %s) names a key and no value — write both, as (map-new %s \
|
||||||
@ -8858,7 +8934,19 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
|||||||
prim (Tast.Cast target) target [ a ]
|
prim (Tast.Cast target) target [ a ]
|
||||||
| _ when is_cast name && List.length args = 1 ->
|
| _ when is_cast name && List.length args = 1 ->
|
||||||
let target = resolve_name ctx.env ~seen:[] loc name in
|
let target = resolve_name ctx.env ~seen:[] loc name in
|
||||||
let a = check ctx (List.hd args) in
|
(* An integer literal too wide for the i32 it would default to is checked
|
||||||
|
at the target instead, so (u64 2935910691) and (i64 5000000000) are the
|
||||||
|
constants they say. One that fits i32 keeps the default and the cast,
|
||||||
|
which is what (u32 -1) has always meant. *)
|
||||||
|
let want =
|
||||||
|
match (List.hd args).Ast.e, target with
|
||||||
|
| Ast.Int n, (Types.Int _ | Types.Float _)
|
||||||
|
when Int64.compare n (-2147483648L) < 0
|
||||||
|
|| Int64.compare n 2147483647L > 0 -> Some target
|
||||||
|
| Ast.UInt _, (Types.Int _ | Types.Float _) -> Some target
|
||||||
|
| _ -> None
|
||||||
|
in
|
||||||
|
let a = check ctx ?want (List.hd args) in
|
||||||
(match a.Tast.ty with
|
(match a.Tast.ty with
|
||||||
| Types.Enum _ -> ()
|
| Types.Enum _ -> ()
|
||||||
(* A dyn opens here — [cast_dyn], TODO.org, "A numeric cast opens a dyn
|
(* A dyn opens here — [cast_dyn], TODO.org, "A numeric cast opens a dyn
|
||||||
@ -9181,7 +9269,7 @@ and generic_call ctx ~want loc name vars pats pret args =
|
|||||||
else is checked on its own terms. *)
|
else is checked on its own terms. *)
|
||||||
let untyped_literal =
|
let untyped_literal =
|
||||||
match a.Ast.e with
|
match a.Ast.e with
|
||||||
| Ast.Int _ | Ast.Float _ | Ast.Byte _ -> true
|
| Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ -> true
|
||||||
| _ -> false
|
| _ -> false
|
||||||
in
|
in
|
||||||
let a =
|
let a =
|
||||||
@ -9653,7 +9741,7 @@ and binary ctx ?(dyn_ok = false) ?(join = true) name loc ~want args =
|
|||||||
let y_decides =
|
let y_decides =
|
||||||
(is_literal x && not (is_literal y))
|
(is_literal x && not (is_literal y))
|
||||||
|| (match x.Ast.e, y.Ast.e with
|
|| (match x.Ast.e, y.Ast.e with
|
||||||
| (Ast.Int _ | Ast.Byte _), Ast.Float _ -> true
|
| (Ast.Int _ | Ast.UInt _ | Ast.Byte _), Ast.Float _ -> true
|
||||||
| _ -> false)
|
| _ -> false)
|
||||||
in
|
in
|
||||||
(* A form that cannot be checked without being told what is wanted. A
|
(* A form that cannot be checked without being told what is wanted. A
|
||||||
|
|||||||
22
lib/emit.ml
22
lib/emit.ml
@ -1517,6 +1517,8 @@ let arith_rem_zero = 1
|
|||||||
let arith_div_overflow = 2
|
let arith_div_overflow = 2
|
||||||
let arith_rem_overflow = 3
|
let arith_rem_overflow = 3
|
||||||
let arith_cast_range = 4
|
let arith_cast_range = 4
|
||||||
|
let arith_cast_nan = 5
|
||||||
|
let arith_cast_inf = 6
|
||||||
|
|
||||||
(* ArithError's fields are i64 and an operand may be narrower, so every
|
(* ArithError's fields are i64 and an operand may be narrower, so every
|
||||||
operand is widened on the way into the condition — signed or not according
|
operand is widened on the way into the condition — signed or not according
|
||||||
@ -1668,11 +1670,27 @@ let check_cast f ~guard loc (src : Types.fkind) (k : Types.ikind) v =
|
|||||||
ins f "%s = fcmp olt double %s, %s" b v (dbl hi_f);
|
ins f "%s = fcmp olt double %s, %s" b v (dbl hi_f);
|
||||||
let ok = fresh f in
|
let ok = fresh f in
|
||||||
ins f "%s = and i1 %s, %s" ok a b;
|
ins f "%s = and i1 %s, %s" ok a b;
|
||||||
|
(* NaN and the infinities are named rather than reported as out of range:
|
||||||
|
they are not values that overshot the type, they have no integer at
|
||||||
|
all. Worked out on the cold path, so the guard is still two compares. *)
|
||||||
signal_block f loc ~guard ok (fun id nn ->
|
signal_block f loc ~guard ok (fun id nn ->
|
||||||
|
let nan = fresh f in
|
||||||
|
ins f "%s = fcmp uno double %s, %s" nan v v;
|
||||||
|
let pinf = fresh f in
|
||||||
|
ins f "%s = fcmp oeq double %s, %s" pinf v (dbl infinity);
|
||||||
|
let ninf = fresh f in
|
||||||
|
ins f "%s = fcmp oeq double %s, %s" ninf v (dbl neg_infinity);
|
||||||
|
let inf = fresh f in
|
||||||
|
ins f "%s = or i1 %s, %s" inf pinf ninf;
|
||||||
|
let c1 = fresh f in
|
||||||
|
ins f "%s = select i1 %s, i32 %d, i32 %d" c1 inf arith_cast_inf
|
||||||
|
arith_cast_range;
|
||||||
|
let code = fresh f in
|
||||||
|
ins f "%s = select i1 %s, i32 %d, i32 %s" code nan arith_cast_nan c1;
|
||||||
ins f
|
ins f
|
||||||
"call void @flan_arith_error(ptr %s, i64 %d, i32 %d, i64 %Ld, i64 %Ld, \
|
"call void @flan_arith_error(ptr %s, i64 %d, i32 %s, i64 %Ld, i64 %Ld, \
|
||||||
ptr %s)"
|
ptr %s)"
|
||||||
id nn arith_cast_range lo_i hi_i xfer_param)
|
id nn code lo_i hi_i xfer_param)
|
||||||
end
|
end
|
||||||
|
|
||||||
(* [at] is strict: the last valid index is len - 1. *)
|
(* [at] is strict: the last valid index is len - 1. *)
|
||||||
|
|||||||
@ -114,6 +114,9 @@ let rec write (sites : sites) p (f : Form.t) =
|
|||||||
| Form.Kw s -> str TKw s
|
| Form.Kw s -> str TKw s
|
||||||
| Form.Str s -> str TStr s
|
| Form.Str s -> str TStr s
|
||||||
| Form.Int i -> tag TInt; Dynload.poke_i64 p payload i
|
| Form.Int i -> tag TInt; Dynload.poke_i64 p payload i
|
||||||
|
(* A macro's Form has one integer case, so a wide literal crosses as its
|
||||||
|
pattern and comes back as an ordinary [Int]. *)
|
||||||
|
| Form.UInt (i, _) -> tag TInt; Dynload.poke_i64 p payload i
|
||||||
| Form.Float x -> tag TFloat; Dynload.poke_f64 p payload x
|
| Form.Float x -> tag TFloat; Dynload.poke_f64 p payload x
|
||||||
| Form.Byte b -> tag TByte; Dynload.poke_i32 p payload (Int32.of_int b)
|
| Form.Byte b -> tag TByte; Dynload.poke_i32 p payload (Int32.of_int b)
|
||||||
| Form.List xs -> seq TList xs
|
| Form.List xs -> seq TList xs
|
||||||
@ -251,7 +254,7 @@ let rec quote (f : Form.t) : Form.t =
|
|||||||
inner form with form-cons"
|
inner form with form-cons"
|
||||||
| Form.Sym s -> node loc "Sym" "s" (Form.Str s)
|
| Form.Sym s -> node loc "Sym" "s" (Form.Str s)
|
||||||
| Form.Kw s -> node loc "Kw" "s" (Form.Str s)
|
| Form.Kw s -> node loc "Kw" "s" (Form.Str s)
|
||||||
| Form.Int i -> node loc "Int" "i" (Form.Int i)
|
| Form.Int i | Form.UInt (i, _) -> node loc "Int" "i" (Form.Int i)
|
||||||
| Form.Float x -> node loc "Float" "x" (Form.Float x)
|
| Form.Float x -> node loc "Float" "x" (Form.Float x)
|
||||||
| Form.Str s -> node loc "Str" "s" (Form.Str s)
|
| Form.Str s -> node loc "Str" "s" (Form.Str s)
|
||||||
| Form.Byte b -> node loc "Byte" "b" (Form.Int (Int64.of_int b))
|
| Form.Byte b -> node loc "Byte" "b" (Form.Int (Int64.of_int b))
|
||||||
|
|||||||
@ -12,6 +12,10 @@ and value =
|
|||||||
| Sym of string (* foo rl/draw-fps .pos + *)
|
| Sym of string (* foo rl/draw-fps .pos + *)
|
||||||
| Kw of string (* :space :else (leading : dropped) *)
|
| Kw of string (* :space :else (leading : dropped) *)
|
||||||
| Int of int64 (* 42 -1 0xE6B800FF *)
|
| Int of int64 (* 42 -1 0xE6B800FF *)
|
||||||
|
(* An integer written at or above 2^63 — 18446744073709551615, or a hex
|
||||||
|
literal with its top bit set. Its 64-bit pattern and its spelling: only a
|
||||||
|
u64 holds it, and a refusal anywhere else prints the number as written. *)
|
||||||
|
| UInt of int64 * string
|
||||||
| Float of float (* 0.05 *)
|
| Float of float (* 0.05 *)
|
||||||
| Str of string (* "SAND" *)
|
| Str of string (* "SAND" *)
|
||||||
| Byte of int (* \space \0 \( (0..255) *)
|
| Byte of int (* \space \0 \( (0..255) *)
|
||||||
@ -30,6 +34,7 @@ let rec to_string f =
|
|||||||
| Sym s -> s
|
| Sym s -> s
|
||||||
| Kw s -> ":" ^ s
|
| Kw s -> ":" ^ s
|
||||||
| Int i -> Int64.to_string i
|
| Int i -> Int64.to_string i
|
||||||
|
| UInt (_, s) -> s
|
||||||
| Float x -> Printf.sprintf "%g" x
|
| Float x -> Printf.sprintf "%g" x
|
||||||
| Str s -> Printf.sprintf "%S" s
|
| Str s -> Printf.sprintf "%S" s
|
||||||
| Byte b ->
|
| Byte b ->
|
||||||
@ -126,6 +131,7 @@ let rec to_source f =
|
|||||||
| Sym s -> s
|
| Sym s -> s
|
||||||
| Kw s -> ":" ^ s
|
| Kw s -> ":" ^ s
|
||||||
| Int i -> Int64.to_string i
|
| Int i -> Int64.to_string i
|
||||||
|
| UInt (_, s) -> s
|
||||||
| Float x -> float_repr x
|
| Float x -> float_repr x
|
||||||
| Str s -> "\"" ^ escape s ^ "\""
|
| Str s -> "\"" ^ escape s ^ "\""
|
||||||
| Byte b -> byte_repr b
|
| Byte b -> byte_repr b
|
||||||
|
|||||||
@ -223,7 +223,7 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr =
|
|||||||
let name n = qualify_name owned alias bound n in
|
let name n = qualify_name owned alias bound n in
|
||||||
let k =
|
let k =
|
||||||
match e.Ast.e with
|
match e.Ast.e with
|
||||||
| Ast.Int _ | Ast.Float _ | Ast.Byte _ | Ast.Str _ | Ast.Kw _
|
| Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ | Ast.Str _ | Ast.Kw _
|
||||||
| Ast.Quote _ -> e.Ast.e
|
| Ast.Quote _ -> e.Ast.e
|
||||||
| Ast.Var n -> Ast.Var (name n)
|
| Ast.Var n -> Ast.Var (name n)
|
||||||
| Ast.Do body -> Ast.Do (gos body)
|
| Ast.Do body -> Ast.Do (gos body)
|
||||||
@ -307,6 +307,7 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr =
|
|||||||
Ast.MapLit (tag, List.map (fun (k, v) -> (go k, go v)) kvs)
|
Ast.MapLit (tag, List.map (fun (k, v) -> (go k, go v)) kvs)
|
||||||
| Ast.Arr items -> Ast.Arr (gos items)
|
| Ast.Arr items -> Ast.Arr (gos items)
|
||||||
| Ast.ArrayOf t -> Ast.ArrayOf (rename_texpr owned alias t)
|
| Ast.ArrayOf t -> Ast.ArrayOf (rename_texpr owned alias t)
|
||||||
|
| Ast.TypeArg t -> Ast.TypeArg (rename_texpr owned alias t)
|
||||||
(* The dimensions too, for the reason [rename_texpr] gives about the one
|
(* The dimensions too, for the reason [rename_texpr] gives about the one
|
||||||
inside [Tarray]: a dimension written as a name is an ordinary
|
inside [Tarray]: a dimension written as a name is an ordinary
|
||||||
compile-time constant of the package and has to be qualified like any
|
compile-time constant of the package and has to be qualified like any
|
||||||
@ -753,7 +754,8 @@ let rec expr_uses acc (e : Ast.expr) =
|
|||||||
let go = expr_uses acc in
|
let go = expr_uses acc in
|
||||||
let gos = List.iter go in
|
let gos = List.iter go in
|
||||||
match e.Ast.e with
|
match e.Ast.e with
|
||||||
| Ast.Int _ | Ast.Float _ | Ast.Byte _ | Ast.Str _ | Ast.Kw _ | Ast.Quote _ ->
|
| Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ | Ast.Str _ | Ast.Kw _
|
||||||
|
| Ast.Quote _ ->
|
||||||
()
|
()
|
||||||
(* The name is not one an import can supply, but the arguments are ordinary
|
(* The name is not one an import can supply, but the arguments are ordinary
|
||||||
expressions and may well use one. *)
|
expressions and may well use one. *)
|
||||||
@ -787,7 +789,7 @@ let rec expr_uses acc (e : Ast.expr) =
|
|||||||
| Ast.Bare kvs -> List.iter (fun (_, v) -> go v) kvs
|
| Ast.Bare kvs -> List.iter (fun (_, v) -> go v) kvs
|
||||||
| Ast.MapLit (_, kvs) -> List.iter (fun (k, v) -> go k; go v) kvs
|
| Ast.MapLit (_, kvs) -> List.iter (fun (k, v) -> go k; go v) kvs
|
||||||
| Ast.Arr items -> gos items
|
| Ast.Arr items -> gos items
|
||||||
| Ast.ArrayOf t -> texpr_uses acc t
|
| Ast.ArrayOf t | Ast.TypeArg t -> texpr_uses acc t
|
||||||
(* A dimension written as a name is a use of that constant, exactly as it is
|
(* A dimension written as a name is a use of that constant, exactly as it is
|
||||||
inside [Tarray]. *)
|
inside [Tarray]. *)
|
||||||
| Ast.ArrayFill (ds, v) | Ast.ArrayGen (ds, v) ->
|
| Ast.ArrayFill (ds, v) | Ast.ArrayGen (ds, v) ->
|
||||||
|
|||||||
18
lib/macro.ml
18
lib/macro.ml
@ -380,12 +380,28 @@ let dir_of (l : loaded) (loc : Loc.t) =
|
|||||||
always has a signature, and the one thing that could put a name in [fns]
|
always has a signature, and the one thing that could put a name in [fns]
|
||||||
without one is the two lists coming apart — in which case expanding
|
without one is the two lists coming apart — in which case expanding
|
||||||
unchecked is the wrong half to lose. *)
|
unchecked is the wrong half to lose. *)
|
||||||
|
(* The gensym counter, process-wide. Every module links its own runtime and
|
||||||
|
so its own [flan_gensym_n], and a build loads several — one per round when
|
||||||
|
a macro calls a macro, then the one the program is expanded with, and a
|
||||||
|
session loads one per expansion. A counter that restarted in each would
|
||||||
|
hand a later module the name an earlier one had already baked into a
|
||||||
|
macro's code. So the count lives here and is written into the module
|
||||||
|
before every call and read back after, whether the call returns or
|
||||||
|
raises. *)
|
||||||
|
let gensym_n = ref 0L
|
||||||
|
|
||||||
|
let with_gensym (l : loaded) f =
|
||||||
|
let cell = Dynload.dl_sym l.handle "flan_gensym_n" in
|
||||||
|
Dynload.poke_i64 cell 0 !gensym_n;
|
||||||
|
Fun.protect ~finally:(fun () -> gensym_n := Dynload.peek_i64 cell 0) f
|
||||||
|
|
||||||
let checked_call (l : loaded) n ~loc (args : Form.t list) : Form.t =
|
let checked_call (l : loaded) n ~loc (args : Form.t list) : Form.t =
|
||||||
(match List.assoc_opt n l.sigs with
|
(match List.assoc_opt n l.sigs with
|
||||||
| Some sg -> Expand.check_call ~name:n ~loc sg args
|
| Some sg -> Expand.check_call ~name:n ~loc sg args
|
||||||
| None -> ());
|
| None -> ());
|
||||||
dir_of l loc;
|
dir_of l loc;
|
||||||
Expand.call ~loc:(Loc.from_macro n loc) (List.assoc n l.fns) args
|
with_gensym l (fun () ->
|
||||||
|
Expand.call ~loc:(Loc.from_macro n loc) (List.assoc n l.fns) args)
|
||||||
|
|
||||||
let fuel = 200
|
let fuel = 200
|
||||||
|
|
||||||
|
|||||||
26
lib/parse.ml
26
lib/parse.ml
@ -310,6 +310,7 @@ let rec expr (f : Form.t) : Ast.expr =
|
|||||||
let mk e = { Ast.e; loc = f.loc } in
|
let mk e = { Ast.e; loc = f.loc } in
|
||||||
match f.v with
|
match f.v with
|
||||||
| Int i -> mk (Ast.Int i)
|
| Int i -> mk (Ast.Int i)
|
||||||
|
| UInt (i, s) -> mk (Ast.UInt (i, s))
|
||||||
| Float x -> mk (Ast.Float x)
|
| Float x -> mk (Ast.Float x)
|
||||||
| Byte b -> mk (Ast.Byte b)
|
| Byte b -> mk (Ast.Byte b)
|
||||||
| Str s -> mk (Ast.Str s)
|
| Str s -> mk (Ast.Str s)
|
||||||
@ -425,6 +426,31 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr =
|
|||||||
| [ target; value ] -> mk (Ast.Set (place target, expr value))
|
| [ target; value ] -> mk (Ast.Set (place target, expr value))
|
||||||
| _ -> fail f "set is (set place value)")
|
| _ -> fail f "set is (set place value)")
|
||||||
|
|
||||||
|
(* ── (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
|
||||||
|
own [vec-new] — so the arguments are read as ordinary expressions and
|
||||||
|
[Check.type_of_expr] reads a type back out of one when the builtin is
|
||||||
|
what was called. The one type an expression cannot carry is [()], as in
|
||||||
|
[(Fn [i32] ())], so an argument that is not an expression but is a type
|
||||||
|
is kept as a [TypeArg]. *)
|
||||||
|
| Sym (("vec-new" | "builtin/vec-new" | "map-new" | "builtin/map-new") as n) ->
|
||||||
|
let slots =
|
||||||
|
if n = "vec-new" || n = "builtin/vec-new" then 1 else 2
|
||||||
|
in
|
||||||
|
let args =
|
||||||
|
List.mapi
|
||||||
|
(fun i (a : Form.t) ->
|
||||||
|
match expr a with
|
||||||
|
| e -> e
|
||||||
|
| exception (Loc.Error _ as not_expr) when i < slots ->
|
||||||
|
(match texpr a with
|
||||||
|
| t -> { Ast.e = Ast.TypeArg t; loc = a.loc }
|
||||||
|
| exception Loc.Error _ -> raise not_expr))
|
||||||
|
args
|
||||||
|
in
|
||||||
|
mk (Ast.Call (expr head, args))
|
||||||
|
|
||||||
(* ── (array 4 rl/Vector2) ───────────────────────────────────────────
|
(* ── (array 4 rl/Vector2) ───────────────────────────────────────────
|
||||||
A zeroed fixed array, told its count and its element type. The type
|
A zeroed fixed array, told its count and its element type. The type
|
||||||
spelling [4 rl/Vector2] is unchanged and still works everywhere a type is
|
spelling [4 rl/Vector2] is unchanged and still works everywhere a type is
|
||||||
|
|||||||
@ -123,9 +123,11 @@ let source = {flan|
|
|||||||
;; 0 (/ a 0) 1 (% a 0)
|
;; 0 (/ a 0) 1 (% a 0)
|
||||||
;; 2 (/ min -1) 3 (% min -1)
|
;; 2 (/ min -1) 3 (% min -1)
|
||||||
;; 4 a float to integer cast whose value does not fit
|
;; 4 a float to integer cast whose value does not fit
|
||||||
|
;; 5 a float to integer cast of NaN
|
||||||
|
;; 6 a float to integer cast of an infinity
|
||||||
;;
|
;;
|
||||||
;; `lhs` and `rhs` are the two operands for codes 0 through 3 and the
|
;; `lhs` and `rhs` are the two operands for codes 0 through 3 and the
|
||||||
;; destination type's representable range for code 4 — the violated condition
|
;; destination type's representable range for codes 4 through 6 — the violated condition
|
||||||
;; written as a range, which is what flan_slice_promise_error already does
|
;; written as a range, which is what flan_slice_promise_error already does
|
||||||
;; with BoundsError's fields. Two meanings over two fields rather than two
|
;; with BoundsError's fields. Two meanings over two fields rather than two
|
||||||
;; condition types, so that a handler writes one clause and not five. The
|
;; condition types, so that a handler writes one clause and not five. The
|
||||||
@ -232,10 +234,9 @@ let source = {flan|
|
|||||||
;; LLVM; at this width there is no such case to guard.
|
;; LLVM; at this width there is no such case to guard.
|
||||||
;;
|
;;
|
||||||
;; The multiplier is written in hex, which is how it is written everywhere
|
;; The multiplier is written in hex, which is how it is written everywhere
|
||||||
;; it appears: in decimal it is 12605985483714917081, and a decimal
|
;; it appears: in decimal it is 12605985483714917081. Either spelling is
|
||||||
;; literal that large is refused here because the reader reads one as a
|
;; a u64 literal and nothing else. It is written here rather than given a
|
||||||
;; signed 64-bit number. Hex is read as a bit pattern, and this is a bit
|
;; name of its own: a
|
||||||
;; pattern. It is written here rather than given a name of its own: a
|
|
||||||
;; prelude constant is a name in every program, and this is an
|
;; prelude constant is a name in every program, and this is an
|
||||||
;; implementation number that nothing outside these four lines wants.
|
;; implementation number that nothing outside these four lines wants.
|
||||||
(let [w (* (bit-xor (>> s (+ (>> s 59) 5)) s) 0xAEF17502108EF2D9)]
|
(let [w (* (bit-xor (>> s (+ (>> s 59) 5)) s) 0xAEF17502108EF2D9)]
|
||||||
@ -2135,19 +2136,19 @@ let source = {flan|
|
|||||||
;; explicit gensym is the settled decision (plan.org, open decision 2); this is
|
;; explicit gensym is the settled decision (plan.org, open decision 2); this is
|
||||||
;; the escape hatch that makes it liveable.
|
;; the escape hatch that makes it liveable.
|
||||||
;;
|
;;
|
||||||
;; The counter lives in the loaded module rather than in the compiler, which is
|
;; The counter is C data in the runtime, flan_gensym_n, because a build loads
|
||||||
;; the one place this departs from the sketch. A module is dlopened once
|
;; more than one macro module — one per round when macros call macros, and
|
||||||
;; per compiler process and every macro in a program shares it, so the counter
|
;; another for every expansion in a session — and each links its own copy of
|
||||||
;; is process-wide in practice; a second module would restart it, and the day
|
;; the runtime. lib/macro.ml keeps the count across them: it writes it into
|
||||||
;; there is one, the fix is to seed this from the module's index.
|
;; the module before every macro call and reads it back after, so no two
|
||||||
(defonce gensym-n i64 0)
|
;; modules in one compiler process draw the same name.
|
||||||
|
(declare gensym-next [] i64 "flan_gensym_next")
|
||||||
|
|
||||||
(defn gensym [] Form
|
(defn gensym [] Form
|
||||||
(set gensym-n (+ gensym-n 1))
|
|
||||||
(let [v (vec-new u8)]
|
(let [v (vec-new u8)]
|
||||||
(push v 126) ; ~
|
(push v 126) ; ~
|
||||||
(push v 103) ; g
|
(push v 103) ; g
|
||||||
(let [d (i64->bytes gensym-n)]
|
(let [d (i64->bytes (gensym-next))]
|
||||||
(dotimes [i (length d)]
|
(dotimes [i (length d)]
|
||||||
(push v (at d i))))
|
(push v (at d i))))
|
||||||
(Form.Sym {.s (string (slice v))})))
|
(Form.Sym {.s (string (slice v))})))
|
||||||
|
|||||||
@ -144,6 +144,8 @@ let read_number st =
|
|||||||
in
|
in
|
||||||
if is_hex then
|
if is_hex then
|
||||||
match Int64.of_string_opt text with
|
match Int64.of_string_opt text with
|
||||||
|
(* A top bit set is a value at or above 2^63, which only a u64 holds. *)
|
||||||
|
| Some i when Int64.compare i 0L < 0 -> spanned st loc (Form.UInt (i, text))
|
||||||
| Some i -> spanned st loc (Form.Int i)
|
| Some i -> spanned st loc (Form.Int i)
|
||||||
| None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st))
|
| None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st))
|
||||||
"malformed hex literal %s" text
|
"malformed hex literal %s" text
|
||||||
@ -153,8 +155,18 @@ let read_number st =
|
|||||||
| None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st))
|
| None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st))
|
||||||
"malformed float literal %s" text
|
"malformed float literal %s" text
|
||||||
else
|
else
|
||||||
|
(* A decimal above the largest i64 and below 2^64 is a [UInt], as a hex
|
||||||
|
literal with its top bit set is: only a u64 holds it. *)
|
||||||
|
let unsigned () =
|
||||||
|
if String.for_all (fun c -> c >= '0' && c <= '9') text then
|
||||||
|
Int64.of_string_opt ("0u" ^ text)
|
||||||
|
else None
|
||||||
|
in
|
||||||
match Int64.of_string_opt text with
|
match Int64.of_string_opt text with
|
||||||
| Some i -> spanned st loc (Form.Int i)
|
| Some i -> spanned st loc (Form.Int i)
|
||||||
|
| None ->
|
||||||
|
match unsigned () with
|
||||||
|
| Some i -> spanned st loc (Form.UInt (i, text))
|
||||||
| None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st))
|
| None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st))
|
||||||
"malformed integer literal %s" text
|
"malformed integer literal %s" text
|
||||||
|
|
||||||
|
|||||||
22
lib/x86.ml
22
lib/x86.ml
@ -2897,8 +2897,30 @@ and check_cast f (loc : Loc.t) (src : Types.fkind) (k : Types.ikind) =
|
|||||||
ucomis f.b ~f64 ~a:1 ~c:xmm0;
|
ucomis f.b ~f64 ~a:1 ~c:xmm0;
|
||||||
jcc_lbl f.b ~cc:cc_a ok;
|
jcc_lbl f.b ~cc:cc_a ok;
|
||||||
lbl f.b bad;
|
lbl f.b bad;
|
||||||
|
(* Which code, on the cold path: NaN and the infinities are named rather
|
||||||
|
than reported as out of range. xmm0 still holds the value here. *)
|
||||||
|
let call = new_label f "nofitcall" and notnan = new_label f "notnan"
|
||||||
|
and isinf = new_label f "isinf" in
|
||||||
imm_into f ~reg:rax (Int64.of_int Emit.arith_cast_range);
|
imm_into f ~reg:rax (Int64.of_int Emit.arith_cast_range);
|
||||||
store_int f.b ~src:rax ~mm:(Frame so) ~size:8;
|
store_int f.b ~src:rax ~mm:(Frame so) ~size:8;
|
||||||
|
ucomis f.b ~f64 ~a:xmm0 ~c:xmm0;
|
||||||
|
jcc_lbl f.b ~cc:cc_np notnan;
|
||||||
|
imm_into f ~reg:rax (Int64.of_int Emit.arith_cast_nan);
|
||||||
|
store_int f.b ~src:rax ~mm:(Frame so) ~size:8;
|
||||||
|
jmp_lbl f.b call;
|
||||||
|
lbl f.b notnan;
|
||||||
|
let kpinf = float_const f infinity ~f64
|
||||||
|
and kninf = float_const f neg_infinity ~f64 in
|
||||||
|
fload f.b ~dst:1 ~mm:(Sym (kpinf, 0)) ~f64;
|
||||||
|
ucomis f.b ~f64 ~a:xmm0 ~c:1;
|
||||||
|
jcc_lbl f.b ~cc:cc_e isinf;
|
||||||
|
fload f.b ~dst:1 ~mm:(Sym (kninf, 0)) ~f64;
|
||||||
|
ucomis f.b ~f64 ~a:xmm0 ~c:1;
|
||||||
|
jcc_lbl f.b ~cc:cc_ne call;
|
||||||
|
lbl f.b isinf;
|
||||||
|
imm_into f ~reg:rax (Int64.of_int Emit.arith_cast_inf);
|
||||||
|
store_int f.b ~src:rax ~mm:(Frame so) ~size:8;
|
||||||
|
lbl f.b call;
|
||||||
imm_into f ~reg:rax lo_i;
|
imm_into f ~reg:rax lo_i;
|
||||||
store_int f.b ~src:rax ~mm:(Frame sa) ~size:8;
|
store_int f.b ~src:rax ~mm:(Frame sa) ~size:8;
|
||||||
imm_into f ~reg:rax hi_i;
|
imm_into f ~reg:rax hi_i;
|
||||||
|
|||||||
@ -969,7 +969,9 @@ enum {
|
|||||||
FLAN_ARITH_REM_ZERO = 1,
|
FLAN_ARITH_REM_ZERO = 1,
|
||||||
FLAN_ARITH_DIV_OVERFLOW = 2,
|
FLAN_ARITH_DIV_OVERFLOW = 2,
|
||||||
FLAN_ARITH_REM_OVERFLOW = 3,
|
FLAN_ARITH_REM_OVERFLOW = 3,
|
||||||
FLAN_ARITH_CAST_RANGE = 4
|
FLAN_ARITH_CAST_RANGE = 4,
|
||||||
|
FLAN_ARITH_CAST_NAN = 5,
|
||||||
|
FLAN_ARITH_CAST_INF = 6
|
||||||
};
|
};
|
||||||
|
|
||||||
typedef struct { int32_t op; int64_t lhs, rhs; } flan_arith_cond;
|
typedef struct { int32_t op; int64_t lhs, rhs; } flan_arith_cond;
|
||||||
@ -1005,6 +1007,19 @@ static void flan_arith_fail(const uint8_t *loc, int64_t loclen, int32_t op,
|
|||||||
op == FLAN_ARITH_DIV_OVERFLOW ? "/" : "%", (long long)lhs,
|
op == FLAN_ARITH_DIV_OVERFLOW ? "/" : "%", (long long)lhs,
|
||||||
(long long)rhs);
|
(long long)rhs);
|
||||||
break;
|
break;
|
||||||
|
/* NaN and the infinities did not overshoot the range: no integer is
|
||||||
|
* their value, whatever the type. Saying "does not fit" reads as too big. */
|
||||||
|
case FLAN_ARITH_CAST_NAN:
|
||||||
|
fprintf(stderr,
|
||||||
|
"%.*s: this value is NaN, which has no integer value to cast to\n",
|
||||||
|
(int)loclen, (const char *)loc);
|
||||||
|
break;
|
||||||
|
case FLAN_ARITH_CAST_INF:
|
||||||
|
fprintf(stderr,
|
||||||
|
"%.*s: this value is infinite, which has no integer value to cast "
|
||||||
|
"to\n",
|
||||||
|
(int)loclen, (const char *)loc);
|
||||||
|
break;
|
||||||
default:
|
default:
|
||||||
fprintf(stderr,
|
fprintf(stderr,
|
||||||
"%.*s: this value does not fit the integer type it is cast to, "
|
"%.*s: this value does not fit the integer type it is cast to, "
|
||||||
@ -3181,6 +3196,14 @@ const uint8_t *flan_getenv(const uint8_t *name, int64_t n, int64_t *len) {
|
|||||||
char flan_macro_dir[FLAN_PATH_MAX] = { 0 };
|
char flan_macro_dir[FLAN_PATH_MAX] = { 0 };
|
||||||
int64_t flan_macro_dir_n = 0;
|
int64_t flan_macro_dir_n = 0;
|
||||||
|
|
||||||
|
/* The prelude's gensym counter. C data rather than a Flan global for the same
|
||||||
|
* reason as the two above: lib/macro.ml writes it into a module before every
|
||||||
|
* macro call and reads it back after, which is what keeps it counting across
|
||||||
|
* every module a compiler process loads rather than restarting in each. */
|
||||||
|
int64_t flan_gensym_n = 0;
|
||||||
|
|
||||||
|
int64_t flan_gensym_next(void) { return ++flan_gensym_n; }
|
||||||
|
|
||||||
/* The bytes are the caller's to read and nobody's to free: an expansion is
|
/* The bytes are the caller's to read and nobody's to free: an expansion is
|
||||||
* bounded by the size of the program being compiled, which is exactly the
|
* bounded by the size of the program being compiled, which is exactly the
|
||||||
* budget lib/dynload.ml's `owned` note already spends on a macro's own
|
* budget lib/dynload.ml's `owned` note already spends on a macro's own
|
||||||
|
|||||||
@ -180,7 +180,8 @@
|
|||||||
|
|
||||||
;; NaN fails both halves of the range test, which is deliberate: a NaN
|
;; NaN fails both halves of the range test, which is deliberate: a NaN
|
||||||
;; cast to an integer is exactly as undefined as a value out of range,
|
;; cast to an integer is exactly as undefined as a value out of range,
|
||||||
;; and an unordered comparison would have waved it through.
|
;; and an unordered comparison would have waved it through. Its code is
|
||||||
|
;; 5, which names NaN, rather than 4, which says it overshot the range.
|
||||||
(cast-frame (/ (f64 0.0) (f64 0.0)))
|
(cast-frame (/ (f64 0.0) (f64 0.0)))
|
||||||
(show "op" (i64 op))
|
(show "op" (i64 op))
|
||||||
|
|
||||||
|
|||||||
@ -76,6 +76,12 @@
|
|||||||
;; double there, which agree because every bound is a power of two and is
|
;; double there, which agree because every bound is a power of two and is
|
||||||
;; exact in both.
|
;; exact in both.
|
||||||
(= n 9) (print (i32 wide))
|
(= n 9) (print (i32 wide))
|
||||||
|
;; NaN and the infinities have no integer value at all, so the message
|
||||||
|
;; names them rather than a range they did not overshoot. An f32 source
|
||||||
|
;; for each too, since the two backends test it at different widths.
|
||||||
|
(= n 10) (print (i32 (/ (f64 1.0) (f64 0.0))))
|
||||||
|
(= n 11) (print (u8 (/ (f32 -1.0) (f32 0.0))))
|
||||||
|
(= n 12) (print (i32 (/ (f32 0.0) (f32 0.0))))
|
||||||
|
|
||||||
:else (println "?"))
|
:else (println "?"))
|
||||||
0))
|
0))
|
||||||
|
|||||||
24
test/programs/macro-gensym-rounds.flan
Normal file
24
test/programs/macro-gensym-rounds.flan
Normal file
@ -0,0 +1,24 @@
|
|||||||
|
;;;; Two gensyms from two macro modules are never the same name.
|
||||||
|
;;;;
|
||||||
|
;;;; `outer` calls `baked` in its body, so `baked` is compiled in a round of
|
||||||
|
;;;; its own and `outer`'s body is expanded against that module before `outer`
|
||||||
|
;;;; is compiled. The gensym `baked` draws there becomes a literal in
|
||||||
|
;;;; `outer`'s code; the one `outer` draws itself comes from the later module
|
||||||
|
;;;; the program is expanded with. `main` comes first so that its expansion is
|
||||||
|
;;;; that module's first draw. Were the two the same name, the second binding
|
||||||
|
;;;; would shadow the first and this would print 200.
|
||||||
|
|
||||||
|
(defn main [] i32
|
||||||
|
(println (outer 1))
|
||||||
|
0)
|
||||||
|
|
||||||
|
;; Expands to code that builds the symbol this expansion drew.
|
||||||
|
(defmacro baked []
|
||||||
|
(match (gensym)
|
||||||
|
(Form.Sym s) `(Form.Sym {.s ~(Form.Str {.s s})})
|
||||||
|
_ `(form-nil)))
|
||||||
|
|
||||||
|
(defmacro outer [a]
|
||||||
|
(let [g (baked)
|
||||||
|
h (gensym)]
|
||||||
|
`(let [~g ~a ~h 100] (+ ~g ~h))))
|
||||||
@ -99,4 +99,10 @@
|
|||||||
(Some v) (recur (+ i 1) (+ acc v))
|
(Some v) (recur (+ i 1) (+ acc v))
|
||||||
None acc)))
|
None acc)))
|
||||||
(println "") ; 0+1+2+3 = 6
|
(println "") ; 0+1+2+3 = 6
|
||||||
|
|
||||||
|
;; The bindings are sequential, as a let's are: the second initialiser reads
|
||||||
|
;; the first name. Only the initial values are; recur still rebinds at once.
|
||||||
|
(print (loop [a 1 b (+ a 10)]
|
||||||
|
(if (> a 3) b (recur (+ a 1) (+ b a)))))
|
||||||
|
(println "") ; 11+1+2+3 = 17
|
||||||
0)
|
0)
|
||||||
|
|||||||
16
test/programs/u64-decimal.flan
Normal file
16
test/programs/u64-decimal.flan
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
;;;; A u64 constant above 2^63 written in decimal, and an integer literal too
|
||||||
|
;;;; wide for i32 as a cast's argument.
|
||||||
|
|
||||||
|
(defconst top u64 18446744073709551615)
|
||||||
|
(defonce fnv u64 14695981039346656037)
|
||||||
|
|
||||||
|
(defn main [] i32
|
||||||
|
(println top)
|
||||||
|
(println fnv)
|
||||||
|
(println (u64 2935910691))
|
||||||
|
(println (u64 18446744073709551615))
|
||||||
|
(println (i64 -5000000000))
|
||||||
|
(println (f64 4000000000))
|
||||||
|
;; A literal that fits i32 keeps its default and is cast, as before.
|
||||||
|
(println (u32 -1))
|
||||||
|
0)
|
||||||
14
test/programs/vec-new-shadow.flan
Normal file
14
test/programs/vec-new-shadow.flan
Normal file
@ -0,0 +1,14 @@
|
|||||||
|
;;;; A program's own vec-new is an ordinary function: a bracket passed to it
|
||||||
|
;;;; is an array value, not an element type. builtin/vec-new is still the
|
||||||
|
;;;; builtin and still reads one as a type.
|
||||||
|
|
||||||
|
(defn vec-new [xs [1 i32]] i32 (at xs 0))
|
||||||
|
|
||||||
|
(defn main [] i32
|
||||||
|
(let [x 7
|
||||||
|
v (builtin/vec-new [u8])]
|
||||||
|
(println (vec-new [x]))
|
||||||
|
(push v (bytes-view "ab"))
|
||||||
|
(println (length (at v 0)))
|
||||||
|
(free v))
|
||||||
|
0)
|
||||||
25
test/programs/vec-new-type.flan
Normal file
25
test/programs/vec-new-type.flan
Normal file
@ -0,0 +1,25 @@
|
|||||||
|
;;;; vec-new and map-new take a type expression where they take a type, so a
|
||||||
|
;;;; local can hold a Vec of slices, of arrays or of pointers with nothing
|
||||||
|
;;;; else naming the element type. The last Vec names an allocator after its
|
||||||
|
;;;; type, which is the one argument that may follow.
|
||||||
|
|
||||||
|
(defn main [] i32
|
||||||
|
(let [a (arena-new 4096)
|
||||||
|
words (vec-new [u8])
|
||||||
|
pairs (vec-new [2 i32])
|
||||||
|
ptrs (vec-new (Ptr i32))
|
||||||
|
opts (vec-new (Option i64) a)
|
||||||
|
m (map-new string [u8])
|
||||||
|
x (i32 7)]
|
||||||
|
(push words (bytes-view "ab"))
|
||||||
|
(push words (bytes-view "cde"))
|
||||||
|
(push pairs [3 4])
|
||||||
|
(push ptrs (addr x))
|
||||||
|
(push opts (Some (i64 9)))
|
||||||
|
(put m "k" (bytes-view "xyz"))
|
||||||
|
(println (length words) (length (at words 1))
|
||||||
|
(at (at pairs 0) 1) (deref (at ptrs 0))
|
||||||
|
(match (at opts 0) (Some v) v None -1)
|
||||||
|
(match (get m "k") (Some v) (length v) None -1))
|
||||||
|
(free words) (free pairs) (free ptrs) (free m))
|
||||||
|
0)
|
||||||
@ -501,7 +501,25 @@ let () =
|
|||||||
rather than running out of stack. The swap line is the other — recur
|
rather than running out of stack. The swap line is the other — recur
|
||||||
rebinds every name at once, and interleaved writes would print 1. *)
|
rebinds every name at once, and interleaved writes would print 1. *)
|
||||||
outputs "loop and recur" "programs/recur.flan"
|
outputs "loop and recur" "programs/recur.flan"
|
||||||
"10\n2\n21\n8\n10000000\n64\n012\n0\n4\n012\n6\n";
|
"10\n2\n21\n8\n10000000\n64\n012\n0\n4\n012\n6\n17\n";
|
||||||
|
(* A type expression where vec-new and map-new take a type: a slice, an
|
||||||
|
array, a pointer and an option, with nothing else naming the element. *)
|
||||||
|
outputs "vec-new takes a type expression" "programs/vec-new-type.flan"
|
||||||
|
"2 3 4 7 9 3\n";
|
||||||
|
outputs ~x86:true "vec-new takes a type expression, x86"
|
||||||
|
"programs/vec-new-type.flan" "2 3 4 7 9 3\n";
|
||||||
|
(* A program's own vec-new takes its arguments as values; the builtin,
|
||||||
|
reached as builtin/vec-new, still reads a bracket as a type. *)
|
||||||
|
outputs "a vec-new of the program's own" "programs/vec-new-shadow.flan"
|
||||||
|
"7\n2\n";
|
||||||
|
(* A u64 above 2^63 in decimal, and a cast of a literal too wide for i32. *)
|
||||||
|
let u64_out =
|
||||||
|
"18446744073709551615\n14695981039346656037\n2935910691\n\
|
||||||
|
18446744073709551615\n-5000000000\n4e+09\n4294967295\n"
|
||||||
|
in
|
||||||
|
outputs "a u64 constant in decimal" "programs/u64-decimal.flan" u64_out;
|
||||||
|
outputs ~x86:true "a u64 constant in decimal, x86"
|
||||||
|
"programs/u64-decimal.flan" u64_out;
|
||||||
(* into. The count of pulls is the assertion a unit test cannot make: one
|
(* into. The count of pulls is the assertion a unit test cannot make: one
|
||||||
pass, one call per element per stage it reaches, and no intermediate
|
pass, one call per element per stage it reaches, and no intermediate
|
||||||
collection anywhere. The two show lines either side of it are the same
|
collection anywhere. The two show lines either side of it are the same
|
||||||
@ -2543,8 +2561,8 @@ let () =
|
|||||||
no overflow case because it has no most-negative value, and a float
|
no overflow case because it has no most-negative value, and a float
|
||||||
division by zero, which is an infinity and is a defined answer this
|
division by zero, which is an infinity and is a defined answer this
|
||||||
language has no business refusing. *)
|
language has no business refusing. *)
|
||||||
let arith ?opt () =
|
let arith ?opt ?x86 () =
|
||||||
let exe = compile ?opt "programs/arith.flan" in
|
let exe = compile ?opt ?x86 "programs/arith.flan" in
|
||||||
let traps name arg reason =
|
let traps name arg reason =
|
||||||
let code, text = run exe (Some arg) in
|
let code, text = run exe (Some arg) in
|
||||||
if code <> 134
|
if code <> 134
|
||||||
@ -2587,7 +2605,7 @@ let () =
|
|||||||
would have waved it through into an fptosi that is as undefined for a
|
would have waved it through into an fptosi that is as undefined for a
|
||||||
NaN as it is for 1e300. *)
|
NaN as it is for 1e300. *)
|
||||||
traps "NaN cast to an integer" "7"
|
traps "NaN cast to an integer" "7"
|
||||||
"does not fit the integer type it is cast to";
|
"this value is NaN, which has no integer value to cast to";
|
||||||
(* One width down, and this is the case the two backends disagreed about
|
(* One width down, and this is the case the two backends disagreed about
|
||||||
*silently* rather than both dying: x86 loaded the operands
|
*silently* rather than both dying: x86 loaded the operands
|
||||||
sign-extended into 64-bit registers, divided there and truncated on
|
sign-extended into 64-bit registers, divided there and truncated on
|
||||||
@ -2604,10 +2622,21 @@ let () =
|
|||||||
and this is the row that says so rather than the comment. *)
|
and this is the row that says so rather than the comment. *)
|
||||||
traps "an f32 too large for an i32" "9"
|
traps "an f32 too large for an i32" "9"
|
||||||
"which holds [-2147483648 2147483647]";
|
"which holds [-2147483648 2147483647]";
|
||||||
|
(* NaN and the infinities are named: they did not overshoot a range,
|
||||||
|
they have no integer value at all. *)
|
||||||
|
traps "an infinity cast to an integer" "10"
|
||||||
|
"this value is infinite, which has no integer value to cast to";
|
||||||
|
traps "an f32 negative infinity cast to a u8" "11"
|
||||||
|
"this value is infinite, which has no integer value to cast to";
|
||||||
|
traps "an f32 NaN cast to an integer" "12"
|
||||||
|
"this value is NaN, which has no integer value to cast to";
|
||||||
(try Sys.remove exe with Sys_error _ -> ())
|
(try Sys.remove exe with Sys_error _ -> ())
|
||||||
in
|
in
|
||||||
arith ();
|
arith ();
|
||||||
arith ~opt:"-O0" ();
|
arith ~opt:"-O0" ();
|
||||||
|
(* The x86 backend picks the code with its own instructions, so the three
|
||||||
|
named cases are asserted there as well as in the survey. *)
|
||||||
|
arith ~x86:true ();
|
||||||
|
|
||||||
(* The release build drops the guards. Asserted on the IR and not by
|
(* The release build drops the guards. Asserted on the IR and not by
|
||||||
running an unchecked program, for the reason the bounds case gives: an
|
running an unchecked program, for the reason the bounds case gives: an
|
||||||
@ -2646,7 +2675,7 @@ let () =
|
|||||||
op 2\nlhs -9223372036854775808\nrhs -1\nop 3\n\
|
op 2\nlhs -9223372036854775808\nrhs -1\nop 3\n\
|
||||||
cast 3\ncast -3\n\
|
cast 3\ncast -3\n\
|
||||||
op 4\nlhs -9223372036854775808\nrhs 9223372036854775807\nop 4\n\
|
op 4\nlhs -9223372036854775808\nrhs 9223372036854775807\nop 4\n\
|
||||||
cast8 12\nlhs -128\nrhs 127\nop 4\n\
|
cast8 12\nlhs -128\nrhs 127\nop 5\n\
|
||||||
lit 4611686018427387903\nu 14\n\
|
lit 4611686018427387903\nu 14\n\
|
||||||
frames 4\nskipped 8\ncleaned 12\n"
|
frames 4\nskipped 8\ncleaned 12\n"
|
||||||
in
|
in
|
||||||
@ -3896,6 +3925,11 @@ level "1"
|
|||||||
outputs ~dev:true "a macro's parameter list, dev"
|
outputs ~dev:true "a macro's parameter list, dev"
|
||||||
"programs/macro-params.flan" macro_params_out;
|
"programs/macro-params.flan" macro_params_out;
|
||||||
|
|
||||||
|
(* A gensym drawn in one round's module and one drawn in the module the
|
||||||
|
program is expanded with are different names. 200 is the two colliding. *)
|
||||||
|
outputs "gensym counts across macro modules"
|
||||||
|
"programs/macro-gensym-rounds.flan" "101\n";
|
||||||
|
|
||||||
(* A macro declared in an imported *package*, which is the half the
|
(* A macro declared in an imported *package*, which is the half the
|
||||||
refusal at [a package's macro is not visible unqualified] above leaves
|
refusal at [a package's macro is not visible unqualified] above leaves
|
||||||
out. The program calls six of them qualified and one of its own
|
out. The program calls six of them qualified and one of its own
|
||||||
|
|||||||
@ -92,6 +92,14 @@ let () =
|
|||||||
reads "bare plus" "+" "+";
|
reads "bare plus" "+" "+";
|
||||||
reads "float" "0.05" "0.05";
|
reads "float" "0.05" "0.05";
|
||||||
reads "hex" "0xE6B800FF" "3870818559";
|
reads "hex" "0xE6B800FF" "3870818559";
|
||||||
|
(* A decimal between 2^63 and 2^64 is its bit pattern, as hex is; one past
|
||||||
|
2^64, or a negative one past the smallest i64, is still malformed. *)
|
||||||
|
reads "u64 decimal" "18446744073709551615" "18446744073709551615";
|
||||||
|
reads "hex top bit" "0xFFFFFFFFFFFFFFFF" "0xFFFFFFFFFFFFFFFF";
|
||||||
|
rejects "decimal past 2^64" "18446744073709551616"
|
||||||
|
~needle:"malformed integer literal";
|
||||||
|
rejects "negative decimal past i64" "-9223372036854775809"
|
||||||
|
~needle:"malformed integer literal";
|
||||||
reads "string" "\"SAND\"" "\"SAND\"";
|
reads "string" "\"SAND\"" "\"SAND\"";
|
||||||
reads "symbol" "empty-at?" "empty-at?";
|
reads "symbol" "empty-at?" "empty-at?";
|
||||||
reads "qualified" "rl/draw-fps" "rl/draw-fps";
|
reads "qualified" "rl/draw-fps" "rl/draw-fps";
|
||||||
@ -6042,6 +6050,58 @@ let () =
|
|||||||
rejects_check "vec-new with no element type and nothing to take one from"
|
rejects_check "vec-new with no element type and nothing to take one from"
|
||||||
~needle:"nothing here says what (vec-new) is a Vec of"
|
~needle:"nothing here says what (vec-new) is a Vec of"
|
||||||
"(defn f [x $t] i32 (do x (let [v (vec-new)] (free v) 0)))";
|
"(defn f [x $t] i32 (do x (let [v (vec-new)] (free v) 0)))";
|
||||||
|
(* A type expression in a type position, generic or not. *)
|
||||||
|
accepts "vec-new over a slice of a type variable"
|
||||||
|
"(defn f [x [$t]] i32 (let [v (vec-new [$t])] (push v x) \
|
||||||
|
(let [n (length v)] (free v) n)))";
|
||||||
|
rejects_check "map-new with a key type expression and no value type"
|
||||||
|
~needle:"(map-new) names a key and no value"
|
||||||
|
"(defn f [] i32 (let [m (map-new [u8])] (free m) 0))";
|
||||||
|
accepts "vec-new over a function type returning unit"
|
||||||
|
"(defn f [] i32 (let [v (vec-new (Fn [i32] ()))] (free v) 0))";
|
||||||
|
accepts "a program's own vec-new takes an array literal"
|
||||||
|
"(defn vec-new [xs [3 i32]] i32 (at xs 2)) \
|
||||||
|
(defn f [] i32 (vec-new [1 2 3]))";
|
||||||
|
accepts "builtin/vec-new over a type expression"
|
||||||
|
"(defn f [] i32 (let [v (builtin/vec-new [u8])] (free v) 0))";
|
||||||
|
|
||||||
|
(* An integer written at or above 2^63 — decimal, or hex with the top bit
|
||||||
|
set — is a u64 and nothing else, and a refusal prints it as written. *)
|
||||||
|
accepts "a wide decimal at u64"
|
||||||
|
"(defconst a u64 18446744073709551615) (defonce b u64 0xFFFFFFFFFFFFFFFF) \
|
||||||
|
(defn f [x u64] u64 (+ x 9223372036854775808)) \
|
||||||
|
(defn g [] f64 (f64 (u64 12345678901234567890)))";
|
||||||
|
accepts "a negative decimal is still a u64 bit pattern"
|
||||||
|
"(defconst a u64 -1)";
|
||||||
|
rejects_check "a wide decimal with nothing to say u64"
|
||||||
|
~needle:"18446744073709551615 does not fit in i32, the type an integer \
|
||||||
|
literal takes when nothing says otherwise — write (u64 \
|
||||||
|
18446744073709551615)"
|
||||||
|
"(defn f [] () (println 18446744073709551615))";
|
||||||
|
rejects_check "a wide decimal cast to i64"
|
||||||
|
~needle:"18446744073709551615 does not fit in i64"
|
||||||
|
"(defn f [] i64 (i64 18446744073709551615))";
|
||||||
|
rejects_check "a wide decimal cast to f64"
|
||||||
|
~needle:"write (f64 (u64 18446744073709551615))"
|
||||||
|
"(defn f [] f64 (f64 18446744073709551615))";
|
||||||
|
rejects_check "a wide decimal constant at i32"
|
||||||
|
~needle:"18446744073709551615 does not fit in i32"
|
||||||
|
"(defconst x i32 18446744073709551615)";
|
||||||
|
rejects_check "a wide decimal constant at f64"
|
||||||
|
~needle:"write (f64 (u64 12345678901234567890))"
|
||||||
|
"(defconst x f64 12345678901234567890)";
|
||||||
|
rejects_check "a wide decimal argument to an i8 parameter"
|
||||||
|
~needle:"18446744073709551600 does not fit in i8"
|
||||||
|
"(defn g [a i8] i8 a) (defn f [] i8 (g 18446744073709551600))";
|
||||||
|
rejects_check "a wide decimal operand prints as written"
|
||||||
|
~needle:"9223372036854775808 does not fit in i32"
|
||||||
|
"(defn f [] () (println (+ 1 9223372036854775808)))";
|
||||||
|
rejects_check "a hex literal with the top bit set at i32"
|
||||||
|
~needle:"0xFFFFFFFFFFFFFFFF does not fit in i32"
|
||||||
|
"(defconst x i32 0xFFFFFFFFFFFFFFFF)";
|
||||||
|
rejects_check "a hex literal with the top bit set at i64"
|
||||||
|
~needle:"0xFFFFFFFFFFFFFFFF does not fit in i64"
|
||||||
|
"(defconst x i64 0xFFFFFFFFFFFFFFFF)";
|
||||||
(* And a sigil on a name nothing binds is answered as the unbound variable
|
(* And a sigil on a name nothing binds is answered as the unbound variable
|
||||||
it is, rather than as a missing element type — with the names that *are*
|
it is, rather than as a missing element type — with the names that *are*
|
||||||
bound, because inside a signature that introduces one the mistake is
|
bound, because inside a signature that introduces one the mistake is
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user