Add #:reduce argument to traces.

Add a new #:reduce argument to traces (and traces/ps) that defines the
function to use when applying the reduction relation.  This way a
function could selectively display some subset of possible reduction
traces instead of all.
This commit is contained in:
Erik Silkensen 2013-06-06 16:24:45 -04:00
parent 5e30416110
commit 25c982ad37
3 changed files with 22 additions and 5 deletions

View File

@ -43,7 +43,9 @@
#:edge-label-font (or/c #f (is-a?/c font%))
#:edge-labels? boolean?
#:filter (-> any/c (or/c #f string?) any/c)
#:graph-pasteboard-mixin (make-mixin-contract graph-pasteboard<%>))
#:graph-pasteboard-mixin (make-mixin-contract graph-pasteboard<%>)
#:reduce (-> reduction-relation? any/c
(listof (list/c (or/c false/c string?) any/c))))
any)]
[traces/ps (->* (reduction-relation?
any/c
@ -61,6 +63,8 @@
#:edge-labels? boolean?
#:filter (-> any/c (or/c #f string?) any/c)
#:graph-pasteboard-mixin (make-mixin-contract graph-pasteboard<%>)
#:reduce (-> reduction-relation? any/c
(listof (list/c (or/c false/c string?) any/c)))
#:post-process (-> (is-a?/c graph-pasteboard<%>) any/c))
any)]

View File

@ -141,7 +141,8 @@
#:filter [term-filter (lambda (x y) #t)]
#:post-process [post-process void]
#:x-spacing [x-spacing default-x-spacing]
#:y-spacing [y-spacing default-x-spacing])
#:y-spacing [y-spacing default-x-spacing]
#:reduce [reduce apply-reduction-relation/tag-with-names])
(let-values ([(graph-pb canvas)
(traces reductions pre-exprs
#:no-show-frame? #t
@ -157,7 +158,8 @@
#:graph-pasteboard-mixin extra-graph-pasteboard-mixin
#:filter term-filter
#:x-spacing x-spacing
#:y-spacing y-spacing)])
#:y-spacing y-spacing
#:reduce reduce)])
(post-process graph-pb)
(print-to-ps graph-pb canvas filename)))
@ -252,7 +254,8 @@
#:graph-pasteboard-mixin [extra-graph-pasteboard-mixin values]
#:no-show-frame? [no-show-frame? #f]
#:x-spacing [x-spacing default-x-spacing]
#:y-spacing [y-spacing default-y-spacing])
#:y-spacing [y-spacing default-y-spacing]
#:reduce [reduce apply-reduction-relation/tag-with-names])
(define exprs (if multiple? pre-exprs (list pre-exprs)))
(define main-eventspace (current-eventspace))
(define saved-parameterization (current-parameterization))
@ -443,7 +446,7 @@
(get-user-char-width user-char-width sexp)
light-arrow-color dark-arrow-color dark-label-color light-label-color
dark-pen-color light-pen-color)))))))
(apply-reduction-relation/tag-with-names reductions (send snip get-expr))))]
(reduce reductions (send snip get-expr))))]
[new-y
(call-on-eventspace-main-thread
(lambda () ; =eventspace main thread=

View File

@ -2099,6 +2099,8 @@ exploring reduction sequences.
@defproc[(traces [reductions reduction-relation?]
[expr (or/c any/c (listof any/c))]
[#:multiple? multiple? boolean? #f]
[#:reduce reduce (-> reduction-relation? any/c
(listof (list/c (union false/c string?) any/c))) apply-reduction-relation/tag-with-names]
[#:pred pred
(or/c (-> sexp any)
(-> sexp term-node? any))
@ -2133,6 +2135,12 @@ found, or no more reductions can occur. It inserts each new
term into the gui. Clicking the @onscreen{reduce} button reduces
until @racket[reduction-steps-cutoff] more terms are found.
The @racket[reduce] function applies the reduction relation to the terms.
By default, it is @racket[apply-reduction-relation/tag-with-names];
it may be changed to only return a subset of the possible reductions,
for example, but it must satisfy the same contract as
@racket[apply-reduction-relation/tag-with-names].
The @racket[pred] function indicates if a term has a particular
property. If it returns @racket[#f], the term is displayed with a
pink background. If it returns a string or a @racket[color%] object,
@ -2278,6 +2286,8 @@ traces window instead of just the numbers.
[expr (or/c any/c (listof any/c))]
[file (or/c path-string? path?)]
[#:multiple? multiple? boolean? #f]
[#:reduce reduce (-> reduction-relation? any/c
(listof (list/c (union false/c string?) any/c))) apply-reduction-relation/tag-with-names]
[#:pred pred
(or/c (-> sexp any)
(-> sexp term-node? any))