#lang racket
#|  _    ____  ___   ______________________  _   _____    __ 
   | |  / / / / / | / / ____/_  __/  _/ __ \/ | / /   |  / / 
   | | / / / / /  |/ / /     / /  / // / / /  |/ / /| | / /  
   | |/ / /_/ / /|  / /___  / / _/ // /_/ / /|  / ___ |/ /___
   |___/\____/_/ |_/\____/ /_/ /___/\____/_/ |_/_/  |_/_____/
       ____________________________  ____  _____
      / ____/ ____/ ____/_  __/ __ \/ __ \/ ___/
     / /_  / __/ / /     / / / / / / /_/ /\__ \ 
    / __/ / /___/ /___  / / / /_/ / _, _/___/ / 
   /_/   /_____/\____/ /_/  \____/_/ |_|/____/               
   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 fector? 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])

;; Based on Conchon and Filliaˆtre, ML Workshop 2007,
;; which is based on Baker, CACM 1978.

;; Like a box, but different.
(struct fox (v) 
        #:mutable
        #:property prop:equal+hash
        (list
         (λ (f1 f2 equal?)
           (reroot! f1)
           (reroot! f2)
           (equal? (unfox f1) (unfox f2)))
         (λ (f equal-hash-code)
           (reroot! f)
           (equal-hash-code (unfox f)))
         (λ (f equal-hash-code)
           (reroot! f)
           (equal-hash-code (unfox f)))))           
        
(define (set-fox! fb x) (set-fox-v! fb x))
(define (unfox fb) (fox-v fb))

(struct diff (i v fv))

(define (fector? x) (fox? x))

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

(define (fector . xs)
  (fox (apply vector xs)))

(define (fector-length fv)
  (reroot! fv)
  (vector-length (unfox fv)))

(define (build-fector n f)
  (fox (build-vector n f)))

(define (fector-ref fv i)
  (match (unfox fv)
    [(diff _ _ _)
     (reroot! fv)
     (vector-ref (unfox fv) i)]
    [v (vector-ref v i)]))

(define (fector-set fv i x)
  (reroot! fv)
  (let ((v (unfox fv)))
    (let ((old (vector-ref v i)))
      (vector-set! v i x)
      (let ((res (fox v)))
        (set-fox! fv (diff i old res))
        res))))

(define (reroot! fv)
  (match (unfox fv)
    [(diff i x fv*)
     (reroot! fv*)
     (let ((v (unfox fv*)))
       (let ((x* (vector-ref v i)))
         (vector-set! v i x)
         (set-fox! fv v)
         (set-fox! fv* (diff i x* fv))))]
    [v (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)))))
|#