From ebad17e4f75ad4d57be107e8cb5f7b1b5297aa95 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Thu, 22 Jan 2009 15:06:31 +0000
Subject: [PATCH] svn: r13257

---
 collects/redex/private/bitmap-test.ss         | 13 +++++++++++++
 collects/redex/private/pict.ss                | 15 ++++++++-------
 collects/redex/private/reduction-semantics.ss |  2 +-
 3 files changed, 22 insertions(+), 8 deletions(-)

diff --git a/collects/redex/private/bitmap-test.ss b/collects/redex/private/bitmap-test.ss
index 0746e6f8fd..fdff95ce89 100644
--- a/collects/redex/private/bitmap-test.ss
+++ b/collects/redex/private/bitmap-test.ss
@@ -42,6 +42,19 @@
 (test (render-metafunction S)
       "metafunction.png")
 
+(define-metafunction lang
+  [(T x y)
+   1
+   (side-condition (not (eq? (term x) (term y))))]
+  [(T x x) 
+   n
+   (where n 2)])
+
+;; in this test, the metafunction has 2 clauses 
+;; with a side-condition on the first clause
+;; and a 'where' in the second clause
+(test (render-metafunction T) "metafunction-T.png")
+
 ;; in this test, teh `x' is italic and the 'z' is sf, since 'x' is in the grammar, and 'z' is not.
 (test (render-lw 
        lang 
diff --git a/collects/redex/private/pict.ss b/collects/redex/private/pict.ss
index 95638fe6b5..c62244491c 100644
--- a/collects/redex/private/pict.ss
+++ b/collects/redex/private/pict.ss
@@ -659,21 +659,22 @@
              [lhss (map (lambda (eqn) 
                           (wrapper->pict
                            (metafunction-call (metafunc-proc-name (metafunction-proc mf))
-                                              (car eqn)
+                                              (list-ref eqn 0)
                                               (metafunc-proc-multi-arg? (metafunction-proc mf)))))
                         eqns)]
              [scs (map (lambda (eqn)
-                         (if (and (null? (cadr eqn))
-                                  (null? (caddr eqn)))
+                         (if (and (null? (list-ref eqn 1))
+                                  (null? (list-ref eqn 2)))
                              #f
                              (side-condition-pict null 
-                                                  (map wrapper->pict (cadr eqn)) 
+                                                  (map wrapper->pict (list-ref eqn 1)) 
                                                   (map (lambda (p)
-                                                         (cons (wrapper->pict (car p)) (wrapper->pict (cdr p))))
-                                                       (caddr eqn))
+                                                         (cons (wrapper->pict (car p))
+                                                               (wrapper->pict (cdr p))))
+                                                       (list-ref eqn 2))
                                                   +inf.0)))
                        eqns)]
-             [rhss (map (lambda (eqn) (wrapper->pict (cadddr eqn))) eqns)]
+             [rhss (map (lambda (eqn) (wrapper->pict (list-ref eqn 3))) eqns)]
              [linebreak-list (or current-linebreaks
                                  (map (lambda (x) #f) eqns))]
              [=-pict (make-=)]
diff --git a/collects/redex/private/reduction-semantics.ss b/collects/redex/private/reduction-semantics.ss
index 5eb3994a4f..a210df3e41 100644
--- a/collects/redex/private/reduction-semantics.ss
+++ b/collects/redex/private/reduction-semantics.ss
@@ -1012,7 +1012,7 @@
                                     (let ([term-fn (syntax-local-value prev-metafunction)])
                                       #`(metafunc-proc-rhss #,(term-fn-get-id term-fn)))
                                     #''())
-                              (λ (f/dom cps rhss) 
+                              (λ (f/dom cps rhss)
                                 (make-metafunc-proc
                                  (let ([name (lambda (x) (f/dom x))]) name)
                                  (list (list (to-lw lhs-for-lw)