|
135 | 135 | (log-resyntax-debug "original source name: ~a" program-source-name) |
136 | 136 | (log-resyntax-debug "original syntax:\n ~a" program-stx) |
137 | 137 | (define current-expand-observe (dynamic-require ''#%expobs 'current-expand-observe)) |
138 | | - (define visited-syntaxes (make-mutable-sorted-map #:key-comparator syntax-path<=>)) |
139 | | - (define context-syntaxes (make-mutable-sorted-map #:key-comparator syntax-path<=>)) |
| 138 | + ;; These are hashes rather than sorted maps because expansion writes to them far more often than |
| 139 | + ;; anything reads from them: every observed visit event records the visited form and every |
| 140 | + ;; original subform within it, and expansion visits nested forms repeatedly. Keeping them sorted |
| 141 | + ;; on every write means running syntax-path<=> a logarithmic number of times per write, whereas |
| 142 | + ;; the two places that need sorted access can sort once after expansion finishes. |
| 143 | + (define visited-syntaxes (make-hash)) |
| 144 | + (define context-syntaxes (make-hash)) |
140 | 145 |
|
141 | 146 | (define/guard (resyntax-should-analyze-syntax? stx #:as-visit? [as-visit? #true]) |
142 | 147 | (guard (syntax-original-and-from-source? stx program-source-name) #:else #false) |
|
162 | 167 | (raise-arguments-error |
163 | 168 | 'source-analyze "visit is missing original path" |
164 | 169 | "visited syntax" visited)) |
165 | | - (sorted-map-put-if-absent! visited-syntaxes visited-path visited)) |
| 170 | + (unless (hash-has-key? visited-syntaxes visited-path) |
| 171 | + (hash-set! visited-syntaxes visited-path visited))) |
166 | 172 | (for ([visit-subform (in-stream (syntax-search-everything visited))] |
167 | 173 | #:when (and (resyntax-should-analyze-syntax? visit-subform #:as-visit? #false) |
168 | 174 | (syntax-has-original-path? visit-subform))) |
169 | 175 | (define path (syntax-original-path visit-subform)) |
170 | | - (sorted-map-put! context-syntaxes path visit-subform))] |
| 176 | + (hash-set! context-syntaxes path visit-subform))] |
171 | 177 | [(_ _) (void)]) |
172 | 178 |
|
173 | 179 | (define output-port (open-output-string)) |
|
176 | 182 | [current-output-port output-port]) |
177 | 183 | (expand program-stx))) |
178 | 184 |
|
179 | | - (define visited-paths (sorted-set->immutable-sorted-set (sorted-map-keys visited-syntaxes))) |
| 185 | + (define visited-paths |
| 186 | + (transduce (in-hash-keys visited-syntaxes) #:into (into-sorted-set syntax-path<=>))) |
180 | 187 |
|
181 | 188 | ;; We evaluate the module in order to ensure it's declared in the namespace, then we attach it at |
182 | 189 | ;; expansion time to ensure the module is visited (but not instantiated). This allows refactoring |
|
205 | 212 | orig-path)) |
206 | 213 | (when (equal? num-orig-paths 1) |
207 | 214 | (define exp-path (present-value (sorted-set-least-element exp-paths))) |
208 | | - (sorted-map-put! context-syntaxes orig-path (syntax-ref expanded exp-path)))) |
| 215 | + (hash-set! context-syntaxes orig-path (syntax-ref expanded exp-path)))) |
| 216 | + |
| 217 | + (define sorted-context-syntaxes |
| 218 | + (transduce (in-hash-pairs context-syntaxes) |
| 219 | + (mapping (λ (path-and-syntax) |
| 220 | + (entry (car path-and-syntax) (cdr path-and-syntax)))) |
| 221 | + #:into (into-sorted-map syntax-path<=>))) |
209 | 222 |
|
210 | 223 | (define enriched-program-stx-without-analyzer-props |
211 | 224 | (for/fold ([program-stx program-stx]) |
212 | | - ([e (in-sorted-map context-syntaxes)]) |
| 225 | + ([e (in-sorted-map sorted-context-syntaxes)]) |
213 | 226 | (match-define (entry orig-path context-stx) e) |
214 | 227 | (define child-stx (syntax-ref program-stx orig-path)) |
215 | | - (define stx-to-use-for-props (sorted-map-get visited-syntaxes orig-path child-stx)) |
| 228 | + (define stx-to-use-for-props (hash-ref visited-syntaxes orig-path child-stx)) |
216 | 229 | (define enriched-child |
217 | 230 | (datum->syntax context-stx (syntax-e child-stx) child-stx stx-to-use-for-props)) |
218 | 231 | (syntax-set program-stx orig-path enriched-child))) |
|
0 commit comments