mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 22:10:21 +02:00
Code Activity

just parse method arguments once.

Browse source 
* module/oop/goops.scm (method): Tweak to just run through the arguments
  once. Thanks to Eli Barzilay for the tip.
This commit is contained in:
Andy Wingo 2009-05-21 15:34:29 +02:00
parent 47c8983f08
commit d63927150a
1 changed files with 20 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

38
module/oop/goops.scm
View file

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