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 ;; 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) (define-syntax (define-record-constructor type name . fields)
(let ((record #'record)) (let ((record #'record))
#`(define (#,name . #,fields) #`(define (#,name . #,fields)
@ -457,7 +445,7 @@
(define-syntax (define-record-type name ctor pred . fields) (define-syntax (define-record-type name ctor pred . fields)
#`(begin #`(begin
(define #,name (make-record-type '#,name)) (define #,name (make-record <record-type>))
(define-record-constructor #,name #,@ctor) (define-record-constructor #,name #,@ctor)
(define-record-predicate #,name #,pred) (define-record-predicate #,name #,pred)
#,@(map (lambda (field) #`(define-record-field #,pred #,@field)) fields))) #,@(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; break;
} }
case PIC_TT_RECORD: { case PIC_TT_RECORD: {
gc_mark_object(pic, (struct pic_object *)obj->u.rec.type);
LOOP(obj->u.rec.data); LOOP(obj->u.rec.data);
break; break;
} }

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

@ -11,15 +11,16 @@ extern "C" {
struct pic_record { struct pic_record {
PIC_OBJECT_HEADER PIC_OBJECT_HEADER
struct pic_record *type;
struct pic_dict *data; struct pic_dict *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 *, 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 *); 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); 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" #include "picrin.h"
struct pic_record * 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_record *rec;
struct pic_dict *data; struct pic_dict *data = pic_make_dict(pic);
data = pic_make_dict(pic);
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;
rec->type = type;
pic_record_set(pic, rec, pic_intern(pic, "@@type"), rectype); if (rec->type == NULL) {
rec->type = rec;
}
return rec; return rec;
} }
pic_value struct pic_record *
pic_record_type(pic_state *pic, struct pic_record *rec) 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 pic_value
@ -49,7 +50,9 @@ pic_record_make_record(pic_state *pic)
pic_get_args(pic, "o", &rectype); 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); return pic_obj_value(rec);
} }
@ -71,7 +74,7 @@ pic_record_record_type(pic_state *pic)
pic_get_args(pic, "r", &rec); pic_get_args(pic, "r", &rec);
return pic_record_type(pic, rec); return pic_obj_value(pic_record_type(pic, rec));
} }
static pic_value 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-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)));
} }