conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge pull request #324 from dcurrie/record-vector-optimization 

Optimize records to use vector rather than a dict for field storage.
This commit is contained in:
Yuichi Nishiwaki 2016-02-09 08:49:02 +09:00
parent 3bc55b8b62 f213119dd6
commit f91678aa82
1 changed files with 28 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
contrib/20.r7rs/scheme/base.scm
View File

@ -410,16 +410,19 @@
(export define-syntax)
;; 5.5 Recored-type definitions
;; 5.5 Record-type definitions
(define (make-record-type name)
(vector name)) ; TODO
(define-syntax (define-record-constructor type name . fields)
(define-syntax (define-record-constructor type field-alist name . fields)
(let ((record #'record))
#`(define (#,name . #,fields)
(let ((#,record (make-record #,type (make-dictionary))))
#,@(map (lambda (field) #`(dictionary-set! (record-datum #,record) '#,field #,field)) fields)
(let ((#,record (make-record #,type (make-vector #,(length field-alist)))))
#,@(map
(lambda (field)
#`(vector-set! (record-datum #,record) #,(cdr (assq field field-alist)) #,field))
fields)
#,record))))
(define-syntax (define-record-predicate type name)
@ -427,31 +430,39 @@
(and (record? obj)
(eq? (record-type obj) #,type))))
(define-syntax (define-record-accessor pred field accessor)
(define-syntax (define-record-accessor pred field-alist field accessor)
#`(define (#,accessor record)
(if (#,pred record)
(cdr (dictionary-ref (record-datum record) '#,field))
(vector-ref (record-datum record) #,(cdr (assq field field-alist)))
(error (string-append (symbol->string '#,accessor) ": wrong record type") record))))
(define-syntax (define-record-modifier pred field modifier)
(define-syntax (define-record-modifier pred field-alist field modifier)
#`(define (#,modifier record val)
(if (#,pred record)
(dictionary-set! (record-datum record) '#,field val)
(vector-set! (record-datum record) #,(cdr (assq field field-alist)) val)
(error (string-append (symbol->string '#,modifier) ": wrong record type") record))))
(define-syntax (define-record-field pred field accessor . modifier-opt)
(define-syntax (define-record-field pred field-alist field accessor . modifier-opt)
(if (null? modifier-opt)
#`(define-record-accessor #,pred #,field #,accessor)
#`(define-record-accessor #,pred #,field-alist #,field #,accessor)
#`(begin
(define-record-accessor #,pred #,field #,accessor)
(define-record-modifier #,pred #,field #,(car modifier-opt)))))
(define-record-accessor #,pred #,field-alist #,field #,accessor)
(define-record-modifier #,pred #,field-alist #,field #,(car modifier-opt)))))
(define-syntax (define-record-type name ctor pred . fields)
#`(begin
(define #,name (make-record-type '#,name))
(define-record-constructor #,name #,@ctor)
(define-record-predicate #,name #,pred)
#,@(map (lambda (field) #`(define-record-field #,pred #,@field)) fields)))
(let ((field-alist (let lp ((fds fields) (idx 0) (alst '()))
(if (null? fds)
alst
(lp (cdr fds)
(+ idx 1)
(cons
(cons (if (pair? (car fds)) (car (car fds)) (car fds)) idx)
alst))))))
#`(begin
(define #,name (make-record-type '#,name))
(define-record-constructor #,name #,field-alist #,@ctor)
(define-record-predicate #,name #,pred)
#,@(map (lambda (field) #`(define-record-field #,pred #,field-alist #,@field)) fields))))
(export define-record-type)