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

into refuses to copy elements that own storage as they stand, and names (map clone) where clone takes the element

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 15:22:44 +07:00
parent e2aa0196cf
commit 5b8c4a68fa
5 changed files with 175 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

106
lib/check.ml
View File

@ -2429,6 +2429,49 @@ and const_steps ro (ty : Types.t) n =
let const_copy env (e : Types.t) =
if owning env e || holds_dyn env e then None else Some "(clone v)"
(* Whether (clone x) accepts a value of this type — the same arms the clone
builtin takes: a Vec or a Map whose elements own nothing, or a slice whose
elements neither own storage nor hold a dyn. *)
let clone_accepts env (t : Types.t) =
match t with
| Types.Vec _ | Types.Map _ -> not (region_only env t)
| Types.Slice (_, e) -> not (owning env e || holds_dyn env e)
| _ -> false
(* The end of clone's refusal for a container of owning elements. Pushing
the elements themselves into a second container would copy their headers
and share their blocks, so the advice is a copy of each element where
clone takes one, and otherwise that there is no copy to make. *)
let insert_copies env (t : Types.t) =
let elem =
match t with
| Types.Vec e | Types.Slice (_, e) | Types.Map (_, e) -> Some e
| _ -> None
in
match elem with
| Some e when clone_accepts env e ->
"Build a second container and push a (clone x) of each element into it"
| Some e ->
Printf.sprintf
"Nothing copies what a %s owns either, so read the elements where they \
are"
(Types.to_string e)
| None -> "Build a second container and insert into it"
(* A call written back out as source, for a fix that has to repeat what the
reader wrote: names, integers and calls of those. Anything else is [None]
and the caller says the fix in words. *)
let rec spell_form (a : Ast.expr) =
match a.Ast.e with
| Ast.Var v -> Some v
| Ast.Int n -> Some (Int64.to_string n)
| Ast.UInt (_, s) -> Some s
| Ast.Call (f, args) ->
let parts = List.map spell_form (f :: args) in
if List.mem None parts then None
else Some ("(" ^ String.concat " " (List.filter_map Fun.id parts) ^ ")")
| _ -> None
(* A store through a read-only view: a [[const T]] or a (Ptr const T). *)
let refuse_const_place env loc (view : Types.t) =
match view with
@ -9136,6 +9179,57 @@ and named_call ?(qualified = false) ctx ~want loc name args =
fail loc
"free takes an owning container — a Vec or a Map — found %s"
(Types.to_string other))
(* Emitted by the prelude's [into] when no (map f) is in the chain, so that
every element pushed is a source element as it stands. A push copies an
element's header, and for an element that owns storage the copy and the
source then share one block: growing an element through either side
reallocates it and frees the block the other still points at. That is a
use after free the program never wrote, under a name that promised a
copy, so it is refused here. A bare (push w (at v 0)) is not: it copies a
header in plain sight, the Odin contract every container follows.
Arguments are the source, then the destination and the transforms as
written — those two only to be spelled back in the fix, never checked. *)
| "into-copies-elements" ->
(match args with
| src :: dst :: transforms ->
let s = check ctx src in
let elem =
match s.Tast.ty with
| Types.Vec e | Types.Slice (_, e) | Types.Array (_, e) -> Some e
| _ -> None
in
(match elem with
| Some e when owning ctx.env e ->
let v = spell_arg "v" src in
let et = Types.to_string e in
let fix =
if clone_accepts ctx.env e then
match spell_form dst, List.map spell_form transforms with
| Some d, ts when not (List.mem None ts) ->
Printf.sprintf
"Add (map clone) to the chain, which copies what each \
element owns: (into %s)"
(String.concat " "
((v :: d :: List.filter_map Fun.id ts) @ [ "(map clone)" ]))
| _ ->
"Add (map clone) to the chain, which copies what each element \
owns"
else
Printf.sprintf
"Nothing copies what a %s owns, so no copy of %s can stand on \
its own: read the elements where they are, or build each new \
element and push that"
et v
in
Loc.failk "check/into-shares-elements" src.Ast.loc
"into copies each element of %s as it stands, and an element of \
%s is a %s, which owns storage — the copy would share each \
element's block with %s, and growing either one frees the block \
the other points at. %s"
v v et v fix
| _ -> ());
expect ctx loc ~want (mk loc Types.Unit Tast.Unit)
| _ -> expect ctx loc ~want (mk loc Types.Unit Tast.Unit))
(* (clone v) uses the current allocator, (clone v a) names one. A deep,
independent copy: spec-memory.md's "copying is always explicit". *)
| "clone" ->
@ -9171,9 +9265,9 @@ and named_call ?(qualified = false) ctx ~want loc name args =
| (Types.Vec _ | Types.Map _) when region_only ctx.env target.Tast.ty ->
fail loc
"%s cannot be cloned — its elements own storage, and nothing here \
can walk one to copy what it owns. Build a second container and \
insert into it"
can walk one to copy what it owns. %s"
(Types.to_string target.Tast.ty)
(insert_copies ctx.env target.Tast.ty)
(* A slice's elements, copied into a block from the allocator and
answered as a slice over it — what (bytes s) does for a string's
bytes, and the same lowering. The same refusal as a Vec's, for the
@ -9181,9 +9275,9 @@ and named_call ?(qualified = false) ctx ~want loc name args =
| Types.Slice (_, elem) when owning ctx.env elem ->
fail loc
"%s cannot be cloned — its elements own storage, and nothing here \
can walk one to copy what it owns. Build a container and insert \
into it"
can walk one to copy what it owns. %s"
(Types.to_string target.Tast.ty)
(insert_copies ctx.env target.Tast.ty)
(* The copy is a block from an allocator, which the collector does not
walk, so a dyn in it would be a root nothing marks. *)
| Types.Slice (_, elem) when holds_dyn ctx.env elem ->
@ -11708,6 +11802,10 @@ let builtins : (string * string * string) list =
allocator's free-all or destroy. Refused for elements that own \
storage: a bytewise copy would alias the original's blocks under a \
name promising otherwise.");
("into-copies-elements", "into-copies-elements [src dst transform...] ()",
"What into writes when its chain has no (map f). Refuses a source whose \
elements own storage, because pushing them as they stand would share \
their blocks. Not meant to be written by hand.");
(* (Map K V) *)
("map-new", "map-new [K? V? Allocator?] (Map K V)",

18
lib/prelude.ml
View File

@ -2371,6 +2371,15 @@ let source = {flan|
(form-sym? head "filter") (recur (- k 1) `(when (~f ~x) ~body))
:else `(into-transform-is-map-or-filter ~t))))))))
;; Whether any transform in the chain is a (map f).
(defn into-maps? [ts [Form]] bool
(loop [k 0]
(cond
(= k (length ts)) false
(let [items (form-items (at ts k))]
(and (> (length items) 0) (form-sym? (at items 0) "map"))) true
:else (recur (+ k 1)))))
;; The items of a list form, and the empty slice for anything else — a
;; non-list transform falls into the arity complaint above rather than needing
;; a case of its own.
@ -2423,10 +2432,19 @@ let source = {flan|
named? (form-is-sym? from)
src (if named? from (gensym))
bind (if named? (form-nil) (form-pair src from))
;; With no (map f) in the chain every element pushed is a source
;; element as it stands, which copies only its header: the checker
;; refuses that for an element that owns storage. The destination and
;; the transforms ride along unevaluated, to be written back in the fix.
shares (if (into-maps? (form-rest args 2))
(form-nil)
(form-cons `(into-copies-elements ~src ~(at args 1) ~@(form-rest args 2))
(form-nil)))
dst (gensym)
x (gensym)
i (gensym)]
`(let [~dst ~(at args 1) ~@bind]
~@shares
(dotimes [~i (length ~src)]
(let [~x (at ~src ~i)]
~(into-wrap (form-rest args 2) dst x)))

22
test/programs/into-owning.flan Normal file
View File

@ -0,0 +1,22 @@
;;;; into over elements that own storage. Without a (map f) in the chain the
;;;; elements are pushed as they stand, which copies their headers and shares
;;;; their blocks — so that is refused, and (map clone) is the copy that
;;;; compiles. The outer Vecs are in an arena, as a container of owning
;;;; elements has to be; the inner ones are on the heap, where growing one
;;;; through a shared header would free the block the other still points at.
(defn main [] i32
(let [a (arena-new 65536)
v (vec-new (Vec i32) a)]
(push v (vec-new i32))
(push (at v 0) 1)
(let [w (into v (vec-new (Vec i32) a) (map clone))]
(dotimes [i 100] (push (at w 0) i))
(println (at (at v 0) 0)) ; 1
(println (length (at v 0))) ; 1
(println (length (at w 0))) ; 101
(println (at (at w 0) 100)) ; 99
(free (at w 0)))
(free (at v 0))
(arena-destroy a)
0))

5
test/test_acceptance.ml
View File

@ -613,6 +613,11 @@ let () =
source transformed in two orders, which have to differ. *)
outputs "into" "programs/into.flan"
"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. *)
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";
(* The prelude's slice algorithms. Every assertion here is over an input a
wrong implementation fails: unsorted with duplicates, negatives and an
odd length; a reverse-sorted slice; and a sort of a subslice whose

28
test/test_flan.ml
View File

@ -3188,6 +3188,34 @@ let () =
rejects_check "clone on a slice of owning elements"
"(defn f [v [(Vec i32)]] i32 (length (clone v)))"
~needle:"[(Vec i32)] cannot be cloned";
(* into with no (map f) pushes the source's elements as they stand, which
for an owning element shares its block — pushing through the copy then
frees the source's. The fix it names is programs/into-owning.flan. *)
rejects_check "into copying owning elements, refused at the source"
"(defn f [a Allocator] i32\n\
\ (let [v (vec-new (Vec i32) a)\n\
\ w (into v (vec-new (Vec i32) a) (filter nonempty?))] (length w)))\n\
(defn nonempty? [x (Vec i32)] bool (> (length x) 0))"
~needle:"into copies each element of v as it stands, and an element of v \
is a (Vec i32), which owns storage — the copy would share each \
element's block with v, and growing either one frees the block \
the other points at. Add (map clone) to the chain, which copies \
what each element owns: (into v (vec-new (Vec i32) a) (filter \
nonempty?) (map clone))";
accepts "into with (map clone) over owning elements"
"(defn f [a Allocator] i32\n\
\ (let [v (vec-new (Vec i32) a)\n\
\ w (into v (vec-new (Vec i32) a) (map clone))] (length w)))";
accepts "into of plain elements is untouched"
"(defn f [v [i32]] () (let [w (into v (vec-new i32))] (free w)))";
rejects_check "into copying elements clone cannot copy, explained"
"(defstruct B [xs (Vec i32)])\n\
(defn f [v [B] a Allocator] i32 (let [w (into v (vec-new B a))] (length w)))"
~needle:"Nothing copies what a B owns, so no copy of v can stand on its \
own";
rejects_check "clone's refusal names a clone of each element"
"(defn f [v [(Vec i32)]] i32 (length (clone v)))"
~needle:"push a (clone x) of each element into it";
accepts "clone on a slice, with and without an allocator"
"(defn f [v [f64] a Allocator] i32 (+ (length (clone v)) (length (clone v a))))";