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

add 'horizontal-side-conditions-same-line style to rule-pict-style

Browse Source
This commit is contained in:
Robby Findler 2013-06-22 00:45:18 -05:00
parent 29bce22d0b
commit eb98ab58cb
3 changed files with 31 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkgs/redex/pict.rkt
View File

@ -8,11 +8,12 @@
texpict/mrpict)
(define reduction-rule-style/c
(symbols 'compact-vertical
'vertical
'vertical-overlapping-side-conditions
'horizontal-left-align
'horizontal))
(or/c 'vertical
'compact-vertical
'vertical-overlapping-side-conditions
'horizontal
'horizontal-left-align
'horizontal-side-conditions-same-line))
(provide reduction-rule-style/c render-term term->pict
term->pict/pretty-write

24
pkgs/redex/private/pict.rkt
View File

@ -179,7 +179,7 @@
(define current-label-extra-space (make-parameter 0))
(define reduction-relation-rule-separation (make-parameter 4))
(define ((rule-picts->pict/horizontal left-column-align) rps)
(define ((rule-picts->pict/horizontal left-column-align side-conditions-same-line?) rps)
(let* ([sep 2]
[max-rhs (apply max
0
@ -208,11 +208,17 @@
[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))
(if side-conditions-same-line?
(list lhs arrow
(hbl-append rhs
(let ([sc (rp->side-condition-pict rp max-w)])
(inset sc (min 0 (- max-rhs (pict-width sc))) 0 0 0)))
label)
(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)))
(if (= len i)
'()
(list sep (blank) (blank) (blank))))))))
@ -425,9 +431,11 @@
[(vertical-overlapping-side-conditions)
rule-picts->pict/vertical-overlapping-side-conditions]
[(horizontal-left-align)
(rule-picts->pict/horizontal ltl-superimpose)]
(rule-picts->pict/horizontal ltl-superimpose #f)]
[(horizontal-side-conditions-same-line)
(rule-picts->pict/horizontal rtl-superimpose #t)]
[else ;; horizontal
(rule-picts->pict/horizontal rtl-superimpose)]))
(rule-picts->pict/horizontal rtl-superimpose #f)]))
(define (mk-arrow-pict sz style)
(let ([cache (make-hash)])

15
pkgs/redex/scribblings/ref.scrbl
View File

@ -2803,7 +2803,9 @@ variant, the side-conditions don't contribute to the width of the
pict, but are just overlaid on the second line of each rule. The
@racket['horizontal-left-align] style is like the @racket['horizontal]
style, but the left-hand sides of the rules are aligned on the left,
instead of on the right.
instead of on the right. The @racket[''horizontal-side-conditions-same-line]
is like @racket['horizontal], except that side-conditions
are on the same lines as the rule, instead of on their own line below.
}
@ -2811,11 +2813,12 @@ instead of on the right.
A contract equivalent to
@racketblock[
(symbols 'vertical
'compact-vertical
'vertical-overlapping-side-conditions
'horizontal)
@racketblock[(or/c 'vertical
'compact-vertical
'vertical-overlapping-side-conditions
'horizontal
'horizontal-left-align
'horizontal-side-conditions-same-line)
]}
@defparam[arrow-space space natural-number/c]{