hm

csp/csp.rkt

@@ -234,20 +234,21 @@
   (define csp-with-assignment (apply-unary-constraint csp ($constraint (list name) (delay (list val)))))
   (validate-assignments csp-with-assignment))
 
-(define (reduce-arity proc args)
+(define (reduce-arity proc pattern)
-  (unless (= (length args) (procedure-arity proc))
+  (unless (= (length pattern) (procedure-arity proc))
-    (raise-argument-error 'reduce-arity (format "list of length ~a, same as procedure arity" (procedure-arity proc)) args))
+    (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 new-arity (length (filter symbol? args)))
+  (define-values (id-names vals) (partition symbol? pattern))
+  (define new-arity (length id-names))
   (procedure-rename
    (λ xs
      (unless (= (length xs) new-arity)
        (apply raise-arity-error reduced-arity-name new-arity xs))
      (apply proc (for/fold ([acc empty]
                             [xs xs]
-                            [vals (filter-not symbol? args)]
+                            [vals vals]
                             #:result (reverse acc))
-                           ([arg (in-list args)])
+                           ([arg (in-list pattern)])
                    (if (symbol? arg)
                        (values (cons (car xs) acc) (cdr xs) vals)
                        (values (cons (car vals) acc) xs (cdr vals))))))