Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

fix combinatorial explosion in match-not (issue #698)

Browse source
This commit is contained in:
Alex Shinn 2020-09-01 16:38:42 +09:00
parent 29df4211ee
commit 717aeb9e8b
2 changed files with 3 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
lib/chibi/match-test.sld
View file

@ -33,6 +33,7 @@
(test "or double" 'ok (match 'ok ((or (? symbol? y) y) y))) (test "or double" 'ok (match 'ok ((or (? symbol? y) y) y)))
(test "or unbalanced" 1 (match 1 ((or (and 1 x) (and 2 y)) x))) (test "or unbalanced" 1 (match 1 ((or (and 1 x) (and 2 y)) x)))
(test "not" 'ok (match 28 ((not (a . b)) 'ok))) (test "not" 'ok (match 28 ((not (a . b)) 'ok)))
(test "not fail" 'bad (match 28 ((not a) 'ok) (else 'bad)))
(test "pred" 'ok (match 28 ((? number?) 'ok))) (test "pred" 'ok (match 28 ((? number?) 'ok)))
(test "named pred" 29 (match 28 ((? number? x) (+ x 1)))) (test "named pred" 29 (match 28 ((? number? x) (+ x 1))))

3
lib/chibi/match/match.scm
View file

@ -385,7 +385,8 @@
((match-two v (or p ...) g+s sk fk i) ((match-two v (or p ...) g+s sk fk i)
(match-extract-vars (or p ...) (match-gen-or v (p ...) g+s sk fk i) i ())) (match-extract-vars (or p ...) (match-gen-or v (p ...) g+s sk fk i) i ()))
((match-two v (not p) g+s (sk ...) fk i) ((match-two v (not p) g+s (sk ...) fk i)
(match-one v p g+s (match-drop-ids fk) (sk ... i) i)) (let ((sk2 (lambda () fk)))
(match-one v p g+s (match-drop-ids (sk2)) (sk ... i) i)))
((match-two v (get! getter) (g s) (sk ...) fk i) ((match-two v (get! getter) (g s) (sk ...) fk i)
(let ((getter (lambda () g))) (sk ... i))) (let ((getter (lambda () g))) (sk ... i)))
((match-two v (set! setter) (g (s ...)) (sk ...) fk i) ((match-two v (set! setter) (g (s ...)) (sk ...) fk i)