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) texpict/mrpict)
(define reduction-rule-style/c (define reduction-rule-style/c
(symbols 'compact-vertical (or/c 'vertical
'vertical 'compact-vertical
'vertical-overlapping-side-conditions 'vertical-overlapping-side-conditions
'horizontal-left-align 'horizontal
'horizontal)) 'horizontal-left-align
'horizontal-side-conditions-same-line))
(provide reduction-rule-style/c render-term term->pict (provide reduction-rule-style/c render-term term->pict
term->pict/pretty-write 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 current-label-extra-space (make-parameter 0))
(define reduction-relation-rule-separation (make-parameter 4)) (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] (let* ([sep 2]
[max-rhs (apply max [max-rhs (apply max
0 0
@ -208,11 +208,17 @@
[label (hbl-append (blank (label-space) 0) (rp->pict-label rp))] [label (hbl-append (blank (label-space) 0) (rp->pict-label rp))]
[sep (blank 4)]) [sep (blank 4)])
(append (append
(list lhs arrow rhs label (if side-conditions-same-line?
(blank) (blank) (list lhs arrow
(let ([sc (rp->side-condition-pict rp max-w)]) (hbl-append rhs
(inset sc (min 0 (- max-rhs (pict-width sc))) 0 0 0)) (let ([sc (rp->side-condition-pict rp max-w)])
(blank)) (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) (if (= len i)
'() '()
(list sep (blank) (blank) (blank)))))))) (list sep (blank) (blank) (blank))))))))
@ -425,9 +431,11 @@
[(vertical-overlapping-side-conditions) [(vertical-overlapping-side-conditions)
rule-picts->pict/vertical-overlapping-side-conditions] rule-picts->pict/vertical-overlapping-side-conditions]
[(horizontal-left-align) [(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 [else ;; horizontal
(rule-picts->pict/horizontal rtl-superimpose)])) (rule-picts->pict/horizontal rtl-superimpose #f)]))
(define (mk-arrow-pict sz style) (define (mk-arrow-pict sz style)
(let ([cache (make-hash)]) (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 pict, but are just overlaid on the second line of each rule. The
@racket['horizontal-left-align] style is like the @racket['horizontal] @racket['horizontal-left-align] style is like the @racket['horizontal]
style, but the left-hand sides of the rules are aligned on the left, 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 A contract equivalent to
@racketblock[ @racketblock[(or/c 'vertical
(symbols 'vertical 'compact-vertical
'compact-vertical 'vertical-overlapping-side-conditions
'vertical-overlapping-side-conditions 'horizontal
'horizontal) 'horizontal-left-align
'horizontal-side-conditions-same-line)
]} ]}
@defparam[arrow-space space natural-number/c]{ @defparam[arrow-space space natural-number/c]{