diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:28 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:28 -0800 |
commit | 87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (patch) | |
tree | 1eb4f87abd38bea56e08335d939e8171d5e7bfc7 /record.scm | |
parent | bd9733926076885e3417b74de76e4c9c7bc56254 (diff) | |
download | slib-87b82b5822ca54228cfa6df29be3ad9d4bc47d16.tar.gz slib-87b82b5822ca54228cfa6df29be3ad9d4bc47d16.zip |
Import Upstream version 2d2upstream/2d2
Diffstat (limited to 'record.scm')
-rw-r--r-- | record.scm | 59 |
1 files changed, 30 insertions, 29 deletions
@@ -10,6 +10,9 @@ ; prevents forgery and corruption (modification without using ; RECORD-MODIFIER) of records. +;;2001-07-24 Aubrey Jaffer <agj@alum.mit.edu> +;; changed identifiers containing VECTOR to VECT or VCT. + (require 'common-list-functions) (define vector? vector?) @@ -27,8 +30,8 @@ (define make-record-type #f) (let (;; Need to close these to keep magic-cookie hidden. - (make-vector make-vector) - (vector vector) + (make-vect make-vector) + (vect vector) ;; We have to wrap these to keep magic-cookie hidden. (vect? vector?) @@ -66,7 +69,7 @@ ;; Internal accessor functions. No error checking. (rtd-tag (lambda (x) (vect-ref x 0))) - (rtd-name (lambda (rtd) (if (vector? rtd) (vect-ref rtd 1) "rtd"))) + (rtd-name (lambda (rtd) (if (vect? rtd) (vect-ref rtd 1) "rtd"))) (rtd-fields (lambda (rtd) (vect-ref rtd 3))) ;; rtd-vfields is padded out to the length of the vector, which is 1 ;; more than the number of fields @@ -91,13 +94,13 @@ (slib:error 'make-record-type "illegal field-names argument." field-names)) (let* ((augmented-length (+ 1 (length field-names))) - (rtd (vector magic-cookie - type-name - '() - field-names - augmented-length - #f - #f))) + (rtd (vect magic-cookie + type-name + '() + field-names + augmented-length + #f + #f))) (vect-set! rtd 5 (lambda (x) (and (vect? x) @@ -129,7 +132,7 @@ (slib:error 'record-constructor (rtd-name rtd) "wrong number of arguments.")) - (apply vector rtd elts))) + (apply vect rtd elts))) (let ((rec-vfields (rtd-vfields rtd)) (corrected-rec-length (rtd-length rtd)) (field-names (car field-names))) @@ -148,7 +151,7 @@ (slib:error 'record-constructor (rtd-name rtd) "wrong number of arguments.")) - (let ((result (make-vector corrected-rec-length))) + (let ((result (make-vect corrected-rec-length))) (vect-set! result 0 rtd) (for-each (lambda (offset elt) (vect-set! result offset elt)) @@ -190,28 +193,26 @@ (slib:error 'record-modifier "wrong record type." x "not" rtd)) (vect-set! x index y))))) ) - - (set! vector? (lambda (obj) (and (not (rec? obj)) (vect? obj)))) + (set! vector? (lambda (obj) (and (vect? obj) (not (rec? obj))))) (set! vector-ref - (lambda (vector k) - (cond ((rec? vector) - (vec:error 'vector-ref nvt vector)) - (else (vect-ref vector k))))) + (lambda (vct k) + (cond ((rec? vct) + (vec:error 'vector-ref nvt vct)) + (else (vect-ref vct k))))) (set! vector->list - (lambda (vector) - (cond ((rec? vector) - (vec:error 'vector->list nvt vector)) - (else (vect->list vector))))) + (lambda (vct) + (cond ((rec? vct) + (vec:error 'vector->list nvt vct)) + (else (vect->list vct))))) (set! vector-set! - (lambda (vector k obj) - (cond ((rec? vector) - (vec:error 'vector-set! nvt vector)) - (else (vect-set! vector k obj))))) + (lambda (vct k obj) + (cond ((rec? vct) (vec:error 'vector-set! nvt vct)) + (else (vect-set! vct k obj))))) (set! vector-fill! (lambda (vector fill) - (cond ((rec? vector) - (vec:error 'vector-fill! nvt vector)) - (else (vect-fill! vector fill))))) + (cond ((rec? vct) + (vec:error 'vector-fill! nvt vct)) + (else (vect-fill! vct fill))))) (set! display (lambda (obj . opt) (apply disp (if (rec? obj) (rec-disp-str obj) obj) opt))) |