Permalink
Browse files

Fix bug of not pattern over guard pattern

  • Loading branch information...
Tomohiro Matsuyama
Tomohiro Matsuyama committed Apr 1, 2013
1 parent 7173170 commit 19fe1ef5b1a5162f4be53b1faa0a6a46d20cecb0
Showing with 14 additions and 1 deletion.
  1. +8 −0 src/pattern.lisp
  2. +6 −1 test/suite.lisp
View
@@ -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
@@ -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))

0 comments on commit 19fe1ef

Please sign in to comment.