[Wisp-cvs] wisp/src/builtin lists.wisp,1.106,1.107 records.wisp,1.5,1.6

[<di...@us...>]

Update of /cvsroot/wisp/wisp/src/builtin
In directory usw-pr-cvs1:/tmp/cvs-serv29769/src/builtin

Modified Files:
	lists.wisp records.wisp 
Log Message:
Added the |length| dispatcher slot to record types.

Index: lists.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/lists.wisp,v
retrieving revision 1.106
retrieving revision 1.107
diff -u -d -r1.106 -r1.107
--- lists.wisp	7 Sep 2002 21:59:27 -0000	1.106
+++ lists.wisp	18 Sep 2002 21:05:08 -0000	1.107
@@ -125,15 +125,22 @@
 
 ; {{{ |length|
 (define (length x)
- (case x
-   (string? (string-length x))
-   (vector? (vector-length x))
-   (else
-     (my l 0
-       (while (cons? x)
-         (incr! l)
-         (cdr! x))
-       l))))
+  (case x
+    (null?   0)
+    (string? (string-length x))
+    (vector? (vector-length x))
+    (cons?   (my l 0
+               (while (cons? x)
+                 (incr! l)
+                 (cdr! x))
+               l))
+    (else
+      (my rt (type-of x)
+        (my measurer (and (record-type? rt)
+                          ((asm NN_pr_record_type_length_slot) rt))
+          (if measurer
+            (measurer x)
+            (raise 'measurable? x)))))))
 ; }}}
 
 ; {{{ |length?|

Index: records.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/records.wisp,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- records.wisp	4 Sep 2002 14:29:47 -0000	1.5
+++ records.wisp	18 Sep 2002 21:05:08 -0000	1.6
@@ -8,20 +8,24 @@
 
 (define (make-record-type slot-count . hooks)
   (my data ((asm NN_pr_make_record_type) slot-count)
-    (my record-type (car data)
-      (let ((ref-hook #f)
-            (ref-hook? #f))
-        (while (not (null? hooks))
-          (my (hook-name hook-generator . rest-hooks) hooks
-            (set! hooks rest-hooks)
-            (case hook-name
-              ((ref) (if ref-hook?
-                       (raise 'duplicate-ref-hook hook-generator)
-                       (begin
-                         (set! ref-hook? #t)
-                         (set! ref-hook (apply hook-generator data)))))
-              (else (raise 'record-hook-name? hook-name)))))
-        (if ref-hook?
-          (set! ((asm NN_pr_record_type_ref_slot) record-type)
-            ref-hook))))
+    (let ((record-type (car data))
+          (ref-hook #f)
+          (length-hook #f))
+      (while (not (null? hooks))
+        (my (hook-name hook-generator . rest-hooks) hooks
+          (set! hooks rest-hooks)
+          (case hook-name
+            ((ref)    (if ref-hook
+                        (raise 'duplicate-ref-hook hook-generator)
+                        (set! ref-hook (apply hook-generator data))))
+            ((length) (if length-hook
+                        (raise 'duplicate-length-hook hook-generator)
+                        (set! length-hook (apply hook-generator data))))
+            (else (raise 'record-hook-name? hook-name)))))
+      (if ref-hook
+        (set! ((asm NN_pr_record_type_ref_slot) record-type)
+          ref-hook))
+      (if length-hook
+        (set! ((asm NN_pr_record_type_length_slot) record-type)
+          length-hook)))
     data))