From 75138db4db98a545c71c95cf64e3224583a12652 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Thu, 7 Aug 2014 11:47:23 +0900
Subject: [PATCH 1/2] add define-record-writer

---
 piclib/CMakeLists.txt    |  1 +
 piclib/picrin/record.scm | 17 +++++++++++++++++
 2 files changed, 18 insertions(+)
 create mode 100644 piclib/picrin/record.scm

diff --git a/piclib/CMakeLists.txt b/piclib/CMakeLists.txt
index 87dd693f..43d5ab4a 100644
--- a/piclib/CMakeLists.txt
+++ b/piclib/CMakeLists.txt
@@ -6,6 +6,7 @@ list(APPEND PICLIB_SCHEME_LIBS
 
   ${PROJECT_SOURCE_DIR}/piclib/scheme/base.scm
 
+  ${PROJECT_SOURCE_DIR}/piclib/picrin/record.scm
   ${PROJECT_SOURCE_DIR}/piclib/picrin/array.scm
   ${PROJECT_SOURCE_DIR}/piclib/picrin/dictionary.scm
   ${PROJECT_SOURCE_DIR}/piclib/picrin/test.scm
diff --git a/piclib/picrin/record.scm b/piclib/picrin/record.scm
new file mode 100644
index 00000000..818913e8
--- /dev/null
+++ b/piclib/picrin/record.scm
@@ -0,0 +1,17 @@
+(define-library (picrin record)
+  (import (scheme base))
+
+  (define (define-record-writer* record-type writer)
+    (record-set! record-type 'writer writer))
+
+  (define-syntax define-record-writer
+    (syntax-rules ()
+      ((_ (type obj) body ...)
+       (define-record-writer* type
+         (lambda (obj)
+           body ...)))
+      ((_ type writer)
+       (define-record-writer* type
+         writer))))
+
+  (export define-record-writer))

From fff22f253ffc2fa911865a4bf608432695b6279c Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Thu, 7 Aug 2014 11:52:00 +0900
Subject: [PATCH 2/2] use define-record-writer to set custom writer to <array>
 type

---
 piclib/picrin/array.scm | 22 ++++++++++------------
 1 file changed, 10 insertions(+), 12 deletions(-)

diff --git a/piclib/picrin/array.scm b/piclib/picrin/array.scm
index d8a2d45a..f7e1dc60 100644
--- a/piclib/picrin/array.scm
+++ b/piclib/picrin/array.scm
@@ -89,19 +89,17 @@
   (define (array-for-each proc ary)
     (for-each proc (array->list ary)))
 
-  (define (print-array array)
+  (define-record-writer (<array> array)
     (call-with-port (open-output-string)
-      (lambda (port)
-        (display "#.(array" port)
-        (array-for-each
-         (lambda (obj)
-           (display " " port)
-           (write obj port))
-         array)
-        (display ")" port)
-        (get-output-string port))))
-
-  (record-set! <array> 'writer print-array)
+     (lambda (port)
+       (display "#.(array" port)
+       (array-for-each
+        (lambda (obj)
+          (display " " port)
+          (write obj port))
+        array)
+       (display ")" port)
+       (get-output-string port))))
 
   (export make-array
           array