From b432fb4b9929475c963e8be69ed6c7293bc964d2 Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Sun, 4 Mar 2001 20:46:34 +0000 Subject: [PATCH] * 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 ): Supply `dummy-procedure' as default instead of creating a new closure. * goops/internal.scm: Re-export (oop goops) without copying bindings. --- oop/ChangeLog | 9 ++++++++- oop/goops.scm | 8 ++++---- oop/goops/compile.scm | 7 +++++-- oop/goops/internal.scm | 8 +++----- 4 files changed, 20 insertions(+), 12 deletions(-) diff --git a/oop/ChangeLog b/oop/ChangeLog index b071f5019..cf3f52287 100644 --- a/oop/ChangeLog +++ b/oop/ChangeLog @@ -1,10 +1,17 @@ 2001-03-04 Mikael Djurfeldt + * 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 ): Pre-expand the method closure. + (initialize ): 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 * goops.scm (method): Enclosed BODY by `(let () ...)'. diff --git a/oop/goops.scm b/oop/goops.scm index a0af2b9bf..ca5c85dec 100644 --- 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 ) 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 ) initargs)) diff --git a/oop/goops/compile.scm b/oop/goops/compile.scm index ab185f3c5..8e99733a1 100644 --- 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 6331ef6df..864fdacf2 100644 --- 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)))) -- 2.20.1