From 458bfcf571363ab23877b63cde259b2acb2b7031 Mon Sep 17 00:00:00 2001 From: Claude Date: Sat, 25 Apr 2026 09:38:20 +0000 Subject: [PATCH] eigentrust pitfalls #7: disambiguate bare-token compound patterns in defn MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Pre-fix: `defn f | cons r nil -> r | cons r rest -> ...` parsed each bare token after `|` as a separate arg pattern, splitting the function into clauses with mismatched arities (1 nil clause + 2 cons-3-arg clauses). This produced a per-clause helper (`f::1`, `f::3`) and the recursive call site `[f rest]` failed with `Unbound variable f::1` because the arity-1 helper only knew the nil clause and any non-empty list hit __match-fail. Fix shape (a) — implement general pattern matrices by auto-packing when the leading bare token names a known constructor whose field count matches the remaining tokens. `cons r nil` → one compound pattern `pat-compound 'cons (var-r, var-nil)` (then normalize-pattern converts var-nil to compound-nil since nil is a known nullary ctor). Fallback preserved for genuinely multi-arg defns: defn add | x y -> [+ x y] The leading `x` is a variable (lookup-ctor returns #f), so falls through to the old N-arg interpretation. Trade-off vs (b) (raise an error): (a) makes the syntax do what ML/Haskell users expect — `defn` IS the primary dispatch mechanism per .claude/rules/prologos-syntax.md, so making `cons r nil` mean "compound pattern" is the natural reading. The detection is local and does not change semantics for any pattern that didn't have a known ctor as its leading token. Scope: 23 lines in parser.rkt's parse-defn-clause + 11 new tests in test-defn-multiarg-patterns.rkt. No changes elsewhere. Test results: 11/11 new tests pass. 43/43 related tests pass (test-pattern-defn-01, test-pattern-defn-02, test-multi-body-defn). Full affected-suite: 4646 tests in 255 files, 1 unrelated pre-existing failure (stale tracking entry for non-existent test-constraint-retry-propagator.rkt). Latent issue exposed (NOT introduced by this fix): compile-match-tree binds variable patterns to outer-param names when those params get destructured by a later dispatch column. E.g., `cons r rest` after outer-cons specialization tries `let rest := __cons_1` while `__cons_1` is being destructured into `__cons_1_0` and `__cons_1_1`. This affects the recursive bodies of the eigentrust example with multi-element inputs, but is a pre-existing bug in compile-match-tree — reproducible on main with the bracketed `[cons r rest]` form, which parses to the same internal representation. The new tests cover the slices unaffected by this bug (empty + singleton inputs, wildcard patterns, all-var multi-arg) and explicitly call out the latent issue. Co-authored-by: kumavis <1474978+kumavis@users.noreply.github.com> --- racket/prologos/parser.rkt | 25 +- .../tests/test-defn-multiarg-patterns.rkt | 315 ++++++++++++++++++ 2 files changed, 339 insertions(+), 1 deletion(-) create mode 100644 racket/prologos/tests/test-defn-multiarg-patterns.rkt diff --git a/racket/prologos/parser.rkt b/racket/prologos/parser.rkt index a9cfc5914..1050f1a12 100644 --- a/racket/prologos/parser.rkt +++ b/racket/prologos/parser.rkt @@ -4105,13 +4105,36 @@ (datum->syntax #f (map stx->datum body-parts) (car body-parts)))) (define body (parse-datum body-stx)) ;; Parse patterns: single bracket element → use parse-pattern-bracket - ;; Multiple bare elements → parse each as individual pattern + ;; Multiple bare elements → either ONE compound (if ctor) or N args. + ;; + ;; Disambiguation rule: + ;; `cons r nil` written as bare tokens after `|` is ambiguous between + ;; (a) one compound pattern: cons-of-(r,nil) + ;; (b) three separate arg patterns + ;; ML/Haskell convention reads (a). To match user intuition while + ;; preserving (b) for genuinely multi-arg defns like `defn add | x y -> ...`, + ;; detect: if the leading bare token names a known constructor whose + ;; field-count equals the remaining token count, parse as ONE compound. + ;; Otherwise, fall back to N separate arg patterns. (define patterns (cond [(and (= (length pattern-stxs) 1) (pair? (stx->datum (car pattern-stxs)))) ;; Single bracket [patterns...] → existing parse-pattern-bracket (parse-pattern-bracket (car pattern-stxs) loc)] + [(and (> (length pattern-stxs) 1) + (let* ([head (stx->datum (car pattern-stxs))] + [meta (and (symbol? head) (lookup-ctor head))]) + (and meta + (= (length (ctor-meta-field-types meta)) + (- (length pattern-stxs) 1))))) + ;; Leading symbol is a known constructor with matching field count. + ;; Treat as one compound pattern: cons r nil → (cons r nil) + (list (parse-single-pattern + (datum->syntax #f + (map stx->datum pattern-stxs) + (car pattern-stxs)) + loc))] [else ;; Bare patterns: each element is one argument pattern (for/list ([p (in-list pattern-stxs)]) diff --git a/racket/prologos/tests/test-defn-multiarg-patterns.rkt b/racket/prologos/tests/test-defn-multiarg-patterns.rkt new file mode 100644 index 000000000..e211746a6 --- /dev/null +++ b/racket/prologos/tests/test-defn-multiarg-patterns.rkt @@ -0,0 +1,315 @@ +#lang racket/base + +;;; +;;; Tests for Multi-Arg Pattern Disambiguation in `defn name | ... -> ...` +;;; +;;; Eigentrust pitfalls doc #7 fix: bare-token patterns after `|` in +;;; `defn name | pat -> body | ...` were ambiguous between +;;; (a) one compound pattern: `cons r nil` → cons-of-(r,nil) [ML/Haskell-like] +;;; (b) N separate arg patterns: `cons r nil` → cons, r, nil [old behavior] +;;; +;;; The fix in parser.rkt's parse-defn-clause auto-detects (a) when the +;;; leading token is a known constructor whose field count matches the +;;; remaining tokens. Otherwise it falls back to (b), preserving genuinely +;;; multi-arg defns like `defn add | x y -> [+ x y]`. +;;; +;;; Coverage: +;;; - Single-arg multi-clause (regression of canonical multi-clause defn) +;;; - Multi-arg multi-clause with all-variable patterns (regression of (b)) +;;; - Eigentrust reproducer (sum-rows): `cons r nil` → one compound +;;; - Multi-arg with constructor patterns in non-first positions +;;; - Wildcards `_` mixed in +;;; + +(require rackunit + racket/list + racket/path + racket/string + racket/port + racket/file + "../macros.rkt" + "../prelude.rkt" + "../syntax.rkt" + "../source-location.rkt" + "../surface-syntax.rkt" + "../errors.rkt" + "../metavar-store.rkt" + "../parser.rkt" + "../elaborator.rkt" + "../pretty-print.rkt" + "../global-env.rkt" + "../driver.rkt" + "../reduction.rkt" + (prefix-in tc: "../typing-core.rkt") + "../namespace.rkt" + "../trait-resolution.rkt" + "../parse-reader.rkt" + "../multi-dispatch.rkt") + +;; ======================================== +;; Shared Fixture (prelude loaded once) +;; ======================================== + +(define here (path->string (path-only (syntax-source #'here)))) +(define lib-dir (simplify-path (build-path here ".." "lib"))) + +(define-values (shared-global-env + shared-ns-context + shared-module-reg + shared-trait-reg + shared-impl-reg + shared-param-impl-reg + shared-bundle-reg) + (parameterize ([current-prelude-env (hasheq)] + [current-module-definitions-content (hasheq)] + [current-ns-context #f] + [current-module-registry (hasheq)] + [current-lib-paths (list lib-dir)] + [current-mult-meta-store (make-hasheq)] + [current-preparse-registry (current-preparse-registry)] + [current-trait-registry (current-trait-registry)] + [current-impl-registry (current-impl-registry)] + [current-param-impl-registry (current-param-impl-registry)] + [current-bundle-registry (current-bundle-registry)]) + (install-module-loader!) + (process-string "(ns test-defn-multiarg)") + (values (current-prelude-env) + (current-ns-context) + (current-module-registry) + (current-trait-registry) + (current-impl-registry) + (current-param-impl-registry) + (current-bundle-registry)))) + +;; Run sexp code using shared environment +(define (run s) + (parameterize ([current-prelude-env shared-global-env] + [current-ns-context shared-ns-context] + [current-module-registry shared-module-reg] + [current-lib-paths (list lib-dir)] + [current-mult-meta-store (make-hasheq)] + [current-preparse-registry (current-preparse-registry)] + [current-trait-registry shared-trait-reg] + [current-impl-registry shared-impl-reg] + [current-param-impl-registry shared-param-impl-reg] + [current-bundle-registry shared-bundle-reg]) + (process-string s))) + +(define (run-last s) (last (run s))) + +;; Run WS code via temp file using shared environment +(define (run-ws s) + (define tmp (make-temporary-file "prologos-test-~a.prologos")) + (call-with-output-file tmp #:exists 'replace + (lambda (out) (display s out))) + (define result + (parameterize ([current-prelude-env shared-global-env] + [current-ns-context shared-ns-context] + [current-module-registry shared-module-reg] + [current-lib-paths (list lib-dir)] + [current-mult-meta-store (make-hasheq)] + [current-preparse-registry (current-preparse-registry)] + [current-trait-registry shared-trait-reg] + [current-impl-registry shared-impl-reg] + [current-param-impl-registry shared-param-impl-reg] + [current-bundle-registry shared-bundle-reg]) + (process-file tmp))) + (delete-file tmp) + result) + +(define (run-ws-last s) (last (run-ws s))) + +;; ======================================== +;; A. Single-arg multi-clause regression +;; ======================================== +;; The canonical `is-zero` example from prologos-syntax.md. + +(test-case "marg/single-arg-is-zero" + (check-equal? + (run-ws-last + "defn iz-marg\n | zero -> true\n | suc _ -> false\neval [iz-marg 0N]") + "true : Bool") + (check-equal? + (run-ws-last + "defn iz-marg2\n | zero -> true\n | suc _ -> false\neval [iz-marg2 3N]") + "false : Bool")) + +;; ======================================== +;; B. Multi-arg with all-variable patterns: must NOT be packed +;; ======================================== +;; `x y` does not have a leading ctor, so falls back to N args. +;; Critical regression: confirms genuinely multi-arg defns still work. + +(test-case "marg/all-var-two-arg" + ;; `defn add-marg | x y -> [+ x y]` — 2 args, both variables + ;; Use Nat constructors so the type infers as Nat -> Nat -> Nat + (check-equal? + (run-ws-last + "spec add-marg Nat -> Nat -> Nat\ndefn add-marg\n | x y -> [+ x y]\neval [add-marg 3N 4N]") + "7N : Nat")) + +(test-case "marg/all-var-three-arg" + ;; 3 args, all variable — must be parsed as 3 args + (check-equal? + (run-ws-last + "spec triple-add Nat -> Nat -> Nat -> Nat\ndefn triple-add\n | x y z -> [+ [+ x y] z]\neval [triple-add 1N 2N 3N]") + "6N : Nat")) + +;; ======================================== +;; C. Eigentrust reproducer: `cons r nil` packs to one compound +;; ======================================== + +(test-case "marg/eigentrust-sum-rows-typechecks" + ;; The eigentrust reproducer: previously failed with `Unbound variable + ;; sum-rows::1` because bare-token clauses produced split arities + ;; (1, 3, 3 instead of 1, 1, 1). With the fix, all three clauses are + ;; arity 1 and `sum-rows-eig` defines as `[List Nat] -> Nat` — a single + ;; function, no per-clause helpers, no unbound reference. + ;; + ;; This test verifies the *parsing* fix (single arity, single function). + ;; A latent compile-match-tree bug (variable bindings for outer-param + ;; names broken across nested compound dispatch) is orthogonal and + ;; tracked separately; see commit message for details. We exercise the + ;; eigentrust case at empty + singleton inputs which are unaffected. + (define results + (run-ws + (string-append + "spec sum-rows-eig [List Nat] -> Nat\n" + "defn sum-rows-eig\n" + " | nil -> 0N\n" + " | cons r nil -> r\n" + " | cons r rest -> [+ r [sum-rows-eig rest]]\n" + "eval [sum-rows-eig '[5N]]"))) + ;; First non-error result line confirms parse + type-check + arity-1 def. + (check-true (for/or ([r (in-list results)]) + (and (string? r) + (string-contains? r "sum-rows-eig") + (string-contains? r "List Nat] -> Nat"))))) + +(test-case "marg/eigentrust-sum-rows-empty" + ;; Empty list → first clause matches: nil → 0N (no nested binding bug). + (define results + (run-ws + (string-append + "spec sum-rows-eig2 [List Nat] -> Nat\n" + "defn sum-rows-eig2\n" + " | nil -> 0N\n" + " | cons r nil -> r\n" + " | cons r rest -> [+ r [sum-rows-eig2 rest]]\n" + "eval [sum-rows-eig2 [the [List Nat] nil]]"))) + (check-true (for/or ([r (in-list results)]) + (and (string? r) (string-contains? r "0N"))))) + +(test-case "marg/eigentrust-sum-rows-singleton" + ;; Singleton list → second clause matches: cons r nil → r. + ;; This is the boundary that the fix unlocks — pre-fix the function + ;; was arity-1 with only the nil clause, so any non-empty list would + ;; hit ??__match-fail. + (define results + (run-ws + (string-append + "spec sum-rows-eig3 [List Nat] -> Nat\n" + "defn sum-rows-eig3\n" + " | nil -> 0N\n" + " | cons r nil -> r\n" + " | cons r rest -> [+ r [sum-rows-eig3 rest]]\n" + "eval [sum-rows-eig3 '[42N]]"))) + (check-true (for/or ([r (in-list results)]) + (and (string? r) (string-contains? r "42N"))))) + +;; ======================================== +;; D. Constructor patterns in non-first positions +;; ======================================== +;; `[+ ... 0N]`-like patterns: peano addition with zero on the right. + +(test-case "marg/ctor-pattern-non-first-position" + ;; `add-zero-r | n zero -> n | n [suc m] -> [suc [add-zero-r n m]]` + ;; Bare `n zero` has leading `n` (variable, not ctor) → falls back to 2 args. + ;; This is the "bare patterns" case where the user genuinely wants N args. + (check-equal? + (run-ws-last + (string-append + "spec add-zr Nat -> Nat -> Nat\n" + "defn add-zr\n" + " | n zero -> n\n" + " | n [suc m] -> [suc [add-zr n m]]\n" + "eval [add-zr 2N 3N]")) + "5N : Nat")) + +;; ======================================== +;; E. Wildcards mixed in +;; ======================================== + +(test-case "marg/wildcard-in-bare-tokens" + ;; `cons _ nil` — `cons` is leading ctor with 2 fields, 2 remaining tokens. + ;; Should be packed as one pattern: cons-of-(_,nil). + (check-equal? + (run-ws-last + (string-append + "defn singleton?\n" + " | nil -> false\n" + " | cons _ nil -> true\n" + " | cons _ _ -> false\n" + "eval [singleton? '[42N]]")) + "true : Bool") + (check-equal? + (run-ws-last + (string-append + "defn singleton?2\n" + " | nil -> false\n" + " | cons _ nil -> true\n" + " | cons _ _ -> false\n" + "eval [singleton?2 '[1N 2N]]")) + "false : Bool")) + +(test-case "marg/wildcard-in-all-var" + ;; `_ _` — both wildcards, no leading ctor → 2 args. + (check-equal? + (run-ws-last + (string-append + "spec const-zero-2 Nat -> Nat -> Nat\n" + "defn const-zero-2\n" + " | _ _ -> 0N\n" + "eval [const-zero-2 5N 7N]")) + "0N : Nat")) + +;; ======================================== +;; F. Mixed: some clauses pack, others don't +;; ======================================== +;; All clauses must end up at the SAME arity. A bare-pattern clause +;; whose leading token is a ctor with matching arity packs to one +;; pattern; a `nil` clause is already one pattern. Both → arity 1. + +(test-case "marg/mixed-leading-ctor-and-nullary" + ;; nil (1 token, nullary ctor) + cons _ _ (3 tokens, packs to 1 compound) + (check-equal? + (run-ws-last + (string-append + "spec list-len-marg [List Nat] -> Nat\n" + "defn list-len-marg\n" + " | nil -> 0N\n" + " | cons _ rest -> [suc [list-len-marg rest]]\n" + "eval [list-len-marg '[10N 20N 30N]]")) + "3N : Nat")) + +;; ======================================== +;; G. Bracketed form continues to work (regression) +;; ======================================== +;; `[cons r nil]` (single bracket) is the explicit way to write a +;; compound pattern in a multi-arg context. This remains supported. + +(test-case "marg/double-bracket-compound-still-works" + ;; [[cons _ nil]] (double bracket) is the legacy way to write a + ;; compound pattern as a single arg in the bracketed form: outer + ;; bracket = "this is the params list with 1 element"; inner bracket + ;; = "the element is the compound pattern (cons _ nil)". This path + ;; is unchanged by the fix (regression check). + (check-equal? + (run-ws-last + (string-append + "defn singleton?-dblbracket\n" + " | [[nil]] -> false\n" + " | [[cons _ nil]] -> true\n" + " | [[cons _ _]] -> false\n" + "eval [singleton?-dblbracket '[42N]]")) + "true : Bool"))