remove define-record-writer

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, "#<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;

piclib/picrin/array.scm

@@ -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?

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)
+  (define ((boot-make-record-type <meta-type>) name)
-    (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)
     (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
+  (export define-record-type))
-          define-record-writer))