optional arguments as an alternative to parameters for render-language, language->pict, render-reduction-relation, and reduction-relation->pict
svn: r11265
This commit is contained in:
Matthew Flatt
parent
f533538e28
commit
2e0c6444f9
|
|
@ -8,17 +8,39 @@
|
|||
(lib "mred.ss" "mred")
|
||||
(lib "mrpict.ss" "texpict"))
|
||||
|
||||
(define reduction-rule-style/c
|
||||
(symbols 'compact-vertical
|
||||
'vertical
|
||||
'vertical-overlapping-side-conditions
|
||||
'horizontal))
|
||||
|
||||
(provide reduction-rule-style/c)
|
||||
|
||||
(provide/contract
|
||||
[render-reduction-relation
|
||||
(case-> (-> reduction-relation? pict?)
|
||||
(-> reduction-relation? (or/c string? path?) void?))]
|
||||
[reduction-relation->pict (-> reduction-relation? pict?)]
|
||||
(->d ([rel reduction-relation?])
|
||||
([file (or/c false/c path-string?)]
|
||||
#:style [style reduction-rule-style/c])
|
||||
[result (lambda (x)
|
||||
(if (path-string? file)
|
||||
(void? x)
|
||||
(pict? x)))])]
|
||||
[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?))))]
|
||||
|
||||
[language->pict (-> compiled-lang? pict?)]
|
||||
[language->pict (->* (compiled-lang?)
|
||||
(#:nts (or/c false/c (listof (or/c string? symbol?))))
|
||||
pict?)]
|
||||
[render-language
|
||||
(case-> (-> compiled-lang? pict?)
|
||||
(-> compiled-lang? (or/c path? string?) void?))])
|
||||
(->d ([lang compiled-lang?])
|
||||
([file (or/c false/c path-string?)]
|
||||
#:nts [nts (or/c false/c (listof (or/c string? symbol?)))])
|
||||
[result (lambda (x)
|
||||
(if (path-string? file)
|
||||
(void? x)
|
||||
(pict? x)))])])
|
||||
|
||||
; syntax
|
||||
(provide metafunction->pict
|
||||
|
|
@ -43,10 +65,7 @@
|
|||
|
||||
(provide/contract
|
||||
[rule-pict-style
|
||||
(parameter/c (symbols 'compact-vertical
|
||||
'vertical
|
||||
'vertical-overlapping-side-conditions
|
||||
'horizontal))]
|
||||
(parameter/c reduction-rule-style/c)]
|
||||
[arrow-space (parameter/c natural-number/c)]
|
||||
[label-space (parameter/c natural-number/c)]
|
||||
[metafunction-pict-style
|
||||
|
|
|
|||
|
|
@ -79,9 +79,9 @@
|
|||
;
|
||||
;
|
||||
|
||||
(define (do-reduction-relation->pict what rr)
|
||||
(define (do-reduction-relation->pict what rr style)
|
||||
(let ([rules (render-reduction-relation-rules)])
|
||||
((rule-pict-style->proc)
|
||||
((rule-pict-style->proc style)
|
||||
(map (rr-lws->trees (language-nts (reduction-relation-lang rr)))
|
||||
(if rules
|
||||
(let ([ht (make-hash)])
|
||||
|
|
@ -97,18 +97,18 @@
|
|||
rules))
|
||||
(reduction-relation-lws rr))))))
|
||||
|
||||
(define (reduction-relation->pict rr) (do-reduction-relation->pict 'reduction-relation->pict rr))
|
||||
(define (reduction-relation->pict rr #:style [style (rule-pict-style)])
|
||||
(do-reduction-relation->pict 'reduction-relation->pict rr style))
|
||||
|
||||
(define render-reduction-relation-rules (make-parameter #f))
|
||||
|
||||
(define render-reduction-relation
|
||||
(case-lambda
|
||||
[(rr)
|
||||
(parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))])
|
||||
(do-reduction-relation->pict 'render-reduction-relation rr))]
|
||||
[(rr filename)
|
||||
(save-as-ps (λ () (do-reduction-relation->pict 'render-reduction-relation rr))
|
||||
filename)]))
|
||||
(define (render-reduction-relation rr [filename #f]
|
||||
#:style [style (rule-pict-style)])
|
||||
(if filename
|
||||
(save-as-ps (λ () (do-reduction-relation->pict 'render-reduction-relation rr style))
|
||||
filename)
|
||||
(parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))])
|
||||
(do-reduction-relation->pict 'render-reduction-relation rr style))))
|
||||
|
||||
(define ((rr-lws->trees nts) rp)
|
||||
(let ([tp (λ (x) (lw->pict nts x))])
|
||||
|
|
@ -318,8 +318,8 @@
|
|||
(define (make-horiz-space picts) (blank (pict-width (apply cc-superimpose picts)) 0))
|
||||
|
||||
(define rule-pict-style (make-parameter 'vertical))
|
||||
(define (rule-pict-style->proc)
|
||||
(case (rule-pict-style)
|
||||
(define (rule-pict-style->proc style)
|
||||
(case style
|
||||
[(vertical) rule-picts->pict/vertical]
|
||||
[(compact-vertical) rule-picts->pict/compact-vertical]
|
||||
[(vertical-overlapping-side-conditions)
|
||||
|
|
@ -393,19 +393,17 @@
|
|||
;; (union (vector flattened-language-pict-info language-pict-info)
|
||||
;; flattened-language-pict-info)
|
||||
|
||||
(define render-language
|
||||
(case-lambda
|
||||
[(lang)
|
||||
(parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))])
|
||||
(do-language->pict 'render-language lang))]
|
||||
[(lang filename)
|
||||
(save-as-ps (λ () (do-language->pict 'render-language lang)) filename)]))
|
||||
(define (render-language lang [filename #f] #:nts [nts (render-language-nts)])
|
||||
(if filename
|
||||
(save-as-ps (λ () (do-language->pict 'render-language lang)) filename nts)
|
||||
(parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))])
|
||||
(do-language->pict 'render-language lang nts))))
|
||||
|
||||
(define (language->pict lang) (do-language->pict 'language->pict lang))
|
||||
(define (language->pict lang #:nts [nts (render-language-nts)])
|
||||
(do-language->pict 'language->pict lang nts))
|
||||
|
||||
(define (do-language->pict what lang)
|
||||
(let ([specd-non-terminals (render-language-nts)]
|
||||
[all-non-terminals (hash-map (compiled-lang-ht lang) (λ (x y) x))])
|
||||
(define (do-language->pict what lang specd-non-terminals)
|
||||
(let ([all-non-terminals (hash-map (compiled-lang-ht lang) (λ (x y) x))])
|
||||
(when specd-non-terminals
|
||||
(check-non-terminals what specd-non-terminals lang))
|
||||
(make-grammar-pict (compiled-lang-pict-builder lang)
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
scheme/gui
|
||||
scheme/pretty
|
||||
scheme/contract
|
||||
(only-in slideshow/pict text dc-for-text-size)
|
||||
(only-in slideshow/pict pict? text dc-for-text-size)
|
||||
redex))
|
||||
|
||||
@(define-syntax (defpattech stx)
|
||||
|
|
@ -1164,51 +1164,66 @@ for use in combination with other libraries that operate on picts
|
|||
The primary difference between these functions is that the former list
|
||||
sets @scheme[dc-for-text-size] and the latter does not.
|
||||
|
||||
@defthing[render-language (case-> (-> compiled-lang?
|
||||
pict?)
|
||||
(-> compiled-lang?
|
||||
(or/c string? path?)
|
||||
void?))]{
|
||||
@defproc[(render-language [lang compiled-lang?]
|
||||
[file (or/c false/c path-string?) #f]
|
||||
[#:nts nts (or/c false/c (listof (or/c string? symbol?)))
|
||||
(render-language-nts)])
|
||||
(if file void? pict?)]{
|
||||
|
||||
This function renders a language. If it receives just a
|
||||
single argument, it produces a pict and if it receives two
|
||||
arguments, it saves PostScript in the provided filename.
|
||||
Renders a language. If @scheme[file] is @scheme[#f],
|
||||
it produces a pict; if @scheme[file] is a path, it saves
|
||||
Encapsulated PostScript in the provided filename. See
|
||||
@scheme[render-language-nts] for information on the
|
||||
@scheme[nts] argument.
|
||||
|
||||
That this function calls @scheme[dc-for-text-size] to set
|
||||
the dc to a relevant dc (either a @scheme[bitmap-dc%] or a
|
||||
@scheme[ps-dc%] depending if the function is called with one
|
||||
or two arguments, respectively).
|
||||
This function parameterizes @scheme[dc-for-text-size] to install a
|
||||
relevant dc: a @scheme[bitmap-dc%] or a @scheme[post-script-dc%], depending on
|
||||
whether @scheme[file] is a path.
|
||||
|
||||
See @scheme[language->pict] if you are using slideshow or
|
||||
See @scheme[language->pict] if you are using Slideshow or
|
||||
are otherwise setting @scheme[dc-for-text-size]. }
|
||||
|
||||
@defproc[(language->pict (lang compiled-lang?)) pict?]{
|
||||
This function turns a languages into a picts. It is
|
||||
primarily designed to be used with Slideshow, or with
|
||||
other tools that combine picts together. It does not
|
||||
set @scheme[dc-for-text-size].
|
||||
@defproc[(language->pict (lang compiled-lang?)
|
||||
[#:nts nts (or/c false/c (listof (or/c string? symbol?)))
|
||||
(render-language-nts)])
|
||||
pict?]{
|
||||
|
||||
Produce a pict like @scheme[render-language], but without
|
||||
adjust @scheme[dc-for-text-size].
|
||||
|
||||
This function is
|
||||
primarily designed to be used with Slideshow or with
|
||||
other tools that combine picts together.
|
||||
}
|
||||
|
||||
@defthing[render-reduction-relation (case-> (-> reduction-relation?
|
||||
pict?)
|
||||
(-> reduction-relation?
|
||||
(or/c string? path?)
|
||||
void?))]{
|
||||
@defproc[(render-reduction-relation [rel reduction-relation?]
|
||||
[file (or/c false/c path-string?) #f]
|
||||
[#:style style reduction-rule-style/c (rule-pict-style)])
|
||||
(if file void? pict?)]{
|
||||
|
||||
If provided with one argument, @scheme[render-reduction-relation]
|
||||
produces a pict that renders properly in the definitions
|
||||
window in DrScheme. If given two argument, it writes
|
||||
postscript into the file named by its second argument.
|
||||
Renders a reduction relation. If @scheme[file] is @scheme[#f],
|
||||
it produces a pict; if @scheme[file] is a path, it saves
|
||||
Encapsulated PostScript in the provided filename. See
|
||||
@scheme[rule-pict-style] for information on the
|
||||
@scheme[style] argument.
|
||||
|
||||
This function sets @scheme[dc-for-text-size]. See also
|
||||
This function parameterizes @scheme[dc-for-text-size] to install a
|
||||
relevant dc: a @scheme[bitmap-dc%] or a @scheme[post-script-dc%], depending on
|
||||
whether @scheme[file] is a path. See also
|
||||
@scheme[reduction-relation->pict].
|
||||
|
||||
}
|
||||
|
||||
@defproc[(reduction-relation->pict (r reduction-relation?)) pict?]{
|
||||
This produces a pict, but without setting @scheme[dc-for-text-size].
|
||||
It is suitable for use in Slideshow or other libraries that combine
|
||||
picts.
|
||||
@defproc[(reduction-relation->pict (r reduction-relation?)
|
||||
[#:style style reduction-rule-style/c (rule-pict-style)])
|
||||
pict?]{
|
||||
|
||||
Produces a pict like @scheme[render-reduction-relation], but
|
||||
without setting @scheme[dc-for-text-size].
|
||||
|
||||
This function is
|
||||
primarily designed to be used with Slideshow or with
|
||||
other tools that combine picts together.
|
||||
}
|
||||
|
||||
@deftogether[[
|
||||
|
|
@ -1236,7 +1251,7 @@ This function sets @scheme[dc-for-text-size]. See also
|
|||
|
||||
@defparam[render-language-nts nts (or/c false/c (listof symbol?))]{
|
||||
The value of this parameter controls which non-terminals
|
||||
@scheme[render-language] and @scheme[language->pict] render. If it
|
||||
@scheme[render-language] and @scheme[language->pict] render by default. If it
|
||||
is @scheme[#f] (the default), all non-terminals are rendered.
|
||||
If it is a list of symbols, only the listed symbols are rendered.
|
||||
|
||||
|
|
@ -1263,22 +1278,31 @@ multi-line right-hand sides.
|
|||
will be rendered.
|
||||
}
|
||||
|
||||
@defparam[rule-pict-style style
|
||||
(symbols 'vertical
|
||||
'compact-vertical
|
||||
'vertical-overlapping-side-conditions
|
||||
'horizontal)]{
|
||||
@defparam[rule-pict-style style reduction-rule-style/c]{
|
||||
|
||||
This parameter controls the style used for the reduction
|
||||
relation. It can be either horizontal, where the left and
|
||||
This parameter controls the style used by default for the reduction
|
||||
relation. It can be @scheme['horizontal], where the left and
|
||||
right-hand sides of the reduction rule are beside each other
|
||||
or vertical, where the left and right-hand sides of the
|
||||
reduction rule are above each other. The vertical mode also
|
||||
has a variant where the side-conditions don't contribute to
|
||||
or @scheme['vertical], where the left and right-hand sides of the
|
||||
reduction rule are above each other.
|
||||
The @scheme['compact-vertical] style moves the reduction arrow
|
||||
to the second line and uses less space between lines.
|
||||
Finally, in the @scheme['vertical-overlapping-side-conditions] variant, the side-conditions don't contribute to
|
||||
the width of the pict, but are just overlaid on the second
|
||||
line of each rule.
|
||||
}
|
||||
|
||||
@defthing[reduction-rule-style/c flat-contract?]{
|
||||
|
||||
A contract equivalent to
|
||||
|
||||
@schemeblock[
|
||||
(symbols 'vertical
|
||||
'compact-vertical
|
||||
'vertical-overlapping-side-conditions
|
||||
'horizontal)
|
||||
]}
|
||||
|
||||
@defparam[arrow-space space natural-number/c]{
|
||||
|
||||
This parameter controls the amount of extra horizontal space
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user