Changeset 7340 in project

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:

• vector-lib.scm (modified) (10 diffs)
• vector-lib.setup (modified) (1 diff)

vector-lib/vector-lib.scm

@@ -1 +1 @@
 ;;; SRFI 43: Vector library
 ;;; Taylor Campbell's reference implementation ported to Chicken Scheme.
-;;; $Id: vector-lib.scm,v 1.8 2005/05/25 16:26:44 zb Exp zb $
-
-; ----------------------------TERMS OF USE--------------------------------
-; Copyright (c) 2005, Zbigniew Szadkowski.  All rights reserved.
+
+;; The reference implementation now includes all fixes that were formerly
+;; applied to this file.
+
+;; These changes were made for Chicken:
+;; Removed redundant offset checks in VECTOR-COPY and VECTOR-REVERSE-COPY
+;; Removed receive and let-optionals* macros (defined natively in Chicken)
+;; Converted let-vector-start+end from define-syntax to define-macro
+;; check-type uses native type checking
+;; Procedures pass symbol, not procedure object, as callee
+;; Clean up error display on Chicken
+
+; Copyright (c) 2005, 2006, 2007, 2008 Jim Ursetto.  All rights reserved.
 ;
 ; Redistribution and use in source and binary forms, with or without
@@ -29 +38 @@
 ; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 ; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-; ----------------------------TERMS OF USE--------------------------------
-
-;; The reference implementation of SRFI 43 on srfi.schemers.org is buggy
-;; (as of 24 May 2005).  This code is derived from Taylor Campbell's updated
-;; version of 4 Feb 2005, which can be found at
-;; http://srfi.schemers.org/srfi-43/post-mail-archive/msg00001.html
-
-;; Also included are the following fixes:
-;; vector-map fix from http://srfi.schemers.org/srfi-43/post-mail-archive/msg00008.html
-;; list->vector and reverse-list->vector obey START and disallow negative length
-;;  (note: START/END are not in the official doc, but are in Taylor's implementation)
-;; Fixed vector-unfold arity problem in list->vector
-;; Removed redundant offset checks in VECTOR-COPY and VECTOR-REVERSE-COPY
-
-;; and these changes made for Chicken:
-;; Removed receive and let-optionals* macros (defined natively in Chicken)
-;; Converted let-vector-start+end from define-syntax to define-macro
-;; check-type uses native type checking
-;; Procedures pass symbol, not procedure object, as callee
-;; Clean up error display on Chicken
 
 (declare
@@ -550 +539 @@
           vec)))))
 
-;++ Flush VECTOR-TABULATE: it's superseded by VECTOR-UNFOLD.
-
-;;; (VECTOR-TABULATE <f> <length>) -> vector
-;;;     (F <index>)
-;;;   Create a vector whose length is LENGTH.  Initialize it with the
-;;;   results of (f INDEX) for every INDEX in the resulting vector.
-;;;   The order of applications of F is unspecified.
-;++(define (vector-tabulate f len)
-;++  (check-type procedure? f vector-tabulate)
-;++  (check-type nonneg-int? len vector-tabulate)
-;++  (let ((new-vector (make-vector len)))
-;++    (do ((i 0 (+ i 1)))
-;++        ((= i len) new-vector)
-;++      (vector-set! new-vector i (f i)))))
-
 ;;; (VECTOR-COPY <vector> [<start> <end> <fill>]) -> vector
 ;;;   Create a newly allocated vector containing the elements from the
@@ -850 +824 @@
                                      (vector-length vec)
                                      vector-map)))
-          (%vector-map2+! f (make-vector len) (cons vec vectors) len)))))
+          (%vector-map2+! f (make-vector len) (cons vec vectors)
+                          len)))))
 
 ;;; (VECTOR-MAP! <f> <vector> ...) -> unspecified
@@ -1026 +1001 @@
       (let loop ((start start) (end end) (j #f))
         (let ((i (quotient (+ start end) 2)))
-          (if (and j (= i j))
+          (if (or (= start end) (and j (= i j)))
               #f
               (let ((comparison
@@ -1144 +1119 @@
 ;;; (VECTOR-COPY! <target> <tstart> <source> [<sstart> <send>])
 ;;;       -> unspecified
-;;;   Copy the values in the locations in [SSTART,SEND) from SOURCE to
+;;;   Copy the values in the locations in [SSTART,SEND) from SOURCE
 ;;;   to TARGET, starting at TSTART in TARGET.
-;; (Note: original code had a bunch of offset checks that could never
-;;  be triggered, as the offsets were already checked earlier.)
+;; (Note: removed start+end offset checks that can never be triggered,
+;;  as the checks are already done in let-vector-start+end.)
 (define (vector-copy! target tstart source . maybe-sstart+send)
   (let* ((target (check-type vector? target 'vector-copy!))
@@ -1156 +1131 @@
 
 ;;; (VECTOR-REVERSE-COPY! <target> <tstart> <source> [<sstart> <send>])
+;; (Note: removed start+end offset checks that can never be triggered,
+;;  as the checks are already done in let-vector-start+end.)
 (define (vector-reverse-copy! target tstart source . maybe-sstart+send)
   (let* ((target (check-type vector? target 'vector-reverse-copy!))
@@ -1241 +1218 @@
 ;;; great for circular lists.
 
-;; The implementor designed for no SRFI-1.
-(define (drop lis k)
-  (##sys#check-exact k 'drop)
-  (let iter ((lis lis) (k k))
-    (if (eq? 0 k) lis (iter (cdr lis) (fx- k 1)))))
-
 (define list->vector
   (let ((%list->vector list->vector))
@@ -1261 +1232 @@
                  (end (length lst)))      ; Ugh -- LENGTH
               (let ((start (check-type nonneg-int? start 'list->vector))
-                    (end   (check-type nonneg-int? end   'list->vector))
-                    (len   (fx- end start)))
-                (cond-expand [unsafe] [else
-                             (if (negative? len)
-                                 (##sys#error 'list->vector "length is negative" len))])
+                    (end   (check-type nonneg-int? end   'list->vector)))
                 ((lambda (f)
-                   (vector-unfold f len (drop lst start)))
+                   (vector-unfold f (- end start) (list-tail lst start)))
                  (lambda (index l)
                    (cond ((null? l)
@@ -1293 +1260 @@
        (end (length lst)))              ; Ugh -- LENGTH
     (let ((start (check-type nonneg-int? start 'reverse-list->vector))
-          (end   (check-type nonneg-int? end   'reverse-list->vector))
-          (len   (fx- end start)))
-      (cond-expand [unsafe] [else
-                   (if (negative? len)
-                       (##sys#error 'list->vector "length is negative" len))])
+          (end   (check-type nonneg-int? end   'reverse-list->vector)))
       ((lambda (f)
-         (vector-unfold-right f len (drop lst start)))
+         (vector-unfold-right f (- end start) (list-tail lst start)))
        (lambda (index l)
          (cond ((null? l)

vector-lib/vector-lib.setup

@@ -10 +10 @@
                 "vector-lib.html"
                 ,@(if has-exports? '("vector-lib.exports") '()) )
-        `((version 1.1)
+        `((version 1.2)
                 ,@(if has-exports? `((exports "vector-lib.exports")) '())
                 (documentation "vector-lib.html") ) )