From ce1426d1e902de7968ba365e9f4fc006956c486d Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 03:38:52 +0700 Subject: [PATCH 1/4] Clojure's destructuring, because a binding vector is where it is missed MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit plan.org says Flan is Clojure's brackets and a small slice of its API, and (let [{:keys [x y]} p] ...) is one of the most-used parts of that surface. A struct is Flan's map, so {:keys [x y]} and {inner :field} read fields off one; [a b] and [a b & rest] read a fixed array. It desugars in parse.ml into the Let bindings and Field accesses that already exist — the same trade dotimes makes. Ast.binding carries a name and nothing else, so nothing downstream learns that a pattern exists: not Load's renaming, not Check, not a backend. That is not only taste. Load matches Ast.pattern exhaustively and Shim builds Ast.binding literally, and neither file is editable from here, so an AST variant was never on the table. The value goes into a temporary first. A pattern over a call must call it once, and (let [{:keys [p]} p] ...) must read the old p rather than the one it is halfway through rebinding. The temporaries are named with a ~, which the reader treats as a delimiter, so no source symbol can collide with one. The arity is the one thing the parser cannot settle — it is a type — so the pattern's shape travels to check.ml as destructure~nth, which knows how many elements the value has and lowers to an ordinary at. --- lib/check.ml | 53 +++++++++++++ lib/parse.ml | 208 ++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 257 insertions(+), 4 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index 12b6219..bad8782 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -1054,6 +1054,59 @@ and named_call ctx ~want loc name args = "zeroed needs to know the type it is zeroing — use it where one is \ expected, as in (set grid (zeroed))") + (* The one half of a destructuring [let] that [Parse] cannot do on its own. + Everything else about a pattern is bindings and field accesses it already + wrote; the arity is a *type* question — how many elements the value has — + and there are no types in the parser. So the pattern's shape travels here + as arguments: which element this binding wants, how many names the pattern + binds, and whether that count is exact or a minimum (it is a minimum when + the pattern ends in [& rest]). + + No source symbol can contain a [~] — the reader makes it a delimiter — so + this name is unspellable and nothing but [Parse] can reach it. *) + | "destructure~nth" -> + (match args with + | [ target; + { Ast.e = Ast.Int i; _ }; { Ast.e = Ast.Int n; _ }; + { Ast.e = Ast.Int exact; _ } ] -> + let plural k = if Int64.equal k 1L then "" else "s" in + let target = check ctx target in + (match target.Tast.ty with + | Types.Array (m, elem) -> + if Int64.equal exact 1L && not (Int64.equal m n) then + fail loc + "this pattern binds %Ld name%s, but %s has %Ld element%s — a \ + pattern over a fixed array names every element, or ends in \ + [& rest]" + n (plural n) (Types.to_string target.Tast.ty) m (plural m); + if Int64.equal exact 0L && Int64.compare m n < 0 then + fail loc + "this pattern binds %Ld name%s before the &, but %s has only %Ld \ + element%s" n (plural n) (Types.to_string target.Tast.ty) m + (plural m); + prim Tast.At elem + [ target; mk loc index_ty (Tast.Int (i, Types.I32)) ] + (* The asymmetry is real and is the reason this is refused rather than + lowered to a bounds-checked [at]: a fixed array's length is in its + type, so [[a b]] over a [[2 f32]] is a claim the checker can settle, + and over a [[T]] it is a claim about a number that does not exist + until the program runs. Turning it into a runtime trap would be a + pattern that type checks and then kills the program, which is the + trade this language does not make. *) + | Types.Slice _ -> + fail loc + "a pattern cannot destructure %s: a slice's length is a runtime \ + value, so nothing here can check that it has %Ld element%s. Use \ + (at s i) and test (len s) yourself" + (Types.to_string target.Tast.ty) n (plural n) + | other -> + fail loc + "%s is not a fixed array, so [a b ...] cannot destructure it" + (Types.to_string other)) + | _ -> + fail loc + "destructure~nth is written by the compiler and cannot be called") + (* ── containers ────────────────────────────────────────────────── *) | "len" -> arity loc name 1 args; diff --git a/lib/parse.ml b/lib/parse.ml index 5a8df1d..90fc84a 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -14,6 +14,35 @@ let sym (f : Form.t) = | Sym s -> s | _ -> fail f "expected a name, found %s" (Form.to_string f) +(* Names for the temporaries a destructuring binding needs — the value is bound + once and every name in the pattern reads *that*, so a pattern over a call + calls it once. [~] is a delimiter in the reader, so no symbol anyone can + write contains one: these cannot collide with a source name and a source + name cannot shadow one. Reset per program so the names, and therefore the + slot numbering downstream, are the same every run. *) +let temps = ref 0 + +let fresh_temp () = incr temps; Printf.sprintf "destructure~%d" !temps + +(* Destructuring binds in [let] and nowhere else. Every other binding position — + a [defn] parameter, a [defstruct] field, an [fn] parameter, a [dotimes] + counter, a [match] arm's binds — takes a plain name, and a pattern written + there is refused here rather than falling out of [sym] as "expected a name". + + A parameter is the one worth saying why about: it is a name/type pair, and a + pattern has no name to pair the type with, so supporting it means a pattern + inside [Ast.field] — a record [Load] and [Shim] both build and read, and + neither is this file's to change. *) +let no_pattern (f : Form.t) = + match f.v with + | Map _ | Vec _ -> + fail f + "%s is a destructuring pattern, and a pattern binds only in let — this \ + position takes a plain name. Take the value under a name and \ + destructure it in the body" + (Form.to_string f) + | _ -> () + (* Primitive type names are lowercase but concrete; every other lowercase name in type position is a type variable (plan.org, Types). *) let primitives = @@ -62,6 +91,7 @@ let rec fields (f : Form.t) (items : Form.t list) : Ast.field list = match items with | [] -> [] | name :: ty :: rest -> + no_pattern name; { Ast.fname = sym name; fty = texpr ty; floc = name.loc } :: fields f rest | [ odd ] -> Loc.fail odd.loc "field %s has no type — these come in name/type pairs" @@ -166,12 +196,14 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = | Sym "fn" -> (match args with | { v = Vec ps; _ } :: body when body <> [] -> + List.iter no_pattern ps; mk (Ast.Fn (List.map sym ps, body_of body)) | _ -> fail f "fn is (fn [param ...] body ...)") | Sym "dotimes" -> (match args with | { v = Vec [ n; count ]; _ } :: body -> + no_pattern n; mk (Ast.Dotimes (sym n, expr count, body_of body)) | _ -> fail f "dotimes is (dotimes [name count] body ...)") @@ -331,15 +363,182 @@ and bindings f (items : Form.t list) : Ast.binding list = Annotated locals are not needed by any acceptance program. *) let rec go = function | [] -> [] - | name :: value :: rest -> - { Ast.bname = sym name; bty = None; bval = expr value; bloc = name.loc } - :: go rest + | pat :: value :: rest -> + let bs = destructure pat (expr value) in + no_duplicates pat bs; + bs @ go rest | [ odd ] -> Loc.fail odd.loc "binding %s has no value — let takes name/value pairs" (Form.to_string odd) in if items = [] then Loc.fail f.loc "let needs at least one binding" else go items +(* ── Destructuring ─────────────────────────────────────────────────── *) + +(* Clojure's destructuring, desugared here into the bindings and field accesses + the language already has. [Ast.binding] carries a name and nothing else, and + deliberately so: nothing downstream — not [Load]'s renaming, not [Check], not + any backend — learns that a pattern exists. The same reason [dotimes] is a + [Let] plus a [While]. + + The one thing this cannot decide is whether an array pattern's arity matches + the value's, because that is a type and there are none here. [destructure~nth] + carries the question to [Check], which answers it and emits an ordinary [at]. + + A binding is a pattern only when it is written in brackets or braces; a bare + name is what it always was. *) +and destructure (p : Form.t) (v : Ast.expr) : Ast.binding list = + match p.v with + | Sym name -> [ { Ast.bname = name; bty = None; bval = v; bloc = p.loc } ] + (* The value goes into a temporary first, so it is evaluated once however + many names the pattern binds, and so that [(let [{:keys [p]} p] ...)] + reads the old [p] rather than the one it is in the middle of rebinding. *) + | Map items -> + let t = fresh_temp () in + { Ast.bname = t; bty = None; bval = v; bloc = p.loc } :: dmap p t items + | Vec items -> + let t = fresh_temp () in + { Ast.bname = t; bty = None; bval = v; bloc = p.loc } :: dvec p t items + | _ -> + fail p + "expected a name or a destructuring pattern, found %s — a pattern is \ + {:keys [x y]} over a struct or [a b] over a fixed array" + (Form.to_string p) + +(* {:keys [x y]} and {inner :field}, over a struct. Clojure's map destructuring + with Flan's structs standing in for its maps: [:keys] is the common case and + the pair form is what nests, since a [:keys] entry is a name and never a + pattern. Everything else Clojure puts in this position — [:as], [:or], + [:strs], [:syms] — is refused by name where it is written. *) +and dmap (p : Form.t) (t : string) (items : Form.t list) : Ast.binding list = + let ex loc e : Ast.expr = { Ast.e; loc } in + let field loc name = ex loc (Ast.Field (ex loc (Ast.Var t), name)) in + let rec go = function + | [] -> [] + | { v = Kw "keys"; _ } :: names :: rest -> + let ns = + match names.v with + | Vec ns -> ns + | _ -> + Loc.fail names.loc + ":keys takes a bracketed list of field names, found %s" + (Form.to_string names) + in + let rec each = function + | [] -> [] + | (n : Form.t) :: more -> + let name = + match n.v with + | Sym s -> s + | _ -> + Loc.fail n.loc + ":keys binds field names, and %s is not one — a nested pattern \ + is written {%s :field}" + (Form.to_string n) (Form.to_string n) + in + { Ast.bname = name; bty = None; bval = field n.loc name; bloc = n.loc } + :: each more + in + each ns @ go rest + | ({ v = Kw k; _ } as bad) :: _ :: rest -> + ignore rest; + Loc.fail bad.loc + ":%s is not implemented in a destructuring pattern — a struct pattern \ + is {:keys [x y]} or {name :field}, and nothing else" k + | pat :: ({ v = Kw fld; _ } as fform) :: rest -> + destructure pat (field fform.loc fld) @ go rest + | pat :: other :: _ -> + Loc.fail other.loc + "expected :field after %s, found %s — a struct pattern binds \ + {name :field}" (Form.to_string pat) (Form.to_string other) + | [ odd ] -> + Loc.fail odd.loc "%s has no :field — a struct pattern comes in pairs" + (Form.to_string odd) + in + if items = [] then + fail p "an empty struct pattern {} binds nothing — write the names it should bind" + else go items + +(* [a b] and [a b & rest], over a fixed array. Not over a slice: see [Check]. *) +and dvec (p : Form.t) (t : string) (items : Form.t list) : Ast.binding list = + let ex loc e : Ast.expr = { Ast.e; loc } in + let var loc n = ex loc (Ast.Var n) in + let rec split acc = function + | [] -> (List.rev acc, None) + | ({ v = Sym "&"; _ } as amp) :: rest -> + (match rest with + | [ r ] -> (List.rev acc, Some r) + | [] -> Loc.fail amp.loc "& needs a name after it, as in [a b & rest]" + | _ :: extra :: _ -> + Loc.fail extra.loc + "& takes one name and it is the last thing in the pattern") + | x :: rest -> split (x :: acc) rest + in + let elems, rest = split [] items in + let n = List.length elems in + (match elems, rest with + | [], None -> + fail p "an empty array pattern [] binds nothing — write the names it should bind" + | [], Some r -> + Loc.fail r.loc + "[& %s] binds the whole value — write %s on its own instead of a pattern" + (Form.to_string r) (Form.to_string r) + | _ -> ()); + (* With a [& rest] the pattern says "at least this many"; without one it says + "exactly this many". [Check] is where the array's length is known, so the + count and which of the two it means travel there as arguments. *) + let exact = if rest = None then 1L else 0L in + let nth i = + ex p.loc + (Ast.Call (var p.loc "destructure~nth", + [ var p.loc t; + ex p.loc (Ast.Int (Int64.of_int i)); + ex p.loc (Ast.Int (Int64.of_int n)); + ex p.loc (Ast.Int exact) ])) + in + let rec each i = function + | [] -> [] + | e :: more -> destructure e (nth i) @ each (i + 1) more + in + let rest_binding = + match rest with + | None -> [] + | Some r -> + (* An ordinary (slice t n (len t)): the tail of the temporary, which is a + local and outlives the body that reads it. Nothing new. *) + let name = + match r.v with + | Sym s -> s + | _ -> + Loc.fail r.loc + "& binds one name for the tail, and %s is not one — the tail is a \ + slice, so it cannot be destructured further" (Form.to_string r) + in + [ { Ast.bname = name; bty = None; bloc = r.loc; + bval = + ex r.loc + (Ast.Call (var r.loc "slice", + [ var r.loc t; + ex r.loc (Ast.Int (Int64.of_int n)); + ex r.loc (Ast.Call (var r.loc "len", + [ var r.loc t ])) ])) } ] + in + each 0 elems @ rest_binding + +(* One pattern binding the same name twice is a mistake, not a shadowing: the + second would win and the first would bind nothing. Across a let's bindings it + *is* shadowing and stays legal, so this looks at one pattern at a time. *) +and no_duplicates (p : Form.t) (bs : Ast.binding list) = + let rec go seen = function + | [] -> () + | (b : Ast.binding) :: rest -> + if String.contains b.Ast.bname '~' then go seen rest + else if List.mem b.Ast.bname seen then + Loc.fail b.Ast.bloc "this pattern binds %s twice" b.Ast.bname + else go (b.Ast.bname :: seen) rest + in + ignore p; go [] bs + and struct_fields f (items : Form.t list) : (string * Ast.expr) list = let rec go = function | [] -> [] @@ -586,8 +785,9 @@ let declared_types (forms : Form.t list) : Names.t = let program (forms : Form.t list) : Ast.decl list = let types = declared_types forms in + temps := 0; List.map (decl types) forms (* Single-declaration entry point, for tests and the REPL. Sees only the builtin types plus whatever this one form declares. *) -let decl (f : Form.t) : Ast.decl = decl (declared_types [ f ]) f +let decl (f : Form.t) : Ast.decl = temps := 0; decl (declared_types [ f ]) f From f7009fcd34aa25d02eeff08f1eea3226e969c239 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 03:42:47 +0700 Subject: [PATCH 2/4] Tests that assert the reason, and one that notices a doubled call The checker tests pin the reason rather than the failure: an array pattern over a slice has to fail *because a slice's length is a runtime value*, not because something went wrong. The four map-destructuring keys Clojure has and this does not are each named individually, because "unexpected form" leaves the author guessing which of the four they wrote is the missing one. The acceptance program exists for the case none of the above can see. A pattern is desugared away entirely, so there is nothing in the typed IR to inspect; the only way to tell that the value was bound once is to destructure something with a side effect and print how often it ran. Four names, two calls. A desugaring that re-evaluated the initialiser per name prints 4, and every other line in the program stays green through the mistake. --- test/programs/destructure.flan | 96 ++++++++++++++++++++++++ test/test_acceptance.ml | 20 +++++ test/test_flan.ml | 131 +++++++++++++++++++++++++++++++++ 3 files changed, 247 insertions(+) create mode 100644 test/programs/destructure.flan diff --git a/test/programs/destructure.flan b/test/programs/destructure.flan new file mode 100644 index 0000000..b4ba30b --- /dev/null +++ b/test/programs/destructure.flan @@ -0,0 +1,96 @@ +;;;; Destructuring in a let: Clojure's binding forms over Flan's shapes. +;;;; +;;;; A struct stands in for Clojure's map, so {:keys [x y]} and {inner :field} +;;;; read fields off one; a fixed array stands in for its sequence, so [a b] +;;;; and [a b & rest] read elements out of one. None of it is a new form: it +;;;; all desugars in parse.ml into the Let, (.field x), at and slice that were +;;;; already there, which is why this program is the test that it works — the +;;;; typed IR has nothing in it a pattern could be hiding in. +;;;; +;;;; The case that matters most here is `calls`. A pattern binds several names +;;;; from one value, and that value is bound to a temporary *first*, so a +;;;; pattern over a call calls it once. Delete the temporary and every name +;;;; re-evaluates the initialiser: this program prints the call count, so that +;;;; mistake changes the output instead of hiding in it. + +(defstruct Point [x i32 y i32]) +(defstruct Line [a Point b Point]) + +(defvar calls i32) + +(defn make-point [] Point + (set calls (+ calls 1)) + (Point {:x 3 :y 4})) + +(defn show2 [label string a i32 b i32] + (print-str label) + (print-str " ") + (print-i64 (i64 a)) + (print-str " ") + (print-i64 (i64 b)) + (newline)) + +(defn main [] i32 + ;; :keys, the common case: one name per field, spelled as the field is. + (let [{:keys [x y]} (Point {:x 1 :y 2})] + (show2 "keys" x y)) + + ;; The pair form, which is what renames and what nests — a :keys entry is a + ;; field name and never a pattern. + (let [{a :x b :y} (Point {:x 10 :y 20})] + (show2 "pairs" a b)) + + (let [l (Line {:a (Point {:x 5 :y 6}) :b (Point {:x 7 :y 8})})] + (let [{{:keys [x y]} :b} l] + (show2 "nested" x y)) + ;; A pattern may shadow the very name it destructures, because the value is + ;; read into a temporary before any of the names are bound. + (let [{l :a} l] + (show2 "shadow" (.x l) (.y l)))) + + ;; A later binding sees an earlier pattern's names, as in any let. + (let [{:keys [x]} (Point {:x 100 :y 0}) + doubled (* x 2)] + (show2 "sequential" x doubled)) + + ;; A fixed array names every element. The count is checked against the type, + ;; so [a b] over a [3 i32] is a compile error and not a silent prefix. + (let [xs [11 22 33] + [a b c] xs] + (print-str "array ") + (print-i64 (i64 a)) (print-str " ") + (print-i64 (i64 b)) (print-str " ") + (print-i64 (i64 c)) (newline)) + + ;; & rest is the tail as a slice, which is an ordinary (slice xs n (len xs)) + ;; over a local — nothing new, and nothing that outlives the array. + (let [xs [1 2 3 4 5] + [head & tail] xs] + (print-str "rest ") + (print-i64 (i64 head)) (print-str " ") + (print-i64 (i64 (len tail))) (print-str " ") + (print-i64 (i64 (at tail 0))) (print-str " ") + (print-i64 (i64 (at tail 3))) (newline)) + + ;; The tail may be empty: naming every element and then asking for the rest + ;; is a zero-length slice, not an error. + (let [xs [9 8] + [p q & rest] xs] + (print-str "empty-tail ") + (print-i64 (i64 (+ p q))) (print-str " ") + (print-i64 (i64 (len rest))) (newline)) + + ;; Patterns nest through each other: a struct inside an array. + (let [ps [(Point {:x 1 :y 2}) (Point {:x 3 :y 4})] + [{:keys [x]} {y :y}] ps] + (show2 "nested-in-array" x y)) + + ;; Evaluate-once. Two patterns, two calls, four names — one call per pattern. + ;; Without the temporary each of the four names would call it again: 4, not 2. + (let [{:keys [x y]} (make-point) + {a :x b :y} (make-point)] + (print-str "calls ") + (print-i64 (i64 calls)) (print-str " ") + (print-i64 (i64 (+ x (+ y (+ a b))))) + (newline)) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 85a45e3..56b9e0a 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -859,6 +859,26 @@ ERR@7 unexpected token: not the kind the caller was reading "(declare-c a [] \"Same\")\n(declare-c b [] \"Same\")" "one declare-c per C function"; + (* ── Destructuring ─────────────────────────────────────────── *) + + (* A destructuring let is desugared in [Parse] into the Let, field access, + [at] and [slice] that already existed, so there is nothing in the typed + IR to inspect and this program *is* the test. The last line is the one + that catches the mistake worth catching: four names come out of two + calls, so a desugaring that dropped the temporary and re-evaluated the + initialiser per name would print 4 instead of 2. Every other line here + would stay green through that. -O0 as well, for the usual reason — the + tail slice is an address into a local array, and mem2reg launders a + sloppy one. *) + let destructure_out = + "keys 1 2\npairs 10 20\nnested 7 8\nshadow 5 6\nsequential 100 200\n\ + array 11 22 33\nrest 1 4 2 5\nempty-tail 17 0\nnested-in-array 1 4\n\ + calls 2 14\n" + in + outputs "destructuring" "programs/destructure.flan" destructure_out; + outputs ~opt:"-O0" "destructuring, -O0" "programs/destructure.flan" + destructure_out; + if !failures = 0 then print_endline "acceptance: all tests passed" else begin Printf.printf "\n%d failure(s)\n" !failures; diff --git a/test/test_flan.ml b/test/test_flan.ml index 7b1c6d3..beb6dcb 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -805,6 +805,137 @@ let () = "find-restart", "(defn f [] (find-restart 'skip))"; "compute-restarts", "(defn f [] (compute-restarts))" ]; + (* ── Destructuring ─────────────────────────────────────────────── *) + + (* A pattern is desugared in [Parse] into the bindings and field accesses that + already existed, so what these assert is that the desugaring is *checked* — + the same errors an equivalent hand-written let would raise, pointing at the + pattern that stands in for it. *) + let pt = "(defstruct Point [x i32 y i32])\n" in + let line = pt ^ "(defstruct Line [a Point b Point])\n" in + + accepts "struct pattern with :keys" + (pt ^ "(defn f [p Point] i32 (let [{:keys [x y]} p] (+ x y)))"); + accepts "struct pattern with a name/:field pair" + (pt ^ "(defn f [p Point] i32 (let [{a :x b :y} p] (+ a b)))"); + accepts "a nested struct pattern" + (line ^ "(defn f [l Line] i32 (let [{{:keys [x y]} :a} l] (+ x y)))"); + (* A later binding sees an earlier pattern's names, as in any let. *) + accepts "a binding after a pattern sees its names" + (pt ^ "(defn f [p Point] i32 (let [{:keys [x]} p y (+ x 1)] y))"); + (* Shadowing works because the value goes into a temporary first. *) + accepts "a pattern may shadow the name it destructures" + (line ^ "(defn f [a Line] i32 (let [{a :a} a] (.x a)))"); + accepts "a pattern over a call" + (pt ^ "(defn mk [] Point (Point {:x 1 :y 2}))\n\ + (defn f [] i32 (let [{:keys [x y]} (mk)] (+ x y)))"); + + rejects_check "a field the struct does not have" + (pt ^ "(defn f [p Point] i32 (let [{:keys [x z]} p] (+ x z)))") + ~needle:"Point has no field z"; + rejects_check "a struct pattern over something that is not a struct" + "(defn f [n i32] i32 (let [{:keys [x]} n] x))" + ~needle:"i32 is not a struct, so it has no fields"; + rejects_check "one pattern binding a name twice" + (pt ^ "(defn f [p Point] i32 (let [{:keys [x x]} p] x))") + ~needle:"this pattern binds x twice"; + rejects_check "an empty struct pattern" + (pt ^ "(defn f [p Point] i32 (let [{} p] 0))") + ~needle:"an empty struct pattern {} binds nothing"; + rejects_check "a field name with no pattern before it" + (pt ^ "(defn f [p Point] i32 (let [{:x} p] 0))") + ~needle:"has no :field"; + rejects_check "a pattern with no field name after it" + (pt ^ "(defn f [p Point] i32 (let [{a b} p] 0))") + ~needle:"expected :field after a"; + + (* Clojure's other map-destructuring keys. Each is refused by its own name: + "unexpected form" would leave the author guessing which of the four they + wrote is the one this does not have. *) + List.iter + (fun k -> + rejects_check (k ^ " in a struct pattern") + (pt ^ Printf.sprintf + "(defn f [p Point] i32 (let [{:keys [x] %s q} p] x))" k) + ~needle:(k ^ " is not implemented in a destructuring pattern")) + [ ":as"; ":or"; ":strs"; ":syms" ]; + + (* ── Sequential patterns, and the asymmetry ────────────────────── *) + + (* A fixed array's length is in its type, so the arity is a claim the checker + can settle. *) + accepts "an array pattern naming every element" + "(defn f [] i32 (let [xs [1 2 3] [a b c] xs] (+ a (+ b c))))"; + accepts "an array pattern with & rest" + "(defn f [] i32 (let [xs [1 2 3] [a & r] xs] (+ a (len r))))"; + accepts "& rest taking an empty tail" + "(defn f [] i32 (let [xs [1 2] [a b & r] xs] (+ a (+ b (len r)))))"; + accepts "a struct pattern nested in an array pattern" + (pt ^ "(defn f [ps [2 Point]] i32 \ + (let [[{:keys [x]} {y :y}] ps] (+ x y)))"); + + rejects_check "an array pattern that names too few elements" + "(defn f [] i32 (let [xs [1 2 3] [a b] xs] (+ a b)))" + ~needle:"this pattern binds 2 names, but [3 i32] has 3 elements"; + rejects_check "an array pattern that names too many" + "(defn f [] i32 (let [xs [1 2] [a b c] xs] (+ a (+ b c))))" + ~needle:"this pattern binds 3 names, but [2 i32] has 2 elements"; + rejects_check "& rest with more names before it than there are elements" + "(defn f [] i32 (let [xs [1 2] [a b c & r] xs] a))" + ~needle:"binds 3 names before the &, but [2 i32] has only 2 elements"; + + (* The asymmetry, and the reason this is refused rather than lowered to a + bounds-checked [at]: over a slice the arity is a claim about a number that + does not exist until the program runs, so a pattern that type checks would + be one that kills the program instead. *) + rejects_check "an array pattern over a slice" + "(defn f [s [i32]] i32 (let [[a b] s] (+ a b)))" + ~needle:"a slice's length is a runtime value"; + rejects_check "an array pattern over a slice, even with & rest" + "(defn f [s [i32]] i32 (let [[a & r] s] (+ a (len r))))" + ~needle:"a slice's length is a runtime value"; + rejects_check "an array pattern over something with no elements at all" + "(defn f [n i32] i32 (let [[a b] n] (+ a b)))" + ~needle:"i32 is not a fixed array"; + + rejects_check "an empty array pattern" + "(defn f [] i32 (let [xs [1 2] [] xs] 0))" + ~needle:"an empty array pattern [] binds nothing"; + rejects_check "& with nothing after it" + "(defn f [] i32 (let [xs [1 2] [a &] xs] a))" + ~needle:"& needs a name after it"; + rejects_check "& with two names after it" + "(defn f [] i32 (let [xs [1 2] [a & r s] xs] a))" + ~needle:"& takes one name"; + rejects_check "a pattern that is only & rest" + "(defn f [] i32 (let [xs [1 2] [& r] xs] (len r)))" + ~needle:"binds the whole value"; + rejects_check "one array pattern binding a name twice" + "(defn f [] i32 (let [xs [1 2] [a a] xs] a))" + ~needle:"this pattern binds a twice"; + + (* ── Where a pattern is not a binding form ─────────────────────── *) + + (* Every other binding position takes a plain name. A parameter is the one + worth a reason: it is a name/type pair, and a pattern has no name for the + type to pair with. Refused where it is written, not left to fall out of + "expected a name". *) + List.iter + (fun (what, src) -> + rejects_check ("a pattern in " ^ what) src + ~needle:"a pattern binds only in let") + [ "a defn parameter", pt ^ "(defn f [{:keys [x]} Point] i32 x)"; + "a defstruct field", "(defstruct S [[a b] i32])"; + "an fn parameter", "(defn f [] i32 (let [g (fn [[a b]] a)] 0))"; + "a dotimes counter", "(defn f [] (dotimes [[a b] 3] 0))"; + "a declare parameter", pt ^ "(declare g [{:keys [x]} Point] \"G\")" ]; + + (* The desugaring's own machinery is unspellable: the reader makes [~] a + delimiter, so the name never reaches the parser as one symbol. *) + rejects_check "the desugaring's internal name cannot be written by hand" + "(defn f [] i32 (let [xs [1 2]] (destructure~nth xs 0 2 1)))" + ~needle:"means nothing outside a quasiquote"; + (* ── The acceptance program checks end to end ──────────────────── *) accepts "calc-me.flan type checks" (In_channel.with_open_bin "../calc-me.flan" In_channel.input_all); From 0b8564828b8ea73de83082f4b0e3a1c4464162d6 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 03:44:16 +0700 Subject: [PATCH 3/4] The temporary and the reference to it come back together, so they cannot drift --- lib/parse.ml | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/lib/parse.ml b/lib/parse.ml index 90fc84a..ae792f0 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -375,6 +375,15 @@ and bindings f (items : Form.t list) : Ast.binding list = (* ── Destructuring ─────────────────────────────────────────────────── *) +(* The temporary every pattern binds its value to before anything reads it, so + that the value is evaluated once however many names come out of it. Returning + the reference as well as the binding is what makes the two impossible to + separate by accident. *) +and temp (p : Form.t) (v : Ast.expr) : Ast.expr * Ast.binding = + let t = fresh_temp () in + ({ Ast.e = Ast.Var t; loc = p.loc }, + { Ast.bname = t; bty = None; bval = v; bloc = p.loc }) + (* Clojure's destructuring, desugared here into the bindings and field accesses the language already has. [Ast.binding] carries a name and nothing else, and deliberately so: nothing downstream — not [Load]'s renaming, not [Check], not @@ -393,12 +402,8 @@ and destructure (p : Form.t) (v : Ast.expr) : Ast.binding list = (* The value goes into a temporary first, so it is evaluated once however many names the pattern binds, and so that [(let [{:keys [p]} p] ...)] reads the old [p] rather than the one it is in the middle of rebinding. *) - | Map items -> - let t = fresh_temp () in - { Ast.bname = t; bty = None; bval = v; bloc = p.loc } :: dmap p t items - | Vec items -> - let t = fresh_temp () in - { Ast.bname = t; bty = None; bval = v; bloc = p.loc } :: dvec p t items + | Map items -> let t, bind = temp p v in bind :: dmap p t items + | Vec items -> let t, bind = temp p v in bind :: dvec p t items | _ -> fail p "expected a name or a destructuring pattern, found %s — a pattern is \ @@ -410,9 +415,9 @@ and destructure (p : Form.t) (v : Ast.expr) : Ast.binding list = the pair form is what nests, since a [:keys] entry is a name and never a pattern. Everything else Clojure puts in this position — [:as], [:or], [:strs], [:syms] — is refused by name where it is written. *) -and dmap (p : Form.t) (t : string) (items : Form.t list) : Ast.binding list = +and dmap (p : Form.t) (t : Ast.expr) (items : Form.t list) : Ast.binding list = let ex loc e : Ast.expr = { Ast.e; loc } in - let field loc name = ex loc (Ast.Field (ex loc (Ast.Var t), name)) in + let field loc name = ex loc (Ast.Field (t, name)) in let rec go = function | [] -> [] | { v = Kw "keys"; _ } :: names :: rest -> @@ -460,7 +465,7 @@ and dmap (p : Form.t) (t : string) (items : Form.t list) : Ast.binding list = else go items (* [a b] and [a b & rest], over a fixed array. Not over a slice: see [Check]. *) -and dvec (p : Form.t) (t : string) (items : Form.t list) : Ast.binding list = +and dvec (p : Form.t) (t : Ast.expr) (items : Form.t list) : Ast.binding list = let ex loc e : Ast.expr = { Ast.e; loc } in let var loc n = ex loc (Ast.Var n) in let rec split acc = function @@ -491,7 +496,7 @@ and dvec (p : Form.t) (t : string) (items : Form.t list) : Ast.binding list = let nth i = ex p.loc (Ast.Call (var p.loc "destructure~nth", - [ var p.loc t; + [ t; ex p.loc (Ast.Int (Int64.of_int i)); ex p.loc (Ast.Int (Int64.of_int n)); ex p.loc (Ast.Int exact) ])) @@ -518,10 +523,9 @@ and dvec (p : Form.t) (t : string) (items : Form.t list) : Ast.binding list = bval = ex r.loc (Ast.Call (var r.loc "slice", - [ var r.loc t; + [ t; ex r.loc (Ast.Int (Int64.of_int n)); - ex r.loc (Ast.Call (var r.loc "len", - [ var r.loc t ])) ])) } ] + ex r.loc (Ast.Call (var r.loc "len", [ t ])) ])) } ] in each 0 elems @ rest_binding From 4428c864cfcaa4980653db63c55421eecd0aa5ce Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 03:48:46 +0700 Subject: [PATCH 4/4] Say why match stops at Option, since the milestone was never the reason MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two ways to write a match over an enum and two different refusals, neither of them true. (match k :lo ...) died in the parser with "expected a pattern, found :hi" — which arm it named depended on cons evaluation order, and it never mentioned enums. (match k lo ...) died in the checker blaming milestone 2, which is not what stands in the way. What stands in the way is worth writing down, because the feature is close. An enum is an i32 at run time and its members are all known, so the arms are a chain of (= k :member) and the exhaustiveness check falls out of env.enums — a desugaring, no new IR node, the same shape as everything else this lane landed. What is missing is a case in Ast.pattern for a keyword, and load.ml matches that type exhaustively with no wildcard, so the variant cannot be added from a session that does not own the file. One line, for whoever does. That is also why destructuring went through a call to an unspellable name instead: a name in call position is an open namespace check.ml already owns, whereas tagging Pctor with ":lo" would put a second meaning into a field another file destructures as a constructor. The struct-tail case in the acceptance program is unrelated housekeeping: the corpus slices arrays of i32, u8 and f32 and nothing wider, so nothing else proves the desugared (slice xs n (len xs)) gets a struct's stride right. --- lib/check.ml | 12 ++++++++++++ lib/parse.ml | 13 +++++++++++++ test/programs/destructure.flan | 12 ++++++++++++ test/test_acceptance.ml | 2 +- test/test_flan.ml | 24 ++++++++++++++++++++++++ 5 files changed, 62 insertions(+), 1 deletion(-) diff --git a/lib/check.ml b/lib/check.ml index bad8782..59ba57f 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -810,6 +810,18 @@ and check_match ctx ?want loc scrutinee arms = let elem = match s.Tast.ty with | Types.Option t -> t + (* An enum is the one scrutinee that is not a milestone away: it is an i32 + at run time and its members are all known, so the arms would be a chain + of [=] with an exhaustiveness check over [env.enums] — a desugaring, not + a new IR node. What blocks it is upstream of here: a keyword has no case + in [Ast.pattern], and [lib/load.ml] matches that type exhaustively, so + the variant cannot be added. Said as itself rather than folded into the + milestone answer below, because the milestone is not the reason. *) + | Types.Enum n -> + fail loc + "match over the enum %s is not implemented — the lowering is a chain \ + of (= k :member), but a keyword has no case in the pattern type yet. \ + Use cond" n | other -> (* Union matching arrives with unions themselves, at milestone 6. *) fail loc "match works on an Option at milestone 2, not on %s" diff --git a/lib/parse.ml b/lib/parse.ml index ae792f0..a7c4102 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -614,7 +614,20 @@ and pattern (f : Form.t) : Ast.pattern = | Sym "_" -> Ast.Pwild | Kw "else" -> Ast.Pwild | Sym ctor -> Ast.Pctor (ctor, []) + (* An enum member, which is the one other thing [match] could plausibly be + over: an enum is an i32 at run time, so the arms would be a chain of [=] + and the members are all known, which is exhaustiveness [cond] cannot give. + What stops it is not the lowering, it is that a keyword pattern needs a + case in [Ast.pattern] — and [lib/load.ml] matches that type exhaustively, + so the variant cannot be added from here. Refused by name rather than + spelled as a constructor it is not. *) + | Kw member -> + fail f + ":%s is not implemented as a pattern — match is over an Option here, \ + and an enum member cannot be one until Ast.pattern can hold a keyword. \ + Use cond with (= k :%s)" member member | List ({ v = Sym ctor; _ } :: binds) -> + List.iter no_pattern binds; Ast.Pctor (ctor, List.map sym binds) | _ -> fail f "expected a pattern, found %s" (Form.to_string f) diff --git a/test/programs/destructure.flan b/test/programs/destructure.flan index b4ba30b..212e232 100644 --- a/test/programs/destructure.flan +++ b/test/programs/destructure.flan @@ -85,6 +85,18 @@ [{:keys [x]} {y :y}] ps] (show2 "nested-in-array" x y)) + ;; A tail of something wider than a machine word. The corpus slices arrays of + ;; i32, u8 and f32 and nothing else, so this is the one place the desugared + ;; (slice xs n (len xs)) has to get a struct's stride right rather than a + ;; scalar's. + (let [ps [(Point {:x 1 :y 2}) (Point {:x 3 :y 4}) (Point {:x 5 :y 6})] + [first & others] ps] + (print-str "struct-tail ") + (print-i64 (i64 (.x first))) (print-str " ") + (print-i64 (i64 (len others))) (print-str " ") + (print-i64 (i64 (.y (at others 0)))) (print-str " ") + (print-i64 (i64 (.x (at others 1)))) (newline)) + ;; Evaluate-once. Two patterns, two calls, four names — one call per pattern. ;; Without the temporary each of the four names would call it again: 4, not 2. (let [{:keys [x y]} (make-point) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 56b9e0a..fdc7f6b 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -873,7 +873,7 @@ ERR@7 unexpected token: not the kind the caller was reading let destructure_out = "keys 1 2\npairs 10 20\nnested 7 8\nshadow 5 6\nsequential 100 200\n\ array 11 22 33\nrest 1 4 2 5\nempty-tail 17 0\nnested-in-array 1 4\n\ - calls 2 14\n" + struct-tail 1 2 4 5\ncalls 2 14\n" in outputs "destructuring" "programs/destructure.flan" destructure_out; outputs ~opt:"-O0" "destructuring, -O0" "programs/destructure.flan" diff --git a/test/test_flan.ml b/test/test_flan.ml index beb6dcb..9e91d00 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -930,6 +930,30 @@ let () = "a dotimes counter", "(defn f [] (dotimes [[a b] 3] 0))"; "a declare parameter", pt ^ "(declare g [{:keys [x]} Point] \"G\")" ]; + (* ── match over an enum ────────────────────────────────────────── *) + + (* Not shipped, and refused twice over because there are two ways to write it + and they fail in different files. Both now say the same thing, which is the + point: the lowering is not what is missing — a keyword has no case in + [Ast.pattern], and [lib/load.ml] matches that type exhaustively. *) + rejects_check "match over an enum, members written as keywords" + "(defenum K [lo 0 hi 1])\n(defn f [k K] i32 (match k :lo 1 :hi 2))" + ~needle:"is not implemented as a pattern"; + rejects_check "match over an enum, members written as names" + "(defenum K [lo 0 hi 1])\n(defn f [k K] i32 (match k lo 1 hi 2))" + ~needle:"match over the enum K is not implemented"; + (* The old message blamed milestone 2, which was never the reason. An Option + still gets that answer, and still should. *) + rejects_check "match over something that is neither" + "(defn f [n i32] i32 (match n _ 2))" + ~needle:"match works on an Option at milestone 2, not on i32"; + (* A destructuring pattern in an arm's binds is a name position like any + other. *) + rejects_check "a pattern inside a match arm's binds" + "(defstruct P [x i32])\n\ + (defn f [o (Option P)] i32 (match o (Some {:keys [x]}) x None 0))" + ~needle:"a pattern binds only in let"; + (* The desugaring's own machinery is unspellable: the reader makes [~] a delimiter, so the name never reaches the parser as one symbol. *) rejects_check "the desugaring's internal name cannot be written by hand"