;;; Copyright (C) 2020 Wolfgang Corcoran-Mathe
;;;
;;; Permission is hereby granted, free of charge, to any person obtaining a
;;; copy of this software and associated documentation files (the
;;; "Software"), to deal in the Software without restriction, including
;;; without limitation the rights to use, copy, modify, merge, publish,
;;; distribute, sublicense, and/or sell copies of the Software, and to
;;; permit persons to whom the Software is furnished to do so, subject to
;;; the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be included
;;; in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
;;; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
;;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
;;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
;;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

(: exact-natural? (* -> boolean))
(define (exact-natural? x)
  (and (exact-integer? x) (not (negative? x))))

;; Find the least element of a list non-empty of naturals. If an element
;; is zero, returns it immediately.
(: short-minimum ((list-of integer) -> integer))
(define (short-minimum ns)
  (call-with-current-continuation
   (lambda (return)
     (reduce (lambda (n s)
               (if (zero? n) (return n) (min n s)))
             0
             ns))))

(: sum ((list-of integer) -> integer))
(define (sum ns) (reduce + 0 ns))

(define-type range (struct <range>))

(define-record-type <range>
  (raw-range start-index
             length
             indexer
             complexity)
  range?
  (start-index range-start-index : integer)
  (length range-length : integer)
  (indexer range-indexer : (integer -> *))
  (complexity range-complexity : fixnum))

;; Maximum number of indexers to compose with range-reverse and
;; range-append before a range is expanded with vector-range.
;; This may need adjustment.
(: %range-maximum-complexity fixnum)
(define %range-maximum-complexity 16)

;; Returns an empty range which is otherwise identical to r.
(: %empty-range-from (range -> range))
(define (%empty-range-from r)
  (raw-range (range-start-index r)
             0
             (range-indexer r)
             (range-complexity r)))

(: threshold? (fixnum -> boolean))
(define (threshold? k)
  (> k %range-maximum-complexity))

(: %range-valid-index? (range integer -> boolean))
(define (%range-valid-index? r index)
  (and (exact-natural? index)
       (< index (range-length r))))

(: check-index (symbol range integer -> undefined))
(define (check-index loc r k)
  (unless (and (>= k 0) (< k (range-length r)))
    (bounds-exception loc "index out of bounds" r k)))

;; As the previous check, but bound is assumed to be exclusive.
(: %range-valid-bound? (range integer -> boolean))
(define (%range-valid-bound? r bound)
  (and (exact-natural? bound)
       (<= bound (range-length r))))

(: check-range (symbol range integer integer -> undefined))
(define (check-range loc r start end)
  (unless (<= 0 start end (range-length r))
    (bounds-exception loc "range out of bounds" r start end)))

;;;; Constructors

