[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 55/61: Optimize %initialize-object
From: |
Andy Wingo |
Subject: |
[Guile-commits] 55/61: Optimize %initialize-object |
Date: |
Thu, 22 Jan 2015 18:53:21 +0000 |
wingo pushed a commit to branch wip-goops-refactor
in repository guile.
commit 9af07987c6bb7576afc17cef1b97db94566c1f73
Author: Andy Wingo <address@hidden>
Date: Mon Jan 19 13:06:44 2015 +0100
Optimize %initialize-object
* module/oop/goops.scm (%initialize-object): Optimize by inlining the
slot initialization, and by avoiding multiple checks for initargs
validity.
---
module/oop/goops.scm | 29 ++++++++++++++++++++++++-----
1 files changed, 24 insertions(+), 5 deletions(-)
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 142982c..6e4cd4b 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -2736,30 +2736,49 @@ function."
(define (%initialize-object obj initargs)
"Initialize the object @var{obj} with the given arguments
var{initargs}."
+ (define (valid-initargs? initargs)
+ (match initargs
+ (() #t)
+ (((? keyword?) _ . initargs) (valid-initargs? initargs))
+ (_ #f)))
(unless (instance? obj)
(scm-error 'wrong-type-arg #f "Not an object: ~S"
(list obj) #f))
- (unless (even? (length initargs))
- (scm-error 'wrong-type-arg #f "Initargs has odd length: ~S"
+ (unless (valid-initargs? initargs)
+ (scm-error 'wrong-type-arg #f "Invalid initargs: ~S"
(list initargs) #f))
(let ((class (class-of obj)))
(define (get-initarg kw)
(if kw
- (get-keyword kw initargs *unbound*)
+ ;; Inlined get-keyword to avoid checking initargs for validity
+ ;; each time.
+ (let lp ((initargs initargs))
+ (match initargs
+ ((kw* val . initargs)
+ (if (eq? kw* kw)
+ val
+ (lp initargs)))
+ (_ *unbound*)))
*unbound*))
(let lp ((slots (struct-ref class class-index-slots)))
(match slots
(() obj)
((slot . slots)
+ (define (initialize-slot! value)
+ (cond
+ ((%slot-definition-slot-set! slot)
+ => (lambda (slot-set!) (slot-set! obj value)))
+ (else
+ (struct-set! obj (%slot-definition-index slot) value))))
(let ((initarg (get-initarg (%slot-definition-init-keyword slot))))
(cond
((not (unbound? initarg))
- (slot-set! obj (%slot-definition-name slot) initarg))
+ (initialize-slot! initarg))
((%slot-definition-init-thunk slot)
=> (lambda (init-thunk)
(unless (memq (slot-definition-allocation slot)
'(#:class #:each-subclass))
- (slot-set! obj (%slot-definition-name slot)
(init-thunk)))))))
+ (initialize-slot! (init-thunk)))))))
(lp slots))))))
(define-method (initialize (object <object>) initargs)
- [Guile-commits] 40/61: when and unless for one-armed ifs in goops.scm, (continued)
- [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, 2015/01/22
- [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 <=
- [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
- [Guile-commits] 57/61: Fix foreign objects for removal of getters-n-setters, Andy Wingo, 2015/01/22
- [Guile-commits] 54/61: Inline internal slot accessors, Andy Wingo, 2015/01/22
- [Guile-commits] 61/61: Simplify GOOPS effective method cache format, Andy Wingo, 2015/01/22
- [Guile-commits] 59/61: GOOPS cosmetics, Andy Wingo, 2015/01/22
- [Guile-commits] 51/61: Introduce <slot> objects in GOOPS, Andy Wingo, 2015/01/22