1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

Extend core vector-fill! to handle a range

With this patch, these two lines

  (vector-fill! vec fill)
  (vector-fill! vec fill 0 end)

run at the same speed; before, the second one was much slower.

This patch also makes it an error to call vector-fill! with a non-vector
array. The previous implementation did not work correctly in this case.

* libguile/vectors.c (SCM_VALIDATE_MUTABLE_VECTOR): Better error message.
  (vector-fill!): Handle optional arguments start, end. Do not attempt
    to handle non-vector arrays. Rename the C binding to
    scm_vector_fill_partial_x.
  (scm_vector_fill_x): Reuse scm_vector_fill_partial_x.
* module/srfi/srfi-43.scm (vector-fill!): Remove & re-export the core
  version instead.
This commit is contained in:
Daniel Llorens 2019-12-18 14:31:39 +01:00
parent 6b0491233f
commit ddad8ae05a
3 changed files with 57 additions and 45 deletions

View file

@ -22,8 +22,8 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-8)
#:re-export (make-vector vector vector? vector-ref vector-set!
vector-length)
#:replace (vector-copy vector-fill! list->vector vector->list)
vector-length vector-fill!)
#:replace (vector-copy list->vector vector->list)
#:export (vector-empty? vector= vector-unfold vector-unfold-right
vector-reverse-copy
vector-append vector-concatenate
@ -872,34 +872,6 @@ Swap the values of the locations in VEC at I and J."
(vector-set! vec i (vector-ref vec j))
(vector-set! vec j tmp))))
;; TODO: Enhance Guile core 'vector-fill!' to do this.
(define vector-fill!
(let ()
(define guile-vector-fill!
(@ (guile) vector-fill!))
(define (%vector-fill! vec fill start end)
(let loop ((i start))
(when (< i end)
(vector-set! vec i fill)
(loop (+ i 1)))))
(case-lambda
"(vector-fill! vec fill [start [end]]) -> unspecified
Assign the value of every location in VEC between START and END to
FILL. START defaults to 0 and END defaults to the length of VEC."
((vec fill)
(guile-vector-fill! vec fill))
((vec fill start)
(assert-vector vec 'vector-fill!)
(let ((len (vector-length vec)))
(assert-valid-start start len 'vector-fill!)
(%vector-fill! vec fill start len)))
((vec fill start end)
(assert-vector vec 'vector-fill!)
(let ((len (vector-length vec)))
(assert-valid-range start end len 'vector-fill!)
(%vector-fill! vec fill start end))))))
(define (%vector-reverse! vec start end)
(let loop ((i start) (j (- end 1)))
(when (< i j)