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?)
(#:style reduction-rule-style/c)
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?)
(#:nts (or/c false/c (listof (or/c string? symbol?))))

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

@ -106,16 +106,18 @@
(map (rr-lws->trees (language-nts (reduction-relation-lang rr)))
(if rules
(let ([ht (make-hash)])
(for-each (lambda (rp)
(for ([rp (in-list (reduction-relation-lws rr))]
[i (in-naturals)])
(hash-set! ht i rp)
(hash-set! ht (rule-pict-label rp) rp))
(reduction-relation-lws rr))
(map (lambda (label)
(hash-ref ht (if (string? label)
(string->symbol label)
label)
(lambda ()
(error what
"no rule found for label: ~e"
"no rule found for ~a: ~e"
(if (number? label) "index" "label")
label))))
rules))
(reduction-relation-lws rr))))))
@ -175,7 +177,9 @@
(table 4
(apply
append
(map (lambda (rp)
(let ([len (length rps)])
(for/list ([rp (in-list rps)]
[i (in-naturals 1)])
(let ([arrow (hbl-append (blank (arrow-space) 0)
(arrow->pict (rule-pict-arrow rp))
(blank (arrow-space) 0))]
@ -184,13 +188,15 @@
[spc (basic-text " " (default-style))]
[label (hbl-append (blank (label-space) 0) (rp->pict-label rp))]
[sep (blank 4)])
(append
(list lhs arrow rhs label
(blank) (blank)
(let ([sc (rp->side-condition-pict rp max-w)])
(inset sc (min 0 (- max-rhs (pict-width sc))) 0 0 0))
(blank)
sep (blank) (blank) (blank))))
rps))
(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* 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.
}
@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
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]{