diff --git a/collects/redex/private/reduction-semantics.rkt b/collects/redex/private/reduction-semantics.rkt index 288603e6e3..579698fe5c 100644 --- a/collects/redex/private/reduction-semantics.rkt +++ b/collects/redex/private/reduction-semantics.rkt @@ -1521,16 +1521,8 @@ (syntax->list stuffs))) (syntax->list extras)))) -(define (build-metafunction lang cases parent-cases/wrong-lang wrap dom-contract-pat codom-contract-pat name relation?) - (let ([parent-cases (map (λ (parent-case) - (make-metafunc-case - (compile-pattern lang (metafunc-case-lhs-pat parent-case) #t) - (metafunc-case-rhs parent-case) - (metafunc-case-lhs-pat parent-case) - (metafunc-case-src-loc parent-case) - (metafunc-case-id parent-case))) - parent-cases/wrong-lang)] - [dom-compiled-pattern (and dom-contract-pat (compile-pattern lang dom-contract-pat #f))] +(define (build-metafunction lang cases parent-cases wrap dom-contract-pat codom-contract-pat name relation?) + (let ([dom-compiled-pattern (and dom-contract-pat (compile-pattern lang dom-contract-pat #f))] [codom-compiled-pattern (compile-pattern lang codom-contract-pat #f)]) (values (wrap @@ -1554,7 +1546,6 @@ (metafunc-proc-cases r))) (cover-case id c)))) (relation-coverage))))] - [all-cases (append cases parent-cases)] [metafunc (λ (exp) (let ([cache-ref (hash-ref cache exp not-in-cache)]) @@ -1565,7 +1556,7 @@ (redex-error name "~s is not in my domain" `(,name ,@exp)))) - (let loop ([cases all-cases] + (let loop ([cases (append cases parent-cases)] [num (- (length parent-cases))]) (cond [(null? cases) diff --git a/collects/redex/tests/tl-test.rkt b/collects/redex/tests/tl-test.rkt index 3684c5d138..29033b51d3 100644 --- a/collects/redex/tests/tl-test.rkt +++ b/collects/redex/tests/tl-test.rkt @@ -530,7 +530,9 @@ [(h number_1) number_1]) (test (term (g 11 17)) 11) (test (term (h 11 17)) 11)) - + + ; We'd like this expression not to raise an error. + #; (let () (define-language L (v 1)) @@ -550,6 +552,8 @@ [(g any) 2]) (test (term (g 0)) 2)) + ; We'd like this expression not to raise an error. + #; (let () (define-language L (v 1 (v)))