macro-debugger/emit: more flexible arguments for emit-remark
original commit: e7e990cc78be6d80f674922be267dca9a357dd4a
This commit is contained in:
parent
8cdf572246
commit
d23cb24353
|
@ -1,26 +1,13 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require racket/contract/base)
|
(require racket/contract/base)
|
||||||
|
|
||||||
(provide/contract
|
|
||||||
[emit-remark
|
|
||||||
(->* () (#:unmark? any/c) #:rest (listof (or/c string? syntax?))
|
|
||||||
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))
|
||||||
|
|
||||||
(define (emit-remark #:unmark? [unmark? #t] . args)
|
(define (emit-remark #:unmark? [unmark? (syntax-transforming?)] . args)
|
||||||
(let ([observe (current-expand-observe)])
|
(let ([observe (current-expand-observe)])
|
||||||
(when observe
|
(when observe
|
||||||
(let ([args
|
(let ([args (flatten-emit-args args unmark?)])
|
||||||
(if unmark?
|
|
||||||
(for/list ([arg (in-list args)])
|
|
||||||
(if (syntax? arg)
|
|
||||||
(syntax-local-introduce arg)
|
|
||||||
arg))
|
|
||||||
args)])
|
|
||||||
(observe 'local-remark args)))))
|
(observe 'local-remark args)))))
|
||||||
|
|
||||||
(define (emit-local-step before after #:id id)
|
(define (emit-local-step before after #:id id)
|
||||||
|
@ -30,3 +17,29 @@
|
||||||
(list (list id)
|
(list (list id)
|
||||||
before (syntax-local-introduce before)
|
before (syntax-local-introduce before)
|
||||||
(syntax-local-introduce after) after)))))
|
(syntax-local-introduce after) after)))))
|
||||||
|
|
||||||
|
(define emit-arg/c
|
||||||
|
(recursive-contract
|
||||||
|
(or/c string?
|
||||||
|
syntax?
|
||||||
|
(listof emit-arg/c)
|
||||||
|
(-> emit-arg/c))))
|
||||||
|
|
||||||
|
(define (flatten-emit-args x unmark?)
|
||||||
|
(define (loop x onto)
|
||||||
|
(cond [(string? x)
|
||||||
|
(cons x onto)]
|
||||||
|
[(syntax? x)
|
||||||
|
(cons (if unmark? (syntax-local-introduce x) x) onto)]
|
||||||
|
[(list? x)
|
||||||
|
(foldr loop onto x)]
|
||||||
|
[(procedure? x)
|
||||||
|
(loop (x) onto)]))
|
||||||
|
(loop x null))
|
||||||
|
|
||||||
|
(provide/contract
|
||||||
|
[emit-remark
|
||||||
|
(->* () (#:unmark? any/c) #:rest (listof emit-arg/c)
|
||||||
|
any)]
|
||||||
|
[emit-local-step
|
||||||
|
(-> syntax? syntax? #:id identifier? any)])
|
||||||
|
|
|
@ -114,8 +114,15 @@ result as the original syntax.
|
||||||
Macros can explicitly send information to a listening macro stepper by
|
Macros can explicitly send information to a listening macro stepper by
|
||||||
using the procedures in this module.
|
using the procedures in this module.
|
||||||
|
|
||||||
@defproc[(emit-remark [fragment (or/c syntax? string?)] ...
|
@defproc[(emit-remark [fragment
|
||||||
[#:unmark? unmark? boolean? #t])
|
(letrec ([emit-arg/c
|
||||||
|
(recursive-contract
|
||||||
|
(or/c string?
|
||||||
|
syntax?
|
||||||
|
(listof emit-arg/c)
|
||||||
|
(-> emit-arg/c)))])
|
||||||
|
emit-arg/c)] ...
|
||||||
|
[#:unmark? unmark? boolean? (syntax-transforming?)])
|
||||||
void?]{
|
void?]{
|
||||||
|
|
||||||
Emits an event to the macro stepper (if one is listening) containing
|
Emits an event to the macro stepper (if one is listening) containing
|
||||||
|
|
Loading…
Reference in New Issue
Block a user