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

don't use @@type property

This commit is contained in:
Yuichi Nishiwaki 2015-08-11 01:34:45 +09:00
parent c336e89e72
commit b96846dc6e
4 changed files with 19 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -412,18 +412,6 @@
;; 5.5 Recored-type definitions
(define ((boot-make-record-type <meta-type>) name)
(let ((rectype (make-record <meta-type>)))
(record-set! rectype 'name name)
rectype))
(define <record-type>
(let ((<record-type> ((boot-make-record-type #t) 'record-type)))
(record-set! <record-type> '@@type <record-type>)
<record-type>))
(define make-record-type (boot-make-record-type <record-type>))
(define-syntax (define-record-constructor type name . fields)
(let ((record #'record))
#`(define (#,name . #,fields)
@ -457,7 +445,7 @@
(define-syntax (define-record-type name ctor pred . fields)
#`(begin
(define #,name (make-record-type '#,name))
(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)))

1
extlib/benz/gc.c
View File

@ -389,6 +389,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
break;
}
case PIC_TT_RECORD: {
gc_mark_object(pic, (struct pic_object *)obj->u.rec.type);
LOOP(obj->u.rec.data);
break;
}

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

@ -11,15 +11,16 @@ extern "C" {
struct pic_record {
PIC_OBJECT_HEADER
struct pic_record *type;
struct pic_dict *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 *, pic_value);
struct pic_record *pic_make_record(pic_state *, struct pic_record *);
pic_value 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 *);
void pic_record_set(pic_state *, struct pic_record *, pic_sym *, pic_value);

24
extlib/benz/record.c
View File

@ -5,25 +5,26 @@
#include "picrin.h"
struct pic_record *
pic_make_record(pic_state *pic, pic_value rectype)
pic_make_record(pic_state *pic, struct pic_record *type)
{
struct pic_record *rec;
struct pic_dict *data;
data = pic_make_dict(pic);
struct pic_dict *data = pic_make_dict(pic);
rec = (struct pic_record *)pic_obj_alloc(pic, sizeof(struct pic_record), PIC_TT_RECORD);
rec->data = data;
rec->type = type;
pic_record_set(pic, rec, pic_intern(pic, "@@type"), rectype);
if (rec->type == NULL) {
rec->type = rec;
}
return rec;
}
pic_value
pic_record_type(pic_state *pic, struct pic_record *rec)
struct pic_record *
pic_record_type(pic_state PIC_UNUSED(*pic), struct pic_record *rec)
{
return pic_record_ref(pic, rec, pic_intern(pic, "@@type"));
return rec->type;
}
pic_value
@ -49,7 +50,9 @@ pic_record_make_record(pic_state *pic)
pic_get_args(pic, "o", &rectype);
rec = pic_make_record(pic, rectype);
pic_assert_type(pic, rectype, record);
rec = pic_make_record(pic, pic_record_ptr(rectype));
return pic_obj_value(rec);
}
@ -71,7 +74,7 @@ pic_record_record_type(pic_state *pic)
pic_get_args(pic, "r", &rec);
return pic_record_type(pic, rec);
return pic_obj_value(pic_record_type(pic, rec));
}
static pic_value
@ -107,4 +110,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)));
}