[racket] Trimmed view in redex's traces?

Because I overlooked that argument. Thanks for pointing it out!
-Ian
----- Original Message -----
From: "Robby Findler" <robby at eecs.northwestern.edu>
To: "J. Ian Johnson" <ianj at ccs.neu.edu>
Cc: "users" <users at racket-lang.org>
Sent: Thursday, May 2, 2013 5:24:16 PM GMT -05:00 US/Canada Eastern
Subject: Re: [racket] Trimmed view in redex's traces?


Why not just use the pp argument that's already there? (And I think your editor is indenting improperly; some of those lines don't seem to have changed except indentation) 


Robby 



On Thu, May 2, 2013 at 3:02 PM, J. Ian Johnson < ianj at ccs.neu.edu > wrote: 


Okay, here's a diff that hacks it in for my purposes and doesn't crash. I don't know what this breaks due to the new init-field in size-snip though. Will anyone familiar with this part of the codebase please comment? 
Thanks, 
-Ian 

diff --git a/collects/redex/gui.rkt b/collects/redex/gui.rkt 
index 41dce2a..ddd291b 100644 
--- a/collects/redex/gui.rkt 
+++ b/collects/redex/gui.rkt 
@@ -43,6 +43,7 @@ 
#:edge-label-font (or/c #f (is-a?/c font%)) 
#:edge-labels? boolean? 
#:filter (-> any/c (or/c #f string?) any/c) 
+ #:format (-> any/c any/c) 
#:graph-pasteboard-mixin (make-mixin-contract graph-pasteboard<%>)) 
any)] 
[traces/ps (->* (reduction-relation? 
@@ -60,6 +61,7 @@ 
#:edge-label-font (or/c #f (is-a?/c font%)) 
#:edge-labels? boolean? 
#:filter (-> any/c (or/c #f string?) any/c) 
+ #:format (-> any/c any/c) 
#:graph-pasteboard-mixin (make-mixin-contract graph-pasteboard<%>) 
#:post-process (-> (is-a?/c graph-pasteboard<%>) any/c)) 
any)] 
diff --git a/collects/redex/private/size-snip.rkt b/collects/redex/private/size-snip.rkt 
index e505ba5..3cf8676 100644 
--- a/collects/redex/private/size-snip.rkt 
+++ b/collects/redex/private/size-snip.rkt 
@@ -83,6 +83,7 @@ 
(define size-editor-snip% 
(class* editor-snip% (reflowing-snip<%>) 
(init-field expr) 
+ (init-field formatted-expr) 
(init pp) 
(init-field char-width) 
(define real-pp 
@@ -172,7 +173,7 @@ 
(send text thaw-colorer)) 
(send text set-styles-sticky #f) 
(send text erase) 
- (real-pp expr port char-width text) 
+ (real-pp formatted-expr port char-width text) 
diff --git a/collects/redex/private/traces.rkt b/collects/redex/private/traces.rkt 
index 1293c19..9bcb45a 100644 
--- a/collects/redex/private/traces.rkt 
+++ b/collects/redex/private/traces.rkt 
@@ -139,6 +139,7 @@ 
#:edge-labels? [edge-labels? #t] 
#:graph-pasteboard-mixin [extra-graph-pasteboard-mixin values] 
#:filter [term-filter (lambda (x y) #t)] 
+ #:format [term-formatter values] 
#:post-process [post-process void] 
#:x-spacing [x-spacing default-x-spacing] 
#:y-spacing [y-spacing default-x-spacing]) 
@@ -156,6 +157,7 @@ 
#:edge-labels? edge-labels? 
#:graph-pasteboard-mixin extra-graph-pasteboard-mixin 
#:filter term-filter 
+ #:format term-formatter 
#:x-spacing x-spacing 
#:y-spacing y-spacing)]) 
(post-process graph-pb) 
@@ -249,6 +251,7 @@ 
#:edge-label-font [edge-label-font #f] 
#:edge-labels? [edge-labels? #t] 
#:filter [term-filter (lambda (x y) #t)] 
+ #:format [term-formatter values] 
#:graph-pasteboard-mixin [extra-graph-pasteboard-mixin values] 
#:no-show-frame? [no-show-frame? #f] 
#:x-spacing [x-spacing default-x-spacing] 
@@ -368,7 +371,7 @@ 
(filter 
(λ (x) x) 
(map (lambda (expr) (apply build-snip 
- snip-cache #f expr pred pp #f code-colors? 
+ snip-cache #f expr pred term-formatter pp #f code-colors? 
(get-user-char-width user-char-width expr) 
default-colors)) 
exprs))) 
@@ -429,20 +432,20 @@ 
(let* ([snip (car snips)] 
[new-snips 
(filter 
- (lambda (x) x) 
+ values 
(map (lambda (red+sexp) 
(let-values ([(name sexp) (apply values red+sexp)]) 
(call-on-eventspace-main-thread 
(λ () 
- (and (term-filter sexp name) 
- (let-values ([(dark-arrow-color light-arrow-color dark-label-color light-label-color 
- dark-pen-color 
- light-pen-color) 
- (red->colors name)]) 
- (build-snip snip-cache snip sexp pred pp name code-colors? 
- (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))))))) 
+ (and (term-filter sexp name) 
+ (let-values ([(dark-arrow-color light-arrow-color dark-label-color light-label-color 
+ dark-pen-color 
+ light-pen-color) 
+ (red->colors name)]) 
+ (build-snip snip-cache snip sexp pred term-formatter pp name code-colors? 
+ (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))))] 
[new-y 
(call-on-eventspace-main-thread 
@@ -787,6 +790,7 @@ 
;; (union #f (is-a?/c graph-snip<%>)) 
;; sexp 
;; sexp -> boolean 
+;; sexp -> sexp 
;; (any port number -> void) 
;; (union #f string) 
;; number 
@@ -795,7 +799,7 @@ 
;; returns #f if a snip corresponding to the expr has already been created. 
;; also adds in the links to the parent snip 
;; =eventspace main thread= 
-(define (build-snip cache parent-snip expr pred pp name code-colors? cw 
+(define (build-snip cache parent-snip expr pred formatter pp name code-colors? cw 
light-arrow-color dark-arrow-color dark-label-color light-label-color 
dark-brush-color light-brush-color) 
(let-values ([(snip new?) 
@@ -804,7 +808,7 @@ 
cache 
expr 
(lambda () 
- (let ([new-snip (make-snip parent-snip expr pred pp code-colors? cw)]) 
+ (let ([new-snip (make-snip parent-snip expr pred formatter pp code-colors? cw)]) 
(hash-set! cache expr new-snip) 
@@ -824,7 +828,7 @@ 
(make-object color% light-label-color)) 
0 0 
name) 
- (update-badness pred parent-snip (send parent-snip get-expr))) 
+ (update-badness pred parent-snip (formatter (send parent-snip get-expr)))) 

(update-badness pred snip expr) 

@@ -845,20 +849,22 @@ 
;; make-snip : (union #f (is-a?/c graph-snip<%>)) 
;; sexp 
;; sexp -> boolean 
+;; sexp -> sexp 
;; (any port number -> void) 
;; boolean 
;; number 
;; -> (is-a?/c graph-editor-snip%) 
;; unconditionally creates a new graph-editor-snip 
;; =eventspace main thread= 
-(define (make-snip parent-snip expr pred pp code-colors? cw) 
+(define (make-snip parent-snip expr pred formatter pp code-colors? cw) 
(let* ([text (new program-text%)] 
[es (instantiate graph-editor-snip% () 
(char-width cw) 
(editor text) 
(my-eventspace (current-eventspace)) 
(pp pp) 
- (expr expr))]) 
+ (expr expr) 
+ (formatted-expr (formatter expr)))]) 
(send text set-autowrap-bitmap #f) 
(send text set-max-width 'none) 
(send text freeze-colorer) 



----- Original Message ----- 
From: "J. Ian Johnson" < ianj at ccs.neu.edu > 
To: "users" < users at racket-lang.org > 
Sent: Thursday, May 2, 2013 2:46:17 PM GMT -05:00 US/Canada Eastern 
Subject: [racket] Trimmed view in redex's traces? 

I'm trying to debug an abstract machine with some large auxiliary tables. Is there a way to make traces only show a portion of a term, but still treat the box it's in as the entire term? An additional bonus would be to drill down into a trimmed box via click or something. 
I don't see this in the docs, so I'm guessing no, but an extra keyword argument for a term -> term "trimming" function shouldn't be too hard to add, right? Just not sure where to change this. 
-Ian 
____________________ 
Racket Users list: 
http://lists.racket-lang.org/users 

____________________ 
Racket Users list: 
http://lists.racket-lang.org/users