diff --git a/extlib/benz/write.c b/extlib/benz/write.c index 73ee11f5..4c9d7333 100644 --- a/extlib/benz/write.c +++ b/extlib/benz/write.c @@ -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, "#", 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; diff --git a/piclib/picrin/array.scm b/piclib/picrin/array.scm index 5ae0c107..6412d136 100644 --- a/piclib/picrin/array.scm +++ b/piclib/picrin/array.scm @@ -93,19 +93,6 @@ (define (array-for-each proc ary) (for-each proc (array->list ary))) - (define-record-writer ( 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? diff --git a/piclib/picrin/record.scm b/piclib/picrin/record.scm index 7559cbbe..fccc1bd4 100644 --- a/piclib/picrin/record.scm +++ b/piclib/picrin/record.scm @@ -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 ) name ctor) + (define ((boot-make-record-type ) name) (let ((rectype (make-record ))) (record-set! rectype 'name name) - (record-set! rectype 'writer (default-record-writer ctor)) rectype)) (define (let (( - ((boot-make-record-type #t) 'record-type '(record-type name writer)))) + ((boot-make-record-type #t) 'record-type))) (record-set! '@@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))