Any typed container of numbers, bools, str, structs, arrays, slices or Vecs crosses into dyn as a view from any storage, and a dev build traps on a view whose frame returned or whose block was released.
This commit is contained in:
parent
f9dadce5d0
commit
7953376e4e
315
lib/check.ml
315
lib/check.ml
@ -354,7 +354,23 @@ type env = {
|
||||
mutable guard_next : bool;
|
||||
}
|
||||
|
||||
let new_env () = {
|
||||
(* The struct table [box] reads a struct's fields from when it describes one
|
||||
for a view: [box] is called from places that hold no [ctx], and there is
|
||||
one table per program. Set by [new_env]. *)
|
||||
let view_structs : (string, Tast.structure) Hashtbl.t ref = ref (Hashtbl.create 1)
|
||||
|
||||
(* The global whose initialiser is being checked, and its form. A view taken
|
||||
there of storage the initialiser itself built is gone the moment the
|
||||
initialiser returns, so it is refused rather than left to the dev check:
|
||||
nothing could ever read it. *)
|
||||
let view_global_init : (string * Ast.reinit) option ref = ref None
|
||||
|
||||
let rec new_env () =
|
||||
let env = new_env_record () in
|
||||
view_structs := env.structs;
|
||||
env
|
||||
|
||||
and new_env_record () = {
|
||||
structs = Hashtbl.create 16;
|
||||
datas = Hashtbl.create 16;
|
||||
unions = Hashtbl.create 16;
|
||||
@ -3612,28 +3628,48 @@ let no_dyn_yet loc ~into t extra =
|
||||
"%s does not cross into %s yet%s"
|
||||
(tyname loc t) (if into then "dyn" else "a written type") extra
|
||||
|
||||
(* M2 item 3: a typed container crossing into dyn as a view. The element set
|
||||
is exactly the unboxable scalars — i64, f64, bool — and that is not a smaller
|
||||
version of the same cut for the same reason: every other element type
|
||||
would need [box] to run on IT too, and a string element's dyn form is a
|
||||
pointer into the collector's heap, while a typed container's storage is
|
||||
arena or stack memory the collector never scans. Writing that pointer
|
||||
into memory nobody roots is a live reference the collector could free out
|
||||
from under — the hazard runtime/flan_dyn.h's view section states at
|
||||
length — and i64/f64/bool carry no pointer, so a view restricted to them
|
||||
cannot manufacture it. It is a compile-time refusal here rather than a
|
||||
run-time one because the element type is exactly what the checker already
|
||||
knows at the crossing. The FLAN_VIEW_* constants are runtime/flan_dyn.h's;
|
||||
this is the compiler's one copy of the same table. *)
|
||||
let view_elem (t : Types.t) : int64 option =
|
||||
match t with
|
||||
| Types.Int Types.I64 -> Some 0L (* FLAN_VIEW_I64 *)
|
||||
| Types.Float Types.F64 -> Some 1L (* FLAN_VIEW_F64 *)
|
||||
| Types.Bool -> Some 2L (* FLAN_VIEW_BOOL *)
|
||||
| _ -> None
|
||||
|
||||
let view_elem_lit loc (k : int64) =
|
||||
mk loc (Types.Int Types.I32) (Tast.Int (k, Types.I32))
|
||||
(* A typed container crossing into dyn is a view, and the runtime needs to
|
||||
know what one element is: its descriptor, a prefix code runtime/flan_dyn.c
|
||||
documents beside [desc_lay] and reads offsets out of by C's layout rule.
|
||||
Every number, bool, str, struct of those, and fixed array, slice or Vec of
|
||||
those can be described. [Error t] names the first type inside that cannot:
|
||||
a dyn, a pointer, a function, an Option, a map, an enum or a data type.
|
||||
None of those is refused for want of a descriptor letter — each is one a
|
||||
dyn value cannot be read out of or written into without a meaning
|
||||
nobody has decided. A str is read as a copy and never written, since a
|
||||
dyn text is a collector pointer and typed storage is never scanned; a
|
||||
[const] slice is refused because a dyn view can be written through. *)
|
||||
let rec view_desc (t : Types.t) : (string, Types.t) result =
|
||||
let ( let* ) = Result.bind in
|
||||
match t with
|
||||
| Types.Int k ->
|
||||
Ok (match k with
|
||||
| Types.I8 -> "b" | Types.U8 -> "B" | Types.I16 -> "h" | Types.U16 -> "H"
|
||||
| Types.I32 -> "i" | Types.U32 -> "I" | Types.I64 -> "l" | Types.U64 -> "L")
|
||||
| Types.Float Types.F32 -> Ok "f"
|
||||
| Types.Float Types.F64 -> Ok "d"
|
||||
| Types.Bool -> Ok "?"
|
||||
| Types.String -> Ok "t"
|
||||
| Types.Array (n, e) ->
|
||||
let* d = view_desc e in
|
||||
Ok (Printf.sprintf "a%Ld;%s" n d)
|
||||
| Types.Slice (Types.Mut, e) -> let* d = view_desc e in Ok ("s" ^ d)
|
||||
| Types.Vec e -> let* d = view_desc e in Ok ("v" ^ d)
|
||||
| Types.Named n ->
|
||||
(match Hashtbl.find_opt !view_structs n with
|
||||
| None -> Error t
|
||||
| Some st ->
|
||||
let* fs =
|
||||
List.fold_left
|
||||
(fun acc (fl : Tast.field) ->
|
||||
let* acc = acc in
|
||||
let* d = view_desc fl.Tast.fty in
|
||||
Ok ((fl.Tast.fname ^ ";" ^ d) :: acc))
|
||||
(Ok []) st.Tast.fields
|
||||
in
|
||||
Ok ("{" ^ n ^ ";" ^ String.concat "" (List.rev fs) ^ "}"))
|
||||
| _ -> Error t
|
||||
|
||||
(* A fix is spelled in the syntax of the file the mistake is in: the checker
|
||||
sees one AST for both, so the location's file is the only thing left that
|
||||
@ -3711,99 +3747,48 @@ let view_refusal kind loc (e : Tast.expr) reason =
|
||||
Loc.failk kind loc "%s, and a dyn value is wanted here. %s. %s" subject
|
||||
reason fix
|
||||
|
||||
let view_not_yet loc (e : Tast.expr) (elem : Types.t) =
|
||||
let view_not_yet loc (e : Tast.expr) (inner : Types.t) =
|
||||
view_refusal "check/dyn-not-yet" loc e
|
||||
(Printf.sprintf
|
||||
"A dyn value can see into a typed container only when its elements \
|
||||
are i64, f64 or bool, and these are %s"
|
||||
(tyname loc elem))
|
||||
"A dyn value sees into numbers, bools, str and structs, and arrays, \
|
||||
slices and Vecs of those; a %s is none of these"
|
||||
(tyname loc inner))
|
||||
|
||||
(* M2 item 3's second guard, added on review: a view's descriptor holds an
|
||||
address into the container's own storage, chased fresh on every
|
||||
operation, which is what makes a Vec's growth safe — but it is also what
|
||||
makes a *dangling* container's storage a live hazard nothing catches
|
||||
until somebody reads through the view. A view returned from the function
|
||||
whose frame the Vec lived in, stashed in a global and read after that
|
||||
frame is gone, or left behind when a condition transfer unwinds it, are
|
||||
all stack-use-after-return once box stopped refusing containers outright
|
||||
— reachable now for the first time, not a pre-existing hole this lane
|
||||
merely inherited.
|
||||
|
||||
On the dynamic side Flan aims where Clojure and Common Lisp are: holding
|
||||
a value should not hand you garbage. Treating a view as a bare pointer and
|
||||
calling the lifetime the programmer's problem is the Odin answer, and
|
||||
neither Odin nor C stops it — this guard is the trade going the other way,
|
||||
refused rather than merely documented.
|
||||
|
||||
What it is NOT is a proof. runtime/flan_dyn.h states the actual property:
|
||||
the view is exactly as stale-safe as the thing it is a view of, no more
|
||||
and no less. This guard narrows what a view can be taken of; it does not
|
||||
make the underlying storage outlive anything. A global [[T]] slice whose
|
||||
data was cut from a frame that has since returned still passes here, and
|
||||
reading through the view then reads a dead frame. So this is a guard that
|
||||
closes the routes the checker can see, not a guarantee that a dyn value
|
||||
never dangles.
|
||||
|
||||
[permanent_root] asks whether an expression's own address — the one a
|
||||
view's pointer will chase — is guaranteed to outlive every frame, which is
|
||||
true of exactly one thing at this milestone: a global. A field of a
|
||||
permanent value is permanent at the same fixed offset from it, and so is
|
||||
an element of a permanent *array* — both are still inside the permanent
|
||||
value's own storage. An element of a permanent *slice* is not: a slice is
|
||||
ptr+len, so a global [[T]] holds only the two words, and the storage they
|
||||
point at can be a frame that has already gone. The [At] arm below is where
|
||||
that distinction is made, and it is made per index rather than once: an
|
||||
[(at g i j)] is a single node carrying the whole index list, so the arm
|
||||
steps the list the way [indexed] does and an array level at every step is
|
||||
what it demands. Reading only the target's type would settle level zero
|
||||
and let a slice at any later level through — which it did, and the
|
||||
accepted program printed a returned frame's contents. A slice built directly from
|
||||
[(slice T lo hi)] inherits the
|
||||
permanence of the [T] it was cut from — unwrapped here because that is
|
||||
the one shape still carrying the trace back to it; once a slice has been
|
||||
bound to a name the trace is gone and it is refused; the spelling that
|
||||
keeps it is to view the slice expression directly, the way this file's
|
||||
own survey program does.
|
||||
|
||||
Everything else — a local, a parameter, a temporary, anything reached
|
||||
through a [Ptr] — answers false. A [Ptr] is refused rather than trusted
|
||||
because a heap-allocated block and a frame slot are the same type: a
|
||||
[(Ptr (Vec i64))] taken from a heap allocation would be sound to view, but
|
||||
the same type is what [(addr some-local)] answers too, and the checker
|
||||
cannot tell the two apart. Admitting one admits the other, which is the
|
||||
whole hazard this guard exists to close — so until a Flan type exists
|
||||
that says "durably heap-owned" and a [Ptr] does not, a container reached
|
||||
through one is refused rather than guessed at. An arena-held container is
|
||||
not a separate case: an arena changes where a Vec's *elements* live, never
|
||||
where its own header — the value a name is bound to — lives, so a Vec
|
||||
grown from an arena is exactly as permanent as the binding that holds it,
|
||||
already covered by the cases above. *)
|
||||
let rec permanent_root (e : Tast.expr) : bool =
|
||||
(* Whether a view's storage is the current function's own frame, which is
|
||||
what the runtime's dev check needs to be told: it then records this
|
||||
activation and traps if the view is used after the call returns. A local,
|
||||
a parameter (copied into the frame, an array parameter too), a field or
|
||||
an array element of one, a slice cut directly from a local array, and a
|
||||
temporary [box] has bound to a slot of its own are all the frame's. A
|
||||
slice's data, and anything reached through a [Ptr] or a global, is not:
|
||||
there the runtime looks the address up in the allocation registry instead,
|
||||
and storage the registry does not know — a global, or a caller's local
|
||||
seen through a slice parameter — is not checked. *)
|
||||
let rec frame_root (e : Tast.expr) : bool =
|
||||
let rec all_array ty = function
|
||||
| [] -> true
|
||||
| _ :: rest ->
|
||||
(match ty with Types.Array (_, elem) -> all_array elem rest | _ -> false)
|
||||
in
|
||||
match e.Tast.e with
|
||||
| Tast.Global _ -> true
|
||||
| Tast.Field (target, _) -> permanent_root target
|
||||
| Tast.Local _ -> (match e.Tast.ty with Types.Slice _ -> false | _ -> true)
|
||||
| Tast.Field (target, _) ->
|
||||
(match target.Tast.ty with Types.Named _ -> frame_root target | _ -> false)
|
||||
| Tast.Prim (Tast.At, target :: idx) ->
|
||||
(* [(at g i j)] is ONE node carrying every index, so the target's own type
|
||||
is only level zero and asking about it alone misses a slice reached at
|
||||
any later level. Step the list the way [indexed] does — that walk is
|
||||
the definition of which levels exist — and require every level stepped
|
||||
to be an array. *)
|
||||
let rec all_array ty = function
|
||||
| [] -> true
|
||||
| _ :: rest ->
|
||||
(match ty with
|
||||
| Types.Array (_, elem) -> all_array elem rest
|
||||
| _ -> false)
|
||||
in
|
||||
all_array target.Tast.ty idx && permanent_root target
|
||||
| Tast.Prim (Tast.Slice, [ target; _; _ ]) -> permanent_root target
|
||||
all_array target.Tast.ty idx && frame_root target
|
||||
| Tast.Prim (Tast.Slice, [ target; _; _ ]) ->
|
||||
(match target.Tast.ty with Types.Array _ -> frame_root target | _ -> false)
|
||||
| _ -> false
|
||||
|
||||
let view_not_permanent loc (e : Tast.expr) =
|
||||
view_refusal "check/dyn-view-lifetime" loc e
|
||||
"A dyn value can see into a typed container only when it is a global: a \
|
||||
local, a parameter or a temporary can be gone while the dyn value still \
|
||||
points at it"
|
||||
(* Whether [e] names storage that already has an address, so a view can
|
||||
point at it; anything else is a temporary [box] binds to a slot first. *)
|
||||
let rec view_place (e : Tast.expr) : bool =
|
||||
match e.Tast.e with
|
||||
| Tast.Local _ | Tast.Global _ | Tast.Deref _ -> true
|
||||
| Tast.Field (target, _) ->
|
||||
(match target.Tast.ty with Types.Named _ -> view_place target | _ -> true)
|
||||
| Tast.Prim (Tast.At, _ :: _ :: _) -> true
|
||||
| _ -> false
|
||||
|
||||
(* A value handed out of [f] that points into [f]'s own frame: returned (the
|
||||
last form's tails, or a [return]), or stored into a global or a field or
|
||||
@ -4062,7 +4047,7 @@ let refuse_frame_escapes (f : Tast.fn) =
|
||||
if returns then
|
||||
match List.rev f.Tast.body with x :: _ -> tails x | [] -> ()
|
||||
|
||||
let box loc (e : Tast.expr) : Tast.expr =
|
||||
let box ?ctx loc (e : Tast.expr) : Tast.expr =
|
||||
let dyn sym args = rt loc Types.Dyn sym args in
|
||||
match e.Tast.ty with
|
||||
| Types.Dyn -> e
|
||||
@ -4084,28 +4069,70 @@ let box loc (e : Tast.expr) : Tast.expr =
|
||||
Loc.failk "check/dyn-unit" loc
|
||||
"() does not box into dyn. The absent dyn value is nil — write nil"
|
||||
| Types.Never -> e
|
||||
(* A view, not a copy: the box holds one word naming where the elements
|
||||
live and what one of them is, and every read or write goes straight
|
||||
through to the container's own storage — see runtime/flan_dyn.h's
|
||||
view section for the whole of the argument, including why the
|
||||
descriptor points AT the container (a Vec's own header address)
|
||||
rather than snapshotting its ptr+len. That is what makes a push
|
||||
through the view safe even though a Vec can grow and move: there is
|
||||
no snapshot for the growth to invalidate. A slice and a fixed array
|
||||
cannot grow, so a snapshot taken once at the crossing is sound for
|
||||
both, and they share [flan_dyn_view_flat]. *)
|
||||
(* The element check runs before the lifetime one in all three arms, and
|
||||
the order is load-bearing rather than incidental: the lifetime message
|
||||
says a global can be seen into, and for an element type no view can
|
||||
carry — a string, an i32 — a global is refused too, so the wrong order
|
||||
hands the programmer a reason that is false for their case. Whichever
|
||||
refusal is unconditional wins. *)
|
||||
| Types.Vec elem ->
|
||||
(match view_elem elem with
|
||||
| None -> view_not_yet loc e elem
|
||||
| Some k ->
|
||||
if not (permanent_root e) then view_not_permanent loc e
|
||||
else dyn "flan_dyn_view_vec" [ e; view_elem_lit loc k ])
|
||||
(* A view, not a copy: the box holds a small record naming where the
|
||||
storage is and what one element is (its descriptor, [view_desc]), and
|
||||
every read or write goes straight through to the container's own
|
||||
storage — see runtime/flan_dyn.h's view section. A Vec's view points AT
|
||||
the Vec's header and reads its pointer and length live, so a push
|
||||
through the view cannot go stale; a slice and a fixed array cannot grow,
|
||||
so a snapshot taken at the crossing is sound for both. A struct's view
|
||||
is a map-like value: (get p :x), (set (get p :x) v), (put p :x v).
|
||||
|
||||
A container, array or struct is handed over by address. One that is not
|
||||
a place already — a call's result — is bound to a slot of its own
|
||||
first, so the view points at storage that lives as long as the frame
|
||||
rather than at a temporary the next statement reuses. [frame_root] then
|
||||
says whether the storage is this frame's, for the runtime's dev check. *)
|
||||
| Types.Vec _ | Types.Array _ | Types.Named _ | Types.Slice (Types.Mut, _)
|
||||
when (match e.Tast.ty with
|
||||
| Types.Named n -> Hashtbl.mem !view_structs n
|
||||
| _ -> true) ->
|
||||
let desc_of t =
|
||||
match view_desc t with
|
||||
| Ok d -> mk loc Types.String (Tast.Str d)
|
||||
| Error inner -> view_not_yet loc e inner
|
||||
in
|
||||
let i32 n = mk loc (Types.Int Types.I32) (Tast.Int (n, Types.I32)) in
|
||||
let i64 n = mk loc dyn_i64 (Tast.Int (n, Types.I64)) in
|
||||
let bind, e =
|
||||
match ctx, e.Tast.ty with
|
||||
| Some ctx, (Types.Vec _ | Types.Array _ | Types.Named _)
|
||||
when not (view_place e) ->
|
||||
let sl = fresh_slot ctx e.Tast.ty in
|
||||
Some (sl, e), mk loc e.Tast.ty (Tast.Local sl)
|
||||
| _ -> None, e
|
||||
in
|
||||
(match !view_global_init with
|
||||
| Some (g, kind) when frame_root e ->
|
||||
let fln = fln_source loc in
|
||||
let ty = tyname loc e.Tast.ty in
|
||||
Loc.failk "check/dyn-view-lifetime" loc
|
||||
"%s is a dyn global, and its initialiser builds a %s that is gone \
|
||||
once the initialiser returns, so a dyn view of it would outlive \
|
||||
it. Give %s its type, as in %s"
|
||||
g ty g
|
||||
(let form =
|
||||
match kind with Ast.Every -> "def" | Ast.Once -> "defonce" in
|
||||
if fln then
|
||||
Printf.sprintf "%s %s: %s = ..."
|
||||
(match kind with Ast.Every -> "def" | Ast.Once -> "once") g ty
|
||||
else Printf.sprintf "(%s %s %s ...)" form g ty)
|
||||
| _ -> ());
|
||||
let here = i32 (if frame_root e then 1L else 0L) in
|
||||
let view =
|
||||
match e.Tast.ty with
|
||||
| Types.Slice (_, elem) ->
|
||||
dyn "flan_dyn_view_slice" [ e; desc_of elem; here ]
|
||||
| Types.Vec elem ->
|
||||
dyn "flan_dyn_view_at" [ addr_of loc e; i64 0L; desc_of elem; i32 1L; here ]
|
||||
| Types.Array (n, elem) ->
|
||||
dyn "flan_dyn_view_at" [ addr_of loc e; i64 n; desc_of elem; i32 0L; here ]
|
||||
| t ->
|
||||
dyn "flan_dyn_view_at" [ addr_of loc e; i64 0L; desc_of t; i32 2L; here ]
|
||||
in
|
||||
(match bind with
|
||||
| None -> view
|
||||
| Some b -> mk loc Types.Dyn (Tast.Let ([ b ], [ view ])))
|
||||
(* A dyn view is written through by (set (at d i) x), and nothing on the
|
||||
dyn side can tell a read-only one apart, so a [[const T]] does not
|
||||
cross. *)
|
||||
@ -4115,20 +4142,6 @@ let box loc (e : Tast.expr) : Tast.expr =
|
||||
[const %s] can only be read. A dyn view is taken of the writable \
|
||||
storage it came from"
|
||||
(tyname loc e.Tast.ty) (tyname loc elem)
|
||||
| Types.Slice (Types.Mut, elem) ->
|
||||
(match view_elem elem with
|
||||
| None -> view_not_yet loc e elem
|
||||
| Some k ->
|
||||
if not (permanent_root e) then view_not_permanent loc e
|
||||
else dyn "flan_dyn_view_flat" [ e; view_elem_lit loc k ])
|
||||
| Types.Array (n, elem) ->
|
||||
(match view_elem elem with
|
||||
| None -> view_not_yet loc e elem
|
||||
| Some k ->
|
||||
if not (permanent_root e) then view_not_permanent loc e
|
||||
else
|
||||
dyn "flan_dyn_view_flat"
|
||||
[ e; mk loc dyn_i64 (Tast.Int (n, Types.I64)); view_elem_lit loc k ])
|
||||
(* No view for a map yet, and the suggestion is the *literal* rather than a
|
||||
constructor call: there is no [(map-new dyn)] — [map_new_types] wants a
|
||||
key and a value, and [map_type] refuses dyn as a key — so naming one
|
||||
@ -4144,7 +4157,7 @@ let box loc (e : Tast.expr) : Tast.expr =
|
||||
mis-lowering. *)
|
||||
| Types.Named _ | Types.Enum _ | Types.Option _ | Types.Ptr _
|
||||
| Types.Alloc | Types.Fn _ | Types.CFn _ | Types.Var _ | Types.Len _
|
||||
| Types.LArray _ ->
|
||||
| Types.LArray _ | Types.Vec _ | Types.Array _ | Types.Slice _ ->
|
||||
no_dyn_yet loc ~into:true e.Tast.ty ""
|
||||
|
||||
(* Every dyn an expectation opened ([expect]'s dyn arm), by the node that
|
||||
@ -4549,7 +4562,7 @@ let expect ctx loc ~want (got : Tast.expr) =
|
||||
match w, got.Tast.ty with
|
||||
| Types.Dyn, Types.Dyn -> got
|
||||
| Types.Dyn, Types.Option t -> box_option ctx loc t got
|
||||
| Types.Dyn, _ -> box loc got
|
||||
| Types.Dyn, _ -> box ~ctx loc got
|
||||
| Types.Option t, Types.Dyn when not (is_nil_lit got) ->
|
||||
let opened = unbox_option ctx loc t got in
|
||||
Opened.replace opened_by_want opened got;
|
||||
@ -16458,7 +16471,11 @@ let check_global env (d : Ast.decl) : Tast.global option =
|
||||
{ Tast.e = Tast.Uninit ty; ty; loc = d.Ast.dloc }
|
||||
| Ast.Init v ->
|
||||
let c = ctx () in
|
||||
let v = check c ~want:ty v in
|
||||
let v =
|
||||
view_global_init := Some (n, kind);
|
||||
Fun.protect ~finally:(fun () -> view_global_init := None)
|
||||
(fun () -> check c ~want:ty v)
|
||||
in
|
||||
if Tast.const_init v && not lift_always then v
|
||||
else lift_ginit c d.Ast.dloc n ty v
|
||||
(* [settle_defvars] turned every one of these into a [Zeroed] or an
|
||||
@ -17768,7 +17785,7 @@ let memory_class (sym : string) (args : Tast.expr list) =
|
||||
| "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_slice" | "flan_dyn_view_at" ->
|
||||
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"
|
||||
| "flan_dyn_from_i64" when (match args with [ x ] -> int_may_spill x | _ -> true) ->
|
||||
|
||||
25
lib/emit.ml
25
lib/emit.ml
@ -250,7 +250,8 @@ module Rt = struct
|
||||
before the call. Null until the first. *)
|
||||
let flanframe =
|
||||
{ sname = "flanframe";
|
||||
fields = [ "prev", Ptr; "info", Ptr; "slots", Ptr; "at", Ptr ] }
|
||||
fields = [ "prev", Ptr; "info", Ptr; "slots", Ptr; "at", Ptr;
|
||||
"serial", I64 ] }
|
||||
|
||||
let align_up n a = (n + a - 1) / a * a
|
||||
|
||||
@ -4045,14 +4046,9 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) =
|
||||
Passing the header by value here would hand the runtime a
|
||||
copy to grow and leave the caller's untouched. *)
|
||||
| Types.Vec _ | Types.Map _ -> [ "ptr " ^ addr f a ]
|
||||
(* A fixed array crossing into a dyn view (M2 item 3) needs its
|
||||
address for the same reason a Vec or a Map does here — the
|
||||
view reads through it live, and passing the value would hand
|
||||
the runtime a copy nothing writes back through. Every other
|
||||
[Rt] caller of an array argument is [flan_dyn_view_flat],
|
||||
which takes the address and never mutates the array's shape,
|
||||
so this is not the move-only argument Vec/Map's comment is
|
||||
about — it is simply the only way to view rather than copy. *)
|
||||
(* A fixed array crosses by address, as a Vec or a Map does: a
|
||||
runtime entry point that takes one reads it in place. (A dyn
|
||||
view is handed an explicit [addr_of] by check.ml's [box].) *)
|
||||
| Types.Array _ -> [ "ptr " ^ addr f a ]
|
||||
| t -> [ ll t ^ " " ^ value f a ])
|
||||
args)
|
||||
@ -4478,6 +4474,13 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
|
||||
"%%frame.a = getelementptr inbounds %%flanframe, ptr %%frame, i32 0, i32 %d"
|
||||
(Rt.index Rt.flanframe "at");
|
||||
"store ptr null, ptr %frame.a";
|
||||
(* Zeroed at every push: a dyn view of a local claims a number here
|
||||
(runtime/flan_dev.c, [flan_dev_frame_claim]), and the next call
|
||||
to land at this address must not inherit it. *)
|
||||
Printf.sprintf
|
||||
"%%frame.n = getelementptr inbounds %%flanframe, ptr %%frame, i32 0, i32 %d"
|
||||
(Rt.index Rt.flanframe "serial");
|
||||
"store i64 0, ptr %frame.n";
|
||||
"store ptr %frame, ptr @flan_frame_head" ];
|
||||
f.frame <- Some prev;
|
||||
(* The parameters are bound before the body starts, so they are recorded
|
||||
@ -5059,8 +5062,8 @@ declare i32 @flan_dyn_cast_kind(i64, ptr, i64, ptr, i64, i32)
|
||||
declare i32 @flan_dyn_is_nil(i64)
|
||||
declare i64 @flan_dyn_need_not_nil(i64)
|
||||
declare i32 @flan_dyn_truthy(i64)
|
||||
declare i64 @flan_dyn_view_vec(ptr, i32)
|
||||
declare i64 @flan_dyn_view_flat(ptr, i64, i32)
|
||||
declare i64 @flan_dyn_view_slice(ptr, i64, ptr, i64, i32)
|
||||
declare i64 @flan_dyn_view_at(ptr, i64, ptr, i64, i32, i32)
|
||||
declare void @flan_dyn_root_push(ptr)
|
||||
declare void @flan_dyn_root_push_desc(ptr, ptr)
|
||||
declare ptr @flan_dyn_env_new(i64, ptr)
|
||||
|
||||
15
lib/x86.ml
15
lib/x86.ml
@ -1602,12 +1602,9 @@ let classify_c (l : loc) (t : Types.t) =
|
||||
| Types.String | Types.Slice _ -> [ Aint (l, Types.Ptr (Types.Mut, Types.Unit)); Alen l ]
|
||||
| Types.Unit | Types.Never -> []
|
||||
| Types.Vec _ | Types.Map _ -> [ Aptr l ]
|
||||
(* A fixed array crossing into a dyn view (M2 item 3) needs its address for
|
||||
the same reason: the view reads through it live and a copy would leave
|
||||
the caller's own array unseen by later writes through the view. Every
|
||||
[Rt] call that takes an array argument is [flan_dyn_view_flat], which
|
||||
never mutates the array's shape, so this is not the move-only case
|
||||
Vec/Map is. *)
|
||||
(* A fixed array crosses by address, as a Vec or a Map does: a runtime
|
||||
entry point that takes one reads it in place. (A dyn view is handed an
|
||||
explicit [addr_of] by check.ml's [box].) *)
|
||||
| Types.Array _ -> [ Aptr l ]
|
||||
| _ when is_agg t ->
|
||||
unsupported "aggregate %s across the C boundary" (Types.to_string t)
|
||||
@ -4216,6 +4213,12 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
|
||||
store_int f.b
|
||||
~src:rax ~mm:(Frame (fr + Emit.Rt.field Emit.Rt.flanframe "at"))
|
||||
~size:8;
|
||||
(* Zeroed at every push, as emit.ml's is: a dyn view of a local claims a
|
||||
number here, and the next call to land at this address must not
|
||||
inherit it. *)
|
||||
store_int f.b
|
||||
~src:rax ~mm:(Frame (fr + Emit.Rt.field Emit.Rt.flanframe "serial"))
|
||||
~size:8;
|
||||
lea f.b ~dst:rax ~mm:(Frame fr);
|
||||
store_int f.b ~src:rax ~mm:(lmem f head ~scratch:r11) ~size:8;
|
||||
(* The parameters are bound before the body starts, so they are recorded
|
||||
|
||||
@ -1111,6 +1111,11 @@ typedef struct flan_frame {
|
||||
* from that call since — which is why [flan_dev_frame_at_loc] is read for
|
||||
* the outer frames only. */
|
||||
const char *at;
|
||||
/* Zero at the push, and given a number from [flan_dev_frame_claim] the
|
||||
* first time a dyn view is taken of this frame's storage. It is what tells
|
||||
* this activation from the next call to land at the same address, which a
|
||||
* view kept past the return would otherwise take for its own. */
|
||||
uint64_t serial;
|
||||
} flan_frame;
|
||||
|
||||
/* The compiler names this symbol directly. A redefinition module reaches it
|
||||
@ -1134,6 +1139,35 @@ void flan_dev_frames_reset(void) { flan_frame_head = NULL; }
|
||||
void *flan_dev_frames_mark(void) { return flan_frame_head; }
|
||||
void flan_dev_frames_restore(void *head) { flan_frame_head = (flan_frame *)head; }
|
||||
|
||||
/* A dyn view of a local (flan_dyn.c, [view_make]): the frame's serial, made
|
||||
* on first use, and the function's name for the sentence a stale view prints
|
||||
* — copied out now, because by then the frame is dead stack. */
|
||||
static uint64_t flan_frame_serials;
|
||||
|
||||
uint64_t flan_dev_frame_claim(void *frame, const char **name,
|
||||
int64_t *namelen) {
|
||||
flan_frame *f = frame;
|
||||
*name = "?";
|
||||
*namelen = 1;
|
||||
if (f == NULL) return 0;
|
||||
if (f->info != NULL) {
|
||||
*name = f->info->name;
|
||||
*namelen = f->info->namelen;
|
||||
}
|
||||
if (f->serial == 0) f->serial = ++flan_frame_serials;
|
||||
return f->serial;
|
||||
}
|
||||
|
||||
/* Still on the chain, and still the same activation. The walk is from the
|
||||
* innermost frame out and is the depth of the stack at worst; dead stack
|
||||
* keeps its old bytes, so the serial alone cannot say the frame is gone. */
|
||||
int32_t flan_dev_frame_alive(const void *frame, uint64_t serial) {
|
||||
const flan_frame *f;
|
||||
for (f = flan_frame_head; f != NULL; f = f->prev)
|
||||
if (f == frame) return f->serial == serial;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* [i] counts from the innermost. NULL past the end, which is how a caller
|
||||
* learns the depth without a second walk. */
|
||||
void *flan_dev_frame_at(int32_t i) {
|
||||
@ -1775,6 +1809,50 @@ int32_t flan_dev_reg_live(const void *p) {
|
||||
return (int32_t)(e != NULL && e->died == 0 ? 1 : 0);
|
||||
}
|
||||
|
||||
/* A dyn view's storage (flan_dyn.c, [view_make]): the smallest live block
|
||||
* holding [p], by base and sequence, so the view can ask later whether that
|
||||
* same note is still alive. The smallest, because an arena's own region can
|
||||
* be a block too, and it outlives the allocation inside it that a free-all
|
||||
* ends. 0 when no live block holds [p] — a global, a frame, C memory — and
|
||||
* always in a release build. A scan, once per crossing, in a dev build. */
|
||||
int32_t flan_dev_reg_claim(const void *p, uintptr_t *base, int64_t *seq,
|
||||
const char **type, int64_t *typelen) {
|
||||
uintptr_t a = (uintptr_t)p;
|
||||
flan_reg_entry *best = NULL;
|
||||
int64_t i;
|
||||
if (!flan_reg_on || a == 0) return 0;
|
||||
for (i = 0; i < FLAN_REG_CAP; i++) {
|
||||
flan_reg_entry *e = &flan_reg[i];
|
||||
if (e->base == 0 || e->died != 0) continue;
|
||||
if (a < e->base || a >= e->base + (uintptr_t)e->bytes) continue;
|
||||
if (best == NULL || e->bytes < best->bytes) best = e;
|
||||
}
|
||||
if (best == NULL) return 0;
|
||||
*base = best->base;
|
||||
*seq = best->seq;
|
||||
*type = best->type;
|
||||
*typelen = best->typelen;
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Is the note [flan_dev_reg_claim] found still there and alive? The probe a
|
||||
* free takes, keyed on the base: an entry is dropped only when its address is
|
||||
* handed out again, and the new note has a new sequence. A compaction moves
|
||||
* entries but keeps both. */
|
||||
int32_t flan_dev_reg_alive(uintptr_t base, int64_t seq) {
|
||||
size_t s;
|
||||
int64_t probe;
|
||||
if (!flan_reg_on || base == 0) return 1;
|
||||
s = flan_reg_slot(base);
|
||||
for (probe = 0; probe < FLAN_REG_CAP; probe++) {
|
||||
size_t j = (s + (size_t)probe) & (FLAN_REG_CAP - 1);
|
||||
if (flan_reg[j].base == 0) return 0;
|
||||
if (flan_reg[j].base != base || flan_reg[j].seq != seq) continue;
|
||||
return flan_reg[j].died == 0;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* What was at this address, in words, for the branch that may not follow it.
|
||||
* Emitted straight into the result buffer rather than returned: the caller is
|
||||
* a render thunk, which has no allocator, and every other piece of a rendering
|
||||
|
||||
@ -355,15 +355,17 @@ typedef struct flan_obj {
|
||||
entries and [cap] counting entries too. Sharing the arm is what lets the
|
||||
marker and the sweep treat the two kinds with one load and a doubled
|
||||
count rather than a second field to keep in step. */
|
||||
/* OBJ_VIEW: a typed container's elements, native words this file did not
|
||||
allocate and does not own. [is_vec] set means [base] is a
|
||||
[flan_dyn_vec_hdr *] and [len] here is unused — the live length is
|
||||
read from the header on every operation, which is the whole of why a
|
||||
Vec growing through the view cannot go stale. [is_vec] clear means
|
||||
[base] is the first element's address and [len] is the snapshot taken
|
||||
at the crossing, for a slice or a fixed array, neither of which moves.
|
||||
[elem] is one of FLAN_VIEW_I64/F64/BOOL. */
|
||||
struct { void *base; int64_t len; int32_t elem; int32_t is_vec; } view;
|
||||
/* OBJ_VIEW: typed storage this file did not allocate and does not own.
|
||||
The shape is in the header's [gen], which only a class instance
|
||||
otherwise uses: VIEW_VEC means [base] is a [flan_dyn_vec_hdr *] whose
|
||||
length is read live, which is why a Vec growing through the view
|
||||
cannot go stale; VIEW_FLAT means [base] is the first element and the
|
||||
header's [len] the count taken at the crossing, for a slice or a fixed
|
||||
array; VIEW_STRUCT means [base] is one struct. [desc] is the element's
|
||||
descriptor, or the struct's. [nul] is always NULL and sits where a
|
||||
map's [klass] does, so a struct view answers "no class" to every class
|
||||
question without a branch. A [view_guard] trails the header. */
|
||||
struct { void *base; const uint8_t *desc; void *nul; } view;
|
||||
/* OBJ_ENV: the descriptor the environment's bytes are marked through,
|
||||
or NULL when it holds nothing the collector follows. [len] is the
|
||||
byte count, and the bytes trail the header as a text's do. */
|
||||
@ -520,7 +522,9 @@ int32_t flan_dyn_tag(flan_dyn v) {
|
||||
side there is nothing to tell them apart by, which is the point of a
|
||||
view being indistinguishable rather than a fourth kind of vec. */
|
||||
case OBJ_VEC: return FLAN_DYN_TAG_VEC;
|
||||
case OBJ_VIEW: return FLAN_DYN_TAG_VEC;
|
||||
/* ...and a struct's view answers a map's, [gen] being its shape
|
||||
(VIEW_STRUCT, below). */
|
||||
case OBJ_VIEW: return o->gen == 2 ? FLAN_DYN_TAG_MAP : FLAN_DYN_TAG_VEC;
|
||||
case OBJ_MAP: return FLAN_DYN_TAG_MAP;
|
||||
default: return FLAN_DYN_TAG_INT;
|
||||
}
|
||||
@ -631,9 +635,11 @@ static double dyn_num_value(flan_dyn v);
|
||||
* they are defined, alongside the container operations below */
|
||||
static int64_t view_len(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
flan_obj *o);
|
||||
static void *view_base(flan_obj *o);
|
||||
static flan_dyn view_box(int32_t elem, const uint8_t *p);
|
||||
static int64_t view_elem_size(int32_t elem);
|
||||
/* A struct view's fields, for the map arms of the printers. */
|
||||
static int64_t view_nfields(flan_obj *o);
|
||||
static flan_dyn view_field_key(flan_obj *o, int64_t i);
|
||||
static flan_dyn view_field_val(flan_obj *o, int64_t i);
|
||||
static void view_struct_name(flan_obj *o, const char **name, int64_t *len);
|
||||
|
||||
/* forward: needed by [dyn_equal] below, defined alongside the view helpers
|
||||
* further down — a length and an element reader that answer correctly
|
||||
@ -687,6 +693,24 @@ static void render(dyn_sink w, flan_dyn v, int depth, int nested) {
|
||||
case FLAN_DYN_TAG_MAP: {
|
||||
flan_obj *o = dyn_obj(v);
|
||||
int64_t i;
|
||||
/* A struct's view prints as the class instance it most resembles: its
|
||||
* type's name as the shape tag, then its fields in declaration order. */
|
||||
if (o->kind == OBJ_VIEW) {
|
||||
const char *nm;
|
||||
int64_t nl, n = view_nfields(o);
|
||||
view_struct_name(o, &nm, &nl);
|
||||
emit(w, "#");
|
||||
emit_n(w, (const uint8_t *)nm, nl);
|
||||
emit(w, "{");
|
||||
for (i = 0; i < n; i++) {
|
||||
if (i > 0) emit(w, " ");
|
||||
render(w, view_field_key(o, i), depth + 1, 1);
|
||||
emit(w, " ");
|
||||
render(w, view_field_val(o, i), depth + 1, 1);
|
||||
}
|
||||
emit(w, "}");
|
||||
return;
|
||||
}
|
||||
/* 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. */
|
||||
@ -706,17 +730,11 @@ static void render(dyn_sink w, flan_dyn v, int depth, int nested) {
|
||||
}
|
||||
default: {
|
||||
flan_obj *o = dyn_obj(v);
|
||||
int64_t i, n = o->kind == OBJ_VIEW ? view_len(NULL, 0, "print", o) : o->len;
|
||||
int64_t i, n = vecish_len(o);
|
||||
emit(w, "[");
|
||||
for (i = 0; i < n; i++) {
|
||||
if (i > 0) emit(w, " ");
|
||||
if (o->kind == OBJ_VIEW)
|
||||
render(w, view_box(o->u.view.elem,
|
||||
(const uint8_t *)view_base(o)
|
||||
+ i * view_elem_size(o->u.view.elem)),
|
||||
depth + 1, 1);
|
||||
else
|
||||
render(w, o->u.v.items[i], depth + 1, 1);
|
||||
render(w, vecish_at(o, i), depth + 1, 1);
|
||||
}
|
||||
emit(w, "]");
|
||||
return;
|
||||
@ -802,6 +820,27 @@ static void say_render(sayer *s, flan_dyn v, int depth) {
|
||||
flan_obj *o = dyn_obj(v);
|
||||
int64_t i;
|
||||
if (depth >= 2) { say_puts(s, "{...}"); return; }
|
||||
if (o->kind == OBJ_VIEW) {
|
||||
const char *nm;
|
||||
int64_t nl, n = view_nfields(o), j;
|
||||
view_struct_name(o, &nm, &nl);
|
||||
say_puts(s, "#");
|
||||
for (j = 0; j < nl && s->n < s->cap - 8; j++) {
|
||||
char c[2];
|
||||
c[0] = nm[j];
|
||||
c[1] = '\0';
|
||||
say_puts(s, c);
|
||||
}
|
||||
say_puts(s, "{");
|
||||
for (i = 0; i < n && s->n < s->cap - 8; i++) {
|
||||
if (i > 0) say_puts(s, " ");
|
||||
say_render(s, view_field_key(o, i), depth + 1);
|
||||
say_puts(s, " ");
|
||||
say_render(s, view_field_val(o, i), depth + 1);
|
||||
}
|
||||
say_puts(s, i == n ? "}" : i > 0 ? " ...}" : "...}");
|
||||
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. */
|
||||
@ -827,19 +866,12 @@ static void say_render(sayer *s, flan_dyn v, int depth) {
|
||||
}
|
||||
default: {
|
||||
flan_obj *o = dyn_obj(v);
|
||||
int64_t i, n = o->kind == OBJ_VIEW ? view_len(NULL, 0, "print", o) : o->len;
|
||||
int64_t i, n = vecish_len(o);
|
||||
if (depth >= 2) { say_puts(s, "[...]"); return; }
|
||||
say_puts(s, "[");
|
||||
for (i = 0; i < n && s->n < s->cap - 8; i++) {
|
||||
if (i > 0) say_puts(s, " ");
|
||||
if (o->kind == OBJ_VIEW)
|
||||
say_render(s,
|
||||
view_box(o->u.view.elem,
|
||||
(const uint8_t *)view_base(o)
|
||||
+ i * view_elem_size(o->u.view.elem)),
|
||||
depth + 1);
|
||||
else
|
||||
say_render(s, o->u.v.items[i], depth + 1);
|
||||
say_render(s, vecish_at(o, i), depth + 1);
|
||||
}
|
||||
say_puts(s, i == n ? "]" : i > 0 ? " ...]" : "...]");
|
||||
return;
|
||||
@ -2810,6 +2842,23 @@ static int dyn_equal(flan_dyn a, flan_dyn b, int depth) {
|
||||
int64_t i, j;
|
||||
if (x == y) return 1;
|
||||
if (depth >= EQ_DEPTH) return 0;
|
||||
/* A struct's view is equal to another view of the same struct type with
|
||||
equal fields, and to nothing else — the answer an instance gets beside
|
||||
a plain map, for the same reason: the type's name is its shape tag. */
|
||||
if (x->kind == OBJ_VIEW || y->kind == OBJ_VIEW) {
|
||||
const char *xn, *yn;
|
||||
int64_t xl, yl, n;
|
||||
if (x->kind != OBJ_VIEW || y->kind != OBJ_VIEW) return 0;
|
||||
view_struct_name(x, &xn, &xl);
|
||||
view_struct_name(y, &yn, &yl);
|
||||
if (xl != yl || memcmp(xn, yn, (size_t)xl) != 0) return 0;
|
||||
n = view_nfields(x);
|
||||
if (n != view_nfields(y)) return 0;
|
||||
for (i = 0; i < n; i++)
|
||||
if (!dyn_equal(view_field_val(x, i), view_field_val(y, i), depth + 1))
|
||||
return 0;
|
||||
return 1;
|
||||
}
|
||||
/* Two instances of one class built either side of a redefinition hold
|
||||
different key sets, and comparing those key sets would answer "not
|
||||
equal" about a difference the class no longer has. So both are brought
|
||||
@ -2860,14 +2909,273 @@ static inline int is_map(flan_dyn v) {
|
||||
|
||||
/* ── Typed containers as views ─────────────────────────────────────────
|
||||
*
|
||||
* Every entry point below already dispatches on [flan_dyn_tag], which does
|
||||
* not distinguish a view from a heap vec — see [flan_dyn_tag]'s switch — so
|
||||
* [flan_dyn_len], [flan_dyn_at], [flan_dyn_set_at], [flan_dyn_push] and the
|
||||
* printer each add one branch for [OBJ_VIEW] beside the existing [OBJ_VEC]
|
||||
* one. What follows is that branch's machinery. */
|
||||
* Every entry point below already dispatches on [flan_dyn_tag]. A view over
|
||||
* a Vec, a slice or a fixed array answers the vec tag and a view over a
|
||||
* struct answers the map tag, so [flan_dyn_len], [flan_dyn_at],
|
||||
* [flan_dyn_set_at], [flan_dyn_push], the map operations and the printers
|
||||
* each add one branch for [OBJ_VIEW]. What follows is that branch's
|
||||
* machinery.
|
||||
*
|
||||
* What one element is comes from a descriptor the compiler writes into
|
||||
* read-only data (lib/check.ml, [view_desc]), a prefix code:
|
||||
*
|
||||
* b B h H i I l L i8 u8 i16 u16 i32 u32 i64 u64
|
||||
* f d ? f32 f64 bool
|
||||
* t str (read as a copy; never written from here)
|
||||
* a<n>;T a fixed [n T]
|
||||
* sT a slice [T]
|
||||
* vT a (Vec T)
|
||||
* {Name;f1;T1f2;T2} a struct, its fields in declaration order
|
||||
*
|
||||
* Offsets are computed here by C's rule, the one Emit.lay spells: every
|
||||
* scalar aligned to its size, a struct to its strictest field and padded to
|
||||
* it, an array adding no padding of its own. test/programs/dyn-view-any.flan
|
||||
* reads back a struct whose fields sit at offsets only that rule gets right,
|
||||
* on both backends.
|
||||
*
|
||||
* A view never stores a collector pointer into typed storage: a read boxes
|
||||
* (or copies, for a str), and a write unboxes a number or a bool. That is
|
||||
* why a str element is read-only from here, and why an aggregate element is
|
||||
* written through its own view rather than replaced whole. */
|
||||
|
||||
static int64_t view_elem_size(int32_t elem) {
|
||||
return elem == FLAN_VIEW_BOOL ? 1 : 8;
|
||||
static int64_t desc_int(const uint8_t **p) {
|
||||
int64_t n = 0;
|
||||
while (**p >= '0' && **p <= '9') { n = n * 10 + (**p - '0'); (*p)++; }
|
||||
if (**p == ';') (*p)++;
|
||||
return n;
|
||||
}
|
||||
|
||||
/* Past a name and its ';'. */
|
||||
static const uint8_t *desc_name_end(const uint8_t *d) {
|
||||
while (*d != ';') d++;
|
||||
return d + 1;
|
||||
}
|
||||
|
||||
static const uint8_t *desc_skip(const uint8_t *d) {
|
||||
switch (*d) {
|
||||
case 'a': d++; desc_int(&d); return desc_skip(d);
|
||||
case 's': case 'v': return desc_skip(d + 1);
|
||||
case '{':
|
||||
d = desc_name_end(d + 1);
|
||||
while (*d != '}') d = desc_skip(desc_name_end(d));
|
||||
return d + 1;
|
||||
default: return d + 1;
|
||||
}
|
||||
}
|
||||
|
||||
static int64_t align_to(int64_t n, int64_t a) { return (n + a - 1) / a * a; }
|
||||
|
||||
static void desc_lay(const uint8_t *d, int64_t *size, int64_t *align) {
|
||||
switch (*d) {
|
||||
case 'b': case 'B': case '?': *size = 1; *align = 1; return;
|
||||
case 'h': case 'H': *size = 2; *align = 2; return;
|
||||
case 'i': case 'I': case 'f': *size = 4; *align = 4; return;
|
||||
case 't': case 's': *size = 16; *align = 8; return;
|
||||
case 'v': *size = 40; *align = 8; return;
|
||||
case 'a': {
|
||||
int64_t n, s, a;
|
||||
d++;
|
||||
n = desc_int(&d);
|
||||
desc_lay(d, &s, &a);
|
||||
*size = n * s;
|
||||
*align = a;
|
||||
return;
|
||||
}
|
||||
case '{': {
|
||||
int64_t off = 0, al = 1, s, a;
|
||||
d = desc_name_end(d + 1);
|
||||
while (*d != '}') {
|
||||
d = desc_name_end(d);
|
||||
desc_lay(d, &s, &a);
|
||||
if (a < 1) a = 1;
|
||||
off = align_to(off, a) + s;
|
||||
if (a > al) al = a;
|
||||
d = desc_skip(d);
|
||||
}
|
||||
*size = align_to(off, al);
|
||||
*align = al;
|
||||
return;
|
||||
}
|
||||
default: *size = 8; *align = 8; return;
|
||||
}
|
||||
}
|
||||
|
||||
static int64_t desc_size(const uint8_t *d) {
|
||||
int64_t s, a;
|
||||
desc_lay(d, &s, &a);
|
||||
return s;
|
||||
}
|
||||
|
||||
/* A struct descriptor's fields, one at a time: [desc_fields] answers where
|
||||
* the first one starts, and each [desc_next] answers a field's name, offset
|
||||
* and type and steps past it, 0 at the closing brace. [*off] is the running
|
||||
* offset. */
|
||||
static const uint8_t *desc_fields(const uint8_t *d, int64_t *off) {
|
||||
*off = 0;
|
||||
return desc_name_end(d + 1);
|
||||
}
|
||||
|
||||
static int desc_next(const uint8_t **at, int64_t *off, const uint8_t **name,
|
||||
int64_t *namelen, int64_t *foff, const uint8_t **fty) {
|
||||
const uint8_t *d = *at;
|
||||
int64_t s, a;
|
||||
if (*d == '}') return 0;
|
||||
*name = d;
|
||||
while (*d != ';') d++;
|
||||
*namelen = (int64_t)(d - *name);
|
||||
d++;
|
||||
desc_lay(d, &s, &a);
|
||||
if (a < 1) a = 1;
|
||||
*foff = align_to(*off, a);
|
||||
*off = *foff + s;
|
||||
*fty = d;
|
||||
*at = desc_skip(d);
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* The field keyword [k] names, or NULL. */
|
||||
static const uint8_t *desc_field(const uint8_t *d, flan_dyn k, int64_t *foff) {
|
||||
const uint8_t *at, *name, *fty;
|
||||
int64_t off, namelen;
|
||||
kw_entry *kw;
|
||||
if (flan_dyn_tag(k) != FLAN_DYN_TAG_KEYWORD) return NULL;
|
||||
kw = dyn_kw(k);
|
||||
at = desc_fields(d, &off);
|
||||
while (desc_next(&at, &off, &name, &namelen, foff, &fty))
|
||||
if (namelen == kw->len && memcmp(name, kw_bytes(kw), (size_t)namelen) == 0)
|
||||
return fty;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static int64_t desc_nfields(const uint8_t *d) {
|
||||
const uint8_t *at, *name, *fty;
|
||||
int64_t off, namelen, foff, n = 0;
|
||||
at = desc_fields(d, &off);
|
||||
while (desc_next(&at, &off, &name, &namelen, &foff, &fty)) n++;
|
||||
return n;
|
||||
}
|
||||
|
||||
/* The Flan spelling of a descriptor's type, for a sentence. */
|
||||
static void desc_spell(const uint8_t *d, char *buf, size_t cap) {
|
||||
static const char scalars[] = "bBhHiIlLfd?t";
|
||||
static const char *const words[] = { "i8", "u8", "i16", "u16", "i32", "u32",
|
||||
"i64", "u64", "f32", "f64", "bool",
|
||||
"str" };
|
||||
const char *w;
|
||||
char inner[96];
|
||||
if (cap == 0) return;
|
||||
buf[0] = '\0';
|
||||
if (*d != '\0' && (w = strchr(scalars, *d)) != NULL) {
|
||||
snprintf(buf, cap, "%s", words[w - scalars]);
|
||||
return;
|
||||
}
|
||||
switch (*d) {
|
||||
case 'a': {
|
||||
int64_t n;
|
||||
d++;
|
||||
n = desc_int(&d);
|
||||
desc_spell(d, inner, sizeof inner);
|
||||
snprintf(buf, cap, "[%lld %s]", (long long)n, inner);
|
||||
return;
|
||||
}
|
||||
case 's':
|
||||
desc_spell(d + 1, inner, sizeof inner);
|
||||
snprintf(buf, cap, "[%s]", inner);
|
||||
return;
|
||||
case 'v':
|
||||
desc_spell(d + 1, inner, sizeof inner);
|
||||
snprintf(buf, cap, "(Vec %s)", inner);
|
||||
return;
|
||||
case '{': {
|
||||
const uint8_t *e = desc_name_end(d + 1);
|
||||
snprintf(buf, cap, "%.*s", (int)(e - d - 2), (const char *)d + 1);
|
||||
return;
|
||||
}
|
||||
default: snprintf(buf, cap, "?"); return;
|
||||
}
|
||||
}
|
||||
|
||||
/* What a dev build remembers of a view's storage at the crossing, and checks
|
||||
* before every read or write through it (runtime/flan_dev.c keeps both
|
||||
* tables):
|
||||
*
|
||||
* a frame the shadow frame the storage belongs to and the serial that
|
||||
* activation was given. Live while that frame is still on the
|
||||
* chain with the same serial: a later call landing at the same
|
||||
* address gets a different one.
|
||||
* a block the registry entry of the heap or arena block holding the
|
||||
* storage, by base and note sequence. Live while the entry is,
|
||||
* which a free, a free-all, an arena's destroy and a Vec's
|
||||
* growth (for the block it left) all end.
|
||||
*
|
||||
* A release build keeps neither table, so a view there records nothing and
|
||||
* checks nothing. Storage neither table knows — a global, rodata, C memory,
|
||||
* a caller's local reached through a slice parameter — is not checked. */
|
||||
typedef struct view_guard {
|
||||
const void *frame; /* NULL when no frame is checked */
|
||||
uint64_t serial;
|
||||
const char *fname; /* whose frame, for the sentence */
|
||||
int64_t fnamelen;
|
||||
uintptr_t rbase; /* 0 when no block is checked */
|
||||
int64_t rseq;
|
||||
const char *rtype;
|
||||
int64_t rtypelen;
|
||||
} view_guard;
|
||||
|
||||
uint64_t flan_dev_frame_claim(void *frame, const char **name, int64_t *namelen);
|
||||
int32_t flan_dev_frame_alive(const void *frame, uint64_t serial);
|
||||
int32_t flan_dev_reg_claim(const void *p, uintptr_t *base, int64_t *seq,
|
||||
const char **type, int64_t *typelen);
|
||||
int32_t flan_dev_reg_alive(uintptr_t base, int64_t seq);
|
||||
extern void *flan_frame_head;
|
||||
|
||||
#define VIEW_FLAT 0 /* [base] is the first element, [o->len] the count */
|
||||
#define VIEW_VEC 1 /* [base] is a Vec's header, read live */
|
||||
#define VIEW_STRUCT 2 /* [base] is the struct, [desc] the struct's own */
|
||||
|
||||
static inline view_guard *view_g(flan_obj *o) { return (view_guard *)(o + 1); }
|
||||
static inline int view_shape(flan_obj *o) { return (int)o->gen; }
|
||||
|
||||
static void guard_block(view_guard *g, const void *p) {
|
||||
g->rbase = 0;
|
||||
if (p != NULL)
|
||||
flan_dev_reg_claim(p, &g->rbase, &g->rseq, &g->rtype, &g->rtypelen);
|
||||
}
|
||||
|
||||
/* A new view record, its guard empty. */
|
||||
static flan_obj *view_new(void *base, int64_t len, const uint8_t *desc,
|
||||
int shape) {
|
||||
flan_obj *o = gc_alloc(OBJ_VIEW, (int64_t)sizeof(view_guard));
|
||||
o->u.view.base = base;
|
||||
o->u.view.desc = desc;
|
||||
o->u.view.nul = NULL;
|
||||
o->gen = (uint32_t)shape;
|
||||
o->len = len;
|
||||
memset(view_g(o), 0, sizeof(view_guard));
|
||||
return o;
|
||||
}
|
||||
|
||||
/* The stale-storage check. The sentence never renders the view: it has just
|
||||
* been found to point at storage that is gone, and rendering reads it. */
|
||||
static void view_guard_check(const uint8_t *loc, int64_t loclen,
|
||||
const char *op, flan_obj *o) {
|
||||
view_guard *g = view_g(o);
|
||||
if (g->frame != NULL && !flan_dev_frame_alive(g->frame, g->serial)) {
|
||||
flan_say(loc, loclen,
|
||||
"dyn %s: this view points into a local of %.*s, and that call "
|
||||
"has returned. A view of a local lasts as long as the call that "
|
||||
"made it",
|
||||
op, (int)g->fnamelen, g->fname);
|
||||
flan_trap((const uint8_t *)"DynStale", 8);
|
||||
}
|
||||
if (g->rbase != 0 && !flan_dev_reg_alive(g->rbase, g->rseq)) {
|
||||
flan_say(loc, loclen,
|
||||
"dyn %s: this view's storage, a block of %.*s, has been "
|
||||
"released — freed, cleared by free-all, or left behind when a "
|
||||
"Vec grew. Take the view again after the change",
|
||||
op, (int)g->rtypelen, g->rtype);
|
||||
flan_trap((const uint8_t *)"DynStale", 8);
|
||||
}
|
||||
}
|
||||
|
||||
/* The stale-container check flan_rt.c's [flan_vec_check] runs for a typed
|
||||
@ -2875,17 +3183,8 @@ static int64_t view_elem_size(int32_t elem) {
|
||||
* doctrine's dyn side gets its own spelling (docs/SPIKE-DUPLICITY.md), and a
|
||||
* dyn program that hits this wants the same park-and-inspect [flan_trap]
|
||||
* gives every other dyn mistake, not the typed side's [rt_die]. A Vec with
|
||||
* no allocator yet — one nobody has pushed to — has nothing to check.
|
||||
*
|
||||
* The message never renders the view it just declared unsafe to read —
|
||||
* review's second finding, and it was not a decoration this dropped for
|
||||
* safety's sake, it was a real infinite recursion: [say] on a view calls
|
||||
* [say_render]'s view branch, which calls [view_len], which calls back in
|
||||
* here, unconditionally, because the epoch is still stale. Every render of
|
||||
* this same view would hit the same check and take the same branch, so
|
||||
* nothing about depth or a visited set closes it — the fix is that a
|
||||
* stale-container check must never read the container it has just refused
|
||||
* to trust, not even to describe it in the sentence explaining why. */
|
||||
* no allocator yet — one nobody has pushed to — has nothing to check. Like
|
||||
* the guard's, the sentence never renders the view. */
|
||||
static void view_vec_check(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
flan_dyn_vec_hdr *h) {
|
||||
if (h->alloc) {
|
||||
@ -2902,104 +3201,300 @@ static void view_vec_check(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
|
||||
/* [len] and [base], read live for a Vec view (so a push that grows and
|
||||
* moves the underlying Vec is seen the very next operation) and read from
|
||||
* the snapshot for a flat one. */
|
||||
* the snapshot for a flat one. [view_len] checks the guard first. */
|
||||
static int64_t view_len(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
flan_obj *o) {
|
||||
if (o->u.view.is_vec) {
|
||||
view_guard_check(loc, loclen, op, o);
|
||||
if (view_shape(o) == VIEW_VEC) {
|
||||
flan_dyn_vec_hdr *h = (flan_dyn_vec_hdr *)o->u.view.base;
|
||||
view_vec_check(loc, loclen, op, h);
|
||||
return h->len;
|
||||
}
|
||||
return o->u.view.len;
|
||||
return o->len;
|
||||
}
|
||||
|
||||
static void *view_base(flan_obj *o) {
|
||||
if (o->u.view.is_vec) return ((flan_dyn_vec_hdr *)o->u.view.base)->ptr;
|
||||
if (view_shape(o) == VIEW_VEC) return ((flan_dyn_vec_hdr *)o->u.view.base)->ptr;
|
||||
return o->u.view.base;
|
||||
}
|
||||
|
||||
/* Reads box the element on the way out — the runtime already knows how to
|
||||
* box an i64, an f64 or a bool, so this is that, from raw bytes rather than
|
||||
* from a C value already in hand. */
|
||||
static flan_dyn view_box(int32_t elem, const uint8_t *p) {
|
||||
switch (elem) {
|
||||
case FLAN_VIEW_I64: { int64_t x; memcpy(&x, p, 8); return flan_dyn_from_i64(x); }
|
||||
case FLAN_VIEW_F64: { double x; memcpy(&x, p, 8); return flan_dyn_from_f64(x); }
|
||||
default: { uint8_t b = *p; return flan_dyn_from_bool(b); }
|
||||
/* A view of the aggregate element at [p], inside [parent]'s storage. An
|
||||
* element of a Vec is checked against the Vec's block, since the Vec's
|
||||
* growth is what would leave it behind; any other inline element shares its
|
||||
* parent's guard. A slice element's data is somewhere else, so it is looked
|
||||
* up afresh. */
|
||||
static flan_dyn view_child(flan_obj *parent, const uint8_t *d, uint8_t *p) {
|
||||
flan_obj *c;
|
||||
switch (*d) {
|
||||
case 's': {
|
||||
void *data;
|
||||
int64_t n;
|
||||
memcpy(&data, p, 8);
|
||||
memcpy(&n, p + 8, 8);
|
||||
c = view_new(data, n, d + 1, VIEW_FLAT);
|
||||
guard_block(view_g(c), data);
|
||||
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)c);
|
||||
}
|
||||
case 'a': {
|
||||
const uint8_t *e = d + 1;
|
||||
int64_t n = desc_int(&e);
|
||||
c = view_new(p, n, e, VIEW_FLAT);
|
||||
break;
|
||||
}
|
||||
case 'v': c = view_new(p, 0, d + 1, VIEW_VEC); break;
|
||||
default: c = view_new(p, 0, d, VIEW_STRUCT); break;
|
||||
}
|
||||
if (view_shape(parent) == VIEW_VEC) guard_block(view_g(c), p);
|
||||
else *view_g(c) = *view_g(parent);
|
||||
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)c);
|
||||
}
|
||||
|
||||
/* One element, boxed on the way out. A number widens to a dyn int or float,
|
||||
* except a u64 above the largest i64, which has no dyn int to become. */
|
||||
static flan_dyn view_read(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
flan_obj *parent, const uint8_t *d, uint8_t *p) {
|
||||
switch (*d) {
|
||||
case 'b': { int8_t x; memcpy(&x, p, 1); return flan_dyn_from_i64(x); }
|
||||
case 'B': { uint8_t x; memcpy(&x, p, 1); return flan_dyn_from_i64(x); }
|
||||
case 'h': { int16_t x; memcpy(&x, p, 2); return flan_dyn_from_i64(x); }
|
||||
case 'H': { uint16_t x; memcpy(&x, p, 2); return flan_dyn_from_i64(x); }
|
||||
case 'i': { int32_t x; memcpy(&x, p, 4); return flan_dyn_from_i64(x); }
|
||||
case 'I': { uint32_t x; memcpy(&x, p, 4); return flan_dyn_from_i64(x); }
|
||||
case 'l': { int64_t x; memcpy(&x, p, 8); return flan_dyn_from_i64(x); }
|
||||
case 'L': {
|
||||
uint64_t x;
|
||||
memcpy(&x, p, 8);
|
||||
if (x > (uint64_t)INT64_MAX) {
|
||||
flan_say(loc, loclen,
|
||||
"dyn %s: this u64 element is %llu, above the largest dyn int "
|
||||
"(9223372036854775807), so it has no dyn value",
|
||||
op, (unsigned long long)x);
|
||||
flan_trap((const uint8_t *)"DynRange", 8);
|
||||
}
|
||||
return flan_dyn_from_i64((int64_t)x);
|
||||
}
|
||||
case 'f': { float x; memcpy(&x, p, 4); return flan_dyn_from_f64((double)x); }
|
||||
case 'd': { double x; memcpy(&x, p, 8); return flan_dyn_from_f64(x); }
|
||||
case '?': return flan_dyn_from_bool(*p ? 1 : 0);
|
||||
case 't': {
|
||||
const uint8_t *s;
|
||||
int64_t n;
|
||||
memcpy(&s, p, 8);
|
||||
memcpy(&n, p + 8, 8);
|
||||
return flan_dyn_from_bytes(s, n);
|
||||
}
|
||||
default: return view_child(parent, d, p);
|
||||
}
|
||||
}
|
||||
|
||||
/* The range each integer element holds. */
|
||||
static int int_range(uint8_t c, int64_t *lo, int64_t *hi) {
|
||||
switch (c) {
|
||||
case 'b': *lo = INT8_MIN; *hi = INT8_MAX; return 1;
|
||||
case 'B': *lo = 0; *hi = UINT8_MAX; return 1;
|
||||
case 'h': *lo = INT16_MIN; *hi = INT16_MAX; return 1;
|
||||
case 'H': *lo = 0; *hi = UINT16_MAX; return 1;
|
||||
case 'i': *lo = INT32_MIN; *hi = INT32_MAX; return 1;
|
||||
case 'I': *lo = 0; *hi = UINT32_MAX; return 1;
|
||||
case 'l': *lo = INT64_MIN; *hi = INT64_MAX; return 1;
|
||||
case 'L': *lo = 0; *hi = INT64_MAX; return 1;
|
||||
default: return 0;
|
||||
}
|
||||
}
|
||||
|
||||
/* One element, unboxed on the way in. The dyn value's tag must be the one
|
||||
* the element's type wants, or this traps by name and never coerces a
|
||||
* mismatched value into the slot; an int the element's width cannot hold
|
||||
* traps too, naming both. An int is not a float here: it is refused, not
|
||||
* converted, as every write through a view has been. A float into an f32
|
||||
* narrows, as (f32 x) does. [v] is the view and [x] the value, for the
|
||||
* sentence. */
|
||||
static void view_write(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
flan_dyn v, const uint8_t *d, flan_dyn x, uint8_t *p) {
|
||||
char ty[128];
|
||||
int64_t lo, hi;
|
||||
if (int_range(*d, &lo, &hi)) {
|
||||
int64_t n;
|
||||
if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT)
|
||||
trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are int", v, x);
|
||||
n = dyn_int_value(x);
|
||||
if (n < lo || n > hi) {
|
||||
desc_spell(d, ty, sizeof ty);
|
||||
if (*d == 'L')
|
||||
flan_say(loc, loclen,
|
||||
"dyn %s: %lld does not fit a u64 element, which holds no "
|
||||
"negative number", op, (long long)n);
|
||||
else
|
||||
flan_say(loc, loclen,
|
||||
"dyn %s: %lld does not fit a %s element, which holds %lld "
|
||||
"to %lld", op, (long long)n, ty, (long long)lo, (long long)hi);
|
||||
flan_trap((const uint8_t *)"DynRange", 8);
|
||||
}
|
||||
switch (*d) {
|
||||
case 'b': case 'B': { uint8_t b = (uint8_t)n; memcpy(p, &b, 1); return; }
|
||||
case 'h': case 'H': { uint16_t h = (uint16_t)n; memcpy(p, &h, 2); return; }
|
||||
case 'i': case 'I': { uint32_t w = (uint32_t)n; memcpy(p, &w, 4); return; }
|
||||
default: memcpy(p, &n, 8); return;
|
||||
}
|
||||
}
|
||||
switch (*d) {
|
||||
case 'f': case 'd': {
|
||||
double f;
|
||||
if (flan_dyn_tag(x) != FLAN_DYN_TAG_FLOAT)
|
||||
trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are float", v, x);
|
||||
f = dyn_num_value(x);
|
||||
if (*d == 'f') { float g = (float)f; memcpy(p, &g, 4); }
|
||||
else memcpy(p, &f, 8);
|
||||
return;
|
||||
}
|
||||
case '?':
|
||||
if (flan_dyn_tag(x) != FLAN_DYN_TAG_BOOL)
|
||||
trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are bool", v, x);
|
||||
*p = dyn_payload(x) ? 1 : 0;
|
||||
return;
|
||||
case 't':
|
||||
trap2(loc, loclen, TYPE_TRAP, op,
|
||||
"a str element is read-only through a dyn view", v, x);
|
||||
default: {
|
||||
char sx[SAY_MAX];
|
||||
desc_spell(d, ty, sizeof ty);
|
||||
say(sx, SAY_MAX, x);
|
||||
flan_say(loc, loclen,
|
||||
"dyn %s: this element is a %s, and a dyn view does not replace "
|
||||
"it whole — write into its own elements or fields instead of "
|
||||
"storing %s",
|
||||
op, ty, sx);
|
||||
flan_trap((const uint8_t *)"DynType", 7);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Element [i] of a vec-shaped view. The caller has checked the bounds. */
|
||||
static uint8_t *view_elem_at(flan_obj *o, int64_t i) {
|
||||
return (uint8_t *)view_base(o) + i * desc_size(o->u.view.desc);
|
||||
}
|
||||
|
||||
/* A length and an element reader that answer correctly whether [o] is an
|
||||
* ordinary heap vec (OBJ_VEC, elements are dyn words) or a view over a
|
||||
* typed container (OBJ_VIEW, elements are native bytes boxed on the way
|
||||
* out) — the pair [dyn_equal]'s VEC arm needs so that a view compares
|
||||
* correctly against another view and against an ordinary vec alike. Reading
|
||||
* [o->len]/[o->u.v.items] directly, the way that arm used to, answers 0 and
|
||||
* garbage for a view: nothing sets [len] for OBJ_VIEW, and its elements
|
||||
* alias [u.view.base] reinterpreted as dyn words rather than the native
|
||||
* bytes they are. */
|
||||
* typed container (OBJ_VIEW, native bytes boxed on the way out) — the pair
|
||||
* [dyn_equal]'s VEC arm and the printers need. */
|
||||
static int64_t vecish_len(flan_obj *o) {
|
||||
return o->kind == OBJ_VIEW ? view_len(NULL, 0, "=", o) : o->len;
|
||||
}
|
||||
|
||||
static flan_dyn vecish_at(flan_obj *o, int64_t i) {
|
||||
if (o->kind == OBJ_VIEW)
|
||||
return view_box(o->u.view.elem,
|
||||
(const uint8_t *)view_base(o)
|
||||
+ i * view_elem_size(o->u.view.elem));
|
||||
return view_read(NULL, 0, "print", o, o->u.view.desc, view_elem_at(o, i));
|
||||
return o->u.v.items[i];
|
||||
}
|
||||
|
||||
/* Writes tag-check on the way in: the dyn value's tag must be the one this
|
||||
* view's element type wants, or this traps by name and never coerces or
|
||||
* truncates a mismatched value into the slot. [v] is the view, for the
|
||||
* sentence's container half; [x] is the value that was refused. */
|
||||
static void view_unbox(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
flan_dyn v, int32_t elem, flan_dyn x, uint8_t *p) {
|
||||
switch (elem) {
|
||||
case FLAN_VIEW_I64: {
|
||||
int64_t n;
|
||||
if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT)
|
||||
trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are int", v, x);
|
||||
n = dyn_int_value(x);
|
||||
memcpy(p, &n, 8);
|
||||
return;
|
||||
}
|
||||
case FLAN_VIEW_F64: {
|
||||
double d;
|
||||
if (flan_dyn_tag(x) != FLAN_DYN_TAG_FLOAT)
|
||||
trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are float", v, x);
|
||||
d = dyn_num_value(x);
|
||||
memcpy(p, &d, 8);
|
||||
return;
|
||||
}
|
||||
default: {
|
||||
uint8_t b;
|
||||
if (flan_dyn_tag(x) != FLAN_DYN_TAG_BOOL)
|
||||
trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are bool", v, x);
|
||||
b = dyn_payload(x) ? 1 : 0;
|
||||
*p = b;
|
||||
return;
|
||||
}
|
||||
/* A struct view's field [k], or a trap naming the fields there are: a
|
||||
* struct's shape is fixed, so a key it does not have is a mistake rather
|
||||
* than an absence. */
|
||||
static uint8_t *view_field(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
flan_obj *o, flan_dyn k, const uint8_t **fty) {
|
||||
int64_t off;
|
||||
const uint8_t *d = o->u.view.desc;
|
||||
view_guard_check(loc, loclen, op, o);
|
||||
*fty = desc_field(d, k, &off);
|
||||
if (*fty == NULL) {
|
||||
char sk[SAY_MAX], nm[96];
|
||||
const uint8_t *at, *name, *t;
|
||||
int64_t o2, namelen, foff;
|
||||
say(sk, SAY_MAX, k);
|
||||
desc_spell(d, nm, sizeof nm);
|
||||
said_len = 0;
|
||||
said_add("dyn %s: a %s has no field %s. Its fields are", op, nm, sk);
|
||||
at = desc_fields(d, &o2);
|
||||
while (desc_next(&at, &o2, &name, &namelen, &foff, &t))
|
||||
said_add(" :%.*s", (int)namelen, (const char *)name);
|
||||
flan_say(loc, loclen, "%s", said_buf);
|
||||
flan_trap((const uint8_t *)"DynType", 7);
|
||||
}
|
||||
return (uint8_t *)o->u.view.base + off;
|
||||
}
|
||||
|
||||
/* The crossing. [base] is the container's address (a Vec's header, the
|
||||
* array's or the struct's first byte) or a slice's data, [len] a flat
|
||||
* view's element count, [desc] the element's descriptor (the struct's own,
|
||||
* for a struct view). [here] is the checker's word that the storage is the
|
||||
* calling function's own frame; otherwise a dev build looks the address up
|
||||
* in the allocation registry. */
|
||||
static flan_dyn view_make(void *base, int64_t len, const uint8_t *desc,
|
||||
int shape, int32_t here) {
|
||||
flan_obj *o = view_new(base, len, desc, shape);
|
||||
view_guard *g = view_g(o);
|
||||
if (here) {
|
||||
if (flan_frame_head != NULL) {
|
||||
g->frame = flan_frame_head;
|
||||
g->serial =
|
||||
flan_dev_frame_claim(flan_frame_head, &g->fname, &g->fnamelen);
|
||||
}
|
||||
} else
|
||||
guard_block(g, base);
|
||||
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_view_slice(void *data, int64_t len, const uint8_t *desc,
|
||||
int64_t desclen, int32_t here) {
|
||||
(void)desclen;
|
||||
return view_make(data, len, desc, VIEW_FLAT, here);
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_view_at(void *addr, int64_t len, const uint8_t *desc,
|
||||
int64_t desclen, int32_t shape, int32_t here) {
|
||||
(void)desclen;
|
||||
return view_make(addr, len, desc, shape, here);
|
||||
}
|
||||
|
||||
/* A struct view's fields by position, for the printers and equality. */
|
||||
static int64_t view_nfields(flan_obj *o) {
|
||||
view_guard_check(NULL, 0, "print", o);
|
||||
return desc_nfields(o->u.view.desc);
|
||||
}
|
||||
|
||||
static int view_nth(flan_obj *o, int64_t i, const uint8_t **name,
|
||||
int64_t *namelen, int64_t *foff, const uint8_t **fty) {
|
||||
int64_t off;
|
||||
const uint8_t *at = desc_fields(o->u.view.desc, &off);
|
||||
while (desc_next(&at, &off, name, namelen, foff, fty))
|
||||
if (i-- == 0) return 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
static flan_dyn view_field_key(flan_obj *o, int64_t i) {
|
||||
const uint8_t *name, *fty;
|
||||
int64_t namelen, foff;
|
||||
if (!view_nth(o, i, &name, &namelen, &foff, &fty)) return flan_dyn_nil();
|
||||
return flan_dyn_kw(name, namelen);
|
||||
}
|
||||
|
||||
static flan_dyn view_field_val(flan_obj *o, int64_t i) {
|
||||
const uint8_t *name, *fty;
|
||||
int64_t namelen, foff;
|
||||
if (!view_nth(o, i, &name, &namelen, &foff, &fty)) return flan_dyn_nil();
|
||||
return view_read(NULL, 0, "print", o, fty, (uint8_t *)o->u.view.base + foff);
|
||||
}
|
||||
|
||||
static void view_struct_name(flan_obj *o, const char **name, int64_t *len) {
|
||||
const uint8_t *d = o->u.view.desc;
|
||||
const uint8_t *e = desc_name_end(d + 1);
|
||||
*name = (const char *)d + 1;
|
||||
*len = (int64_t)(e - d - 2);
|
||||
}
|
||||
|
||||
/* The first ABI, kept for test/dyn_ops.c: FLAN_VIEW_I64/F64/BOOL. */
|
||||
static const uint8_t *old_elem_desc(int32_t elem) {
|
||||
return (const uint8_t *)(elem == FLAN_VIEW_I64 ? "l"
|
||||
: elem == FLAN_VIEW_F64 ? "d" : "?");
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_view_vec(void *hdr, int32_t elem) {
|
||||
flan_obj *o = gc_alloc(OBJ_VIEW, 0);
|
||||
o->u.view.base = hdr;
|
||||
o->u.view.len = 0;
|
||||
o->u.view.elem = elem;
|
||||
o->u.view.is_vec = 1;
|
||||
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
||||
return view_make(hdr, 0, old_elem_desc(elem), VIEW_VEC, 0);
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_view_flat(void *data, int64_t len, int32_t elem) {
|
||||
flan_obj *o = gc_alloc(OBJ_VIEW, 0);
|
||||
o->u.view.base = data;
|
||||
o->u.view.len = len;
|
||||
o->u.view.elem = elem;
|
||||
o->u.view.is_vec = 0;
|
||||
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
||||
return view_make(data, len, old_elem_desc(elem), VIEW_FLAT, 0);
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_len(flan_dyn v) {
|
||||
@ -3009,6 +3504,10 @@ flan_dyn flan_dyn_len(flan_dyn v) {
|
||||
reason [get] is. */
|
||||
if (is_map(v)) {
|
||||
flan_obj *o = dyn_obj(v);
|
||||
if (o->kind == OBJ_VIEW) {
|
||||
view_guard_check(NULL, 0, "length", o);
|
||||
return flan_dyn_from_i64(view_nfields(o));
|
||||
}
|
||||
class_sync(o);
|
||||
return flan_dyn_from_i64(o->len);
|
||||
}
|
||||
@ -3044,8 +3543,7 @@ flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i, const uint8_t *loc,
|
||||
if (o->kind == OBJ_VIEW) {
|
||||
int64_t len = view_len(loc, loclen, "at", o);
|
||||
if (k < 0 || k >= len) trap_range(loc, loclen, "at", v, k, len);
|
||||
return view_box(o->u.view.elem,
|
||||
(const uint8_t *)view_base(o) + k * view_elem_size(o->u.view.elem));
|
||||
return view_read(loc, loclen, "at", o, o->u.view.desc, view_elem_at(o, k));
|
||||
}
|
||||
if (k < 0 || k >= o->len) trap_range(loc, loclen, "at", v, k, o->len);
|
||||
if (o->kind == OBJ_TEXT) return flan_dyn_from_i64(obj_text_bytes(o)[k]);
|
||||
@ -3092,10 +3590,8 @@ void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x, const uint8_t *loc,
|
||||
o = dyn_obj(v);
|
||||
if (o->kind == OBJ_VIEW) {
|
||||
int64_t len = view_len(loc, loclen, "set-at", o);
|
||||
uint8_t *p;
|
||||
if (k < 0 || k >= len) trap_range(loc, loclen, "set-at", v, k, len);
|
||||
p = (uint8_t *)view_base(o) + k * view_elem_size(o->u.view.elem);
|
||||
view_unbox(loc, loclen, "set-at", v, o->u.view.elem, x, p);
|
||||
view_write(loc, loclen, "set-at", v, o->u.view.desc, x, view_elem_at(o, k));
|
||||
return;
|
||||
}
|
||||
if (k < 0 || k >= o->len) trap_range(loc, loclen, "set-at", v, k, o->len);
|
||||
@ -3111,20 +3607,24 @@ void flan_dyn_push(flan_dyn v, flan_dyn x, const uint8_t *loc, int64_t loclen) {
|
||||
}
|
||||
o = dyn_obj(v);
|
||||
if (o->kind == OBJ_VIEW) {
|
||||
uint8_t buf[8];
|
||||
uint8_t buf[16];
|
||||
/* The typed Vec's own traps print a site too, and without one from the
|
||||
* caller the best this can name is the operation. */
|
||||
static const uint8_t push_loc[] = "(dyn push)";
|
||||
const uint8_t *site = loc != NULL && loclen > 0 ? loc : push_loc;
|
||||
int64_t sitelen = loc != NULL && loclen > 0 ? loclen
|
||||
: (int64_t)sizeof(push_loc) - 1;
|
||||
int64_t size;
|
||||
if (!o->u.view.is_vec)
|
||||
int64_t size, align;
|
||||
if (view_shape(o) != VIEW_VEC)
|
||||
trap2(loc, loclen, TYPE_TRAP, "push",
|
||||
"this view is a slice or an array and cannot grow", v, x);
|
||||
size = view_elem_size(o->u.view.elem);
|
||||
view_unbox(loc, loclen, "push", v, o->u.view.elem, x, buf);
|
||||
if (!flan_vec_push(o->u.view.base, buf, size, size, site, sitelen))
|
||||
view_len(loc, loclen, "push", o);
|
||||
desc_lay(o->u.view.desc, &size, &align);
|
||||
/* Only a number or a bool is ever written, and [view_write] refuses the
|
||||
rest before a byte of [buf] is used. */
|
||||
memset(buf, 0, sizeof buf);
|
||||
view_write(loc, loclen, "push", v, o->u.view.desc, x, buf);
|
||||
if (!flan_vec_push(o->u.view.base, buf, size, align, site, sitelen))
|
||||
trap_oom(loc, loclen, size);
|
||||
return;
|
||||
}
|
||||
@ -3187,12 +3687,22 @@ static flan_obj *want_map(const char *op, flan_dyn m, flan_dyn k) {
|
||||
|
||||
flan_dyn flan_dyn_map_get(flan_dyn m, flan_dyn k) {
|
||||
flan_obj *o = want_map("get", m, k);
|
||||
if (o->kind == OBJ_VIEW) {
|
||||
const uint8_t *fty;
|
||||
uint8_t *p = view_field(NULL, 0, "get", o, k, &fty);
|
||||
return view_read(NULL, 0, "get", o, fty, p);
|
||||
}
|
||||
int64_t i = map_find(o, k);
|
||||
return i < 0 ? flan_dyn_nil() : o->u.v.items[i * 2 + 1];
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_map_contains(flan_dyn m, flan_dyn k) {
|
||||
flan_obj *o = want_map("has-key?", m, k);
|
||||
if (o->kind == OBJ_VIEW) {
|
||||
int64_t off;
|
||||
view_guard_check(NULL, 0, "has-key?", o);
|
||||
return flan_dyn_from_bool(desc_field(o->u.view.desc, k, &off) != NULL);
|
||||
}
|
||||
return flan_dyn_from_bool(map_find(o, k) >= 0);
|
||||
}
|
||||
|
||||
@ -3294,6 +3804,12 @@ void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v,
|
||||
class_entry *e;
|
||||
int64_t j;
|
||||
flan_dyn out;
|
||||
if (is_map(m) && dyn_obj(m)->kind == OBJ_VIEW) {
|
||||
const uint8_t *fty;
|
||||
uint8_t *p = view_field(loc, loclen, "set", dyn_obj(m), k, &fty);
|
||||
view_write(loc, loclen, "set", m, fty, v, p);
|
||||
return;
|
||||
}
|
||||
if (!is_map(m) || dyn_obj(m)->u.v.klass == NULL) {
|
||||
char sm[SAY_MAX];
|
||||
say(sm, SAY_MAX, m);
|
||||
@ -3335,6 +3851,12 @@ void flan_dyn_map_put(flan_dyn m, flan_dyn k, flan_dyn v, const uint8_t *loc,
|
||||
class_entry *e;
|
||||
if (!is_map(m)) trap2(NULL, 0, TYPE_TRAP, "put", "only a map answers it", m, k);
|
||||
o = dyn_obj(m);
|
||||
if (o->kind == OBJ_VIEW) {
|
||||
const uint8_t *fty;
|
||||
uint8_t *p = view_field(loc, loclen, "put", o, k, &fty);
|
||||
view_write(loc, loclen, "put", m, fty, v, p);
|
||||
return;
|
||||
}
|
||||
e = class_sync(o);
|
||||
/* A map with no class, and a class with no typed slot, stop at the test. */
|
||||
if (e != NULL && e->typed) v = check_slot(loc, loclen, BY_PUT, o, e, m, k, v);
|
||||
|
||||
@ -301,56 +301,40 @@ flan_dyn flan_dyn_need_not_nil(flan_dyn v);
|
||||
* "", an empty vec, an empty map, and any keyword. Never traps. */
|
||||
uint8_t flan_dyn_truthy(flan_dyn v);
|
||||
|
||||
/* ── Typed containers as views — M2 item 3 ─────────────────────────────
|
||||
/* ── Typed containers as views ────────────────────────────────────────
|
||||
*
|
||||
* A [(Vec T)], a [T] slice, or a fixed [n T] array crossing into dyn is a
|
||||
* VIEW, not a copy: the box holds a small heap record naming where the
|
||||
* elements live and what one of them is, and every read or write goes
|
||||
* straight through to the container's own storage. [flan_dyn_at] boxes an
|
||||
* element on the way out; [flan_dyn_set_at] tag-checks the dyn value it is
|
||||
* given against the element type on the way in and traps, by [flan_trap],
|
||||
* on a mismatch — never a silent coercion.
|
||||
* A [(Vec T)], a [T] slice, a fixed [n T] array or a struct crossing into
|
||||
* dyn is a VIEW, not a copy: the box holds a small heap record naming where
|
||||
* the storage is and a descriptor of one element (flan_dyn.c documents the
|
||||
* code beside [desc_lay]), and every read or write goes straight through to
|
||||
* the container's own storage. A read boxes the element — every number
|
||||
* widens, an aggregate element answers a view of its own, a str is copied
|
||||
* into a text — and a write tag-checks and range-checks the dyn value
|
||||
* against the element type and traps, by [flan_trap], rather than coerce.
|
||||
* A struct's view answers the map tag: [get], [put] and (set (get p :k) v)
|
||||
* reach its fields.
|
||||
*
|
||||
* T is restricted to i64, f64 and bool — exactly the set [flan_dyn_need_i64]
|
||||
* and friends already treat as crossing the typed boundary both ways. That
|
||||
* is not an arbitrary cut: the excluded case that matters is a string
|
||||
* element, whose dyn form is a pointer into this collector's heap, while a
|
||||
* typed container's storage is arena or stack memory the collector never
|
||||
* scans. Writing such a pointer into that memory would be a live reference
|
||||
* nothing ever traces — a use-after-free the collector cannot see coming,
|
||||
* not a bug in this file but a hazard the type admits. i64, f64 and bool
|
||||
* carry no such pointer, so a view restricted to them cannot manufacture
|
||||
* it. [box] in lib/check.ml keeps the "does not cross into dyn yet" refusal
|
||||
* for every other element type, and this paragraph is why.
|
||||
* No collector pointer is ever written into typed storage, which the
|
||||
* collector never scans: that is why a str element is read-only from dyn and
|
||||
* an aggregate element is written through its own view, never replaced.
|
||||
*
|
||||
* Two kinds, because the containers split exactly here: a [(Vec T)] can grow
|
||||
* and move (a push may reallocate), a slice and a fixed array cannot.
|
||||
* [flan_dyn_view_at] with shape 1 takes the address of a Vec's own header —
|
||||
* the struct [flan_vec] in flan_rt.c, restated in flan_dyn.c under the same
|
||||
* "if either table changes, change both" rule — and every operation re-reads
|
||||
* its [ptr] and [len], so a push that grows and moves the Vec is never seen
|
||||
* as stale. A slice (flan_dyn_view_slice) and a fixed array (shape 0) are
|
||||
* snapshotted at the crossing, sound because neither moves; a struct is
|
||||
* shape 2.
|
||||
*
|
||||
* [flan_dyn_view_vec] takes the address of the Vec's own header — the
|
||||
* struct [flan_vec] in flan_rt.c, restated in flan_dyn.c under the same
|
||||
* "if either table changes, change both" rule this whole boundary already
|
||||
* lives under. That address is the Vec's home, fixed for as long as the Vec
|
||||
* exists — but "as long as the Vec exists" is the whole of the guarantee,
|
||||
* which is why [permanent_root] in lib/check.ml admits only storage that
|
||||
* outlives every frame: a global, a field or an array element of one, or a
|
||||
* slice cut from one at the crossing. A local's slot is a home too, and it
|
||||
* is precisely the one that is refused. Every operation re-reads that
|
||||
* header's [ptr] and [len] fresh, so a push that grows and moves the Vec is
|
||||
* never seen as stale — [flan_vec_grow] overwrites the SAME header's [ptr]
|
||||
* field in place, and there is no snapshot anywhere to go stale. That is
|
||||
* what makes the failure the open design question worried about
|
||||
* (a push through dyn holding a dangling pointer) impossible rather than
|
||||
* merely unlikely: there is nothing captured at the crossing for a later
|
||||
* push to invalidate.
|
||||
* The storage may be anywhere. [here] is the compiler's word that it is the
|
||||
* calling function's own frame; a dev build then records that activation
|
||||
* (runtime/flan_dev.c's shadow frame and its serial), and otherwise looks
|
||||
* the address up in its allocation registry, and every later operation
|
||||
* traps with DynStale when the frame has returned or the block has been
|
||||
* released. A release build records and checks nothing.
|
||||
*
|
||||
* [flan_dyn_view_flat] takes a data address and a length captured once, at
|
||||
* the crossing — sound for a slice and for a fixed array because neither
|
||||
* ever moves or grows. Note the asymmetry is not an oversight: pointing
|
||||
* *this* case at the value's own slot instead would be worse than a
|
||||
* snapshot, because a slot's lifetime is not the slice's, and a slice taken
|
||||
* from a Vec is already one push away from dangling on its own account
|
||||
* (flan_vec_grow's own comment says so) — the view is exactly as
|
||||
* stale-safe as the thing it is a view of, no more and no less.
|
||||
* The FLAN_VIEW_* entry points below are the first ABI, kept for
|
||||
* test/dyn_ops.c; the compiler calls the two after them.
|
||||
*/
|
||||
#define FLAN_VIEW_I64 0
|
||||
#define FLAN_VIEW_F64 1
|
||||
@ -358,6 +342,10 @@ uint8_t flan_dyn_truthy(flan_dyn v);
|
||||
|
||||
flan_dyn flan_dyn_view_vec(void *hdr, int32_t elem);
|
||||
flan_dyn flan_dyn_view_flat(void *data, int64_t len, int32_t elem);
|
||||
flan_dyn flan_dyn_view_slice(void *data, int64_t len, const uint8_t *desc,
|
||||
int64_t desclen, int32_t here);
|
||||
flan_dyn flan_dyn_view_at(void *addr, int64_t len, const uint8_t *desc,
|
||||
int64_t desclen, int32_t shape, int32_t here);
|
||||
|
||||
/* ── The collector ─────────────────────────────────────────────────────
|
||||
*
|
||||
|
||||
211
test/programs/dyn-view-any.flan
Normal file
211
test/programs/dyn-view-any.flan
Normal file
@ -0,0 +1,211 @@
|
||||
;;;; Any typed container crosses into dyn as a view: every element type and
|
||||
;;;; any storage. Mode 0 is the survey; the others are one trap each, since a
|
||||
;;;; trap ends the process. test_acceptance.ml runs it on both backends, and
|
||||
;;;; the stale-view modes under --dev only: a release build keeps no record of
|
||||
;;;; frames or blocks, so it neither checks nor promises anything there.
|
||||
|
||||
;; Unannotated parameters and returns are dyn: every call below boxes its
|
||||
;; typed argument into a view at the call.
|
||||
(defn show [label d] ()
|
||||
(print label)
|
||||
(print " ")
|
||||
(println d))
|
||||
|
||||
(defn bump-all [d] ()
|
||||
(dotimes [i (length d)]
|
||||
(set (at d i) (+ (at d i) 1))))
|
||||
|
||||
(defn keep [d] dyn d)
|
||||
|
||||
;; Field offsets only C's layout rule gets right: a u8, then an i64 aligned
|
||||
;; to 8, an f32, a bool, three u16 at 2, an i32 at 4.
|
||||
(defstruct Mix [a u8 b i64 c f32 d bool e [3 u16] f i32])
|
||||
(defstruct Point [x f32 y i32])
|
||||
(defstruct Named [name str id u32])
|
||||
|
||||
(defn make-point [] Point (Point {.x 1.5 .y 2}))
|
||||
|
||||
(defn param-array [xs [4 i32]] i32
|
||||
;; A parameter array is this frame's copy.
|
||||
(bump-all xs)
|
||||
(at xs 3))
|
||||
|
||||
(defn param-slice [xs [i64]] ()
|
||||
(bump-all xs))
|
||||
|
||||
(defonce held dyn nil)
|
||||
|
||||
;; A view of a local, kept past the call that owns the local.
|
||||
(defn leak-local [] ()
|
||||
(let [a [1 2 3]]
|
||||
(set held (keep a))))
|
||||
|
||||
(defn clobber [] i64
|
||||
(let [b [(i64 7) 8 9 10 11 12]]
|
||||
(+ (at b 0) (at b 5))))
|
||||
|
||||
(defn main [args [str]] i32
|
||||
(let [n (i32 (bytes->i64 (bytes-view (at args 1))))]
|
||||
(cond
|
||||
(= n 0)
|
||||
(do
|
||||
;; Every integer width, a local array each: read widens, write stores.
|
||||
(let [a [(i8 -1) -2 -3]
|
||||
b [(u8 250) 251 252]
|
||||
c [(i16 -300) 300]
|
||||
d [(u16 60000) 1]
|
||||
e [(i32 -70000) 70000]
|
||||
f [(u32 4000000000) 1]
|
||||
g [(i64 -5) 5]
|
||||
h [(u64 9000000000000000000) 1]]
|
||||
(bump-all a) (bump-all b) (bump-all c) (bump-all d)
|
||||
(bump-all e) (bump-all f) (bump-all g) (bump-all h)
|
||||
(show "i8" a) (show "u8" b) (show "i16" c) (show "u16" d)
|
||||
(show "i32" e) (show "u32" f) (show "i64" g) (show "u64" h)
|
||||
(println (at b 2)))
|
||||
;; f32: read widens, write narrows.
|
||||
(let [fs [(f32 0.5) 1.25]
|
||||
dv (keep fs)]
|
||||
(set (at dv 0) 2.75)
|
||||
(set (at dv 1) 3.1)
|
||||
(show "f32" dv)
|
||||
(println (at fs 0)))
|
||||
;; bool, through a slice cut from a local array.
|
||||
(let [bs [true false true]]
|
||||
(let [dv (keep (slice bs 0 3))]
|
||||
(set (at dv 1) true)
|
||||
(show "bool" dv)
|
||||
(println (at bs 1))))
|
||||
;; The author's case: a [u8] from bytes, sorted in place by dyn code.
|
||||
(let [text (bytes "INSERTIONSORT")]
|
||||
(let [d (keep text)]
|
||||
(dotimes [i (length d)]
|
||||
(let [j i]
|
||||
(while (and (> j 0) (< (at d j) (at d (- j 1))))
|
||||
(let [t (at d j)]
|
||||
(set (at d j) (at d (- j 1)))
|
||||
(set (at d (- j 1)) t))
|
||||
(set j (- j 1))))))
|
||||
(println (str text)))
|
||||
;; A struct: a map-like view, written through get and put.
|
||||
(let [p (Point {.x 0.5 .y 3})
|
||||
dp (keep p)]
|
||||
(show "point" dp)
|
||||
(set (get dp :y) 40)
|
||||
(put dp :x 9.5)
|
||||
(println (.y p))
|
||||
(println (.x p))
|
||||
(println (get dp :x))
|
||||
(println (length dp))
|
||||
(println (has-key? dp :y)))
|
||||
;; Every field of a padded struct reads back.
|
||||
(let [m (Mix {.a 7 .b -9000000000 .c 2.5 .d true .e [1 2 3] .f -4})]
|
||||
(show "mix" (keep m))
|
||||
(set (at (get (keep m) :e) 2) 65535)
|
||||
(println (at (.e m) 2)))
|
||||
;; A str field reads as text.
|
||||
(let [nm (Named {.name "ada" .id 7})]
|
||||
(show "named" (keep nm)))
|
||||
;; Nested arrays: a view of a view.
|
||||
(let [grid [[(i32 1) 2 3] [4 5 6]]
|
||||
dg (keep grid)]
|
||||
(set (at (at dg 1) 2) 60)
|
||||
(show "grid" dg)
|
||||
(println (at (at grid 1) 2)))
|
||||
;; An array of structs.
|
||||
(let [ps [(Point {.x 1.0 .y 1}) (Point {.x 2.0 .y 2})]
|
||||
dp (keep ps)]
|
||||
(set (get (at dp 1) :y) 20)
|
||||
(show "points" dp)
|
||||
(println (.y (at ps 1))))
|
||||
;; A Vec in a local: a push through the view grows the typed Vec.
|
||||
(let [v (vec-new i32)]
|
||||
(push v 1)
|
||||
(let [dv (keep v)]
|
||||
(push dv 2)
|
||||
(push dv 3)
|
||||
(show "vec" dv))
|
||||
(println (length v)))
|
||||
;; A Vec of structs.
|
||||
(let [v (vec-new Point)]
|
||||
(push v (Point {.x 0.0 .y 5}))
|
||||
(let [dv (keep v)]
|
||||
(set (get (at dv 0) :y) 6))
|
||||
(println (.y (at v 0))))
|
||||
;; Parameters: an array parameter is the callee's copy; a slice
|
||||
;; parameter sees the caller's elements.
|
||||
(let [xs [(i32 1) 2 3 4]]
|
||||
(println (param-array xs))
|
||||
(println (at xs 3)))
|
||||
(let [ys [(i64 1) 2]]
|
||||
(param-slice (slice ys 0 2))
|
||||
(println (at ys 1)))
|
||||
;; A temporary: a struct returned by a call.
|
||||
(show "temp" (keep (make-point)))
|
||||
;; A heap slice, and an arena's Vec.
|
||||
(let [c (clone (slice [(i64 1) 2 3] 0 3))]
|
||||
(bump-all c)
|
||||
(println (at c 2)))
|
||||
(let [ar (arena-new 4096)]
|
||||
(with-allocator ar
|
||||
(let [v (vec-new i16)]
|
||||
(push v 1)
|
||||
(push v 2)
|
||||
(bump-all v)
|
||||
(println (at v 1))))
|
||||
(arena-destroy ar))
|
||||
;; Two views of equal structs are equal.
|
||||
(let [p (Point {.x 1.0 .y 2})
|
||||
q (Point {.x 1.0 .y 2})]
|
||||
(println (= (keep p) (keep q))))
|
||||
0)
|
||||
;; A value an element's width cannot hold.
|
||||
(= n 1)
|
||||
(let [b [(u8 1) 2]]
|
||||
(set (at (keep b) 0) 300)
|
||||
0)
|
||||
;; A u64 above the largest dyn int.
|
||||
(= n 2)
|
||||
(let [h [(u64 18000000000000000000)]]
|
||||
(println (at (keep h) 0))
|
||||
0)
|
||||
;; A field a struct does not have.
|
||||
(= n 3)
|
||||
(let [p (Point {.x 1.0 .y 2})]
|
||||
(println (get (keep p) :z))
|
||||
0)
|
||||
;; A view of a local, used after its call returned: stale in a dev build.
|
||||
(= n 4)
|
||||
(do (leak-local)
|
||||
(println (clobber))
|
||||
(println (at held 0))
|
||||
0)
|
||||
;; A slice of a Vec's block, used after the Vec grew and moved.
|
||||
(= n 5)
|
||||
(let [v (vec-new i64)]
|
||||
(push v 1)
|
||||
(let [d (keep (slice v))]
|
||||
(dotimes [i 100] (push v i))
|
||||
(println (at d 0)))
|
||||
0)
|
||||
;; A heap slice used after it was freed.
|
||||
(= n 6)
|
||||
(let [c (clone (slice [(i64 1) 2 3] 0 3))
|
||||
d (keep c)]
|
||||
(free c)
|
||||
(println (at d 0))
|
||||
0)
|
||||
;; An arena's storage used after free-all.
|
||||
(= n 7)
|
||||
(let [ar (arena-new 4096)
|
||||
v (with-allocator ar (clone (slice [(i32 4) 5] 0 2)))
|
||||
d (keep v)]
|
||||
(free-all ar)
|
||||
(println (at d 1))
|
||||
0)
|
||||
;; A str element is read-only through a view.
|
||||
(= n 8)
|
||||
(let [nm (Named {.name "ada" .id 7})]
|
||||
(put (keep nm) :name "bob")
|
||||
0)
|
||||
:else (do (println "?") 1))))
|
||||
@ -5,24 +5,8 @@
|
||||
;;;; caller's own value, which is what makes [dv] below the SAME storage [v]
|
||||
;;;; is and not a copy of it.
|
||||
;;;;
|
||||
;;;; Every container viewed below is a GLOBAL, and that is not incidental to
|
||||
;;;; this program — it is the lifetime guard review added after the first
|
||||
;;;; landing: a view's descriptor chases the container's own address on every
|
||||
;;;; operation, which is what makes a Vec's growth safe, but it is also what
|
||||
;;;; makes a DANGLING container's address a live hazard. box refuses a Vec, a
|
||||
;;;; slice or a fixed array whose storage is not known to outlive the view —
|
||||
;;;; a local's, a parameter's, a temporary's — and a global's is the one
|
||||
;;;; storage this milestone can prove permanent: fixed in .data for the
|
||||
;;;; process — as is a field of one, and an ELEMENT of one when the global
|
||||
;;;; is an array, whose elements sit inside its own storage. An element of a
|
||||
;;;; global SLICE is not: the slice is ptr+len and says nothing about where
|
||||
;;;; the data is — and that holds at every index of a multi-index (at g i j),
|
||||
;;;; not just the first, so one slice level anywhere in the walk refuses.
|
||||
;;;; test_flan.ml's checker tests carry the refusal side of this (a local
|
||||
;;;; Vec, a Vec parameter, a Vec behind a Ptr, a slice rebound to a local, an
|
||||
;;;; element of a global slice, and an element reached through a slice at a
|
||||
;;;; later index level); this program is the acceptance side, over storage
|
||||
;;;; the guard allows.
|
||||
;;;; Every container viewed below is a global; dyn-view-any.flan covers
|
||||
;;;; the other storage and element types.
|
||||
;;;;
|
||||
;;;; Mode 0 is the survey: a read through the view boxes the element
|
||||
;;;; correctly, a write through either side is seen through the other, and a
|
||||
|
||||
@ -5838,6 +5838,74 @@ level "1"
|
||||
dyn_view ~opt:"-O0" ();
|
||||
dyn_view ~x86:true ();
|
||||
|
||||
(* ── Any typed container crosses as a view ─────────────────────────
|
||||
programs/dyn-view-any.flan: every integer width, f32, bool, str, a
|
||||
struct and a padded one, nested arrays, arrays and Vecs of structs,
|
||||
over locals, parameters, a temporary, a heap slice and an arena's Vec
|
||||
(mode 0); then one trap per mode. The traps a release build cannot
|
||||
see — a view kept past its frame, a slice kept past its Vec's growth,
|
||||
past a free, past a free-all — run under --dev only, on both
|
||||
backends. The survey's text was captured from the running program and
|
||||
is the same in all five builds. *)
|
||||
let any_out =
|
||||
"i8 [0 -1 -2]\nu8 [251 252 253]\ni16 [-299 301]\nu16 [60001 2]\n\
|
||||
i32 [-69999 70001]\nu32 [4000000001 2]\ni64 [-4 6]\n\
|
||||
u64 [9000000000000000001 2]\n253\n\
|
||||
f32 [2.75 3.1]\n2.75\n\
|
||||
bool [true true true]\ntrue\n\
|
||||
EIINNOORRSSTT\n\
|
||||
point #Point{:x 0.5 :y 3}\n40\n9.5\n9.5\n2\ntrue\n\
|
||||
mix #Mix{:a 7 :b -9000000000 :c 2.5 :d true :e [1 2 3] :f -4}\n65535\n\
|
||||
named #Named{:name \"ada\" :id 7}\n\
|
||||
grid [[1 2 3] [4 5 60]]\n60\n\
|
||||
points [#Point{:x 1 :y 1} #Point{:x 2 :y 20}]\n20\n\
|
||||
vec [1 2 3]\n3\n6\n5\n4\n3\n\
|
||||
temp #Point{:x 1.5 :y 2}\n4\n3\ntrue\n"
|
||||
in
|
||||
let any_traps =
|
||||
[ ("1", "300 does not fit a u8 element, which holds 0 to 255");
|
||||
("2", "this u64 element is 18000000000000000000, above the largest \
|
||||
dyn int");
|
||||
("3", "a Point has no field :z. Its fields are :x :y");
|
||||
("8", "a str element is read-only through a dyn view") ]
|
||||
and any_stale =
|
||||
[ ("4", "this view points into a local of leak-local, and that call \
|
||||
has returned");
|
||||
("5", "this view's storage, a block of i64, has been released");
|
||||
("6", "this view's storage, a block of i64, has been released");
|
||||
("7", "this view's storage, a block of i32, has been released") ]
|
||||
in
|
||||
let dyn_view_any ?opt ?(x86 = false) ?(dev = false) () =
|
||||
let exe = compile ?opt ~x86 ~dev "programs/dyn-view-any.flan" in
|
||||
let name what =
|
||||
"dyn: any container's view" ^ what
|
||||
^ (match opt with Some o -> ", " ^ o | None -> "")
|
||||
^ (if x86 then ", --x86" else "") ^ (if dev then ", --dev" else "")
|
||||
in
|
||||
let code, text = run exe (Some "0") in
|
||||
if code <> 0 || text <> any_out then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL %s\n got: %S (exit %d)\n wanted: %S\n"
|
||||
(name "") text code any_out
|
||||
end;
|
||||
List.iter
|
||||
(fun (mode, needle) ->
|
||||
let code, text = run exe (Some mode) in
|
||||
if code <> 134 || not (contains text needle) then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
"FAIL %s\n got: %S (exit %d)\n wanted a trap \
|
||||
saying %S\n" (name (", mode " ^ mode)) text code needle
|
||||
end)
|
||||
(any_traps @ if dev then any_stale else []);
|
||||
(try Sys.remove exe with Sys_error _ -> ())
|
||||
in
|
||||
dyn_view_any ();
|
||||
dyn_view_any ~opt:"-O0" ();
|
||||
dyn_view_any ~x86:true ();
|
||||
dyn_view_any ~dev:true ();
|
||||
dyn_view_any ~dev:true ~x86:true ();
|
||||
|
||||
(* The root count, which is the part of this feature the runs above cannot
|
||||
check — and the reason has outlived the stub it was first written
|
||||
about. flan_dyn.c's trigger has a one-megabyte floor, and not one
|
||||
|
||||
@ -1525,105 +1525,80 @@ let () =
|
||||
"(defonce v (Vec f64) (vec-new f64))\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take v))";
|
||||
(* The element restriction is still refused, and by name: a string element
|
||||
would need a dyn string's own boxing, whose payload is a pointer into
|
||||
the collector's heap, planted where nothing will ever trace it. *)
|
||||
rejects_check "a Vec of strings does not view into dyn yet"
|
||||
(* Every element a view can describe crosses: every number, bool, str,
|
||||
struct, and arrays, slices and Vecs of those. What cannot be described
|
||||
is refused by name — a pointer, an Option, a function, a map, an enum
|
||||
or a data type inside the container. *)
|
||||
accepts "a Vec of strings views into dyn, read-only"
|
||||
"(defonce v (Vec str) (vec-new str))\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take v))"
|
||||
~needle:"only when its elements are i64, f64 or bool";
|
||||
rejects_check "an i32 element is not one of the view's three"
|
||||
(defn main [] i32 (take v))";
|
||||
accepts "an i32 element views into dyn"
|
||||
"(defonce v (Vec i32) (vec-new i32))\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take v))";
|
||||
rejects_check "a Vec of pointers does not view into dyn"
|
||||
"(defonce v (Vec (Ptr i64)) (vec-new (Ptr i64)))\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take v))"
|
||||
~needle:"only when its elements are i64, f64 or bool";
|
||||
~needle:"a (Ptr i64) is none of these";
|
||||
rejects_check "a struct with an Option field names the field's type"
|
||||
"(defstruct Maybe [x (Option i64)])\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take (Maybe {.x None})))"
|
||||
~needle:"a (Option i64) is none of these";
|
||||
(* A typed (Map K V) is unrelated to item 3 and keeps its own refusal. *)
|
||||
rejects_check "a typed Map still refuses into dyn"
|
||||
"(defonce m (Map i64 i64) (map-new i64 i64))\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take m))"
|
||||
~needle:"does not cross into dyn yet";
|
||||
(* Which of the two refusals wins when both apply. A LOCAL (Vec string)
|
||||
fails the lifetime guard and the element check both, and the element
|
||||
one has to be the one that speaks: the lifetime message names
|
||||
(defonce g ...) as the spelling that works, and for a string element
|
||||
the global spelling is refused too, so the other order would hand back
|
||||
advice that fails when taken. *)
|
||||
rejects_check "a local Vec of strings gets the element refusal, not the \
|
||||
lifetime one"
|
||||
(* Any storage: a local, a parameter, a temporary, a slice bound to a
|
||||
local, an element of a global slice, and a container behind a pointer.
|
||||
A dev build checks each against its frame or its block at run time
|
||||
(test_acceptance.ml, dyn-view-any.flan); nothing is refused here. *)
|
||||
accepts "a local Vec views into dyn"
|
||||
"(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (let [v (vec-new str)] (take v)))"
|
||||
~needle:"only when its elements are i64, f64 or bool";
|
||||
(* ── The lifetime guard, added on review ─────────────────────────
|
||||
A local, a parameter and a temporary all answer false to
|
||||
[permanent_root], and each gets the same message rather than "cannot be
|
||||
indexed" or some other accident of which path noticed. *)
|
||||
rejects_check "a local Vec does not view into dyn — its frame ends"
|
||||
"(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (let [v (vec-new i64)] (take v)))"
|
||||
~needle:"only when it is a global";
|
||||
rejects_check "a Vec parameter does not view into dyn"
|
||||
(defn main [] i32 (let [v (vec-new i64)] (take v)))";
|
||||
accepts "a Vec parameter views into dyn"
|
||||
"(defn take [d dyn] i32 1)\n\
|
||||
(defn give [v (Vec i64)] i32 (take v))\n\
|
||||
(defn main [] i32 0)"
|
||||
~needle:"only when it is a global";
|
||||
rejects_check "a fixed array local does not view into dyn"
|
||||
(defn main [] i32 0)";
|
||||
accepts "a fixed array local views into dyn"
|
||||
"(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (let [a (array 4 i64)] (take a)))"
|
||||
~needle:"only when it is a global";
|
||||
(* A slice cut from a global is permanent; the same slice expression
|
||||
rebound to a local first loses the trace back to it and is refused —
|
||||
conservative rather than wrong, and the message says what does work. *)
|
||||
accepts "a slice cut from a global inline is still permanent"
|
||||
(defn main [] i32 (let [a (array 4 i64)] (take a)))";
|
||||
accepts "a slice cut from a global inline views into dyn"
|
||||
"(defonce xs [3 i64])\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take (slice xs 0 3)))";
|
||||
rejects_check "a slice rebound to a local loses the trace and is refused"
|
||||
accepts "a slice bound to a local views into dyn"
|
||||
"(defonce xs [3 i64])\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (let [s (slice xs 0 3)] (take s)))"
|
||||
~needle:"only when it is a global";
|
||||
(* An element of a global is permanent only when the global is an ARRAY.
|
||||
An array's elements are inside the global's own storage; a slice's are
|
||||
not — a global [[T]] holds ptr+len and nothing more, and what they
|
||||
point at may be a frame that has already returned. The refusal row
|
||||
below is one word different from the acceptance row above it, which is
|
||||
the point: it is the [At] arm's demand for an array at the level being
|
||||
indexed and nothing else deciding. Before that guard the refusal row
|
||||
compiled and segfaulted with no diagnostic at all. *)
|
||||
accepts "an element of a global array is permanent"
|
||||
(defn main [] i32 (let [s (slice xs 0 3)] (take s)))";
|
||||
accepts "an element of a global array views into dyn"
|
||||
"(defonce rows [2 (Vec i64)])\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take (at rows 0)))";
|
||||
rejects_check "an element of a global slice is not permanent"
|
||||
accepts "an element of a global slice views into dyn"
|
||||
"(defonce sv [(Vec i64)])\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take (at sv 0)))"
|
||||
~needle:"only when it is a global";
|
||||
(* [(at g i j)] is ONE typed node holding both indices, not two nested
|
||||
ones, so a guard that reads the target's type alone sees level zero and
|
||||
nothing after it. These two rows pin the multi-index spelling on both
|
||||
sides: every level an array is permanent, and a slice at ANY level is
|
||||
not — including the second, which the one-level guard accepted and
|
||||
which then printed a dead frame's contents with exit 0. *)
|
||||
accepts "an element of a global array of arrays is permanent"
|
||||
(defn main [] i32 (take (at sv 0)))";
|
||||
accepts "an element of a global array of arrays views into dyn"
|
||||
"(defonce rows [2 [3 (Vec i64)]])\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take (at rows 0 1)))";
|
||||
rejects_check "an element reached through a slice level is not permanent"
|
||||
accepts "an element reached through a slice level views into dyn"
|
||||
"(defonce g [2 [[3 i64]]])\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take (at g 0 1)))"
|
||||
~needle:"only when it is a global";
|
||||
(* A Vec behind a Ptr is refused even though some Ptrs really are
|
||||
heap-durable — the checker cannot tell this one from a Ptr taken off a
|
||||
local, and admitting one admits the other. *)
|
||||
rejects_check "a Vec behind a Ptr does not view into dyn"
|
||||
(defn main [] i32 (take (at g 0 1)))";
|
||||
accepts "a Vec behind a Ptr views into dyn"
|
||||
"(defn take [d dyn] i32 1)\n\
|
||||
(defn use [p (Ptr (Vec i64))] i32 (take (deref p)))\n\
|
||||
(defn main [] i32 0)"
|
||||
~needle:"only when it is a global";
|
||||
(defn main [] i32 0)";
|
||||
accepts "a struct views into dyn"
|
||||
"(defstruct P [x f32 y u8])\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (let [p (P {.x 1.0 .y 2})] (take p)))";
|
||||
(* A bracket *literal* is not a typed container yet, and where a dyn is
|
||||
wanted it builds the runtime's own vec instead — the lowering the map
|
||||
literal's values ride on, and what makes {:xs [1 2]} mean what it
|
||||
@ -3700,12 +3675,10 @@ let () =
|
||||
|
||||
The three-element spelling does not mean this, and could not. A defonce
|
||||
whose third element is not a type is a *dyn* global by the 2026-09-20
|
||||
rule, and a typed fixed array crosses into dyn only as a view of storage
|
||||
that outlives the view. A freshly built array is a temporary, so the view
|
||||
lifetime guard refuses it — and where the elements are an array rather
|
||||
than one of the three scalar widths a view carries, the element refusal
|
||||
gets there first. Both refusals are the ones any other temporary gets;
|
||||
neither was written for this form. *)
|
||||
rule, and a typed fixed array crosses into dyn as a view of its
|
||||
storage. A freshly built array is the initialiser's temporary, gone when
|
||||
the initialiser returns, so a view of it is refused there by name with
|
||||
the typed spelling as the fix. *)
|
||||
defvar_reading "a typed array-fill global is computed, not zeroed"
|
||||
"(defconst rows 2) (defconst cols 3)\n\
|
||||
(defonce grid [rows [cols u8]] (array-fill [rows cols] 255))\n\
|
||||
@ -3713,10 +3686,11 @@ let () =
|
||||
"grid" ~ty:"[2 [3 u8]]" ~zeroed:false;
|
||||
rejects_check "a three-element array-fill defonce is the dyn reading"
|
||||
"(defonce xs (array-fill [3] (i64 1))) (defn f [] ())"
|
||||
~needle:"only when it is a global";
|
||||
rejects_check "and its element type is asked about first"
|
||||
~needle:"xs is a dyn global, and its initialiser builds a [3 i64] that is \
|
||||
gone once the initialiser returns";
|
||||
rejects_check "and the fix it names is the typed spelling"
|
||||
"(defonce grid (array-fill [2 3] 255)) (defn f [] ())"
|
||||
~needle:"only when its elements are i64, f64 or bool";
|
||||
~needle:"as in (defonce grid [2 [3 i32]] ...)";
|
||||
(* A defconst is not a second path to it: its value is what the linker
|
||||
writes into the image, and a fill is a loop. *)
|
||||
rejects_check "array-fill is not a constant's value"
|
||||
@ -7664,14 +7638,18 @@ let () =
|
||||
infers "the names the element type of a mixed literal" "(the [dyn] [1 2.5])" "[2 dyn]";
|
||||
infers "the with a slice type gives the literal's array type"
|
||||
"(the [f32] [1 2.5])" "[2 f32]";
|
||||
(match checked "(defstruct P [x i32]) (defn main [] i32 (let [a [(P 1) 2]] 0))" with
|
||||
| _ -> check "a struct beside a number is refused" false
|
||||
(* A struct crosses into dyn as a view, so a struct beside a number is a dyn
|
||||
vector; a pointer has no dyn form, so it is refused against the first. *)
|
||||
accepts "a struct beside a number is a dyn vector"
|
||||
"(defstruct P [x i32]) (defn main [] i32 (let [a [(P 1) 2]] (println a) 0))";
|
||||
(match checked "(defn main [] i32 (let [x 1 a [(addr x) 2]] 0))" with
|
||||
| _ -> check "a pointer beside a number is refused" false
|
||||
| exception Loc.Error d ->
|
||||
check "elements that cannot become a dyn are refused against the first"
|
||||
(contains d.Loc.dmsg "expected P, found the integer literal 2"
|
||||
(contains d.Loc.dmsg "expected (Ptr i32), found the integer literal 2"
|
||||
&& List.exists
|
||||
(fun (n : Loc.note) ->
|
||||
contains n.Loc.nmsg "this array's first element is P")
|
||||
contains n.Loc.nmsg "this array's first element is (Ptr i32)")
|
||||
d.Loc.notes));
|
||||
(match checked "(defn g [x $t] i32 (let [a [x 1]] 0))" with
|
||||
| _ -> check "a type variable beside a literal is refused" false
|
||||
|
||||
@ -262,6 +262,10 @@ let corpus =
|
||||
view that grows and moves the Vec leaves anything for ASan's
|
||||
use-after-free detection to find. *)
|
||||
"programs/dyn-view.flan", [ "0" ];
|
||||
(* Views of every element type over locals, parameters, a temporary, a
|
||||
heap slice and an arena's Vec: the offsets the runtime computes from
|
||||
a descriptor, read and written under ASan. *)
|
||||
"programs/dyn-view-any.flan", [ "0" ];
|
||||
"programs/x86-p13-dyn-collect.flan", [];
|
||||
"programs/sand-headless.flan", [];
|
||||
"programs/signedness.flan", [];
|
||||
|
||||
@ -930,46 +930,54 @@ let checks name text =
|
||||
let () =
|
||||
let poke_fln = "fn poke(coll) -> dyn\n coll[0] = 99\n coll\n\n" in
|
||||
let poke_flan = "(defn poke [coll] dyn (set (at coll 0) 99) coll)\n" in
|
||||
(* A typed local is not a global, so no dyn value may see into it. *)
|
||||
(* A container of pointers has no dyn view, and the refusal's subject and
|
||||
fix follow what the container is: a local, a temporary, a parameter. *)
|
||||
refused "view-local.fln"
|
||||
(poke_fln ^ "fn main() -> ()\n let a: [4 i64] = [6 2 4 9]\n poke(a)\n")
|
||||
[ "a is a [4 i64], and a dyn value is wanted here";
|
||||
"a local, a parameter or a temporary";
|
||||
(poke_fln ^ "fn main() -> ()\n let a = vec-new(Ptr(i64))\n poke(a)\n")
|
||||
[ "a is a Vec(Ptr(i64)), and a dyn value is wanted here";
|
||||
"a Ptr(i64) is none of these";
|
||||
"as in let a: dyn = [...]" ];
|
||||
refused "view-local.flan"
|
||||
(poke_flan ^ "(defn main [] () (let [a (array 4 i64)] (poke a)))\n")
|
||||
[ "a is a [4 i64]"; "as in (let [a (the dyn [...])] ...)" ];
|
||||
(poke_flan ^ "(defn main [] () (let [a (vec-new (Ptr i64))] (poke a)))\n")
|
||||
[ "a is a (Vec (Ptr i64))"; "as in (let [a (the dyn [...])] ...)" ];
|
||||
refused "view-temp.flan"
|
||||
(poke_flan ^ "(defn main [] () (poke (array 4 i64)))\n")
|
||||
[ "This is a [4 i64]"; "as in (the dyn [...])" ];
|
||||
(* An unannotated literal is [4 i32], whose elements no view carries. *)
|
||||
refused "view-elem.fln"
|
||||
(poke_fln ^ "fn main() -> ()\n let d = [6 2 4 9]\n poke(d)\n")
|
||||
[ "d is a [4 i32]"; "only when its elements are i64, f64 or bool, and these are i32";
|
||||
"as in let d: dyn = [...]" ];
|
||||
(poke_flan ^ "(defn main [] () (poke (vec-new (Ptr i64))))\n")
|
||||
[ "This is a (Vec (Ptr i64))"; "as in (the dyn [...])" ];
|
||||
(* Any storage and any number crosses: a local [4 i32] is a view. *)
|
||||
checks "view-elem.fln"
|
||||
(poke_fln ^ "fn main() -> ()\n let d = [6 2 4 9]\n poke(d)\n");
|
||||
(* A parameter is made by the caller, so its fix is its declaration. *)
|
||||
refused "view-param.fln"
|
||||
"fn take(d) -> i32 = 1\n\nfn give(n: i32, v: [4 i64]) -> i32\n take(v)\n\n\
|
||||
"fn take(d) -> i32 = 1\n\nfn give(n: i32, v: [Ptr(i64)]) -> i32\n take(v)\n\n\
|
||||
fn main() -> i32 = 0\n"
|
||||
[ "v is a [4 i64] parameter"; "Declare v as dyn in give's parameters: v: dyn" ];
|
||||
[ "v is a [Ptr(i64)] parameter"; "Declare v as dyn in give's parameters: v: dyn" ];
|
||||
refused "view-param.flan"
|
||||
"(defn take [d dyn] i32 1)\n(defn give [n i32 v (Vec i64)] i32 (take v))\n\
|
||||
"(defn take [d dyn] i32 1)\n(defn give [n i32 v (Vec (Ptr i64))] i32 (take v))\n\
|
||||
(defn main [] i32 0)\n"
|
||||
[ "v is a (Vec i64) parameter"; "Declare v as dyn in give's parameters: v dyn" ];
|
||||
[ "v is a (Vec (Ptr i64)) parameter"; "Declare v as dyn in give's parameters: v dyn" ];
|
||||
checks "view-param-fix.fln"
|
||||
"fn take(d) -> i32 = 1\n\nfn give(n: i32, v: dyn) -> i32\n take(v)\n\n\
|
||||
fn main() -> i32 = 0\n";
|
||||
(* A global's fix redefines it, in the form it was defined with. *)
|
||||
let show_flan = "(defn show [d dyn] i32 1)\n" in
|
||||
refused "view-global.flan"
|
||||
("(defonce gs [2 i32] [1 2])\n" ^ show_flan ^ "(defn main [] i32 (show gs))\n")
|
||||
[ "gs is a [2 i32]"; "as in (defonce gs dyn [...])" ];
|
||||
("(defonce gs (Vec (Ptr i32)) (vec-new (Ptr i32)))\n" ^ show_flan
|
||||
^ "(defn main [] i32 (show gs))\n")
|
||||
[ "gs is a (Vec (Ptr i32))"; "as in (defonce gs dyn [...])" ];
|
||||
refused "view-global-def.flan"
|
||||
("(def gs [2 i32] [1 2])\n" ^ show_flan ^ "(defn main [] i32 (show gs))\n")
|
||||
("(def gs (Vec (Ptr i32)) (vec-new (Ptr i32)))\n" ^ show_flan
|
||||
^ "(defn main [] i32 (show gs))\n")
|
||||
[ "as in (def gs dyn [...])" ];
|
||||
refused "view-global.fln"
|
||||
"once gs: [2 i32] = [1 2]\n\nfn show(d) -> i32 = 1\n\nfn main() -> i32 = show(gs)\n"
|
||||
[ "gs is a [2 i32]"; "as in once gs: dyn = [...]" ];
|
||||
"once gs: Vec(Ptr(i32)) = vec-new(Ptr(i32))\n\nfn show(d) -> i32 = 1\n\n\
|
||||
fn main() -> i32 = show(gs)\n"
|
||||
[ "gs is a Vec(Ptr(i32))"; "as in once gs: dyn = [...]" ];
|
||||
checks "view-global-typed.flan"
|
||||
("(defonce gs [2 i32] [1 2])\n" ^ show_flan ^ "(defn main [] i32 (show gs))\n");
|
||||
(* A dyn global's initialiser cannot view what it builds itself. *)
|
||||
refused "view-global-init.fln"
|
||||
"once xs = array-fill([3], i64(1))\n\nfn main() -> i32 = 0\n"
|
||||
[ "xs is a dyn global"; "as in once xs: [3 i64] = ..." ];
|
||||
checks "view-global-fix.flan"
|
||||
("(defonce gs dyn [1 2])\n(def hs dyn [1 2])\n" ^ show_flan
|
||||
^ "(defn main [] i32 (show gs) (show hs))\n");
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user