;; The primary range constructor does some extra consistency checking.
(: range (integer (integer -> *) -> range))
(define (range length indexer)
  (assert-type 'range (exact-natural? length))
  (assert-type 'range (procedure? indexer))
  (raw-range 0 length indexer 0))

(: numeric-range (or (integer integer -> range)
                     (integer integer integer -> range)))
(define numeric-range
  (case-lambda
    ((start end) (numeric-range start end 1))
    ((start end step)
     (assert-type 'numeric-range (real? start))
     (assert-type 'numeric-range (real? end))
     (when (zero? step)
       (error 'numeric-range "zero-valued step" start end))
     (let ((len (exact (ceiling (max 0 (/ (- end start) step))))))
       ;; Try to ensure that we can compute a correct range from the
       ;; given parameters, i.e. one not plagued by roundoff errors.
       (unless (cond ((and (positive? step) (< start end))
                      (and (> (+ start step) start)
                           (< (+ start (* (- len 1) step)) end)))
                     ((and (negative? step) (> start end))
                      (and (< (+ start step) start)
                           (> (+ start (* (- len 1) step)) end)))
                     (else #t))
         (error 'numeric-range "cannot compute range from parameters"
                start end step))
       (raw-range 0 len (lambda (n) (+ start (* n step))) 0)))))

;; TODO: Consider possible round-off bugs.
(: iota-range (or (integer -> range)
                  (integer integer -> range)
                  (integer integer integer -> range)))
(define iota-range
  (case-lambda
    ((len) (iota-range len 0 1))
    ((len start) (iota-range len start 1))
    ((len start step)
     (assert-type 'iota-range (exact-natural? len))
     (assert-type 'iota-range (real? start))
     (assert-type 'iota-range (real? step))
     (raw-range 0
                len
                (cond ((and (zero? start) (= step 1)) (lambda (i) i))
                      ((= step 1) (lambda (i) (+ start i)))
                      ((zero? start) (lambda (i) (* step i)))
                      (else (lambda (i) (+ start (* step i)))))
                0))))

(: vector-range (vector -> range))
(define (vector-range vec)
  (assert-type 'vector-range (vector? vec))
  (raw-range 0 (vector-length vec) (lambda (i) (vector-ref vec i)) 0))

;; This implementation assumes that string-ref is O(n), as would be
;; the case with UTF-8.  If an implementation has an O(1) string-ref,
;; the following version is preferable:
;;
;; (raw-range 0 (string-length s) (lambda (i) (string-ref s i))))
;;
(: string-range (string -> range))
(define (string-range s)
  (assert-type 'string-range (string? s))
  (vector-range (string->vector s)))

(: %range-maybe-vectorize (range -> range))
(define (%range-maybe-vectorize r)
  (if (threshold? (range-complexity r))
      (vector-range (range->vector r))
      r))

;;;; Accessors

(: range-ref (range integer -> *))
(define (range-ref r index)
  (assert-type 'range-ref (range? r))
  (assert-type 'range-ref (exact-integer? index))
  (check-index 'range-ref r index)
  ((range-indexer r) (+ index (range-start-index r))))

;; A portable implementation can't rely on inlining, but it
;; can rely on macros.
(define-syntax %range-ref-no-check
  (syntax-rules ()
    ((_ r index)
     ((range-indexer r) (+ index (range-start-index r))))))

(: range-first (range -> *))
(define (range-first r)
  (assert-type 'range-first (range? r))
  (%range-ref-no-check r (range-start-index r)))

(: range-last (range -> *))
(define (range-last r)
  (assert-type 'range-last (range? r))
  (%range-ref-no-check r (- (range-length r) 1)))

;;;; Predicates

(: range=? (or ((* * -> boolean) range range -> boolean)
               ((* * -> boolean) #!rest range -> boolean)))
(define range=?
  (case-lambda
    ((equal ra rb)                      ; two-range fast path
     (assert-type 'range=? (procedure? equal))
     (assert-type 'range=? (range? ra))
     (%range=?-2 equal ra rb))
    ((equal . rs)                       ; variadic path
     (assert-type 'range=? (procedure? equal))
     (unless (pair? rs) (arity-exception 'range=? rs))
     (let ((ra (car rs)))
       (assert-type 'range=? (range? ra))
       (every (lambda (rb) (%range=?-2 equal ra rb)) (cdr rs))))))

(: %range=?-2 ((* * -> boolean) range range -> boolean))
(define (%range=?-2 equal ra rb)
  (assert-type 'range=? (range? rb))
  (or (eqv? ra rb)                      ; quick check
      (let ((la (range-length ra)))
        (and (= la (range-length rb))
             (if (zero? la)
                 #t                     ; all empty ranges are equal
                 (let lp ((i 0))
                   (cond ((= i la) #t)
                         ((not (equal (%range-ref-no-check ra i)
                                      (%range-ref-no-check rb i)))
                          #f)
                         (else (lp (+ i 1))))))))))

;;;; Iteration

(: range-split-at (range integer -> range range))
(define (range-split-at r index)
  (assert-type 'range-split-at (range? r))
  (assert-type 'subrange (exact-integer? index))
  (unless (%range-valid-bound? r index)
    (bounds-exception 'range-split-at "index out of bounds" r index))
  (cond ((= index 0) (values (%empty-range-from r) r))
        ((= index (range-length r)) (values r (%empty-range-from r)))
        (else
         (let ((indexer (range-indexer r)) (k (range-complexity r)))
           (values (raw-range (range-start-index r) index indexer k)
                   (raw-range index
                              (- (range-length r) index)
                              indexer
                              k))))))

(: subrange (range integer integer -> range))
(define (subrange r start end)
  (assert-type 'subrange (range? r))
  (assert-type 'subrange (exact-integer? start))
  (assert-type 'subrange (exact-integer? end))
  (check-range 'subrange r start end)
  (if (and (zero? start) (= end (range-length r)))
      r
      (raw-range (+ (range-start-index r) start)
                 (- end start)
                 (range-indexer r)
                 (range-complexity r))))

(: range-segment (range integer -> (list-of range)))
(define (range-segment r k)
  (assert-type 'range-segment (range? r))
  (assert-type 'range-segment (and (exact-integer? k) (positive? k)))
  (let ((len (range-length r))
        (%subrange-no-check
         (lambda (s e)
           (raw-range (+ (range-start-index r) s)
                      (- e s)
                      (range-indexer r)
                      (range-complexity r)))))
    (unfold (lambda (i) (>= i len))
            (lambda (i) (%subrange-no-check i (min len (+ i k))))
            (lambda (i) (+ i k))
            0)))

(: range-take (range integer -> range))
(define (range-take r count)
  (assert-type 'range-take (range? r))
  (assert-type 'range-take (exact-integer? count))
  (unless (%range-valid-bound? r count)
    (bounds-exception 'range-take "invalid count" r count))
  (cond ((zero? count) (%empty-range-from r))
        ((= count (range-length r)) r)
        (else (raw-range (range-start-index r)
                         count
                         (range-indexer r)
                         (range-complexity r)))))

(: range-take-right (range integer -> range))
(define (range-take-right r count)
  (assert-type 'range-take-right (range? r))
  (assert-type 'range-take-right (exact-integer? count))
  (unless (%range-valid-bound? r count)
    (bounds-exception 'range-take-right "invalid count" r count))
  (cond ((zero? count) (%empty-range-from r))
        ((= count (range-length r)) r)
        (else
         (raw-range (+ (range-start-index r) (- (range-length r) count))
                    count
                    (range-indexer r)
                    (range-complexity r)))))

(: range-drop (range integer -> range))
(define (range-drop r count)
  (assert-type 'range-drop (range? r))
  (assert-type 'range-drop (exact-integer? count))
  (unless (%range-valid-bound? r count)
    (bounds-exception 'range-drop "invalid count" r count))
  (if (zero? count)
      r
      (raw-range (+ (range-start-index r) count)
                 (- (range-length r) count)
                 (range-indexer r)
                 (range-complexity r))))

(: range-drop-right (range integer -> range))
(define (range-drop-right r count)
  (assert-type 'range-drop-right (range? r))
  (assert-type 'range-drop-right (exact-integer? count))
  (unless (%range-valid-bound? r count)
    (bounds-exception 'range-drop-right "invalid count" r count))
  (if (zero? count)
      r
      (raw-range (range-start-index r)
                 (- (range-length r) count)
                 (range-indexer r)
                 (range-complexity r))))

(: range-count (procedure range #!rest range -> integer))
(define (range-count pred r . rs)
  (assert-type 'range-count (procedure? pred))
  (assert-type 'range-count (range? r))
  (assert-type 'range-count (every range? rs))
  (if (null? rs)                        ; one-range fast path
      (%range-fold-1 (lambda (c x)
                       (if (pred x) (+ c 1) c))
                     0
                     r)
      (apply range-fold                 ; variadic path
             (lambda (c . xs)
               (if (apply pred xs) (+ c 1) c))
             0
             r
             rs)))

(: range-any (procedure range #!rest range -> boolean))
(define (range-any pred r . rs)
  (assert-type 'range-any (procedure? pred))
  (assert-type 'range-any (range? r))
  (assert-type 'range-any (every range? rs))
  (call-with-current-continuation
   (lambda (return)
     (if (null? rs)                        ; one-range fast path
         (%range-fold-1 (lambda (_last x)
                          (cond ((pred x) => return)
                                (else #f)))
                        #f
                        r)
         (apply range-fold                 ; variadic path
                (lambda (_last . xs)
                  (cond ((apply pred xs) => return)
                        (else #f)))
                #f
                r
                rs)))))

(: range-every (procedure range #!rest range -> boolean))
(define (range-every pred r . rs)
  (assert-type 'range-every (procedure? pred))
  (assert-type 'range-every (range? r))
  (assert-type 'range-every (every range? rs))
  (call-with-current-continuation
   (lambda (return)
     (if (null? rs)                     ; one-range fast path
         (%range-fold-1 (lambda (_ x) (or (pred x) (return #f)))
                        #t
                        r)
         (apply range-fold              ; variadic path
                (lambda (_ . xs) (or (apply pred xs) (return #f)))
                #t
                r
                rs)))))

(: range-map (procedure #!rest range -> range))
(define (range-map proc . rs)
  (assert-type 'range-map (procedure? proc))
  (assert-type 'range-map (every range? rs))
  (when (null? rs) (arity-exception 'range-map rs))
  (vector-range (apply range-map->vector proc rs)))

(: range-filter-map (procedure #!rest range -> range))
(define (range-filter-map proc . rs)
  (assert-type 'range-filter-map (procedure? proc))
  (assert-type 'range-filter-map (every range? rs))
  (when (null? rs) (arity-exception 'range-filter-map rs))
  (vector-range (list->vector (apply range-filter-map->list proc rs))))

(: range-map->list (procedure range #!rest range -> list))
(define (range-map->list proc r . rs)
  (assert-type 'range-map->list (procedure? proc))
  (assert-type 'range-map->list (range? r))
  (assert-type 'range-map->list (every range? rs))
  (if (null? rs)                        ; one-range fast path
      (%range-fold-right-1 (lambda (res x) (cons (proc x) res))
                           '()
                           r)
      (apply range-fold-right           ; variadic path
             (lambda (res . xs) (cons (apply proc xs) res))
             '()
             r
             rs)))

(: range-filter-map->list
   (procedure range #!rest range -> list))
(define (range-filter-map->list proc r . rs)
  (assert-type 'range-filter-map->list (procedure? proc))
  (assert-type 'range-filter-map->list (range? r))
  (assert-type 'range-filter-map->list (every range? rs))
  (if (null? rs)                        ; one-range fast path
      (%range-fold-right-1 (lambda (res x)
                             (cond ((proc x) =>
                                    (lambda (elt) (cons elt res)))
                                   (else res)))
                           '()
                           r)
      (apply range-fold-right           ; variadic path
             (lambda (res . xs)
               (cond ((apply proc xs) => (lambda (elt) (cons elt res)))
                     (else res)))
             '()
             r
             rs)))

(: range-map->vector (procedure range #!rest range -> vector))
(define (range-map->vector proc r . rs)
  (assert-type 'range-map->vector (procedure? proc))
  (assert-type 'range-map->vector (range? r))
  (assert-type 'range-map->vector (every range? rs))
  (if (null? rs)                        ; one-range fast path
      (vector-unfold (lambda (i) (proc (%range-ref-no-check r i)))
                     (range-length r))
      (let ((rs* (cons r rs)))          ; variadic path
        (vector-unfold (lambda (i)
                         (apply proc (map (lambda (r)
                                            (%range-ref-no-check r i))
                                          rs*)))
                       (short-minimum (map range-length rs*))))))

(: range-for-each
   (procedure range #!rest range -> undefined))
(define (range-for-each proc r . rs)
  (assert-type 'range-for-each (procedure? proc))
  (assert-type 'range-for-each (range? r))
  (assert-type 'range-for-each (every range? rs))
  (if (null? rs)                        ; one-range fast path
      (let ((len (range-length r)))
        (do ((i 0 (+ i 1)))
            ((= i len) (void))
          (proc (%range-ref-no-check r i))))
      (let* ((rs* (cons r rs))          ; variadic path
             (len (short-minimum (map range-length rs*))))
        (do ((i 0 (+ i 1)))
            ((= i len) (void))
          (apply proc (map (lambda (r) (%range-ref-no-check r i))
                           rs*))))))

(: %range-fold-1 (procedure * range -> *))
(define (%range-fold-1 proc nil r)
  (let ((len (range-length r)))
    (do ((i 0 (+ i 1))
         (acc nil (proc acc (%range-ref-no-check r i))))
        ((= i len) acc))))

(: range-fold (or (procedure * range -> *)
                  (procedure * #!rest range -> *)))
(define range-fold
  (case-lambda
    ((proc nil r)                       ; one-range fast path
     (assert-type 'range-fold (procedure? proc))
     (assert-type 'range-fold (range? r))
     (%range-fold-1 proc nil r))
    ((proc nil . rs)                    ; variadic path
     (assert-type 'range-fold (procedure? proc))
     (assert-type 'range-fold (every range? rs))
     (when (null? rs) (arity-exception 'range-fold-right rs))
     (let ((len (short-minimum (map range-length rs)))
           (ref (lambda (i)
                  (map (lambda (r) (%range-ref-no-check r i)) rs))))
       (do ((i 0 (+ i 1))
            (acc nil (apply proc acc (ref i))))
           ((= i len) acc))))))

(: %range-fold-right-1 (procedure * range -> *))
(define (%range-fold-right-1 proc nil r)
  (let ((len (range-length r)))
    (let rec ((i 0))
      (if (= i len)
          nil
          (proc (rec (+ i 1)) (%range-ref-no-check r i))))))

(: range-fold-right (or (procedure * range -> *)
                        (procedure * #!rest range -> *)))
(define range-fold-right
  (case-lambda
    ((proc nil r)                       ; one-range fast path
     (%range-fold-right-1 proc nil r))
    ((proc nil . rs)                    ; variadic path
     (assert-type 'range-fold-right (procedure? proc))
     (assert-type 'range-fold-right (every range? rs))
     (when (null? rs) (arity-exception 'range-fold-right rs))
     (let ((len (short-minimum (map range-length rs))))
       (let rec ((i 0))
         (if (= i len)
             nil
             (apply proc
                    (rec (+ i 1))
                    (map (lambda (r) (%range-ref-no-check r i)) rs))))))))

(: range-filter (procedure range -> range))
(define (range-filter pred r)
  (vector-range (list->vector (range-filter->list pred r))))

(: range-filter->list (procedure range -> list))
(define (range-filter->list pred r)
  (assert-type 'range-filter->list (procedure? pred))
  (assert-type 'range-filter->list (range? r))
  (%range-fold-right-1 (lambda (xs x)
                         (if (pred x) (cons x xs) xs))
                       '()
                       r))

(: range-remove (procedure range -> range))
(define (range-remove pred r)
  (vector-range (list->vector (range-remove->list pred r))))

(: range-remove->list (procedure range -> list))
(define (range-remove->list pred r)
  (assert-type 'range-remove->list (procedure? pred))
  (assert-type 'range-remove->list (range? r))
  (%range-fold-right-1 (lambda (xs x)
                         (if (pred x) xs (cons x xs)))
                       '()
                       r))

(: range-reverse (range -> range))
(define (range-reverse r)
  (assert-type 'range-reverse (range? r))
  (%range-maybe-vectorize
   (raw-range (range-start-index r)
              (range-length r)
              (lambda (n)
                ((range-indexer r) (- (range-length r) 1 n)))
              (+ 1 (range-complexity r)))))

(: range-append (or (-> range)
                    (range -> range)
                    (range range -> range)
                    (#!rest range -> range)))
(define range-append
  (case-lambda
    (() (raw-range 0 0 identity 0))
    ((r)                                ; one-range fast path
     (assert-type 'range-append (range? r))
     r)
    ((ra rb)                            ; two-range fast path
     (assert-type 'range-append (range? ra))
     (assert-type 'range-append (range? rb))
     (let ((la (range-length ra))
           (lb (range-length rb)))
       (%range-maybe-vectorize          ; FIXME: should be lazy.
        (raw-range 0
                   (+ la lb)
                   (lambda (i)
                     (if (< i la)
                         (%range-ref-no-check ra i)
                         (%range-ref-no-check rb (- i la))))
                   (+ 2 (range-complexity ra) (range-complexity rb))))))
    (rs                                 ; variadic path
     (assert-type 'range-append (every range? rs))
     (let ((lens (map range-length rs)))
       (%range-maybe-vectorize          ; FIXME: should be lazy.
        (raw-range 0
                   (sum lens)
                   (lambda (i)
                     (do ((lens lens (cdr lens))
                          (i i (- i (car lens)))
                          (rs rs (cdr rs)))
                         ((< i (car lens))
                          (%range-ref-no-check (car rs) i))))
                   (+ (length rs) (sum (map range-complexity rs)))))))))

;;;; Searching

(: range-index
   (procedure range #!rest range -> (or integer false)))
(define (range-index pred r . rs)
  (assert-type 'range-index (procedure? pred))
  (assert-type 'range-index (range? r))
  (assert-type 'range-index (every range? rs))
  (if (null? rs)                        ; one-range fast path
      (let ((len (range-length r)))
        (let lp ((i 0))
          (cond ((= i len) #f)
                ((pred (%range-ref-no-check r i)) i)
                (else (lp (+ i 1))))))
      (let* ((rs* (cons r rs))          ; variadic path
             (len (short-minimum (map range-length rs*))))
        (let lp ((i 0))
          (cond ((= i len) #f)
                ((apply pred
                        (map (lambda (s) (%range-ref-no-check s i))
                             rs*))
                 i)
                (else (lp (+ i 1))))))))

(: range-index-right
   (procedure range #!rest range -> (or integer false)))
(define (range-index-right pred r . rs)
  (assert-type 'range-index-right (procedure? pred))
  (assert-type 'range-index-right (range? r))
  (assert-type 'range-index-right (every range? rs))
  (if (null? rs)                        ; one-range fast path
      (let lp ((i (- (range-length r) 1)))
        (cond ((< i 0) #f)
              ((pred (%range-ref-no-check r i)) i)
              (else (lp (- i 1)))))
      (let ((len (range-length r))      ; variadic path
            (rs* (cons r rs)))
        (unless (every (lambda (s) (= len (range-length s))) rs)
          (error 'range-index-right
                 "range arguments must be of the same length"
                 r rs))
        (let lp ((i (- len 1)))
          (cond ((< i 0) #f)
                ((apply pred
                        (map (lambda (s) (%range-ref-no-check s i))
                             rs*))
                 i)
                (else (lp (- i 1))))))))

(: range-take-while (procedure range -> range))
(define (range-take-while pred r)
  (assert-type 'range-take-while (procedure? pred))
  (assert-type 'range-take-while (range? r))
  (cond ((range-index (lambda (x) (not (pred x))) r) =>
         (lambda (i) (range-take r i)))
        (else r)))

(: range-take-while-right (procedure range -> range))
(define (range-take-while-right pred r)
  (assert-type 'range-take-while-right (procedure? pred))
  (assert-type 'range-take-while-right (range? r))
  (cond ((range-index-right (lambda (x) (not (pred x))) r) =>
         (lambda (i) (range-take-right r (- (range-length r) 1 i))))
        (else r)))

(: range-drop-while (procedure range -> range))
(define (range-drop-while pred r)
  (assert-type 'range-drop-while (procedure? pred))
  (assert-type 'range-drop-while (range? r))
  (cond ((range-index (lambda (x) (not (pred x))) r) =>
         (lambda (i) (range-drop r i)))
        (else (%empty-range-from r))))

(: range-drop-while-right (procedure range -> range))
(define (range-drop-while-right pred r)
  (assert-type 'range-drop-while-right (procedure? pred))
  (assert-type 'range-drop-while-right (range? r))
  (cond ((range-index-right (lambda (x) (not (pred x))) r) =>
         (lambda (i) (range-drop-right r (- (range-length r) 1 i))))
        (else (%empty-range-from r))))

;;;; Conversion

(: range->list (range -> list))
(define (range->list r)
  (assert-type 'range->list (range? r))
  (%range-fold-right-1 xcons '() r))

(: range->vector (range -> vector))
(define (range->vector r)
  (assert-type 'range->vector (range? r))
  (vector-unfold (lambda (i) (%range-ref-no-check r i))
                 (range-length r)))

(: range->string (range -> string))
(define (range->string r)
  (assert-type 'range->string (range? r))
  (string-tabulate
   (lambda (i)
     (let ((c (%range-ref-no-check r i)))
       (unless (char? c)
         (type-exception 'range->string
                         "non-character element"
                         c i))
       c))
   (range-length r)))

(: vector->range (vector -> range))
(define (vector->range vec)
  (assert-type 'vector->range (vector? vec))
  (vector-range (vector-copy vec)))

(: range->generator (range -> procedure))
(define (range->generator r)
  (assert-type 'range->generator (range? r))
  (let ((i 0) (len (range-length r)))
    (lambda ()
      (if (>= i len)
          (eof-object)
          (begin
           (let ((v (%range-ref-no-check r i)))
             (set! i (+ i 1))
             v))))))