JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A Vec or Map field grown through a struct parameter taken by value is warned at the parameter, naming the field path and the (Ptr ...) that reaches the caller's

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 16:40:39 +07:00
parent 00fd022330
commit 43c7494d54
4 changed files with 77 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
lib/check.ml
View File

@ -4190,8 +4190,28 @@ let grow_params : (ctx * (int * Ast.field) list) list ref = ref []
let grow_warnings : Loc.diag list ref = ref []
let note_grown ctx op loc (target : Tast.expr) =
match target.Tast.e, target.Tast.ty, !grow_params with
| Tast.Local s, ((Types.Vec _ | Types.Map _) as t), (c, ps) :: _ when c == ctx ->
(* The parameter the container is reached from, through struct fields
taken by value — a field of a parameter is in the parameter's copy too —
and the path written back out. A [Deref] ends the walk: through a
pointer the caller's own storage is what grows. *)
let rec root (e : Tast.expr) =
match e.Tast.e with
| Tast.Local s -> Some (s, fun p -> p)
| Tast.Field (inner, i) ->
(match inner.Tast.ty with
| Types.Named n ->
(match Hashtbl.find_opt ctx.env.structs n with
| Some st when i < List.length st.Tast.fields ->
let f = (List.nth st.Tast.fields i).Tast.fname in
Option.map
(fun (s, path) -> (s, fun p -> Printf.sprintf "(.%s %s)" f (path p)))
(root inner)
| _ -> None)
| _ -> None)
| _ -> None
in
match target.Tast.ty, root target, !grow_params with
| ((Types.Vec _ | Types.Map _) as t), Some (s, path), (c, ps) :: _ when c == ctx ->
(match List.assoc_opt s ps with
| Some (p : Ast.field)
when not
@ -4199,16 +4219,28 @@ let note_grown ctx op loc (target : Tast.expr) =
(fun (d : Loc.diag) -> d.Loc.dloc = p.Ast.floc)
!grow_warnings) ->
let ts = Types.to_string t in
let msg =
match target.Tast.e with
| Tast.Local _ ->
Printf.sprintf
"%s is a %s passed by value, a copy of the caller's header, so \
the %s at %s grows this function's copy and the caller's \
container never sees it. Take it as (Ptr %s) and write (%s \
(deref %s) ...), and each caller passes (addr c) for its \
container c"
p.Ast.fname ts op (Loc.to_string loc) ts op p.Ast.fname
| _ ->
let pt = Types.to_string (List.nth ctx.slot_tys (ctx.slots - 1 - s)) in
Printf.sprintf
"%s is a %s passed by value, a copy of the caller's, so the %s \
at %s grows %s in this function's copy and the caller's never \
sees it. Take it as (Ptr %s), where %s reaches the caller's own, \
and each caller passes (addr c) for its %s c"
p.Ast.fname pt op (Loc.to_string loc) (path p.Ast.fname) pt
(path p.Ast.fname) pt
in
grow_warnings :=
Loc.diag ~kind:"check/grown-parameter" p.Ast.floc
(Printf.sprintf
"%s is a %s passed by value, a copy of the caller's header, so \
the %s at %s grows this function's copy and the caller's \
container never sees it. Take it as (Ptr %s) and write (%s \
(deref %s) ...), and each caller passes (addr c) for its \
container c"
p.Ast.fname ts op (Loc.to_string loc) ts op p.Ast.fname)
:: !grow_warnings
Loc.diag ~kind:"check/grown-parameter" p.Ast.floc msg :: !grow_warnings
| _ -> ())
| _ -> ()

14
test/programs/grow-param.flan
View File

@ -1,11 +1,17 @@
;;;; A container parameter is a copy of the caller's header. Growing it grows
;;;; the copy, so the caller's container does not see the push; the function
;;;; is warned at, at the parameter, and the fix it names is the (Ptr ...)
;;;; below, which reaches the caller's own header.
;;;; below, which reaches the caller's own header. A struct passed by value
;;;; is a copy too, with its Vec fields in it, and is warned at the same way.
(defstruct Bag [items (Vec i32) n i32])
(defstruct Box [bag Bag])
(defn add-copy [v (Vec i32)] () (push v 1) (free v))
(defn add-ptr [v (Ptr (Vec i32))] () (push (deref v) 2))
(defn put-ptr [m (Ptr (Map i32 i32))] () (put (deref m) 7 8))
(defn bag-copy [b Bag] () (push (.items b) 1) (free (.items b)))
(defn bag-ptr [x (Ptr Box)] () (push (.items (.bag x)) 3))
(defn main [] i32
(let [v (vec-new i32)
@ -20,4 +26,10 @@
(println (length m)) ; 1
(free v)
(free m))
(let [x (Box {.bag (Bag {.items (vec-new i32) .n 0})})]
(bag-copy (.bag x))
(println (length (.items (.bag x)))) ; 0
(bag-ptr (addr x))
(println (at (.items (.bag x)) 0)) ; 3
(free (.items (.bag x))))
0)

4
test/test_acceptance.ml
View File

@ -628,9 +628,9 @@ let () =
outputs ~x86:true "a program's names and the prelude's, --x86"
"programs/prelude-names.flan" "3\n6\n7\n5\n1\n";
(* A grown container parameter reaches the caller only through a Ptr. *)
outputs "a grown parameter" "programs/grow-param.flan" "0\n2\n2\n1\n";
outputs "a grown parameter" "programs/grow-param.flan" "0\n2\n2\n1\n0\n3\n";
outputs ~x86:true "a grown parameter, --x86" "programs/grow-param.flan"
"0\n2\n2\n1\n";
"0\n2\n2\n1\n0\n3\n";
outputs "into with (map clone)" "programs/into-owning.flan" "1\n1\n101\n99\n";
outputs ~x86:true "into with (map clone), --x86" "programs/into-owning.flan"
"1\n1\n101\n99\n";

19
test/test_flan.ml
View File

@ -5896,6 +5896,25 @@ let () =
| Some ds ->
check (Printf.sprintf "two grow warnings, not %d" (List.length ds)) false
| None -> check "the grown-parameter program checks" false);
(* A struct parameter is a copy with its Vec fields in it, through any
depth of fields taken by value; through a pointer, not. *)
(match
grown "(defstruct Bag [items (Vec i32)])\n(defstruct Box [bag Bag])\n\
(defn f [x Box] () (push (.items (.bag x)) 1))\n\
(defn g [x (Ptr Box)] () (push (.items (.bag x)) 1))"
with
| Some [ d ] ->
check "a grown field of a struct parameter is warned at the parameter"
(d.Loc.dloc.Loc.line = 3 && d.Loc.dloc.Loc.col = 10
&& d.Loc.dmsg
= "x is a Box passed by value, a copy of the caller's, so the push \
at <test>:3:20 grows (.items (.bag x)) in this function's copy \
and the caller's never sees it. Take it as (Ptr Box), where \
(.items (.bag x)) reaches the caller's own, and each caller \
passes (addr c) for its Box c")
| Some ds ->
check (Printf.sprintf "one field grow warning, not %d" (List.length ds)) false
| None -> check "the grown-field program checks" false);
check "a pointer parameter and a local are not warned at"
(grown "(defn f [v (Ptr (Vec i32))] ()\n\
\ (push (deref v) 1) (let [w (vec-new i32)] (push w 1) (free w)))"