just parse method arguments once.

* module/oop/goops.scm (method): Tweak to just run through the arguments
  once. Thanks to Eli Barzilay for the tip.

1 files changed, 20 insertions, 18 deletions

diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 8c980485f..fd2d60058 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -479,23 +479,26 @@
 
 (define-syntax method
   (lambda (x)
-    (define (compute-formals args)
-      (let lp ((ls args) (out '()))
-        (syntax-case ls ()
-          (((f s) . rest)  (lp (syntax rest) (cons (syntax f) out)))
-          ((f . rest)      (identifier? (syntax f))
-                           (lp (syntax rest) (cons (syntax f) out)))
-          (()              (reverse out))
-          (tail            (identifier? (syntax tail))
-                           (append (reverse out) (syntax tail))))))
-
-    (define (compute-specializers args)
-      (let lp ((ls args) (out '()))
+    (define (parse-args args)
+      (let lp ((ls args) (formals '()) (specializers '()))
         (syntax-case ls ()
-          (((f s) . rest)  (lp (syntax rest) (cons (syntax s) out)))
-          ((f . rest)      (lp (syntax rest) (cons (syntax <top>) out)))
-          (()              (reverse (cons (syntax '()) out)))
-          (tail            (reverse (cons (syntax <top>) out))))))
+          (((f s) . rest)
+           (and (identifier? (syntax f)) (identifier? (syntax s)))
+           (lp (syntax rest)
+               (cons (syntax f) formals)
+               (cons (syntax s) specializers)))
+          ((f . rest)
+           (identifier? (syntax f))
+           (lp (syntax rest)
+               (cons (syntax f) formals)
+               (cons (syntax <top>) specializers)))
+          (()
+           (list (reverse formals)
+                 (reverse (cons (syntax '()) specializers))))
+          (tail
+           (identifier? (syntax tail))
+           (list (append (reverse formals) (syntax tail))
+                 (reverse (cons (syntax <top>) specializers)))))))
 
     (define (find-free-id exp referent)
       (syntax-case exp ()
@@ -561,8 +564,7 @@
     (syntax-case x ()
       ((_ args) (syntax (method args (if #f #f))))
       ((_ args body0 body1 ...)
-       (with-syntax ((formals (compute-formals (syntax args)))
-                     ((specializer ...) (compute-specializers (syntax args))))
+       (with-syntax (((formals (specializer ...)) (parse-args (syntax args))))
          (call-with-values
              (lambda ()
                (compute-procedures (syntax formals) (syntax (body0 body1 ...))))