diff options
Diffstat (limited to 'record.scm')
| -rw-r--r-- | record.scm | 27 |
1 files changed, 16 insertions, 11 deletions
@@ -1,6 +1,6 @@ ; "record.scm" record data types ; Written by David Carlton, carlton@husc.harvard.edu. -; Re-Written by Aubrey Jaffer, jaffer@ai.mit.edu, 1996, 1997 +; Re-Written by Aubrey Jaffer, agj @ alum.mit.edu, 1996, 1997 ; ; This code is in the public domain. @@ -22,14 +22,19 @@ (define vector->list vector->list) (define display display) (define write write) - +;@ (define record-modifier #f) (define record-accessor #f) (define record-constructor #f) (define record-predicate #f) (define make-record-type #f) -(let (;; Need to close these to keep magic-cookie hidden. +(let (;; protect CL functions against redefinition. + (has-duplicates? has-duplicates?) + (notevery notevery) + (position position) + + ;; Need to close these to keep magic-cookie hidden. (make-vect make-vector) (vect vector) @@ -89,8 +94,8 @@ (if (not (or (symbol? type-name) (string? type-name))) (slib:error 'make-record-type "non-string type-name argument." type-name)) - (if (or (and (list? field-names) (comlist:has-duplicates? field-names)) - (comlist:notevery symbol? field-names)) + (if (or (and (list? field-names) (has-duplicates? field-names)) + (notevery symbol? field-names)) (slib:error 'make-record-type "illegal field-names argument." field-names)) (let* ((augmented-length (+ 1 (length field-names))) @@ -136,15 +141,15 @@ (let ((rec-vfields (rtd-vfields rtd)) (corrected-rec-length (rtd-length rtd)) (field-names (car field-names))) - (if (or (and (list? field-names) (comlist:has-duplicates? field-names)) - (comlist:notevery (lambda (x) (memq x rec-vfields)) + (if (or (and (list? field-names) (has-duplicates? field-names)) + (notevery (lambda (x) (memq x rec-vfields)) field-names)) (slib:error 'record-constructor "invalid field-names argument." (cdr rec-vfields))) (let ((field-length (length field-names)) (offsets - (map (lambda (field) (comlist:position field rec-vfields)) + (map (lambda (field) (position field rec-vfields)) field-names))) (lambda elts (if (= (length elts) field-length) #t @@ -163,7 +168,7 @@ (lambda (rtd field-name) (if (not (rtd? rtd)) (slib:error 'record-accessor "invalid rtd argument." rtd)) - (let ((index (comlist:position field-name (rtd-vfields rtd))) + (let ((index (position field-name (rtd-vfields rtd))) (augmented-length (rtd-length rtd))) (if (not index) (slib:error 'record-accessor "invalid field-name argument." @@ -180,7 +185,7 @@ (lambda (rtd field-name) (if (not (rtd? rtd)) (slib:error 'record-modifier "invalid rtd argument." rtd)) - (let ((index (comlist:position field-name (rtd-vfields rtd))) + (let ((index (position field-name (rtd-vfields rtd))) (augmented-length (rtd-length rtd))) (if (not index) (slib:error 'record-modifier "invalid field-name argument." @@ -209,7 +214,7 @@ (cond ((rec? vct) (vec:error 'vector-set! nvt vct)) (else (vect-set! vct k obj))))) (set! vector-fill! - (lambda (vector fill) + (lambda (vct fill) (cond ((rec? vct) (vec:error 'vector-fill! nvt vct)) (else (vect-fill! vct fill))))) |