Commit | Line | Data |
---|---|---|
c40944c9 | 1 | ;;;; Copyright (C) 1999, 2001, 2006, 2009 Free Software Foundation, Inc. |
14f1d9fe | 2 | ;;;; |
73be1d9e MV |
3 | ;;;; This library is free software; you can redistribute it and/or |
4 | ;;;; modify it under the terms of the GNU Lesser General Public | |
5 | ;;;; License as published by the Free Software Foundation; either | |
53befeb7 | 6 | ;;;; version 3 of the License, or (at your option) any later version. |
14f1d9fe | 7 | ;;;; |
73be1d9e | 8 | ;;;; This library is distributed in the hope that it will be useful, |
14f1d9fe | 9 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
73be1d9e MV |
10 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
11 | ;;;; Lesser General Public License for more details. | |
14f1d9fe | 12 | ;;;; |
73be1d9e MV |
13 | ;;;; You should have received a copy of the GNU Lesser General Public |
14 | ;;;; License along with this library; if not, write to the Free Software | |
92205699 | 15 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
14f1d9fe MD |
16 | ;;;; |
17 | \f | |
18 | ||
4631414e AW |
19 | ;; There are circularities here; you can't import (oop goops compile) |
20 | ;; before (oop goops). So when compiling, make sure that things are | |
21 | ;; kosher. | |
f6ddf827 | 22 | (eval-when (expand) (resolve-module '(oop goops))) |
4631414e | 23 | |
14f1d9fe MD |
24 | (define-module (oop goops compile) |
25 | :use-module (oop goops) | |
26 | :use-module (oop goops util) | |
47c8983f | 27 | :export (compute-cmethod) |
14f1d9fe MD |
28 | :no-backtrace |
29 | ) | |
30 | ||
5487977b | 31 | ;;; |
e177058b | 32 | ;;; Compiling next methods into method bodies |
5487977b AW |
33 | ;;; |
34 | ||
35 | ;;; So, for the reader: there basic idea is that, given that the | |
36 | ;;; semantics of `next-method' depend on the concrete types being | |
37 | ;;; dispatched, why not compile a specific procedure to handle each type | |
47c8983f | 38 | ;;; combination that we see at runtime. |
5487977b AW |
39 | ;;; |
40 | ;;; In theory we can do much better than a bytecode compilation, because | |
41 | ;;; we know the *exact* types of the arguments. It's ideal for native | |
42 | ;;; compilation. A task for the future. | |
43 | ;;; | |
44 | ;;; I think this whole generic application mess would benefit from a | |
45 | ;;; strict MOP. | |
46 | ||
c40944c9 | 47 | (define (compute-cmethod methods types) |
e177058b AW |
48 | (let ((make-procedure (slot-ref (car methods) 'make-procedure))) |
49 | (if make-procedure | |
50 | (make-procedure | |
074c414e | 51 | (if (null? (cdr methods)) |
e177058b AW |
52 | (lambda args |
53 | (no-next-method (method-generic-function (car methods)) args)) | |
54 | (compute-cmethod (cdr methods) types))) | |
55 | (method-procedure (car methods))))) |