* goops/compile.scm (compile-method): Tag method closure for body

expansion.

* goops.scm (change-object-class): Quote empty list constants.
(method): Reverted previous change (enclosing body);
Quote empty list.
(initialize <method>): Supply `dummy-procedure' as default instead
of creating a new closure.

* goops/internal.scm: Re-export (oop goops) without copying
bindings.

diff --git a/oop/ChangeLog b/oop/ChangeLog
index b071f50..cf3f522 100644 (file)
--- a/oop/ChangeLog
+++ b/oop/ChangeLog
@@ -1,10 +1,17 @@
 2001-03-04  Mikael Djurfeldt  <mdj@linnaeus.mit.edu>
 
+       * goops/compile.scm (compile-method): Tag method closure for body
+       expansion.
+
        * goops.scm (change-object-class): Quote empty list constants.
        (method): Reverted previous change (enclosing body);
        Quote empty list.
-       (initialize <method>): Pre-expand the method closure.
+       (initialize <method>): Supply `dummy-procedure' as default instead
+       of creating a new closure.
        
+       * goops/internal.scm: Re-export (oop goops) without copying
+       bindings.
+
 2001-02-23  Keisuke Nishida  <kxn30@po.cwru.edu>
 
        * goops.scm (method): Enclosed BODY by `(let () ...)'.

diff --git a/oop/goops.scm b/oop/goops.scm
index a0af2b9..ca5c85d 100644 (file)
--- a/oop/goops.scm
+++ b/oop/goops.scm
@@ -1314,14 +1314,14 @@
        (set-procedure-property! generic 'name name))
     ))
 
+(define dummy-procedure (lambda args *unspecified*))
+
 (define-method initialize ((method <method>) initargs)
   (next-method)
   (slot-set! method 'generic-function (get-keyword #:generic-function initargs #f))
   (slot-set! method 'specializers (get-keyword #:specializers initargs '()))
-  (slot-set! method
-            'procedure
-            (%pre-expand-closure!
-             (get-keyword #:procedure initargs (lambda l '()))))
+  (slot-set! method 'procedure
+            (get-keyword #:procedure initargs dummy-procedure))
   (slot-set! method 'code-table '()))
 
 (define-method initialize ((obj <foreign-object>) initargs))

diff --git a/oop/goops/compile.scm b/oop/goops/compile.scm
index ab185f3..8e99733 100644 (file)
--- a/oop/goops/compile.scm
+++ b/oop/goops/compile.scm
@@ -1,4 +1,4 @@
-;;;;   Copyright (C) 1999 Free Software Foundation, Inc.
+;;;;   Copyright (C) 1999, 2001 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -109,6 +109,9 @@
 ;;; NOTE: This section is far from finished.  It will finally be
 ;;; implemented on C level.
 
+(define %tag-body
+  (nested-ref the-root-module '(app modules oop goops %tag-body)))
+
 (define (compile-method methods types)
   (let* ((proc (method-procedure (car methods)))
         (src (procedure-source proc))
@@ -132,5 +135,5 @@
              ,@body)))
        (cons (procedure-environment proc)
              (cons formals
-                   body))
+                   (%tag-body body)))
        )))

diff --git a/oop/goops/internal.scm b/oop/goops/internal.scm
index 6331ef6..864fdac 100644 (file)
--- a/oop/goops/internal.scm
+++ b/oop/goops/internal.scm
@@ -1,6 +1,6 @@
 ;;; installed-scm-file
 
-;;;;   Copyright (C) 1999 Free Software Foundation, Inc.
+;;;;   Copyright (C) 1999, 2001 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -22,7 +22,5 @@
 (define-module (oop goops internal)
   :use-module (oop goops))
 
-;; Export all bindings from (oop goops)
-(module-for-each (lambda (sym var)
-                  (module-add! %module-public-interface sym var))
-                (nested-ref the-root-module '(app modules oop goops)))
+(set-module-uses! %module-public-interface
+                 (list (nested-ref the-root-module '(app modules oop goops))))