Skip to content

Commit 1ddbb79

Browse files
Copilotjackfirth
Copilot
and
jackfirth
authored
Extract source-analyze to separate analysis module (#666)
Co-authored-by: copilot-swe-agent[bot] <[email protected]> Co-authored-by: jackfirth <[email protected]>
1 parent a752c8e commit 1ddbb79

File tree

3 files changed

+237
-217
lines changed

3 files changed

+237
-217
lines changed

‎main.rkt‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -52,6 +52,7 @@
5252
rebellion/type/record
5353
resyntax/base
5454
resyntax/default-recommendations
55+
resyntax/private/analysis
5556
resyntax/private/comment-reader
5657
resyntax/private/git
5758
resyntax/private/limiting

‎private/analysis.rkt‎

Lines changed: 236 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,236 @@
1+
#lang racket/base
2+
3+
4+
(require racket/contract/base)
5+
6+
7+
(provide
8+
(contract-out
9+
[source-analyze (->* (source?) (#:lines range-set?) source-code-analysis?)]
10+
[source-code-analysis? (-> any/c boolean?)]
11+
[source-code-analysis-code (-> source-code-analysis? source?)]
12+
[source-code-analysis-visited-forms (-> source-code-analysis? (listof syntax?))]
13+
[source-code-analysis-expansion-time-output (-> source-code-analysis? immutable-string?)]
14+
[source-code-analysis-namespace (-> source-code-analysis? namespace?)]
15+
[source-code-analysis-added-syntax-properties (-> source-code-analysis? syntax-property-bundle?)]))
16+
17+
18+
(require guard
19+
racket/match
20+
racket/port
21+
racket/pretty
22+
racket/sequence
23+
racket/stream
24+
rebellion/base/comparator
25+
rebellion/base/immutable-string
26+
rebellion/base/option
27+
rebellion/base/range
28+
rebellion/collection/entry
29+
rebellion/collection/list
30+
rebellion/collection/range-set
31+
rebellion/collection/sorted-map
32+
rebellion/collection/sorted-set
33+
rebellion/collection/vector/builder
34+
rebellion/streaming/transducer
35+
rebellion/type/record
36+
resyntax/default-recommendations/analyzers/identifier-usage
37+
resyntax/default-recommendations/analyzers/ignored-result-values
38+
resyntax/default-recommendations/analyzers/variable-mutability
39+
resyntax/private/analyzer
40+
resyntax/private/linemap
41+
resyntax/private/logger
42+
resyntax/private/source
43+
resyntax/private/string-indent
44+
resyntax/private/syntax-movement
45+
resyntax/private/syntax-neighbors
46+
resyntax/private/syntax-path
47+
resyntax/private/syntax-property-bundle
48+
resyntax/private/syntax-traversal
49+
syntax/parse)
50+
51+
52+
;@----------------------------------------------------------------------------------------------------
53+
54+
55+
(define-record-type source-code-analysis
56+
(code visited-forms expansion-time-output namespace added-syntax-properties))
57+
58+
59+
(define (source-analyze code #:lines [lines (range-set (unbounded-range #:comparator natural<=>))])
60+
(define ns (make-base-namespace))
61+
(parameterize ([current-directory (or (source-directory code) (current-directory))]
62+
[current-namespace ns])
63+
(define code-linemap (string-linemap (source->string code)))
64+
(define program-stx (source-read-syntax code))
65+
(define program-source-name (syntax-source program-stx))
66+
(unless program-source-name
67+
(raise-arguments-error
68+
'source-analyze
69+
"cannot refactor given source code, the reader returned a syntax object without a source name"
70+
"source" code
71+
"reader-produced syntax object" program-stx))
72+
(log-resyntax-debug "original source name: ~a" program-source-name)
73+
(log-resyntax-debug "original syntax:\n ~a" program-stx)
74+
(define current-expand-observe (dynamic-require ''#%expobs 'current-expand-observe))
75+
(define original-visits (make-vector-builder))
76+
(define most-recent-visits-by-original-path (make-hash))
77+
78+
(define/guard (resyntax-should-analyze-syntax? stx #:as-visit? [as-visit? #true])
79+
(guard (syntax-original-and-from-source? stx program-source-name) #:else #false)
80+
(guard as-visit? #:else #true)
81+
(define stx-lines (syntax-line-range stx #:linemap code-linemap))
82+
(define overlaps? (range-set-overlaps? lines stx-lines))
83+
(unless overlaps?
84+
(log-resyntax-debug
85+
(string-append "ignoring visited syntax object because it's outside analyzed lines\n"
86+
" analyzed lines: ~a\n"
87+
" syntax lines: ~a\n"
88+
" syntax: ~a")
89+
lines
90+
stx-lines
91+
stx))
92+
overlaps?)
93+
94+
(define/match (observe-event! sig val)
95+
[('visit (? syntax? visited))
96+
(when (resyntax-should-analyze-syntax? visited)
97+
(vector-builder-add original-visits visited))
98+
(for ([visit-subform (in-stream (syntax-search-everything visited))]
99+
#:when (and (resyntax-should-analyze-syntax? visit-subform #:as-visit? #false)
100+
(syntax-has-original-path? visit-subform)))
101+
(define path (syntax-original-path visit-subform))
102+
(hash-set! most-recent-visits-by-original-path path visit-subform))]
103+
[(_ _) (void)])
104+
105+
(define output-port (open-output-string))
106+
(define expanded
107+
(parameterize ([current-expand-observe observe-event!]
108+
[current-output-port output-port])
109+
(expand program-stx)))
110+
111+
;; We evaluate the module in order to ensure it's declared in the namespace, then we attach it at
112+
;; expansion time to ensure the module is visited (but not instantiated). This allows refactoring
113+
;; rules to access expansion-time values reflectively via the analysis namespace.
114+
(eval expanded)
115+
(namespace-require/expansion-time (extract-module-require-spec expanded))
116+
117+
(define output (get-output-string output-port))
118+
(define movement-table (syntax-movement-table expanded))
119+
120+
(define property-selection-table
121+
(transduce movement-table
122+
(filtering
123+
(λ (e)
124+
(match-define (entry orig-path exp-paths) e)
125+
(match (sorted-set-size exp-paths)
126+
[1 #true]
127+
[0 #false]
128+
[_
129+
(log-resyntax-debug
130+
(string-append
131+
"ignoring expansion analyzer properties for original path ~a because"
132+
" multiple expanded forms claim to originate from that path")
133+
orig-path)
134+
#false])))
135+
(mapping-values (λ (exp-paths) (present-value (sorted-set-least-element exp-paths))))
136+
#:into (into-sorted-map syntax-path<=>)))
137+
138+
(define expansion-analyzer-props
139+
(transduce (sequence-append
140+
(syntax-property-bundle-entries
141+
(expansion-analyze identifier-usage-analyzer expanded))
142+
(syntax-property-bundle-entries
143+
(expansion-analyze ignored-result-values-analyzer expanded))
144+
(syntax-property-bundle-entries
145+
(expansion-analyze variable-mutability-analyzer expanded)))
146+
#:into into-syntax-property-bundle))
147+
148+
(define expansion-analyzer-props-adjusted-for-visits
149+
(transduce property-selection-table
150+
(mapping-values
151+
(λ (exp-path)
152+
(syntax-property-bundle-get-immediate-properties expansion-analyzer-props
153+
exp-path)))
154+
#:into property-hashes-into-syntax-property-bundle))
155+
156+
(when (log-level? resyntax-logger 'debug)
157+
(define props-str
158+
(string-indent (pretty-format expansion-analyzer-props-adjusted-for-visits) #:amount 2))
159+
(log-resyntax-debug "syntax properties from expansion analyzers:\n~a" props-str))
160+
161+
(define (enrich stx #:skip-root? [skip-root? #false])
162+
(syntax-traverse stx
163+
#:skip-root? skip-root?
164+
[child
165+
#:do [(define child-stx (attribute child))
166+
(define orig-path (syntax-original-path child-stx))]
167+
#:when (and orig-path (sorted-map-contains-key? movement-table orig-path))
168+
#:do [(define expansions
169+
(transduce (sorted-map-get movement-table orig-path)
170+
(mapping (λ (p) (syntax-ref expanded p)))
171+
(filtering syntax-original?)
172+
#:into into-list))]
173+
#:when (equal? (length expansions) 1)
174+
(match-define (list expanded-child) expansions)
175+
(log-resyntax-debug "enriching ~a with scopes from expansion" child-stx)
176+
(enrich (datum->syntax expanded-child (syntax-e child-stx) child-stx child-stx)
177+
#:skip-root? #true)]
178+
[child
179+
#:do [(define child-stx (attribute child))
180+
(define orig-path (syntax-original-path child-stx))]
181+
#:when (and orig-path (hash-has-key? most-recent-visits-by-original-path orig-path))
182+
#:do [(define visit (hash-ref most-recent-visits-by-original-path orig-path))]
183+
(log-resyntax-debug "enriching ~a with scopes from visit" child-stx)
184+
(enrich (datum->syntax visit (syntax-e child-stx) child-stx child-stx) #:skip-root? #true)]
185+
#:parent-context-modifier values
186+
#:parent-srcloc-modifier values
187+
#:parent-props-modifier values))
188+
189+
(define visited
190+
(transduce (build-vector original-visits)
191+
(peeking
192+
(λ (visit)
193+
(unless (syntax-original-path visit)
194+
(raise-arguments-error
195+
'source-analyze "pre-enriched visit is missing original path"
196+
"visited syntax" visit))))
197+
(deduplicating #:key syntax-original-path)
198+
(mapping
199+
(λ (visit)
200+
(define path (syntax-original-path visit))
201+
(define visit-props
202+
(syntax-property-bundle-get-all-properties
203+
expansion-analyzer-props-adjusted-for-visits path))
204+
(syntax-add-all-properties visit visit-props)))
205+
(mapping enrich)
206+
(peeking
207+
(λ (visit)
208+
(unless (syntax-original-path visit)
209+
(raise-arguments-error
210+
'source-analyze "post-enriched visit is missing original path"
211+
"visited syntax" visit))))
212+
(sorting syntax-path<=> #:key syntax-original-path)
213+
#:into into-list))
214+
215+
(log-resyntax-debug "visited ~a forms" (length visited))
216+
(source-code-analysis #:code code
217+
#:visited-forms visited
218+
#:expansion-time-output output
219+
#:namespace ns
220+
#:added-syntax-properties expansion-analyzer-props-adjusted-for-visits)))
221+
222+
223+
(define (syntax-original-and-from-source? stx source-name)
224+
(and (syntax-original? stx)
225+
;; Some macros are able to bend hygiene and syntax properties in such a way that they
226+
;; introduce syntax objects into the program that are syntax-original?, but from a
227+
;; different file than the one being expanded. So in addition to checking for
228+
;; originality, we also check that they come from the same source as the main program
229+
;; syntax object. The (open ...) clause of the define-signature macro bends hygiene
230+
;; in this way, and is what originally motivated the addition of this check.
231+
(equal? (syntax-source stx) source-name)))
232+
233+
234+
(define (extract-module-require-spec mod-stx)
235+
(syntax-parse mod-stx
236+
[(_ name _ . _) `',(syntax-e #'name)]))

0 commit comments

Comments
 (0)