Skip to content

Commit

Permalink
it appears that the check for empty list when the depth is 'unknown-m…
Browse files Browse the repository at this point in the history
…ismatch-depth was overzealous

The way that things work, as soon as there is something in the one of the nested lists that needs to be checked to make sure they are different, then we're going to get the correct depth in `nesting-depth`

closes #268
  • Loading branch information
rfindler committed Nov 16, 2024
1 parent ac38ebd commit c21e7f3
Show file tree
Hide file tree
Showing 2 changed files with 35 additions and 18 deletions.
29 changes: 11 additions & 18 deletions redex-lib/redex/private/matcher.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -690,24 +690,17 @@ See match-a-pattern.rkt for more details
(define table (make-hash))
(hash-set! mismatch-ht name table)
(set! priors table))
(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))]))])]))
(unless (equal? nesting-depth 'unknown-mismatch-depth)
(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-bindings (hash-map match-ht make-bind)))))

;; compile-pattern : compiled-lang pattern boolean -> compiled-pattern
Expand Down
24 changes: 24 additions & 0 deletions redex-test/redex/tests/matcher-test.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -176,6 +176,30 @@
(make-bind '..._1 2)))
'(1 1 1 1 2 2)
none)))
(test-empty '(list (repeat (list (repeat (mismatch-name number_!_ number) #f #f)) #f #f))
'(())
(list (make-mtch (make-bindings '()) '(()) none)))
(test-empty '(list (repeat (list (repeat (mismatch-name number_!_ number) #f #f)) #f #f))
'(() ())
(list (make-mtch (make-bindings '()) '(() ()) none)))
(test-empty '(list (repeat (list (repeat (list (repeat (mismatch-name number_!_ number) #f #f)) #f #f)) #f #f))
'(() ())
(list (make-mtch (make-bindings '()) '(() ()) none)))
(test-empty '(list (repeat (list (repeat (list (repeat (mismatch-name number_!_ number) #f #f)) #f #f)) #f #f))
'(() (()))
(list (make-mtch (make-bindings '()) '(() (())) none)))
(test-empty '(list (repeat (list (repeat (list (repeat (mismatch-name number_!_ number) #f #f)) #f #f)) #f #f))
'(() ((())))
#f)
(test-empty '(list (repeat (list (repeat (list (repeat (mismatch-name number_!_ number) #f #f)) #f #f)) #f #f))
'(() ((1)))
(list (make-mtch (make-bindings '()) '(() ((1))) none)))
(test-empty '(list (repeat (list (repeat (list (repeat (mismatch-name number_!_ number) #f #f)) #f #f)) #f #f))
'(() (()))
(list (make-mtch (make-bindings '()) '(() (())) none)))
(test-empty '(list (repeat (list (repeat (list (repeat (mismatch-name number_!_ number) #f #f)) #f #f)) #f #f))
'(() (1))
#f)

(test-ellipses '(a) '(a))
(test-ellipses '((repeat a #f #f)) `(,(make-repeat 'a '() #f #f)))
Expand Down

0 comments on commit c21e7f3

Please sign in to comment.