|
1 | 1 | #lang racket |
2 | 2 |
|
3 | 3 | (require "../syntax/syntax.rkt" |
4 | | - "../utils/common.rkt") |
| 4 | + "../utils/common.rkt" |
| 5 | + "../utils/alternative.rkt") ; for unbatchify-alts |
5 | 6 |
|
6 | | -(provide progs->batch ; (Listof Expr) -> Batch |
7 | | - batch->progs ; Batch -> ?(or (Listof Root) (Vectorof Root)) -> (Listof Expr) |
| 7 | +(provide progs->batch ; List<Expr> -> Batch |
| 8 | + batch->progs ; Batch -> ?(or List<Root> Vector<Root>) -> List<Expr> |
8 | 9 | (struct-out batch) |
9 | | - (struct-out batchref) ; temporarily for patch.rkt |
10 | | - (struct-out mutable-batch) ; temporarily for patch.rkt |
| 10 | + (struct-out batchref) |
| 11 | + (struct-out mutable-batch) |
11 | 12 | batch-length ; Batch -> Integer |
12 | 13 | batch-tree-size ; Batch -> Integer |
13 | 14 | batch-free-vars |
14 | 15 | batch-ref ; Batch -> Idx -> Expr |
15 | 16 | deref ; Batchref -> Expr |
16 | 17 | batch-replace ; Batch -> (Expr<Batchref> -> Expr<Batchref>) -> Batch |
17 | 18 | debatchref ; Batchref -> Expr |
18 | | - batch-remove-zombie ; Batch -> ?(Vectorof Root) -> Batch |
| 19 | + batch-alive-nodes ; Batch -> ?Vector<Root> -> Vector<Idx> |
| 20 | + batch-reconstruct-exprs ; Batch -> Vector<Expr> |
| 21 | + batch-remove-zombie ; Batch -> ?Vector<Root> -> Batch |
19 | 22 | mutable-batch-munge! ; Mutable-batch -> Expr -> Root |
20 | 23 | make-mutable-batch ; Mutable-batch |
21 | 24 | batch->mutable-batch ; Batch -> Mutable-batch |
22 | 25 | batch-copy-mutable-nodes! ; Batch -> Mutable-batch -> Void |
23 | 26 | mutable-batch-push! ; Mutable-batch -> Node -> Idx |
24 | | - batch-copy) |
| 27 | + batch-copy |
| 28 | + unbatchify-alts) |
| 29 | + |
| 30 | +;; Batches store these recursive structures, flattened |
| 31 | +(struct batch ([nodes #:mutable] [roots #:mutable])) |
| 32 | + |
| 33 | +(struct mutable-batch ([nodes #:mutable] [index #:mutable] cache)) |
| 34 | + |
| 35 | +(struct batchref (batch idx) #:transparent) |
25 | 36 |
|
26 | 37 | ;; This function defines the recursive structure of expressions |
27 | 38 | (define (expr-recurse expr f) |
|
31 | 42 | [(list op args ...) (cons op (map f args))] |
32 | 43 | [_ expr])) |
33 | 44 |
|
34 | | -;; Batches store these recursive structures, flattened |
35 | | -(struct batch ([nodes #:mutable] [roots #:mutable])) |
| 45 | +;; Converts batchrefs of altns into expressions, assuming that batchrefs refer to batch |
| 46 | +(define (unbatchify-alts batch altns) |
| 47 | + (define exprs (batch-reconstruct-exprs batch)) |
| 48 | + (define (unmunge altn) |
| 49 | + (define expr (alt-expr altn)) |
| 50 | + (match expr |
| 51 | + [(? batchref?) |
| 52 | + (define expr* (vector-ref exprs (batchref-idx expr))) |
| 53 | + (struct-copy alt altn [expr expr*])] |
| 54 | + [_ altn])) |
| 55 | + (map (curry alt-map unmunge) altns)) |
36 | 56 |
|
37 | 57 | (define (batch-length b) |
38 | 58 | (cond |
39 | 59 | [(batch? b) (vector-length (batch-nodes b))] |
40 | 60 | [(mutable-batch? b) (hash-count (mutable-batch-index b))] |
41 | 61 | [else (error 'batch-length "Invalid batch" b)])) |
42 | 62 |
|
43 | | -(struct mutable-batch ([nodes #:mutable] [index #:mutable] cache)) |
44 | | - |
45 | 63 | (define (make-mutable-batch) |
46 | 64 | (mutable-batch '() (make-hash) (make-hasheq))) |
47 | 65 |
|
|
67 | 85 | (define (batch-copy b) |
68 | 86 | (batch (vector-copy (batch-nodes b)) (vector-copy (batch-roots b)))) |
69 | 87 |
|
70 | | -(struct batchref (batch idx) #:transparent) |
71 | | - |
72 | 88 | (define (deref x) |
73 | 89 | (match-define (batchref b idx) x) |
74 | 90 | (expr-recurse (vector-ref (batch-nodes b) idx) (lambda (ref) (batchref b ref)))) |
|
105 | 121 | (munge expr)) |
106 | 122 |
|
107 | 123 | (define (batch->progs b [roots (batch-roots b)]) |
108 | | - (define exprs (make-vector (batch-length b))) |
109 | | - (for ([node (in-vector (batch-nodes b))] |
110 | | - [idx (in-naturals)]) |
111 | | - (vector-set! exprs idx (expr-recurse node (lambda (x) (vector-ref exprs x))))) |
| 124 | + (define exprs (batch-reconstruct-exprs b)) |
112 | 125 | (for/list ([root roots]) |
113 | 126 | (vector-ref exprs root))) |
114 | 127 |
|
|
146 | 159 | (define roots (vector-map (curry vector-ref mapping) (batch-roots b))) |
147 | 160 | (mutable-batch->batch out roots)) |
148 | 161 |
|
149 | | -; The function removes any zombie nodes from batch with respect to the roots |
150 | | -; Time complexity: O(|R| + |N|), where |R| - number of roots, |N| - length of nodes |
151 | | -; Space complexity: O(|N| + |N*| + |R|), where |N*| is a length of nodes without zombie nodes |
152 | | -; The flag keep-vars is used in compiler.rkt when vars should be preserved no matter what |
153 | | -(define (batch-remove-zombie input-batch [roots (batch-roots input-batch)] #:keep-vars [keep-vars #f]) |
154 | | - (define nodes (batch-nodes input-batch)) |
155 | | - (define nodes-length (batch-length input-batch)) |
| 162 | +;; Function returns indices of alive nodes within a batch for given roots, |
| 163 | +;; where alive node is a child of a root + meets a condition - (condition node) |
| 164 | +(define (batch-alive-nodes batch |
| 165 | + [roots (batch-roots batch)] |
| 166 | + #:keep-vars-alive [keep-vars-alive #f] |
| 167 | + #:condition [condition (const #t)]) |
| 168 | + (define nodes (batch-nodes batch)) |
| 169 | + (define nodes-length (batch-length batch)) |
| 170 | + (define alive-mask (make-vector nodes-length #f)) |
| 171 | + (for ([root (in-vector roots)]) |
| 172 | + (vector-set! alive-mask root #t)) |
| 173 | + (for ([i (in-range (- nodes-length 1) -1 -1)] |
| 174 | + [node (in-vector nodes (- nodes-length 1) -1 -1)] |
| 175 | + [alv (in-vector alive-mask (- nodes-length 1) -1 -1)] |
| 176 | + #:when (or (and alv (condition node)) (and keep-vars-alive (symbol? node)))) |
| 177 | + (unless alv ; if keep-vars-alive then alv may not be #t, making sure it's #t |
| 178 | + (vector-set! alive-mask i #t)) |
| 179 | + (expr-recurse node |
| 180 | + (λ (n) |
| 181 | + (when (condition (vector-ref nodes n)) |
| 182 | + (vector-set! alive-mask n #t))))) |
| 183 | + ; Return indices of alive nodes in ascending order |
| 184 | + (for/vector ([alv (in-vector alive-mask)] |
| 185 | + [i (in-naturals)] |
| 186 | + #:when alv) |
| 187 | + i)) |
| 188 | + |
| 189 | +;; Function constructs a vector of expressions for the given nodes of a batch |
| 190 | +(define (batch-reconstruct-exprs batch) |
| 191 | + (define exprs (make-vector (batch-length batch))) |
| 192 | + (for ([node (in-vector (batch-nodes batch))] |
| 193 | + [idx (in-naturals)]) |
| 194 | + (vector-set! exprs idx (expr-recurse node (lambda (x) (vector-ref exprs x))))) |
| 195 | + exprs) |
| 196 | + |
| 197 | +;; The function removes any zombie nodes from batch with respect to the roots |
| 198 | +;; Time complexity: O(|R| + |N|), where |R| - number of roots, |N| - length of nodes |
| 199 | +;; Space complexity: O(|N| + |N*| + |R|), where |N*| is a length of nodes without zombie nodes |
| 200 | +;; The flag keep-vars is used in compiler.rkt when vars should be preserved no matter what |
| 201 | +(define (batch-remove-zombie batch [roots (batch-roots batch)] #:keep-vars [keep-vars #f]) |
| 202 | + (define nodes (batch-nodes batch)) |
| 203 | + (define nodes-length (batch-length batch)) |
156 | 204 | (match (zero? nodes-length) |
157 | 205 | [#f |
158 | | - (define zombie-mask (make-vector nodes-length #t)) |
159 | | - (for ([root (in-vector roots)]) |
160 | | - (vector-set! zombie-mask root #f)) |
161 | | - (for ([i (in-range (- nodes-length 1) -1 -1)] |
162 | | - [node (in-vector nodes (- nodes-length 1) -1 -1)] |
163 | | - [zmb (in-vector zombie-mask (- nodes-length 1) -1 -1)]) |
164 | | - (when (and keep-vars (symbol? node)) |
165 | | - (vector-set! zombie-mask i #f)) |
166 | | - (unless zmb |
167 | | - (expr-recurse node (λ (n) (vector-set! zombie-mask n #f))))) |
| 206 | + (define alive-nodes (batch-alive-nodes batch roots #:keep-vars-alive keep-vars)) |
168 | 207 |
|
169 | 208 | (define mappings (make-vector nodes-length -1)) |
170 | 209 | (define (remap idx) |
171 | 210 | (vector-ref mappings idx)) |
172 | 211 |
|
173 | 212 | (define out (make-mutable-batch)) |
174 | | - (for ([node (in-vector nodes)] |
175 | | - [zmb (in-vector zombie-mask)] |
176 | | - [n (in-naturals)] |
177 | | - #:unless zmb) |
178 | | - (vector-set! mappings n (mutable-batch-push! out (expr-recurse node remap)))) |
| 213 | + (for ([alv (in-vector alive-nodes)]) |
| 214 | + (define node (vector-ref nodes alv)) |
| 215 | + (vector-set! mappings alv (mutable-batch-push! out (expr-recurse node remap)))) |
179 | 216 |
|
180 | 217 | (define roots* (vector-map (curry vector-ref mappings) roots)) |
181 | 218 | (mutable-batch->batch out roots*)] |
182 | | - [#t (batch-copy input-batch)])) |
| 219 | + [#t (batch-copy batch)])) |
183 | 220 |
|
184 | 221 | (define (batch-ref batch reg) |
185 | 222 | (define (unmunge reg) |
|
0 commit comments