Changeset 20664 in project


Ignore:
Timestamp:
10/06/10 09:41:53 (9 years ago)
Author:
felix winkelmann
Message:

srfi-63 0.3

Location:
release/4/srfi-63
Files:
9 added
5 moved

Legend:

Unmodified
Added
Removed
  • release/4/srfi-63/trunk/srfi-63.meta

    r20663 r20664  
    1 ((egg "srfi-63.egg")
    2  (files "srfi-63.scm"
     1;;;; srfi-63.meta -*- Scheme -*-
     2
     3((files "srfi-63.scm"
    34        "srfi-63.setup"
    4         "TODO"
    5         "tests/run.scm")
     5        "tests")
    66 (category data)
    77 (license "Artistic")
    88 (author "Aubrey Jaffer, ported to hygienic Chicken with test suite by Peter Danenberg")
    99 (synopsis "Homogeneous and heterogeneous arrays")
    10  (depends records setup-helper)
     10 (depends records)
    1111 (test-depends test))
  • release/4/srfi-63/trunk/srfi-63.scm

    r20663 r20664  
    2828srfi-63
    2929(array?
    30  equal?
    3130 array-rank
    3231 array-dimensions
     
    122121
    123122;;@body
    124 ;;Returns @code{#t} if @1 and @2 have the same rank and dimensions and the
    125 ;;corresponding elements of @1 and @2 are @code{equal?}.
    126 
    127 ;;@body
    128 ;;@0 recursively compares the contents of pairs, vectors, strings, and
    129 ;;@emph{arrays}, applying @code{eqv?} on other objects such as numbers
    130 ;;and symbols.  A rule of thumb is that objects are generally @0 if
    131 ;;they print the same.  @0 may fail to terminate if its arguments are
    132 ;;circular data structures.
    133 ;;
    134 ;;@example
    135 ;;(equal? 'a 'a)                             @result{}  #t
    136 ;;(equal? '(a) '(a))                         @result{}  #t
    137 ;;(equal? '(a (b) c)
    138 ;;        '(a (b) c))                        @result{}  #t
    139 ;;(equal? "abc" "abc")                       @result{}  #t
    140 ;;(equal? 2 2)                               @result{}  #t
    141 ;;(equal? (make-vector 5 'a)
    142 ;;        (make-vector 5 'a))                @result{}  #t
    143 ;;(equal? (make-array (A:fixN32b 4) 5 3)
    144 ;;        (make-array (A:fixN32b 4) 5 3))    @result{}  #t
    145 ;;(equal? (make-array '#(foo) 3 3)
    146 ;;        (make-array '#(foo) 3 3))          @result{}  #t
    147 ;;(equal? (lambda (x) x)
    148 ;;        (lambda (y) y))                    @result{}  @emph{unspecified}
    149 ;;@end example
    150 (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? (vector-length obj1) (vector-length obj2))
    160               (do ((idx (+ -1 (vector-length obj1)) (+ -1 idx)))
    161                   ((or (negative? idx)
    162                        (not (equal? (vector-ref obj1 idx)
    163                                     (vector-ref obj2 idx))))
    164                    (negative? idx)))))
    165         ((and (array? obj1) (array? obj2))
    166          (and (equal? (array:dimensions obj1) (array:dimensions obj2))
    167               (letrec ((rascan
    168                         (lambda (dims idxs)
    169                           (if (null? dims)
    170                               (equal? (apply array-ref obj1 idxs)
    171                                       (apply array-ref 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 ;;@body
    179123;;Returns the number of dimensions of @1.  If @1 is not an array, 0 is
    180124;;returned.
  • release/4/srfi-63/trunk/srfi-63.setup

    r20663 r20664  
    1 ;;; -*- Hen -*-
     1;;; -*- Scheme -*-
    22
    3 (include "setup-helper")
     3(compile -sSJi -O3 -d1 srfi-63.scm)
     4(compile -si -O3 -d0 srfi-63.import.scm)
    45
    5 (verify-extension-name "srfi-63")
    6 
    7 (setup-shared-extension-module
     6(install-extension
    87 'srfi-63
    9  (extension-version 0.2))
     8 '("srfi-63.so" "srfi-63.import.so")
     9 '((version 0.3)))
Note: See TracChangeset for help on using the changeset viewer.