diff --git a/TODO.org b/TODO.org index b92a4f8e..32de7f60 100644 --- a/TODO.org +++ b/TODO.org @@ -630,12 +630,6 @@ generic binding — saying =$= marks a type variable and naming the bare spelling. A =defn= parameter was already refused, as a type in a name slot. -** NEXT A container parameter the function grows is warned at -Decided 2026-09-25: Odin's behaviour stays — a Vec or Map passed by value is a -copy of its header, so growth inside the callee does not reach the caller. A -parameter the function grows (push, put, reserve, anything that can reallocate) -gets a warning at the parameter suggesting (Ptr ...). - ** CANCELLED not= as a spelling of != CLOSED: [2026-09-25] One spelling for one operation; != stays, and not= is refused with a suggestion diff --git a/lib/check.ml b/lib/check.ml index aee64ee2..c077e403 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -4150,6 +4150,39 @@ let tracked_call loc env name (tr : Shim.track) ret (args : Tast.expr list) = let truthy_failed : (Ast.expr * ctx * Loc.diag) list ref = ref [] let truthy_depth = ref 0 + +(* A Vec or a Map parameter is a copy of the caller's header — Odin's rule — + so growing it reallocates a block only this function's copy points at, and + the caller's container never sees the elements. The function being checked + and its container parameters, by slot, and the warnings found so far, one + per parameter, printed by [build_program]. A stack because a generic's copy + is checked from inside the body that called it. *) +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 -> + (match List.assoc_opt s ps with + | Some (p : Ast.field) + when not + (List.exists + (fun (d : Loc.diag) -> d.Loc.dloc = p.Ast.floc) + !grow_warnings) -> + let ts = Types.to_string t 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 + | _ -> ()) + | _ -> () + let rec check ctx ?want (e : Ast.expr) : Tast.expr = let place = ctx.place_ok in ctx.place_ok <- false; @@ -9197,6 +9230,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = [ target; check ctx ~want:Types.Dyn x; here loc ]) else begin let elem = vec_elem loc "push" target.Tast.ty in + note_grown ctx "push" loc target; let x = check ctx ~want:elem x in (* The element is bound before the loop so that a [retry] re-attempts the allocation and not the expression that produced the value. *) @@ -9228,6 +9262,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = let target = check_target ctx target in refuse_const_change ctx loc target; let n = check ctx ~want:index_ty n in + note_grown ctx "reserve" loc target; let n64 = mk loc (Types.Int Types.I64) (Tast.Prim (Tast.Cast (Types.Int Types.I64), [ n ])) in @@ -9524,6 +9559,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = check ctx ~want:Types.Dyn v; here loc ]) else begin let kt, vt = map_kv loc "put" target.Tast.ty in + note_grown ctx "put" loc target; let k = check ctx ~want:kt k in let v = check ctx ~want:vt v in (* Deferred: the arguments are checked — so a move here is still a move @@ -12866,6 +12902,15 @@ let rec check_fn env (fn : Ast.fn) : Tast.fn = end; ignore (bind ctx p.Ast.fname ty ~assignable:false)) fn.Ast.params params; + let grow_saved = !grow_params in + grow_params := + ( ctx, + List.filter_map + (fun (p : Ast.field) -> + Option.map (fun b -> (b.slot, p)) (List.assoc_opt p.Ast.fname ctx.scope)) + fn.Ast.params ) + :: grow_saved; + Fun.protect ~finally:(fun () -> grow_params := grow_saved) @@ fun () -> let body = match fn.Ast.fbody with | [] -> @@ -14158,6 +14203,7 @@ let build_program ~keep_going ?tolerate (decls : Ast.decl list) : time it runs every signature is sound, so a body that fails to check cannot make the next body fail — which is what makes a declaration a resync point that needs no resynchronising. *) + grow_warnings := []; let decls = collect env decls in if !print_warnings then List.iter @@ -14211,6 +14257,12 @@ let build_program ~keep_going ?tolerate (decls : Ast.decl list) : | _ -> None) decls in + if !print_warnings then + List.iter + (fun (d : Loc.diag) -> + prerr_endline + (Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg)) + (List.rev !grow_warnings); Loc.finish s; (* The handler clauses lifted out along the way. They are ordinary functions from here down; nothing in the backend knows they were written inside diff --git a/test/programs/grow-param.flan b/test/programs/grow-param.flan new file mode 100644 index 00000000..a3f12362 --- /dev/null +++ b/test/programs/grow-param.flan @@ -0,0 +1,23 @@ +;;;; 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. + +(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 main [] i32 + (let [v (vec-new i32) + m (map-new i32 i32)] + (add-copy v) + (println (length v)) ; 0 + (add-ptr (addr v)) + (add-ptr (addr v)) + (println (length v)) ; 2 + (println (at v 1)) ; 2 + (put-ptr (addr m)) + (println (length m)) ; 1 + (free v) + (free m)) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 23d96f21..b3869e17 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -622,6 +622,10 @@ let () = "7 8 9 \n2 4 6 8 10 12 \n4 8 12 \n21\n6 2 4 \n3 1 2 \n3 4 \n2 4 \n1\n"; (* The fix into's refusal names for owning elements, (map clone): the copy's inner Vec grows on the heap and the source's is untouched. *) + (* 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 ~x86:true "a grown parameter, --x86" "programs/grow-param.flan" + "0\n2\n2\n1\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 1e20a2e4..6150470e 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -5837,6 +5837,39 @@ let () = (Printf.sprintf "one pairing warning, not %d" (List.length ds)) false) | exception Loc.Error _ -> check "the paired program checks" false); + (* A Vec or Map parameter is the caller's header copied, so growing it is + warned at the parameter, once, naming the (Ptr ...) that reaches the + caller's own. A pointer parameter and a local are not warned at. The + running side is programs/grow-param.flan. *) + let grown src = + match checked src with + | _ -> Some !Check.grow_warnings + | exception Loc.Error _ -> None + in + (match + grown "(defn f [v (Vec i32) m (Map i32 i32)] ()\n\ + \ (push v 1) (reserve v 8) (put m 1 2))" + with + | Some [ dm; dv ] -> + check "a grown Vec parameter is warned at the parameter" + (dv.Loc.kind = "check/grown-parameter" + && dv.Loc.dloc.Loc.line = 1 && dv.Loc.dloc.Loc.col = 10 + && dv.Loc.dmsg + = "v is a (Vec i32) passed by value, a copy of the caller's header, \ + so the push at :2:3 grows this function's copy and the \ + caller's container never sees it. Take it as (Ptr (Vec i32)) \ + and write (push (deref v) ...), and each caller passes (addr c) \ + for its container c"); + check "and a grown Map parameter names put" + (dm.Loc.dloc.Loc.col = 22 + && Test_support.contains dm.Loc.dmsg "the put at :2:28") + | Some ds -> + check (Printf.sprintf "two grow warnings, not %d" (List.length ds)) false + | None -> check "the grown-parameter 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)))" + = Some []); check "a program that shadows nothing is warned at not at all" (Check.shadowed_builtins (program "(defn f [] i32 1)") = []); (* A prelude function's name is taken over the same way, for the calls in