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

fix bug in recent _!_ semantics change

Browse Source
This commit is contained in:
Robby Findler 2014-05-24 11:57:34 -05:00
parent 69c96c628d
commit f26a5b60d7
2 changed files with 21 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
pkgs/redex-pkgs/redex-lib/redex/private/matcher.rkt
View File

@ -682,16 +682,24 @@ See match-a-pattern.rkt for more details
(define table (make-hash))
(hash-set! mismatch-ht name table)
(set! priors table))
(let loop ([depth nesting-depth]
[exp exp])
(cond
[(= depth 0)
(when (hash-ref priors exp #f)
(fail #f))
(hash-set! priors exp #t)]
[else
(for ([exp-ele (in-list exp)])
(loop (- depth 1) exp-ele))]))]))
(cond
[(equal? nesting-depth 'unknown-mismatch-depth)
(unless (null? exp)
(error 'matcher.rkt
(string-append "invariant broken; unknown-mismatch-depth should"
" appear only when the expression is an empty list: ~s")
exp))]
[else
(let loop ([depth nesting-depth]
[exp exp])
(cond
[(= depth 0)
(when (hash-ref priors exp #f)
(fail #f))
(hash-set! priors exp #t)]
[else
(for ([exp-ele (in-list exp)])
(loop (- depth 1) exp-ele))]))])]))
(make-mtch
(make-bindings (hash-map match-ht make-bind))
(mtch-context match)

3
pkgs/redex-pkgs/redex-test/redex/tests/matcher-test.rkt
View File

@ -143,6 +143,9 @@
(repeat (mismatch-name number_!_1 number) #f #f))
'((1 2) (3 4) 5 6)
(list (make-test-mtch (make-bindings (list)) '((1 2) (3 4) 5 6) none)))
(test-empty '(list (repeat (mismatch-name number_!_1 number) #f #f))
'()
(list (make-test-mtch (make-bindings (list)) '() none)))
(test-empty '(list (repeat (name x_1 1) ..._1 ..._!_1)
(repeat (name x_1 1) ..._1 #f)