Skip to content
Browse files

created

  • Loading branch information...
0 parents commit 526763e6f9cd474e5eb50f71aad7cacd12d6fc5e @dherman committed
Showing with 90 additions and 0 deletions.
  1. +12 −0 README.md
  2. +78 −0 main.rkt
12 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).
78 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))

0 comments on commit 526763e

Please sign in to comment.
Something went wrong with that request. Please try again.