guile-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: srfi-9 record type checking


From: Kevin Ryde
Subject: Re: srfi-9 record type checking
Date: Wed, 02 Aug 2006 10:42:07 +1000
User-agent: Gnus/5.110006 (No Gnus v0.6) Emacs/21.4 (gnu/linux)

address@hidden (Ludovic Courtès) writes:
>
> Neil Jerram <address@hidden> writes:
>>
>> So on balance I don't think we need to provide complete compatibility
>> within Guile here.
>
> Right, I think you convinced me.  :-)

In absense of violent objections I made the change below.  I didn't do
the same in the 1.6 branch, there I only amended the srfi-9
implementation.

Is the local-eval stuff supposed to minimize the amount of environment
or whatever captured by the returned functions?  Guessing that's so I
put the type check in a helper function.


--- boot-9.scm.~1.356.2.1.~     2006-05-09 10:34:24.000000000 +1000
+++ boot-9.scm  2006-08-02 08:40:13.000000000 +1000
@@ -429,13 +429,20 @@
 (define (record-predicate rtd)
   (lambda (obj) (and (struct? obj) (eq? rtd (struct-vtable obj)))))
 
+(define (%record-type-check rtd obj)  ;; private helper
+  (or (eq? rtd (record-type-descriptor obj))
+      (scm-error 'wrong-type-arg "%record-type-check"
+                "Wrong type record (want `~S'): ~S"
+                (list (record-type-name rtd) obj)
+                #f)))
+
 (define (record-accessor rtd field-name)
   (let* ((pos (list-index (record-type-fields rtd) field-name)))
     (if (not pos)
        (error 'no-such-field field-name))
     (local-eval `(lambda (obj)
-                  (and (eq? ',rtd (record-type-descriptor obj))
-                       (struct-ref obj ,pos)))
+                  (%record-type-check ',rtd obj)
+                  (struct-ref obj ,pos))
                the-root-environment)))
 
 (define (record-modifier rtd field-name)
@@ -443,8 +450,8 @@
     (if (not pos)
        (error 'no-such-field field-name))
     (local-eval `(lambda (obj val)
-                  (and (eq? ',rtd (record-type-descriptor obj))
-                       (struct-set! obj ,pos val)))
+                  (%record-type-check ',rtd obj)
+                  (struct-set! obj ,pos val))
                the-root-environment)))
 
 

reply via email to

[Prev in Thread] Current Thread [Next in Thread]