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

fix broken earlier commit

Browse Source
This commit is contained in:
Robby Findler 2011-05-25 14:42:37 -05:00
parent e3c552b785
commit d74810a08b
1 changed files with 16 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/redex/private/reduction-semantics.rkt
View File

@ -1120,19 +1120,24 @@
(define-struct match (bindings) #:inspector #f) (define-struct match (bindings) #:inspector #f)
(define (do-test-match lang pat binders name) (define (do-test-match lang pat binders context-name)
(unless (compiled-lang? lang) (unless (compiled-lang? lang)
(error 'redex-match "expected first argument to be a language, got ~e" lang)) (error 'redex-match "expected first argument to be a language, got ~e" lang))
(let ([cpat (compile-pattern lang pat #t)]) (define name (or context-name
(procedure-rename (and (symbol? pat)
(λ (exp) pat)))
(let ([ans (match-pattern cpat exp)]) (define cpat (compile-pattern lang pat #t))
(and ans (define redex-match-proc
(map (λ (m) (make-match (sort-bindings (λ (exp)
(filter (λ (x) (memq (bind-name x) binders)) (let ([ans (match-pattern cpat exp)])
(bindings-table (mtch-bindings m)))))) (and ans
ans)))) (map (λ (m) (make-match (sort-bindings
name))) (filter (λ (x) (memq (bind-name x) binders))
(bindings-table (mtch-bindings m))))))
ans)))))
(if name
(procedure-rename redex-match-proc name)
redex-match-proc))
(define (sort-bindings bnds) (define (sort-bindings bnds)
(sort (sort