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

Optimize records to use vector rather than a dict for field storage.

This commit is contained in:
Doug Currie 2016-01-15 23:04:51 -05:00
parent 7019f81aaf
commit 9b7e0cf019
3 changed files with 44 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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 <record-type>))
(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 <record-type> 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)

8
extlib/benz/include/picrin/record.h
View File

@ -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)
}

30
extlib/benz/record.c
View File

@ -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, "<record-type>", pic_obj_value(pic_make_record(pic, NULL)));
pic_define(pic, "<record-type>", pic_obj_value(pic_make_record(pic, NULL, 0)));
}