fixed PR 10041

svn: r13442

collects/redex/private/bitmap-test.ss

@@ -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)

collects/redex/private/reduction-semantics.ss

@@ -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))
                                        ...)