diff options
author | Jim Pick <jim@jimpick.com> | 1998-03-08 23:05:22 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:27 -0800 |
commit | b21cac3362022718634f7086964208b2eed8e897 (patch) | |
tree | 16f4b2e70645c0e8e2202023170b5a94baa967e3 /record.scm | |
parent | 3796d2595035e192ed4bf1c9a6bfdb13c3c9d261 (diff) | |
parent | f24b9140d6f74804d5599ec225717d38ca443813 (diff) | |
download | slib-b21cac3362022718634f7086964208b2eed8e897.tar.gz slib-b21cac3362022718634f7086964208b2eed8e897.zip |
Import Debian changes 2c0-3debian/2c0-3
slib (2c0-3) unstable; urgency=low
* New maintainer.
* slibconfig script to automatically configure guile.
* Fix type in description, closes: Bug#18996
slib (2c0-2) unstable; urgency=low
* Minor fix for debian/rules targets
slib (2c0-1) unstable; urgency=low
* New upstream source
* New maintainer
Diffstat (limited to 'record.scm')
-rw-r--r-- | record.scm | 27 |
1 files changed, 22 insertions, 5 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 +; Re-Written by Aubrey Jaffer, jaffer@ai.mit.edu, 1996, 1997 ; ; This code is in the public domain. @@ -17,6 +17,8 @@ (define vector-set! vector-set!) (define vector-fill! vector-fill!) (define vector->list vector->list) +(define display display) +(define write write) (define record-modifier #f) (define record-accessor #f) @@ -32,6 +34,8 @@ (vect? vector?) (vect-ref vector-ref) (vect->list vector->list) + (disp display) + (wri write) ;; Need to wrap these to protect record data from being corrupted. (vect-set! vector-set!) @@ -71,10 +75,15 @@ (rtd-length (lambda (rtd) (vect-ref rtd 4))) (rec-rtd (lambda (x) (vect-ref x 0))) + (rec-disp-str + (lambda (x) + (let ((name (rtd-name (rec-rtd x)))) + (string-append + "#<" (if (symbol? name) (symbol->string name) name) ">")))) (make-rec-type (lambda (type-name field-names) - (if (not (string? type-name)) + (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)) @@ -182,17 +191,17 @@ (vect-set! x index y))))) ) - (set! vector? (lambda (obj) (and (not (rec? obj)) (vector? obj)))) + (set! vector? (lambda (obj) (and (not (rec? obj)) (vect? obj)))) (set! vector-ref (lambda (vector k) (cond ((rec? vector) (vec:error 'vector-ref nvt vector)) (else (vect-ref vector k))))) (set! vector->list - (lambda (vector k) + (lambda (vector) (cond ((rec? vector) (vec:error 'vector->list nvt vector)) - (else (vect->list vector k))))) + (else (vect->list vector))))) (set! vector-set! (lambda (vector k obj) (cond ((rec? vector) @@ -203,6 +212,14 @@ (cond ((rec? vector) (vec:error 'vector-fill! nvt vector)) (else (vect-fill! vector fill))))) + (set! display + (lambda (obj . opt) + (apply disp (if (rec? obj) (rec-disp-str obj) obj) opt))) + (set! write + (lambda (obj . opt) + (if (rec? obj) + (apply disp (rec-disp-str obj) opt) + (apply wri obj opt)))) (set! record-modifier rec-modifier) (set! record-accessor rec-accessor) (set! record-constructor rec-constructor) |