created

README.md

@@ -0,0 +1,12 @@
+## array.rkt
+
+An efficient functional array, based on
+[Jean-Christophe Filliâtre](http://www.lri.fr/~filliatr/puf/)'s
+[http://www.lri.fr/~filliatr/ftp/ocaml/ds/parray.ml.html](parray) data structure
+from [ML Workshop 2007](http://www.lri.fr/~filliatr/ftp/publis/puf-wml07.ps).
+
+## License
+
+Copyright © 2012 Dave Herman
+
+Licensed under the [LGPL 2.1](http://www.gnu.org/licenses/lgpl-2.1.html).

main.rkt

@@ -0,0 +1,78 @@
+#lang racket/base
+
+(require racket/match)
+
+(provide (rename-out [array* array])
+         build-array
+         array-ref array-set
+         array-length array->list)
+
+;; TODO: array-for-each, array-map, array-foldl, array-foldr
+;; TODO: array, list->array
+
+;; (data a)
+(define-struct array ([data #:mutable]))
+
+;; exact-nonnegative-integer * a * (data a)
+(define-struct diff (index value data))
+
+;; (data a) ::= (vector a) | (diff a)
+
+;; exact-nonnegative-integer * a -> (array a)
+(define array*
+  (procedure-rename
+   (lambda (n [x #f])
+     (make-array (make-vector n x)))
+   'array))
+
+;; exact-nonnegative-integer * (exact-nonnegative-integer -> a) -> (array a)
+(define (build-array n proc)
+  (make-array (build-vector n proc)))
+
+;; (array a) -> void
+(define (reroot! t)
+  (match (array-data t)
+    [(? vector?) (void)]
+    [(struct diff (i v t*))
+     (reroot! t*)
+     (let* ([n (array-data t*)]
+            [v* (vector-ref n i)])
+       (vector-set! n i v)
+       (set-array-data! t n)
+       (set-array-data! t* (make-diff i v* t)))]))
+
+;; (array a) * exact-nonnegative-integer -> a
+(define (array-ref t i)
+  (let ([a (array-data t)])
+    (if (vector? a)
+        (vector-ref a i)
+        (begin
+          (reroot! t)
+          (vector-ref (array-data t) i)))))
+
+;; (array a) * exact-nonnegative-integer * a -> (array a)
+(define (array-set t i v)
+  (reroot! t)
+  (let* ([n (array-data t)]
+         [old (vector-ref n i)])
+    (if (equal? old v)
+        t
+        (begin
+          (vector-set! n i v)
+          (let ([res (make-array n)])
+            (set-array-data! t (make-diff i old res))
+            res)))))
+
+(define (impure f t)
+  (reroot! t)
+  (f (array-data t)))
+
+(define (apply-impure f ts)
+  (for-each reroot! ts)
+  (apply f ts))
+
+(define (array-length t)
+  (impure vector-length t))
+
+(define (array->list t)
+  (impure vector->list t))