diff --git a/lib/check.ml b/lib/check.ml index 12b6219..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" @@ -1054,6 +1066,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..a7c4102 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,186 @@ 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 ─────────────────────────────────────────────────── *) + +(* 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 + 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, 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 \ + {: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 : 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 (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 : 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 + | [] -> (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", + [ 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", + [ t; + ex r.loc (Ast.Int (Int64.of_int n)); + ex r.loc (Ast.Call (var r.loc "len", [ 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 | [] -> [] @@ -411,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) @@ -586,8 +802,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 diff --git a/test/programs/destructure.flan b/test/programs/destructure.flan new file mode 100644 index 0000000..212e232 --- /dev/null +++ b/test/programs/destructure.flan @@ -0,0 +1,108 @@ +;;;; 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)) + + ;; 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) + {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 9f85b75..4533d7b 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -881,6 +881,26 @@ ERR@7 unexpected token: not the kind the caller was reading outputs "signedness" "programs/signedness.flan" signed_out; outputs ~opt:"-O0" "signedness, -O0" "programs/signedness.flan" signed_out; + (* ── 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\ + 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" + 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..9e91d00 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -805,6 +805,161 @@ 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\")" ]; + + (* ── 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" + "(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);