;;;; Copyright 2002, Jonathan Bachrach.  See file TERMS.

(use goo/boot)
(use goo/fun)
(use goo/class)
(use goo/macros)
(use goo/any)
(use goo/log)
(use goo/chr)
(use goo/mag)
(use goo/math)
(use goo/types)
(use goo/cols/col)
(use goo/cols/colx)
(use goo/cols/seq)
(use goo/cols/seqx)
(use goo/cols/lst)
(use goo/cols/flat)
(use goo/cols/rep)

;; 3.7.6.3 STRETCHY-VECTOR

;;;;!! Interface
(exported
 (dc <vec> (<flat> <seq!>))
 (dg vec (elts|... => <vec>))
 )
 

;;;;!! Implementation
  (dp! vec-len (<vec> => <int>) 0)
  (dp! vec-dat (<vec> => <rep>) (rep-nul))

;;;; Collection protocol

(dm len (c|<vec> => <int>)
  (vec-len c))

(dm elt-or (c|<vec> i|<int> default => <any>)
  (if (range-check? c i)
      (low-elt c i)
      default))

(dm elt-setter (z c|<vec> i|<int>)
  (when (< i 0) (range-error c i))
  (set (low-elt c i) z))

(dm nul ((c (t= <vec>)) => <vec>) (new <vec>))

(dm fab ((c (t= <vec>)) s|<int> => <vec>)
  (def dat (rep-fab (power-of-two-ceil s) #f))
  (new <vec> vec-len s vec-dat dat))

;;;; Sequence protocol

;; TODO: HAVE THIS FALL OUT OF PROTOCOL
(dm cat! (x|<vec> more|... => <vec>)
  (for ((s more))
    (for ((e s))
      (add! x e)))
  x)

(dm vec (elts|... => <vec>)
  (app fabs <vec> elts))

(dm push! (c|<vec> x => <vec>)
  (add! c x))

(dm pop! (c|<vec> => (tup seq|<vec> val|<any>))
  (def new-len (- (len c) 1))
  (when (< new-len 0) (range-error c new-len))
  (def x (low-elt c new-len))
  (set (len c) new-len)
  (tup c x))

;; TODO: QUESTIONABLE SYNTAX
(dm to-str (x|<vec> => <str>) 
  (cat "#[" (vals-to-str x) "]"))

(dm add! (c|<vec> x => <vec>)
  (set (low-elt c (len c)) x)
  c)

(dm len/fill-setter (new-len|<int> c|<vec> default)
  (def dat (vec-dat c))
  (if (> new-len (rep-len dat))
      (let ((new-data (rep-fab (power-of-two-ceil new-len) default)))
        (rep-into! new-data dat)
        (set (vec-len c) new-len)
        (set (vec-dat c) new-data))
      (if (< new-len (len c))
          (let ((old-len (len c)))
            (when (< new-len 0) (range-error c new-len))
            (set (vec-len c) new-len)
            (rep fill ((i|<int> new-len))
              (and (< i old-len)
                   (set (rep-elt dat i) default)
                   (fill (+ i 1)))))
          (set (vec-len c) new-len))))

(dm len-setter (new-len|<int> c|<vec>)
  (set (len/fill c (elt-default c)) new-len))

(dm zap! (c|<vec> => <vec>) (set (len c) 0) c)

(dm low-elt (x|<vec> i|<int> => <any>)
  (rep-elt (vec-dat x) i))

(dm low-elt-setter (z x|<vec> i|<int>)
  (when (>= i (len x))
    (set (len x) (+ i 1)))
  (set (rep-elt (vec-dat x) i) z))

(dm sort-by (A|<seq.> test|<fun> => <seq.>)
  (col-res A (sort-by! (as <vec> A) test)))
 
(dm sort-by! (A|<seq!> test|<fun> => <seq!>)
  (def sorted (quicksort! (as <vec> A) 0 (1- (len A)) test))
  (if (== A sorted) ; (as) can return the same object, so sorted could == A
      sorted
      (into A sorted)))

(dm quicksort! (A|<vec> p|<int> r|<int> test|<fun> => <vec>)
  (if (< p r)
      (let ((q (partition! A p r test)))
        (quicksort! A p q test)
        (quicksort! A (1+ q) r test))
      A))

(dm partition! (A|<vec> p|<int> r|<int> test|<fun> => <int>)
  (def x (elt A p))
  (def i (1- p))
  (def j (1+ r))
  (rep loop ()
    (rep j-loop ()
      (decf j)
      (unless (or (test (elt A j) x) (= (elt A j) x))
        (j-loop)))
    (rep i-loop ()
      (incf i)
      (unless (not (test (elt A i) x))
        (i-loop)))
    (if (< i j)
        (seq (swapf (elt A i) (elt A j))
             (loop))
        j)))
