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

lib/check.ml

@@ -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
+  (* The parameter the container is reached from, through struct fields
-  | Tast.Local s, ((Types.Vec _ | Types.Map _) as t), (c, ps) :: _ when c == ctx ->
+     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
+         Loc.diag ~kind:"check/grown-parameter" p.Ast.floc msg :: !grow_warnings
-           (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
      | _ -> ())
   | _ -> ()
 

test/programs/grow-param.flan

@@ -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)

test/test_acceptance.ml

@@ -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";

test/test_flan.ml

@@ -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)))"