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) (export define-syntax)
;; 5.5 Recored-type definitions ;; 5.5 Record-type definitions
(define (make-record-type name) (define (make-record-type name)
(vector name)) ; TODO (vector name)) ; TODO
(define-syntax (define-record-constructor type name . fields) (define-syntax (define-record-constructor type field-alist name . fields)
(let ((record #'record)) (let ((record #'record))
#`(define (#,name . #,fields) #`(define (#,name . #,fields)
(let ((#,record (make-record #,type (make-dictionary)))) (let ((#,record (make-record #,type (make-vector #,(length field-alist)))))
#,@(map (lambda (field) #`(dictionary-set! (record-datum #,record) '#,field #,field)) fields) #,@(map
(lambda (field)
#`(vector-set! (record-datum #,record) #,(cdr (assq field field-alist)) #,field))
fields)
#,record)))) #,record))))
(define-syntax (define-record-predicate type name) (define-syntax (define-record-predicate type name)
@ -427,31 +430,39 @@
(and (record? obj) (and (record? obj)
(eq? (record-type obj) #,type)))) (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) #`(define (#,accessor record)
(if (#,pred 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)))) (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) #`(define (#,modifier record val)
(if (#,pred record) (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)))) (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) (if (null? modifier-opt)
#`(define-record-accessor #,pred #,field #,accessor) #`(define-record-accessor #,pred #,field-alist #,field #,accessor)
#`(begin #`(begin
(define-record-accessor #,pred #,field #,accessor) (define-record-accessor #,pred #,field-alist #,field #,accessor)
(define-record-modifier #,pred #,field #,(car modifier-opt))))) (define-record-modifier #,pred #,field-alist #,field #,(car modifier-opt)))))
(define-syntax (define-record-type name ctor pred . fields) (define-syntax (define-record-type name ctor pred . fields)
#`(begin (let ((field-alist (let lp ((fds fields) (idx 0) (alst '()))
(define #,name (make-record-type '#,name)) (if (null? fds)
(define-record-constructor #,name #,@ctor) alst
(define-record-predicate #,name #,pred) (lp (cdr fds)
#,@(map (lambda (field) #`(define-record-field #,pred #,@field)) fields))) (+ 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) (export define-record-type)