[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 41/61: More GOOPS cleanups
From: |
Andy Wingo |
Subject: |
[Guile-commits] 41/61: More GOOPS cleanups |
Date: |
Thu, 22 Jan 2015 18:53:14 +0000 |
wingo pushed a commit to branch wip-goops-refactor
in repository guile.
commit c868fcbfdc0d5433b4fe856e9e73b4f4aba3b664
Author: Andy Wingo <address@hidden>
Date: Wed Jan 14 20:15:53 2015 +0100
More GOOPS cleanups
* module/oop/goops.scm (build-slots-list): Use `match'.
(make-standard-class): Formatting fixes.
---
module/oop/goops.scm | 54 ++++++++++++++++++++++++-------------------------
1 files changed, 26 insertions(+), 28 deletions(-)
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index d24229c..26a8ac9 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -393,31 +393,30 @@ subclasses of @var{c}."
'() '())))
(define (remove-duplicate-slots slots)
(let lp ((slots (reverse slots)) (res '()) (seen '()))
- (cond
- ((null? slots) res)
- ((memq (caar slots) seen)
- (lp (cdr slots) res seen))
- (else
- (lp (cdr slots) (cons (car slots) res) (cons (caar slots) seen))))))
+ (match slots
+ (() res)
+ (((and slot (name . options)) . slots)
+ (if (memq name seen)
+ (lp slots res seen)
+ (lp slots (cons slot res) (cons name seen)))))))
(let* ((class-slots (and (memq <class> cpl)
(struct-ref <class> class-index-slots))))
(when class-slots
(check-cpl dslots class-slots))
(let lp ((cpl (cdr cpl)) (res dslots) (class-slots '()))
- (if (null? cpl)
- (remove-duplicate-slots (append class-slots res))
- (let* ((head (car cpl))
- (cpl (cdr cpl))
- (new-slots (struct-ref head class-index-direct-slots)))
- (cond
- ((not class-slots)
- (lp cpl (append new-slots res) class-slots))
- ((eq? head <class>)
- ;; Move class slots to the head of the list.
- (lp cpl res new-slots))
- (else
- (check-cpl new-slots class-slots)
- (lp cpl (append new-slots res) class-slots))))))))
+ (match cpl
+ (() (remove-duplicate-slots (append class-slots res)))
+ ((head . cpl)
+ (let ((new-slots (struct-ref head class-index-direct-slots)))
+ (cond
+ ((not class-slots)
+ (lp cpl (append new-slots res) class-slots))
+ ((eq? head <class>)
+ ;; Move class slots to the head of the list.
+ (lp cpl res new-slots))
+ (else
+ (check-cpl new-slots class-slots)
+ (lp cpl (append new-slots res) class-slots)))))))))
(define (%compute-layout slots getters-n-setters nfields is-class?)
(define (instance-allocated? g-n-s)
@@ -516,12 +515,12 @@ subclasses of @var{c}."
(struct-set! z class-index-slots slots)
(struct-set! z class-index-getters-n-setters g-n-s)
(struct-set! z class-index-redefined #f)
- (for-each (lambda (super)
- (let ((subclasses
- (struct-ref super class-index-direct-subclasses)))
- (struct-set! super class-index-direct-subclasses
- (cons z subclasses))))
- dsupers)
+ (for-each
+ (lambda (super)
+ (let ((subclasses (struct-ref super class-index-direct-subclasses)))
+ (struct-set! super class-index-direct-subclasses
+ (cons z subclasses))))
+ dsupers)
(%prep-layout! z)
z)))
@@ -770,8 +769,7 @@ followed by its associated value. If @var{l} does not hold
a value for
(slot-set! z slot (get-keyword kw args default))))
'((#:name name ???)
(#:dsupers direct-supers ())
- (#:slots direct-slots ())
- )))
+ (#:slots direct-slots ()))))
(else
(error "boot `make' does not support this class" class)))
z))))
- [Guile-commits] 37/61: Narrative reordering in goops.scm, (continued)
- [Guile-commits] 37/61: Narrative reordering in goops.scm, Andy Wingo, 2015/01/22
- [Guile-commits] 36/61: scm_make cleanup, Andy Wingo, 2015/01/22
- [Guile-commits] 39/61: More GOOPS comments, Andy Wingo, 2015/01/22
- [Guile-commits] 42/61: Convert emit-linear-dispatch to use match, Andy Wingo, 2015/01/22
- [Guile-commits] 38/61: Commenting in goops.scm, Andy Wingo, 2015/01/22
- [Guile-commits] 43/61: `match' refactor in goops.scm, Andy Wingo, 2015/01/22
- [Guile-commits] 40/61: when and unless for one-armed ifs in goops.scm, Andy Wingo, 2015/01/22
- [Guile-commits] 44/61: GOOPS class slot indices defined as inline values, Andy Wingo, 2015/01/22
- [Guile-commits] 47/61: change-object-class refactor, Andy Wingo, 2015/01/22
- [Guile-commits] 45/61: Manipulate GOOPS vtable flags from Scheme, for speed, Andy Wingo, 2015/01/22
- [Guile-commits] 41/61: More GOOPS cleanups,
Andy Wingo <=
- [Guile-commits] 48/61: GOOPS: Deprecate "using-class" procs like slot-ref-using-class, Andy Wingo, 2015/01/22
- [Guile-commits] 46/61: slot-ref, slot-set! et al bypass "using-class" variants, Andy Wingo, 2015/01/22
- [Guile-commits] 50/61: Beginnings of <slot> slot definition class, Andy Wingo, 2015/01/22
- [Guile-commits] 52/61: Use a vtable bit to mark <slot> instances, Andy Wingo, 2015/01/22
- [Guile-commits] 56/61: Minor GOOPS cleanups, Andy Wingo, 2015/01/22
- [Guile-commits] 55/61: Optimize %initialize-object, Andy Wingo, 2015/01/22
- [Guile-commits] 49/61: The GOOPS "unbound" value is a unique pair, Andy Wingo, 2015/01/22
- [Guile-commits] 53/61: Inline helpers into slot-ref, slot-set!, etc, Andy Wingo, 2015/01/22
- [Guile-commits] 58/61: Update (oop goops save) for <slot> objects, Andy Wingo, 2015/01/22
- [Guile-commits] 60/61: Fast generic function dispatch without calling `compile' at runtime, Andy Wingo, 2015/01/22