array/dynamic.rkt at master · rvs314/array · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
#lang racket/base

(require "array.rkt" racket/generic racket/stream)

(provide (except-out (struct-out dynamic-array) dynamic-array)
         (rename-out [new-dynamic-array dynamic-array])
         dynamic-array-capacity dynamic-array-ensure-capacity!
         dynamic-array-append! dynamic-array-push! dynamic-array-pop!
         dynamic-array-contents)

(struct dynamic-array (buffer length)
  #:mutable
  #:methods gen:custom-write
  [(define (write-proc me port mode)
     (define v (dynamic-array-contents me))
     (case mode
       [(#t)  (write v port)]
       [(#f)  (display v port)]
       [(0 1) (print v port mode)]))]
  #:methods gen:equal-mode+hash
  [(define (equal-mode-proc me them rec just-for-now?)
     (if just-for-now?
         (and (= (dynamic-array-length me) (dynamic-array-length them))
              (for/and ([m (in-array me)]
                        [t (in-array them)])
                (rec m t)))
         (eq? me them)))
   (define (hash-mode-proc me rec just-for-now?)
     (if just-for-now?
         (rec (dynamic-array-contents me))
         (eq-hash-code me)))]
  #:methods gen:array
  [(define/generic len array-length)
   (define/generic ref array-ref)
   (define/generic set! array-set!)
   (define/generic copy! array-copy!)
   (define/generic alloc array-alloc)
   (define/generic in in-array)
   (define (array-length arr)
     (dynamic-array-length arr))
   (define (array-ref array idx)
     (ref (dynamic-array-buffer array) idx))
   (define (array-set! array idx val)
     (set! (dynamic-array-buffer array) idx val))
   (define (array-copy! dest dest-start src
                        [src-start 0] [src-end (dynamic-array-length src)])
     (copy! dest dest-start (dynamic-array-buffer src)
            src-start src-end))
   (define (array-alloc array len)
     (dynamic-array (alloc (dynamic-array-buffer array) len) len))
   (define (in-array arr)
     (stream-take (sequence->stream (in (dynamic-array-buffer arr)))
                  (dynamic-array-length arr)))])

(define (new-dynamic-array arr [len (array-length arr)])
  (when (> len (array-length arr))
    (raise-argument-error
     'dynamic-array
     "a dynamic array length less than that of the underlying buffer"
     1 arr len))
  (dynamic-array arr len))

(define (dynamic-array-capacity arr)
  (array-length (dynamic-array-buffer arr)))

(define minimum-dynamic-array-capacity 8)

(define (dynamic-array-ensure-capacity! arr min-cap)
  (define old-cap (dynamic-array-capacity arr))
  (define new-cap
    (let loop ([cap old-cap])
      (if (< cap min-cap)
          (loop (max minimum-dynamic-array-capacity (floor (* 3/2 cap))))
          cap)))
  (unless (= new-cap old-cap)
    (define new-buff (array-alloc (dynamic-array-buffer arr) new-cap))
    (array-copy! new-buff 0 (dynamic-array-buffer arr)
                 0 (dynamic-array-length arr))
    (set-dynamic-array-buffer! arr new-buff)))

(define (dynamic-array-append! arr new-values)
  (define len (dynamic-array-length arr))
  (define new-len (+ len (array-length new-values)))
  (dynamic-array-ensure-capacity! arr new-len)
  (array-copy! (dynamic-array-buffer arr) len new-values)
  (set-dynamic-array-length! arr new-len))

(define (dynamic-array-push! arr new-value)
  (define idx (dynamic-array-length arr))
  (dynamic-array-ensure-capacity! arr (add1 idx))
  (set-dynamic-array-length! arr (add1 idx))
  (array-set! arr idx new-value)
  idx)

(define (dynamic-array-pop! arr)
  (when (array-empty? arr)
    (raise-argument-error 'dynamic-array-pop! "a non-empty array" 0 arr))
  (define idx (sub1 (dynamic-array-length arr)))
  (set-dynamic-array-length! arr idx)
  (array-ref arr idx))

(define (dynamic-array-contents arr)
  (define res (array-alloc (dynamic-array-buffer arr)
                           (dynamic-array-length arr)))
  (array-copy! res 0 (dynamic-array-buffer arr) 0 (dynamic-array-length arr))
  res)

(module+ test
  (require rackunit racket/function)

  (define da (new-dynamic-array "four"))

  (check-equal? da da)
  (check equal-always? da da)
  (check-equal? (equal-hash-code da) (equal-hash-code da))

  (define db (new-dynamic-array "four"))

  (check-equal? da db)
  (check (negate equal-always?) da db)
  (check-equal? (equal-hash-code da) (equal-hash-code db))
  (check (negate equal?) (equal-always-hash-code da) (equal-always-hash-code db))

  (check-equal? (dynamic-array-contents db) "four")
  (dynamic-array-push! db #\t)
  (check-equal? (dynamic-array-contents db) "fourt")
  (dynamic-array-append! db "hy")
  (check-equal? (dynamic-array-contents db) "fourthy")

  (check-equal? (dynamic-array-pop! db) #\y)
  (check-equal? (dynamic-array-contents db) "fourth"))