www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs

expand.rkt (977B)

      1 #lang racket/base
      2 (require racket/contract/base
      3          "model/trace.rkt"
      4          "model/reductions-config.rkt"
      5          "model/reductions.rkt")
      6 
      7 (provide/contract
      8  [expand-only 
      9   (any/c (listof identifier?) . -> . syntax?)]
     10  [expand/hide
     11   (any/c (listof identifier?) . -> . syntax?)]
     12  [expand/show-predicate
     13   (any/c (-> identifier? any/c) . -> . syntax?)])
     14 
     15 (define (->predicate ids)
     16   (lambda (id)
     17     (for/or ([x ids]) (free-identifier=? id x))))
     18 
     19 (define (expand-only stx to-show)
     20   (expand/show-predicate stx (->predicate to-show)))
     21 
     22 (define (expand/hide stx to-hide)
     23   (expand/show-predicate stx (compose not (->predicate to-hide))))
     24 
     25 (define (expand/show-predicate stx show?)
     26   (let-values ([(result deriv) (trace/result stx)])
     27     (when (exn? result) (raise result))
     28     (let-values ([(_steps _defs _uses stx exn2)
     29                   (parameterize ((macro-policy show?))
     30                     (reductions+ deriv))])
     31       (when (exn? exn2) (raise exn2))
     32       stx)))