macro-stepper: added emit-local-step

original commit: 3d21f97f3f7fe71663a6224ee28bb47ecae44ff1
This commit is contained in:
Ryan Culpepper 2010-06-10 16:40:52 -06:00
parent 54d3e93501
commit f4d14edaac
4 changed files with 36 additions and 1 deletions

View File

@ -4,7 +4,9 @@
(provide/contract
[emit-remark
(->* () (#:unmark? any/c) #:rest (listof (or/c string? syntax?))
any)])
any)]
[emit-local-step
(-> syntax? syntax? #:id identifier? any)])
(define current-expand-observe
(dynamic-require ''#%expobs 'current-expand-observe))
@ -20,3 +22,11 @@
arg))
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)))))

View File

@ -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}

View File

@ -204,6 +204,18 @@
(make local-bind $1 #f $2 $3)]
[(local-remark)
(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
;; called 'expand' (not 'local-expand') within transformer
[(start (? EE)) #f]

View File

@ -61,6 +61,7 @@
top-non-begin ; .
local-remark ; (listof (U string syntax))
local-artificial-step ; (list syntax syntax syntax syntax)
))
(define-tokens renames-tokens
@ -96,6 +97,7 @@
(#f top-begin ,token-top-begin)
(#f top-non-begin ,token-top-non-begin)
(#f local-remark ,token-local-remark)
(#f local-artificial-step ,token-local-artificial-step)
;; Standard signals
(0 visit ,token-visit)