A view describes a struct from its own program's table, and an Option's payload is bound to a slot before it is viewed.
This commit is contained in:
parent
8291e62d7a
commit
d5d9dc1538
29
lib/check.ml
29
lib/check.ml
@ -354,9 +354,9 @@ type env = {
|
||||
mutable guard_next : bool;
|
||||
}
|
||||
|
||||
(* 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]. *)
|
||||
(* The struct table [box] describes a struct from when it was handed no
|
||||
[ctx]: the newest program's, set by [new_env]. Every caller that has a
|
||||
[ctx] passes it, so its own program's table is the one read. *)
|
||||
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
|
||||
@ -3640,7 +3640,7 @@ let no_dyn_yet loc ~into t extra =
|
||||
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 rec view_desc structs (t : Types.t) : (string, Types.t) result =
|
||||
let ( let* ) = Result.bind in
|
||||
match t with
|
||||
| Types.Int k ->
|
||||
@ -3652,19 +3652,19 @@ let rec view_desc (t : Types.t) : (string, Types.t) result =
|
||||
| Types.Bool -> Ok "?"
|
||||
| Types.String -> Ok "t"
|
||||
| Types.Array (n, e) ->
|
||||
let* d = view_desc e in
|
||||
let* d = view_desc structs 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.Slice (Types.Mut, e) -> let* d = view_desc structs e in Ok ("s" ^ d)
|
||||
| Types.Vec e -> let* d = view_desc structs e in Ok ("v" ^ d)
|
||||
| Types.Named n ->
|
||||
(match Hashtbl.find_opt !view_structs n with
|
||||
(match Hashtbl.find_opt 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
|
||||
let* d = view_desc structs fl.Tast.fty in
|
||||
Ok ((fl.Tast.fname ^ ";" ^ d) :: acc))
|
||||
(Ok []) st.Tast.fields
|
||||
in
|
||||
@ -4049,6 +4049,9 @@ let refuse_frame_escapes (f : Tast.fn) =
|
||||
|
||||
let box ?ctx loc (e : Tast.expr) : Tast.expr =
|
||||
let dyn sym args = rt loc Types.Dyn sym args in
|
||||
let structs =
|
||||
match ctx with Some c -> c.env.structs | None -> !view_structs
|
||||
in
|
||||
match e.Tast.ty with
|
||||
| Types.Dyn -> e
|
||||
| Types.Int _ -> dyn "flan_dyn_from_i64" [ widen loc dyn_i64 e ]
|
||||
@ -4085,10 +4088,10 @@ let box ?ctx loc (e : Tast.expr) : Tast.expr =
|
||||
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
|
||||
| Types.Named n -> Hashtbl.mem structs n
|
||||
| _ -> true) ->
|
||||
let desc_of t =
|
||||
match view_desc t with
|
||||
match view_desc structs t with
|
||||
| Ok d -> mk loc Types.String (Tast.Str d)
|
||||
| Error inner -> view_not_yet loc e inner
|
||||
in
|
||||
@ -4325,7 +4328,7 @@ let box_option ctx loc (t : Types.t) (got : Tast.expr) : Tast.expr =
|
||||
run time and the conversion is free on both backends. *)
|
||||
match got.Tast.e with
|
||||
| Tast.None_ -> rt loc Types.Dyn "flan_dyn_nil" []
|
||||
| Tast.Some_ x -> if Types.equal t Types.Dyn then x else box loc x
|
||||
| Tast.Some_ x -> if Types.equal t Types.Dyn then x else box ~ctx loc x
|
||||
| _ ->
|
||||
let s = fresh_slot ctx (Types.Option t) in
|
||||
let sv = mk loc (Types.Option t) (Tast.Local s) in
|
||||
@ -4336,7 +4339,7 @@ let box_option ctx loc (t : Types.t) (got : Tast.expr) : Tast.expr =
|
||||
[ tag; mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ]))
|
||||
in
|
||||
let payload = mk loc t (Tast.Field (sv, 1)) in
|
||||
let some_dyn = if Types.equal t Types.Dyn then payload else box loc payload in
|
||||
let some_dyn = if Types.equal t Types.Dyn then payload else box ~ctx loc payload in
|
||||
let none_dyn = rt loc Types.Dyn "flan_dyn_nil" [] in
|
||||
mk loc Types.Dyn
|
||||
(Tast.Let ([ (s, got) ],
|
||||
|
||||
@ -3127,7 +3127,8 @@ 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;
|
||||
struct flan_frame;
|
||||
extern struct flan_frame *flan_frame_head; /* runtime/flan_dev.c */
|
||||
|
||||
#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 */
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user