[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 66/88: More GOOPS cleanups
From: |
Andy Wingo |
Subject: |
[Guile-commits] 66/88: More GOOPS cleanups |
Date: |
Fri, 23 Jan 2015 15:25:54 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit f5c34767938c39128baaa70db2c8006150d2f664
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] 56/88: GOOPS cleanup to use SRFI-1 better, (continued)
- [Guile-commits] 56/88: GOOPS cleanup to use SRFI-1 better, Andy Wingo, 2015/01/23
- [Guile-commits] 57/88: append-map rather than mapappend, Andy Wingo, 2015/01/23
- [Guile-commits] 58/88: GOOPS utils module cleanups, Andy Wingo, 2015/01/23
- [Guile-commits] 55/88: Cosmetic goops refactors., Andy Wingo, 2015/01/23
- [Guile-commits] 53/88: goops.c no longer knows about <class> slot allocation, Andy Wingo, 2015/01/23
- [Guile-commits] 61/88: scm_make cleanup, Andy Wingo, 2015/01/23
- [Guile-commits] 64/88: More GOOPS comments, Andy Wingo, 2015/01/23
- [Guile-commits] 59/88: Fold (oop goops util) into (oop goops), Andy Wingo, 2015/01/23
- [Guile-commits] 51/88: Reimplement %allocate-instance in Scheme, Andy Wingo, 2015/01/23
- [Guile-commits] 62/88: Narrative reordering in goops.scm, Andy Wingo, 2015/01/23
- [Guile-commits] 66/88: More GOOPS cleanups,
Andy Wingo <=
- [Guile-commits] 67/88: Convert emit-linear-dispatch to use match, Andy Wingo, 2015/01/23
- [Guile-commits] 60/88: Add compute-cpl tests, Andy Wingo, 2015/01/23
- [Guile-commits] 72/88: change-object-class refactor, Andy Wingo, 2015/01/23
- [Guile-commits] 69/88: GOOPS class slot indices defined as inline values, Andy Wingo, 2015/01/23
- [Guile-commits] 71/88: slot-ref, slot-set! et al bypass "using-class" variants, Andy Wingo, 2015/01/23
- [Guile-commits] 70/88: Manipulate GOOPS vtable flags from Scheme, for speed, Andy Wingo, 2015/01/23
- [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