diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index c9b8b24e..a2c8f231 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -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 diff --git a/lib/minikanren/tests/flat-mapo.sx b/lib/minikanren/tests/flat-mapo.sx new file mode 100644 index 00000000..fd98f3f3 --- /dev/null +++ b/lib/minikanren/tests/flat-mapo.sx @@ -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!)