suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add a "Step Until Choice" option into the redex stepper

Browse Source
This commit is contained in:
Robby Findler 2011-10-14 13:36:40 -05:00
parent 522ba14b9f
commit db2e13a09b
1 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/redex/private/stepper.rkt
View File

@ -104,9 +104,10 @@ todo:
[parent choice-vp] [parent choice-vp]
[font small-control-font] [font small-control-font]
[label #f] [label #f]
[choices (cons "Single Step" [choices (list* "Single Step"
(map (λ (x) (format "Reduce until ~a" x)) "Step Until Choice"
reduction-names))]))) (map (λ (x) (format "Reduce until ~a" x))
reduction-names))])))
(define red-name-message (define red-name-message
(and (not (null? (reduction-relation->rule-names red))) (and (not (null? (reduction-relation->rule-names red)))
(new message% (new message%
@ -221,8 +222,10 @@ todo:
[(or (not reds-choice) [(or (not reds-choice)
(zero? (send reds-choice get-selection))) (zero? (send reds-choice get-selection)))
#f] #f]
[(equal? (send reds-choice get-selection) 1)
#t]
[else (symbol->string [else (symbol->string
(list-ref reduction-names (- (send reds-choice get-selection) 1)))])]) (list-ref reduction-names (- (send reds-choice get-selection) 2)))])])
(let loop ([next-node click-target] (let loop ([next-node click-target]
[new-nodes (list)] [new-nodes (list)]
[cutoff (if looking-for [cutoff (if looking-for
@ -240,7 +243,8 @@ todo:
(cond (cond
[(send (car new-children) in-cycle?) [(send (car new-children) in-cycle?)
(reverse (cons new-children new-nodes))] (reverse (cons new-children new-nodes))]
[(member looking-for (find-reduction-label next-node (car new-children) #f)) [(and (not (eq? looking-for #t))
(member looking-for (find-reduction-label next-node (car new-children) #f)))
(reverse (cons new-children new-nodes))] (reverse (cons new-children new-nodes))]
[else [else
(loop (car new-children) (loop (car new-children)