diff options
author | Andy Wingo <wingo@pobox.com> | 2015-01-24 19:22:47 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2015-01-24 19:23:08 +0100 |
commit | 583a23bf104c84d9617222856e188f3f3af4934d (patch) | |
tree | d2bf181685cc72bf203b23348cd7b996f002d46f /module/oop/goops | |
parent | 1abe6ba5d8ab3fd84d55ea2494d3cea67d8b0474 (diff) | |
download | guile-583a23bf104c84d9617222856e188f3f3af4934d.tar.gz |
Fix accessor struct field inlining
* module/oop/goops/compile.scm: Inline into goops.scm, leaving a
compatible interface stub behind.
* module/oop/goops/dispatch.scm: Don't import (oop goops compile), to
break circularities.
* module/oop/goops.scm: Move (oop goops util) include up to the top, and
import (ice-9 match).
(compute-cmethod): Move here from compile.scm. Add a special case for
accessor methods, so as to fix bug #17355.
(compute-getter-method, compute-setter-method): #:procedure slot is
now generic.
* test-suite/tests/goops.test ("accessor slots"): New test.
Diffstat (limited to 'module/oop/goops')
-rw-r--r-- | module/oop/goops/compile.scm | 40 | ||||
-rw-r--r-- | module/oop/goops/dispatch.scm | 5 |
2 files changed, 5 insertions, 40 deletions
diff --git a/module/oop/goops/compile.scm b/module/oop/goops/compile.scm index 8c546e03f..93fdbf76e 100644 --- a/module/oop/goops/compile.scm +++ b/module/oop/goops/compile.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1999, 2001, 2006, 2009 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2006, 2009, 2015 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 @@ -16,40 +16,6 @@ ;;;; -;; There are circularities here; you can't import (oop goops compile) -;; before (oop goops). So when compiling, make sure that things are -;; kosher. -(eval-when (expand) (resolve-module '(oop goops))) - (define-module (oop goops compile) - :use-module (oop goops) - :use-module (oop goops util) - :export (compute-cmethod) - :no-backtrace - ) - -;;; -;;; Compiling next methods into method bodies -;;; - -;;; So, for the reader: there basic idea is that, given that the -;;; semantics of `next-method' depend on the concrete types being -;;; dispatched, why not compile a specific procedure to handle each type -;;; combination that we see at runtime. -;;; -;;; In theory we can do much better than a bytecode compilation, because -;;; we know the *exact* types of the arguments. It's ideal for native -;;; compilation. A task for the future. -;;; -;;; I think this whole generic application mess would benefit from a -;;; strict MOP. - -(define (compute-cmethod methods types) - (let ((make-procedure (slot-ref (car methods) 'make-procedure))) - (if make-procedure - (make-procedure - (if (null? (cdr methods)) - (lambda args - (no-next-method (method-generic-function (car methods)) args)) - (compute-cmethod (cdr methods) types))) - (method-procedure (car methods))))) + #:use-module (oop goops internal) + #:re-export (compute-cmethod)) diff --git a/module/oop/goops/dispatch.scm b/module/oop/goops/dispatch.scm index 0198a9f40..666597441 100644 --- a/module/oop/goops/dispatch.scm +++ b/module/oop/goops/dispatch.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1999, 2000, 2001, 2003, 2006, 2009, 2012 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2000, 2001, 2003, 2006, 2009, 2012, 2015 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 @@ -24,7 +24,6 @@ (define-module (oop goops dispatch) #:use-module (oop goops) #:use-module (oop goops util) - #:use-module (oop goops compile) #:use-module (system base target) #:export (memoize-method!) #:no-backtrace) @@ -251,7 +250,7 @@ (else (parse (1+ n) (cdr ls))))) (define (memoize len rest? types) - (let* ((cmethod (compute-cmethod applicable types)) + (let* ((cmethod ((@@ (oop goops) compute-cmethod) applicable types)) (cache (cons (vector len types rest? cmethod) (slot-ref gf 'effective-methods)))) (slot-set! gf 'effective-methods cache) |