mk: take-while-o + drop-while-o — predicate-driven prefix/suffix
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
(take-while-o pred l result): take elements from l while pred holds, stopping at the first element that fails. (drop-while-o pred l result): drop matching elements, return the rest including the first non-match. Together: (take-while p l) ⊕ (drop-while p l) = l, verified by an end-to-end roundtrip test. 8 new tests, 546/546 cumulative.
This commit is contained in:
@@ -89,6 +89,22 @@
|
|||||||
((fresh (a d r-rest) (conso a d l) (conde ((membero a d) (nub-o d result)) ((nafc (membero a d)) (conso a r-rest result) (nub-o d r-rest))))))))
|
((fresh (a d r-rest) (conso a d l) (conde ((membero a d) (nub-o d result)) ((nafc (membero a d)) (conso a r-rest result) (nub-o d r-rest))))))))
|
||||||
|
|
||||||
|
|
||||||
|
(define
|
||||||
|
take-while-o
|
||||||
|
(fn
|
||||||
|
(pred l result)
|
||||||
|
(conde
|
||||||
|
((nullo l) (nullo result))
|
||||||
|
((fresh (a d r-rest) (conso a d l) (conde ((pred a) (conso a r-rest result) (take-while-o pred d r-rest)) ((nafc (pred a)) (== result (list)))))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
drop-while-o
|
||||||
|
(fn
|
||||||
|
(pred l result)
|
||||||
|
(conde
|
||||||
|
((nullo l) (nullo result))
|
||||||
|
((fresh (a d) (conso a d l) (conde ((pred a) (drop-while-o pred d result)) ((nafc (pred a)) (== result l))))))))
|
||||||
|
|
||||||
(define
|
(define
|
||||||
membero
|
membero
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
80
lib/minikanren/tests/take-while-drop-while.sx
Normal file
80
lib/minikanren/tests/take-while-drop-while.sx
Normal file
@@ -0,0 +1,80 @@
|
|||||||
|
;; lib/minikanren/tests/take-while-drop-while.sx — prefix/suffix by predicate.
|
||||||
|
|
||||||
|
(mk-test
|
||||||
|
"take-while-o-empty"
|
||||||
|
(run* q (take-while-o (fn (x) (== x 1)) (list) q))
|
||||||
|
(list (list)))
|
||||||
|
|
||||||
|
(mk-test
|
||||||
|
"take-while-o-while-lt-5"
|
||||||
|
(run*
|
||||||
|
q
|
||||||
|
(take-while-o
|
||||||
|
(fn (x) (lto-i x 5))
|
||||||
|
(list 1 3 7 2 9)
|
||||||
|
q))
|
||||||
|
(list (list 1 3)))
|
||||||
|
|
||||||
|
(mk-test
|
||||||
|
"take-while-o-all-match"
|
||||||
|
(run*
|
||||||
|
q
|
||||||
|
(take-while-o
|
||||||
|
(fn (x) (lto-i x 100))
|
||||||
|
(list 1 2 3)
|
||||||
|
q))
|
||||||
|
(list (list 1 2 3)))
|
||||||
|
|
||||||
|
(mk-test
|
||||||
|
"take-while-o-none-match"
|
||||||
|
(run*
|
||||||
|
q
|
||||||
|
(take-while-o
|
||||||
|
(fn (x) (lto-i 100 x))
|
||||||
|
(list 1 2 3)
|
||||||
|
q))
|
||||||
|
(list (list)))
|
||||||
|
|
||||||
|
(mk-test
|
||||||
|
"drop-while-o-empty"
|
||||||
|
(run* q (drop-while-o (fn (x) (== x 1)) (list) q))
|
||||||
|
(list (list)))
|
||||||
|
|
||||||
|
(mk-test
|
||||||
|
"drop-while-o-while-lt-5"
|
||||||
|
(run*
|
||||||
|
q
|
||||||
|
(drop-while-o
|
||||||
|
(fn (x) (lto-i x 5))
|
||||||
|
(list 1 3 7 2 9)
|
||||||
|
q))
|
||||||
|
(list (list 7 2 9)))
|
||||||
|
|
||||||
|
(mk-test
|
||||||
|
"drop-while-o-all-match"
|
||||||
|
(run*
|
||||||
|
q
|
||||||
|
(drop-while-o
|
||||||
|
(fn (x) (lto-i x 100))
|
||||||
|
(list 1 2 3)
|
||||||
|
q))
|
||||||
|
(list (list)))
|
||||||
|
|
||||||
|
(mk-test
|
||||||
|
"take-drop-roundtrip"
|
||||||
|
(run*
|
||||||
|
q
|
||||||
|
(fresh
|
||||||
|
(p s)
|
||||||
|
(take-while-o
|
||||||
|
(fn (x) (lto-i x 5))
|
||||||
|
(list 1 3 7 2 9)
|
||||||
|
p)
|
||||||
|
(drop-while-o
|
||||||
|
(fn (x) (lto-i x 5))
|
||||||
|
(list 1 3 7 2 9)
|
||||||
|
s)
|
||||||
|
(appendo p s q)))
|
||||||
|
(list (list 1 3 7 2 9)))
|
||||||
|
|
||||||
|
(mk-tests-run!)
|
||||||
Reference in New Issue
Block a user