From 9b7e0cf0191b939c9347e5023aece4a9b9ddcd78 Mon Sep 17 00:00:00 2001 From: Doug Currie Date: Fri, 15 Jan 2016 23:04:51 -0500 Subject: [PATCH] Optimize records to use vector rather than a dict for field storage. --- contrib/20.r7rs/scheme/base.scm | 42 ++++++++++++++++++----------- extlib/benz/include/picrin/record.h | 8 +++--- extlib/benz/record.c | 30 ++++++++++----------- 3 files changed, 44 insertions(+), 36 deletions(-) diff --git a/contrib/20.r7rs/scheme/base.scm b/contrib/20.r7rs/scheme/base.scm index 736e489d..2ae88ce3 100644 --- a/contrib/20.r7rs/scheme/base.scm +++ b/contrib/20.r7rs/scheme/base.scm @@ -412,11 +412,13 @@ ;; 5.5 Recored-type definitions - (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))) - #,@(map (lambda (field) #`(record-set! #,record '#,field #,field)) fields) + (let ((#,record (make-record #,type #,(length field-alist)))) + #,@(map + (lambda (field) #`(record-set! #,record #,(cdr (assq field field-alist)) #,field)) + fields) #,record)))) (define-syntax (define-record-predicate type name) @@ -424,31 +426,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) - (record-ref record '#,field) + (record-ref 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) - (record-set! record '#,field val) + (record-set! record #,(cdr (assq field field-alist)) val) ;; '#,field (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 )) - (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 0)) + (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) diff --git a/extlib/benz/include/picrin/record.h b/extlib/benz/include/picrin/record.h index befc6407..0310d5c3 100644 --- a/extlib/benz/include/picrin/record.h +++ b/extlib/benz/include/picrin/record.h @@ -12,17 +12,17 @@ extern "C" { struct pic_record { PIC_OBJECT_HEADER struct pic_record *type; - struct pic_dict *data; + struct pic_vector *data; }; #define pic_record_p(v) (pic_type(v) == PIC_TT_RECORD) #define pic_record_ptr(v) ((struct pic_record *)pic_ptr(v)) -struct pic_record *pic_make_record(pic_state *, struct pic_record *); +struct pic_record *pic_make_record(pic_state *, struct pic_record *, int); struct pic_record *pic_record_type(pic_state *, struct pic_record *); -pic_value pic_record_ref(pic_state *, struct pic_record *, pic_sym *); -void pic_record_set(pic_state *, struct pic_record *, pic_sym *, pic_value); +pic_value pic_record_ref(pic_state *, struct pic_record *, int); +void pic_record_set(pic_state *, struct pic_record *, int, pic_value); #if defined(__cplusplus) } diff --git a/extlib/benz/record.c b/extlib/benz/record.c index 6f733a9f..44bb50bf 100644 --- a/extlib/benz/record.c +++ b/extlib/benz/record.c @@ -5,10 +5,10 @@ #include "picrin.h" struct pic_record * -pic_make_record(pic_state *pic, struct pic_record *type) +pic_make_record(pic_state *pic, struct pic_record *type, int len) { struct pic_record *rec; - struct pic_dict *data = pic_make_dict(pic); + struct pic_vector *data = pic_make_vec(pic, len); rec = (struct pic_record *)pic_obj_alloc(pic, sizeof(struct pic_record), PIC_TT_RECORD); rec->data = data; @@ -28,18 +28,15 @@ pic_record_type(pic_state PIC_UNUSED(*pic), struct pic_record *rec) } pic_value -pic_record_ref(pic_state *pic, struct pic_record *rec, pic_sym *slot) +pic_record_ref(pic_state PIC_UNUSED(*pic), struct pic_record *rec, int slot) { - if (! pic_dict_has(pic, rec->data, slot)) { - pic_errorf(pic, "slot named ~s is not found for record: ~s", pic_obj_value(slot), pic_obj_value(rec)); - } - return pic_dict_ref(pic, rec->data, slot); + return rec->data->data[slot]; } void -pic_record_set(pic_state *pic, struct pic_record *rec, pic_sym *slot, pic_value val) +pic_record_set(pic_state PIC_UNUSED(*pic), struct pic_record *rec, int slot, pic_value val) { - pic_dict_set(pic, rec->data, slot, val); + rec->data->data[slot] = val; } static pic_value @@ -47,12 +44,13 @@ pic_record_make_record(pic_state *pic) { struct pic_record * rec; pic_value rectype; + int len; - pic_get_args(pic, "o", &rectype); + pic_get_args(pic, "oi", &rectype, &len); pic_assert_type(pic, rectype, record); - rec = pic_make_record(pic, pic_record_ptr(rectype)); + rec = pic_make_record(pic, pic_record_ptr(rectype), len); return pic_obj_value(rec); } @@ -81,9 +79,9 @@ static pic_value pic_record_record_ref(pic_state *pic) { struct pic_record *rec; - pic_sym *slot; + int slot; - pic_get_args(pic, "rm", &rec, &slot); + pic_get_args(pic, "ri", &rec, &slot); return pic_record_ref(pic, rec, slot); } @@ -92,10 +90,10 @@ static pic_value pic_record_record_set(pic_state *pic) { struct pic_record *rec; - pic_sym *slot; + int slot; pic_value val; - pic_get_args(pic, "rmo", &rec, &slot, &val); + pic_get_args(pic, "rio", &rec, &slot, &val); pic_record_set(pic, rec, slot, val); @@ -110,5 +108,5 @@ pic_init_record(pic_state *pic) pic_defun(pic, "record-type", pic_record_record_type); pic_defun(pic, "record-ref", pic_record_record_ref); pic_defun(pic, "record-set!", pic_record_record_set); - pic_define(pic, "", pic_obj_value(pic_make_record(pic, NULL))); + pic_define(pic, "", pic_obj_value(pic_make_record(pic, NULL, 0))); }