;; lib/minikanren/tests/condu.sx — Phase 2 piece D tests for `onceo` and `condu`.

;; --- onceo: at most one answer ---

(mk-test
  "onceo-single-success-passes-through"
  (let
    ((q (mk-var "q")))
    (let
      ((res (stream-take 5 ((onceo (== q 7)) empty-s))))
      (map (fn (s) (mk-walk q s)) res)))
  (list 7))

(mk-test
  "onceo-multi-success-trimmed-to-one"
  (let
    ((q (mk-var "q")))
    (let
      ((res (stream-take 5 ((onceo (mk-disj (== q 1) (== q 2) (== q 3))) empty-s))))
      (map (fn (s) (mk-walk q s)) res)))
  (list 1))

(mk-test
  "onceo-failure-stays-failure"
  ((onceo (== 1 2)) empty-s)
  (list))

(mk-test
  "onceo-conde-trimmed"
  (let
    ((q (mk-var "q")))
    (let
      ((res (stream-take 5 ((onceo (conde ((== q "a")) ((== q "b")))) empty-s))))
      (map (fn (s) (mk-walk q s)) res)))
  (list "a"))

;; --- condu: first clause with successful head wins ---

(mk-test
  "condu-first-clause-wins"
  (let
    ((q (mk-var "q")))
    (let
      ((res (stream-take 10 ((condu ((== q 1)) ((== q 2))) empty-s))))
      (map (fn (s) (mk-walk q s)) res)))
  (list 1))

(mk-test
  "condu-skips-failing-head"
  (let
    ((q (mk-var "q")))
    (let
      ((res (stream-take 10 ((condu ((== 1 2)) ((== q 100)) ((== q 200))) empty-s))))
      (map (fn (s) (mk-walk q s)) res)))
  (list 100))

(mk-test
  "condu-all-fail-empty"
  ((condu ((== 1 2)) ((== 3 4)))
    empty-s)
  (list))

(mk-test "condu-empty-clauses-fail" ((condu) empty-s) (list))

;; --- condu commits head's first answer; rest-goals can still backtrack
;;     within that committed substitution but cannot revisit other heads. ---

(mk-test
  "condu-head-onceo-rest-runs"
  (let
    ((q (mk-var "q")) (r (mk-var "r")))
    (let
      ((res (stream-take 10 ((condu ((mk-disj (== q 1) (== q 2)) (== r 99))) empty-s))))
      (map (fn (s) (list (mk-walk q s) (mk-walk r s))) res)))
  (list (list 1 99)))

(mk-test
  "condu-rest-goals-can-fail-the-clause"
  (let
    ((q (mk-var "q")))
    (let
      ((res (stream-take 10 ((condu ((== q 1) (== 2 3)) ((== q 99))) empty-s))))
      (map (fn (s) (mk-walk q s)) res)))
  (list))

(mk-tests-run!)