Changeset 20664 in project
 Timestamp:
 10/06/10 09:41:53 (10 years ago)
 Location:
 release/4/srfi63
 Files:

 9 added
 5 moved
Legend:
 Unmodified
 Added
 Removed

release/4/srfi63/trunk/srfi63.meta
r20663 r20664 1 ((egg "srfi63.egg") 2 (files "srfi63.scm" 1 ;;;; srfi63.meta * Scheme * 2 3 ((files "srfi63.scm" 3 4 "srfi63.setup" 4 "TODO" 5 "tests/run.scm") 5 "tests") 6 6 (category data) 7 7 (license "Artistic") 8 8 (author "Aubrey Jaffer, ported to hygienic Chicken with test suite by Peter Danenberg") 9 9 (synopsis "Homogeneous and heterogeneous arrays") 10 (depends records setuphelper)10 (depends records) 11 11 (testdepends test)) 
release/4/srfi63/trunk/srfi63.scm
r20663 r20664 28 28 srfi63 29 29 (array? 30 equal?31 30 arrayrank 32 31 arraydimensions … … 122 121 123 122 ;;@body 124 ;;Returns @code{#t} if @1 and @2 have the same rank and dimensions and the125 ;;corresponding elements of @1 and @2 are @code{equal?}.126 127 ;;@body128 ;;@0 recursively compares the contents of pairs, vectors, strings, and129 ;;@emph{arrays}, applying @code{eqv?} on other objects such as numbers130 ;;and symbols. A rule of thumb is that objects are generally @0 if131 ;;they print the same. @0 may fail to terminate if its arguments are132 ;;circular data structures.133 ;;134 ;;@example135 ;;(equal? 'a 'a) @result{} #t136 ;;(equal? '(a) '(a)) @result{} #t137 ;;(equal? '(a (b) c)138 ;; '(a (b) c)) @result{} #t139 ;;(equal? "abc" "abc") @result{} #t140 ;;(equal? 2 2) @result{} #t141 ;;(equal? (makevector 5 'a)142 ;; (makevector 5 'a)) @result{} #t143 ;;(equal? (makearray (A:fixN32b 4) 5 3)144 ;; (makearray (A:fixN32b 4) 5 3)) @result{} #t145 ;;(equal? (makearray '#(foo) 3 3)146 ;; (makearray '#(foo) 3 3)) @result{} #t147 ;;(equal? (lambda (x) x)148 ;; (lambda (y) y)) @result{} @emph{unspecified}149 ;;@end example150 (define (equal? obj1 obj2)151 (cond ((eqv? obj1 obj2) #t)152 ((or (pair? obj1) (pair? obj2))153 (and (pair? obj1) (pair? obj2)154 (equal? (car obj1) (car obj2))155 (equal? (cdr obj1) (cdr obj2))))156 ((and (string? obj1) (string? obj2))157 (string=? obj1 obj2))158 ((and (vector? obj1) (vector? obj2))159 (and (equal? (vectorlength obj1) (vectorlength obj2))160 (do ((idx (+ 1 (vectorlength obj1)) (+ 1 idx)))161 ((or (negative? idx)162 (not (equal? (vectorref obj1 idx)163 (vectorref obj2 idx))))164 (negative? idx)))))165 ((and (array? obj1) (array? obj2))166 (and (equal? (array:dimensions obj1) (array:dimensions obj2))167 (letrec ((rascan168 (lambda (dims idxs)169 (if (null? dims)170 (equal? (apply arrayref obj1 idxs)171 (apply arrayref obj2 idxs))172 (do ((res #t (rascan (cdr dims) (cons idx idxs)))173 (idx (+ 1 (car dims)) (+ 1 idx)))174 ((or (not res) (negative? idx)) res))))))175 (rascan (reverse (array:dimensions obj1)) '()))))176 (else #f)))177 178 ;;@body179 123 ;;Returns the number of dimensions of @1. If @1 is not an array, 0 is 180 124 ;;returned. 
release/4/srfi63/trunk/srfi63.setup
r20663 r20664 1 ;;; * Hen*1 ;;; * Scheme * 2 2 3 (include "setuphelper") 3 (compile sSJi O3 d1 srfi63.scm) 4 (compile si O3 d0 srfi63.import.scm) 4 5 5 (verifyextensionname "srfi63") 6 7 (setupsharedextensionmodule 6 (installextension 8 7 'srfi63 9 (extensionversion 0.2)) 8 '("srfi63.so" "srfi63.import.so") 9 '((version 0.3)))
Note: See TracChangeset
for help on using the changeset viewer.