Classes and generic functions, milestone 2's last item
A defclass is a named dyn map with a shape tag, and a generic function
dispatches on it two ways: CLOS's, where the dispatch value is the class
of the first argument, and Clojure's, where a body computes it. They are
one mechanism and not two — a class dispatcher is (class-of arg0) as the
dispatch function, which is what lets a method written for the class
point and one written for the value :point be the same branch.
(defclass point [x y])
(point 3 4) ; the constructor, positional
(class-of p) ; :point, or nil for anything else
(defgeneric area [self] dyn)
(defmethod area point [p] (* (get p :x) (get p :y)))
(defmulti describe [x] dyn (get x :kind))
(defmethod describe :square [s] ...)
(defmethod describe :else [s] ...)
A slot is a key in the instance's own map, so get, put and has-key? are
how one is read and written and no operation was added for any of it.
What the class adds is the tag, and the tag lives in the object's header
rather than in a reserved entry — the queue's note said a reserved key
and this departs from it, because a key would be counted by len, walked
by the renderer and compared by equality, so every instance would answer
a length one larger than its slot count and print a key nobody wrote. A
header field cannot be reached by get or put at all, so no user key can
collide with it. It costs nothing: the map arm of flan_obj's union grows
to the size the view arm already had, and sizeof(flan_obj) is unchanged.
It needs no tracing either — the tag is an interned keyword entry, which
is immortal and is not a collector object.
The tag shows up in exactly three places: class-of answers it, equality
compares it (two instances of one class compare by their slots; an
instance and a plain map with the same entries do not, which is
Clojure's answer for a record beside a map), and both renderers print it
— #point{ :x 1 :y 2}, Clojure's own spelling.
None of the four forms reaches the checker. lib/classes.ml turns the
whole declaration list into ordinary defns at the top of build_program,
the way Shim.expand already turns a declare-c into a declare plus a
defn: a class becomes its constructor, a generic becomes one function
whose body binds the dispatch value and compares it down a chain, and a
method becomes a branch of that chain. It is a pass and not a macro
because a macro sees one form and the generic's body is not decidable
until every method is in hand — a method may be written above its
generic, below it, or arrive at a reload an hour later.
That last case is why the method bodies are inlined rather than lifted.
A generic is exactly one top-level name, so adding a method to a running
program is the ordinary redefinition of one function, through the cell
every call site already goes through. session.ml names the generic
alongside the method's own declaration name for that reason. The cost,
recorded rather than hidden: a method is not separately callable and is
not a frame of its own.
A dispatch that finds no method signals NoMethod, a prelude struct
carrying the generic's name and the dispatch value that missed. A
condition and not a trap, because a miss is something a program can be
written to answer, and handler-case around the call is the shape. Its
value field is dyn, the first condition here with one; the per-type
descriptor an item-2 struct carries is what the collector reaches it by.
No restart is established at the miss, which is BoundsError's decision
taken for BoundsError's reason.
Both backends, identically: the two new runtime entry points are
declared in emit.ml and the x86 backend needs nothing, since a dyn call
is a dyn call there. Deferred and written down in FIX.org: inheritance,
multi-argument dispatch, :before/:after/:around, named-slot
construction, unknown-slot checking, and computed dispatch values.
This commit is contained in:
parent
c4e07256db
commit
5a62770e52
@ -92,6 +92,15 @@ let summarise (d : Flan.Ast.decl) =
|
|||||||
Printf.sprintf "declare-c %s (%d params) = %s" fn.name
|
Printf.sprintf "declare-c %s (%d params) = %s" fn.name
|
||||||
(List.length fn.params) csym
|
(List.length fn.params) csym
|
||||||
| Defenum (n, ms) -> Printf.sprintf "defenum %s (%d members)" n (List.length ms)
|
| Defenum (n, ms) -> Printf.sprintf "defenum %s (%d members)" n (List.length ms)
|
||||||
|
| Defclass (n, slots) ->
|
||||||
|
Printf.sprintf "defclass %s (%d slots)" n (List.length slots)
|
||||||
|
| Defgeneric fn ->
|
||||||
|
Printf.sprintf "defgeneric %s (%d params)" fn.name (List.length fn.params)
|
||||||
|
| Defmulti fn ->
|
||||||
|
Printf.sprintf "defmulti %s (%d params)" fn.name (List.length fn.params)
|
||||||
|
| Defmethod m ->
|
||||||
|
Printf.sprintf "defmethod %s %s (%d body forms)" m.mgen
|
||||||
|
(dispatch_text m.mkey) (List.length m.mfn.fbody)
|
||||||
| Defn fn ->
|
| Defn fn ->
|
||||||
Printf.sprintf "defn %s (%d params, %s return, %d body forms)"
|
Printf.sprintf "defn %s (%d params, %s return, %d body forms)"
|
||||||
fn.name (List.length fn.params)
|
fn.name (List.length fn.params)
|
||||||
|
|||||||
94
lib/ast.ml
94
lib/ast.ml
@ -69,7 +69,13 @@ and expr_kind =
|
|||||||
(* {:a 1 :b s} — a dyn map literal. Braces whose first form is not a
|
(* {:a 1 :b s} — a dyn map literal. Braces whose first form is not a
|
||||||
[.field] symbol are this; the struct spelling keeps the dot. Keys are
|
[.field] symbol are this; the struct spelling keeps the dot. Keys are
|
||||||
ordinary expressions, keywords being the common case. *)
|
ordinary expressions, keywords being the common case. *)
|
||||||
| MapLit of (expr * expr) list
|
(* The [string option] is a shape tag, and the parser never writes one: a
|
||||||
|
tagged map is what a (defclass ...) constructor builds, and
|
||||||
|
[Classes.expand] is the only thing that writes that constructor. The tag
|
||||||
|
is the class's name; the instance carries it in its object header, not as
|
||||||
|
an entry, so a tagged literal and an untagged one with the same pairs
|
||||||
|
differ in exactly one word and in nothing a [get] can see. *)
|
||||||
|
| MapLit of string option * (expr * expr) list
|
||||||
| Arr of expr list (* [0xE6B800FF ...] — a fixed array value *)
|
| Arr of expr list (* [0xE6B800FF ...] — a fixed array value *)
|
||||||
(* (array 4 rl/Vector2) — a zeroed fixed array, given its count and its
|
(* (array 4 rl/Vector2) — a zeroed fixed array, given its count and its
|
||||||
element type. [n T] is the ordinary *type* syntax and already works
|
element type. [n T] is the ordinary *type* syntax and already works
|
||||||
@ -208,6 +214,52 @@ and decl_kind =
|
|||||||
(* value is optional: ZII. `uninit` opts out and is recorded as Uninit. *)
|
(* value is optional: ZII. `uninit` opts out and is recorded as Uninit. *)
|
||||||
| Defvar of string * texpr option * init
|
| Defvar of string * texpr option * init
|
||||||
| Defconst of string * texpr option * expr
|
| Defconst of string * texpr option * expr
|
||||||
|
(* ── The dyn side's classes and generic functions ──────────────────
|
||||||
|
None of these four reaches [Check]. [Classes.expand] turns the whole set
|
||||||
|
into ordinary [Defn]s before pass one collects anything, the way [Shim]
|
||||||
|
already turns a [DeclareC] into a [Declare] plus a [Defn]: a class is a
|
||||||
|
constructor, and a generic function is one function whose body is a
|
||||||
|
dispatch over the methods written for it.
|
||||||
|
|
||||||
|
They are declarations here rather than a macro because the expansion
|
||||||
|
needs the *whole* declaration list in hand — a method may be written
|
||||||
|
anywhere in the file, or arrive at a reload long after the generic did,
|
||||||
|
and a macro sees one form. *)
|
||||||
|
|
||||||
|
(* (defclass point [x y]) — the slot names, in constructor order. *)
|
||||||
|
| Defclass of string * (string * Loc.t) list
|
||||||
|
(* (defgeneric area [self] dyn) — CLOS's class dispatch: the dispatch value
|
||||||
|
is the shape tag of the first argument. The parameter vector and the
|
||||||
|
return slot are a [defn]'s, and there is no body. *)
|
||||||
|
| Defgeneric of fn
|
||||||
|
(* (defmulti describe [x] dyn (get x :kind)) — Clojure's: the body IS the
|
||||||
|
dispatch function, computing the value the methods are keyed by. Exactly
|
||||||
|
a [defn]'s shape, which is what it is. *)
|
||||||
|
| Defmulti of fn
|
||||||
|
(* (defmethod area point [p] body ...) — one method of a generic. [mgen] is
|
||||||
|
the generic's name, [mkey] the dispatch value it answers for, and [mfn]
|
||||||
|
carries the parameter vector and the body. There is no return slot: the
|
||||||
|
generic states the return type once, for all of its methods. *)
|
||||||
|
| Defmethod of methd
|
||||||
|
|
||||||
|
(* A dispatch value, written at a [defmethod]. Only literals: the value is
|
||||||
|
compared at run time and the *name* the method is declared under is built
|
||||||
|
from it at compile time, so it has to be something both passes can read. *)
|
||||||
|
and dispatch =
|
||||||
|
(* [point] — a class's name, standing for the keyword its instances carry.
|
||||||
|
Refused unless a [defclass] of that name is in scope, which is the one
|
||||||
|
compile-time check a shape tag makes possible. *)
|
||||||
|
| Dclass of string
|
||||||
|
| Dkw of string (* :circle *)
|
||||||
|
| Dstr of string (* "circle" *)
|
||||||
|
| Dint of int64
|
||||||
|
| Dbool of bool
|
||||||
|
(* [:else] — the method that answers when no other does. The spelling is
|
||||||
|
[match]'s, not Clojure's [:default], because this language already has
|
||||||
|
one word for "none of the above" and two would be one too many. *)
|
||||||
|
| Delse
|
||||||
|
|
||||||
|
and methd = { mgen : string; mkey : dispatch; mfn : fn; mkloc : Loc.t }
|
||||||
|
|
||||||
and variant = { vname : string; vfields : field list; vloc : Loc.t }
|
and variant = { vname : string; vfields : field list; vloc : Loc.t }
|
||||||
|
|
||||||
@ -225,11 +277,37 @@ and init = Zeroed | Uninit | Init of expr | Ambiguous of expr
|
|||||||
one top-level namespace, so this is both the set [Load] renames on an import
|
one top-level namespace, so this is both the set [Load] renames on an import
|
||||||
and the set [Check] refuses to see twice — one definition, so the two cannot
|
and the set [Check] refuses to see twice — one definition, so the two cannot
|
||||||
drift apart. *)
|
drift apart. *)
|
||||||
|
(* How a dispatch value reads back, in a message and in the name below. The
|
||||||
|
keyword keeps its colon and the string its quotes, so that a method written
|
||||||
|
for :circle and one written for "circle" — two different values — do not
|
||||||
|
read as the same thing in a duplicate-method refusal. *)
|
||||||
|
let dispatch_text = function
|
||||||
|
| Dclass n -> n
|
||||||
|
| Dkw k -> ":" ^ k
|
||||||
|
| Dstr s -> "\"" ^ s ^ "\""
|
||||||
|
| Dint i -> Int64.to_string i
|
||||||
|
| Dbool b -> if b then "true" else "false"
|
||||||
|
| Delse -> ":else"
|
||||||
|
|
||||||
|
(* The top-level name a [defmethod] declares. No function is ever emitted
|
||||||
|
under it — a method's body is inlined into its generic's dispatch, so the
|
||||||
|
only function the pass writes is the generic itself — but a declaration
|
||||||
|
still needs a name of its own, for the reason every declaration does: a
|
||||||
|
session replaces a declaration it has already seen by name, and appends one
|
||||||
|
it has not. Redefining a method has to replace, and adding one has to
|
||||||
|
append, and the pair (generic, dispatch value) is what tells those two
|
||||||
|
apart. The [@] is what keeps the name out of a program's reach: no symbol a
|
||||||
|
reader accepts contains one. *)
|
||||||
|
let method_name (m : methd) = m.mgen ^ "@" ^ dispatch_text m.mkey
|
||||||
|
|
||||||
let declared_name (d : decl) =
|
let declared_name (d : decl) =
|
||||||
match d.d with
|
match d.d with
|
||||||
| Defenum (n, _) | Defalias (n, _) | Defstruct (n, _) | Defdata (n, _)
|
| Defenum (n, _) | Defalias (n, _) | Defstruct (n, _) | Defdata (n, _)
|
||||||
| Defunion (n, _) | Defvar (n, _, _) | Defconst (n, _, _) -> Some n
|
| Defunion (n, _) | Defvar (n, _, _) | Defconst (n, _, _)
|
||||||
| Declare (fn, _) | DeclareC (fn, _) | Defn fn -> Some fn.name
|
| Defclass (n, _) -> Some n
|
||||||
|
| Declare (fn, _) | DeclareC (fn, _) | Defn fn
|
||||||
|
| Defgeneric fn | Defmulti fn -> Some fn.name
|
||||||
|
| Defmethod m -> Some (method_name m)
|
||||||
| Package _ | Import _ -> None
|
| Package _ | Import _ -> None
|
||||||
|
|
||||||
(* ── Instrumenting a form with (pause) ─────────────────────────────── *)
|
(* ── Instrumenting a form with (pause) ─────────────────────────────── *)
|
||||||
@ -279,7 +357,7 @@ let map_children f (e : expr) : expr =
|
|||||||
| Call (fn, args) -> Call (ex fn, List.map ex args)
|
| Call (fn, args) -> Call (ex fn, List.map ex args)
|
||||||
| Match (s, arms) -> Match (ex s, List.map arm arms)
|
| Match (s, arms) -> Match (ex s, List.map arm arms)
|
||||||
| Struct (n, fs) -> Struct (n, List.map (fun (n, v) -> (n, ex v)) fs)
|
| Struct (n, fs) -> Struct (n, List.map (fun (n, v) -> (n, ex v)) fs)
|
||||||
| MapLit kvs -> MapLit (List.map (fun (k, v) -> (ex k, ex v)) kvs)
|
| MapLit (tag, kvs) -> MapLit (tag, List.map (fun (k, v) -> (ex k, ex v)) kvs)
|
||||||
| Arr es -> Arr (List.map ex es)
|
| Arr es -> Arr (List.map ex es)
|
||||||
| Fn (ps, es) -> Fn (ps, List.map ex es)
|
| Fn (ps, es) -> Fn (ps, List.map ex es)
|
||||||
| Dotimes (l, n, c, es) -> Dotimes (l, n, ex c, List.map ex es)
|
| Dotimes (l, n, c, es) -> Dotimes (l, n, ex c, List.map ex es)
|
||||||
@ -331,6 +409,14 @@ let mark_pause ~line ~col (ds : decl list) : decl list option =
|
|||||||
hit := true;
|
hit := true;
|
||||||
{ d with d = Defn { f with fbody = pause_call d.dloc :: f.fbody } }
|
{ d with d = Defn { f with fbody = pause_call d.dloc :: f.fbody } }
|
||||||
| Defn f -> { d with d = Defn { f with fbody = body f.fbody } }
|
| Defn f -> { d with d = Defn { f with fbody = body f.fbody } }
|
||||||
|
(* A method's body and a defmulti's dispatch body are code someone wrote
|
||||||
|
and can stop inside, so both are walked. Marking the whole declaration
|
||||||
|
— the [at d.dloc] case above — is deliberately not offered for either:
|
||||||
|
a method is not a function of its own by the time it runs, so there is
|
||||||
|
no entry to stop at, only the forms inside it. *)
|
||||||
|
| Defmethod m ->
|
||||||
|
{ d with d = Defmethod { m with mfn = { m.mfn with fbody = body m.mfn.fbody } } }
|
||||||
|
| Defmulti f -> { d with d = Defmulti { f with fbody = body f.fbody } }
|
||||||
| Defvar (n, t, Init e) -> { d with d = Defvar (n, t, Init (walk e)) }
|
| Defvar (n, t, Init e) -> { d with d = Defvar (n, t, Init (walk e)) }
|
||||||
(* The value reading of an undecided [defvar] is walked too: if it is the
|
(* The value reading of an undecided [defvar] is walked too: if it is the
|
||||||
one that wins it is an initialiser like any other, and if the type
|
one that wins it is an initialiser like any other, and if the type
|
||||||
|
|||||||
66
lib/check.ml
66
lib/check.ml
@ -2417,7 +2417,7 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
|
|||||||
like any other dyn value would. The literal lowers to a fresh slot — a
|
like any other dyn value would. The literal lowers to a fresh slot — a
|
||||||
rooted one, because a slot of type dyn is what [dyn_roots] counts — so
|
rooted one, because a slot of type dyn is what [dyn_roots] counts — so
|
||||||
the map stays reachable across the allocations its own entries make. *)
|
the map stays reachable across the allocations its own entries make. *)
|
||||||
| Ast.MapLit kvs ->
|
| Ast.MapLit (tag, kvs) ->
|
||||||
let m = fresh_slot ctx Types.Dyn in
|
let m = fresh_slot ctx Types.Dyn in
|
||||||
let mval = mk loc Types.Dyn (Tast.Local m) in
|
let mval = mk loc Types.Dyn (Tast.Local m) in
|
||||||
let sets =
|
let sets =
|
||||||
@ -2428,10 +2428,19 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
|
|||||||
check ctx ~want:Types.Dyn v ])
|
check ctx ~want:Types.Dyn v ])
|
||||||
kvs
|
kvs
|
||||||
in
|
in
|
||||||
|
(* A shape tag, if this is the literal a class's constructor was written
|
||||||
|
from. It is the class's name interned as a keyword, and it goes into
|
||||||
|
the object's header rather than into the entries — so everything below
|
||||||
|
this line, the rooting included, is the untagged case unchanged. *)
|
||||||
|
let empty =
|
||||||
|
match tag with
|
||||||
|
| None -> rt loc Types.Dyn "flan_dyn_map_new" []
|
||||||
|
| Some cls ->
|
||||||
|
rt loc Types.Dyn "flan_dyn_map_new_class"
|
||||||
|
[ rt loc Types.Dyn "flan_dyn_kw" [ mk loc Types.String (Tast.Str cls) ] ]
|
||||||
|
in
|
||||||
expect ctx loc ~want
|
expect ctx loc ~want
|
||||||
(mk loc Types.Dyn
|
(mk loc Types.Dyn (Tast.Let ([ (m, empty) ], sets @ [ mval ])))
|
||||||
(Tast.Let ([ (m, rt loc Types.Dyn "flan_dyn_map_new" []) ],
|
|
||||||
sets @ [ mval ])))
|
|
||||||
| Ast.Quote _ ->
|
| Ast.Quote _ ->
|
||||||
unimplemented loc "a quoted symbol (restart names)" 6
|
unimplemented loc "a quoted symbol (restart names)" 6
|
||||||
| Ast.Var name -> var ctx loc ~want name
|
| Ast.Var name -> var ctx loc ~want name
|
||||||
@ -5439,6 +5448,25 @@ and named_call ctx ~want loc name args =
|
|||||||
(Types.to_string other))
|
(Types.to_string other))
|
||||||
| _ -> assert false)
|
| _ -> assert false)
|
||||||
|
|
||||||
|
(* (class-of v) -> the class's name as a keyword, or nil. It is the dyn
|
||||||
|
side's one question about shape, and the dispatch a (defgeneric ...)
|
||||||
|
compiles to is this call and a comparison — so what a class dispatcher
|
||||||
|
is, exactly, is the shape tag of the first argument as the dispatch
|
||||||
|
function, which is what makes the CLOS half and the Clojure half one
|
||||||
|
mechanism rather than two.
|
||||||
|
|
||||||
|
Anything that is not an instance answers nil rather than trapping: an
|
||||||
|
ordinary map, a number, nil itself. Asking is not a claim, and the
|
||||||
|
question is askable of every value — the same line [get] takes about an
|
||||||
|
absent key. *)
|
||||||
|
| "class-of" ->
|
||||||
|
arity loc name 1 args;
|
||||||
|
(match args with
|
||||||
|
| [ v ] ->
|
||||||
|
expect ctx loc ~want
|
||||||
|
(rt loc Types.Dyn "flan_dyn_class_of" [ check ctx ~want:Types.Dyn v ])
|
||||||
|
| _ -> assert false)
|
||||||
|
|
||||||
(* (map-remove m k) -> (Option V): the value that was there, or None when
|
(* (map-remove m k) -> (Option V): the value that was there, or None when
|
||||||
the key was not. The same answer [get] gives, for the same reason — a key
|
the key was not. The same answer [get] gives, for the same reason — a key
|
||||||
that is not in the map is an answer and not a failure — and the value
|
that is not in the map is an answer and not a failure — and the value
|
||||||
@ -6779,6 +6807,12 @@ let builtins : (string * string * string) list =
|
|||||||
wants, where get would hand back an Option to match on. Over a dyn map \
|
wants, where get would hand back an Option to match on. Over a dyn map \
|
||||||
it is the question that stays askable when nil might also be stored \
|
it is the question that stays askable when nil might also be stored \
|
||||||
under the key.");
|
under the key.");
|
||||||
|
("class-of", "class-of [dyn] dyn",
|
||||||
|
"The class's name as a keyword for a value built by a defclass \
|
||||||
|
constructor, and nil for everything else — an ordinary map included. \
|
||||||
|
It is what a defgeneric dispatches on, so a class dispatcher is this \
|
||||||
|
call over the first argument and a defmulti whose body is (class-of x) \
|
||||||
|
is the same generic function written the other way.");
|
||||||
("keyword", "keyword [string|[u8]] dyn",
|
("keyword", "keyword [string|[u8]] dyn",
|
||||||
"The interned dyn keyword named by the bytes, for a name that only \
|
"The interned dyn keyword named by the bytes, for a name that only \
|
||||||
exists at run time — a reader building :texture-path out of a token's \
|
exists at run time — a reader building :texture-path out of a token's \
|
||||||
@ -7229,7 +7263,21 @@ let collect env (decls : Ast.decl list) =
|
|||||||
Hashtbl.replace env.globals n (ty, false)
|
Hashtbl.replace env.globals n (ty, false)
|
||||||
| Ast.Defconst (n, Some t, _) ->
|
| Ast.Defconst (n, Some t, _) ->
|
||||||
Hashtbl.replace env.globals n (resolve env t, true)
|
Hashtbl.replace env.globals n (resolve env t, true)
|
||||||
| Ast.Defconst (n, None, v) -> untyped := (n, v) :: !untyped)
|
| Ast.Defconst (n, None, v) -> untyped := (n, v) :: !untyped
|
||||||
|
(* [Classes.expand] ran at the top of [build_program] and left none of
|
||||||
|
these behind, the way [Shim.expand] leaves no [declare-c] behind. A
|
||||||
|
driver that assembled a declaration list and skipped that pass would
|
||||||
|
otherwise get a missing name from wherever the constructor was
|
||||||
|
called, with nothing pointing here. *)
|
||||||
|
| Ast.Defclass (n, _) | Ast.Defgeneric { Ast.name = n; _ }
|
||||||
|
| Ast.Defmulti { Ast.name = n; _ } ->
|
||||||
|
fail loc
|
||||||
|
"internal: %s reached the checker unexpanded — Classes.expand did \
|
||||||
|
not run over this declaration list" n
|
||||||
|
| Ast.Defmethod m ->
|
||||||
|
fail loc
|
||||||
|
"internal: a method of %s reached the checker unexpanded — \
|
||||||
|
Classes.expand did not run over this declaration list" m.Ast.mgen)
|
||||||
decls;
|
decls;
|
||||||
(* Also to a fixpoint, and for the same reason: one untyped constant may be
|
(* Also to a fixpoint, and for the same reason: one untyped constant may be
|
||||||
defined in terms of another declared after it. A constant that still does
|
defined in terms of another declared after it. A constant that still does
|
||||||
@ -8421,6 +8469,11 @@ let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env =
|
|||||||
flattening comes back to be compiled into the build. Nothing below this
|
flattening comes back to be compiled into the build. Nothing below this
|
||||||
line knows the form exists. *)
|
line knows the form exists. *)
|
||||||
let decls, cshim = Shim.expand decls in
|
let decls, cshim = Shim.expand decls in
|
||||||
|
(* And on the same line: every class and generic function becomes the
|
||||||
|
[defn]s it stands for. It runs over the whole list because a method may
|
||||||
|
be written anywhere in it, which is also what makes a reload rebuild
|
||||||
|
every dispatch from the session's declarations — see lib/classes.ml. *)
|
||||||
|
let decls = Classes.expand decls in
|
||||||
(* Pass one, and it stops at the first thing it refuses. That is not
|
(* 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
|
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
|
declaration this pass could not make sense of leaves a hole that pass two
|
||||||
@ -8791,6 +8844,9 @@ let memory_class (sym : string) (args : Tast.expr list) =
|
|||||||
gc "allocates: a dyn vector is an object on the collector's heap"
|
gc "allocates: a dyn vector is an object on the collector's heap"
|
||||||
| "flan_dyn_map_new" ->
|
| "flan_dyn_map_new" ->
|
||||||
gc "allocates: a dyn map is an object on the collector's heap"
|
gc "allocates: a dyn map is an object on the collector's heap"
|
||||||
|
| "flan_dyn_map_new_class" ->
|
||||||
|
gc "allocates: a class instance is a dyn map on the collector's heap, \
|
||||||
|
with the class's name in its header"
|
||||||
| "flan_dyn_view_vec" | "flan_dyn_view_flat" ->
|
| "flan_dyn_view_vec" | "flan_dyn_view_flat" ->
|
||||||
gc "allocates: a typed container crossing into dyn takes a view record \
|
gc "allocates: a typed container crossing into dyn takes a view record \
|
||||||
on the collector's heap — the elements are not copied, the record is"
|
on the collector's heap — the elements are not copied, the record is"
|
||||||
|
|||||||
311
lib/classes.ml
Normal file
311
lib/classes.ml
Normal file
@ -0,0 +1,311 @@
|
|||||||
|
(** The dyn side's classes and generic functions, turned into ordinary
|
||||||
|
declarations.
|
||||||
|
|
||||||
|
[(defclass point [x y])] is a constructor. [(defgeneric area [self] dyn)]
|
||||||
|
and [(defmulti describe [x] dyn (get x :kind))] are each one function whose
|
||||||
|
body is a dispatch, and [(defmethod area point [p] ...)] is a branch of
|
||||||
|
one. Nothing below this pass knows any of the four forms exists: what it
|
||||||
|
writes is [defn]s, and they are checked, emitted, rooted, redefined and
|
||||||
|
inspected as any other function is.
|
||||||
|
|
||||||
|
**Why a pass and not a macro.** A macro sees one form. This needs the
|
||||||
|
whole declaration list, because a method may be written anywhere — above
|
||||||
|
its generic, below it, or at a reload an hour later — and the generic's
|
||||||
|
body is not decidable until every method is in hand. The pass runs at the
|
||||||
|
top of [Check.build_program], over the flat list an import has already
|
||||||
|
been folded into, so a reload rebuilds every dispatch from the session's
|
||||||
|
whole set of declarations and a method added to a running program is the
|
||||||
|
ordinary redefinition of the one function that dispatches. [Shim.expand]
|
||||||
|
is the precedent, form for form.
|
||||||
|
|
||||||
|
**Why the method bodies are inlined rather than lifted into functions of
|
||||||
|
their own.** A generic is then exactly one top-level name, which is what
|
||||||
|
makes adding a method at a reload work: the session installs the bodies
|
||||||
|
the evaluated form declared, one name each, and a new method has to reach
|
||||||
|
a call site that was compiled before it existed. One function means one
|
||||||
|
cell to replace. The cost is that a method is not separately callable and
|
||||||
|
does not appear as a frame of its own, which is recorded in FIX.org.
|
||||||
|
|
||||||
|
**What it does not do.** There is no inheritance, no multi-argument
|
||||||
|
dispatch, and no :before/:after/:around — see FIX.org, 2026-09-20, for
|
||||||
|
which of those were deferred and why. A method's dispatch value is a
|
||||||
|
literal, so the specificity question CLOS answers with a class precedence
|
||||||
|
list does not arise here: two methods either answer for the same value,
|
||||||
|
which is refused, or for different ones. *)
|
||||||
|
|
||||||
|
let dyn_at loc : Ast.texpr = { Ast.t = Ast.Tname "dyn"; tloc = loc }
|
||||||
|
|
||||||
|
let ex loc (e : Ast.expr_kind) : Ast.expr = { Ast.e; loc }
|
||||||
|
|
||||||
|
(* The name the dispatch value is bound to inside a generic's body. [~] is a
|
||||||
|
delimiter in the reader, so no symbol anyone can write is this one and no
|
||||||
|
method body can shadow it or be shadowed by it. *)
|
||||||
|
let dispatch_slot = "~dispatch"
|
||||||
|
|
||||||
|
(* The condition a generic signals when no method answers. Its struct is in
|
||||||
|
the prelude; this is the only place that builds one. *)
|
||||||
|
let no_method = "NoMethod"
|
||||||
|
|
||||||
|
(* ── Collecting ────────────────────────────────────────────────────── *)
|
||||||
|
|
||||||
|
type generic = {
|
||||||
|
gkind : [ `Class | `Multi ];
|
||||||
|
gfn : Ast.fn;
|
||||||
|
gloc : Loc.t;
|
||||||
|
(* In source order, which is dispatch order: the first method whose value
|
||||||
|
matches answers, and since duplicates are refused the order is not
|
||||||
|
observable except for [:else], which is moved to the end regardless. *)
|
||||||
|
mutable gms : Ast.methd list;
|
||||||
|
}
|
||||||
|
|
||||||
|
let collect (decls : Ast.decl list) =
|
||||||
|
let classes : (string, Loc.t) Hashtbl.t = Hashtbl.create 8 in
|
||||||
|
let generics : (string, generic) Hashtbl.t = Hashtbl.create 8 in
|
||||||
|
List.iter
|
||||||
|
(fun (d : Ast.decl) ->
|
||||||
|
match d.Ast.d with
|
||||||
|
| Ast.Defclass (n, slots) ->
|
||||||
|
(* Two slots of one name would write one entry and read one value,
|
||||||
|
and the constructor would take two arguments for it. The duplicate
|
||||||
|
parameter that falls out of it is refused by the checker anyway;
|
||||||
|
this says which declaration it came from. *)
|
||||||
|
let seen = Hashtbl.create 8 in
|
||||||
|
List.iter
|
||||||
|
(fun (s, sloc) ->
|
||||||
|
if Hashtbl.mem seen s then
|
||||||
|
Loc.failk "check/duplicate-slot" sloc
|
||||||
|
"%s names the slot %s twice. A slot is a key in the \
|
||||||
|
instance's map, so the second would replace the first and \
|
||||||
|
the constructor would take an argument that goes nowhere"
|
||||||
|
n s;
|
||||||
|
Hashtbl.replace seen s ())
|
||||||
|
slots;
|
||||||
|
Hashtbl.replace classes n d.Ast.dloc
|
||||||
|
| Ast.Defgeneric fn ->
|
||||||
|
Hashtbl.replace generics fn.Ast.name
|
||||||
|
{ gkind = `Class; gfn = fn; gloc = d.Ast.dloc; gms = [] }
|
||||||
|
| Ast.Defmulti fn ->
|
||||||
|
Hashtbl.replace generics fn.Ast.name
|
||||||
|
{ gkind = `Multi; gfn = fn; gloc = d.Ast.dloc; gms = [] }
|
||||||
|
| _ -> ())
|
||||||
|
decls;
|
||||||
|
(* Methods second, so a method may be written above the generic it extends
|
||||||
|
— which it has to be able to be, since a reload appends. *)
|
||||||
|
List.iter
|
||||||
|
(fun (d : Ast.decl) ->
|
||||||
|
match d.Ast.d with
|
||||||
|
| Ast.Defmethod m ->
|
||||||
|
let g =
|
||||||
|
match Hashtbl.find_opt generics m.Ast.mgen with
|
||||||
|
| Some g -> g
|
||||||
|
| None ->
|
||||||
|
Loc.failk "check/unknown-generic" d.Ast.dloc
|
||||||
|
"no defgeneric or defmulti names %s, so there is nothing for \
|
||||||
|
this method to be a method of. A generic function is \
|
||||||
|
declared once, with its parameters and its return type, and \
|
||||||
|
the methods are written against it"
|
||||||
|
m.Ast.mgen
|
||||||
|
in
|
||||||
|
(match m.Ast.mkey with
|
||||||
|
| Ast.Dclass c when not (Hashtbl.mem classes c) ->
|
||||||
|
Loc.failk "check/unknown-class" m.Ast.mkloc
|
||||||
|
"no defclass names %s. A bare name in a method's dispatch slot \
|
||||||
|
is a class, and stands for the shape tag its instances carry; \
|
||||||
|
a dispatch value that is not a class is written as itself — a \
|
||||||
|
keyword, a string, an integer"
|
||||||
|
c
|
||||||
|
| _ -> ());
|
||||||
|
let n = List.length m.Ast.mfn.Ast.params
|
||||||
|
and want = List.length g.gfn.Ast.params in
|
||||||
|
if n <> want then
|
||||||
|
Loc.failk "check/method-arity" d.Ast.dloc
|
||||||
|
"%s takes %d argument%s and this method of it takes %d. Every \
|
||||||
|
method of a generic function has the generic's own parameter \
|
||||||
|
list: one call site reaches all of them, and it can only pass \
|
||||||
|
one number of arguments"
|
||||||
|
m.Ast.mgen want (if want = 1 then "" else "s") n;
|
||||||
|
List.iter
|
||||||
|
(fun (prev : Ast.methd) ->
|
||||||
|
if prev.Ast.mkey = m.Ast.mkey then
|
||||||
|
Loc.failk "check/duplicate-method" d.Ast.dloc
|
||||||
|
"%s already has a method for %s. Two methods for one \
|
||||||
|
dispatch value is an ambiguity nothing resolves — there \
|
||||||
|
is no specificity rule here, because a dispatch value is \
|
||||||
|
a value and not a type"
|
||||||
|
m.Ast.mgen (Ast.dispatch_text m.Ast.mkey))
|
||||||
|
g.gms;
|
||||||
|
g.gms <- g.gms @ [ m ]
|
||||||
|
| _ -> ())
|
||||||
|
decls;
|
||||||
|
(classes, generics)
|
||||||
|
|
||||||
|
(* ── Writing the declarations ──────────────────────────────────────── *)
|
||||||
|
|
||||||
|
(* [(defclass point [x y])] becomes
|
||||||
|
|
||||||
|
(defn point [x dyn y dyn] dyn #point{:x x :y y})
|
||||||
|
|
||||||
|
— the constructor, positional, one argument per slot in the order the
|
||||||
|
slots were written. The slots are keys in an ordinary dyn map, so [get],
|
||||||
|
[put] and [has-key?] are how one is read and written and no new operation
|
||||||
|
is needed for any of it. What the class adds is the tag on the map, which
|
||||||
|
is what [class-of] answers and what a generic dispatches on.
|
||||||
|
|
||||||
|
Named-slot construction — the dyn twin of [(Cursor {.src s})], with an
|
||||||
|
omitted slot meaning nil — is deferred, and so is refusing an unknown slot
|
||||||
|
at [(get p :z)]. Both are recorded in FIX.org. *)
|
||||||
|
let constructor n slots loc : Ast.decl =
|
||||||
|
let params =
|
||||||
|
List.map
|
||||||
|
(fun (s, sloc) -> { Ast.fname = s; fty = dyn_at sloc; floc = sloc })
|
||||||
|
slots
|
||||||
|
in
|
||||||
|
let pairs =
|
||||||
|
List.map (fun (s, sloc) -> (ex sloc (Ast.Kw s), ex sloc (Ast.Var s))) slots
|
||||||
|
in
|
||||||
|
{ Ast.d =
|
||||||
|
Ast.Defn
|
||||||
|
{ Ast.name = n; params; praw = None; ret = Some (dyn_at loc);
|
||||||
|
fwhere = []; fbody = [ ex loc (Ast.MapLit (Some n, pairs)) ];
|
||||||
|
nloc = loc };
|
||||||
|
dloc = loc }
|
||||||
|
|
||||||
|
(* The dispatch value a method answers for, as an expression to compare
|
||||||
|
against. A class's name stands for the keyword its instances carry, which
|
||||||
|
is the whole of how the CLOS half and the Clojure half share one
|
||||||
|
mechanism: [(defgeneric area [self] dyn)] is [(defmulti area [self] dyn
|
||||||
|
(class-of self))], and a method written for the class [point] is a method
|
||||||
|
written for the value [:point]. *)
|
||||||
|
let key_expr loc (k : Ast.dispatch) : Ast.expr =
|
||||||
|
match k with
|
||||||
|
| Ast.Dclass c -> ex loc (Ast.Kw c)
|
||||||
|
| Ast.Dkw k -> ex loc (Ast.Kw k)
|
||||||
|
| Ast.Dstr s -> ex loc (Ast.Str s)
|
||||||
|
| Ast.Dint i -> ex loc (Ast.Int i)
|
||||||
|
| Ast.Dbool b -> ex loc (Ast.Var (if b then "true" else "false"))
|
||||||
|
| Ast.Delse -> assert false (* never compared: it is the else arm *)
|
||||||
|
|
||||||
|
(* A method's body, with the method's own parameter names bound to the
|
||||||
|
generic's. The names are the method's to choose — [(defmethod area point [p]
|
||||||
|
...)] under [(defgeneric area [self] dyn)] — and a name that already agrees
|
||||||
|
binds nothing, so the common case adds no [let] at all. *)
|
||||||
|
let method_body (g : generic) (m : Ast.methd) : Ast.expr =
|
||||||
|
let loc = m.Ast.mfn.Ast.nloc in
|
||||||
|
let bs =
|
||||||
|
List.filter_map
|
||||||
|
(fun ((mp : Ast.field), (gp : Ast.field)) ->
|
||||||
|
if String.equal mp.Ast.fname gp.Ast.fname then None
|
||||||
|
else
|
||||||
|
Some { Ast.bname = mp.Ast.fname; bty = None;
|
||||||
|
bval = ex mp.Ast.floc (Ast.Var gp.Ast.fname);
|
||||||
|
bloc = mp.Ast.floc })
|
||||||
|
(List.combine m.Ast.mfn.Ast.params g.gfn.Ast.params)
|
||||||
|
in
|
||||||
|
if bs = [] then ex loc (Ast.Do m.Ast.mfn.Ast.fbody)
|
||||||
|
else ex loc (Ast.Let (bs, m.Ast.mfn.Ast.fbody))
|
||||||
|
|
||||||
|
(* What a generic answers when no method does. Common Lisp signals here and
|
||||||
|
so does this: it is a condition with a handler-case around it, not a trap,
|
||||||
|
because a dispatch that missed is a thing a program can be written to
|
||||||
|
answer — a default, a log line, a fallback object — and a trap would take
|
||||||
|
that away. [error] rather than [signal] because there is no value to carry
|
||||||
|
on with if nothing handles it.
|
||||||
|
|
||||||
|
No restart is established at the miss. That is BoundsError's and
|
||||||
|
ArithError's decision, taken here for their reason: a restart frame is
|
||||||
|
allocated by the form that offers it, and the ones that matter — a frame
|
||||||
|
loop's [continue] — are already on the stack and reachable from a handler
|
||||||
|
without this form pushing anything. *)
|
||||||
|
let miss loc gname : Ast.expr =
|
||||||
|
ex loc
|
||||||
|
(Ast.Signal
|
||||||
|
(Ast.Serror,
|
||||||
|
ex loc
|
||||||
|
(Ast.Struct
|
||||||
|
(no_method,
|
||||||
|
[ ("generic", ex loc (Ast.Str gname));
|
||||||
|
("value", ex loc (Ast.Var dispatch_slot)) ]))))
|
||||||
|
|
||||||
|
let dispatcher (g : generic) : Ast.decl =
|
||||||
|
let loc = g.gloc in
|
||||||
|
let gname = g.gfn.Ast.name in
|
||||||
|
(* The value the methods are keyed by. A defgeneric computes it — the shape
|
||||||
|
tag of the first argument — and a defmulti's own body is it. *)
|
||||||
|
let value =
|
||||||
|
match g.gkind with
|
||||||
|
| `Multi -> ex loc (Ast.Do g.gfn.Ast.fbody)
|
||||||
|
| `Class ->
|
||||||
|
(match g.gfn.Ast.params with
|
||||||
|
| p :: _ ->
|
||||||
|
ex loc
|
||||||
|
(Ast.Call (ex loc (Ast.Var "class-of"),
|
||||||
|
[ ex p.Ast.floc (Ast.Var p.Ast.fname) ]))
|
||||||
|
| [] ->
|
||||||
|
Loc.failk "check/method-arity" loc
|
||||||
|
"%s takes no arguments, and a defgeneric dispatches on the class \
|
||||||
|
of its first one. Write a defmulti, whose body says what to \
|
||||||
|
dispatch on"
|
||||||
|
gname)
|
||||||
|
in
|
||||||
|
(* [:else] last whatever order it was written in, because it is the arm
|
||||||
|
everything else falls through to and not a value to compare against. *)
|
||||||
|
let fallback, cases =
|
||||||
|
List.partition (fun (m : Ast.methd) -> m.Ast.mkey = Ast.Delse) g.gms
|
||||||
|
in
|
||||||
|
let last =
|
||||||
|
match fallback with
|
||||||
|
| m :: _ -> method_body g m
|
||||||
|
| [] -> miss loc gname
|
||||||
|
in
|
||||||
|
let chain =
|
||||||
|
List.fold_right
|
||||||
|
(fun (m : Ast.methd) rest ->
|
||||||
|
let kloc = m.Ast.mkloc in
|
||||||
|
ex kloc
|
||||||
|
(Ast.If
|
||||||
|
(ex kloc
|
||||||
|
(Ast.Call (ex kloc (Ast.Var "="),
|
||||||
|
[ ex kloc (Ast.Var dispatch_slot);
|
||||||
|
key_expr kloc m.Ast.mkey ])),
|
||||||
|
method_body g m, Some rest)))
|
||||||
|
cases last
|
||||||
|
in
|
||||||
|
{ Ast.d =
|
||||||
|
Ast.Defn
|
||||||
|
{ g.gfn with
|
||||||
|
Ast.fbody =
|
||||||
|
[ ex loc
|
||||||
|
(Ast.Let ([ { Ast.bname = dispatch_slot; bty = None;
|
||||||
|
bval = value; bloc = loc } ],
|
||||||
|
[ chain ])) ] };
|
||||||
|
dloc = loc }
|
||||||
|
|
||||||
|
(** Every [defclass], [defgeneric], [defmulti] and [defmethod] in the list,
|
||||||
|
replaced by the [defn]s they stand for. Everything else is untouched and
|
||||||
|
keeps its position: a constructor is written where its class was and a
|
||||||
|
dispatch where its generic was, so declaration order — which is emission
|
||||||
|
order for globals — does not move. *)
|
||||||
|
let expand (decls : Ast.decl list) : Ast.decl list =
|
||||||
|
let has =
|
||||||
|
List.exists
|
||||||
|
(fun (d : Ast.decl) ->
|
||||||
|
match d.Ast.d with
|
||||||
|
| Ast.Defclass _ | Ast.Defgeneric _ | Ast.Defmulti _
|
||||||
|
| Ast.Defmethod _ -> true
|
||||||
|
| _ -> false)
|
||||||
|
decls
|
||||||
|
in
|
||||||
|
if not has then decls
|
||||||
|
else begin
|
||||||
|
let _classes, generics = collect decls in
|
||||||
|
List.filter_map
|
||||||
|
(fun (d : Ast.decl) ->
|
||||||
|
match d.Ast.d with
|
||||||
|
| Ast.Defclass (n, slots) -> Some (constructor n slots d.Ast.dloc)
|
||||||
|
| Ast.Defgeneric fn | Ast.Defmulti fn ->
|
||||||
|
Some (dispatcher (Hashtbl.find generics fn.Ast.name))
|
||||||
|
(* Gone: its body is inside its generic's dispatch. *)
|
||||||
|
| Ast.Defmethod _ -> None
|
||||||
|
| _ -> Some d)
|
||||||
|
decls
|
||||||
|
end
|
||||||
@ -3619,6 +3619,8 @@ declare i64 @flan_dyn_from_bool(i32)
|
|||||||
declare i64 @flan_dyn_from_bytes(ptr, i64)
|
declare i64 @flan_dyn_from_bytes(ptr, i64)
|
||||||
declare i64 @flan_dyn_vec_new()
|
declare i64 @flan_dyn_vec_new()
|
||||||
declare i64 @flan_dyn_map_new()
|
declare i64 @flan_dyn_map_new()
|
||||||
|
declare i64 @flan_dyn_map_new_class(i64)
|
||||||
|
declare i64 @flan_dyn_class_of(i64)
|
||||||
declare i64 @flan_dyn_kw(ptr, i64)
|
declare i64 @flan_dyn_kw(ptr, i64)
|
||||||
declare i64 @flan_dyn_map_get(i64, i64)
|
declare i64 @flan_dyn_map_get(i64, i64)
|
||||||
declare void @flan_dyn_map_set(i64, i64, i64)
|
declare void @flan_dyn_map_set(i64, i64, i64)
|
||||||
|
|||||||
69
lib/load.ml
69
lib/load.ml
@ -267,8 +267,11 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr =
|
|||||||
Ast.Struct (name n, List.map (fun (k, v) -> (k, go v)) kvs)
|
Ast.Struct (name n, List.map (fun (k, v) -> (k, go v)) kvs)
|
||||||
(* A dyn map literal has no name of its own to qualify; its keys and
|
(* A dyn map literal has no name of its own to qualify; its keys and
|
||||||
values are ordinary expressions and are walked like anything else. *)
|
values are ordinary expressions and are walked like anything else. *)
|
||||||
| Ast.MapLit kvs ->
|
| Ast.MapLit (tag, kvs) ->
|
||||||
Ast.MapLit (List.map (fun (k, v) -> (go k, go v)) kvs)
|
(* The tag is a class's name and is already qualified: the only thing
|
||||||
|
that writes one is [Classes.expand], which runs over the flat list
|
||||||
|
after every import has been folded into it. *)
|
||||||
|
Ast.MapLit (tag, List.map (fun (k, v) -> (go k, go v)) kvs)
|
||||||
| Ast.Arr items -> Ast.Arr (gos items)
|
| Ast.Arr items -> Ast.Arr (gos items)
|
||||||
| Ast.ArrayOf t -> Ast.ArrayOf (rename_texpr owned alias t)
|
| Ast.ArrayOf t -> Ast.ArrayOf (rename_texpr owned alias t)
|
||||||
| Ast.Fn (ps, body) ->
|
| Ast.Fn (ps, body) ->
|
||||||
@ -358,6 +361,18 @@ let rename_pitem owned alias (p : Ast.pitem) : Ast.pitem =
|
|||||||
| Ast.Pname _ -> p
|
| Ast.Pname _ -> p
|
||||||
| Ast.Ptype t -> Ast.Ptype (rename_texpr owned alias t)
|
| Ast.Ptype t -> Ast.Ptype (rename_texpr owned alias t)
|
||||||
|
|
||||||
|
(* A generic function's or a method's signature and body. Its parameters are
|
||||||
|
all [dyn] and were written out by the parser, so unlike a [defn]'s there is
|
||||||
|
no undecided vector to qualify and the names the body may shadow are simply
|
||||||
|
the parameter names. The declared name is qualified by the caller, which
|
||||||
|
for a method is not [fn.name] at all. *)
|
||||||
|
let qualify_dyn_fn owned alias (fn : Ast.fn) : Ast.fn =
|
||||||
|
let bound = List.map (fun (p : Ast.field) -> p.Ast.fname) fn.Ast.params in
|
||||||
|
{ fn with
|
||||||
|
Ast.name = qualify alias fn.Ast.name;
|
||||||
|
ret = Option.map (rename_texpr owned alias) fn.Ast.ret;
|
||||||
|
fbody = List.map (rename_expr owned alias bound) fn.Ast.fbody }
|
||||||
|
|
||||||
let qualify_decl owned alias (d : Ast.decl) : Ast.decl =
|
let qualify_decl owned alias (d : Ast.decl) : Ast.decl =
|
||||||
let loc = d.Ast.dloc in
|
let loc = d.Ast.dloc in
|
||||||
let k =
|
let k =
|
||||||
@ -432,6 +447,41 @@ let qualify_decl owned alias (d : Ast.decl) : Ast.decl =
|
|||||||
params; praw;
|
params; praw;
|
||||||
ret = Option.map (rename_texpr owned alias) fn.Ast.ret;
|
ret = Option.map (rename_texpr owned alias) fn.Ast.ret;
|
||||||
fbody = List.map (rename_expr owned alias bound) fn.Ast.fbody }
|
fbody = List.map (rename_expr owned alias bound) fn.Ast.fbody }
|
||||||
|
(* ── The class forms ──────────────────────────────────────────────
|
||||||
|
[Classes.expand] has not run — it runs over the whole flat list, after
|
||||||
|
every import has been folded into it — so these arrive here as written
|
||||||
|
and the rename is the ordinary one: the declared name, plus whatever
|
||||||
|
inside them is a name of this package.
|
||||||
|
|
||||||
|
A class's slots are not renamed. They are keywords in the map the
|
||||||
|
constructor builds, and a keyword belongs to nobody — the same line the
|
||||||
|
[MapLit] arm above takes about a map literal's keys. The *class's* name
|
||||||
|
is qualified, so [pkg/point] is what an instance's shape tag reads and
|
||||||
|
two packages' [point] classes are two classes. *)
|
||||||
|
| Ast.Defclass (n, slots) -> Ast.Defclass (qualify alias n, slots)
|
||||||
|
(* A generic's parameters are dyn and were written out by the parser, so
|
||||||
|
there is no unpaired vector here and [bound] is exactly the parameter
|
||||||
|
names. *)
|
||||||
|
| Ast.Defgeneric fn -> Ast.Defgeneric (qualify_dyn_fn owned alias fn)
|
||||||
|
| Ast.Defmulti fn -> Ast.Defmulti (qualify_dyn_fn owned alias fn)
|
||||||
|
(* Both halves of the head are names this package owns or does not: the
|
||||||
|
generic being extended, and — when the dispatch value is a class — the
|
||||||
|
class being dispatched on. A method written in one package for another
|
||||||
|
package's generic therefore keeps working, because [owned] answers no
|
||||||
|
for that name and the alias-qualified spelling the source wrote is left
|
||||||
|
alone by [rename_expr]'s rule. *)
|
||||||
|
| Ast.Defmethod m ->
|
||||||
|
let mkey =
|
||||||
|
match m.Ast.mkey with
|
||||||
|
| Ast.Dclass c when List.mem c owned -> Ast.Dclass (qualify alias c)
|
||||||
|
| k -> k
|
||||||
|
in
|
||||||
|
let mgen = if List.mem m.Ast.mgen owned then qualify alias m.Ast.mgen
|
||||||
|
else m.Ast.mgen in
|
||||||
|
let mfn = qualify_dyn_fn owned alias m.Ast.mfn in
|
||||||
|
Ast.Defmethod
|
||||||
|
{ m with Ast.mgen; mkey;
|
||||||
|
mfn = { mfn with Ast.name = mgen ^ "@" ^ Ast.dispatch_text mkey } }
|
||||||
| Ast.Package _ -> Ast.Package alias
|
| Ast.Package _ -> Ast.Package alias
|
||||||
(* A package's own imports were resolved before this ran and are not in
|
(* A package's own imports were resolved before this ran and are not in
|
||||||
the list it is given, so one arriving here is a bug in [import] rather
|
the list it is given, so one arriving here is a bug in [import] rather
|
||||||
@ -681,7 +731,7 @@ let rec expr_uses acc (e : Ast.expr) =
|
|||||||
| Ast.Struct (n, kvs) ->
|
| Ast.Struct (n, kvs) ->
|
||||||
acc := (n, e.Ast.loc) :: !acc;
|
acc := (n, e.Ast.loc) :: !acc;
|
||||||
List.iter (fun (_, v) -> go v) kvs
|
List.iter (fun (_, v) -> go v) kvs
|
||||||
| Ast.MapLit kvs -> List.iter (fun (k, v) -> go k; go v) kvs
|
| Ast.MapLit (_, kvs) -> List.iter (fun (k, v) -> go k; go v) kvs
|
||||||
| Ast.Arr items -> gos items
|
| Ast.Arr items -> gos items
|
||||||
| Ast.ArrayOf t -> texpr_uses acc t
|
| Ast.ArrayOf t -> texpr_uses acc t
|
||||||
| Ast.Fn (_, body) -> gos body
|
| Ast.Fn (_, body) -> gos body
|
||||||
@ -755,6 +805,19 @@ let decl_uses acc (d : Ast.decl) =
|
|||||||
| Ast.Zeroed | Ast.Uninit -> ())
|
| Ast.Zeroed | Ast.Uninit -> ())
|
||||||
| Ast.Defconst (_, t, v) ->
|
| Ast.Defconst (_, t, v) ->
|
||||||
Option.iter (texpr_uses acc) t; expr_uses acc v
|
Option.iter (texpr_uses acc) t; expr_uses acc v
|
||||||
|
(* A class's slots are keywords and name nothing. Its constructor's body is
|
||||||
|
written by [Classes.expand], long after this, out of the slots alone. *)
|
||||||
|
| Ast.Defclass _ -> ()
|
||||||
|
| Ast.Defgeneric f | Ast.Defmulti f -> fn f
|
||||||
|
(* The generic is a use — a method in one package extending another's has to
|
||||||
|
pull that package in — and so is the class in the dispatch slot, for the
|
||||||
|
same reason a type in a signature is. *)
|
||||||
|
| Ast.Defmethod m ->
|
||||||
|
acc := (m.Ast.mgen, d.Ast.dloc) :: !acc;
|
||||||
|
(match m.Ast.mkey with
|
||||||
|
| Ast.Dclass c -> acc := (c, m.Ast.mkloc) :: !acc
|
||||||
|
| _ -> ());
|
||||||
|
fn m.Ast.mfn
|
||||||
|
|
||||||
let uses (ds : Ast.decl list) =
|
let uses (ds : Ast.decl list) =
|
||||||
let acc = ref [] in
|
let acc = ref [] in
|
||||||
|
|||||||
121
lib/parse.ml
121
lib/parse.ml
@ -140,6 +140,52 @@ and pitems (items : Form.t list) : Ast.pitem list =
|
|||||||
| _ -> Ast.Ptype (texpr it))
|
| _ -> Ast.Ptype (texpr it))
|
||||||
items
|
items
|
||||||
|
|
||||||
|
(* A generic's or a method's parameter vector. Every slot is a bare name and
|
||||||
|
every parameter is [dyn], so the types are written out here rather than
|
||||||
|
left for [Check.pair_params] to decide: the pairing exists because a
|
||||||
|
[defn]'s vector is ambiguous until every type name is known, and this one
|
||||||
|
never is. A parameter named after a type is therefore fine here, where in a
|
||||||
|
[defn] it would be refused. *)
|
||||||
|
and dyn_params which (items : Form.t list) : Ast.field list =
|
||||||
|
List.map
|
||||||
|
(fun (it : Form.t) ->
|
||||||
|
match it.v with
|
||||||
|
| Sym s ->
|
||||||
|
{ Ast.fname = s;
|
||||||
|
fty = { Ast.t = Ast.Tname "dyn"; tloc = it.loc };
|
||||||
|
floc = it.loc }
|
||||||
|
| _ ->
|
||||||
|
fail it
|
||||||
|
"a %s's parameter is a bare name, and found %s. Every parameter of \
|
||||||
|
a generic function is dyn — there is no type to write, and a \
|
||||||
|
method that wanted one could not be reached by a dispatch that \
|
||||||
|
does not know types either"
|
||||||
|
which (Form.to_string it))
|
||||||
|
items
|
||||||
|
|
||||||
|
(* A [defmethod]'s dispatch value. Literals only: the value is compared
|
||||||
|
against what the dispatch answered at run time, and the method is declared
|
||||||
|
under a name built from it at compile time, so it has to be something both
|
||||||
|
passes can read off the source. A computed one — Clojure allows any value a
|
||||||
|
method is registered under, because registration there is a run-time call —
|
||||||
|
is not available and the message says so. *)
|
||||||
|
and dispatch (f : Form.t) : Ast.dispatch =
|
||||||
|
match f.v with
|
||||||
|
| Kw "else" -> Ast.Delse
|
||||||
|
| Sym "true" -> Ast.Dbool true
|
||||||
|
| Sym "false" -> Ast.Dbool false
|
||||||
|
| Sym s -> Ast.Dclass s
|
||||||
|
| Kw k -> Ast.Dkw k
|
||||||
|
| Str s -> Ast.Dstr s
|
||||||
|
| Int i -> Ast.Dint i
|
||||||
|
| _ ->
|
||||||
|
fail f
|
||||||
|
"a method's dispatch value is a class's name, a keyword, a string, an \
|
||||||
|
integer, true, false, or :else for the one that answers when no other \
|
||||||
|
does — and found %s. It is matched at compile time as well as at run \
|
||||||
|
time, so it is written out rather than computed"
|
||||||
|
(Form.to_string f)
|
||||||
|
|
||||||
(* ── The constraint map at the head of a defn body ──────────────────────
|
(* ── The constraint map at the head of a defn body ──────────────────────
|
||||||
[(defn sort [s [$t]] () {:where (ordered? $t)} body ...)]. Clojure's
|
[(defn sort [s [$t]] () {:where (ordered? $t)} body ...)]. Clojure's
|
||||||
[{:pre [...] :post [...]}] is the precedent and the reason it is a map
|
[{:pre [...] :post [...]}] is the precedent and the reason it is a map
|
||||||
@ -274,7 +320,7 @@ let rec expr (f : Form.t) : Ast.expr =
|
|||||||
| Map ({ v = Sym s; _ } :: _)
|
| Map ({ v = Sym s; _ } :: _)
|
||||||
when String.length s > 1 && s.[0] = '.' ->
|
when String.length s > 1 && s.[0] = '.' ->
|
||||||
fail f "a bare map is not an expression; write (Type {.field v})"
|
fail f "a bare map is not an expression; write (Type {.field v})"
|
||||||
| Map items -> mk (Ast.MapLit (map_pairs f items))
|
| Map items -> mk (Ast.MapLit (None, map_pairs f items))
|
||||||
| List [] -> fail f "() is not an expression"
|
| List [] -> fail f "() is not an expression"
|
||||||
| List (head :: args) -> form f mk head args
|
| List (head :: args) -> form f mk head args
|
||||||
|
|
||||||
@ -567,7 +613,7 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr =
|
|||||||
output rather than a dependency. Building a declaration as a value is what
|
output rather than a dependency. Building a declaration as a value is what
|
||||||
a macro is for. *)
|
a macro is for. *)
|
||||||
| Sym ("defmacro" | "defn" | "defvar" | "defconst" | "defstruct" | "defdata"
|
| Sym ("defmacro" | "defn" | "defvar" | "defconst" | "defstruct" | "defdata"
|
||||||
| "defunion"
|
| "defunion" | "defclass" | "defgeneric" | "defmulti" | "defmethod"
|
||||||
| "defenum" | "defalias" | "import" as name) ->
|
| "defenum" | "defalias" | "import" as name) ->
|
||||||
fail f
|
fail f
|
||||||
"%s is a top-level declaration, not an expression. A quasiquoted one is \
|
"%s is a top-level declaration, not an expression. A quasiquoted one is \
|
||||||
@ -1215,6 +1261,77 @@ let rec decl (f : Form.t) : Ast.decl =
|
|||||||
"defn is (defn name [param Type ...] ReturnType body ...). The return \
|
"defn is (defn name [param Type ...] ReturnType body ...). The return \
|
||||||
type is not optional; a function that returns nothing writes ()")
|
type is not optional; a function that returns nothing writes ()")
|
||||||
|
|
||||||
|
(* ── The dyn side's classes and generic functions ──────────────────
|
||||||
|
Four forms, all of them shorthand: nothing below [Classes.expand] knows
|
||||||
|
they exist, and what it writes in their place is ordinary [defn]s. The
|
||||||
|
parsing here is only the shape check — which slots are present, and what
|
||||||
|
kind of thing is in each — because everything that needs the other
|
||||||
|
declarations to answer (is that a class? is there a generic by that
|
||||||
|
name? has this dispatch value a method already?) is the expansion's.
|
||||||
|
|
||||||
|
Every parameter of a generic and of a method is [dyn], written or not,
|
||||||
|
so a parameter vector here takes bare names and nothing else. That is
|
||||||
|
what keeps these off [defn]'s undecided-pairing path: a [defn]'s vector
|
||||||
|
cannot be read until every type name is known, and one that may hold
|
||||||
|
only names can be read here. *)
|
||||||
|
| List ({ v = Sym "defclass"; _ } :: args) ->
|
||||||
|
(match args with
|
||||||
|
| [ n; { v = Vec slots; _ } ] ->
|
||||||
|
mk (Ast.Defclass
|
||||||
|
(sym n,
|
||||||
|
List.map
|
||||||
|
(fun (s : Form.t) ->
|
||||||
|
match s.v with
|
||||||
|
| Sym name -> (name, s.loc)
|
||||||
|
| _ ->
|
||||||
|
fail s
|
||||||
|
"a class slot is a name. Its value is dyn and there is \
|
||||||
|
no type to write: an instance is a dyn map with a \
|
||||||
|
shape tag on it, and (get p :%s) is how a slot is read"
|
||||||
|
(Form.to_string s))
|
||||||
|
slots))
|
||||||
|
| _ -> fail f "defclass is (defclass Name [slot ...])")
|
||||||
|
|
||||||
|
| List ({ v = Sym ("defgeneric" | "defmulti" as which); _ } :: args) ->
|
||||||
|
let generic = String.equal which "defgeneric" in
|
||||||
|
let usage =
|
||||||
|
if generic then
|
||||||
|
"defgeneric is (defgeneric name [param ...] ReturnType). It has no \
|
||||||
|
body: its dispatch value is the class of its first argument, which \
|
||||||
|
is what makes it the class-dispatching half of the pair. Write \
|
||||||
|
defmulti for a dispatch value of your own"
|
||||||
|
else
|
||||||
|
"defmulti is (defmulti name [param ...] ReturnType body ...), and the \
|
||||||
|
body is the dispatch: it answers the value the methods are keyed by"
|
||||||
|
in
|
||||||
|
(match args with
|
||||||
|
| n :: { v = Vec ps; _ } :: ret :: body
|
||||||
|
when if generic then body = [] else body <> [] ->
|
||||||
|
mk ((if generic then (fun fn -> Ast.Defgeneric fn)
|
||||||
|
else fun fn -> Ast.Defmulti fn)
|
||||||
|
{ Ast.name = sym n; params = dyn_params which ps; praw = None;
|
||||||
|
ret = Some (texpr ret); fwhere = []; fbody = body_of body;
|
||||||
|
nloc = n.loc })
|
||||||
|
| _ -> fail f "%s" usage)
|
||||||
|
|
||||||
|
| List ({ v = Sym "defmethod"; _ } :: args) ->
|
||||||
|
(match args with
|
||||||
|
| n :: key :: { v = Vec ps; _ } :: body when body <> [] ->
|
||||||
|
let gen = sym n and k = dispatch key in
|
||||||
|
mk (Ast.Defmethod
|
||||||
|
{ Ast.mgen = gen; mkey = k; mkloc = key.loc;
|
||||||
|
(* The name is the declaration's, not a symbol anything emits:
|
||||||
|
no function is ever written under it. *)
|
||||||
|
mfn = { Ast.name = gen ^ "@" ^ Ast.dispatch_text k;
|
||||||
|
params = dyn_params "defmethod" ps; praw = None;
|
||||||
|
ret = None; fwhere = []; fbody = body_of body;
|
||||||
|
nloc = n.loc } })
|
||||||
|
| _ ->
|
||||||
|
fail f
|
||||||
|
"defmethod is (defmethod generic dispatch [param ...] body ...). \
|
||||||
|
There is no return type: the generic states it once, for every \
|
||||||
|
method written for it")
|
||||||
|
|
||||||
| List ({ v = Sym ("declare" | "declare-c" as which); _ } :: args) ->
|
| List ({ v = Sym ("declare" | "declare-c" as which); _ } :: args) ->
|
||||||
(* (declare name [param Type ...] ReturnType? "c_symbol"). The C symbol is
|
(* (declare name [param Type ...] ReturnType? "c_symbol"). The C symbol is
|
||||||
last and is always written: a foreign name is not derivable from a Flan
|
last and is always written: a foreign name is not derivable from a Flan
|
||||||
|
|||||||
@ -148,6 +148,28 @@ let source = {flan|
|
|||||||
;; pushed here.
|
;; pushed here.
|
||||||
(defstruct ArithError [op i32 lhs i64 rhs i64])
|
(defstruct ArithError [op i32 lhs i64 rhs i64])
|
||||||
|
|
||||||
|
;; What a generic function signals when no method answers. `generic` is the
|
||||||
|
;; name written at the defgeneric or defmulti, and `value` is what the
|
||||||
|
;; dispatch actually produced -- the class of the first argument for a
|
||||||
|
;; defgeneric, whatever the body answered for a defmulti. A miss is nil for
|
||||||
|
;; the common case of a value that is not an instance at all.
|
||||||
|
;;
|
||||||
|
;; A condition and not a trap, and that is the decision rather than the
|
||||||
|
;; obvious default: Common Lisp signals here, and a dispatch that missed is
|
||||||
|
;; something a program can be written to answer -- a default object, a log
|
||||||
|
;; line, a fallback -- which a trap would take away. `handler-case` around
|
||||||
|
;; the call is the shape, and a method written for `:else` is the other
|
||||||
|
;; answer, in the generic rather than at the call.
|
||||||
|
;;
|
||||||
|
;; `value` is dyn, which is the one field type no other condition here has.
|
||||||
|
;; It is the honest one: a dispatch value is whatever the dispatch answered
|
||||||
|
;; and there is no narrower type it has. The collector reaches it through the
|
||||||
|
;; per-type descriptor a struct with a dyn field carries.
|
||||||
|
;;
|
||||||
|
;; No restart is established at the miss, which is BoundsError's decision
|
||||||
|
;; taken for BoundsError's reason -- see the note above it.
|
||||||
|
(defstruct NoMethod [generic string value dyn])
|
||||||
|
|
||||||
;; A breakpoint. (pause) stops the program where it stands and hands it to the
|
;; A breakpoint. (pause) stops the program where it stands and hands it to the
|
||||||
;; break loop, with the whole stack under it readable — C-c C-b lists the
|
;; break loop, with the whole stack under it readable — C-c C-b lists the
|
||||||
;; frames, TAB opens one, and taking `continue` resumes at the call.
|
;; frames, TAB opens one, and taking `continue` resumes at the call.
|
||||||
|
|||||||
@ -586,7 +586,21 @@ let eval ?(origin = "<eval>") ?pause t src : change =
|
|||||||
fail loc "nothing to pause at line %d, column %d of the form sent"
|
fail loc "nothing to pause at line %d, column %d of the form sent"
|
||||||
line col)
|
line col)
|
||||||
in
|
in
|
||||||
let names = List.filter_map Ast.declared_name incoming in
|
(* A method declares a name of its own — that is what makes evaluating one
|
||||||
|
twice a replacement and evaluating a new one an append, through the same
|
||||||
|
kept/added logic every other declaration goes through. But no function is
|
||||||
|
emitted under that name: a method's body is inlined into its generic's
|
||||||
|
dispatch by [Classes.expand], so the body that has to be installed is the
|
||||||
|
*generic's*. Naming it here is what makes [C-c C-c] on a defmethod reach
|
||||||
|
a call site compiled before the method existed, which is the whole of why
|
||||||
|
this feature is usable in the loop the project exists for. *)
|
||||||
|
let names =
|
||||||
|
List.filter_map Ast.declared_name incoming
|
||||||
|
@ List.filter_map
|
||||||
|
(fun (d : Ast.decl) ->
|
||||||
|
match d.Ast.d with Ast.Defmethod m -> Some m.Ast.mgen | _ -> None)
|
||||||
|
incoming
|
||||||
|
in
|
||||||
let replacement n =
|
let replacement n =
|
||||||
List.find_opt
|
List.find_opt
|
||||||
(fun (d : Ast.decl) -> Ast.declared_name d = Some n)
|
(fun (d : Ast.decl) -> Ast.declared_name d = Some n)
|
||||||
|
|||||||
@ -220,6 +220,11 @@ typedef struct flan_dyn_alloc_hdr {
|
|||||||
uint64_t epoch;
|
uint64_t epoch;
|
||||||
} flan_dyn_alloc_hdr;
|
} flan_dyn_alloc_hdr;
|
||||||
|
|
||||||
|
/* A keyword's interned entry, declared here because a map's shape tag is one.
|
||||||
|
* The definition, the table and the argument for interning are further down,
|
||||||
|
* under "Keywords". */
|
||||||
|
struct kw_entry;
|
||||||
|
|
||||||
typedef struct flan_obj {
|
typedef struct flan_obj {
|
||||||
struct flan_obj *next; /* every object ever allocated, newest first */
|
struct flan_obj *next; /* every object ever allocated, newest first */
|
||||||
uint8_t kind;
|
uint8_t kind;
|
||||||
@ -228,7 +233,26 @@ typedef struct flan_obj {
|
|||||||
of a map */
|
of a map */
|
||||||
union {
|
union {
|
||||||
int64_t i; /* OBJ_INT */
|
int64_t i; /* OBJ_INT */
|
||||||
struct { flan_dyn *items; int64_t cap; } v; /* OBJ_VEC and OBJ_MAP —
|
struct { flan_dyn *items; int64_t cap;
|
||||||
|
/* OBJ_MAP only, and NULL for every map that is not a defclass
|
||||||
|
instance: the shape tag. It is the interned entry of the
|
||||||
|
class's name — :point for (defclass point [x y]) — so the
|
||||||
|
identity compare that makes keyword equality cheap is also
|
||||||
|
what makes a class check cheap, and the tag needs no marking
|
||||||
|
because an interned entry is immortal and is not a GC object
|
||||||
|
(see [mark_value], which follows BOX_OBJ and nothing else).
|
||||||
|
|
||||||
|
It lives in the header rather than in a reserved entry of the
|
||||||
|
map itself, which is the one place this departs from the
|
||||||
|
queue's note: an entry would be counted by [len], walked by
|
||||||
|
[render], and compared by [dyn_equal]'s key loop, so every
|
||||||
|
instance would answer a length one larger than its slot count
|
||||||
|
and print a key nobody wrote. A field cannot be reached by
|
||||||
|
[get] or [put] at all, so no user key can collide with it.
|
||||||
|
|
||||||
|
A vec leaves it NULL. The arm is shared, so the field exists
|
||||||
|
for both kinds; nothing reads it for an OBJ_VEC. */
|
||||||
|
struct kw_entry *klass; } v; /* OBJ_VEC and OBJ_MAP —
|
||||||
a map shares the vec's arm on purpose: its entries are the same malloc
|
a map shares the vec's arm on purpose: its entries are the same malloc
|
||||||
block of dyn words, interleaved key then value, with [len] counting
|
block of dyn words, interleaved key then value, with [len] counting
|
||||||
entries and [cap] counting entries too. Sharing the arm is what lets the
|
entries and [cap] counting entries too. Sharing the arm is what lets the
|
||||||
@ -555,6 +579,13 @@ static void render(flan_dyn v, int depth, int nested) {
|
|||||||
case FLAN_DYN_TAG_MAP: {
|
case FLAN_DYN_TAG_MAP: {
|
||||||
flan_obj *o = dyn_obj(v);
|
flan_obj *o = dyn_obj(v);
|
||||||
int64_t i;
|
int64_t i;
|
||||||
|
/* A class instance prints its shape tag in front, Clojure's own spelling
|
||||||
|
* for a record: #point{ :x 1 :y 2}. The tag is not an entry, so it is
|
||||||
|
* written here or it is not written at all. */
|
||||||
|
if (o->u.v.klass != NULL) {
|
||||||
|
emit("#");
|
||||||
|
emit_n(kw_bytes(o->u.v.klass), o->u.v.klass->len);
|
||||||
|
}
|
||||||
emit("{");
|
emit("{");
|
||||||
for (i = 0; i < o->len; i++) {
|
for (i = 0; i < o->len; i++) {
|
||||||
emit(" ");
|
emit(" ");
|
||||||
@ -651,6 +682,19 @@ static void say_render(sayer *s, flan_dyn v, int depth) {
|
|||||||
flan_obj *o = dyn_obj(v);
|
flan_obj *o = dyn_obj(v);
|
||||||
int64_t i;
|
int64_t i;
|
||||||
if (depth >= 2) { say_puts(s, "{...}"); return; }
|
if (depth >= 2) { say_puts(s, "{...}"); return; }
|
||||||
|
/* The same tag [render] writes, so a trap sentence naming an instance
|
||||||
|
* says which class it was. Truncated with the rest when the buffer is
|
||||||
|
* short: [say] is a 96-byte sentence, not a printer. */
|
||||||
|
if (o->u.v.klass != NULL && s->n < s->cap - 8) {
|
||||||
|
int64_t j;
|
||||||
|
say_puts(s, "#");
|
||||||
|
for (j = 0; j < o->u.v.klass->len && s->n < s->cap - 8; j++) {
|
||||||
|
char c[2];
|
||||||
|
c[0] = (char)kw_bytes(o->u.v.klass)[j];
|
||||||
|
c[1] = '\0';
|
||||||
|
say_puts(s, c);
|
||||||
|
}
|
||||||
|
}
|
||||||
say_puts(s, "{");
|
say_puts(s, "{");
|
||||||
for (i = 0; i < o->len && s->n < s->cap - 8; i++) {
|
for (i = 0; i < o->len && s->n < s->cap - 8; i++) {
|
||||||
say_puts(s, " ");
|
say_puts(s, " ");
|
||||||
@ -1015,6 +1059,9 @@ flan_dyn flan_dyn_vec_new(void) {
|
|||||||
o->len = 0;
|
o->len = 0;
|
||||||
o->u.v.items = NULL;
|
o->u.v.items = NULL;
|
||||||
o->u.v.cap = 0;
|
o->u.v.cap = 0;
|
||||||
|
/* Shared arm, and nothing reads this for a vec; written anyway so that the
|
||||||
|
field's value is never whatever [gc_alloc] happened to leave. */
|
||||||
|
o->u.v.klass = NULL;
|
||||||
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -1023,9 +1070,37 @@ flan_dyn flan_dyn_map_new(void) {
|
|||||||
o->len = 0;
|
o->len = 0;
|
||||||
o->u.v.items = NULL;
|
o->u.v.items = NULL;
|
||||||
o->u.v.cap = 0;
|
o->u.v.cap = 0;
|
||||||
|
o->u.v.klass = NULL;
|
||||||
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* The same map with a shape tag on it: what a (defclass ...) constructor
|
||||||
|
* calls. [k] is a keyword and anything else traps by name — the compiler
|
||||||
|
* hands it the class's own name and nothing else can reach this. */
|
||||||
|
flan_dyn flan_dyn_map_new_class(flan_dyn k) {
|
||||||
|
flan_obj *o;
|
||||||
|
if (flan_dyn_tag(k) != FLAN_DYN_TAG_KEYWORD)
|
||||||
|
trap1(TYPE_TRAP, "class instance", "a class tag is a keyword", k);
|
||||||
|
o = gc_alloc(OBJ_MAP, 0);
|
||||||
|
o->len = 0;
|
||||||
|
o->u.v.items = NULL;
|
||||||
|
o->u.v.cap = 0;
|
||||||
|
o->u.v.klass = dyn_kw(k);
|
||||||
|
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* The shape tag, as a value: the class's name as a keyword, or nil. Never
|
||||||
|
* traps. Absence is an answer here for the reason it is one in [map_get] —
|
||||||
|
* asking what class a value is, is a question every value can be asked, and
|
||||||
|
* an ordinary map, a number and nil all truthfully answer "none". */
|
||||||
|
flan_dyn flan_dyn_class_of(flan_dyn v) {
|
||||||
|
flan_obj *o;
|
||||||
|
if (flan_dyn_tag(v) != FLAN_DYN_TAG_MAP) return flan_dyn_nil();
|
||||||
|
o = dyn_obj(v);
|
||||||
|
if (o->u.v.klass == NULL) return flan_dyn_nil();
|
||||||
|
return dyn_make(BOX_KW, (uint64_t)(uintptr_t)o->u.v.klass);
|
||||||
|
}
|
||||||
|
|
||||||
/* ── Keywords ──────────────────────────────────────────────────────────
|
/* ── Keywords ──────────────────────────────────────────────────────────
|
||||||
*
|
*
|
||||||
* One global table, append-only, never freed: a keyword is a *name*, the set
|
* One global table, append-only, never freed: a keyword is a *name*, the set
|
||||||
@ -1483,6 +1558,12 @@ static int dyn_equal(flan_dyn a, flan_dyn b, int depth) {
|
|||||||
int64_t i, j;
|
int64_t i, j;
|
||||||
if (x == y) return 1;
|
if (x == y) return 1;
|
||||||
if (depth >= EQ_DEPTH) return 0;
|
if (depth >= EQ_DEPTH) return 0;
|
||||||
|
/* The shape tag is part of the value. Two instances of one class compare
|
||||||
|
* by their entries as any two maps do; an instance and a plain map with
|
||||||
|
* the same entries do not, which is Clojure's answer for a record beside
|
||||||
|
* a map and is the only answer a tag can have if it means anything. An
|
||||||
|
* identity compare, because both sides are interned entries. */
|
||||||
|
if (x->u.v.klass != y->u.v.klass) return 0;
|
||||||
if (x->len != y->len) return 0;
|
if (x->len != y->len) return 0;
|
||||||
for (i = 0; i < x->len; i++) {
|
for (i = 0; i < x->len; i++) {
|
||||||
flan_dyn k = x->u.v.items[i * 2];
|
flan_dyn k = x->u.v.items[i * 2];
|
||||||
|
|||||||
@ -76,6 +76,24 @@ flan_dyn flan_dyn_from_bytes(const uint8_t *p, int64_t n);
|
|||||||
flan_dyn flan_dyn_vec_new(void);
|
flan_dyn flan_dyn_vec_new(void);
|
||||||
flan_dyn flan_dyn_map_new(void);
|
flan_dyn flan_dyn_map_new(void);
|
||||||
|
|
||||||
|
/* A map carrying a shape tag: what a (defclass point [x y]) constructor
|
||||||
|
* builds. [k] is the class's name as a keyword and anything else traps.
|
||||||
|
*
|
||||||
|
* The tag lives in the object's header and not in an entry of the map, so it
|
||||||
|
* is invisible to [get], [set], [contains] and [len] — an instance's length
|
||||||
|
* is its slot count and no key a program can write collides with it. What can
|
||||||
|
* see it is [flan_dyn_class_of], [flan_dyn_eq] (two values of different
|
||||||
|
* classes are unequal, and an instance is never equal to a plain map) and
|
||||||
|
* [flan_dyn_print] (an instance renders as #point{ :x 1 :y 2}).
|
||||||
|
*
|
||||||
|
* The tag is not traced and does not have to be: an interned keyword entry is
|
||||||
|
* immortal and is not a collector object. */
|
||||||
|
flan_dyn flan_dyn_map_new_class(flan_dyn k);
|
||||||
|
|
||||||
|
/* The class's name as a keyword, or nil for anything that is not an instance
|
||||||
|
* — an ordinary map included. Never traps. */
|
||||||
|
flan_dyn flan_dyn_class_of(flan_dyn v);
|
||||||
|
|
||||||
/* A keyword: :foo as a run-time value. Interned — the runtime keeps one entry
|
/* A keyword: :foo as a run-time value. Interned — the runtime keeps one entry
|
||||||
* per distinct name forever, so two keywords with the same bytes are the same
|
* per distinct name forever, so two keywords with the same bytes are the same
|
||||||
* word and equality is an identity compare, never a memcmp. The entries are
|
* word and equality is an identity compare, never a memcmp. The entries are
|
||||||
|
|||||||
120
test/programs/dyn-class.flan
Normal file
120
test/programs/dyn-class.flan
Normal file
@ -0,0 +1,120 @@
|
|||||||
|
;;;; Classes and generic functions, the dyn side's two dispatch styles.
|
||||||
|
;;;;
|
||||||
|
;;;; A defclass is a named dyn map with a shape tag. The constructor is the
|
||||||
|
;;;; class's own name, positional over the slots; the slots are ordinary map
|
||||||
|
;;;; keys, so get and put are how one is read and written and nothing new was
|
||||||
|
;;;; needed for either. What the class adds is the tag, which lives in the
|
||||||
|
;;;; object's header and not in the entries: (len p) is the slot count, no key
|
||||||
|
;;;; a program can write collides with it, and it shows up in exactly three
|
||||||
|
;;;; places -- class-of, equality, and the printed form #point{ :x 1 :y 2}.
|
||||||
|
;;;;
|
||||||
|
;;;; The two dispatch styles are one mechanism. A defgeneric dispatches on the
|
||||||
|
;;;; class of its first argument, which is Common Lisp's; a defmulti's body IS
|
||||||
|
;;;; the dispatch, which is Clojure's. A class dispatcher is the shape tag of
|
||||||
|
;;;; the first argument as the dispatch function, so the second spells the
|
||||||
|
;;;; first, and a method is a branch either way.
|
||||||
|
|
||||||
|
(defclass point [x y])
|
||||||
|
(defclass circle [r])
|
||||||
|
|
||||||
|
;; CLOS's half: dispatch on the class of the first argument. The generic
|
||||||
|
;; declares the parameters and the return type once; a method states neither.
|
||||||
|
(defgeneric area [self] dyn)
|
||||||
|
|
||||||
|
(defmethod area point [p] (* (get p :x) (get p :y)))
|
||||||
|
;; A method may name its parameter whatever it likes -- the generic's name is
|
||||||
|
;; bound to it on the way in.
|
||||||
|
(defmethod area circle [c] (* 3 (* (get c :r) (get c :r))))
|
||||||
|
|
||||||
|
;; Clojure's half: the dispatch is a body, over the same parameter list every
|
||||||
|
;; method has, answering the value the methods are keyed by.
|
||||||
|
(defmulti describe [thing] dyn (get thing :kind))
|
||||||
|
|
||||||
|
(defmethod describe :square [s] (get s :side))
|
||||||
|
(defmethod describe "round" [s] "a round thing, keyed by a string")
|
||||||
|
(defmethod describe 7 [s] "the one keyed by a number")
|
||||||
|
;; The method that answers when no other does. It is :else, which is the word
|
||||||
|
;; match already uses, and it is the last arm whatever order it is written in.
|
||||||
|
(defmethod describe :else [s] "something else")
|
||||||
|
|
||||||
|
;; A generic with no :else: a miss signals, and the program answers it.
|
||||||
|
(defgeneric name-of [self] dyn)
|
||||||
|
(defmethod name-of point [p] "a point")
|
||||||
|
|
||||||
|
(defn main [] i32
|
||||||
|
(let [p (point 3 4)
|
||||||
|
c (circle 2)]
|
||||||
|
;; The instance is a map, and prints as one with its tag in front.
|
||||||
|
(println p)
|
||||||
|
(println (len p))
|
||||||
|
(println (get p :x))
|
||||||
|
(put p :x 10)
|
||||||
|
(println (get p :x))
|
||||||
|
(println (has-key? p :x))
|
||||||
|
(println (has-key? p :nothing))
|
||||||
|
(println (get p :nothing))
|
||||||
|
|
||||||
|
;; The shape tag, as a value. Every value can be asked; only an instance
|
||||||
|
;; answers with a name.
|
||||||
|
(println (class-of p))
|
||||||
|
(println (class-of c))
|
||||||
|
(println (class-of {:x 3 :y 4}))
|
||||||
|
(println (class-of 1))
|
||||||
|
(println (class-of nil))
|
||||||
|
|
||||||
|
;; Equality takes the tag into account: two instances of one class compare
|
||||||
|
;; by their slots, an instance and a plain map with the same entries do
|
||||||
|
;; not, and two classes with the same slots are two classes.
|
||||||
|
(println (= (point 1 2) (point 1 2)))
|
||||||
|
(println (= (point 1 2) (point 1 3)))
|
||||||
|
(println (= (point 1 2) {:x 1 :y 2}))
|
||||||
|
(println (= (circle 2) (circle 2)))
|
||||||
|
|
||||||
|
;; Class dispatch. Same call site, two classes, two methods.
|
||||||
|
(println (area p))
|
||||||
|
(println (area c))
|
||||||
|
|
||||||
|
;; Arbitrary dispatch, over three kinds of dispatch value and the
|
||||||
|
;; fallback. The dispatch runs on every call, so the value is whatever
|
||||||
|
;; the map holds at the time.
|
||||||
|
(println (describe {:kind :square :side 5}))
|
||||||
|
(println (describe {:kind "round"}))
|
||||||
|
(println (describe {:kind 7}))
|
||||||
|
(println (describe {:kind :hexagon}))
|
||||||
|
;; An empty map on its own is the zero-field struct literal, so it is
|
||||||
|
;; bound first -- the dispatch answers nil for a map with no :kind, and
|
||||||
|
;; nil finds no method either.
|
||||||
|
(let [empty {:no :kind}]
|
||||||
|
(println (describe empty)))
|
||||||
|
|
||||||
|
;; An instance is an ordinary dyn value: it goes in a vec, keys a map,
|
||||||
|
;; and is collected like anything else.
|
||||||
|
(let [v [p c]]
|
||||||
|
(println (len v))
|
||||||
|
(println (class-of (at v 1))))
|
||||||
|
|
||||||
|
;; The miss. No method and no :else, so the generic signals NoMethod, and
|
||||||
|
;; handler-case answers the whole form with a value -- the condition
|
||||||
|
;; carries the generic's name and the dispatch value that found nothing.
|
||||||
|
(println (name-of p))
|
||||||
|
(println
|
||||||
|
(handler-case (name-of c)
|
||||||
|
[(NoMethod [e] (.generic e))]))
|
||||||
|
;; The condition carries the dispatch value that found nothing, which for
|
||||||
|
;; a defgeneric over a value that is no instance at all is nil.
|
||||||
|
(println
|
||||||
|
(handler-case (name-of 42)
|
||||||
|
[(NoMethod [e] (.value e))])))
|
||||||
|
|
||||||
|
;; Instances under the collector: enough of them to pass the 1 MiB floor
|
||||||
|
;; many times over, with one live instance in a rooted global. A marker that
|
||||||
|
;; lost an instance's slots would free something live and the sum would come
|
||||||
|
;; out wrong -- the tag itself is an interned keyword and immortal, which is
|
||||||
|
;; why it needs no tracing.
|
||||||
|
(let [total (point 0 0)]
|
||||||
|
(dotimes [i 50000]
|
||||||
|
(let [q (point i "forty-seven bytes of text to fatten each row")]
|
||||||
|
(put total :x (+ (get total :x) (len q)))))
|
||||||
|
(println (get total :x))
|
||||||
|
(println (class-of total)))
|
||||||
|
0)
|
||||||
@ -3575,6 +3575,35 @@ level "1"
|
|||||||
"programs/dyn-map.flan" dyn_map_out;
|
"programs/dyn-map.flan" dyn_map_out;
|
||||||
outputs ~x86:true "dyn: maps and keywords, --x86"
|
outputs ~x86:true "dyn: maps and keywords, --x86"
|
||||||
"programs/dyn-map.flan" dyn_map_out;
|
"programs/dyn-map.flan" dyn_map_out;
|
||||||
|
(* ── Classes and generic functions, M2 item 6 ────────────────────
|
||||||
|
The dyn side's two dispatch styles over one mechanism, at all three
|
||||||
|
rows because dispatch is a chain of dyn comparisons and the shape tag
|
||||||
|
is a word in an object header — two things the backends could differ
|
||||||
|
about and do not. Captured from the running program. The first line
|
||||||
|
pins the tagged rendering (#point in front of the map the renderer
|
||||||
|
already wrote, with its space-per-element convention unchanged) and
|
||||||
|
the 2 after it pins the other half of the decision: the tag is not an
|
||||||
|
entry, so an instance's length is its slot count. The three nils in
|
||||||
|
the middle are class-of over a plain map, a number and nil — asking
|
||||||
|
is not a claim. The 40 and the 12 are class dispatch over two
|
||||||
|
classes at one call site; the four lines under them are arbitrary
|
||||||
|
dispatch over a keyword, a string, a number and the :else fallback.
|
||||||
|
name-of, then nil, are a dispatch miss answered by handler-case: the
|
||||||
|
generic's name out of the condition, then the dispatch value that
|
||||||
|
found nothing. The 100000 at the end is 50000 instances allocated
|
||||||
|
against one live instance, well past the collector's 1 MiB floor. *)
|
||||||
|
let dyn_class_out =
|
||||||
|
"#point{ :x 3 :y 4}\n2\n3\n10\ntrue\nfalse\nnil\n:point\n\
|
||||||
|
:circle\nnil\nnil\nnil\ntrue\nfalse\nfalse\ntrue\n40\n12\n5\n\
|
||||||
|
a round thing, keyed by a string\nthe one keyed by a number\n\
|
||||||
|
something else\nsomething else\n2\n:circle\na point\nname-of\n\
|
||||||
|
nil\n100000\n:point\n"
|
||||||
|
in
|
||||||
|
outputs "dyn: classes and dispatch" "programs/dyn-class.flan" dyn_class_out;
|
||||||
|
outputs ~opt:"-O0" "dyn: classes and dispatch, -O0"
|
||||||
|
"programs/dyn-class.flan" dyn_class_out;
|
||||||
|
outputs ~x86:true "dyn: classes and dispatch, --x86"
|
||||||
|
"programs/dyn-class.flan" dyn_class_out;
|
||||||
(* ── Per-type descriptors, M2 item 2 ─────────────────────────────
|
(* ── Per-type descriptors, M2 item 2 ─────────────────────────────
|
||||||
The first program anywhere with a dyn field in a struct, which was a
|
The first program anywhere with a dyn field in a struct, which was a
|
||||||
refusal until the descriptors landed. It matters at all three rows
|
refusal until the descriptors landed. It matters at all three rows
|
||||||
|
|||||||
@ -1732,6 +1732,121 @@ let () =
|
|||||||
main_at "a wrong main parameter points at main" "(defn main [n i32] ())";
|
main_at "a wrong main parameter points at main" "(defn main [n i32] ())";
|
||||||
main_at "a wrong main return type points at main" "(defn main [] bool true)";
|
main_at "a wrong main return type points at main" "(defn main [] bool true)";
|
||||||
|
|
||||||
|
(* ── Classes and generic functions — M2 item 6 ─────────────────── *)
|
||||||
|
(* A class is a constructor and a shape tag. The constructor is the class's
|
||||||
|
own name, positional over the slots, and everything that reads or writes
|
||||||
|
an instance is the dyn map operation that was already there. *)
|
||||||
|
accepts "a class and its constructor"
|
||||||
|
"(defclass point [x y])\n\
|
||||||
|
(defn main [] i32 (let [p (point 1 2)] (if (= (get p :x) 1) 0 1)))";
|
||||||
|
accepts "a class with no slots"
|
||||||
|
"(defclass marker [])\n(defn main [] i32 (let [m (marker)] 0))";
|
||||||
|
accepts "class-of answers nil for anything that is not an instance"
|
||||||
|
"(defn main [] i32 (if (= (class-of 1) nil) 0 1))";
|
||||||
|
(* The constructor is an ordinary function, so its arity is the ordinary
|
||||||
|
arity check and a wrong one names the class. *)
|
||||||
|
rejects_check "a constructor takes one argument per slot"
|
||||||
|
"(defclass point [x y])\n(defn main [] i32 (let [p (point 1)] 0))"
|
||||||
|
~needle:"point";
|
||||||
|
(* A slot vector holds names and nothing else. [(defclass point [x i64])]
|
||||||
|
is therefore two slots, one of them unfortunately named — the parser
|
||||||
|
cannot tell a type's name from a slot's and does not have to, since a
|
||||||
|
slot has no type to write. What it can tell is a form that is not a name
|
||||||
|
at all. *)
|
||||||
|
rejects_check "a slot is a name, not a type expression"
|
||||||
|
"(defclass point [x (Ptr i64)])\n(defn main [] i32 0)"
|
||||||
|
~needle:"a class slot is a name";
|
||||||
|
rejects_check "a class does not name a slot twice"
|
||||||
|
"(defclass point [x x])\n(defn main [] i32 0)"
|
||||||
|
~needle:"names the slot x twice";
|
||||||
|
|
||||||
|
(* Both halves of the dispatch, and the fact that they are one mechanism:
|
||||||
|
a defgeneric is a defmulti whose dispatch is (class-of first-argument),
|
||||||
|
so a method written for a class is a method written for its keyword. *)
|
||||||
|
accepts "class dispatch"
|
||||||
|
"(defclass point [x y])\n\
|
||||||
|
(defgeneric area [self] dyn)\n\
|
||||||
|
(defmethod area point [p] (* (get p :x) (get p :y)))\n\
|
||||||
|
(defn main [] i32 (if (= (area (point 2 3)) 6) 0 1))";
|
||||||
|
accepts "arbitrary dispatch, with a fallback"
|
||||||
|
"(defmulti describe [x] dyn (get x :kind))\n\
|
||||||
|
(defmethod describe :square [s] 1)\n\
|
||||||
|
(defmethod describe :else [s] 2)\n\
|
||||||
|
(defn main [] i32 (if (= (describe {:kind :round}) 2) 0 1))";
|
||||||
|
accepts "a method may name its parameters whatever it likes"
|
||||||
|
"(defclass point [x y])\n\
|
||||||
|
(defgeneric area [self] dyn)\n\
|
||||||
|
(defmethod area point [whatever] (get whatever :x))\n\
|
||||||
|
(defn main [] i32 0)";
|
||||||
|
accepts "a method may be written above its generic"
|
||||||
|
"(defclass point [x y])\n\
|
||||||
|
(defmethod area point [p] (get p :x))\n\
|
||||||
|
(defgeneric area [self] dyn)\n\
|
||||||
|
(defn main [] i32 0)";
|
||||||
|
(* A generic with no methods at all is legal and always misses; that is a
|
||||||
|
run-time answer (the NoMethod condition), not a compile-time refusal. *)
|
||||||
|
accepts "a generic with no methods"
|
||||||
|
"(defgeneric area [self] dyn)\n(defn main [] i32 0)";
|
||||||
|
|
||||||
|
rejects_check "a method needs a generic"
|
||||||
|
"(defclass point [x y])\n(defmethod area point [p] 1)\n\
|
||||||
|
(defn main [] i32 0)"
|
||||||
|
~needle:"no defgeneric or defmulti names area";
|
||||||
|
rejects_check "a method dispatching on an unknown class"
|
||||||
|
"(defgeneric area [self] dyn)\n(defmethod area square [p] 1)\n\
|
||||||
|
(defn main [] i32 0)"
|
||||||
|
~needle:"no defclass names square";
|
||||||
|
rejects_check "two methods for one dispatch value"
|
||||||
|
"(defclass point [x y])\n\
|
||||||
|
(defgeneric area [self] dyn)\n\
|
||||||
|
(defmethod area point [p] 1)\n\
|
||||||
|
(defmethod area point [p] 2)\n\
|
||||||
|
(defn main [] i32 0)"
|
||||||
|
~needle:"already has a method for point";
|
||||||
|
rejects_check "two :else methods for one generic"
|
||||||
|
"(defmulti d [x] dyn x)\n\
|
||||||
|
(defmethod d :else [x] 1)\n\
|
||||||
|
(defmethod d :else [x] 2)\n\
|
||||||
|
(defn main [] i32 0)"
|
||||||
|
~needle:"already has a method for :else";
|
||||||
|
rejects_check "a method's arity is its generic's"
|
||||||
|
"(defclass point [x y])\n\
|
||||||
|
(defgeneric area [self] dyn)\n\
|
||||||
|
(defmethod area point [p q] 1)\n\
|
||||||
|
(defn main [] i32 0)"
|
||||||
|
~needle:"and this method of it takes 2";
|
||||||
|
rejects_check "a generic's parameter is a bare name"
|
||||||
|
"(defgeneric area [self (Ptr i64)] dyn)\n(defn main [] i32 0)"
|
||||||
|
~needle:"parameter is a bare name";
|
||||||
|
rejects_check "a defgeneric has no body"
|
||||||
|
"(defgeneric area [self] dyn (class-of self))\n(defn main [] i32 0)"
|
||||||
|
~needle:"It has no body";
|
||||||
|
rejects_check "a defmulti has one"
|
||||||
|
"(defmulti describe [x] dyn)\n(defn main [] i32 0)"
|
||||||
|
~needle:"the body is the dispatch";
|
||||||
|
rejects_check "a defgeneric needs something to dispatch on"
|
||||||
|
"(defgeneric area [] dyn)\n(defn main [] i32 0)"
|
||||||
|
~needle:"dispatches on the class of its first";
|
||||||
|
rejects_check "a dispatch value is written out, not computed"
|
||||||
|
"(defmulti d [x] dyn x)\n(defmethod d (f 1) [x] 1)\n\
|
||||||
|
(defn main [] i32 0)"
|
||||||
|
~needle:"is written out rather than computed";
|
||||||
|
(* A method has no return slot: the generic states the type once, for all
|
||||||
|
of them. What that means for anyone writing the defn spelling by habit
|
||||||
|
is that the slot they would have written is read as the first form of
|
||||||
|
the body, and a lone type name there is an unknown name. *)
|
||||||
|
rejects_check "a method has no return slot"
|
||||||
|
"(defclass point [x y])\n\
|
||||||
|
(defgeneric area [self] dyn)\n\
|
||||||
|
(defmethod area point [p] dyn (get p :x))\n\
|
||||||
|
(defn main [] i32 0)"
|
||||||
|
~needle:"dyn";
|
||||||
|
(* A class and a function are one namespace, as a defn and a defvar are:
|
||||||
|
the constructor is a defn, so the collision is the ordinary one. *)
|
||||||
|
rejects_check "a class collides with a function of the same name"
|
||||||
|
"(defclass point [x y])\n(defn point [] i32 0)\n(defn main [] i32 0)"
|
||||||
|
~needle:"point";
|
||||||
|
|
||||||
(* ── Unconstrained operators, and everything past milestone 2 ──── *)
|
(* ── Unconstrained operators, and everything past milestone 2 ──── *)
|
||||||
(* M2 queue item 5: typed = and != grow strings, bytewise. Ordering does
|
(* M2 queue item 5: typed = and != grow strings, bytewise. Ordering does
|
||||||
not — there is no collation the language has picked, so < stays
|
not — there is no collation the language has picked, so < stays
|
||||||
|
|||||||
@ -195,6 +195,14 @@ let corpus =
|
|||||||
amount of reading the offsets can. *)
|
amount of reading the offsets can. *)
|
||||||
"programs/dyn-struct.flan", [];
|
"programs/dyn-struct.flan", [];
|
||||||
"programs/dyn-map.flan", [];
|
"programs/dyn-map.flan", [];
|
||||||
|
(* Classes, M2 queue item 6. A class instance is a map with one more word
|
||||||
|
in its header, so what this adds over [dyn-map] is that word: it is
|
||||||
|
written by a constructor, read by class-of, compared by equality and
|
||||||
|
printed by both renderers, and it is the one field in an object that
|
||||||
|
the marker deliberately does not trace — an interned keyword entry is
|
||||||
|
immortal and is not a collector object. If that reasoning is wrong,
|
||||||
|
50000 instances past the one-megabyte floor is where ASan says so. *)
|
||||||
|
"programs/dyn-class.flan", [];
|
||||||
(* nil <-> None at (Option T), M2 queue item 4: an Option's tag is read
|
(* nil <-> None at (Option T), M2 queue item 4: an Option's tag is read
|
||||||
with a raw [Field] the surface language never writes (check.ml's
|
with a raw [Field] the surface language never writes (check.ml's
|
||||||
[box_option]/[unbox_option], the same access Render's structural
|
[box_option]/[unbox_option], the same access Render's structural
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user