On Tue, Aug 19, 2014 at 8:56 PM, John Cowan <cowan@mercury.ccil.org> wrote:
> Pierpaolo Bernardi scripsit:
>
>> (make-vector-from-pieces dim default init...)
>>
>> where each of the inits specifies a range to be filled in the new
>> vector, and an existing vector with a starting point, to be copied in
>> that range.  Ranges not included in any /init/ will be initialized
>> with /default/, as in make-vector.
>
> That's an interesting variant of vector-append.  I've added it to
> VectorsCowan, my proposed vector library (a superset of SRFI 43).
>
>> This function can be implemented trivially in any Scheme, and an
>> implementor can supply a version for his implementation which avoids
>> double assignments in the newly  created vector, and is also safe.
>
> Indeed.

And here's, attached below, a sample implementation written in racket,
and pseudocode for a possible implementation specific version.

> (define vect #(a b c d e f g h i j))

> (make-vector-from-pieces 16 'default
                           (range 0 5 vect 0)
                           (range 10 15 vect 5))

#(a b c d e default default default default default f g h i j default)

========
;; Tested only lightly. Do not trust this code.

#lang racket

(struct range
  (from to from-vector from-vector-start))

(define (make-vector-from-pieces dim default . inits)
  (define sorted-inits (sort inits range-<))
  (let ((vector (make-vector dim)))
    (let loop ((cur 0) (inits sorted-inits))
      (cond ((null? inits)
             (vector-fill vector cur dim default))
            (else
             (define init (first inits))
             (vector-fill vector cur (range-from init) default)
             (vector-block-copy vector init)
             (loop (range-to init) (rest inits)))))
    vector))

(define (range-< range1 range2)
  (< (range-from range1)
     (range-from range2)))

(define (vector-block-copy vector range)
  (define to (range-to range))
  (define from-vector (range-from-vector range))
  (let loop ((cur (range-from range))
             (i (range-from-vector-start range)))
    (when (< cur to)
      (vector-set! vector cur (vector-ref from-vector i))
      (loop (add1 cur) (add1 i)))))

(define (vector-fill vector from to value)
  (let loop ((from from))
    (when (< from to)
      (vector-set! vector from value)
      (loop (add1 from)))))

#|
;; implementation specific version
(define (make-vector-from-pieces dim default . inits)
  (define sorted-inits (sort inits range-<))
  (with-gc-off
   (lambda ()
     (let ((vector (make-uninitialized-vector dim)))
       (let loop ((cur 0) (inits sorted-inits))
         (cond ((null? inits)
                (vector-fill vector cur dim default))
               (else
                (define init (first inits))
                (vector-fill vector cur (range-from init) default)
                (vector-block-copy vector init)
                (loop (range-to init) (rest inits)))))
       vector))))
|#

_______________________________________________
Scheme-reports mailing list
Scheme-reports@scheme-reports.org
http://lists.scheme-reports.org/cgi-bin/mailman/listinfo/scheme-reports