diff --git a/TODO.org b/TODO.org index 4082966a..c9cd0045 100644 --- a/TODO.org +++ b/TODO.org @@ -147,14 +147,7 @@ CLOSED: [2026-09-25] =f64-inf=, =f64-nan=, =f32-inf= and =f32-nan= are names the checker supplies (=Check.special_float=), reached only after every local, global and function has missed, so a program's own binding of one wins. Negative infinity is -=(- 0.0 f64-inf)=: the decision wrote =(- f64-inf)=, and there is no unary minus. -Rules out Clojure's =##Inf= reader literal. - -** TODO (!= x x) is false for a NaN -=!== on floats is LLVM's ordered =one= on both backends (=lib/emit.ml= =fcmp_op=, -=lib/x86.ml= =float_cc=), so =(!= f64-nan f64-nan)= is =false= where C, Odin and -IEEE 754 say =true=; =(not (= x x))= is the only NaN test that works. Changing it -to =une= is a decision about what =!== means. +=(- f64-inf)=. Rules out Clojure's =##Inf= reader literal. ** DONE A u64 constant above 2^63 cannot be written in decimal CLOSED: [2026-09-25] @@ -162,8 +155,8 @@ An integer written at or above 2^63 — a decimal up to 2^64 - 1, or hex with th top bit set — reads as =Form.UInt=, its pattern and its spelling. It is accepted 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 +negative at any integer type before this; it is refused now too. 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 passed to a macro as an argument comes back wide: it crosses as an =Int= with a token in the unused @@ -957,19 +950,13 @@ type an expression cannot hold, such as =(Fn [i32] ())=, is parsed as ** DONE An array literal cannot say it is [f32] CLOSED: [2026-09-25] -With nothing outside an array literal naming its element type, the first -element's type is the want for the rest, so =[(f32 1.0) 2.5]= is a =[2 f32]=. A -refusal of a later element carries a note at the first saying it set the type. -Rules out a =1.0f= suffix for now. +=(the [f32] [1 2.5])= names the element type; with nothing naming one, a literal +element takes the other elements' type. Rules out a =1.0f= suffix for now. -** NEXT A let binding takes no type annotation -Decided 2026-09-25: =(the T expr)=, Common Lisp's special operator, gives any expression its want; checked at compile time like any other want, and it compiles to nothing. =let= is unchanged. On a =dyn= operand it is refused, naming the cast. The refusals that say "annotate the binding" — =None=, an empty =[]=, and =(zeroed)=/=(filled)=/=(dead-beef)= with no want — suggest it instead, because today their suggestion cannot compile. -Everything under the surface is there — the binding carries a type slot and the -checker consumes it as the want — and only the way it is written is open, because -=let= is a flat list of pairs and cannot disambiguate by count. No longer the -blocker it was, since =(array 4 T)= answers the case that raised it. plan.org's -rule is "annotate function signatures, infer locals", so a general annotation is a -deliberate absence. +** DONE A let binding takes no type annotation +CLOSED: [2026-09-25] +=(the T expr)= gives any expression its want and =let= stays a flat list of +pairs. Rules out a type slot in =let=. ** NEXT A read-only slice type Decided 2026-09-25: =[const u8]=, Zig's spelling in Flan's brackets. =bytes-view= answers one and a =set= through it is a compile error; a =[T]= converts to =[const T]= and not back, and the prelude's read-only functions take it. =const= is reserved as a name, since =[n T]= accepts a constant's name for =n=. @@ -1025,10 +1012,9 @@ died in the backend as a redefinition of a symbol, a message with no source location. ** DONE A u64 literal is its 64-bit pattern -The cost of accepting the pattern is that a negative decimal literal is accepted -as a =u64=, because the reader records 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= shows up. +A negative literal fits no unsigned type, u64 included; =(u64 -1)= is how the +pattern is written, and a constant folds it. Rules out a negative decimal as a +u64's bit pattern. ** DONE A folded constant does not skip the range check The folding pass makes its own call to the range test, because a global's @@ -1090,11 +1076,6 @@ An unknown call whose near miss is a value — =(context-allocator)= against =context/allocator=, or a global — says the name is a value written without parentheses, and names no call at all when the call had arguments. -** NEXT (max-value T) and (min-value T) -Decided 2026-09-25: the type-limit constants as a form taking a type, Odin's -max(T), valid at any numeric type or a numeric?-bounded variable. For a float, -min-of is the most negative finite value. - ** NEXT (Ptr const T), the pointer beside [const T] Decided 2026-09-25: addr through a read-only slice gives a (Ptr const T), which nothing writes through; (Ptr T) widens to it and never back; a C parameter @@ -1575,14 +1556,19 @@ incarnation it was made for; every use compares the incarnation, so a destroyed arena traps whether or not a later arena-new reused its record. Rules out static tracking of destroy, which is move semantics. -** NEXT A mixed array literal with no want is a dyn vector -Decided 2026-09-25: with nothing expected of it, an array literal whose elements -agree (numbers widening together) is typed; one whose elements mix — [10 "Hi"], -[nil 1] — is a dyn vector. (the [T] ...) forces a typed one, and a want from -context still wins. Replaces the first-element carry-over. +** DONE A mixed array literal with no want is a dyn vector +CLOSED: [2026-09-25] +Elements that agree, numbers meeting at the wider, are typed; elements that mix +are a dyn vector, except numbers with no common type, which are refused. Rules +out the first element typing the rest. * Dev loop +** TODO A prelude function shadowed live is reached by the prelude's own calls +A defn of a prelude function's name sent to a running =flan dev= installs into the +host's cell for that name, so the prelude's calls compiled into the host follow it; +a rebuild gives them the prelude's again, as =Check.shadow_prelude= intends. + ** DONE The dev loop, step 1: the reload primitive A list of top-level forms is recompiled and installed into a running process, and call sites compiled before those forms existed follow them through an indirection diff --git a/bin/main.ml b/bin/main.ml index f4564016..0f1db3e2 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -362,6 +362,7 @@ let () = p.globals; List.iter (fun (f : Flan.Tast.fn) -> + if not (Flan.Check.internal_name f.name) then Printf.printf "defn %s : (Fn [%s] %s) %d slots\n" f.name (String.concat " " (List.map Flan.Types.to_string f.params)) @@ -736,6 +737,8 @@ let () = if List.mem warn_memory_flag rest then print_memory_warnings ~file:path p) in + Flan.Build.need_main ~file:path ~doing:"flan build has nothing to link" + f.program; ignore (Flan.Build.executable ~opts:{ Flan.Build.default with checks; dev; debug; sanitize; target; x86; @@ -915,6 +918,8 @@ let () = (Printf.sprintf "flan-run-%d" (Unix.getpid ())) in let f = Flan.Front.linked ~all:true path in + Flan.Build.need_main ~file:path ~doing:"flan run has nothing to run" + f.program; ignore (Flan.Build.executable ~opts:{ Flan.Build.default with checks; debug; sanitize; x86; diff --git a/emacs/flan-mode.el b/emacs/flan-mode.el index 05b2747c..e297b3a7 100644 --- a/emacs/flan-mode.el +++ b/emacs/flan-mode.el @@ -129,7 +129,7 @@ (defconst flan--special '("quote" "do" "let" "if" "when" "cond" "and" "or" "while" "until" "break" "continue" "return" "set" - "array" "array-fill" "array-gen" "match" "fn" "dotimes" "loop" "recur" + "array" "array-fill" "array-gen" "the" "match" "fn" "dotimes" "loop" "recur" "defer" "some" "try" "signal" "error" "handler-bind" "handler-case" "restart-case" "invoke-restart") "The heads `Parse.form' dispatches on — the forms with a meaning of their own. diff --git a/lib/ast.ml b/lib/ast.ml index 67902059..3ecf117f 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -126,6 +126,10 @@ and expr_kind = dimension; [ArrayFill]'s is the element value itself, evaluated once. *) | ArrayFill of len list * expr | ArrayGen of len list * expr + (* (the T e) — [e] checked with [T] as its expectation, Common Lisp's + special operator. A binding has no type slot, and this is what gives any + expression one; it compiles to [e]. *) + | The of texpr * expr (* These bind names or alter control flow, so none of them can be a call. *) | Fn of string list * expr list (* (fn [x y] ...) *) (* (dotimes :o [i n] ...), (dotimes [i start stop] ...) and @@ -438,6 +442,7 @@ let map_children f (e : expr) : expr = subexpressions. The dimensions are [len]s and hold none. *) | ArrayFill (ds, v) -> ArrayFill (ds, ex v) | ArrayGen (ds, f) -> ArrayGen (ds, ex f) + | The (t, x) -> The (t, ex x) | Fn (ps, es) -> Fn (ps, List.map ex es) | Dotimes (l, n, b, es) -> Dotimes (l, n, diff --git a/lib/build.ml b/lib/build.ml index 899310d2..70e94449 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -744,6 +744,22 @@ let compile_c ~opts ?tflags ?(warn = []) ~src ~name () = end; obj +(* A program with no [main] builds every function and then fails at the link, + as an undefined reference from the C startup code — a message about crt1.o + for a mistake in the .flan file. Asked here, by the commands that make an + executable, rather than inside [executable], whose callers include hosts + and tests that supply their own [main]. *) +let need_main ~file ~doing (p : Tast.program) = + if not (List.exists (fun (f : Tast.fn) -> f.Tast.name = "main") p.Tast.fns) + then + failwith + (Printf.sprintf + "%s has no main, so %s. A program starts at a function named main, \ + for example:\n\n\ + \ (defn main [] i32\n\ + \ 0)" + file doing) + (* [csrcs] and [lflags] come from the imported packages (see [Load]): the C shim a package binds through, and the arguments needed to link the library it binds to. diff --git a/lib/check.ml b/lib/check.ml index 80b92b58..49013241 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -2074,12 +2074,20 @@ let mk loc ty e : Tast.expr = { Tast.e; ty; loc } let unit_at loc = mk loc Types.Unit Tast.Unit +(* The compiler temp an [and] leaves in its else arm; see [check_if]. *) +let and_sentinel (x : Ast.expr) = + match x.Ast.e with + | Ast.Var n -> String.length n > 4 && String.sub n 0 4 = "and~" + | _ -> false + (* Integer arithmetic over literals alone, folded. Unlike [const_int] no name is read: a defconst has a type of its own, and only an untyped constant may stand at a type variable. *) let rec literal_arith (e : Ast.expr) : int64 option = match e.Ast.e with | Ast.Int n -> Some n + | Ast.Call ({ Ast.e = Ast.Var "-"; _ }, [ x ]) -> + Option.map Int64.neg (literal_arith x) | Ast.Call ({ Ast.e = Ast.Var op; _ }, x :: y :: rest) -> let step a b = match op with @@ -2098,6 +2106,10 @@ let rec literal_arith (e : Ast.expr) : int64 option = (literal_arith x) (y :: rest) | _ -> None +(* A value with no type until one is asked of it: a literal, or arithmetic + over literals alone. *) +let lone_literal (e : Ast.expr) = is_literal e || literal_arith e <> None + (* The environment for a lifted body, built once its own body has been checked and [caught] is therefore final. spec-memory.md's case 2, and the whole of @@ -3571,6 +3583,28 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = let tail = ctx.tail in ctx.tail <- false; match e.Ast.e with + (* A negative literal in a generic body, at an instantiation that made it + unsigned. The cast the ordinary refusal names would be wrong at every + other type the function is called at, so the fix is one that needs no + negative number at all, and the refusal says which call asked. *) + | Ast.Int n + when Int64.compare n 0L < 0 && ctx.env.chain <> [] + && (match want with + | Some (Types.Int k) -> not (Types.signed k) + | _ -> false) -> + let t = Option.get want in + let gname, _, at = List.nth ctx.env.chain (List.length ctx.env.chain - 1) in + let var = + match List.find_opt (fun (_, u) -> Types.equal u t) ctx.env.subst with + | Some (v, _) -> Printf.sprintf "$%s = %s" v (Types.to_string t) + | None -> Types.to_string t + in + Loc.failk literal_at_want loc + ~notes:[ Loc.note at (Printf.sprintf "%s is instantiated at %s here" gname var) ] + "%Ld does not fit in %s, which holds no negative number, and %s is called \ + at %s — the body has to work at every type it is called at, so write \ + it with no negative literal, as in (- x %Ld) in place of (+ x %Ld)" + n (Types.to_string t) gname var (Int64.neg n) 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 -> @@ -3826,18 +3860,7 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = {:xs [1 2]} mean what it reads as. Everywhere else brackets stay the fixed-array literal they always were. *) | Ast.Arr items when want = Some Types.Dyn -> - let v = fresh_slot ctx Types.Dyn in - let vval = mk loc Types.Dyn (Tast.Local v) in - let pushes = - List.map - (fun x -> - rt loc Types.Unit "flan_dyn_push" - [ vval; check ctx ~want:Types.Dyn x; here loc ]) - items - in - mk loc Types.Dyn - (Tast.Let ([ (v, rt loc Types.Dyn "flan_dyn_vec_new" []) ], - pushes @ [ vval ])) + dyn_vec ctx loc (map_lr (fun x -> check ctx ~want:Types.Dyn x) items) | Ast.Arr items -> check_arr ctx ~want loc items (* (array 4 rl/Vector2). Parse already assembled the whole array type, so there is nothing to infer: resolve it and hand back its all-bytes-zero @@ -3852,6 +3875,7 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = 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.ArrayGen (dims, f) -> check_array_gen ctx ~want loc dims f + | Ast.The (t, v) -> check_the ctx ~want loc t v | Ast.Match (scrutinee, arms) -> check_match ctx ~tail ?want loc scrutinee arms (* Constant integer arithmetic where a type variable is wanted is folded to the literal it computes first, so [(+ x (+ 1 2))] is admitted wherever @@ -4069,24 +4093,34 @@ and wide_literal loc ~want n s = (* 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. *) -and in_range loc k n = +and in_range ?(pattern = false) loc k n = let bits = Types.bits k in let ok = if Types.signed k then bits = 64 || (Int64.compare n (Int64.neg (Int64.shift_left 1L (bits - 1))) >= 0 && Int64.compare n (Int64.shift_left 1L (bits - 1)) < 0) - else if bits = 64 then - (* A literal at or above 2^63 is a [UInt] and never reaches here; see - [wide_literal]. A negative decimal is accepted as a u64's bit pattern, - which is a settled rule. Narrower unsigned types keep the strict - check, which is where a typo like 300 for a u8 actually shows up. *) - true + (* A literal at or above 2^63 is a [UInt] and never reaches here as a + literal; see [wide_literal]. [pattern] is the folded-constant path, + which holds a u64 as its 64-bit pattern and cannot tell 2^64 - 1 from + -1, so there every pattern is a u64. *) + else if bits = 64 then pattern || Int64.compare n 0L >= 0 else Int64.compare n 0L >= 0 && Int64.compare n (Int64.shift_left 1L bits) < 0 in if ok then n + else if Int64.compare n 0L < 0 && not (Types.signed k) then + (* A negative number at an unsigned type is never the value it reads as. + The cast is how to ask for the bit pattern, and names what it is. *) + let mask = + if bits = 64 then -1L else Int64.sub (Int64.shift_left 1L bits) 1L + in + let tn = Types.ikind_name k in + Loc.failk literal_at_want loc + "%Ld does not fit in %s, which holds no negative number — write (%s %Ld) \ + for the %s with the same bits, %Lu" + n tn tn n tn (Int64.logand n mask) else Loc.failk literal_at_want loc "%Ld does not fit in %s" n (Types.ikind_name k) @@ -4129,8 +4163,8 @@ and var ctx ?(qualified = false) loc ~want name = fail loc "expected %s, found None" (Types.to_string other) | _ -> fail loc - "nothing here says what None is an Option of — annotate the \ - function's return type or the binding") + "nothing here says what None is an Option of — use it where an \ + Option is expected, or name one, as in (the (Option i32) None)") (* spec-memory.md puts the allocator in the calling convention as [context/allocator] and [context/temp]. They read as names rather than calls because that is how the spec writes them, and they are dynamic @@ -5321,6 +5355,27 @@ and check_if ctx ?(tail = false) ?want loc c t e = no value on the missing side. `when` desugars to this. *) let t = branch ctx (fun () -> in_tail (fun () -> check ctx t)) in expect ctx loc ~want (mk loc Types.Unit (Tast.If (c, t, unit_at loc))) + (* Two literal arms meet at the wider of their own types, as two literal + elements of an array do: [(if c 1 2.5)] is an f64. *) + | Some e + when want = None && lone_literal t && lone_literal e + && (match literal_join ctx t e with + | Some j -> not (Types.equal j (Types.Int Types.I32)) + | None -> false) -> + let want = literal_join ctx t e in + let t = branch ctx (fun () -> in_tail (fun () -> check ctx ?want t)) in + let e = branch ctx (fun () -> in_tail (fun () -> check ctx ?want e)) in + mk loc t.Tast.ty (Tast.If (c, t, e)) + | Some e when want = None && lone_literal t && not (lone_literal e) + && not (and_sentinel e) -> + (* A literal has no type of its own until something asks, so with no + expectation the other arm decides: [(if c 4000000 n)] over an i64 [n] + is an i64, as [(+ 4000000 n)] is. *) + let e = branch ctx (fun () -> in_tail (fun () -> check ctx e)) in + let twant = if e.Tast.ty = Types.Never then None else Some e.Tast.ty in + let t = branch ctx (fun () -> in_tail (fun () -> check ctx ?want:twant t)) in + let ty = if e.Tast.ty = Types.Never then t.Tast.ty else e.Tast.ty in + mk loc ty (Tast.If (c, t, e)) | Some e -> let t = branch ctx (fun () -> in_tail (fun () -> check ctx ?want t)) in (* With no expectation the then-branch supplies one for the else-branch, @@ -5344,12 +5399,6 @@ and check_if ctx ?(tail = false) ?want loc c t e = sentinel in the then arm, so every operand is already blamed at its own location; and with an expectation in hand both arms are checked against it rather than against each other, so nothing here runs. *) - let and_sentinel (x : Ast.expr) = - match x.Ast.e with - | Ast.Var n -> - String.length n > 4 && String.sub n 0 4 = "and~" - | _ -> false - in let e = match branch ctx (fun () -> in_tail (fun () -> check ctx ?want:ewant e)) with | v -> v @@ -5371,6 +5420,18 @@ and check_if ctx ?(tail = false) ?want loc c t e = in mk loc ty (Tast.If (c, t, e)) +(* The type two literals meet at, each at its own type — a wide integer at + u64, which is the only type that holds one. *) +and literal_join ctx (a : Ast.expr) (b : Ast.expr) = + let own (x : Ast.expr) = + match x.Ast.e with + | Ast.UInt _ -> Some (Types.Int Types.U64) + | _ -> probe ctx x.Ast.loc (fun () -> (check ctx x).Tast.ty) + in + match own a, own b with + | Some x, Some y -> Types.join x y + | _ -> None + (* Whether a name would reach a callee if it were called — a global function, a generic, or a local holding a function value. The three sources [named_call] itself consults, in its own order; builtins are deliberately not among them, @@ -5696,63 +5757,31 @@ and check_arr ctx ~want loc items = | Some (Types.Slice t) -> Some t | _ -> None in - (* With nothing outside saying what the elements are, the first one says: - [[(f32 1.0) 2.5]] is an [[2 f32]], its [2.5] checked at [f32] the way it - would be at an [f32] parameter. *) - let items = - match elem_want, items with - | Some _, _ | None, [] -> map_lr (fun i -> check ctx ?want:elem_want i) items - | None, first :: rest -> - let first_ast = first in - let first = check ctx first in - let want = - match first.Tast.ty with Types.Never -> None | t -> Some t - in - (* A refusal of the element itself says where its type came from. *) - let one (i : Ast.expr) = - (match i.Ast.e, want with - | Ast.UInt (_, text), Some (Types.Int k) when k <> Types.U64 -> - let first_src = - match first_ast.Ast.e with - | Ast.Int _ | Ast.Byte _ -> Some (spell_arg "" first_ast) - | _ -> None - in - Loc.failk literal_at_want i.Ast.loc - ~notes: - [ Loc.note first.Tast.loc - (Printf.sprintf - "this array's first element is %s, so every element is" - (Types.ikind_name k)) ] - "%s does not fit in %s, and only a u64 holds it%s" text - (Types.ikind_name k) - (match first_src with - | Some f -> - Printf.sprintf " — write the first element as (u64 %s) for an \ - array of u64" f - | None -> " — make the first element a u64 for an array of u64") - | _ -> ()); - try check ctx ?want i with - | Loc.Error d when d.Loc.dloc = i.Ast.loc && want <> None -> - raise - (Loc.Error - { d with - Loc.notes = - d.Loc.notes - @ [ Loc.note first.Tast.loc - (Printf.sprintf - "this array's first element is %s, so every \ - element is" - (Types.to_string first.Tast.ty)) ] }) - in - first :: map_lr one rest - in + match elem_want, items with + | None, _ :: _ -> + (match arr_elem_type ctx items with + | Some t -> + let n = Int64.of_int (List.length items) in + expect ctx loc ~want + (check_arr ctx ~want:(Some (Types.Array (n, t))) loc items) + | None -> + (match + trial ctx (fun () -> + dyn_vec ctx loc (map_lr (fun i -> check ctx ~want:Types.Dyn i) items)) + with + | Ok v -> expect ctx loc ~want v + | Error d -> mixed_refusal ctx items d)) + | _ -> + let items = map_lr (fun i -> check ctx ?want:elem_want i) items in let n = Int64.of_int (List.length items) in let elem = match elem_want, items with | Some t, _ -> t | None, first :: _ -> first.Tast.ty | None, [] -> - fail loc "an empty array literal needs a type — annotate the binding" + fail loc + "an empty array literal needs a type — use it where one is expected, \ + or name it, as in (the [0 i32] [])" in List.iter (fun (i : Tast.expr) -> @@ -5768,6 +5797,206 @@ and check_arr ctx ~want loc items = an array literal does not satisfy a slice expectation. *) expect ctx loc ~want (mk loc (Types.Array (n, elem)) (Tast.Arr items)) +(* The element type of an array literal nothing outside it names, or [None] + for a dyn vector. Every element is looked at on its own terms first, by + [probe], so nothing here is checked for real — [check_arr] does that once, + at the answer. + + Elements that agree are a typed array: one type, or numbers that meet at + the wider of them the way two operands of [+] do. A literal takes the + others' type if it fits it, so [[(f32 1.0) 2.5]] is an [[2 f32]] and + [[(u8 1) 300]] an [[2 i32]]. An element that cannot be checked without + being told what it is — [None], a bare struct — takes the same type. + Elements that do not agree — [[10 "Hi"]], a dyn beside anything that is + not one — are a dyn vector, which is what the same brackets are where a + dyn is expected. Numbers that do not agree are refused instead; see + [numbers_disagree]. *) +and arr_elem_type ctx (items : Ast.expr list) : Types.t option = + let natural (i : Ast.expr) = + match i.Ast.e with + (* Refused with no want, and only a u64 holds one. *) + | Ast.UInt _ -> Some (Types.Int Types.U64) + | _ -> probe ctx i.Ast.loc (fun () -> (check ctx i).Tast.ty) + in + let fits t (i : Ast.expr) = + probe ctx i.Ast.loc (fun () -> ignore (check ctx ~want:t i)) <> None + in + let lits, rest = List.partition lone_literal items in + let typed, needs = + List.partition_map + (fun i -> + match natural i with Some t -> Left (i, t) | None -> Right i) + rest + in + let tys = + List.filter (fun t -> t <> Types.Never) (List.map snd typed) + in + let lit_tys = List.filter_map natural lits in + let join_all = function + | [] -> None + | t :: ts -> + List.fold_left + (fun acc t -> Option.bind acc (fun a -> Types.join a t)) (Some t) ts + in + let mixed_dyn = + List.mem Types.Dyn tys + && (List.exists (fun t -> t <> Types.Dyn) tys || lits <> []) + in + let all_fit t = List.for_all (fits t) lits && List.for_all (fits t) needs in + (* A candidate the literals do not all fit is widened by the ones that do + not, once: [[x 2.5]] over an i32 [x] meets at f64. *) + let settle = function + | None -> None + | Some t when all_fit t -> Some t + | Some t -> + let t' = + List.fold_left + (fun acc i -> + if fits t i then acc + else Option.bind acc (fun a -> Option.bind (natural i) (Types.join a))) + (Some t) lits + in + (match t' with + | Some t' when not (Types.equal t' t) && all_fit t' -> Some t' + | _ -> None) + in + let candidates = + if tys <> [] then [ join_all tys ] + else join_all lit_tys :: List.map Option.some lit_tys + in + if mixed_dyn then None + else if tys = [] && lits = [] then + (match typed, needs with + | _ :: _, [] -> Some Types.Never + (* Nothing here says what any of them is. The first one's own refusal is + the one worth reading. *) + | _, first :: _ -> ignore (check ctx first); None + | [], [] -> None) + else + match + List.fold_left + (fun found c -> match found with Some _ -> found | None -> settle c) + None candidates + with + | Some t -> Some t + | None -> + let numeric t = match t with Types.Int _ | Types.Float _ -> true | _ -> false in + if needs = [] && List.for_all numeric (tys @ lit_tys) then + numbers_disagree ctx + (List.filter_map + (fun i -> Option.map (fun t -> (i, t)) (natural i)) items) + else None + +(* Numbers with no type they all meet at — an i32 beside an f32, an i64 beside + a u64 — are refused rather than boxed into a dyn vector: the elements are + all numbers, and which one should move is the program's to say. The fix + named converts the second of the first disagreeing pair, into the float + when one of the two is a float and into the first's type otherwise. *) +and numbers_disagree : 'a. ctx -> (Ast.expr * Types.t) list -> 'a = + fun ctx elems -> + match elems with + | [] -> fail Loc.unknown "internal: an array of numbers with no elements" + | _ :: _ -> + (* A literal is not one of the disagreeing types when it fits the others: + each is checked at the type the rest meet at — or, with every element a + literal, at the u64 a wide one needs — and the first that does not fit + is the refusal, its own. *) + let lit (e, _) = lone_literal e in + let others = List.filter (fun p -> not (lit p)) elems in + let meet = + match others with + | [] -> + if List.exists (fun (e, _) -> match e.Ast.e with Ast.UInt _ -> true | _ -> false) elems + then Some (Types.Int Types.U64) else None + | (_, t) :: ts -> + List.fold_left (fun acc (_, u) -> Option.bind acc (fun a -> Types.join a u)) + (Some t) ts + in + (match meet with + | Some (Types.Int _ as m) -> + List.iter + (fun (e, t) -> + if lone_literal e && (match t with Types.Int _ -> true | _ -> false) + then ignore (check ctx ~want:m e)) + elems + | _ -> ()); + let pool = if others = [] then elems else others in + let first, t1 = List.hd pool in + let second, t2 = + match List.find_opt (fun (_, t) -> Types.join t1 t = None) (List.tl pool) with + | Some p -> p + | None -> + (match List.find_opt (fun (_, t) -> Types.join t1 t = None) elems with + | Some p -> p + | None -> List.nth elems (List.length elems - 1)) + in + let target, moved, moved_ty, other = + match t1, t2 with + | Types.Int _, Types.Float _ -> t2, first, t1, second + | _ -> t1, second, t2, first + in + ignore ctx; + let tn = Types.to_string target in + Loc.failk "check/array-numbers-disagree" moved.Ast.loc + ~notes:[ Loc.note other.Ast.loc (Printf.sprintf "this element is %s" tn) ] + "this array's elements are %s and %s, and neither holds every value of \ + the other — %s" + (Types.to_string moved_ty) tn + (match spell_arg "" moved with + | "" -> + Printf.sprintf "convert the %s element with the %s cast" (Types.to_string moved_ty) tn + | x -> Printf.sprintf "convert one, as in (%s %s)" tn x) + +(* Elements that do not agree and cannot all become a dyn either: a struct + beside a number, a type variable beside a literal. The dyn vector's refusal + would be about dyn, which the program never mentioned, so the elements are + refused against each other instead — the first one's type is what the rest + are checked at, and the refusal points back at it. [d] is the answer if + that finds nothing. *) +and mixed_refusal : 'a. ctx -> Ast.expr list -> Loc.diag -> 'a = + fun ctx items d -> + match items with + | [] -> raise (Loc.Error d) + | first :: rest -> + let first = check ctx first in + let want = match first.Tast.ty with Types.Never -> None | t -> Some t in + List.iter + (fun (i : Ast.expr) -> + match check ctx ?want i with + | v -> + (match want with + | Some t when not (Types.fits ~expected:t ~actual:v.Tast.ty) -> + fail i.Ast.loc "this array's elements are %s, but this one is %s" + (Types.to_string t) (Types.to_string v.Tast.ty) + | _ -> ()) + | exception Loc.Error e when e.Loc.dloc = i.Ast.loc && want <> None -> + raise + (Loc.Error + { e with + Loc.notes = + e.Loc.notes + @ [ Loc.note first.Tast.loc + (Printf.sprintf + "this array's first element is %s, so every \ + element is" + (match first.Tast.ty with + | Types.Var v -> "$" ^ v + | t -> Types.to_string t)) ] })) + rest; + raise (Loc.Error d) + +(* A dyn vector built where it stands from elements already checked at dyn: + the runtime's own vec, pushed to in order. *) +and dyn_vec ctx loc (items : Tast.expr list) = + let v = fresh_slot ctx Types.Dyn in + let vval = mk loc Types.Dyn (Tast.Local v) in + let pushes = + List.map (fun x -> rt loc Types.Unit "flan_dyn_push" [ vval; x; here loc ]) + items + in + mk loc Types.Dyn + (Tast.Let ([ (v, rt loc Types.Dyn "flan_dyn_vec_new" []) ], pushes @ [ vval ])) + (* ── (array-fill [r c] v) and (array-gen [r c] f) ────────────────────── TODO.org, "A value-producing array constructor". [(array 4 T)] is @@ -5886,6 +6115,78 @@ and array_build ctx loc ns elem ~pre ~element = (Tast.Let (pre @ [ (arr, mk loc aty (Tast.Zero aty)) ], [ nest ns islots; arrv ])) +(* (the T e): [e] with [T] as its expectation, which is every conversion an + annotation would make — a literal built at T, a narrower number widened — + and nothing more. A dyn operand is the exception: an expectation would + unbox it and trap at run time on a mismatch, and [the] is a statement about + the type rather than a conversion, so it is refused and the cast named. + + [(the [T] [...])] asks for the literal's element type and answers the + [n T] the literal is, since an array literal is never a slice. *) +and check_the ctx ~want loc (t : Ast.texpr) (v : Ast.expr) = + let ty = resolve ctx.env t in + let is_nil = match v.Ast.e with Ast.Var "nil" -> true | _ -> false in + if ty <> Types.Dyn && not is_nil + && probe ctx loc (fun () -> (check ctx v).Tast.ty) = Some Types.Dyn + then begin + let tn = Types.to_string ty in + let numeric = match ty with Types.Int _ | Types.Float _ -> true | _ -> false in + if numeric then + fail v.Ast.loc + "the checks a value as %s and does not convert one, and this is a dyn \ + — %s" + tn + (match spell_arg "" v with + | "" -> Printf.sprintf "convert it with the %s cast instead" tn + | s -> Printf.sprintf "write (%s %s) to convert it" tn s) + else + (* What a dyn does at this type is the boundary's own answer, asked of + it rather than restated: some types take one where a value is passed, + returned or stored, and the rest do not take one at all. *) + let crosses = + probe ctx loc (fun () -> + ignore (expect ctx v.Ast.loc ~want:(Some ty) (check ctx v))) + in + match crosses with + | Some () -> + fail v.Ast.loc + "the checks a value as %s and does not convert one, and this is a \ + dyn — a dyn becomes a %s where a %s is passed, returned or stored" + tn tn tn + | None -> + (match check ctx ~want:ty v with + | _ -> + fail v.Ast.loc + "the checks a value as %s and does not convert one, and this is \ + a dyn" tn + | exception Loc.Error d -> + fail v.Ast.loc + "the checks a value as %s and does not convert one, and this is \ + a dyn — %s" tn d.Loc.dmsg) + end; + let r = + match ty, v.Ast.e with + | Types.Slice elem, Ast.Arr items -> + check_arr ctx + ~want:(Some (Types.Array (Int64.of_int (List.length items), elem))) + v.Ast.loc items + | _ -> expect ctx v.Ast.loc ~want:(Some ty) (check ctx ~want:ty v) + in + expect ctx loc ~want r + +(* [f] run for its answer alone: whatever it wrote into the context is put + back whether it succeeded or not, so a form can be checked once to see what + it is and then checked again for real. [None] if it was refused. *) +and probe : 'a. ctx -> Loc.t -> (unit -> 'a) -> 'a option = fun ctx loc f -> + let answer = ref None in + (match + trial ctx (fun () -> + answer := Some (f ()); + raise (Loc.Error (Loc.diag loc "probe"))) + with + | _ -> ()); + !answer + and check_array_fill ctx ~want loc dims v = let ns = array_dims ctx loc dims in let elem_want = array_elem_want (List.length ns) want in @@ -6080,7 +6381,7 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = let want = ref want in let seen = Hashtbl.create 8 in let saw_wild = ref false in - let arms = + let resolved = map_lr (fun (a : Ast.arm) -> let ctor, binds = resolve_pat a in @@ -6091,6 +6392,48 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = fail a.Ast.aloc "this match has two %s arms" (match subject with `Enum _ -> ":" ^ c | _ -> c); Hashtbl.add seen c ()); + (a, ctor, binds)) + arms + in + (* With nothing expected of the match, the first arm's type is every arm's — + unless that arm is a bare literal, which has no type until asked. So the + arms whose value is a literal are checked last, and take their type from + the others, as an [if]'s literal arm does. The order is only the order + they are checked in; they are put back in source order below. *) + let literal_arm ((a : Ast.arm), _, _) = + match List.rev a.Ast.body with last :: _ -> lone_literal last | [] -> false + in + (* Every arm a literal: they meet at the wider of their own types, as an + [if]'s two do. *) + (if !want = None && resolved <> [] && List.for_all literal_arm resolved then + let lasts = + List.map (fun ((a : Ast.arm), _, _) -> List.hd (List.rev a.Ast.body)) + resolved + in + match lasts with + | first :: rest -> + let j = + List.fold_left + (fun acc x -> + Option.bind acc (fun a -> + Option.bind (literal_join ctx first x) (Types.join a))) + (literal_join ctx first first) rest + in + (match j with + | Some t when not (Types.equal t (Types.Int Types.I32)) -> want := Some t + | _ -> ()) + | [] -> ()); + let order = + let idx = List.mapi (fun i r -> (i, r)) resolved in + if !want <> None then idx + else + List.filter (fun (_, r) -> not (literal_arm r)) idx + @ List.filter (fun (_, r) -> literal_arm r) idx + in + let checked = + map_lr + (fun (i, ((a : Ast.arm), ctor, binds)) -> + i, branch ctx (fun () -> (* What each name in this arm is, in words, for the one refusal that needs it: a case pattern binds fields positionally, so the @@ -6126,7 +6469,10 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = if !want = None && body.Tast.ty <> Types.Never then want := Some body.Tast.ty; { Tast.acase = ctor; binds; abody = [ body ] })) - arms + order + in + let arms = + List.map snd (List.sort (fun (i, _) (j, _) -> compare i j) checked) in (* Exhaustiveness is refused, not defaulted. A match that silently fell through would have to produce a value of the match's type out of nothing, @@ -6609,12 +6955,9 @@ and arity _ctx loc name n args = Two is the floor, and the two missing cases are refused rather than invented. Zero operands would have to mean an identity element, 0 for + and 1 for *, and a sum with no terms in it is a typo far more often than it is - an intent. One operand would have to mean negation for [-] and reciprocal - for [/], and this language has no unary minus anywhere: the prelude writes - every negation as [(- 0 n)] or [(- 0.0 x)], and [(- x)] meaning something - else than the [-] two lines above it is a rule a reader has to carry rather - than see. Integer division makes the reciprocal worse still: [(/ 3)] would - be 0. + an intent. One operand is refused for every operator but [-], whose one + operand form is negation and is [named_call]'s. For [/] it would be the + reciprocal, and integer division makes that a trap: [(/ 3)] would be 0. A one-operand comparison would have to be [true] — there is no pair to disagree, and nothing for a lone value to be distinct from — and a test @@ -6623,10 +6966,6 @@ and arity _ctx loc name n args = and fold_arity loc name args = match args with | _ :: _ :: _ -> () - | [ _ ] when String.equal name "-" -> - fail loc - "- takes two arguments or more, given 1 — there is no unary minus; \ - write (- 0 x) to negate" | [ _ ] when String.equal name "/" -> fail loc "/ takes two arguments or more, given 1 — there is no reciprocal; \ @@ -7013,6 +7352,16 @@ 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. *) +(* 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 + | _ -> false) + and type_named ctx n = (* A type variable names a type here too, which is what lets [(vec-new t)] and [(vec-new $t)] be written in a generic body: inside an instantiation @@ -7283,6 +7632,33 @@ and named_call ?(qualified = false) ctx ~want loc name args = | _ when (not qualified) && shadows_builtin ctx loc name -> ordinary_call ctx ~want loc name args (* ── arithmetic and comparison ─────────────────────────────────── *) + (* (- x) negates, Clojure's rule. A literal operand is the negative literal, + so it takes its type from the site as any literal does. A float is + subtracted from -0.0, which is exact negation — 0.0 - 0.0 would answer + +0.0 — and an integer from 0, which wraps as (- 0 x) does. *) + | "-" when List.length args = 1 -> + let x = List.hd args in + (match x.Ast.e, literal_arith x with + (* Integer arithmetic over literals alone negates to a literal, so + [(- (- 1))] is the literal 1 and fits a u8. *) + | _, Some n when n <> Int64.min_int -> + check ctx ?want { Ast.e = Ast.Int (Int64.neg n); loc } + | Ast.Float v, _ -> check ctx ?want { Ast.e = Ast.Float (-.v); loc } + | _ -> + let v = check ctx ?want:(numeric_want want) x in + if v.Tast.ty = Types.Dyn then + expect ctx loc ~want (rt loc Types.Dyn "flan_dyn_neg" [ v; here loc ]) + else begin + unconstrained ctx.env loc name ~needs:"numeric?" v.Tast.ty; + if not (Types.is_numeric v.Tast.ty || generic_ty v.Tast.ty) then + not_numeric name "numbers" v; + let zero = + match v.Tast.ty with + | Types.Float k -> mk loc v.Tast.ty (Tast.Float (-0.0, k)) + | ty -> int_literal loc ~want:(Some ty) ~preds:ctx.env.tvpreds 0L + in + expect ctx loc ~want (mk loc v.Tast.ty (Tast.Prim (Tast.Sub, [ zero; v ]))) + end) | "+" | "-" | "*" | "/" -> let p = match name with | "+" -> Tast.Add | "-" -> Tast.Sub | "*" -> Tast.Mul @@ -7508,6 +7884,67 @@ and named_call ?(qualified = false) ctx ~want loc name args = expect ctx loc ~want (List.fold_left (fun acc arg -> pick acc (check ctx ~want:ty arg)) (pick a b) rest) + (* A type handed to the prelude's slice reductions: the reach for the + type-limit constants under the name of the reduction beside them. *) + | ("max-of" | "min-of") + when (not (shadows_builtin ctx loc name)) + && (match args with [ a ] -> type_arg ctx a | _ -> false) -> + let which = if String.equal name "max-of" then "max-value" else "min-value" in + fail loc + "%s reduces a slice to its %s element, and this is a type — the %s value \ + of a type is (%s %s)" + name (if which = "max-value" then "largest" else "least") + (if which = "max-value" then "largest" else "least") which + (spell_arg "i32" (List.hd args)) + (* (max-value T) and (min-value T): the type-limit constants, by type, so a + generic body can name its own type's. Odin's max(T) and min(T), and the + same answer for a float: the largest finite value and its negation, not + the smallest positive one. *) + | "max-value" | "min-value" -> + arity ctx loc name 1 args; + if not (type_arg ctx (List.hd args)) then + fail (List.hd args).Ast.loc "%s takes a type, as in (%s i32)" name name; + let a = List.hd args in + let ty = + match type_of_expr a, a.Ast.e with + | Some t, _ -> resolve ctx.env t + | _, Ast.Var n -> resolve_name ctx.env ~seen:[] a.Ast.loc n + | _ -> fail a.Ast.loc "internal: %s's type argument is not a type" name + in + let max = String.equal name "max-value" in + let v = + match ty with + | Types.Int k -> + let b = Types.bits k in + let n = + if Types.signed k then + let top = Int64.shift_left 1L (b - 1) in + if max then Int64.sub top 1L else Int64.neg top + else if not max then 0L + else if b = 64 then -1L + else Int64.sub (Int64.shift_left 1L b) 1L + in + mk loc ty (Tast.Int (n, k)) + | Types.Float k -> + let m = + match k with + | Types.F32 -> Int32.float_of_bits 0x7f7fffffl + | Types.F64 -> Float.max_float + in + mk loc ty (Tast.Float ((if max then m else -.m), k)) + | Types.Var v -> + if not (declares ctx.env.tvpreds v "numeric?") then + Loc.failk "check/unconstrained-type-variable" a.Ast.loc + "%s is a limit of a numeric type, and nothing declares $%s \ + numeric — write {:where (numeric? $%s)} at the head of the body" + name v v; + int_literal loc ~want:(Some ty) ~preds:ctx.env.tvpreds 0L + | _ -> + fail a.Ast.loc + "%s takes a numeric? type, and %s is not one — as in (%s i32)" name + (Types.to_string ty) name + in + expect ctx loc ~want v (* (zeroed) is the all-bytes-zero value of whatever it is being stored into, so it only means anything where a type is expected of it. *) | "zeroed" -> @@ -7519,7 +7956,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = | _ -> fail loc "zeroed needs to know the type it is zeroing — use it where one is \ - expected, as in (set grid (zeroed))") + expected, or name it, as in (the [4 i32] (zeroed))") (* [zeroed]'s two siblings, and the same shape exactly: a value of whatever type is expected of it, so [(set grid (filled 0xFF))] is how a place is @@ -7616,7 +8053,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = | _ -> fail loc "%s needs to know the type it is filling — use it where one is \ - expected, as in (set grid (%s))" + expected, or name it, as in (the [4 u32] (%s))" name (if is_byte then "filled 0xFF" else name)) (* The one half of a destructuring [let] that [Parse] cannot do on its own. @@ -10352,7 +10789,8 @@ let builtins : (string * string * string) list = numeric types meet at the wider one when that cannot lose — i32 and i64 \ add at i64 — and i32 with u32 has no such type and is refused."); ("-", "- [numeric? ...] numeric?", - "Difference, folded left: (- a b c) is ((a - b) - c)."); + "Difference, folded left: (- a b c) is ((a - b) - c). With one operand, \ + its negation: (- x)."); ("*", "* [numeric? ...] numeric?", "Product, folded left over two or more operands of one numeric type."); ("/", "/ [numeric? ...] numeric?", @@ -10368,7 +10806,8 @@ let builtins : (string * string * string) list = ordered."); ("!=", "!= [equal? ...] bool", "All different: (!= a b c) is true when every operand differs from every \ - other, so (!= 1 2 1) is false. Over everything = accepts."); + other, so (!= 1 2 1) is false. Over everything = accepts. A float NaN \ + is != to everything, itself included."); ("<", "< [ordered? ...] bool", "Less than, chained: (< a b c) is a < b and b < c, and every operand is \ evaluated once. Machine numbers and enums only — ordering a handle \ @@ -10399,6 +10838,13 @@ let builtins : (string * string * string) list = i16-y) is an i16."); ("max", "max [ordered? ...] ordered?", "The largest of two or more operands, each evaluated exactly once."); + ("max-value", "max-value [type] T", + "The largest value of a numeric type: (max-value u8) is 255, and at a \ + float the largest finite value. Takes a type variable under \ + {:where (numeric? $t)}."); + ("min-value", "min-value [type] T", + "The least value of a numeric type: (min-value i8) is -128, 0 at an \ + unsigned type, and at a float the negation of the largest finite value."); ("zeroed", "zeroed [] T", "The all-bytes-zero value of whatever it is being stored into, so it \ only means anything where a type is expected of it."); @@ -10643,9 +11089,9 @@ let builtins : (string * string * string) list = not hold. It becomes None where an (Option T) is wanted, and stays dyn \ everywhere else."); ("None", "None (Option T)", - "The absent Option. It takes its type from its context — a return type \ - or an annotated binding — because nothing about the word says what it \ - is an Option of."); + "The absent Option. It takes its type from its context — a return type, \ + a parameter, or (the (Option i32) None) — because nothing about the \ + word says what it is an Option of."); ("context/allocator", "context/allocator Allocator", "The allocator in effect here: what with-allocator rebinds, and what an \ allocating operation uses when none is named at the site."); @@ -10711,6 +11157,22 @@ let rec const_int env (e : Ast.expr) : int64 option = | Ast.Int n -> Some n | Ast.Byte b -> Some (Int64.of_int b) | Ast.Var n -> Hashtbl.find_opt env.consts n + | Ast.Call ({ Ast.e = Ast.Var "-"; _ }, [ x ]) -> + Option.map Int64.neg (const_int env x) + (* A conversion to an integer type, which is how a negative number is + written as an unsigned constant's bit pattern: [(u64 -1)]. Truncated to + the type's width and extended by its sign, as the cast does at run time. *) + | Ast.Call ({ Ast.e = Ast.Var k; _ }, [ x ]) + when Types.ikind_of_name k <> None -> + let k = Option.get (Types.ikind_of_name k) in + let bits = Types.bits k in + Option.map + (fun n -> + if bits = 64 then n + else if Types.signed k then + Int64.shift_right (Int64.shift_left n (64 - bits)) (64 - bits) + else Int64.logand n (Int64.sub (Int64.shift_left 1L bits) 1L)) + (const_int env x) (* Left to right over any number of operands, because that is how the checker reads the same form: an array length that type-checks as a product of three literals and is then not a constant would be a @@ -11758,12 +12220,26 @@ let check_global env (d : Ast.decl) : Tast.global option = than the expression it came from: a global's initialiser has to be a compile-time constant, and [(/ screen-height cell-size)] is one — the folding pass is the only thing that knows it. *) + (* A folded conversion is still a value of the type it converts to. *) + (match v.Ast.e, ty with + | Ast.Call ({ Ast.e = Ast.Var c; _ }, [ _ ]), Types.Int kind + when (match Types.ikind_of_name c with + | Some k -> + k <> kind + && not (Types.widens_to ~from:(Types.Int k) ~into:(Types.Int kind)) + | None -> false) -> + fail v.Ast.loc "expected %s, found %s" (Types.ikind_name kind) c + | _ -> ()); let ginit = match Hashtbl.find_opt env.consts n, ty with | Some k, Types.Int kind -> (* Still range-checked: this path skips [check], and [in_range] is the only thing that rejects 300 as a u8. *) - { Tast.e = Tast.Int (in_range d.Ast.dloc kind k, kind); ty; + { Tast.e = + Tast.Int + (in_range + ~pattern:(match v.Ast.e with Ast.Int _ -> false | _ -> true) + v.Ast.loc kind k, kind); ty; loc = d.Ast.dloc } | _ -> check (ctx ()) ~want:ty v in @@ -12427,6 +12903,68 @@ let is_env_struct = Closures.is_env_struct let heap_env = Closures.heap_env let place_closures fns = Closures.place ~dev:false fns +(* A program's function named as a prelude function takes the name over, the + way a definition of a builtin's name does: every call written in the file + that defines it reaches the program's, and every call anywhere else — the + prelude's own among them, which were written against the prelude's + signature — keeps reaching the prelude's. The prelude's is renamed out of + the way, under a qualifier no source can spell, rather than dropped. + Functions only: a type or a global of the prelude's name is still defined + twice. *) +let prelude_alias = "prelude~" + +(* Off for a check whose warnings were already printed for the same source: + the dev program re-creating the session its launcher built and warned for. *) +let print_warnings = ref true + +(* A name the renaming above made, which nobody wrote: left out of every + listing a person reads, and shown as whose it is where a frame has to be. *) +let internal_name n = String.starts_with ~prefix:(prelude_alias ^ "/") n + +let shown_name n = + if internal_name n then + let p = String.length prelude_alias + 1 in + "the prelude's " ^ String.sub n p (String.length n - p) + else n + +let shadow_prelude (prelude : Ast.decl list) (decls : Ast.decl list) = + let fn_name (d : Ast.decl) = + match d.Ast.d with + | Ast.Defn fn | Ast.Declare (fn, _) | Ast.DeclareC (fn, _) -> Some fn.Ast.name + | _ -> None + in + let theirs = List.filter_map fn_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) + | _ -> None) + decls + in + let warnings = + List.map + (fun (n, at) -> + Loc.diag ~kind:"check/shadows-prelude" at + (Printf.sprintf + "%s shadows the prelude's %s — every call in this file now \ + reaches your definition" + n n)) + taken + in + let prelude, decls = + List.fold_left + (fun (prelude, decls) (n, (at : Loc.t)) -> + ( List.map (Load.rename_refs [ n ] prelude_alias) prelude, + List.map + (fun (d : Ast.decl) -> + if String.equal d.Ast.dloc.Loc.file at.Loc.file then d + else Load.rename_refs [ n ] prelude_alias d) + decls )) + (prelude, decls) taken + in + (prelude @ decls, warnings) + let build_program ~keep_going ?tolerate (decls : Ast.decl list) : Tast.program * env * string list = let env = new_env () in @@ -12482,7 +13020,9 @@ let build_program ~keep_going ?tolerate (decls : Ast.decl list) : end else raise e) in - let decls = Parse.program (Prelude.forms ()) @ decls in + let decls, prelude_warnings = + shadow_prelude (Parse.program (Prelude.forms ())) decls + in (* Before anything is collected: every (declare-c ...) becomes an ordinary flattened [declare] with a Flan [defn] over it, and the C that does the flattening comes back to be compiled into the build. Nothing below this @@ -12502,11 +13042,12 @@ let build_program ~keep_going ?tolerate (decls : Ast.decl list) : reload, which is where a defn is most likely to be written. Printed in the shape [Loc] gives an error, so a checker in an editor parses it the same way. *) + if !print_warnings then List.iter (fun (d : Loc.diag) -> prerr_endline (Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg)) - (shadowed_builtins decls); + (shadowed_builtins decls @ prelude_warnings); (* Pass one, and it stops at the first thing it refuses. That is not laziness: every name, type and signature in the file comes from here, so a declaration this pass could not make sense of leaves a hole that pass two diff --git a/lib/dev.ml b/lib/dev.ml index dfe19dda..05d74af0 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -1448,7 +1448,10 @@ let describe t = ok [ ":fns " ^ Wire.strings - (List.map (fun (f : Tast.fn) -> f.Tast.name) + (List.filter_map + (fun (f : Tast.fn) -> + if Check.internal_name f.Tast.name then None + else Some f.Tast.name) t.session.Session.program.Tast.fns); ":globals " ^ Wire.strings @@ -1560,6 +1563,7 @@ let defs t = Hashtbl.replace macro_locs f.Tast.name (Loc.to_string f.Tast.floc); None | None when List.mem f.Tast.name class_names -> None + | None when Check.internal_name f.Tast.name -> None | None -> Some (entry ~name:f.Tast.name ~kind:"fn" ~sign:(signature_of_fn f) @@ -2007,7 +2011,7 @@ let backtrace_op t = (List.map (fun (name, loc, mine, nslots, _sig, _rsig) -> Wire.list - [ Wire.quote name; Wire.quote loc; + [ Wire.quote (Check.shown_name name); Wire.quote loc; Wire.quote (if mine then "program" else "eval"); string_of_int nslots ]) frames); @@ -4891,17 +4895,8 @@ let make_session_dir ~file dir = would find that out at the link — as a missing symbol, or as the merged build's rename finding nothing to rename. *) let need_main ~file (session : Session.t) = - if not - (List.exists (fun (f : Tast.fn) -> f.Tast.name = "main") - session.Session.host.Tast.fns) - then - failwith - (Printf.sprintf - "%s has no main, so flan dev has nothing to run. A program starts at \ - a function named main, for example:\n\n\ - \ (defn main [] i32\n\ - \ 0)" - file) + Build.need_main ~file ~doing:"flan dev has nothing to run" + session.Session.host (* [debug] is off by default, which keeps [flan dev] exactly what it was: a -O2 host and -O2 modules. It is opt-in rather than always-on because a debug @@ -5820,7 +5815,10 @@ let merged_setup () = marshalling a [Session.t] through a file, which buys nothing: the source cannot have changed between the two, because the build that produced this binary is the one that exec'd it. *) + (* Its warnings were printed by the launcher over the same source. *) + Check.print_warnings := false; let session, _ = Session.create ~debug ~x86 ~file () in + Check.print_warnings := true; (* The program's output has to reach an editor exactly as it did when the daemon held the other end of a pipe. Same pipe, one process: fd 1 is replaced before the program starts, and the accept loop drains it — diff --git a/lib/emit.ml b/lib/emit.ml index 0e27575b..0a911b09 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -2277,8 +2277,11 @@ let icmp_op signed = function | Tast.Ge -> if signed then "sge" else "uge" | _ -> assert false +(* [!=] is unordered and the rest are ordered, so a NaN is unequal to + everything, itself included, and neither less, greater nor equal: IEEE 754's + answers, and C's and Odin's. *) let fcmp_op = function - | Tast.Eq -> "oeq" | Tast.Ne -> "one" | Tast.Lt -> "olt" + | Tast.Eq -> "oeq" | Tast.Ne -> "une" | Tast.Lt -> "olt" | Tast.Le -> "ole" | Tast.Gt -> "ogt" | Tast.Ge -> "oge" | _ -> assert false @@ -4793,6 +4796,7 @@ declare i64 @flan_dyn_sub(i64, i64, ptr, i64) declare i64 @flan_dyn_mul(i64, i64, ptr, i64) declare i64 @flan_dyn_div(i64, i64, ptr, i64) declare i64 @flan_dyn_rem(i64, i64, ptr, i64) +declare i64 @flan_dyn_neg(i64, ptr, i64) declare i64 @flan_dyn_lt(i64, i64, ptr, i64) declare i64 @flan_dyn_le(i64, i64, ptr, i64) declare i64 @flan_dyn_gt(i64, i64, ptr, i64) diff --git a/lib/load.ml b/lib/load.ml index 17d9b0c8..5bf878da 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -315,6 +315,7 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr = other reference to it. *) | Ast.ArrayFill (ds, v) -> Ast.ArrayFill (List.map (rename_len owned alias) ds, go v) | Ast.ArrayGen (ds, v) -> Ast.ArrayGen (List.map (rename_len owned alias) ds, go v) + | Ast.The (t, v) -> Ast.The (rename_texpr owned alias t, go v) | Ast.Fn (ps, body) -> Ast.Fn (ps, List.map (rename_expr owned alias (ps @ bound)) body) | Ast.Dotimes (l, i, b, body) -> @@ -554,6 +555,37 @@ let qualify_decl owned alias (d : Ast.decl) : Ast.decl = in { d with Ast.d = k } +(* [qualify_decl]'s rename of every use of an [owned] name, without the rename + of the declaration's own name unless that name is one of them. How a + program's definition of a name the prelude also defines takes the name + over: the prelude's declaration and its uses outside the program's file + move to the qualified name, and the program's file keeps the bare one. *) +let rename_refs owned alias (d : Ast.decl) : Ast.decl = + match Ast.declared_name d, d.Ast.d with + | _, (Ast.Package _ | Ast.Import _) -> d + | Some n, _ when List.mem n owned -> qualify_decl owned alias d + | _ -> + let q = qualify_decl owned alias d in + let named (fn : Ast.fn) (o : Ast.fn) = { fn with Ast.name = o.Ast.name } in + let k = + match q.Ast.d, d.Ast.d with + | Ast.Declare (fn, c), Ast.Declare (o, _) -> Ast.Declare (named fn o, c) + | Ast.DeclareC (fn, c), Ast.DeclareC (o, _) -> Ast.DeclareC (named fn o, c) + | Ast.Defn fn, Ast.Defn o -> Ast.Defn (named fn o) + | Ast.Defgeneric fn, Ast.Defgeneric o -> Ast.Defgeneric (named fn o) + | Ast.Defmulti fn, Ast.Defmulti o -> Ast.Defmulti (named fn o) + | Ast.Defenum (_, ms), Ast.Defenum (n, _) -> Ast.Defenum (n, ms) + | Ast.Defalias (_, t), Ast.Defalias (n, _) -> Ast.Defalias (n, t) + | Ast.Defconst (_, t, v), Ast.Defconst (n, _, _) -> Ast.Defconst (n, t, v) + | Ast.Defstruct (_, fs), Ast.Defstruct (n, _) -> Ast.Defstruct (n, fs) + | Ast.Defunion (_, fs), Ast.Defunion (n, _) -> Ast.Defunion (n, fs) + | Ast.Defdata (_, vs), Ast.Defdata (n, _) -> Ast.Defdata (n, vs) + | Ast.Defvar (_, t, i, r), Ast.Defvar (n, _, _, _) -> Ast.Defvar (n, t, i, r) + | Ast.Defclass (_, ss), Ast.Defclass (n, _) -> Ast.Defclass (n, ss) + | k, _ -> k + in + { q with Ast.d = k } + (* ── Qualifying a package's macros ────────────────────────────────── The rename above works over the Ast and a macro cannot go that way. By the time [Parse] is finished with a [defmacro] its quasiquote has been desugared @@ -790,6 +822,7 @@ let rec expr_uses acc (e : Ast.expr) = | Ast.MapLit (_, kvs) -> List.iter (fun (k, v) -> go k; go v) kvs | Ast.Arr items -> gos items | Ast.ArrayOf t | Ast.TypeArg t -> texpr_uses acc t + | Ast.The (t, v) -> texpr_uses acc t; go v (* A dimension written as a name is a use of that constant, exactly as it is inside [Tarray]. *) | Ast.ArrayFill (ds, v) | Ast.ArrayGen (ds, v) -> diff --git a/lib/parse.ml b/lib/parse.ml index 519103b1..b6e15cd1 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -489,6 +489,15 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = array of integers — the wrong reading, and a silent one. Read here, the brackets are [len]s: the same integer-or-constant's-name the [n T] type spelling takes, refused by [len] when they are anything else. *) + (* ── (the T e) ──────────────────────────────────────────────────── *) + | Sym "the" -> + (match args with + | [ t; v ] -> mk (Ast.The (texpr t, expr v)) + | _ -> + fail f + "the is (the TYPE value), as in (the u8 0) — the value, checked as \ + a TYPE") + | Sym (("array-fill" | "array-gen") as which) -> let usage () = fail f diff --git a/lib/prelude.ml b/lib/prelude.ml index 880a720a..9eb5ce04 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -427,6 +427,7 @@ let source = {flan| ;; or more numbers, and a defn cannot shadow a builtin: nothing shadows [+] ;; either. These reduce a slice, which is a different operation with a ;; different arity, so the different name is honest rather than a workaround. +;; A type's own limits are (min-value T) and (max-value T). (defn min-of [s [$t]] (Option $t) {:where (ordered? $t)} (if (= (length s) 0) @@ -716,7 +717,7 @@ let source = {flan| ;; The floats are three questions and not two, which is why there is no ;; f32-min here to sit beside f32-max. ;; -;; A float's least value is just the negation of its greatest — (- 0.0 f32-max) +;; A float's least value is just the negation of its greatest — (- f32-max) ;; — so a constant for it would say nothing the language cannot. What a caller ;; actually reaches for under the name "min" is the smallest positive one, and ;; that is a different number entirely. Naming it f32-min would make the two diff --git a/lib/session.ml b/lib/session.ml index d5ddc186..5ae2cef3 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -186,6 +186,10 @@ let stale_sites ?(live = SM.empty) ?(running = false) built (p : Tast.program) : m acc in from ~kept:true live (from ~kept:false built []) + (* A caller or callee the prelude-shadowing rename made is not the + program's, and there is nothing in the program to recompile for it. *) + |> List.filter (fun s -> + not (Check.internal_name s.caller || Check.internal_name s.target)) |> List.sort (fun a b -> match String.compare a.at.Loc.file b.at.Loc.file with | 0 -> Loc.before a.at b.at diff --git a/lib/x86.ml b/lib/x86.ml index de4665cf..7b7f03b7 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -1318,18 +1318,20 @@ let int_cc ~signed (p : Tast.prim) = (* Parity, which on [ucomis] means "unordered": one of the operands was a NaN. Nothing else in this file reads it. *) -let cc_np = 11 +let cc_p = 10 and cc_np = 11 (* [ucomis] sets the flags the *unsigned* codes read, whichever way the operands are signed, so a float comparison never uses l/g — and it sets CF, ZF and PF all at once when either operand is a NaN. That last part is why this is not simply the unsigned table. Every - comparison Flan has is LLVM's *ordered* one ([emit.ml]'s [fcmp_op]: oeq, - one, olt, ...), which answers false for a NaN, and [setb] after an - unordered compare answers true. So [<] and [<=] swap their operands and ask - for a/ae, which are the two codes a NaN makes false; [=] and [!=] cannot be - spelled by one code at all and take a second [setnp] beside them. + comparison Flan has but one is LLVM's *ordered* one ([emit.ml]'s + [fcmp_op]: oeq, olt, ...), which answers false for a NaN, and [setb] after + an unordered compare answers true. So [<] and [<=] swap their operands and + ask for a/ae, which are the two codes a NaN makes false; [=] cannot be + spelled by one code at all and takes a second [setnp] beside it. The one is + [!=], which is [une] — true for a NaN, as IEEE 754 and C have it — and is + [setne] or'd with [setp]. [(not (= x x))] is how [format-f64] in the prelude detects a NaN, and it is the whole of the difference: with [sete] alone, [(/ 0.0 0.0)] formatted as @@ -1345,7 +1347,7 @@ let float_cc (p : Tast.prim) = | _ -> unsupported "not a comparison" let float_ordered (p : Tast.prim) = - match p with Tast.Eq | Tast.Ne -> true | _ -> false + match p with Tast.Eq -> true | _ -> false let is_cmp (p : Tast.prim) = match p with @@ -3274,6 +3276,12 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) dst = movzx8 f.b ~dst:rcx ~src:rcx; and_rr f.b ~dst:rax ~src:rcx end + else if p = Tast.Ne then begin + movzx8 f.b ~dst:rax ~src:rax; + setcc f.b ~cc:cc_p ~dst:rcx; + movzx8 f.b ~dst:rcx ~src:rcx; + or_rr f.b ~dst:rax ~src:rcx + end end else begin load_loc f ~reg:rax la a.Tast.ty; load_loc f ~reg:rcx lb b.Tast.ty; diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index fb76e66e..54cb40f5 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -2076,6 +2076,14 @@ flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen) { return arith(loc, loclen, "-", a, b); } +/* (- x): an int wraps, as (- 0 x) does, and a float flips its sign, so the + * negation of 0.0 is -0.0 and not the 0.0 a subtraction from zero gives. */ +flan_dyn flan_dyn_neg(flan_dyn a, const uint8_t *loc, int64_t loclen) { + if (!is_num(a)) trap1(loc, loclen, TYPE_TRAP, "-", "it takes a number", a); + if (flan_dyn_tag(a) == FLAN_DYN_TAG_INT) + return flan_dyn_from_i64((int64_t)(0 - (uint64_t)dyn_int_value(a))); + return flan_dyn_from_f64(-dyn_num_value(a)); +} flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen) { return arith(loc, loclen, "*", a, b); diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index 8e119e57..79d90d8d 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -168,6 +168,7 @@ flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +flan_dyn flan_dyn_neg(flan_dyn a, const uint8_t *loc, int64_t loclen); /* Answer a bool dyn. Numbers compare as numbers and text compares bytewise; * a mixture of the two, or anything else, traps. */ diff --git a/test/dyn_ops.c b/test/dyn_ops.c index d57d4424..5dc1266a 100644 --- a/test/dyn_ops.c +++ b/test/dyn_ops.c @@ -985,6 +985,8 @@ static void refuse(const char *what) { if (strcmp(what, "add") == 0) (void)FDYN_add(flan_dyn_from_i64(3), t); else if (strcmp(what, "sub") == 0) (void)FDYN_sub(flan_dyn_nil(), flan_dyn_from_i64(1)); + else if (strcmp(what, "neg") == 0) + (void)flan_dyn_neg(t, NULL, 0); else if (strcmp(what, "mul") == 0) (void)FDYN_mul(flan_dyn_from_bool(1), flan_dyn_from_i64(2)); else if (strcmp(what, "div") == 0) diff --git a/test/programs/array-first-element.flan b/test/programs/array-first-element.flan index a667a60a..e50876e8 100644 --- a/test/programs/array-first-element.flan +++ b/test/programs/array-first-element.flan @@ -1,6 +1,6 @@ ;;;; An array literal with nothing outside it saying what its elements are -;;;; takes that from its first element: [(f32 1.0) 2.5] is a [2 f32], and the -;;;; 2.5 is an f32 literal rather than an f64 refused for not being one. +;;;; takes that from the elements that are not literals: [(f32 1.0) 2.5] is a +;;;; [2 f32], and the 2.5 is an f32 literal rather than an f64. (defn sum3 [a [3 f32]] f32 (+ (at a 0) (at a 1) (at a 2))) (defn main [] i32 diff --git a/test/programs/array-mixed.flan b/test/programs/array-mixed.flan new file mode 100644 index 00000000..f4238c73 --- /dev/null +++ b/test/programs/array-mixed.flan @@ -0,0 +1,59 @@ +;;;; An array literal with nothing outside it naming a type: elements that agree +;;;; are a typed array, numbers meeting at the wider and a literal taking the +;;;; others' type, and elements that do not are a dyn vector. +(defstruct P [x i32 y i32]) +(defn mixed [] i32 + (let [x (i32 4) + a [(f32 1.0) 2.5 3.25] + b [(i64 1) 2 3] + c [(u8 1) 300] + d [x 2.5] + e [1 18446744073709551615] + f [10 "Hi"] + g [nil 1] + h [None (Some 3)] + i [(P 1 2) {.x 3 .y 4}] + j [[1 2] [3 4]] + k [1 2.5] + m [x (i64 5)] + dd [:a "b" 3]] + (println (length a)) + (println (+ (at c 1) (i32 (at c 0)))) + (println (at d 1)) + (println (at e 1)) + (println f) + (println g) + (println (length f)) + (println (match (at h 1) None 0 (Some v) v)) + (println (.y (at i 1))) + (println (at (at j 1) 0)) + (println (at k 0)) + (println (+ (at m 0) (i64 9000000000))) + (println dd)) + 0) + +;; (the T e) gives any expression its type. +(defn the-forms [] i32 + (let [a (the u8 200) + b (the i64 5000000000) + c (the f32 2.5) + d (the [3 f32] [1 2 3.5]) + e (the [f32] [1 2.5]) + f (the (Option i32) None) + g (the (Option i32) nil) + h (the dyn 3) + n (the i64 (+ (the i32 1) 2)) + v (the (Vec i32) (vec-new))] + (println (+ a (u8 55))) + (println b) + (println (* c (f32 2.0))) + (println (+ (at d 0) (at d 2))) + (println (length e)) + (println (match f None 0 (Some x) x)) + (println (match g None 7 (Some x) x)) + (println h) + (println n) + (println (length v))) + 0) + +(defn main [] i32 (mixed) (the-forms)) diff --git a/test/programs/limits.flan b/test/programs/limits.flan index bd284465..954cc082 100644 --- a/test/programs/limits.flan +++ b/test/programs/limits.flan @@ -60,6 +60,10 @@ (print " ") (println (if ok "ok" "WRONG"))) +(defn ne-f64 [a f64 b f64] bool (!= a b)) +(defn ne-f32 [a f32 b f32] bool (!= a b)) +(defn ne-dyn [a dyn b dyn] bool (!= a b)) + (defn main [] i32 ;; The integers, each printed as the exact decimal the expected output pins. (println i8-max) @@ -115,17 +119,26 @@ ;; the absence is recorded rather than merely unmentioned: a float's least ;; value is the negation of its greatest, and there is nothing to derive. (say "f32's least value negates its greatest" - (< (- (f32 0.0) f32-max) (- (f32 0.0) f32-min-positive))) + (< (- f32-max) (- f32-min-positive))) (say "f64's least value negates its greatest" - (< (- 0.0 f64-max) (- 0.0 f64-min-positive))) + (< (- f64-max) (- f64-min-positive))) ;; The infinities and NaNs, which no literal writes. Each infinity is the ;; overflow of its type's greatest value, negated it is below the least ;; finite one, and a NaN is the one value not equal to itself. (say "f64-inf" (= f64-inf (* f64-max 2.0))) (say "f32-inf" (= f32-inf (* f32-max (f32 2.0)))) - (say "f64-inf negated" (< (- 0.0 f64-inf) (- 0.0 f64-max))) - (say "f32-inf negated" (< (- (f32 0.0) f32-inf) (- (f32 0.0) f32-max))) + (say "f64-inf negated" (< (- f64-inf) (- f64-max))) + (say "f32-inf negated" (< (- f32-inf) (- f32-max))) (say "f64-nan" (not (= f64-nan f64-nan))) (say "f32-nan" (not (= f32-nan f32-nan))) + ;; != is the one unordered comparison: a NaN is unequal to everything, + ;; itself included, and the dyn side agrees. The operands arrive as + ;; parameters so that no constant folder answers in the backend's place. + (say "f64-nan != itself" (ne-f64 f64-nan f64-nan)) + (say "f32-nan != itself" (ne-f32 f32-nan f32-nan)) + (say "!= over ordinary floats" + (and (ne-f64 1.0 2.0) (not (ne-f64 1.5 1.5)) + (ne-f32 (f32 1.0) (f32 2.0)) (not (ne-f32 (f32 1.5) (f32 1.5))))) + (say "a dyn NaN != itself" (ne-dyn f64-nan f64-nan)) 0) diff --git a/test/programs/literal-arm.flan b/test/programs/literal-arm.flan new file mode 100644 index 00000000..5459e906 --- /dev/null +++ b/test/programs/literal-arm.flan @@ -0,0 +1,18 @@ +;;;; A literal arm takes its type from the arm that is not a literal, in an +;;;; if, a cond and a match alike, as a literal operand of + does. +(defn g [c bool n i64] i64 (let [x (if c 4000000 n)] x)) +(defn h [k i32 n i64] i64 + (let [x (cond (= k 0) 5000000000 (= k 1) 7 :else n)] x)) +(defn m [o (Option i64)] i64 + (let [x (match o None 3 (Some v) v)] x)) +(defn f32s [c bool y f32] f32 (let [x (if c 2.5 y)] x)) +(defn main [] i32 + (println (g true (i64 3))) + (println (g false (i64 9000000000))) + (println (h 0 (i64 1))) + (println (h 1 (i64 1))) + (println (h 2 (i64 9000000000))) + (println (m None)) + (println (m (Some (i64 9000000000)))) + (println (f32s true (f32 1.0))) + 0) diff --git a/test/programs/max-value.flan b/test/programs/max-value.flan new file mode 100644 index 00000000..70015390 --- /dev/null +++ b/test/programs/max-value.flan @@ -0,0 +1,54 @@ +;;;; (max-value T) and (min-value T): a numeric type's limits, named by the type, at +;;;; a concrete type and inside a generic whose bound admits numbers. + +;; A selection sort, descending, whose running best starts at the least value +;; of the element type, so any element beats it. +(defn sort-desc [s [$t]] () + {:where (numeric? $t)} + (dotimes [i (length s)] + (let [best (min-value $t) + at-best i] + (dotimes [j (- (length s) i)] + (let [k (+ i j)] + (when (> (at s k) best) + (set best (at s k)) + (set at-best k)))) + (swap s i at-best)))) + +(defn largest [s [$t]] $t + {:where (numeric? $t)} + (let [best (min-value t)] + (dotimes [i (length s)] + (when (> (at s i) best) (set best (at s i)))) + best)) + +(defn show-i32 [s [i32]] () + (dotimes [i (length s)] (print (at s i)) (print " ")) + (println "")) + +(defn show-f64 [s [f64]] () + (dotimes [i (length s)] (print (at s i)) (print " ")) + (println "")) + +(defn main [] i32 + (println (max-value u8)) + (println (min-value u8)) + (println (max-value i8)) + (println (min-value i8)) + (println (max-value i32)) + (println (min-value i64)) + (println (max-value u64)) + (println (= (max-value f32) f32-max)) + (println (= (min-value f64) (- f64-max))) + (println (= (max-value i16) i16-max)) + (let [a [(i32 3) -7 12 0 -2147483648 5] + b [2.5 -1.0 1e300 -1e308] + c [(u8 4) 0 200 9]] + (sort-desc (slice a)) + (show-i32 (slice a)) + (sort-desc (slice b)) + (show-f64 (slice b)) + (println (largest (slice c))) + (println (let [d [(i64 -5) -9]] (largest (slice d)))) + (println (let [e [(f32 -1.0) -3.0]] (= (largest (slice e)) (f32 -1.0))))) + 0) diff --git a/test/programs/negate.flan b/test/programs/negate.flan new file mode 100644 index 00000000..51821e23 --- /dev/null +++ b/test/programs/negate.flan @@ -0,0 +1,25 @@ +;;;; (- x) negates: an integer wraps, a float flips its sign — the negation of +;;;; 0.0 is -0.0, which 1/x tells apart — and a dyn does either by its tag. +(defn negi [x i32] i32 (- x)) +(defn negf [x f64] f64 (- x)) +(defn negf32 [x f32] f32 (- x)) +(defn negu [x u8] u8 (- x)) +(defn negd [x dyn] dyn (- x)) +(defn negg [x $t] $t {:where (numeric? $t)} (- x)) +(defn main [] i32 + (println (negi 3)) + (println (negi -7)) + (println (negf 2.5)) + (println (/ 1.0 (negf 0.0))) + (println (negf32 (f32 1.5))) + (println (negu (u8 1))) + (println (negd 4)) + (println (negd 2.5)) + (println (/ 1.0 (negd 0.0))) + (println (negg (i64 9000000000))) + (println (negg 0.5)) + (let [a (- 5) b (i64 (- 3))] + (println (+ a (i32 b)))) + (println (- f64-inf)) + (println (< (- f64-inf) (- f64-max))) + 0) diff --git a/test/programs/shadow-prelude.flan b/test/programs/shadow-prelude.flan new file mode 100644 index 00000000..a9d628ae --- /dev/null +++ b/test/programs/shadow-prelude.flan @@ -0,0 +1,13 @@ +;;;; 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. +(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 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)) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 19deffc0..33b659f5 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -563,13 +563,50 @@ let () = fpu_out; outputs ~x86:true "a pointer and a union filled, x86" "programs/fill-ptr-union.flan" fpu_out; - (* An array literal takes its element type from its first element when - nothing outside it names one. *) + (* A literal element takes its type from the other elements when nothing + outside the array names one. *) let first_out = "3\n6.75\n9000000002\n255\n" in outputs "an array literal's first element types the rest" "programs/array-first-element.flan" first_out; outputs ~x86:true "an array literal's first element types the rest, x86" "programs/array-first-element.flan" first_out; + (* An array literal whose elements agree is typed and one whose elements + mix is a dyn vector; (the T e) gives any expression its type. *) + let mixed_out = + "3\n301\n2.5\n18446744073709551615\n[ 10 \"Hi\"]\n[ nil 1]\n2\n3\n4\n\ + 3\n1\n9000000004\n[ :a \"b\" 3]\n\ + 255\n5000000000\n5\n4.5\n2\n0\n7\n3\n3\n0\n" in + outputs "mixed array literals and the" "programs/array-mixed.flan" mixed_out; + outputs ~x86:true "mixed array literals and the, x86" + "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 + 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; + (* (max-value T) and (min-value T), concrete and inside a generic. *) + let maxof_out = + "255\n0\n127\n-128\n2147483647\n-9223372036854775808\n\ + 18446744073709551615\ntrue\ntrue\ntrue\n\ + 12 5 3 0 -7 -2147483648 \n1e+300 2.5 -1 -1e+308 \n200\n-5\ntrue\n" in + outputs "max-value and min-value" "programs/max-value.flan" maxof_out; + outputs ~opt:"-O0" "max-value and min-value, -O0" "programs/max-value.flan" maxof_out; + outputs ~x86:true "max-value and min-value, x86" "programs/max-value.flan" maxof_out; + (* (- x) negates, on every numeric type, a type variable and a dyn. *) + let neg_out = + "-3\n7\n-2.5\n-inf\n-1.5\n255\n-4\n-2.5\n-inf\n-9000000000\n\ + -0.5\n-8\n-inf\ntrue\n" in + outputs "unary minus" "programs/negate.flan" neg_out; + outputs ~opt:"-O0" "unary minus, -O0" "programs/negate.flan" neg_out; + outputs ~x86:true "unary minus, x86" "programs/negate.flan" neg_out; + (* A literal arm takes the other arm's type. *) + let arm_out = + "4000000\n9000000000\n5000000000\n7\n9000000000\n3\n9000000000\n2.5\n" in + outputs "a literal arm takes the other arm's type" + "programs/literal-arm.flan" arm_out; + outputs ~x86:true "a literal arm takes the other arm's type, x86" + "programs/literal-arm.flan" arm_out; (* 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 collection anywhere. The two show lines either side of it are the same @@ -5684,7 +5721,9 @@ level "1" f32's least value negates its greatest ok\n\ f64's least value negates its greatest ok\n\ f64-inf ok\nf32-inf ok\nf64-inf negated ok\nf32-inf negated ok\n\ - f64-nan ok\nf32-nan ok\n" + f64-nan ok\nf32-nan ok\n\ + f64-nan != itself ok\nf32-nan != itself ok\n\ + != over ordinary floats ok\na dyn NaN != itself ok\n" in outputs "type limits" "programs/limits.flan" limits_out; outputs ~opt:"-O0" "type limits, -O0" "programs/limits.flan" limits_out; @@ -6716,6 +6755,28 @@ level "1" cli_case "--debug and an explicit -O are refused together" "build ../calc-me.flan --debug -O2 -o /dev/null" ~code:2 ~says:[ "--debug"; "-O2"; "Drop one of the two" ]; + (* The name a shadowed prelude function is moved to is nobody's to read. *) + (let code, text = cli "check programs/shadow-prelude.flan" in + if code <> 0 || contains text "prelude~" + || not (contains text "defn floor-f32") + then begin + incr failures; + Printf.printf + "FAIL check's listing leaves out the renamed prelude function\n\ + \ got: %S (exit %d)\n" text code + end); + (* A file with no main is refused by name before the link, which would + otherwise report an undefined reference from crt1.o. *) + let nomain = Filename.concat scratch "no-main.flan" in + Out_channel.with_open_bin nomain (fun oc -> + output_string oc "(defn f [] i32 0)\n"); + cli_case "build of a file with no main names main" + (Printf.sprintf "build %s -o /dev/null" (Filename.quote nomain)) ~code:1 + ~says:[ "has no main"; "(defn main [] i32" ]; + cli_case "run of a file with no main names main" + (Printf.sprintf "run %s" (Filename.quote nomain)) ~code:1 + ~says:[ "has no main"; "(defn main [] i32" ]; + Sys.remove nomain; (* Every row above that went through the pool has been forked; nothing after this point may look at [failures] until every one of them has diff --git a/test/test_dyn.ml b/test/test_dyn.ml index 8152b9cf..4969e4d9 100644 --- a/test/test_dyn.ml +++ b/test/test_dyn.ml @@ -205,6 +205,7 @@ let () = let refusals = [ ("add", "dyn +: int and text"); ("sub", "dyn -: nil and int"); + ("neg", "dyn -: text, and it takes a number"); ("mul", "dyn *: bool and int"); ("div", "dyn /: vec and int"); ("rem", "dyn %: int and nil"); diff --git a/test/test_flan.ml b/test/test_flan.ml index 2e265ce7..33c0209f 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -1245,7 +1245,7 @@ let () = accepts "return type types the literal" "(defn f [] u8 0)"; accepts "return type types None" "(defn f [] (Option f64) None)"; rejects_check "bare None has no type" "(defconst x None)" - ~needle:"what None is an Option of"; + ~needle:"(the (Option i32) None)"; accepts "param types the literal" "(defn g [x u8] ()) (defn f [] () (g 3))"; rejects_check "wrong argument type" @@ -1337,14 +1337,18 @@ let () = infers "min at four" "(min 4 1 3 2)" "i32"; infers "max at four" "(max 4 1 3 2)" "i32"; (* And the two counts below the floor. Zero would have to mean an identity - element and one a unary operator this language does not have; both are a - typo far more often than an intent, so both are refused by name. *) + element, and one is refused for every operator but -, whose one-operand + form negates. *) rejects_check "a sum with no terms" "(defn f [] i32 (+))" ~needle:"+ takes two arguments or more, given 0"; rejects_check "a product with no factors" "(defn f [] i32 (*))" ~needle:"* takes two arguments or more, given 0"; - rejects_check "there is no unary minus" - "(defn f [] i32 (- 1))" ~needle:"there is no unary minus"; + infers "a negated literal" "(- 1)" "i32"; + infers "a negated literal takes its type from the site" "(i64 (- 1))" "i64"; + rejects_check "unary minus over a string names the operand" + "(defn f [s string] () (println (- s)))" ~needle:"- takes numbers"; + rejects_check "unary minus at an unsigned literal is out of range" + "(defn f [] u8 (- 1))" ~needle:"does not fit in u8"; rejects_check "there is no reciprocal" "(defn f [] f64 (/ 2.0))" ~needle:"there is no reciprocal"; rejects_check "one operand is not a bitwise and" @@ -3001,7 +3005,7 @@ let () = ~needle:"needs to know the type it is filling"; rejects_check "a dead-beef in a position with no expected type" "(defn f [] () (print (dead-beef)))" - ~needle:"needs to know the type it is filling"; + ~needle:"(the [4 u32] (dead-beef))"; (* The byte is a u8 and the ordinary literal rule applies to it — there is no range check of this builtin's own, and there does not need to be. *) rejects_check "a fill byte out of range" @@ -5406,6 +5410,24 @@ let () = | exception Loc.Error _ -> false); 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 + the defining file. *) + let prelude_src = "(defn abs-f32 [v f32] f32 v)" in + (match + snd (Check.shadow_prelude (Parse.program (Prelude.forms ())) + (program prelude_src)) + with + | [ d ] -> + check "a defn of a prelude function's name warns once" + (d.Loc.kind = "check/shadows-prelude" + && d.Loc.dmsg + = "abs-f32 shadows the prelude's abs-f32 — every call in this file \ + now reaches your definition") + | _ -> 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; + 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. Pinned in both halves because it is the case most likely to be thought of as special and quietly excepted later: the warning is the same @@ -6205,8 +6227,61 @@ let () = "(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)"; + (* A negative literal fits no unsigned type, wherever the type comes from; + the cast the refusal names is how to write the bit pattern. *) + List.iter + (fun (what, src, needle) -> rejects_check what src ~needle) + [ ("a negative literal at a u64 constant", "(defconst a u64 -1)", + "-1 does not fit in u64, which holds no negative number — write \ + (u64 -1) for the u64 with the same bits, 18446744073709551615"); + ("a negative literal at a u32 global", "(defonce g u32 -5)", + "write (u32 -5) for the u32 with the same bits, 4294967291"); + ("a negative literal as a u64 return", "(defn f [] u64 -1)", + "-1 does not fit in u64"); + ("a negative literal as a u32 argument", + "(defn t [x u32] u32 x) (defn f [] u32 (t -2))", "-2 does not fit in u32"); + ("a negative literal in a u8 field", + "(defstruct S [a u8]) (defn f [] S (S -3))", "write (u8 -3)"); + ("a negative literal given a u64 by the", + "(defn f [] i32 (let [a (the u64 -1)] 0))", "-1 does not fit in u64"); + ("a negative literal beside a u64-only literal", + "(defn f [] i32 (let [a [-1 18446744073709551615]] 0))", + "write (u64 -1) for the u64"); + ("a negative literal beside a u64 element", + "(defn f [x u64] i32 (let [a [x -1]] 0))", "write (u64 -1) for the u64") ]; + accepts "the casts those refusals name compile" + "(defconst a u64 (u64 -1)) (defonce g u32 (u32 -5)) \ + (defstruct S [a u8]) (defn f [x u64] S \ + (let [a [(u64 -1) 18446744073709551615] b [x (u64 -1)] \ + c (the u64 (u64 -1))] \ + (S (u8 -3))))"; + (* The literal that does not fit is the one blamed, not one that does. *) + rejects_check "a negative literal among u64 elements is the one blamed" + "(defn f [] () (println [(u64 2) 1 -1]))" ~needle:"-1 does not fit in u64"; + rejects_check "a negative literal after a u64 element is the one blamed" + "(defn f [] () (println [1 (u64 2) -1]))" ~needle:"-1 does not fit in u64"; + (* In a generic body the cast would break the other instantiations. *) + (match + checked + "(defn add1 [x $t] $t {:where (numeric? $t)} (+ x -1)) \ + (defn main [] i32 (add1 3) (add1 (u64 5)) 0)" + with + | _ -> check "a negative literal at a u64 instantiation is refused" false + | exception Loc.Error d -> + check "the generic's refusal names a fix for every type and the call" + (contains d.Loc.dmsg "as in (- x 1) in place of (+ x -1)" + && not (contains d.Loc.dmsg "(u64 -1)") + && List.exists + (fun (n : Loc.note) -> + contains n.Loc.nmsg "add1 is instantiated at $t = u64 here") + d.Loc.notes)); + accepts "the generic's fix compiles at both types" + "(defn add1 [x $t] $t {:where (numeric? $t)} (- x 1)) \ + (defn main [] i32 (add1 3) (add1 (u64 5)) 0)"; + accepts "a doubly negated literal is positive at an unsigned type" + "(defn f [] u8 (- (- 1)))"; + rejects_check "a folded constant's conversion is still its type" + "(defconst a u8 (i32 5))" ~needle:"expected u8, found i32"; 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 \ @@ -6510,17 +6585,106 @@ let () = parse_rejects "the $ refusal names the bare spelling" "(defn $foo [x i32] i32 x)" ~needle:"Name it foo"; - (* ── An array literal's first element types the rest ───────────── *) - accepts "an f32 array literal from its first element" - "(defn main [] i32 (let [a [(f32 1.0) 2.5]] (i32 (length a))))"; - (match checked "(defn main [] i32 (let [a [(u8 1) 256]] 0))" with - | _ -> check "an element that does not fit the first element's type" false + (* ── An array literal with nothing outside it naming a type ────── *) + infers "a literal takes the other elements' type" "[(f32 1.0) 2.5]" "[2 f32]"; + infers "numbers meet at the wider" "[(u8 1) 256]" "[2 i32]"; + infers "an int and a float literal meet at f64" "[1 2.5]" "[2 f64]"; + infers "a wide literal makes the array u64" "[1 18446744073709551615]" "[2 u64]"; + infers "None takes the other element's Option" "[None (Some 1)]" "[2 (Option i32)]"; + infers "a number and a string are a dyn vector" "[10 \"Hi\"]" "dyn"; + infers "nil beside a number is a dyn vector" "[nil 1]" "dyn"; + infers "two dyns are a typed array of dyn" "[nil nil]" "[2 dyn]"; + infers "the names the element type of a mixed literal" "(the [dyn] [1 2.5])" "[2 dyn]"; + infers "the with a slice type gives the literal's array type" + "(the [f32] [1 2.5])" "[2 f32]"; + (match checked "(defstruct P [x i32]) (defn main [] i32 (let [a [(P 1) 2]] 0))" with + | _ -> check "a struct beside a number is refused" false | exception Loc.Error d -> - check "the refusal says the first element set the type" - (List.exists - (fun (n : Loc.note) -> - contains n.Loc.nmsg "this array's first element is u8") - d.Loc.notes)); + check "elements that cannot become a dyn are refused against the first" + (contains d.Loc.dmsg "expected P, found the integer literal 2" + && List.exists + (fun (n : Loc.note) -> + contains n.Loc.nmsg "this array's first element is P") + d.Loc.notes)); + (match checked "(defn g [x $t] i32 (let [a [x 1]] 0))" with + | _ -> check "a type variable beside a literal is refused" false + | exception Loc.Error d -> + check "a type variable beside a literal names the bound and spells $t" + (contains d.Loc.dmsg "{:where (numeric? $t)}" + && List.exists + (fun (n : Loc.note) -> + contains n.Loc.nmsg "this array's first element is $t") + d.Loc.notes)); + rejects_check "numbers with no common type are refused and the fix named" + "(defn f [x i32 y f32] i32 (let [a [x y]] 0))" + ~needle:"elements are i32 and f32, and neither holds every value of the \ + other — convert one, as in (f32 x)"; + accepts "the conversion that refusal names compiles" + "(defn f [x i32 y f32] i32 (let [a [(f32 x) y]] 0))"; + rejects_check "two integer types with no common type are refused" + "(defn f [x i64 y u64] i32 (let [a [x y]] 0))" ~needle:"as in (i64 y)"; + accepts "the integer conversion that refusal names compiles" + "(defn f [x i64 y u64] i32 (let [a [x (i64 y)]] 0))"; + rejects_check "every element needing a type names the first's refusal" + "(defn main [] i32 (let [a [None None]] 0))" + ~needle:"what None is an Option of"; + + (* ── (max-value T) and (min-value T) ──────────────────────────────── *) + infers "max-value carries its type" "(max-value u16)" "u16"; + infers "min-value at a float" "(min-value f32)" "f32"; + (match checked "(defn f [x $t] $t (max-value $t))" with + | _ -> check "max-value at an unbounded type variable is refused" false + | exception Loc.Error d -> + check "max-value at an unbounded type variable names the bound and only it" + (contains d.Loc.dmsg "write {:where (numeric? $t)}" + && not (contains d.Loc.dmsg "Fn"))); + infers "two literal if arms meet at the wider" "(if true 1 2.5)" "f64"; + infers "two integer if arms stay i32" "(if true 1 2)" "i32"; + infers "two literal match arms meet at the wider" + "(match (Some 1) (Some v) 1 None 2.5)" "f64"; + accepts "max-value at a type variable the bound admits" + "(defn f [x $t] $t {:where (integer? $t)} (max-value t))"; + rejects_check "max-value at a type that is not a number names the bound" + "(defn f [] string (max-value string))" + ~needle:"max-value takes a numeric? type, and string is not one"; + rejects_check "max-value of a value says it takes a type" + "(defn f [x i32] i32 (max-value x))" ~needle:"max-value takes a type"; + accepts "max-of of a slice is the prelude's reduction" + "(defn f [xs [i32]] (Option i32) (max-of xs))"; + rejects_check "max-of of a type names max-value" + "(defn f [] u8 (max-of u8))" ~needle:"the largest value of a type is (max-value u8)"; + + (* ── (the T e) ─────────────────────────────────────────────────── *) + infers "the gives a literal its type" "(the u8 200)" "u8"; + infers "the widens as an annotation does" "(the i64 (the i32 1))" "i64"; + rejects_check "the does not narrow" + "(defn f [x i64] i32 (the i32 x))" ~needle:"expected i32, found i64"; + rejects_check "the refuses a dyn and names the cast" + "(defn f [x dyn] i32 (the i32 x))" ~needle:"write (i32 x) to convert it"; + accepts "the cast that refusal names compiles" "(defn f [x dyn] i32 (i32 x))"; + rejects_check "the refuses a dyn at a type a dyn does not become" + "(defn f [x dyn] string (the string x))" + ~needle:"dyn — string does not cross into a written type yet"; + rejects_check "the refuses a dyn at bool, which a dyn becomes where passed" + "(defn f [x dyn] bool (the bool x))" + ~needle:"a dyn becomes a bool where a bool is passed"; + accepts "the bool a dyn becomes where it is returned" "(defn f [x dyn] bool x)"; + accepts "the at an Option takes nil" "(defn f [] (Option i32) (the (Option i32) nil))"; + parse_rejects "the takes a type and a value" "(defn f [] i32 (the i32))" + ~needle:"the is (the TYPE value)"; + (* The refusals of a form with no type of its own name the as a way out, and + the spellings they name compile. *) + rejects_check "an empty array literal names the" + "(defn main [] i32 (let [a []] 0))" ~needle:"(the [0 i32] [])"; + accepts "the empty array that refusal names compiles" + "(defn main [] i32 (let [a (the [0 i32] [])] (length a)))"; + accepts "the None that refusal names compiles" + "(defn main [] i32 (let [a (the (Option i32) None)] 0))"; + accepts "the zeroed that refusal names compiles" + "(defn main [] i32 (let [a (the [4 i32] (zeroed))] (at a 0)))"; + accepts "the fills that refusal names compile" + "(defn main [] i32 (let [a (the [4 u32] (filled 0xFF)) \ + b (the [4 u32] (dead-beef))] 0))"; (* ── A wide literal's follow-ups ──────────────────────────────── *) parse_rejects "a wide enum member is refused for its range" @@ -6541,10 +6705,7 @@ let () = "(defmacro idm [x] x) \ (defn f [] u64 (idm 18446744073709551615))"; - rejects_check "a wide element after a narrow first names the u64 array" - "(defn main [] i32 (let [a [1 18446744073709551615]] 0))" - ~needle:"write the first element as (u64 1) for an array of u64"; - accepts "the u64 array that refusal names compiles" + accepts "a u64 array with a cast first element" "(defn main [] i32 (let [a [(u64 1) 18446744073709551615]] 0))"; (* ── Suggestions that compile ─────────────────────────────────── *)