A defstruct whose fields introduce $t or an array length $n is a generic struct, each application of it an ordinary struct copy that generic functions bind against, and a printed call is evaluated once
This commit is contained in:
parent
680b8e7e59
commit
4054c4921b
13
TODO.org
13
TODO.org
@ -750,15 +750,10 @@ depth it gave up at. The bare depth number is a backstop that also prints the
|
||||
chain. Before any of it, the compiler hung rather than failed, which wedges =C-c
|
||||
C-c= with nothing to show.
|
||||
|
||||
** NEXT Generic types
|
||||
Decided 2026-09-25: the freeze is lifted for this; build both type and length parameters.
|
||||
=(defstruct Pair [a $t b $t])= cannot be spelled, and neither can a length
|
||||
parameter. =Types.Named= is a bare string with no room for parameters; giving it
|
||||
some changes the type, the layout calculator, both backends, the renderer and the
|
||||
DWARF path. Same price for one as for both. Decided and unblocked, deliberately
|
||||
not started — it is a language feature under a freeze, and it was stopped once
|
||||
already for that reason. The motivating case is Odin's =Small_Array=: a
|
||||
fixed-capacity array with a count and no allocation.
|
||||
** DONE Generic types
|
||||
CLOSED: [2026-09-25]
|
||||
A struct's parameters are its fields' $-names in first-written order, a length by position; there is no
|
||||
explicit parameter vector. Each application is an ordinary struct under a key, so no backend sees a parameter.
|
||||
|
||||
** WAIT A value predicate over a length parameter
|
||||
Decided 2026-09-25: waits until a program wants one.
|
||||
|
||||
@ -24,6 +24,9 @@ and texpr_kind =
|
||||
them identically — the difference is a fact about the value, and it is
|
||||
[Check.resolve] that turns it into one. *)
|
||||
| Tfn of bool * texpr list * texpr
|
||||
(* An integer written as a generic struct's argument, the 8 in
|
||||
(Small 8 i32). Parsed only there; it is not a type anywhere else. *)
|
||||
| Tlen of int64
|
||||
|
||||
(* An array length is an integer or a compile-time constant's name. *)
|
||||
and len =
|
||||
|
||||
984
lib/check.ml
984
lib/check.ml
File diff suppressed because it is too large
Load Diff
@ -407,6 +407,7 @@ let rec ty_source (t : Ast.texpr) =
|
||||
| Ast.Tname n -> n
|
||||
| Ast.Tapp (n, args) ->
|
||||
Printf.sprintf "(%s %s)" n (String.concat " " (List.map ty_source args))
|
||||
| Ast.Tlen n -> Int64.to_string n
|
||||
| Ast.Tslice (c, e) ->
|
||||
Printf.sprintf "[%s%s]" (if c then "const " else "") (ty_source e)
|
||||
| Ast.Tarray (Ast.Lint n, e) -> Printf.sprintf "[%Ld %s]" n (ty_source e)
|
||||
|
||||
21
lib/dev.ml
21
lib/dev.ml
@ -1819,8 +1819,27 @@ let defs t =
|
||||
~loc:(Loc.to_string loc) ())
|
||||
classes
|
||||
in
|
||||
(* A generic struct is listed by its template, as [(Pair $t)]; its copies
|
||||
are struct names only the compiler wrote. *)
|
||||
let structs =
|
||||
Hashtbl.fold
|
||||
(fun name _ acc ->
|
||||
if Hashtbl.mem env.Check.copies name then acc
|
||||
else entry ~name ~kind:"struct" ~sign:name ~loc:"" () :: acc)
|
||||
env.Check.structs []
|
||||
@ Hashtbl.fold
|
||||
(fun name (g : Check.gstruct) acc ->
|
||||
entry ~name ~kind:"struct"
|
||||
~sign:
|
||||
(Printf.sprintf "(%s %s)" name
|
||||
(String.concat " "
|
||||
(List.map (fun (p, _) -> "$" ^ p) g.Check.gparams)))
|
||||
~loc:"" ()
|
||||
:: acc)
|
||||
env.Check.gstructs []
|
||||
in
|
||||
List.sort compare
|
||||
(of_table "struct" env.Check.structs
|
||||
(structs
|
||||
@ datas @ classes
|
||||
@ of_table "union" env.Check.unions
|
||||
@ of_table "enum" env.Check.enums
|
||||
|
||||
@ -370,7 +370,7 @@ let rec ll (t : Types.t) =
|
||||
integer spelling costs no casts and keeps the emitter honest about not
|
||||
knowing whether the bits are a pointer. *)
|
||||
| Types.Dyn -> "i64"
|
||||
| Types.Var _ ->
|
||||
| Types.Var _ | Types.Len _ | Types.LArray _ ->
|
||||
(* The checker rejects it by name — nothing reaches here. *)
|
||||
internal "no layout for %s" (Types.to_string t)
|
||||
|
||||
@ -638,7 +638,8 @@ let rec lay m (t : Types.t) : int * int =
|
||||
| Some u -> union_lay m u
|
||||
| None -> internal "no layout for struct %s" n)
|
||||
| Types.Dyn -> 8, 8
|
||||
| Types.Var _ -> internal "no layout for %s" (Types.to_string t)
|
||||
| Types.Var _ | Types.Len _ | Types.LArray _ ->
|
||||
internal "no layout for %s" (Types.to_string t)
|
||||
|
||||
(* Size, alignment, and the offset of every member. *)
|
||||
and lay_fields m tys =
|
||||
@ -1175,7 +1176,7 @@ let rec dty m d (t : Types.t) : int =
|
||||
reading: it prints, and the person reading it can hand it to the
|
||||
runtime's own printer. *)
|
||||
| Types.Dyn -> basic "dyn" 64 "DW_ATE_unsigned"
|
||||
| Types.Var _ ->
|
||||
| Types.Var _ | Types.Len _ | Types.LArray _ ->
|
||||
internal "no debug type for %s" (Types.to_string t)
|
||||
in
|
||||
Hashtbl.replace d.dtys key n;
|
||||
|
||||
@ -249,6 +249,8 @@ let rec refuse_ty loc (t : Types.t) =
|
||||
host's own, and that work has not been done"
|
||||
| Types.Var n ->
|
||||
at loc "a type variable (%s) reached the backend, which cannot happen" n
|
||||
| Types.Len _ | Types.LArray _ ->
|
||||
at loc "a length variable reached the backend, which cannot happen"
|
||||
|
||||
(* Aggregates in the sense that matters here: the types whose assignment
|
||||
copies in Flan and would alias in JS. A slice is deliberately not one —
|
||||
|
||||
@ -205,8 +205,11 @@ let rec rename_texpr owned alias (t : Ast.texpr) : Ast.texpr =
|
||||
Ast.Tarray (rename_len owned alias l, rename_texpr owned alias e)
|
||||
| Ast.Tmap (k, v) ->
|
||||
Ast.Tmap (rename_texpr owned alias k, rename_texpr owned alias v)
|
||||
(* The head too, when it is a generic struct the package declares. *)
|
||||
| Ast.Tapp (n, args) ->
|
||||
let n = if List.mem n owned then qualify alias n else n in
|
||||
Ast.Tapp (n, List.map (rename_texpr owned alias) args)
|
||||
| Ast.Tlen _ as k -> k
|
||||
| Ast.Tfn (env, ps, r) ->
|
||||
Ast.Tfn (env, List.map (rename_texpr owned alias) ps,
|
||||
rename_texpr owned alias r)
|
||||
@ -792,8 +795,11 @@ let rec texpr_uses acc (t : Ast.texpr) =
|
||||
(match l with Ast.Lname n -> acc := (n, t.Ast.tloc) :: !acc | Ast.Lint _ -> ());
|
||||
texpr_uses acc e
|
||||
| Ast.Tmap (k, v) -> texpr_uses acc k; texpr_uses acc v
|
||||
| Ast.Tapp (_, args) -> List.iter (texpr_uses acc) args
|
||||
| Ast.Tapp (n, args) ->
|
||||
acc := (n, t.Ast.tloc) :: !acc;
|
||||
List.iter (texpr_uses acc) args
|
||||
| Ast.Tfn (_, ps, r) -> List.iter (texpr_uses acc) ps; texpr_uses acc r
|
||||
| Ast.Tlen _ -> ()
|
||||
|
||||
let rec expr_uses acc (e : Ast.expr) =
|
||||
let go = expr_uses acc in
|
||||
|
||||
20
lib/parse.ml
20
lib/parse.ml
@ -136,7 +136,25 @@ let rec texpr (f : Form.t) : Ast.texpr =
|
||||
mk (Ast.Tfn (env, List.map texpr params, texpr ret))
|
||||
| _ -> fail f "a function type is (%s [T ...] R)" which)
|
||||
| List ({ v = Sym name; _ } :: args) when args <> [] ->
|
||||
mk (Ast.Tapp (name, List.map texpr args))
|
||||
(* An integer argument is a generic struct's length, and a type
|
||||
constructor is capitalised. A lowercase head is a body form in the
|
||||
return slot — (+ x 1) — and its integer is the type parser's reason to
|
||||
give up, which is the refusal that slot is built on. *)
|
||||
let capitalised =
|
||||
let base =
|
||||
match String.rindex_opt name '/' with
|
||||
| Some i -> String.sub name (i + 1) (String.length name - i - 1)
|
||||
| None -> name
|
||||
in
|
||||
base <> "" && Char.uppercase_ascii base.[0] = base.[0]
|
||||
&& Char.lowercase_ascii base.[0] <> base.[0]
|
||||
in
|
||||
let arg (a : Form.t) =
|
||||
match a.v with
|
||||
| Int n when capitalised -> { Ast.t = Ast.Tlen n; tloc = a.loc }
|
||||
| _ -> texpr a
|
||||
in
|
||||
mk (Ast.Tapp (name, List.map arg args))
|
||||
| _ -> fail f "expected a type, found %s" (Form.to_string f)
|
||||
|
||||
and len (f : Form.t) : Ast.len =
|
||||
|
||||
@ -597,7 +597,7 @@ let compatible ~loc (old_ : Tast.program) (new_ : Tast.program) =
|
||||
if not same then
|
||||
fail loc
|
||||
"%s changes layout. Restart to change it."
|
||||
s.Tast.sname
|
||||
(Types.to_string (Types.Named s.Tast.sname))
|
||||
| None -> ())
|
||||
new_.Tast.structs
|
||||
|
||||
@ -2610,10 +2610,12 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) t src : change =
|
||||
let placed =
|
||||
List.filter (fun (f : Tast.fn) -> List.mem f.Tast.name own) placed
|
||||
in
|
||||
let copies = Check.fresh_copies t.env t.program.Tast.structs in
|
||||
let program =
|
||||
{ t.program with
|
||||
Tast.fns = t.program.Tast.fns @ fresh @ placed;
|
||||
structs = t.program.Tast.structs @ Check.env_structs t.env lifted;
|
||||
structs =
|
||||
t.program.Tast.structs @ copies @ Check.env_structs t.env lifted;
|
||||
externs = t.program.Tast.externs @ externs }
|
||||
in
|
||||
let ir =
|
||||
@ -2639,7 +2641,10 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) t src : change =
|
||||
caller closes that half by taking a [held] before this and restoring it
|
||||
when either fails — a copy the session holds and no module defines is a
|
||||
null cell exactly as a stranded declaration is. *)
|
||||
t.program <- { t.program with Tast.fns = t.program.Tast.fns @ fresh };
|
||||
t.program <-
|
||||
{ t.program with
|
||||
Tast.fns = t.program.Tast.fns @ fresh;
|
||||
structs = t.program.Tast.structs @ copies };
|
||||
{ ir; x86 = t.x86; names = []; fns = []; installs = true; stale = [] }
|
||||
|
||||
(* ── What a macro call expands to ──────────────────────────────────── *)
|
||||
|
||||
@ -256,6 +256,7 @@ let rec cty env ~needed ~loc ~what (t : Ast.texpr) : string =
|
||||
fail loc "%s is a function type, and a C callback is not implemented" what
|
||||
| Ast.Tapp (n, _) ->
|
||||
fail loc "%s is %s, which is not a type this shim generator knows" what n
|
||||
| Ast.Tlen n -> fail loc "%s is %Ld, which is not a type" what n
|
||||
|
||||
(* ── What one parameter does at the boundary ────────────────────────── *)
|
||||
|
||||
|
||||
26
lib/types.ml
26
lib/types.ml
@ -106,6 +106,15 @@ type t =
|
||||
| Fn of t list * t (* (Fn [T ...] R) *)
|
||||
| CFn of t list * t (* (CFn [T ...] R) *)
|
||||
| Var of string (* a type variable — milestone 5 *)
|
||||
(* The two halves of a length parameter, and neither is the type of a value.
|
||||
[Len] is a length standing where a generic struct's argument goes — the 8
|
||||
in (Small 8 i32) — and what a length variable is bound to. [LArray] is a
|
||||
fixed array whose length is a variable, [[$n $t]], and exists only in a
|
||||
generic signature, as the pattern a call site binds [n] from. A generic
|
||||
body is checked with its lengths at [Check.abstract_len], so neither ever
|
||||
reaches a backend. *)
|
||||
| Len of int64
|
||||
| LArray of string * t
|
||||
(* [dyn]: one machine word whose contents the runtime knows and this module
|
||||
does not. It is a written type — [(defonce x dyn 5)] boxes the 5 — and it
|
||||
is also what an unannotated [defn] parameter means, which is why it is a
|
||||
@ -206,8 +215,20 @@ let rec equal a b =
|
||||
&& List.for_all2 equal ps ps'
|
||||
&& equal r r'
|
||||
| Var x, Var y -> String.equal x y
|
||||
| Len x, Len y -> Int64.equal x y
|
||||
| LArray (n, x), LArray (m, y) -> String.equal n m && equal x y
|
||||
| _ -> false
|
||||
|
||||
(* How a generic struct's copy is spelled to a reader. The copy is an
|
||||
ordinary struct under a symbol-safe key — [Small-8-i32] — and this is the
|
||||
key's written form, [(Small 8 i32)], filled in as each copy is made. Global
|
||||
rather than on a checker's env because every message that prints a type
|
||||
comes through here with no env in hand. The key determines the spelling,
|
||||
so an entry left from an earlier program in the same process is wrong only
|
||||
for a struct that program's successor declares under a copy's key by hand,
|
||||
and then only in how a message spells it. *)
|
||||
let display : (string, string) Hashtbl.t = Hashtbl.create 16
|
||||
|
||||
let rec to_string = function
|
||||
| Int k -> ikind_name k
|
||||
| Float k -> fkind_name k
|
||||
@ -215,7 +236,8 @@ let rec to_string = function
|
||||
| String -> "string"
|
||||
| Unit -> "()"
|
||||
| Never -> "Never"
|
||||
| Named n | Enum n -> n
|
||||
| Named n -> (match Hashtbl.find_opt display n with Some d -> d | None -> n)
|
||||
| Enum n -> n
|
||||
| Slice (Mut, t) -> "[" ^ to_string t ^ "]"
|
||||
| Slice (Const, t) -> "[const " ^ to_string t ^ "]"
|
||||
| Array (n, t) -> Printf.sprintf "[%Ld %s]" n (to_string t)
|
||||
@ -232,6 +254,8 @@ let rec to_string = function
|
||||
Printf.sprintf "(CFn [%s] %s)"
|
||||
(String.concat " " (List.map to_string ps)) (to_string r)
|
||||
| Var n -> "$" ^ n
|
||||
| Len n -> Int64.to_string n
|
||||
| LArray (n, t) -> Printf.sprintf "[$%s %s]" n (to_string t)
|
||||
| Dyn -> "dyn"
|
||||
|
||||
let is_numeric = function Int _ | Float _ -> true | _ -> false
|
||||
|
||||
@ -532,6 +532,7 @@ let is_agg (t : Types.t) =
|
||||
the arithmetic. *)
|
||||
| Types.Dyn -> false
|
||||
| Types.Var v -> unsupported "type variable %s" v
|
||||
| Types.Len _ | Types.LArray _ -> unsupported "length variable"
|
||||
|
||||
let is_void (t : Types.t) = match t with Types.Unit | Types.Never -> true | _ -> false
|
||||
let is_float (t : Types.t) = match t with Types.Float _ -> true | _ -> false
|
||||
|
||||
89
test/programs/generic-struct.flan
Normal file
89
test/programs/generic-struct.flan
Normal file
@ -0,0 +1,89 @@
|
||||
;;;; Generic structs, end to end: type parameters and length parameters.
|
||||
;;;;
|
||||
;;;; A defstruct whose fields introduce $t is a template, and each set of
|
||||
;;;; arguments it is given is a copy — an ordinary struct. A parameter is a
|
||||
;;;; length when it stands in an array's length slot, and a type anywhere else;
|
||||
;;;; the arguments are written in the order the fields first introduce them.
|
||||
;;;;
|
||||
;;;; Small is Odin's Small_Array: a fixed-capacity array with a count, and no
|
||||
;;;; allocation anywhere.
|
||||
|
||||
(defstruct Small [items [$n $t] count i32])
|
||||
|
||||
;; A generic function over a generic struct binds both of its parameters from
|
||||
;; the argument, and reads the length back as a value.
|
||||
(defn append! [s (Ptr (Small $n $t)) x $t] bool
|
||||
(if (< (.count s) n)
|
||||
(do (set (at (.items s) (.count s)) x)
|
||||
(set (.count s) (+ (.count s) 1))
|
||||
true)
|
||||
false))
|
||||
|
||||
(defn pop! [s (Ptr (Small $n $t))] (Option $t)
|
||||
(if (= (.count s) 0)
|
||||
None
|
||||
(do (set (.count s) (- (.count s) 1))
|
||||
(Some (at (.items s) (.count s))))))
|
||||
|
||||
(defn capacity [s (Ptr (Small $n $t))] i32 n)
|
||||
|
||||
(defn total [s (Ptr (Small $n $t))] $t {:where (numeric? $t)}
|
||||
(let [acc (the $t 0)]
|
||||
(dotimes [i (.count s)]
|
||||
(set acc (+ acc (at (.items s) i))))
|
||||
acc))
|
||||
|
||||
;; A type parameter alone, built positionally with the type read off the
|
||||
;; fields, and returned under a variable.
|
||||
(defstruct Pair [a $t b $t])
|
||||
|
||||
(defn swapped [p (Pair $t)] (Pair $t) (Pair (.b p) (.a p)))
|
||||
|
||||
;; A copy that names itself through a pointer, and a literal field that
|
||||
;; takes its width from the one beside it.
|
||||
(defstruct Node [v $t next (Option (Ptr (Node $t)))])
|
||||
|
||||
(defn sum-list [n (Ptr (Node i64))] i64
|
||||
(loop [at n acc (the i64 0)]
|
||||
(let [acc (+ acc (.v at))]
|
||||
(match (.next at)
|
||||
(Some p) (recur p acc)
|
||||
None acc))))
|
||||
|
||||
;; A template naming another at its own parameters.
|
||||
(defstruct Twice [x (Small $m $u) y (Small $m $u)])
|
||||
|
||||
;; A length variable straight on an array parameter.
|
||||
(defn len-of [a [$k $e]] i32 k)
|
||||
|
||||
(defconst cap 3)
|
||||
|
||||
(defn main [] i32
|
||||
(let [s (the (Small 4 i32) (zeroed))
|
||||
f (the (Small cap f64) (zeroed))]
|
||||
(append! (addr s) 10)
|
||||
(append! (addr s) 20)
|
||||
(append! (addr s) 30)
|
||||
(println (total (addr s)) (.count s) (capacity (addr s)))
|
||||
(append! (addr f) 1.5)
|
||||
(append! (addr f) 2.5)
|
||||
(append! (addr f) 3.5)
|
||||
(println (append! (addr f) 4.5) (total (addr f)) (capacity (addr f)))
|
||||
(println (pop! (addr f)) (pop! (addr f)) (.count f))
|
||||
(let [p (Pair 1 2)
|
||||
q (swapped p)
|
||||
r (swapped (Pair {.a 1.5 .b 2.5}))]
|
||||
(println (.a q) (.b q) (.a r) (.b r)))
|
||||
(let [c (the (Node i64) {.v 3})
|
||||
b (Node 2 (Some (addr c)))
|
||||
a (Node 1 (Some (addr b)))]
|
||||
(println (sum-list (addr a))))
|
||||
(let [w (the (Twice 2 u8) (zeroed))]
|
||||
(append! (addr (.y w)) 7)
|
||||
(println (.count (.x w)) (.count (.y w)) (capacity (addr (.x w)))))
|
||||
(println (len-of [1 2 3]) (len-of [1.5 2.5]))
|
||||
(let [v (vec-new (Pair i32))]
|
||||
(push v (Pair 5 6))
|
||||
(println (.b (at v 0)))
|
||||
(free v))
|
||||
0))
|
||||
@ -3466,6 +3466,18 @@ let () =
|
||||
outputs "generics" "programs/generics.flan" generics_out;
|
||||
outputs ~opt:"-O0" "generics, -O0" "programs/generics.flan" generics_out;
|
||||
|
||||
(* Generic structs — see the program's header. The third line is two pops
|
||||
printed in one call, which is also the pin for a printed call being
|
||||
evaluated once: the walk reads an option's tag and then its payload,
|
||||
and each read used to make the call again. *)
|
||||
let generic_struct_out =
|
||||
"60 3 4\nfalse 7.5 3\n(some 3.5) (some 2.5) 1\n2 1 2.5 1.5\n6\n\
|
||||
0 1 2\n3 2\n6\n"
|
||||
in
|
||||
outputs "generic structs" "programs/generic-struct.flan" generic_struct_out;
|
||||
outputs ~x86:true "generic structs, --x86" "programs/generic-struct.flan"
|
||||
generic_struct_out;
|
||||
|
||||
(* integer?, end to end — see the program's own header. The first eight
|
||||
lines are the collapsed abs at six widths and both signed minimums
|
||||
(which answer themselves; the negation wraps). The [0 0] after them is
|
||||
|
||||
@ -1470,10 +1470,10 @@ let () =
|
||||
can actually be written there; the parameter-vector suggestion survives
|
||||
where it works, which the return-type pin further down exercises. *)
|
||||
rejects_check "a real type variable at a field" "(defstruct Holder [x elem])"
|
||||
~needle:"a field is built at one type for every value";
|
||||
~needle:"in a defstruct's fields that makes the struct generic over it";
|
||||
rejects_check "and the field message offers what a field can hold"
|
||||
"(defstruct Holder [x elem])"
|
||||
~needle:"Write a concrete type here, or dyn to hold any value";
|
||||
~needle:"Write $elem, a concrete type, or dyn to hold any value";
|
||||
rejects_check "an unknown concrete type" "(defn f [x Widget] ())"
|
||||
~needle:"unknown type Widget";
|
||||
|
||||
@ -2871,13 +2871,11 @@ let () =
|
||||
(* [(Pair i32)] in a defonce falls down the value fork now that the third
|
||||
element takes either reading, and the generics answer the type fork gave
|
||||
it has to be reachable from here too. *)
|
||||
(* A capitalised head with arguments is a *type* given type arguments, and
|
||||
that is the half of generics that is not built — Types.Named is a bare
|
||||
string with no room for parameters. The sentence says which half, since
|
||||
generic functions are here and pointing at them is the useful part. *)
|
||||
(* A capitalised head with arguments is a *type* given type arguments; with
|
||||
no such struct declared, the sentence says how one is. *)
|
||||
rejects_check "a capitalised call with arguments is a generic type"
|
||||
"(defonce x (Pair i32)) (defn f [] i32 0)"
|
||||
~needle:"is a generic type, which is not there yet";
|
||||
~needle:"no struct or generic struct Pair is declared";
|
||||
accepts "and the generic function it points at is"
|
||||
"(defn pair-fst [a $t b $u] $t (do b a))\n\
|
||||
(defn main [] () (println (pair-fst 1 true)))";
|
||||
@ -6701,9 +6699,74 @@ let () =
|
||||
"(defn f [a $t b $u] i32 (do a b (let [v (vec-new $w)] (free v) 0)))";
|
||||
(* Where no variable is in scope there is none to name, and the answer is
|
||||
the rule: a sigil binds, and only a defn signature is a binding site. *)
|
||||
rejects_check "a sigil in a struct field, where nothing can bind one"
|
||||
~needle:"only a defn signature can"
|
||||
"(defstruct S [v $t])";
|
||||
rejects_check "a sigil in a data case's field, where nothing can bind one"
|
||||
~needle:"only a defn signature or a defstruct's fields can"
|
||||
"(defdata D [(C [v $t])])";
|
||||
|
||||
(* ── Generic structs: what is refused, and where ─────────────────── *)
|
||||
rejects_check "a generic struct given the wrong number of arguments"
|
||||
~needle:"Pair takes 1 argument, (Pair $t), and this gives 2"
|
||||
"(defstruct Pair [a $t b $t]) (defn f [p (Pair i32 i64)] i32 0)";
|
||||
rejects_check "a generic struct named with no arguments"
|
||||
~needle:"Pair is generic, and a type only once it is given its arguments"
|
||||
"(defstruct Pair [a $t b $t]) (defn f [p Pair] i32 0)";
|
||||
rejects_check "a type where a length argument goes"
|
||||
~needle:"Small's $n is a length"
|
||||
"(defstruct Small [items [$n $t] count i32]) \
|
||||
(defn f [p (Small i32 4)] i32 0)";
|
||||
rejects_check "a length where a type argument goes"
|
||||
~needle:"Small's $t is a type, and 4 is a length"
|
||||
"(defstruct Small [items [$n $t] count i32]) \
|
||||
(defn f [p (Small 4 4)] i32 0)";
|
||||
rejects_check "a negative length argument"
|
||||
~needle:"-1 is negative"
|
||||
"(defstruct Small [items [$n $t] count i32]) \
|
||||
(defn f [p (Small -1 i32)] i32 0)";
|
||||
rejects_check "one variable as both a length and a type"
|
||||
~needle:"$t stands for a length in one place here and a type in another"
|
||||
"(defstruct Bad [x $t y [$t i32]])";
|
||||
rejects_check "a length variable where a type goes"
|
||||
~needle:"n is a length, not a type"
|
||||
"(defn f [a [$n i32]] i32 (let [x (the n 0)] 0))";
|
||||
rejects_check "a where clause over a length variable"
|
||||
~needle:"$n is a length, and a where clause takes type predicates only"
|
||||
"(defn f [a [$n i32]] i32 {:where (numeric? $n)} 0)";
|
||||
rejects_check "a generic struct that contains itself by value"
|
||||
~needle:"(Loop $t) contains itself by value"
|
||||
"(defstruct Loop [next (Loop $t)])";
|
||||
rejects_check "a generic struct that asks for bigger copies of itself"
|
||||
~needle:"Grow names a copy of itself at a type built around its own"
|
||||
"(defstruct Grow [next (Ptr (Grow [$t]))]) (defn f [p (Grow i32)] i32 0)";
|
||||
rejects_check "a copy whose key is already a struct's name"
|
||||
~needle:"Pair at these arguments is called Pair-i32, and Pair-i32 is \
|
||||
already defined"
|
||||
"(defstruct Pair [a $t b $t]) (defstruct Pair-i32 [x i32]) \
|
||||
(defn f [p (Pair i32)] i32 0)";
|
||||
rejects_check "a generic struct literal whose fields decide nothing"
|
||||
~needle:"Pair's $t is not decided by the fields given here"
|
||||
"(defstruct Pair [a $t b $t]) (defn f [] i32 (let [p (Pair {})] 0))";
|
||||
rejects_check "two fields that disagree about the variable"
|
||||
~needle:"(Pair $t)'s .b is i32 here, and this is f64"
|
||||
"(defstruct Pair [a $t b $t]) \
|
||||
(defn f [] i32 (let [p (Pair (the i32 1) (the f64 2.5))] 0))";
|
||||
accepts "a literal field takes its width from a typed one beside it"
|
||||
"(defstruct Pair [a $t b $t]) \
|
||||
(defn f [] f64 (let [p (Pair 1 (the f64 2.5))] (.a p)))";
|
||||
rejects_check "a generic struct as a condition"
|
||||
~needle:"Pair is generic, and a condition struct is not"
|
||||
"(defstruct Pair :parent Error [a $t])";
|
||||
rejects_check "an operator a generic body's struct field does not support"
|
||||
~needle:"+ over the type variable $t"
|
||||
"(defstruct Pair [a $t b $t]) (defn f [p (Pair $t)] $t (+ (.a p) (.b p)))";
|
||||
accepts "the same body with the predicate declared"
|
||||
"(defstruct Pair [a $t b $t]) \
|
||||
(defn f [p (Pair $t)] $t {:where (numeric? $t)} (+ (.a p) (.b p))) \
|
||||
(defn main [] i32 (f (Pair 1 2)))";
|
||||
accepts "a copy wanted where it is built takes its type from there"
|
||||
"(defstruct Pair [a $t b $t]) (defn f [] (Pair i64) (Pair 1 2))";
|
||||
accepts "a defonce of a generic struct's copy"
|
||||
"(defstruct Pair [a $t b $t]) (defonce g (Pair i32)) \
|
||||
(defn main [] i32 (.a g))";
|
||||
|
||||
(* ── The builtin table against the arms it describes ──────────────
|
||||
[Check.builtins] is what the editor's C-c C-v and M-. read for a name no
|
||||
|
||||
@ -354,6 +354,26 @@ let () =
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
||||
fail "the session was poisoned by a bad expression: %s" m);
|
||||
|
||||
(* A generic struct's copy first named by an expression typed at the
|
||||
session: the module built for it has to lay the copy out, and the
|
||||
session keeps it, as it keeps a generic function's copy. *)
|
||||
(let gt, _ = Session.create ~file:"programs/reload.flan" () in
|
||||
(match Session.eval gt "(defstruct Pair [a $t b $t])" with
|
||||
| _ -> ()
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
||||
fail "a generic struct was refused at the session: %s" m);
|
||||
match Session.eval_expr gt "(println (.b (Pair 7 8)))" with
|
||||
| e ->
|
||||
if not (has e.Session.ir "%\"Pair-i32\" = type") then
|
||||
fail "the expression's module did not carry the struct copy";
|
||||
if not
|
||||
(List.exists
|
||||
(fun (s : Tast.structure) -> String.equal s.Tast.sname "Pair-i32")
|
||||
gt.Session.program.Tast.structs)
|
||||
then fail "the session did not keep the struct copy an expression made"
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
||||
fail "an expression building a generic struct was refused: %s" m);
|
||||
|
||||
(* The other half of "a refusal costs nothing", and the half that used to be
|
||||
missing: a form can check and *then* fail, in the build or at the agent,
|
||||
and the session that already accepted it has no way to hear about it
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user