;;
;; 
;; Dynamic (dense) vectors. 
;;
;; Copyright 2007-2010 Ivan Raikov and the Okinawa Institute of Science and Technology.
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; A full copy of the GPL license can be found at
;; <http://www.gnu.org/licenses/>.
;;


(module dyn-vector

 (dynvector? 		 
  dynvector-tabulate
  list->dynvector
  make-dynvector
  dynvector-clear!
  dynvector-length
  dynvector-ref
  dynvector-set!
  dynvector-expand!
  dynvector-for-each
  dynvector-map
  dynvector-copy
  dynvector-fold
  dynvector-fold-right
  dynvector-index
  dynvector-any
  dynvector-every
  dynvector->list)
		 
		   
  (import scheme chicken data-structures extras )

  (require-extension srfi-1 vector-lib )

(define-record dvbase vect dflt cnt)

(define-record-printer (dvbase x out)
  (fprintf out "#(dynvector")
  (for-each (lambda (x) (fprintf out " ~A" x)) (dynvector->list x))
  (fprintf out ")"))


(define dynvector? dvbase?)


(define (dynvector-tabulate n f . rest) 
  (let-optionals  rest ((dflt #f))
   (let* ((vect (vector-unfold f n))
	  (dflt (if dflt dflt (vector-ref vect 0))))
     (make-dvbase vect dflt n))))

(define (list->dynvector l . rest)
  (let-optionals  rest ((dflt #f))
   (let* ((vect (list->vector l))
	  (dflt (if dflt dflt (vector-ref vect 0))))
     (make-dvbase vect dflt (vector-length vect)))))
  
(define (make-dynvector n dflt)
  (make-dvbase (make-vector n dflt) dflt 0))

(define (dynvector-clear! dv n) 
    (dvbase-vect-set! dv (make-vector n (dvbase-dflt dv)))
    (dvbase-cnt-set! dv n))

(define (dynvector-length dv)
  (dvbase-cnt dv))

(define (dynvector-ref dv i)
  (define (handle-ref thunk dflt)
    (condition-case (thunk)
		    [(exn bounds)  dflt]))
  
  (let ((vect (dvbase-vect dv)))
    (handle-ref (lambda () (vector-ref vect i)) (dvbase-dflt dv))))

(define (dynvector-set! dv i e)
  (define (handle-update thunk extend)
    (condition-case (thunk)
		    [(exn bounds)  (extend)]))
  
  (let ((vect (dvbase-vect dv))
	(n    (dvbase-cnt dv)))
    (handle-update
     (lambda () (begin
		  (vector-set! vect i e)
		  (dvbase-cnt-set! dv (max n (fx+ 1 i)))))
     (lambda () (let* ((n1    (max (fx* 2 n) (fx+ 1 i) 16))
		       (vect1 (if (fx= 0 (vector-length vect))
				  (make-vector n1 (dvbase-dflt dv))
				  (vector-copy vect 0 n1 (dvbase-dflt dv)))))
		  (vector-set! vect1 i e)
		  (dvbase-vect-set! dv vect1)
		  (dvbase-cnt-set! dv (fx+ 1 i)))))))


(define (dynvector-expand! dv n)
  (dynvector-set! dv (- n 1) (dvbase-dflt dv)))

(define (dynvector-for-each f dv . rest)
  (let ((vect+n (map (lambda (dv) (list (dvbase-vect dv) (dvbase-cnt dv))) (cons dv rest))))
    (let-values (((vect n)  (unzip2 vect+n)))
	(let ((min-n  (apply min n)))
	  (apply vector-for-each 
		 (cons (lambda (i v . rest) (apply f (cons i rest)))
		       (cons (make-vector min-n #f) vect)))))))

(define (dynvector-map f dv . rest)
  (let ((vect+n (map (lambda (dv) (list (dvbase-vect dv) (dvbase-cnt dv))) (cons dv rest))))
    (let-values (((vect n)  (unzip2 vect+n)))
	(let ((min-n  (apply min n)))
	  (let ((vect1 (apply vector-map 
			      (cons (lambda (i v . rest) (apply f (cons i rest)))
				    (cons (make-vector min-n #f) vect)))))
	    (make-dvbase vect1 (vector-ref vect1 0) min-n))))))

(define (dynvector-copy dv)
  (let ((vect (dvbase-vect dv))
	(dflt (dvbase-dflt dv))
	(n    (dvbase-cnt dv)))
  (make-dvbase (vector-copy vect) dflt n)))


(define (dynvector-fold f init dv . rest)
  (let ((vect+n (map (lambda (dv) (list (dvbase-vect dv) (dvbase-cnt dv))) (cons dv rest))))
    (let-values (((vect n)  (unzip2 vect+n)))
	(let ((min-n  (apply min n)))
	  (apply vector-fold 
		 (cons (lambda (i state v . rest) (apply f (cons i (cons state rest))))
		       (cons init (cons (make-vector min-n #f) vect))))))))


(define (dynvector-fold-right f init dv . rest)
  (let ((vect+n (map (lambda (dv) (list (dvbase-vect dv) (dvbase-cnt dv))) (cons dv rest))))
    (let-values (((vect n)  (unzip2 vect+n)))
	(let ((min-n  (apply min n)))
	  (apply vector-fold-right 
		 (cons (lambda (i state v . rest) (apply f (cons i (cons state rest))))
		       (cons init (cons (make-vector min-n #f) vect))))))))

(define (dynvector-index pred? dv . rest)
  (let ((vect+n (map (lambda (dv) (list (dvbase-vect dv) (dvbase-cnt dv))) (cons dv rest))))
    (let-values (((vect n)  (unzip2 vect+n)))
	(let ((min-n  (apply min n)))
	  (apply vector-index 
		 (cons (lambda (v . rest) (apply pred? rest))
		       (cons (make-vector min-n #f) vect)))))))

(define (dynvector-any pred? dv . rest)
  (let ((vect+n (map (lambda (dv) (list (dvbase-vect dv) (dvbase-cnt dv))) (cons dv rest))))
    (let-values (((vect n)  (unzip2 vect+n)))
	(let ((min-n  (apply min n)))
	  (apply vector-any 
		 (cons (lambda (v . rest) (apply pred? rest))
		       (cons (make-vector min-n #f) vect)))))))

(define (dynvector-every pred? dv . rest)
  (let ((vect+n (map (lambda (dv) (list (dvbase-vect dv) (dvbase-cnt dv))) (cons dv rest))))
    (let-values (((vect n)  (unzip2 vect+n)))
	(let ((min-n  (apply min n)))
	  (apply vector-every 
		 (cons (lambda (v . rest) (apply pred? rest))
		       (cons (make-vector min-n #f) vect)))))))

(define (dynvector->list dv)
  (let ((n     (dvbase-cnt dv))
	(vect  (dvbase-vect dv)))
    (vector->list vect 0 n)))


)