From 25c982ad3752429a5028130153986a980bacd372 Mon Sep 17 00:00:00 2001 From: Erik Silkensen Date: Thu, 6 Jun 2013 16:24:45 -0400 Subject: [PATCH] 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. --- collects/redex/gui.rkt | 6 +++++- collects/redex/private/traces.rkt | 11 +++++++---- collects/redex/scribblings/ref.scrbl | 10 ++++++++++ 3 files changed, 22 insertions(+), 5 deletions(-) diff --git a/collects/redex/gui.rkt b/collects/redex/gui.rkt index 41dce2a008..cae5fdef1e 100644 --- a/collects/redex/gui.rkt +++ b/collects/redex/gui.rkt @@ -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)] diff --git a/collects/redex/private/traces.rkt b/collects/redex/private/traces.rkt index 3b3757a4e4..a6e65e924c 100644 --- a/collects/redex/private/traces.rkt +++ b/collects/redex/private/traces.rkt @@ -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= diff --git a/collects/redex/scribblings/ref.scrbl b/collects/redex/scribblings/ref.scrbl index da0ed90e2e..ac16481eb8 100644 --- a/collects/redex/scribblings/ref.scrbl +++ b/collects/redex/scribblings/ref.scrbl @@ -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))