diff --git a/lib/check.ml b/lib/check.ml index 6ca2fdd4..52ffac86 100644 --- a/lib/check.ml +++ b/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) ], diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 0e7823d8..5c69d5fb 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -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 */