From 54c0ded87643b04ffd4136c2519ec99e948ec090 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 19 Feb 2014 02:01:02 +0900
Subject: [PATCH] move (picrin record) to the head of file

---
 piclib/built-in.scm | 294 ++++++++++++++++++++++----------------------
 1 file changed, 147 insertions(+), 147 deletions(-)

diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index 809b7c1f..79c9f9a9 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -369,10 +369,153 @@
 
   (export parameterize))
 
+;;; Record Type
+(define-library (picrin record)
+  (import (scheme base)
+	  (scheme cxr)
+	  (picrin macro)
+          (picrin core-syntax))
+
+  (define record-marker (list 'record-marker))
+
+  (define real-vector? vector?)
+
+  (define (vector? x)
+    (and (real-vector? x)
+	 (or (= 0 (vector-length x))
+	     (not (eq? (vector-ref x 0)
+		       record-marker)))))
+
+  #|
+  ;; (scheme eval) is not provided for now
+  (define eval
+    (let ((real-eval eval))
+      (lambda (exp env)
+	((real-eval `(lambda (vector?) ,exp))
+	 vector?))))
+  |#
+
+  (define (record? x)
+    (and (real-vector? x)
+	 (< 0 (vector-length x))
+	 (eq? (vector-ref x 0) record-marker)))
+
+  (define (make-record size)
+    (let ((new (make-vector (+ size 1))))
+      (vector-set! new 0 record-marker)
+      new))
+
+  (define (record-ref record index)
+    (vector-ref record (+ index 1)))
+
+  (define (record-set! record index value)
+    (vector-set! record (+ index 1) value))
+
+  (define record-type% (make-record 3))
+  (record-set! record-type% 0 record-type%)
+  (record-set! record-type% 1 'record-type%)
+  (record-set! record-type% 2 '(name field-tags))
+
+  (define (make-record-type name field-tags)
+    (let ((new (make-record 3)))
+      (record-set! new 0 record-type%)
+      (record-set! new 1 name)
+      (record-set! new 2 field-tags)
+      new))
+
+  (define (record-type record)
+    (record-ref record 0))
+
+  (define (record-type-name record-type)
+    (record-ref record-type 1))
+
+  (define (record-type-field-tags record-type)
+    (record-ref record-type 2))
+
+  (define (field-index type tag)
+    (let rec ((i 1) (tags (record-type-field-tags type)))
+      (cond ((null? tags)
+	     (error "record type has no such field" type tag))
+	    ((eq? tag (car tags)) i)
+	    (else (rec (+ i 1) (cdr tags))))))
+
+  (define (record-constructor type tags)
+    (let ((size (length (record-type-field-tags type)))
+	  (arg-count (length tags))
+	  (indexes (map (lambda (tag) (field-index type tag)) tags)))
+      (lambda args
+	(if (= (length args) arg-count)
+	    (let ((new (make-record (+ size 1))))
+	      (record-set! new 0 type)
+	      (for-each (lambda (arg i) (record-set! new i arg)) args indexes)
+	      new)
+	    (error "wrong number of arguments to constructor" type args)))))
+
+  (define (record-predicate type)
+    (lambda (thing)
+      (and (record? thing)
+	   (eq? (record-type thing)
+		type))))
+
+  (define (record-accessor type tag)
+    (let ((index (field-index type tag)))
+      (lambda (thing)
+	(if (and (record? thing)
+		 (eq? (record-type thing)
+		      type))
+	    (record-ref thing index)
+	    (error "accessor applied to bad value" type tag thing)))))
+
+  (define (record-modifier type tag)
+    (let ((index (field-index type tag)))
+      (lambda (thing value)
+	(if (and (record? thing)
+		 (eq? (record-type thing)
+		      type))
+	    (record-set! thing index value)
+	    (error "modifier applied to bad value" type tag thing)))))
+
+  (define-syntax define-record-field
+    (ir-macro-transformer
+     (lambda (form inject compare?)
+       (let ((type (cadr form))
+	     (field-tag (caddr form))
+	     (acc-mod (cdddr form)))
+	 (if (= 1 (length acc-mod))
+	     `(define ,(car acc-mod)
+		(record-accessor ,type ',field-tag))
+	     `(begin
+		(define ,(car acc-mod)
+		  (record-accessor ,type ',field-tag))
+		(define ,(cadr acc-mod)
+		  (record-modifier ,type ',field-tag))))))))
+
+  (define-syntax define-record-type
+    (ir-macro-transformer
+     (lambda (form inject compare?)
+       (let ((type (cadr form))
+	     (constructor (caddr form))
+	     (predicate (cadddr form))
+	     (field-tag (cddddr form)))
+	 `(begin
+	    (define ,type
+	      (make-record-type ',type ',(cdr constructor)))
+	    (define ,(car constructor)
+	      (record-constructor ,type ',(cdr constructor)))
+	    (define ,predicate
+	      (record-predicate ,type))
+	    ,@(map
+	       (lambda (x)
+		 `(define-record-field ,type ,(car x) ,(cadr x) ,@(cddr x)))
+	       field-tag))))))
+
+  (export define-record-type vector?))
+
 (import (picrin macro)
         (picrin core-syntax)
         (picrin multiple-value)
-        (picrin parameter))
+        (picrin parameter)
+        (picrin record))
 
 (export let let* letrec letrec*
         quasiquote unquote unquote-splicing
@@ -388,6 +531,9 @@
 (export make-parameter
         parameterize)
 
+(export vector?                         ; override definition
+        define-record-type)
+
 (define (every pred list)
   (if (null? list)
       #t
@@ -746,149 +892,3 @@
         (write obj port)))))
 
   (export display))
-
-;;; Record Type
-(define-library (picrin record)
-  (import (scheme base)
-	  (scheme cxr)
-	  (picrin macro))
-
-  (define record-marker (list 'record-marker))
-
-  (define real-vector? vector?)
-
-  (define (vector? x)
-    (and (real-vector? x)
-	 (or (= 0 (vector-length x))
-	     (not (eq? (vector-ref x 0)
-		       record-marker)))))
-
-  #|
-  ;; (scheme eval) is not provided for now
-  (define eval
-    (let ((real-eval eval))
-      (lambda (exp env)
-	((real-eval `(lambda (vector?) ,exp))
-	 vector?))))
-  |#
-
-  (define (record? x)
-    (and (real-vector? x)
-	 (< 0 (vector-length x))
-	 (eq? (vector-ref x 0) record-marker)))
-
-  (define (make-record size)
-    (let ((new (make-vector (+ size 1))))
-      (vector-set! new 0 record-marker)
-      new))
-
-  (define (record-ref record index)
-    (vector-ref record (+ index 1)))
-
-  (define (record-set! record index value)
-    (vector-set! record (+ index 1) value))
-
-  (define record-type% (make-record 3))
-  (record-set! record-type% 0 record-type%)
-  (record-set! record-type% 1 'record-type%)
-  (record-set! record-type% 2 '(name field-tags))
-
-  (define (make-record-type name field-tags)
-    (let ((new (make-record 3)))
-      (record-set! new 0 record-type%)
-      (record-set! new 1 name)
-      (record-set! new 2 field-tags)
-      new))
-
-  (define (record-type record)
-    (record-ref record 0))
-
-  (define (record-type-name record-type)
-    (record-ref record-type 1))
-
-  (define (record-type-field-tags record-type)
-    (record-ref record-type 2))
-
-  (define (field-index type tag)
-    (let rec ((i 1) (tags (record-type-field-tags type)))
-      (cond ((null? tags)
-	     (error "record type has no such field" type tag))
-	    ((eq? tag (car tags)) i)
-	    (else (rec (+ i 1) (cdr tags))))))
-
-  (define (record-constructor type tags)
-    (let ((size (length (record-type-field-tags type)))
-	  (arg-count (length tags))
-	  (indexes (map (lambda (tag) (field-index type tag)) tags)))
-      (lambda args
-	(if (= (length args) arg-count)
-	    (let ((new (make-record (+ size 1))))
-	      (record-set! new 0 type)
-	      (for-each (lambda (arg i) (record-set! new i arg)) args indexes)
-	      new)
-	    (error "wrong number of arguments to constructor" type args)))))
-
-  (define (record-predicate type)
-    (lambda (thing)
-      (and (record? thing)
-	   (eq? (record-type thing)
-		type))))
-
-  (define (record-accessor type tag)
-    (let ((index (field-index type tag)))
-      (lambda (thing)
-	(if (and (record? thing)
-		 (eq? (record-type thing)
-		      type))
-	    (record-ref thing index)
-	    (error "accessor applied to bad value" type tag thing)))))
-
-  (define (record-modifier type tag)
-    (let ((index (field-index type tag)))
-      (lambda (thing value)
-	(if (and (record? thing)
-		 (eq? (record-type thing)
-		      type))
-	    (record-set! thing index value)
-	    (error "modifier applied to bad value" type tag thing)))))
-
-  (define-syntax define-record-field
-    (ir-macro-transformer
-     (lambda (form inject compare?)
-       (let ((type (cadr form))
-	     (field-tag (caddr form))
-	     (acc-mod (cdddr form)))
-	 (if (= 1 (length acc-mod))
-	     `(define ,(car acc-mod)
-		(record-accessor ,type ',field-tag))
-	     `(begin
-		(define ,(car acc-mod)
-		  (record-accessor ,type ',field-tag))
-		(define ,(cadr acc-mod)
-		  (record-modifier ,type ',field-tag))))))))
-
-  (define-syntax define-record-type
-    (ir-macro-transformer
-     (lambda (form inject compare?)
-       (let ((type (cadr form))
-	     (constructor (caddr form))
-	     (predicate (cadddr form))
-	     (field-tag (cddddr form)))
-	 `(begin
-	    (define ,type
-	      (make-record-type ',type ',(cdr constructor)))
-	    (define ,(car constructor)
-	      (record-constructor ,type ',(cdr constructor)))
-	    (define ,predicate
-	      (record-predicate ,type))
-	    ,@(map
-	       (lambda (x)
-		 `(define-record-field ,type ,(car x) ,(cadr x) ,@(cddr x)))
-	       field-tag))))))
-
-  (export define-record-type vector?))
-
-(import (picrin record))
-
-(export vector?                         ; override definition
-        define-record-type)