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

Fix the RHSes of term-lets not being treated as unquoted when converted to lws.

Browse Source 
svn: r13762
This commit is contained in:
Stevie Strickland 2009-02-21 03:33:33 +00:00
parent 7cc03cb42f
commit d23bdbbfaf
2 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -64,11 +64,11 @@
(define-metafunction lang (define-metafunction lang
[(TL 1) (a [(TL 1) (a
,(term-let ((x 1)) ,(term-let ((x (term 1)))
(term x)) (term x))
below-only)] below-only)]
[(TL 2) (a [(TL 2) (a
,(term-let ((x 1)) ,(term-let ((x (term 1)))
(term x)) beside (term x)) beside
below)]) below)])
@ -78,7 +78,7 @@
(define-metafunction lang (define-metafunction lang
[(Name (name x-arg arg)) [(Name (name x-arg arg))
,(term-let ((x-term-let 1)) ,(term-let ((x-term-let (term 1)))
(term (x-where x-term-let))) (term (x-where x-term-let)))
(where x-where 2)]) (where x-where 2)])

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

@ -318,8 +318,9 @@
[(fvars ...) fvars] [(fvars ...) fvars]
[((where-id where-expr) ...) withs] [((where-id where-expr) ...) withs]
[((bind-id . bind-pat) ...) [((bind-id . bind-pat) ...)
(append (extract-pattern-binds #'lhs) (extract-pattern-binds #'lhs)]
(extract-term-let-binds #'rhs))]) [((tl-id . tl-pat) ...)
(extract-term-let-binds #'rhs)])
#`(make-rule-pict 'arrow #`(make-rule-pict 'arrow
(to-lw lhs) (to-lw lhs)
(to-lw rhs) (to-lw rhs)
@ -329,6 +330,9 @@
(list (cons (to-lw bind-id) (list (cons (to-lw bind-id)
(to-lw bind-pat)) (to-lw bind-pat))
... ...
(cons (to-lw tl-id)
(to-lw/uq tl-pat))
...
(cons (to-lw where-id) (cons (to-lw where-id)
(to-lw where-expr)) (to-lw where-expr))
...))))])) ...))))]))
@ -1027,7 +1031,7 @@
(to-lw bind-pat)) (to-lw bind-pat))
... ...
(cons (to-lw rhs-bind-id) (cons (to-lw rhs-bind-id)
(to-lw rhs-bind-pat)) (to-lw/uq rhs-bind-pat))
... ...
(cons (to-lw where-id) (cons (to-lw where-id)
(to-lw where-pat)) (to-lw where-pat))