From cd96014104974a711b2b0f15d23202edfb6cf219 Mon Sep 17 00:00:00 2001
From: Yuito Murase <yuito.murase@gmail.com>
Date: Mon, 4 Aug 2014 12:40:41 +0900
Subject: [PATCH] record-ref and record-set! don't check type

---
 include/picrin/record.h |  4 ++--
 piclib/scheme/base.scm  | 20 +++++++++++++-------
 src/record.c            | 24 ++++++++----------------
 3 files changed, 23 insertions(+), 25 deletions(-)

diff --git a/include/picrin/record.h b/include/picrin/record.h
index b15e5f31..32ca9223 100644
--- a/include/picrin/record.h
+++ b/include/picrin/record.h
@@ -21,8 +21,8 @@ struct pic_record {
 struct pic_record *pic_record_new(pic_state *, pic_value);
 
 bool pic_record_of(pic_state *, struct pic_record *, pic_value);
-pic_value pic_record_ref(pic_state *, struct pic_record *, pic_value, pic_sym);
-void pic_record_set(pic_state *, struct pic_record *, pic_value, pic_sym, pic_value);
+pic_value pic_record_ref(pic_state *, struct pic_record *, pic_sym);
+void pic_record_set(pic_state *, struct pic_record *, pic_sym, pic_value);
 
 #if defined(__cplusplus)
 }
diff --git a/piclib/scheme/base.scm b/piclib/scheme/base.scm
index f547b342..ae6416fe 100644
--- a/piclib/scheme/base.scm
+++ b/piclib/scheme/base.scm
@@ -743,7 +743,7 @@
 
   (define (make-record-type name)
     (let ((rectype (make-record #t)))
-      (record-set! rectype #t 'name name)
+      (record-set! rectype 'name name)
       rectype))
 
   (define-syntax define-record-constructor
@@ -755,7 +755,7 @@
 	 `(define (,name ,@fields)
 	    (let ((record (make-record ,rectype)))
 	      ,@(map (lambda (field)
-		       `(record-set! record ,rectype ',field ,field))
+		       `(record-set! record ',field ,field))
 		     fields)
 	      record))))))
 
@@ -770,18 +770,24 @@
   (define-syntax define-record-field
     (ir-macro-transformer
      (lambda (form inject compare?)
-       (let ((rectype (cadr form))
+       (let ((pred (cadr form))
 	     (field-name (caddr form))
 	     (accessor (cadddr form))
 	     (modifier? (cddddr form)))
 	 (if (null? modifier?)
 	     `(define (,accessor record)
-		(record-ref record ,rectype ',field-name))
+		(if (,pred record)
+		    (record-ref record ',field-name)
+		    (error "wrong record type")))
 	     `(begin
 		(define (,accessor record)
-		  (record-ref record ,rectype ',field-name))
+		  (if (,pred record)
+		      (record-ref record ',field-name)
+		      (error "wrong record type")))
 		(define (,(car modifier?) record val)
-		  (record-set! record ,rectype ',field-name val))))))))
+		  (if (,pred record)
+		      (record-set! record ',field-name val)
+		      (error "wrong record type")))))))))
 
   (define-syntax define-record-type
     (ir-macro-transformer
@@ -794,7 +800,7 @@
 	    (define ,name (make-record-type ',name))
 	    (define-record-constructor ,name ,@constructor)
 	    (define-record-predicate ,name ,pred)
-	    ,@(map (lambda (field) `(define-record-field ,name ,@field))
+	    ,@(map (lambda (field) `(define-record-field ,pred ,@field))
 		   fields))))))
 
   (export define-record-type)
diff --git a/src/record.c b/src/record.c
index d6d9cde1..572eb013 100644
--- a/src/record.c
+++ b/src/record.c
@@ -26,28 +26,22 @@ pic_record_of(pic_state *pic, struct pic_record *rec, pic_value rectype)
 }
 
 pic_value
-pic_record_ref(pic_state *pic, struct pic_record *rec, pic_value rectype, pic_sym slotname)
+pic_record_ref(pic_state *pic, struct pic_record *rec, pic_sym slotname)
 {
   xh_entry *e;
 
-  if (! pic_eq_p(rec->rectype, rectype)) {
-    pic_errorf(pic, "value is not record of ~s", rectype);
-  }
-
   e = xh_get_int(&rec->hash, slotname);
   if (! e) {
-    pic_errorf(pic, "slot named ~s is not found for record: ~s", pic_sym_value(slotname), rectype);
+    pic_errorf(pic, "slot named ~s is not found for record: ~s", pic_sym_value(slotname), rec);
   }
   return xh_val(e, pic_value);
 }
 
 
 void
-pic_record_set(pic_state *pic, struct pic_record *rec, pic_value rectype, pic_sym slotname, pic_value val)
+pic_record_set(pic_state *pic, struct pic_record *rec, pic_sym slotname, pic_value val)
 {
-  if (! pic_eq_p(rec->rectype, rectype)) {
-    pic_errorf(pic, "value is not record of ~s", rectype);
-  }
+  UNUSED(pic);
 
   xh_put_int(&rec->hash, slotname, &val);
 }
@@ -80,25 +74,23 @@ static pic_value
 pic_record_record_ref(pic_state *pic)
 {
   struct pic_record *rec;
-  pic_value rectype;
   pic_sym slotname;
 
-  pic_get_args(pic, "rom", &rec, &rectype, &slotname);
+  pic_get_args(pic, "rm", &rec, &slotname);
 
-  return pic_record_ref(pic, rec, rectype, slotname);
+  return pic_record_ref(pic, rec, slotname);
 }
 
 static pic_value
 pic_record_record_set(pic_state *pic)
 {
   struct pic_record *rec;
-  pic_value rectype;
   pic_sym slotname;
   pic_value val;
 
-  pic_get_args(pic, "romo", &rec, &rectype, &slotname, &val);
+  pic_get_args(pic, "rmo", &rec, &slotname, &val);
 
-  pic_record_set(pic, rec, rectype, slotname, val);
+  pic_record_set(pic, rec, slotname, val);
 
   return pic_none_value();
 }