mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 12:20:20 +02:00
Code Activity

remove code-table slot from methods

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2009-11-05 12:54:41 +01:00
parent 6d33e90f0c
commit c40944c9ff
4 changed files with 8 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

1
module/oop/goops.scm
View file

@ -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)))

30
module/oop/goops/compile.scm
View file

@ -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
@ -28,32 +28,6 @@
:no-backtrace
)
;;;
;;; 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