#|  _    ____  ___   ______________________  _   _____    __ 
   | |  / / / / / | / / ____/_  __/  _/ __ \/ | / /   |  / / 
   | | / / / / /  |/ / /     / /  / // / / /  |/ / /| | / /  
   | |/ / /_/ / /|  / /___  / / _/ // /_/ / /|  / ___ |/ /___
   |___/\____/_/ |_/\____/ /_/ /___/\____/_/ |_/_/  |_/_____/
       ____________________________  ____  _____
      / ____/ ____/ ____/_  __/ __ \/ __ \/ ___/
     / /_  / __/ / /     / / / / / / /_/ /\__ \ 
    / __/ / /___/ /___  / / / /_/ / _, _/___/ / 
   /_/   /_____/\____/ /_/  \____/_/ |_|/____/               
   Persistent Functional Vectors.

   Copyright (c) 2011 David Van Horn
   Licensed under the Academic Free License version 3.0
  
   (at dvanhorn (dot ccs neu edu))

   Vucking vast vunctional fectors.
|#

(provide make-fector fector fector-length 
         build-fector fector-ref fector-set)

;; An [Fector X] is a (fox [Data X])
;; A [Data X] is one of:
;; - [Vector X]
;; - (diff Nat X [Fector X])

;; (struct diff (i v fv))

;; Based on Conchon and Filliaˆtre, ML Workshop 2007,
;; which is based on Baker, CACM 1978.
(provide make-fector fector fector-length 
         build-fector fector-ref fector-set)

;; An [Fector X] is a (box [Data X])
;; A [Data X] is one of:
;; - [Vector X]
;; - (list Nat X [Fector X])

(define (make-fector n x)
  (box (make-vector n x)))

(define (fector . xs)
  (box (apply vector xs)))
  
(define (fector-length fv)
  (atomic 
   (λ ()
     (reroot! fv)
     (vector-length (unbox fv)))))
   
(define (build-fector n f)
  (box (build-vector n f)))

(define (fector-ref fv i)
  (atomic
   (λ ()
     (let ((v (unbox fv)))
       (cond 
         [(pair? v)
          (reroot! fv)
          (vector-ref (unbox fv) i)]
         [else
          (vector-ref v i)])))))
   
(define (fector-set fv i x)
  (atomic 
   (λ ()
     (reroot! fv)
     (let ((v (unbox fv)))
       (let ((old (vector-ref v i)))
         (vector-set! v i x)
         (let ((res (box v)))
           (set-box! fv (list i old res))
           res))))))

(define (reroot! fv)
  (match (unbox fv)
    [(list i x fv*)
     (reroot! fv*)     
     (let ((v (unbox fv*)))
       (let ((x* (vector-ref v i)))         
         (vector-set! v i x)
         (set-box! fv v)
         (set-box! fv* (list i x* fv))))]
    [_ (void)]))

#|
(define a0 (make-fector 7 0))
(define a1 (fector-set a0 1 7))
(define a2 (fector-set a1 2 8))
(define a3 (fector-set a1 2 9))
    
(for/list ([i (in-range 7)])
  (fector-ref a0 i))
(for/list ([i (in-range 7)])
  (fector-ref a1 i))
(for/list ([i (in-range 7)])
  (fector-ref a2 i))
(for/list ([i (in-range 7)])
  (fector-ref a3 i))

(equal? (fox (vector 1 2 3))
        (fox (diff 0 1 (fox (vector 7 2 3)))))
|#