Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 83 lines (66 sloc) 1.938 kb
526763e @dherman created
authored
1 #lang racket/base
2
3 (require racket/match)
4
5 (provide (rename-out [array* array])
6 build-array
7 array-ref array-set
f986c24 @samth Add `array-for-each`.
samth authored
8 array-for-each
526763e @dherman created
authored
9 array-length array->list)
10
f986c24 @samth Add `array-for-each`.
samth authored
11 ;; TODO: array-map, array-foldl, array-foldr
526763e @dherman created
authored
12 ;; TODO: array, list->array
13
14 ;; (data a)
15 (define-struct array ([data #:mutable]))
16
17 ;; exact-nonnegative-integer * a * (data a)
18 (define-struct diff (index value data))
19
20 ;; (data a) ::= (vector a) | (diff a)
21
22 ;; exact-nonnegative-integer * a -> (array a)
23 (define array*
24 (procedure-rename
25 (lambda (n [x #f])
26 (make-array (make-vector n x)))
27 'array))
28
29 ;; exact-nonnegative-integer * (exact-nonnegative-integer -> a) -> (array a)
30 (define (build-array n proc)
31 (make-array (build-vector n proc)))
32
33 ;; (array a) -> void
34 (define (reroot! t)
35 (match (array-data t)
36 [(? vector?) (void)]
37 [(struct diff (i v t*))
38 (reroot! t*)
39 (let* ([n (array-data t*)]
40 [v* (vector-ref n i)])
41 (vector-set! n i v)
42 (set-array-data! t n)
43 (set-array-data! t* (make-diff i v* t)))]))
44
45 ;; (array a) * exact-nonnegative-integer -> a
46 (define (array-ref t i)
47 (let ([a (array-data t)])
48 (if (vector? a)
49 (vector-ref a i)
50 (begin
51 (reroot! t)
52 (vector-ref (array-data t) i)))))
53
54 ;; (array a) * exact-nonnegative-integer * a -> (array a)
55 (define (array-set t i v)
56 (reroot! t)
57 (let* ([n (array-data t)]
58 [old (vector-ref n i)])
59 (if (equal? old v)
60 t
61 (begin
62 (vector-set! n i v)
63 (let ([res (make-array n)])
64 (set-array-data! t (make-diff i old res))
65 res)))))
66
67 (define (impure f t)
68 (reroot! t)
69 (f (array-data t)))
70
71 (define (apply-impure f ts)
72 (for-each reroot! ts)
73 (apply f ts))
74
75 (define (array-length t)
76 (impure vector-length t))
77
78 (define (array->list t)
79 (impure vector->list t))
f986c24 @samth Add `array-for-each`.
samth authored
80
81 (define (array-for-each f t)
82 (impure (lambda (d) (vector-for-each d f)) t))
Something went wrong with that request. Please try again.