Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Fix bug of not pattern over guard pattern

  • Loading branch information...
commit 19fe1ef5b1a5162f4be53b1faa0a6a46d20cecb0 1 parent 7173170
Tomohiro Matsuyama authored
Showing with 14 additions and 1 deletion.
  1. +8 −0 src/pattern.lisp
  2. +6 −1 test/suite.lisp
View
8 src/pattern.lisp
@@ -259,6 +259,14 @@ occurence like:
(subpattern (guard-pattern-subpattern subpattern)))
(make-guard-pattern subpattern test-form))
pattern)))
+ ((not-pattern-p pattern)
+ ;; Stop lifting on not pattern.
+ (let* ((subpattern (not-pattern-subpattern pattern))
+ (lifted-subpattern (lift-guard-patterns subpattern)))
+ (if (and (not (guard-pattern-p subpattern))
+ (guard-pattern-p lifted-subpattern))
+ (make-not-pattern lifted-subpattern)
+ pattern)))
((or-pattern-p pattern)
;; OR local lift.
(let* ((subpatterns (or-pattern-subpatterns pattern))
View
7 test/suite.lisp
@@ -202,7 +202,12 @@
(is-not-match 1 (not 1))
;; double negation
(is-not-match 1 (not (not (not 1))))
- (is-match 1 (not (not (not (not 1))))))
+ (is-match 1 (not (not (not (not 1)))))
+ ;; complex
+ (is-match 1 (not (guard it (consp it))))
+ (is (equal (let ((it 1))
+ (match 2 ((not (guard it (eql it 3))) it)))
+ 1)))
(test or-pattern
(is-not-match 1 (or))
Please sign in to comment.
Something went wrong with that request. Please try again.