summaryrefslogtreecommitdiff
path: root/module/oop
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-11-05 12:54:41 +0100
committerAndy Wingo <wingo@pobox.com>2009-11-26 00:25:06 +0100
commitc40944c9ff4f22ccae7c54628bf0057d9a0032f2 (patch)
tree706849ca922e7f5a2a84aef4baa520d5b41d6cb4 /module/oop
parent6d33e90f0ccf96f5a9f6403768daf24f84481046 (diff)
downloadguile-c40944c9ff4f22ccae7c54628bf0057d9a0032f2.tar.gz
remove code-table slot from methods
* libguile/goops.c (scm_sys_invalidate_method_cache_x, scm_make) (create_standard_classes): Remove code-table slot from methods. The generic cache completely does its job, afaict. * libguile/goops.h (scm_si_formals, scm_si_body, scm_si_make_procedure): Renumber slots. * module/oop/goops.scm (initialize on <method>): No more code-table slot. * module/oop/goops/compile.scm: Always "compile" a method, instead of looking for a hit in an always-empty cache.
Diffstat (limited to 'module/oop')
-rw-r--r--module/oop/goops.scm1
-rw-r--r--module/oop/goops/compile.scm30
2 files changed, 2 insertions, 29 deletions
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index a9e26b5aa..b67c4d4b0 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -1517,7 +1517,6 @@
(slot-set! method 'specializers (get-keyword #:specializers initargs '()))
(slot-set! method 'procedure
(get-keyword #:procedure initargs #f))
- (slot-set! method 'code-table '())
(slot-set! method 'formals (get-keyword #:formals initargs '()))
(slot-set! method 'body (get-keyword #:body initargs '()))
(slot-set! method 'make-procedure (get-keyword #:make-procedure initargs #f)))
diff --git a/module/oop/goops/compile.scm b/module/oop/goops/compile.scm
index 5db406cd0..db1a16088 100644
--- a/module/oop/goops/compile.scm
+++ b/module/oop/goops/compile.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2006, 2009 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -29,32 +29,6 @@
)
;;;
-;;; Method entries
-;;;
-
-(define code-table-lookup
- (letrec ((check-entry (lambda (entry types)
- (cond
- ((not (pair? entry)) (and (null? types) entry))
- ((null? types) #f)
- (else
- (and (eq? (car entry) (car types))
- (check-entry (cdr entry) (cdr types))))))))
- (lambda (code-table types)
- (cond ((null? code-table) #f)
- ((check-entry (car code-table) types))
- (else (code-table-lookup (cdr code-table) types))))))
-
-(define (compute-cmethod methods types)
- (or (code-table-lookup (slot-ref (car methods) 'code-table) types)
- (let* ((method (car methods))
- (cmethod (compile-method methods types))
- (entry (append types cmethod)))
- (slot-set! method 'code-table
- (cons entry (slot-ref method 'code-table)))
- cmethod)))
-
-;;;
;;; Compiling next methods into method bodies
;;;
@@ -70,7 +44,7 @@
;;; I think this whole generic application mess would benefit from a
;;; strict MOP.
-(define (compile-method methods types)
+(define (compute-cmethod methods types)
(let ((make-procedure (slot-ref (car methods) 'make-procedure)))
(if make-procedure
(make-procedure