diff --git a/collects/macro-debugger/expand.ss b/collects/macro-debugger/expand.ss index 5d72112..29f6d77 100644 --- a/collects/macro-debugger/expand.ss +++ b/collects/macro-debugger/expand.ss @@ -1,28 +1,32 @@ #lang scheme/base -(require "model/trace.ss" +(require scheme/contract + "model/trace.ss" "model/reductions-config.ss" "model/reductions.ss") -(provide expand-only - expand/hide) +(provide/contract + [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 (show? id) - (ormap (lambda (x) (free-identifier=? id x)) - show-list)) - (expand/hiding stx show?)) +(define (->predicate ids) + (lambda (id) + (for/or ([x ids]) (free-identifier=? id x)))) -(define (expand/hide stx hide-list) - (define (show? id) - (andmap (lambda (x) (not (free-identifier=? id x))) - hide-list)) - (expand/hiding stx show?)) +(define (expand-only stx to-show) + (expand/show-predicate stx (->predicate to-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)]) - (when (exn? result) - (raise result)) - (let-values ([(_steps _uses stx _exn) + (when (exn? result) (raise result)) + (let-values ([(_steps _uses stx exn2) (parameterize ((macro-policy show?)) (reductions+ deriv))]) + (when (exn? exn2) (raise exn2)) stx))) diff --git a/collects/macro-debugger/macro-debugger.scrbl b/collects/macro-debugger/macro-debugger.scrbl index c734747..bb2928a 100644 --- a/collects/macro-debugger/macro-debugger.scrbl +++ b/collects/macro-debugger/macro-debugger.scrbl @@ -56,6 +56,13 @@ location. @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?)]) syntax?]{ @@ -67,9 +74,6 @@ location. (expand-only #'(let ([x 1] [y 2]) (or (even? x) (even? y))) (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?)]) @@ -82,10 +86,19 @@ location. (syntax->datum (expand/hide #'(let ([x 1] [y 2]) (or (even? x) (even? y))) (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/show-predicate [stx any/c] [show? (-> identifier? boolean?)]) + 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} @@ -93,25 +106,28 @@ location. @defmodule[macro-debugger/stepper-text] @defproc[(expand/step-text [stx any/c] - [macro-policy (or/c (-> identifier? boolean?) - (listof identifier?)) - null]) + [show? (or/c (-> identifier? boolean?) + (listof identifier?)) + (lambda (x) #t)]) void?]{ Expands the syntax and prints the macro expansion steps. If the 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. @(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))) (lambda (id) (eq? (syntax-e id) 'or)))) } @defproc[(stepper-text [stx any/c] - [macro-policy (or/c (-> identifier? boolean?) - (listof identifier?))]) + [show? (or/c (-> identifier? boolean?) + (listof identifier?)) + (lambda (x) #t)]) (symbol? -> void?)]{ Returns a procedure that can be called on the symbol