diff options
author | Andy Wingo <wingo@pobox.com> | 2009-11-05 13:16:40 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-11-26 00:25:06 +0100 |
commit | 2aecf4cfe22962118e945a9a4b6ab52e063a7119 (patch) | |
tree | 3544d62b945412881750386b220601d5802958ec /module/oop/goops | |
parent | c40944c9ff4f22ccae7c54628bf0057d9a0032f2 (diff) | |
download | guile-2aecf4cfe22962118e945a9a4b6ab52e063a7119.tar.gz |
more clarity in (oop goops dispatch)
* module/oop/goops/dispatch.scm (memoize-method!): If we don't have a
no-applicable-method, just call no-applicable-method directly.
* test-suite/tests/goops.test ("no-applicable-method"): Add some tests.
Diffstat (limited to 'module/oop/goops')
-rw-r--r-- | module/oop/goops/dispatch.scm | 11 |
1 files changed, 1 insertions, 10 deletions
diff --git a/module/oop/goops/dispatch.scm b/module/oop/goops/dispatch.scm index 1b83529b1..14b4a854c 100644 --- a/module/oop/goops/dispatch.scm +++ b/module/oop/goops/dispatch.scm @@ -207,10 +207,6 @@ ;;; Memoization ;;; -;; Backward compatibility -(define (lookup-create-cmethod gf args) - (no-applicable-method (car args) (cadr args))) - (define (memoize-method! gf args exp) (let ((applicable ((if (eq? gf compute-applicable-methods) %compute-applicable-methods @@ -237,13 +233,8 @@ new args applicable))))) (set-cdr! (cdr exp) (cddr new)) res)) - ((null? args) - (lookup-create-cmethod no-applicable-method (list gf '()))) (else - ;; Mutate arglist to fit no-applicable-method - (set-cdr! args (list (cons (car args) (cdr args)))) - (set-car! args gf) - (lookup-create-cmethod no-applicable-method args))))) + (no-applicable-method gf args))))) (set-procedure-property! memoize-method! 'system-procedure #t) |