expander: fix incorrect addition of shifts
Commit 32b256886e
adds shifts in one place where it shoouldn't;
the "determinsitic-zo" test exposed the problem.
Also, avoid adding shifts that will have no effect, which avoids
accumulating useless shifts in some top-level contexts.
This commit is contained in:
parent
2cfd65e972
commit
8d56c29317
|
@ -122,6 +122,7 @@
|
|||
[self-mpi #:parent root-expand-context (root-expand-context-self-mpi root-ctx)]
|
||||
[module-scopes #:parent root-expand-context (root-expand-context-module-scopes root-ctx)]
|
||||
[post-expansion-scope #:parent root-expand-context (root-expand-context-post-expansion-scope root-ctx)]
|
||||
[post-expansion-shifts #:parent root-expand-context (root-expand-context-post-expansion-shifts root-ctx)]
|
||||
[top-level-bind-scope #:parent root-expand-context (root-expand-context-top-level-bind-scope root-ctx)]
|
||||
[all-scopes-stx #:parent root-expand-context (root-expand-context-all-scopes-stx root-ctx)]
|
||||
[use-site-scopes #:parent root-expand-context (root-expand-context-use-site-scopes root-ctx)]
|
||||
|
|
|
@ -159,18 +159,26 @@
|
|||
(non-source-shift from-mpi to-mpi)
|
||||
(cons from-mpi to-mpi)))
|
||||
(struct-copy syntax s
|
||||
[mpi-shifts (cons shift (syntax-mpi-shifts s))]
|
||||
[mpi-shifts (shift-cons shift (syntax-mpi-shifts s))]
|
||||
[inspector (or (syntax-inspector s)
|
||||
inspector)]
|
||||
[scope-propagations+tamper (if (datum-has-elements? (syntax-content s))
|
||||
(propagation-mpi-shift (syntax-scope-propagations+tamper s)
|
||||
(lambda (s) (cons shift s))
|
||||
(lambda (s) (shift-cons shift s))
|
||||
inspector
|
||||
(syntax-scopes s)
|
||||
(syntax-shifted-multi-scopes s)
|
||||
(syntax-mpi-shifts s))
|
||||
(syntax-scope-propagations+tamper s))])]))
|
||||
|
||||
(define (shift-cons shift shifts)
|
||||
(cond
|
||||
[(and (pair? shifts)
|
||||
(eq? (shift-from shift) (shift-from (car shifts))))
|
||||
;; Adding `shift` is not useful
|
||||
shifts]
|
||||
[else (cons shift shifts)]))
|
||||
|
||||
;; Use `resolve+shift` instead of `resolve` when the module of a
|
||||
;; module binding is relevant or when `free-identifier=?` equivalences
|
||||
;; (as installed by a binding to a rename transfomer) are relevant;
|
||||
|
|
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user