Changeset 7340 in project


Ignore:
Timestamp:
01/12/08 20:45:59 (12 years ago)
Author:
Jim Ursetto
Message:

vector-lib: minor tweaks to align with ref impl

Location:
vector-lib
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • vector-lib/vector-lib.scm

    r404 r7340  
    11;;; SRFI 43: Vector library
    22;;; Taylor Campbell's reference implementation ported to Chicken Scheme.
    3 ;;; $Id: vector-lib.scm,v 1.8 2005/05/25 16:26:44 zb Exp zb $
    4 
    5 ; ----------------------------TERMS OF USE--------------------------------
    6 ; Copyright (c) 2005, Zbigniew Szadkowski.  All rights reserved.
     3
     4;; The reference implementation now includes all fixes that were formerly
     5;; applied to this file.
     6
     7;; These changes were made for Chicken:
     8;; Removed redundant offset checks in VECTOR-COPY and VECTOR-REVERSE-COPY
     9;; Removed receive and let-optionals* macros (defined natively in Chicken)
     10;; Converted let-vector-start+end from define-syntax to define-macro
     11;; check-type uses native type checking
     12;; Procedures pass symbol, not procedure object, as callee
     13;; Clean up error display on Chicken
     14
     15; Copyright (c) 2005, 2006, 2007, 2008 Jim Ursetto.  All rights reserved.
    716;
    817; Redistribution and use in source and binary forms, with or without
     
    2938; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
    3039; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
    31 ; ----------------------------TERMS OF USE--------------------------------
    32 
    33 ;; The reference implementation of SRFI 43 on srfi.schemers.org is buggy
    34 ;; (as of 24 May 2005).  This code is derived from Taylor Campbell's updated
    35 ;; version of 4 Feb 2005, which can be found at
    36 ;; http://srfi.schemers.org/srfi-43/post-mail-archive/msg00001.html
    37 
    38 ;; Also included are the following fixes:
    39 ;; vector-map fix from http://srfi.schemers.org/srfi-43/post-mail-archive/msg00008.html
    40 ;; list->vector and reverse-list->vector obey START and disallow negative length
    41 ;;  (note: START/END are not in the official doc, but are in Taylor's implementation)
    42 ;; Fixed vector-unfold arity problem in list->vector
    43 ;; Removed redundant offset checks in VECTOR-COPY and VECTOR-REVERSE-COPY
    44 
    45 ;; and these changes made for Chicken:
    46 ;; Removed receive and let-optionals* macros (defined natively in Chicken)
    47 ;; Converted let-vector-start+end from define-syntax to define-macro
    48 ;; check-type uses native type checking
    49 ;; Procedures pass symbol, not procedure object, as callee
    50 ;; Clean up error display on Chicken
    5140
    5241(declare
     
    550539          vec)))))
    551540
    552 ;++ Flush VECTOR-TABULATE: it's superseded by VECTOR-UNFOLD.
    553 
    554 ;;; (VECTOR-TABULATE <f> <length>) -> vector
    555 ;;;     (F <index>)
    556 ;;;   Create a vector whose length is LENGTH.  Initialize it with the
    557 ;;;   results of (f INDEX) for every INDEX in the resulting vector.
    558 ;;;   The order of applications of F is unspecified.
    559 ;++(define (vector-tabulate f len)
    560 ;++  (check-type procedure? f vector-tabulate)
    561 ;++  (check-type nonneg-int? len vector-tabulate)
    562 ;++  (let ((new-vector (make-vector len)))
    563 ;++    (do ((i 0 (+ i 1)))
    564 ;++        ((= i len) new-vector)
    565 ;++      (vector-set! new-vector i (f i)))))
    566 
    567541;;; (VECTOR-COPY <vector> [<start> <end> <fill>]) -> vector
    568542;;;   Create a newly allocated vector containing the elements from the
     
    850824                                     (vector-length vec)
    851825                                     vector-map)))
    852           (%vector-map2+! f (make-vector len) (cons vec vectors) len)))))
     826          (%vector-map2+! f (make-vector len) (cons vec vectors)
     827                          len)))))
    853828
    854829;;; (VECTOR-MAP! <f> <vector> ...) -> unspecified
     
    10261001      (let loop ((start start) (end end) (j #f))
    10271002        (let ((i (quotient (+ start end) 2)))
    1028           (if (and j (= i j))
     1003          (if (or (= start end) (and j (= i j)))
    10291004              #f
    10301005              (let ((comparison
     
    11441119;;; (VECTOR-COPY! <target> <tstart> <source> [<sstart> <send>])
    11451120;;;       -> unspecified
    1146 ;;;   Copy the values in the locations in [SSTART,SEND) from SOURCE to
     1121;;;   Copy the values in the locations in [SSTART,SEND) from SOURCE
    11471122;;;   to TARGET, starting at TSTART in TARGET.
    1148 ;; (Note: original code had a bunch of offset checks that could never
    1149 ;;  be triggered, as the offsets were already checked earlier.)
     1123;; (Note: removed start+end offset checks that can never be triggered,
     1124;;  as the checks are already done in let-vector-start+end.)
    11501125(define (vector-copy! target tstart source . maybe-sstart+send)
    11511126  (let* ((target (check-type vector? target 'vector-copy!))
     
    11561131
    11571132;;; (VECTOR-REVERSE-COPY! <target> <tstart> <source> [<sstart> <send>])
     1133;; (Note: removed start+end offset checks that can never be triggered,
     1134;;  as the checks are already done in let-vector-start+end.)
    11581135(define (vector-reverse-copy! target tstart source . maybe-sstart+send)
    11591136  (let* ((target (check-type vector? target 'vector-reverse-copy!))
     
    12411218;;; great for circular lists.
    12421219
    1243 ;; The implementor designed for no SRFI-1.
    1244 (define (drop lis k)
    1245   (##sys#check-exact k 'drop)
    1246   (let iter ((lis lis) (k k))
    1247     (if (eq? 0 k) lis (iter (cdr lis) (fx- k 1)))))
    1248 
    12491220(define list->vector
    12501221  (let ((%list->vector list->vector))
     
    12611232                 (end (length lst)))      ; Ugh -- LENGTH
    12621233              (let ((start (check-type nonneg-int? start 'list->vector))
    1263                     (end   (check-type nonneg-int? end   'list->vector))
    1264                     (len   (fx- end start)))
    1265                 (cond-expand [unsafe] [else
    1266                              (if (negative? len)
    1267                                  (##sys#error 'list->vector "length is negative" len))])
     1234                    (end   (check-type nonneg-int? end   'list->vector)))
    12681235                ((lambda (f)
    1269                    (vector-unfold f len (drop lst start)))
     1236                   (vector-unfold f (- end start) (list-tail lst start)))
    12701237                 (lambda (index l)
    12711238                   (cond ((null? l)
     
    12931260       (end (length lst)))              ; Ugh -- LENGTH
    12941261    (let ((start (check-type nonneg-int? start 'reverse-list->vector))
    1295           (end   (check-type nonneg-int? end   'reverse-list->vector))
    1296           (len   (fx- end start)))
    1297       (cond-expand [unsafe] [else
    1298                    (if (negative? len)
    1299                        (##sys#error 'list->vector "length is negative" len))])
     1262          (end   (check-type nonneg-int? end   'reverse-list->vector)))
    13001263      ((lambda (f)
    1301          (vector-unfold-right f len (drop lst start)))
     1264         (vector-unfold-right f (- end start) (list-tail lst start)))
    13021265       (lambda (index l)
    13031266         (cond ((null? l)
  • vector-lib/vector-lib.setup

    r1881 r7340  
    1010                "vector-lib.html"
    1111                ,@(if has-exports? '("vector-lib.exports") '()) )
    12         `((version 1.1)
     12        `((version 1.2)
    1313                ,@(if has-exports? `((exports "vector-lib.exports")) '())
    1414                (documentation "vector-lib.html") ) )
Note: See TracChangeset for help on using the changeset viewer.