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 ;; 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)) (let ((record #'record))
#`(define (#,name . #,fields) #`(define (#,name . #,fields)
(let ((#,record (make-record #,type))) (let ((#,record (make-record #,type #,(length field-alist))))
#,@(map (lambda (field) #`(record-set! #,record '#,field #,field)) fields) #,@(map
(lambda (field) #`(record-set! #,record #,(cdr (assq field field-alist)) #,field))
fields)
#,record)))) #,record))))
(define-syntax (define-record-predicate type name) (define-syntax (define-record-predicate type name)
@ -424,31 +426,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)
(record-ref record '#,field) (record-ref 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)
(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)))) (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 <record-type>)) (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 <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) (export define-record-type)

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

@ -12,17 +12,17 @@ extern "C" {
struct pic_record { struct pic_record {
PIC_OBJECT_HEADER PIC_OBJECT_HEADER
struct pic_record *type; 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_p(v) (pic_type(v) == PIC_TT_RECORD)
#define pic_record_ptr(v) ((struct pic_record *)pic_ptr(v)) #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 *); struct pic_record *pic_record_type(pic_state *, struct pic_record *);
pic_value pic_record_ref(pic_state *, struct pic_record *, pic_sym *); pic_value pic_record_ref(pic_state *, struct pic_record *, int);
void pic_record_set(pic_state *, struct pic_record *, pic_sym *, pic_value); void pic_record_set(pic_state *, struct pic_record *, int, pic_value);
#if defined(__cplusplus) #if defined(__cplusplus)
} }

30
extlib/benz/record.c
View File

@ -5,10 +5,10 @@
#include "picrin.h" #include "picrin.h"
struct pic_record * 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_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 = (struct pic_record *)pic_obj_alloc(pic, sizeof(struct pic_record), PIC_TT_RECORD);
rec->data = data; rec->data = data;
@ -28,18 +28,15 @@ pic_record_type(pic_state PIC_UNUSED(*pic), struct pic_record *rec)
} }
pic_value 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)) { return rec->data->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);
} }
void 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 static pic_value
@ -47,12 +44,13 @@ pic_record_make_record(pic_state *pic)
{ {
struct pic_record * rec; struct pic_record * rec;
pic_value rectype; pic_value rectype;
int len;
pic_get_args(pic, "o", &rectype); pic_get_args(pic, "oi", &rectype, &len);
pic_assert_type(pic, rectype, record); 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); return pic_obj_value(rec);
} }
@ -81,9 +79,9 @@ static pic_value
pic_record_record_ref(pic_state *pic) pic_record_record_ref(pic_state *pic)
{ {
struct pic_record *rec; 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); return pic_record_ref(pic, rec, slot);
} }
@ -92,10 +90,10 @@ static pic_value
pic_record_record_set(pic_state *pic) pic_record_record_set(pic_state *pic)
{ {
struct pic_record *rec; struct pic_record *rec;
pic_sym *slot; int slot;
pic_value val; 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); 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-type", pic_record_record_type);
pic_defun(pic, "record-ref", pic_record_record_ref); pic_defun(pic, "record-ref", pic_record_record_ref);
pic_defun(pic, "record-set!", pic_record_record_set); 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)));
} }