diff options
Diffstat (limited to 'module/srfi')
-rw-r--r-- | module/srfi/srfi-1.scm | 4 | ||||
-rw-r--r-- | module/srfi/srfi-43.scm | 43 |
2 files changed, 15 insertions, 32 deletions
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm index 680ee94b5..57f9058b6 100644 --- a/module/srfi/srfi-1.scm +++ b/module/srfi/srfi-1.scm @@ -1,6 +1,6 @@ ;;; srfi-1.scm --- List Library -;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2009, 2010, 2011, 2014, 2020 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2009, 2010, 2011, 2014, 2020, 2021 Free Software Foundation, Inc. ;; ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -734,7 +734,7 @@ the list returned." (define (find-tail pred lst) "Return the first pair of @var{lst} whose @sc{car} satisfies the predicate @var{pred}, or return @code{#f} if no such element is found." - (check-arg procedure? pred find) + (check-arg procedure? pred find-tail) (let loop ((lst lst)) (and (not (null? lst)) (let ((head (car lst))) 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 |