Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-23 20:15:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Faster initialization of objects create via define-record-type

Browse source
This commit is contained in:
Justin Ethier 2019-02-27 14:31:14 -05:00
parent 0f0beb024c
commit 8772c5355b
2 changed files with 19 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
CHANGELOG.md
View file

@ -2,6 +2,10 @@
## 0.9.10 - TBD
Features
- Faster initialization of objects create via `define-record-type`.
## 0.9.9 - February 19, 2019
Bug Fixes

46
scheme/base.sld
View file

@ -23,6 +23,7 @@
register-simple-type
make-type-predicate
make-constructor
make-constructor/args
make-getter
make-setter
slot-ref
@ -1831,18 +1832,18 @@
(equal? (vector-ref obj 0) record-marker)
(equal? (vector-ref obj 1) name))))
(define (make-constructor make name)
(lambda ()
(lambda args
(let* ((field-tags (vector-ref name 2))
(field-values (make-vector (length field-tags) #f))
; (new (make-vector 3 #f))
)
; (vector-set! new 0 record-marker)
; (vector-set! new 1 name)
; (vector-set! new 2 field-values)
; new
(vector record-marker name field-values)
)
));
(vector record-marker name field-values))))
(define (make-constructor/args make name)
(lambda args
(let* ((field-tags (vector-ref name 2))
(field-values (list->vector args)))
(when (not (equal? (length field-tags) (length args)))
(error "invalid number of arguments passed to record type constructor" args))
(vector record-marker name field-values))))
(define (type-slot-offset name sym)
(let ((field-tags (vector-ref name 2)))
(_list-index sym field-tags)))
@ -1940,27 +1941,10 @@
fields)
;; constructor
(,_define ,make
,(let lp ((ls make-fields) (sets '()))
(cond
((null? ls)
`(,_let ((%make (,(rename 'make-constructor)
,(symbol->string make) ;(identifier->symbol make))
,name)))
(,_lambda ,make-fields
(,_let ((res (%make)))
,@sets
res))))
(else
(let ((field (assq (car ls) fields)))
(cond
((not field)
(error "unknown record field in constructor" (car ls)))
((pair? (cddr field))
(lp (cdr ls)
(cons `(,(car (cddr field)) res ,(car ls)) sets)))
(else
(lp (cdr ls)
(cons `(,_slot-set! ,name res (,_type_slot_offset ,name ',(car ls)) ,(car ls))
sets)))))))))
(,_let ((%make (,(rename 'make-constructor/args)
,(symbol->string make) ;(identifier->symbol make))
,name)))
(,_lambda ,make-fields
(%make ,@make-fields))))
)))))
))