mk: flat-mapo — concatMap-style relation
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
(flat-mapo rel l result): each element x of l is mapped to a list via
rel x list-from-x, and all such lists are concatenated to form result.
(flat-mapo (fn (x r) (== r (list x x))) (list 1 2 3) q)
-> ((1 1 2 2 3 3))
5 new tests, 515/515 cumulative.
This commit is contained in:
@@ -72,6 +72,14 @@
|
||||
((nullo l) (== result acc))
|
||||
((fresh (a d new-acc) (conso a d l) (rel acc a new-acc) (foldl-o rel d new-acc result))))))
|
||||
|
||||
(define
|
||||
flat-mapo
|
||||
(fn
|
||||
(rel l result)
|
||||
(conde
|
||||
((nullo l) (nullo result))
|
||||
((fresh (a d a-result rest-result) (conso a d l) (rel a a-result) (flat-mapo rel d rest-result) (appendo a-result rest-result result))))))
|
||||
|
||||
(define
|
||||
membero
|
||||
(fn
|
||||
@@ -80,6 +88,7 @@
|
||||
((fresh (d) (conso x d l)))
|
||||
((fresh (a d) (conso a d l) (membero x d))))))
|
||||
|
||||
|
||||
(define
|
||||
not-membero
|
||||
(fn
|
||||
@@ -88,7 +97,6 @@
|
||||
((nullo l))
|
||||
((fresh (a d) (conso a d l) (nafc (== a x)) (not-membero x d))))))
|
||||
|
||||
|
||||
(define
|
||||
subseto
|
||||
(fn
|
||||
|
||||
39
lib/minikanren/tests/flat-mapo.sx
Normal file
39
lib/minikanren/tests/flat-mapo.sx
Normal file
@@ -0,0 +1,39 @@
|
||||
;; lib/minikanren/tests/flat-mapo.sx — concatMap-style relation.
|
||||
|
||||
(mk-test
|
||||
"flat-mapo-empty"
|
||||
(run* q (flat-mapo (fn (x r) (== r (list x x))) (list) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"flat-mapo-duplicate-each"
|
||||
(run*
|
||||
q
|
||||
(flat-mapo
|
||||
(fn (x r) (== r (list x x)))
|
||||
(list 1 2 3)
|
||||
q))
|
||||
(list
|
||||
(list 1 1 2 2 3 3)))
|
||||
|
||||
(mk-test
|
||||
"flat-mapo-empty-from-each"
|
||||
(run* q (flat-mapo (fn (x r) (== r (list))) (list :a :b :c) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"flat-mapo-singleton-from-each-is-identity"
|
||||
(run* q (flat-mapo (fn (x r) (== r (list x))) (list :a :b :c) q))
|
||||
(list (list :a :b :c)))
|
||||
|
||||
(mk-test
|
||||
"flat-mapo-tag-each"
|
||||
(run*
|
||||
q
|
||||
(flat-mapo
|
||||
(fn (x r) (== r (list :tag x)))
|
||||
(list 1 2)
|
||||
q))
|
||||
(list (list :tag 1 :tag 2)))
|
||||
|
||||
(mk-tests-run!)
|
||||
Reference in New Issue
Block a user