diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 23a1356f..ac340736 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -56,6 +56,14 @@ ((nullo l) (nullo yes) (nullo no)) ((fresh (a d y-rest n-rest) (conso a d l) (conde ((pred a) (conso a y-rest yes) (== no n-rest) (partitiono pred d y-rest n-rest)) ((nafc (pred a)) (== yes y-rest) (conso a n-rest no) (partitiono pred d y-rest n-rest)))))))) +(define + foldr-o + (fn + (rel l acc result) + (conde + ((nullo l) (== result acc)) + ((fresh (a d r-rest) (conso a d l) (foldr-o rel d acc r-rest) (rel a r-rest result)))))) + (define membero (fn @@ -80,6 +88,7 @@ ((nullo l1)) ((fresh (a d) (conso a d l1) (membero a l2) (subseto d l2)))))) + (define reverseo (fn @@ -88,7 +97,6 @@ ((nullo l) (nullo r)) ((fresh (a d res-rev) (conso a d l) (reverseo d res-rev) (appendo res-rev (list a) r)))))) - (define rev-acco (fn diff --git a/lib/minikanren/tests/foldr-o.sx b/lib/minikanren/tests/foldr-o.sx new file mode 100644 index 00000000..7a24ca5e --- /dev/null +++ b/lib/minikanren/tests/foldr-o.sx @@ -0,0 +1,38 @@ +;; lib/minikanren/tests/foldr-o.sx — relational right fold. + +(mk-test + "foldr-o-empty" + (run* q (foldr-o conso (list) (list 99) q)) + (list (list 99))) + +(mk-test + "foldr-o-conso-rebuilds-list" + (run* q (foldr-o conso (list 1 2 3) (list) q)) + (list (list 1 2 3))) + +(mk-test + "foldr-o-appendo-flattens" + (run* + q + (foldr-o + appendo + (list + (list 1 2) + (list 3) + (list 4 5)) + (list) + q)) + (list (list 1 2 3 4 5))) + +(mk-test + "foldr-o-with-acc-init" + (run* + q + (foldr-o + conso + (list 1 2) + (list 9 9) + q)) + (list (list 1 2 9 9))) + +(mk-tests-run!)