macro-debugger/expand: added new expand function with docs
svn: r11578 original commit: 402697e2d48356c0c35264cfa3c473bdd44312e2
This commit is contained in:
parent
6fcdf2701d
commit
c5579d0bab
|
@ -1,28 +1,32 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
(require "model/trace.ss"
|
(require scheme/contract
|
||||||
|
"model/trace.ss"
|
||||||
"model/reductions-config.ss"
|
"model/reductions-config.ss"
|
||||||
"model/reductions.ss")
|
"model/reductions.ss")
|
||||||
|
|
||||||
(provide expand-only
|
(provide/contract
|
||||||
expand/hide)
|
[expand-only
|
||||||
|
(any/c (listof identifier?) . -> . syntax?)]
|
||||||
|
[expand/hide
|
||||||
|
(any/c (listof identifier?) . -> . syntax?)]
|
||||||
|
[expand/show-predicate
|
||||||
|
(any/c (-> identifier? any/c) . -> . syntax?)])
|
||||||
|
|
||||||
(define (expand-only stx show-list)
|
(define (->predicate ids)
|
||||||
(define (show? id)
|
(lambda (id)
|
||||||
(ormap (lambda (x) (free-identifier=? id x))
|
(for/or ([x ids]) (free-identifier=? id x))))
|
||||||
show-list))
|
|
||||||
(expand/hiding stx show?))
|
|
||||||
|
|
||||||
(define (expand/hide stx hide-list)
|
(define (expand-only stx to-show)
|
||||||
(define (show? id)
|
(expand/show-predicate stx (->predicate to-show)))
|
||||||
(andmap (lambda (x) (not (free-identifier=? id x)))
|
|
||||||
hide-list))
|
|
||||||
(expand/hiding stx show?))
|
|
||||||
|
|
||||||
(define (expand/hiding stx show?)
|
(define (expand/hide stx to-hide)
|
||||||
|
(expand/show-predicate stx (compose not (->predicate to-hide))))
|
||||||
|
|
||||||
|
(define (expand/show-predicate stx show?)
|
||||||
(let-values ([(result deriv) (trace/result stx)])
|
(let-values ([(result deriv) (trace/result stx)])
|
||||||
(when (exn? result)
|
(when (exn? result) (raise result))
|
||||||
(raise result))
|
(let-values ([(_steps _uses stx exn2)
|
||||||
(let-values ([(_steps _uses stx _exn)
|
|
||||||
(parameterize ((macro-policy show?))
|
(parameterize ((macro-policy show?))
|
||||||
(reductions+ deriv))])
|
(reductions+ deriv))])
|
||||||
|
(when (exn? exn2) (raise exn2))
|
||||||
stx)))
|
stx)))
|
||||||
|
|
|
@ -56,6 +56,13 @@ location.
|
||||||
|
|
||||||
@defmodule[macro-debugger/expand]
|
@defmodule[macro-debugger/expand]
|
||||||
|
|
||||||
|
This module provides @scheme[expand]-like procedures that allow the
|
||||||
|
user to specify macros whose expansions should be hidden.
|
||||||
|
|
||||||
|
Warning: because of limitations in the way macro expansion is
|
||||||
|
selectively hidden, the resulting syntax may not evaluate to the same
|
||||||
|
thing as the original syntax.
|
||||||
|
|
||||||
@defproc[(expand-only [stx any/c] [transparent-macros (listof identifier?)])
|
@defproc[(expand-only [stx any/c] [transparent-macros (listof identifier?)])
|
||||||
syntax?]{
|
syntax?]{
|
||||||
|
|
||||||
|
@ -67,9 +74,6 @@ location.
|
||||||
(expand-only #'(let ([x 1] [y 2]) (or (even? x) (even? y)))
|
(expand-only #'(let ([x 1] [y 2]) (or (even? x) (even? y)))
|
||||||
(list #'or))))
|
(list #'or))))
|
||||||
|
|
||||||
Warning: because of limitations in syntax, expansion, and hiding,
|
|
||||||
the resulting syntax may not evaluate to the same thing as the
|
|
||||||
original syntax.
|
|
||||||
}
|
}
|
||||||
|
|
||||||
@defproc[(expand/hide [stx any/c] [hidden-macros (listof identifier?)])
|
@defproc[(expand/hide [stx any/c] [hidden-macros (listof identifier?)])
|
||||||
|
@ -82,10 +86,19 @@ location.
|
||||||
(syntax->datum
|
(syntax->datum
|
||||||
(expand/hide #'(let ([x 1] [y 2]) (or (even? x) (even? y)))
|
(expand/hide #'(let ([x 1] [y 2]) (or (even? x) (even? y)))
|
||||||
(list #'or))))
|
(list #'or))))
|
||||||
|
}
|
||||||
|
|
||||||
Warning: because of limitations in syntax, expansion, and hiding,
|
@defproc[(expand/show-predicate [stx any/c] [show? (-> identifier? boolean?)])
|
||||||
the resulting syntax may not evaluate to the same thing as the
|
syntax?]{
|
||||||
original syntax.
|
|
||||||
|
Expands the given syntax @scheme[stx], but only shows the expansion of macros
|
||||||
|
whose names satisfy the predicate @scheme[show?].
|
||||||
|
|
||||||
|
@(examples #:eval the-eval
|
||||||
|
(syntax->datum
|
||||||
|
(expand/show-predicate
|
||||||
|
#'(let ([x 1] [y 2]) (or (even? x) (even? y)))
|
||||||
|
(lambda (id) (memq (syntax-e id) '(or #%app))))))
|
||||||
}
|
}
|
||||||
|
|
||||||
@section{Macro stepper text interface}
|
@section{Macro stepper text interface}
|
||||||
|
@ -93,25 +106,28 @@ location.
|
||||||
@defmodule[macro-debugger/stepper-text]
|
@defmodule[macro-debugger/stepper-text]
|
||||||
|
|
||||||
@defproc[(expand/step-text [stx any/c]
|
@defproc[(expand/step-text [stx any/c]
|
||||||
[macro-policy (or/c (-> identifier? boolean?)
|
[show? (or/c (-> identifier? boolean?)
|
||||||
(listof identifier?))
|
(listof identifier?))
|
||||||
null])
|
(lambda (x) #t)])
|
||||||
void?]{
|
void?]{
|
||||||
|
|
||||||
Expands the syntax and prints the macro expansion steps. If the
|
Expands the syntax and prints the macro expansion steps. If the
|
||||||
identifier predicate is given, it determines which macros are shown
|
identifier predicate is given, it determines which macros are shown
|
||||||
(if absent, no macros are hidden). A list of identifiers is also
|
(if absent, all macros are shown). A list of identifiers is also
|
||||||
accepted.
|
accepted.
|
||||||
|
|
||||||
@(examples #:eval the-eval
|
@(examples #:eval the-eval
|
||||||
(expand/step-text #'(let ([x 1]) (even? x)))
|
(expand/step-text #'(let ([x 1] [y 2]) (or (even? x) (even? y)))
|
||||||
|
(list #'or))
|
||||||
|
#;(expand/step-text #'(let ([x 1]) (even? x)))
|
||||||
#;(expand/step-text #'(let ([x 1] [y 2]) (or (even? x) (even? y)))
|
#;(expand/step-text #'(let ([x 1] [y 2]) (or (even? x) (even? y)))
|
||||||
(lambda (id) (eq? (syntax-e id) 'or))))
|
(lambda (id) (eq? (syntax-e id) 'or))))
|
||||||
}
|
}
|
||||||
|
|
||||||
@defproc[(stepper-text [stx any/c]
|
@defproc[(stepper-text [stx any/c]
|
||||||
[macro-policy (or/c (-> identifier? boolean?)
|
[show? (or/c (-> identifier? boolean?)
|
||||||
(listof identifier?))])
|
(listof identifier?))
|
||||||
|
(lambda (x) #t)])
|
||||||
(symbol? -> void?)]{
|
(symbol? -> void?)]{
|
||||||
|
|
||||||
Returns a procedure that can be called on the symbol
|
Returns a procedure that can be called on the symbol
|
||||||
|
|
Loading…
Reference in New Issue
Block a user