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

remove define-record-writer

This commit is contained in:
Yuichi Nishiwaki 2015-06-15 02:22:55 +09:00
parent 9ace96dd19
commit 015971ffc4
3 changed files with 4 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
extlib/benz/write.c
View File

@ -162,35 +162,6 @@ write_str(pic_state *pic, struct pic_string *str, xFILE *file)
}
}
static void
write_record(pic_state *pic, struct pic_record *rec, xFILE *file)
{
pic_sym *sWRITER = pic_intern_cstr(pic, "writer");
pic_value type, writer, str;
#if DEBUG
xfprintf(file, "#<record %p>", rec);
#else
type = pic_record_type(pic, rec);
if (! pic_record_p(type)) {
pic_errorf(pic, "\"@@type\" property of record object is not of record type");
}
writer = pic_record_ref(pic, pic_record_ptr(type), sWRITER);
if (! pic_proc_p(writer)) {
pic_errorf(pic, "\"writer\" property of record type object is not a procedure");
}
str = pic_apply1(pic, pic_proc_ptr(writer), pic_obj_value(rec));
if (! pic_str_p(str)) {
pic_errorf(pic, "return value from writer procedure is not of string type");
}
xfprintf(file, "%s", pic_str_cstr(pic, pic_str_ptr(str)));
#endif
}
static void
write_core(struct writer_control *p, pic_value obj)
{
@ -331,9 +302,6 @@ write_core(struct writer_control *p, pic_value obj)
}
xfprintf(file, ")");
break;
case PIC_TT_RECORD:
write_record(pic, pic_record_ptr(obj), file);
break;
default:
xfprintf(file, "#<%s %p>", pic_type_repr(pic_type(obj)), pic_ptr(obj));
break;

13
piclib/picrin/array.scm
View File

@ -93,19 +93,6 @@
(define (array-for-each proc ary)
(for-each proc (array->list ary)))
(define-record-writer (<array> array)
(let ((port (open-output-string)))
(display "#.(array" port)
(array-for-each
(lambda (obj)
(display " " port)
(write obj port))
array)
(display ")" port)
(let ((str (get-output-string port)))
(close-port port)
str)))
(export make-array
array
array?

38
piclib/picrin/record.scm
View File

@ -2,45 +2,16 @@
(import (picrin base)
(picrin macro))
;; define-record-writer
(define (set-record-writer! record-type writer)
(record-set! record-type 'writer writer))
(define-syntax define-record-writer
(er-macro-transformer
(lambda (form r compare)
(let ((formal (cadr form)))
(if (pair? formal)
`(,(r 'set-record-writer!) ,(car formal)
(,(r 'lambda) (,(cadr formal))
,@(cddr form)))
`(,(r 'set-record-writer!) ,formal
,@(cddr form)))))))
;; define-record-type
(define ((default-record-writer ctor) obj)
(let ((port (open-output-string)))
(display "#.(" port)
(display (car ctor) port)
(for-each
(lambda (field)
(display " " port)
(write (record-ref obj field) port))
(cdr ctor))
(display ")" port)
(get-output-string port)))
(define ((boot-make-record-type <meta-type>) name ctor)
(define ((boot-make-record-type <meta-type>) name)
(let ((rectype (make-record <meta-type>)))
(record-set! rectype 'name name)
(record-set! rectype 'writer (default-record-writer ctor))
rectype))
(define <record-type>
(let ((<record-type>
((boot-make-record-type #t) 'record-type '(record-type name writer))))
((boot-make-record-type #t) 'record-type)))
(record-set! <record-type> '@@type <record-type>)
<record-type>))
@ -99,11 +70,10 @@
(pred (car (cdr (cdr (cdr form)))))
(fields (cdr (cdr (cdr (cdr form))))))
`(begin
(define ,name (make-record-type ',name ',ctor))
(define ,name (make-record-type ',name))
(define-record-constructor ,name ,@ctor)
(define-record-predicate ,name ,pred)
,@(map (lambda (field) `(define-record-field ,pred ,@field))
fields))))))
(export define-record-type
define-record-writer))
(export define-record-type))