From 43c7494d54ed59bf58be6ee3179f952976c57a7b Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 16:40:39 +0700 Subject: [PATCH] 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 | 54 ++++++++++++++++++++++++++++------- test/programs/grow-param.flan | 14 ++++++++- test/test_acceptance.ml | 4 +-- test/test_flan.ml | 19 ++++++++++++ 4 files changed, 77 insertions(+), 14 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index bee40258..8b40ec8f 100644 --- a/lib/check.ml +++ b/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 - | 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 | _ -> ()) | _ -> () diff --git a/test/programs/grow-param.flan b/test/programs/grow-param.flan index a3f12362..4e0186c4 100644 --- a/test/programs/grow-param.flan +++ b/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) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 67e90db1..ffdc2da2 100644 --- a/test/test_acceptance.ml +++ b/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"; diff --git a/test/test_flan.ml b/test/test_flan.ml index 6b4d9986..f0b689f6 100644 --- a/test/test_flan.ml +++ b/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 :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)))"