;;;; levenshtein-sequence-vector.scm -*- Scheme -*-
;;;; Kon Lovett, Mar '20
;;;; Kon Lovett, Apr '12
;;;; Kon Lovett, May '06

(include "levenshtein-sequence-interface")

(module levenshtein-sequence-vector SEQUENCE-OPER

(import scheme
	(chicken base)
	(chicken type)
  (only record-variants define-record-type-variant)
	vector-lib
	type-checks
	type-errors)

;;;

(include "levenshtein-sequence-vector.types")

;;;

(define shared-vector 'shared-vector)
(define-record-type-variant shared-vector (unchecked inline unsafe)
  (%make-shared-vector vec start end)
  %shared-vector?
  (vec %shared-vector-vector)
  (start %shared-vector-start)
  (end %shared-vector-end))

;;;

(define (*vector? obj)
  (or (vector? obj) (%shared-vector? obj)) )

(define (error/type/vector loc obj)
  (error-argument-type loc obj "vector") )

#; ;UNUSED
(define (check-*vector loc obj)
  (unless (*vector? obj) (error/type/vector loc obj))
  obj )

(define (*vector-length vec)
  (cond
    ((vector? vec) (vector-length vec))
    ((%shared-vector? vec) (- (%shared-vector-end vec) (%shared-vector-start vec)))
    (else
      (error/type/vector '*vector-length vec)) ) )

(define (*vector-ref vec idx)
  (cond
    ((vector? vec) (vector-ref vec idx))
    ((%shared-vector? vec)
      (let ((ridx (+ (%shared-vector-start vec) idx)))
        (if (and (<= (%shared-vector-start vec) ridx) (< ridx (%shared-vector-end vec)))
            (*vector-ref (%shared-vector-vector vec) ridx)
            (error 'vector-ref "out of range" idx))))
    (else
      (error/type/vector '*vector-ref vec)) ) )

(define (*vector-for-each f vec . vectors)
  (define (vec-for-each f vec start end)
    (do ((i start (+ i 1)))
        ((<= end i))
      (f i (*vector-ref vec i)) ) )
  (if (null? vectors)
      (vec-for-each f vec 0 (*vector-length vec))
      (error 'vector-for-each "multiple vector support not implemented") ) )

(define (subvector/shared vec start #!optional (end (*vector-length vec)))
  (%make-shared-vector vec start end) )

(define (vector-prefix-length elm-eql v1 v2
          #!optional (s1 0) (e1 (*vector-length v1)) (s2 0) (e2 (*vector-length v2)))
  (let loop ((i1 s1) (i2 s2))
    (cond
      ((or (>= i1 e1) (>= i2 e2))
        (if (> i1 e1) 0 (- i1 s1)))
      ((elm-eql (*vector-ref v1 i1) (*vector-ref v2 i2))
        (loop (add1 i1) (add1 i2)))
      (else
        (- i1 s1)))) )

(define (vector-suffix-length elm-eql v1 v2
          #!optional (s1 0) (e1 (*vector-length v1)) (s2 0) (e2 (*vector-length v2)))
  (let loop ((i1 (sub1 e1)) (i2 (sub1 e2)))
    (cond
      ((or (<= i1 s1) (<= i2 s2))
        (if (< i1 s1) 0 (- e1 (add1 i1))))
      ((elm-eql (*vector-ref v1 i1) (*vector-ref v2 i2))
        (loop (sub1 i1) (sub1 i2)))
      (else
        (- e1 (add1 i1))))) )

;;;

(define check-sequence check-vector)
(define sequence-length vector-length)
(define sequence-prefix-length vector-prefix-length)
(define sequence-suffix-length vector-suffix-length)
(define sequence-for-each vector-for-each)
(define subsequence/shared subvector/shared)

) ;module levenshtein-sequence-vector