mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 14:21:10 +02:00
Code Activity

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

Browse source 
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.
This commit is contained in:
Mikael Djurfeldt 2001-03-04 20:46:34 +00:00
parent 5e03762c12
commit b432fb4b99
4 changed files with 20 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

9
oop/ChangeLog
View file

@ -1,10 +1,17 @@
2001-03-04 Mikael Djurfeldt <mdj@linnaeus.mit.edu> 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. * goops.scm (change-object-class): Quote empty list constants.
(method): Reverted previous change (enclosing body); (method): Reverted previous change (enclosing body);
Quote empty list. 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> 2001-02-23 Keisuke Nishida <kxn30@po.cwru.edu>
* goops.scm (method): Enclosed BODY by `(let () ...)'. * goops.scm (method): Enclosed BODY by `(let () ...)'.

8
oop/goops.scm
View file

@ -1314,14 +1314,14 @@
(set-procedure-property! generic 'name name)) (set-procedure-property! generic 'name name))
)) ))
(define dummy-procedure (lambda args *unspecified*))
(define-method initialize ((method <method>) initargs) (define-method initialize ((method <method>) initargs)
(next-method) (next-method)
(slot-set! method 'generic-function (get-keyword #:generic-function initargs #f)) (slot-set! method 'generic-function (get-keyword #:generic-function initargs #f))
(slot-set! method 'specializers (get-keyword #:specializers initargs '())) (slot-set! method 'specializers (get-keyword #:specializers initargs '()))
(slot-set! method (slot-set! method 'procedure
'procedure (get-keyword #:procedure initargs dummy-procedure))
(%pre-expand-closure!
(get-keyword #:procedure initargs (lambda l '()))))
(slot-set! method 'code-table '())) (slot-set! method 'code-table '()))
(define-method initialize ((obj <foreign-object>) initargs)) (define-method initialize ((obj <foreign-object>) initargs))

7
oop/goops/compile.scm
View file

@ -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 ;;;; 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 ;;;; 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 ;;; NOTE: This section is far from finished. It will finally be
;;; implemented on C level. ;;; implemented on C level.
(define %tag-body
(nested-ref the-root-module '(app modules oop goops %tag-body)))
(define (compile-method methods types) (define (compile-method methods types)
(let* ((proc (method-procedure (car methods))) (let* ((proc (method-procedure (car methods)))
(src (procedure-source proc)) (src (procedure-source proc))
@ -132,5 +135,5 @@
,@body))) ,@body)))
(cons (procedure-environment proc) (cons (procedure-environment proc)
(cons formals (cons formals
body)) (%tag-body body)))
))) )))

8
oop/goops/internal.scm
View file

@ -1,6 +1,6 @@
;;; installed-scm-file ;;; 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 ;;;; 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 ;;;; it under the terms of the GNU General Public License as published by
@ -22,7 +22,5 @@
(define-module (oop goops internal) (define-module (oop goops internal)
:use-module (oop goops)) :use-module (oop goops))
;; Export all bindings from (oop goops) (set-module-uses! %module-public-interface
(module-for-each (lambda (sym var) (list (nested-ref the-root-module '(app modules oop goops))))
(module-add! %module-public-interface sym var))
(nested-ref the-root-module '(app modules oop goops)))