From 3c5bda43d500c13624fe1481c0ce940414070f30 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 12 Oct 2018 08:57:15 -0700 Subject: [PATCH] improve arity error --- csp/csp.rkt | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 32e7162c..f7ced556 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -235,7 +235,9 @@ (validate-assignments csp-with-assignment)) (define (reduce-arity proc pattern) - (unless (= (length pattern) (procedure-arity proc)) + (unless (match (procedure-arity proc) + [(arity-at-least val) (<= val (length pattern))] + [(? number? val) (= val (length pattern))]) (raise-argument-error 'reduce-arity (format "list of length ~a, same as procedure arity" (procedure-arity proc)) pattern)) (define reduced-arity-name (string->symbol (format "reduced-arity-~a" (object-name proc)))) (define-values (id-names vals) (partition symbol? pattern)) @@ -248,8 +250,8 @@ [xs xs] [vals vals] #:result (reverse acc)) - ([arg (in-list pattern)]) - (if (symbol? arg) + ([pat-item (in-list pattern)]) + (if (symbol? pat-item) (values (cons (car xs) acc) (cdr xs) vals) (values (cons (car vals) acc) xs (cdr vals)))))) reduced-arity-name))