edward

 1;; Copyright (c) 2020-2021 Adam Nelson.
 2;;
 3;; Permission is hereby granted, free of charge, to any person obtaining a copy
 4;; of this software and associated documentation files (the "Software"), to
 5;; deal in the Software without restriction, including without limitation the
 6;; rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
 7;; sell copies of the Software, and to permit persons to whom the Software is
 8;; furnished to do so, subject to the following conditions:
 9;;
10;; The above copyright notice and this permission notice (including the next
11;; paragraph) shall be included in all copies or substantial portions of the
12;; Software.
13;;
14;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
17;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20;; IN THE SOFTWARE.
21
22(define-record-type Flexvector
23  (%make-flexvector fv-vector fv-length)
24  flexvector?
25  (fv-vector vec set-vec!)
26  (fv-length flexvector-length set-flexvector-length!))
27
28(define (grow! fv)
29  (define old-vec (vec fv))
30  (define
31    new-vec
32    (vector-resize old-vec (quotient (* (vector-length old-vec) 3) 2)))
33  (set-vec! fv new-vec)
34  new-vec)
35
36(define (flexvector)
37  (%make-flexvector (make-vector 4) 0))
38
39(define (flexvector-ref fv index)
40  (vector-ref (vec fv) index))
41
42(define (flexvector-add-all! fv i xs)
43  (let* ((len (flexvector-length fv))
44         (xv (list->vector xs))
45         (xvlen (vector-length xv))
46         (v (let lp ((v (vec fv)))
47              (if (< (+ len xvlen) (vector-length v)) v (lp (grow! fv))))))
48    (vector-copy! v (+ i xvlen) v i len)
49    (vector-copy! v i xv 0 xvlen)
50    (set-flexvector-length! fv (+ len xvlen))
51    fv))
52
53(define (flexvector-remove-range! fv start end)
54  (let ((len (flexvector-length fv)))
55    (when (< start 0) (set! start 0))
56    (when (>= end len) (set! end len))
57    (vector-copy! (vec fv) start (vec fv) end)
58    (let ((new-len (- len (- end start))))
59      (vector-fill! (vec fv) #f new-len len)
60      (set-flexvector-length! fv new-len)))
61  fv)
62
63;; Inspired by chez-scheme's SRFI 214 flexvector->list implementation.
64(define (%flexvector->list fv start end)
65  (if (< end start)
66    (error "invalid sublist specification")
67    (let ((vec (vec fv)))
68      (let lp ((acc '()) (idx (dec end)))
69        (if (< idx start)
70          acc
71          (lp (cons (vector-ref vec idx) acc)
72              (dec idx)))))))
73
74(define flexvector->list
75  (case-lambda
76    ((fv)
77     (flexvector->list fv 0 (flexvector-length fv)))
78    ((fv start)
79     (flexvector->list fv start (flexvector-length fv)))
80    ((fv start end)
81     (%flexvector->list fv start end))))