macro-stepper: added emit-local-step
original commit: 3d21f97f3f7fe71663a6224ee28bb47ecae44ff1
This commit is contained in:
parent
54d3e93501
commit
f4d14edaac
|
@ -4,7 +4,9 @@
|
||||||
(provide/contract
|
(provide/contract
|
||||||
[emit-remark
|
[emit-remark
|
||||||
(->* () (#:unmark? any/c) #:rest (listof (or/c string? syntax?))
|
(->* () (#:unmark? any/c) #:rest (listof (or/c string? syntax?))
|
||||||
any)])
|
any)]
|
||||||
|
[emit-local-step
|
||||||
|
(-> syntax? syntax? #:id identifier? any)])
|
||||||
|
|
||||||
(define current-expand-observe
|
(define current-expand-observe
|
||||||
(dynamic-require ''#%expobs 'current-expand-observe))
|
(dynamic-require ''#%expobs 'current-expand-observe))
|
||||||
|
@ -20,3 +22,11 @@
|
||||||
arg))
|
arg))
|
||||||
args)])
|
args)])
|
||||||
(observe 'local-remark args)))))
|
(observe 'local-remark args)))))
|
||||||
|
|
||||||
|
(define (emit-local-step before after #:id id)
|
||||||
|
(let ([observe (current-expand-observe)])
|
||||||
|
(when observe
|
||||||
|
(observe 'local-artificial-step
|
||||||
|
(list (list id)
|
||||||
|
before (syntax-local-introduce before)
|
||||||
|
(syntax-local-introduce after) after)))))
|
||||||
|
|
|
@ -142,6 +142,17 @@ transformer returns. Unmarking is suppressed if @scheme[unmark?] is
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@defproc[(emit-local-step [before syntax?] [after syntax?]
|
||||||
|
[#:id id identifier?])
|
||||||
|
void?]{
|
||||||
|
|
||||||
|
Emits an event that simulates a local expansion step from
|
||||||
|
@scheme[before] to @scheme[after].
|
||||||
|
|
||||||
|
The @scheme[id] argument acts as the step's ``macro'' for the purposes
|
||||||
|
of macro hiding.
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
@section{Macro stepper text interface}
|
@section{Macro stepper text interface}
|
||||||
|
|
||||||
|
|
|
@ -204,6 +204,18 @@
|
||||||
(make local-bind $1 #f $2 $3)]
|
(make local-bind $1 #f $2 $3)]
|
||||||
[(local-remark)
|
[(local-remark)
|
||||||
(make local-remark $1)]
|
(make local-remark $1)]
|
||||||
|
[(local-artificial-step)
|
||||||
|
(let ([ids (list-ref $1 0)]
|
||||||
|
[before (list-ref $1 1)]
|
||||||
|
[mbefore (list-ref $1 2)]
|
||||||
|
[mafter (list-ref $1 3)]
|
||||||
|
[after (list-ref $1 4)])
|
||||||
|
(make local-expansion
|
||||||
|
before after #f mbefore
|
||||||
|
(make mrule mbefore mafter ids #f
|
||||||
|
before null after #f mafter
|
||||||
|
(make p:stop mafter mafter null #f))
|
||||||
|
#f after #f))]
|
||||||
;; -- Not really local actions, but can occur during evaluation
|
;; -- Not really local actions, but can occur during evaluation
|
||||||
;; called 'expand' (not 'local-expand') within transformer
|
;; called 'expand' (not 'local-expand') within transformer
|
||||||
[(start (? EE)) #f]
|
[(start (? EE)) #f]
|
||||||
|
|
|
@ -61,6 +61,7 @@
|
||||||
top-non-begin ; .
|
top-non-begin ; .
|
||||||
|
|
||||||
local-remark ; (listof (U string syntax))
|
local-remark ; (listof (U string syntax))
|
||||||
|
local-artificial-step ; (list syntax syntax syntax syntax)
|
||||||
))
|
))
|
||||||
|
|
||||||
(define-tokens renames-tokens
|
(define-tokens renames-tokens
|
||||||
|
@ -96,6 +97,7 @@
|
||||||
(#f top-begin ,token-top-begin)
|
(#f top-begin ,token-top-begin)
|
||||||
(#f top-non-begin ,token-top-non-begin)
|
(#f top-non-begin ,token-top-non-begin)
|
||||||
(#f local-remark ,token-local-remark)
|
(#f local-remark ,token-local-remark)
|
||||||
|
(#f local-artificial-step ,token-local-artificial-step)
|
||||||
|
|
||||||
;; Standard signals
|
;; Standard signals
|
||||||
(0 visit ,token-visit)
|
(0 visit ,token-visit)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user