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

redex: adjust the 'horizontal rule-pict-style so that it doesn't add space after the last rule

Browse Source 
extend render-reduction-relation-rules so you can specify rule indicies instead of just
         the names of the rules
This commit is contained in:
Robby Findler 2011-06-21 06:31:15 +08:00
parent 3daf61f605
commit 78006b5720
3 changed files with 31 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/redex/pict.rkt
View File

@ -29,7 +29,7 @@
[reduction-relation->pict (->* (reduction-relation?) [reduction-relation->pict (->* (reduction-relation?)
(#:style reduction-rule-style/c) (#:style reduction-rule-style/c)
pict?)] pict?)]
[render-reduction-relation-rules (parameter/c (or/c false/c (listof (or/c symbol? string?))))] [render-reduction-relation-rules (parameter/c (or/c false/c (listof (or/c symbol? string? exact-nonnegative-integer?))))]
[language->pict (->* (compiled-lang?) [language->pict (->* (compiled-lang?)
(#:nts (or/c false/c (listof (or/c string? symbol?)))) (#:nts (or/c false/c (listof (or/c string? symbol?))))

46
collects/redex/private/pict.rkt
View File

@ -106,16 +106,18 @@
(map (rr-lws->trees (language-nts (reduction-relation-lang rr))) (map (rr-lws->trees (language-nts (reduction-relation-lang rr)))
(if rules (if rules
(let ([ht (make-hash)]) (let ([ht (make-hash)])
(for-each (lambda (rp) (for ([rp (in-list (reduction-relation-lws rr))]
(hash-set! ht (rule-pict-label rp) rp)) [i (in-naturals)])
(reduction-relation-lws rr)) (hash-set! ht i rp)
(hash-set! ht (rule-pict-label rp) rp))
(map (lambda (label) (map (lambda (label)
(hash-ref ht (if (string? label) (hash-ref ht (if (string? label)
(string->symbol label) (string->symbol label)
label) label)
(lambda () (lambda ()
(error what (error what
"no rule found for label: ~e" "no rule found for ~a: ~e"
(if (number? label) "index" "label")
label)))) label))))
rules)) rules))
(reduction-relation-lws rr)))))) (reduction-relation-lws rr))))))
@ -175,22 +177,26 @@
(table 4 (table 4
(apply (apply
append append
(map (lambda (rp) (let ([len (length rps)])
(let ([arrow (hbl-append (blank (arrow-space) 0) (for/list ([rp (in-list rps)]
(arrow->pict (rule-pict-arrow rp)) [i (in-naturals 1)])
(blank (arrow-space) 0))] (let ([arrow (hbl-append (blank (arrow-space) 0)
[lhs (rule-pict-lhs rp)] (arrow->pict (rule-pict-arrow rp))
[rhs (rule-pict-rhs rp)] (blank (arrow-space) 0))]
[spc (basic-text " " (default-style))] [lhs (rule-pict-lhs rp)]
[label (hbl-append (blank (label-space) 0) (rp->pict-label rp))] [rhs (rule-pict-rhs rp)]
[sep (blank 4)]) [spc (basic-text " " (default-style))]
(list lhs arrow rhs label [label (hbl-append (blank (label-space) 0) (rp->pict-label rp))]
(blank) (blank) [sep (blank 4)])
(let ([sc (rp->side-condition-pict rp max-w)]) (append
(inset sc (min 0 (- max-rhs (pict-width sc))) 0 0 0)) (list lhs arrow rhs label
(blank) (blank) (blank)
sep (blank) (blank) (blank)))) (let ([sc (rp->side-condition-pict rp max-w)])
rps)) (inset sc (min 0 (- max-rhs (pict-width sc))) 0 0 0))
(blank))
(if (= len i)
'()
(list sep (blank) (blank) (blank))))))))
(list* left-column-align ctl-superimpose ltl-superimpose) (list* left-column-align ctl-superimpose ltl-superimpose)
(list* left-column-align ctl-superimpose ltl-superimpose) (list* left-column-align ctl-superimpose ltl-superimpose)
(list* sep sep (+ sep (current-label-extra-space))) 2))) (list* sep sep (+ sep (current-label-extra-space))) 2)))

6
collects/redex/redex.scrbl
View File

@ -2121,9 +2121,11 @@ Note that the @racket[#t] variant can look a little bit strange if
multi-line right-hand sides. multi-line right-hand sides.
} }
@defparam[render-reduction-relation-rules rules (or/c false/c (listof (or/c symbol? string?)))]{ @defparam[render-reduction-relation-rules rules (or/c false/c (listof (or/c symbol? string? exact-nonnegative-integer?)))]{
This parameter controls which rules in a reduction relation This parameter controls which rules in a reduction relation
will be rendered. will be rendered. The strings and symbols match the names of
the rules and the integers match the position of the rule in
the original definition.
} }
@defparam[rule-pict-style style reduction-rule-style/c]{ @defparam[rule-pict-style style reduction-rule-style/c]{