From f7009fcd34aa25d02eeff08f1eea3226e969c239 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 03:42:47 +0700 Subject: [PATCH] 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);