[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 83/88: Update (oop goops save) for <slot> objects
From: |
Andy Wingo |
Subject: |
[Guile-commits] 83/88: Update (oop goops save) for <slot> objects |
Date: |
Fri, 23 Jan 2015 15:26:01 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit 0b4c068d532a372222d890a4f66e2d47f4de651e
Author: Andy Wingo <address@hidden>
Date: Mon Jan 19 17:11:21 2015 +0100
Update (oop goops save) for <slot> objects
* module/oop/goops/describe.scm (describe): Remove commented code.
* module/oop/goops/save.scm (get-set-for-each, access-for-each): Update
these hoary routines for the new <slot> universe.
---
module/oop/goops/describe.scm | 11 +-------
module/oop/goops/save.scm | 49 ++++++++++++++++++++---------------------
2 files changed, 26 insertions(+), 34 deletions(-)
diff --git a/module/oop/goops/describe.scm b/module/oop/goops/describe.scm
index 52eb299..0428b4b 100644
--- a/module/oop/goops/describe.scm
+++ b/module/oop/goops/describe.scm
@@ -1,6 +1,6 @@
;;; installed-scm-file
-;;;; Copyright (C) 1998, 1999, 2001, 2006, 2008, 2009 Free Software
Foundation, Inc.
+;;;; Copyright (C) 1998, 1999, 2001, 2006, 2008, 2009, 2015 Free Software
Foundation, Inc.
;;;; Copyright (C) 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <address@hidden>
;;;;
;;;; This library is free software; you can redistribute it and/or
@@ -138,14 +138,7 @@
(format #t "(No direct method)~%")
(begin
(format #t "Class direct methods are:~%")
- (for-each describe methods))))
-
-; (format #t "~%Field Initializers ~% ")
-; (write (slot-ref x 'initializers)) (newline)
-
-; (format #t "~%Getters and Setters~% ")
-; (write (slot-ref x 'getters-n-setters)) (newline)
-)
+ (for-each describe methods)))))
;;;
;;; Describe for generic functions
diff --git a/module/oop/goops/save.scm b/module/oop/goops/save.scm
index a4b15ad..20c3b05 100644
--- a/module/oop/goops/save.scm
+++ b/module/oop/goops/save.scm
@@ -370,33 +370,32 @@
;; Don't export this function! This is all very temporary.
;;
(define (get-set-for-each proc class)
- (for-each (lambda (slotdef g-n-s)
- (let ((g-n-s (cddr g-n-s)))
- (cond ((integer? g-n-s)
- (proc (standard-get g-n-s) (standard-set g-n-s)))
- ((not (memq (slot-definition-allocation slotdef)
- '(#:class #:each-subclass)))
- (proc (car g-n-s) (cadr g-n-s))))))
- (class-slots class)
- (slot-ref class 'getters-n-setters)))
+ (for-each (lambda (slot)
+ (unless (memq (slot-definition-allocation slot)
+ '(#:class #:each-subclass))
+ (let ((ref (slot-definition-slot-ref slot))
+ (set (slot-definition-slot-set! slot))
+ (index (slot-definition-index slot)))
+ (if ref
+ (proc ref set)
+ (proc (standard-get index) (standard-set index))))))
+ (class-slots class)))
(define (access-for-each proc class)
- (for-each (lambda (slotdef g-n-s)
- (let ((g-n-s (cddr g-n-s))
- (a (slot-definition-accessor slotdef)))
- (cond ((integer? g-n-s)
- (proc (slot-definition-name slotdef)
- (and a (generic-function-name a))
- (standard-get g-n-s)
- (standard-set g-n-s)))
- ((not (memq (slot-definition-allocation slotdef)
- '(#:class #:each-subclass)))
- (proc (slot-definition-name slotdef)
- (and a (generic-function-name a))
- (car g-n-s)
- (cadr g-n-s))))))
- (class-slots class)
- (slot-ref class 'getters-n-setters)))
+ (for-each (lambda (slot)
+ (unless (memq (slot-definition-allocation slot)
+ '(#:class #:each-subclass))
+ (let ((name (slot-definition-name slot))
+ (accessor (and=> (slot-definition-accessor slot)
+ generic-function-name))
+ (ref (slot-definition-slot-ref slot))
+ (set (slot-definition-slot-set! slot))
+ (index (slot-definition-index slot)))
+ (if ref
+ (proc name accessor ref set)
+ (proc name accessor
+ (standard-get index) (standard-set index))))))
+ (class-slots class)))
(define-macro (restore class slots . exps)
"(restore CLASS (SLOT-NAME1 ...) EXP1 ...)"
- [Guile-commits] 73/88: GOOPS: Deprecate "using-class" procs like slot-ref-using-class, (continued)
- [Guile-commits] 73/88: GOOPS: Deprecate "using-class" procs like slot-ref-using-class, Andy Wingo, 2015/01/23
- [Guile-commits] 65/88: when and unless for one-armed ifs in goops.scm, Andy Wingo, 2015/01/23
- [Guile-commits] 75/88: Beginnings of <slot> slot definition class, Andy Wingo, 2015/01/23
- [Guile-commits] 68/88: `match' refactor in goops.scm, Andy Wingo, 2015/01/23
- [Guile-commits] 78/88: Inline helpers into slot-ref, slot-set!, etc, Andy Wingo, 2015/01/23
- [Guile-commits] 63/88: Commenting in goops.scm, Andy Wingo, 2015/01/23
- [Guile-commits] 82/88: Fix foreign objects for removal of getters-n-setters, Andy Wingo, 2015/01/23
- [Guile-commits] 81/88: Minor GOOPS cleanups, Andy Wingo, 2015/01/23
- [Guile-commits] 79/88: Inline internal slot accessors, Andy Wingo, 2015/01/23
- [Guile-commits] 74/88: The GOOPS "unbound" value is a unique pair, Andy Wingo, 2015/01/23
- [Guile-commits] 83/88: Update (oop goops save) for <slot> objects,
Andy Wingo <=
- [Guile-commits] 77/88: Use a vtable bit to mark <slot> instances, Andy Wingo, 2015/01/23
- [Guile-commits] 86/88: Simplify GOOPS effective method cache format, Andy Wingo, 2015/01/23
- [Guile-commits] 87/88: Export <slot> from GOOPS, Andy Wingo, 2015/01/23
- [Guile-commits] 80/88: Optimize %initialize-object, Andy Wingo, 2015/01/23
- [Guile-commits] 85/88: Fast generic function dispatch without calling `compile' at runtime, Andy Wingo, 2015/01/23
- [Guile-commits] 84/88: GOOPS cosmetics, Andy Wingo, 2015/01/23
- [Guile-commits] 76/88: Introduce <slot> objects in GOOPS, Andy Wingo, 2015/01/23
- [Guile-commits] 88/88: Simplify and optimize slot access, Andy Wingo, 2015/01/23