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

fixed PR 10041

Browse Source 
svn: r13442
This commit is contained in:
Robby Findler 2009-02-05 00:23:47 +00:00
parent 8802b83c0a
commit 7eaef08d63
5 changed files with 24 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/redex/private/bitmap-test.ss
View File

@ -76,5 +76,16 @@
;; when the metafunction is rendered
(test (render-metafunction TL) "metafunction-TL.png")
(define-metafunction lang
[(Name (name x-arg arg))
,(term-let ((x-term-let 1))
(term (x-where x-term-let)))
(where x-where 2)])
;; this tests that the three variable bindings
;; (x-arg, x-term-let, and x-where)
;; all show up in the output.
(test (render-metafunction Name) "metafunction-Name.png")
(printf "bitmap-test.ss: ")
(done)

BIN
collects/redex/private/bmps/metafunction-Name.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 4.3 KiB

BIN
collects/redex/private/bmps/metafunction-T.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 2.9 KiB

After

Width:  |  Height:  |  Size: 3.4 KiB

BIN
collects/redex/private/bmps/metafunction-TL.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 3.7 KiB

After

Width:  |  Height:  |  Size: 4.5 KiB

14
collects/redex/private/reduction-semantics.ss
View File

@ -995,7 +995,13 @@
(syntax->list #'((tl-side-conds ...) ...)))]
[(((bind-id . bind-pat) ...) ...)
;; Also for pict, extract pattern bindings
(map extract-pattern-binds (syntax->list #'(lhs ...)))])
(map extract-pattern-binds (syntax->list #'(lhs ...)))]
[(((rhs-bind-id . rhs-bind-pat) ...) ...)
;; Also for pict, extract pattern bindings
(map extract-term-let-binds (syntax->list #'(rhs ...)))]
[(((where-id where-pat) ...) ...)
;; Also for pict, extract where bindings
#'(tl-bindings ...)])
#`(begin
(define-values (name2 name-predicate)
(let ([sc `(side-conditions-rewritten ...)]
@ -1019,6 +1025,12 @@
(list (to-lw/uq side-cond) ...)
(list (cons (to-lw bind-id)
(to-lw bind-pat))
...
(cons (to-lw rhs-bind-id)
(to-lw rhs-bind-pat))
...
(cons (to-lw where-id)
(to-lw where-pat))
...)
(to-lw rhs))
...)