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))
|
