diff options
Diffstat (limited to 'module/srfi/srfi-43.scm')
-rw-r--r-- | module/srfi/srfi-43.scm | 43 |
1 files changed, 13 insertions, 30 deletions
diff --git a/module/srfi/srfi-43.scm b/module/srfi/srfi-43.scm index eb6d8c317..18e97cf53 100644 --- a/module/srfi/srfi-43.scm +++ b/module/srfi/srfi-43.scm @@ -22,7 +22,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-8) #:re-export (make-vector vector vector? vector-ref vector-set! - vector-length vector-fill!) + vector-length vector-fill! vector-copy!) #:replace (vector-copy list->vector vector->list) #:export (vector-empty? vector= vector-unfold vector-unfold-right vector-reverse-copy @@ -35,7 +35,7 @@ vector-binary-search vector-any vector-every vector-swap! vector-reverse! - vector-copy! vector-reverse-copy! + vector-reverse-copy! reverse-vector->list reverse-list->vector)) @@ -204,7 +204,6 @@ error for the number of seeds to vary between iterations." (define guile-vector-copy (@ (guile) vector-copy)) -;; TODO: Enhance Guile core 'vector-copy' to do this. (define vector-copy (case-lambda* "(vector-copy vec [start [end [fill]]]) -> vector @@ -217,23 +216,20 @@ VEC, the slots in the new vector that obviously cannot be filled by elements from VEC are filled with FILL, whose default value is unspecified." ((v) (guile-vector-copy v)) - ((v start) - (assert-vector v 'vector-copy) - (let ((len (vector-length v))) - (assert-valid-start start len 'vector-copy) - (let ((result (make-vector (- len start)))) - (vector-move-left! v start len result 0) - result))) + ((v start) (guile-vector-copy v start)) ((v start end #:optional (fill *unspecified*)) (assert-vector v 'vector-copy) (let ((len (vector-length v))) - (unless (and (exact-integer? start) - (exact-integer? end) - (<= 0 start end)) - (error-from 'vector-copy "invalid index range" start end)) - (let ((result (make-vector (- end start) fill))) - (vector-move-left! v start (min end len) result 0) - result))))) + (if (<= end len) + (guile-vector-copy v start end) + (begin + (unless (and (exact-integer? start) + (exact-integer? end) + (<= 0 start end)) + (error-from 'vector-copy "invalid index range" start end)) + (let ((result (make-vector (- end start) fill))) + (vector-move-left! v start (min end len) result 0) + result))))))) (define vector-reverse-copy (let () @@ -937,19 +933,6 @@ START defaults to 0 and END defaults to the length of VEC." (error-from 'copy! "would write past end of target")) (%copy! target tstart source sstart send))))))) -(define-vector-copier! vector-copy! - "(vector-copy! target tstart source [sstart [send]]) -> unspecified - -Copy a block of elements from SOURCE to TARGET, both of which must be -vectors, starting in TARGET at TSTART and starting in SOURCE at -SSTART, ending when SEND - SSTART elements have been copied. It is an -error for TARGET to have a length less than TSTART + (SEND - SSTART). -SSTART defaults to 0 and SEND defaults to the length of SOURCE." - (lambda (target tstart source sstart send) - (if (< tstart sstart) - (vector-move-left! source sstart send target tstart) - (vector-move-right! source sstart send target tstart)))) - (define-vector-copier! vector-reverse-copy! "(vector-reverse-copy! target tstart source [sstart [send]]) -> unspecified |