rose-ash/lib/minikanren/tests/goals.sx

;; lib/minikanren/tests/goals.sx — Phase 2 tests for stream.sx + goals.sx.
;;
;; Loaded after: lib/guest/match.sx, lib/minikanren/unify.sx,
;;               lib/minikanren/stream.sx, lib/minikanren/goals.sx.
;; Reuses the mk-test* counters from tests/unify.sx — load that first to
;; accumulate, or call mk-tests-run! after this file alone for fresh totals.

;; --- stream-take base cases ---

(mk-test
  "stream-take-zero-from-mature"
  (stream-take 0 (list 1 2 3))
  (list))

(mk-test "stream-take-from-empty" (stream-take 5 mzero) (list))

(mk-test
  "stream-take-mature-list"
  (stream-take 5 (list 1 2 3))
  (list 1 2 3))

(mk-test
  "stream-take-fewer-than-available"
  (stream-take 2 (list 10 20 30))
  (list 10 20))

(mk-test
  "stream-take-all-with-neg-1"
  (stream-take -1 (list 1 2 3 4))
  (list 1 2 3 4))

;; --- stream-take forces immature thunks ---

(mk-test
  "stream-take-forces-thunk"
  (stream-take 3 (fn () (list "a" "b" "c")))
  (list "a" "b" "c"))

(mk-test
  "stream-take-forces-nested-thunks"
  (stream-take
    3
    (fn () (fn () (list 1 2 3))))
  (list 1 2 3))

;; --- mk-mplus interleaves ---

(mk-test
  "mplus-empty-left"
  (mk-mplus mzero (list 1 2))
  (list 1 2))
(mk-test
  "mplus-empty-right"
  (mk-mplus (list 1 2) mzero)
  (list 1 2))

(mk-test
  "mplus-mature-mature"
  (mk-mplus (list 1 2) (list 3 4))
  (list 1 2 3 4))

(mk-test
  "mplus-with-paused-left-swaps"
  (stream-take 4 (mk-mplus (fn () (list "a" "b")) (list "c" "d")))
  (list "c" "d" "a" "b"))

;; --- mk-bind ---

(mk-test "bind-empty-stream" (mk-bind mzero (fn (s) (unit s))) (list))

(mk-test
  "bind-singleton-identity"
  (mk-bind (list 5) (fn (x) (list x)))
  (list 5))

(mk-test
  "bind-flat-multi"
  (mk-bind
    (list 1 2)
    (fn (x) (list x (* x 10))))
  (list 1 10 2 20))

(mk-test
  "bind-fail-prunes-some"
  (mk-bind
    (list 1 2 3)
    (fn (x) (if (= x 2) (list) (list x))))
  (list 1 3))

;; --- core goals: succeed / fail ---

(mk-test "succeed-yields-singleton" (succeed empty-s) (list empty-s))

(mk-test "fail-yields-mzero" (fail empty-s) (list))

;; --- == ---

(mk-test
  "eq-ground-success"
  (mk-unified? (first ((== 1 1) empty-s)))
  true)

(mk-test "eq-ground-failure" ((== 1 2) empty-s) (list))

(mk-test
  "eq-binds-var"
  (let
    ((x (mk-var "x")))
    (mk-walk x (first ((== x 7) empty-s))))
  7)

(mk-test
  "eq-list-success"
  (let
    ((x (mk-var "x")))
    (mk-walk x (first ((== x (list 1 2)) empty-s))))
  (list 1 2))

(mk-test
  "eq-list-mismatch-fails"
  ((== (list 1 2) (list 1 3)) empty-s)
  (list))

;; --- conj2 / mk-conj ---

(mk-test
  "conj2-both-bind"
  (let
    ((x (mk-var "x")) (y (mk-var "y")))
    (let
      ((s (first ((conj2 (== x 1) (== y 2)) empty-s))))
      (list (mk-walk x s) (mk-walk y s))))
  (list 1 2))

(mk-test
  "conj2-conflict-empty"
  (let
    ((x (mk-var "x")))
    ((conj2 (== x 1) (== x 2)) empty-s))
  (list))

(mk-test "conj-empty-is-succeed" ((mk-conj) empty-s) (list empty-s))

(mk-test
  "conj-single-is-goal"
  (let
    ((x (mk-var "x")))
    (mk-walk x (first ((mk-conj (== x 99)) empty-s))))
  99)

(mk-test
  "conj-three-bindings"
  (let
    ((x (mk-var "x")) (y (mk-var "y")) (z (mk-var "z")))
    (let
      ((s (first ((mk-conj (== x 1) (== y 2) (== z 3)) empty-s))))
      (list (mk-walk x s) (mk-walk y s) (mk-walk z s))))
  (list 1 2 3))

;; --- disj2 / mk-disj ---

(mk-test
  "disj2-both-succeed"
  (let
    ((q (mk-var "q")))
    (let
      ((res (stream-take 5 ((disj2 (== q 1) (== q 2)) empty-s))))
      (map (fn (s) (mk-walk q s)) res)))
  (list 1 2))

(mk-test
  "disj2-fail-or-succeed"
  (let
    ((q (mk-var "q")))
    (let
      ((res (stream-take 5 ((disj2 fail (== q 5)) empty-s))))
      (map (fn (s) (mk-walk q s)) res)))
  (list 5))

(mk-test "disj-empty-is-fail" ((mk-disj) empty-s) (list))

(mk-test
  "disj-three-clauses"
  (let
    ((q (mk-var "q")))
    (let
      ((res (stream-take 5 ((mk-disj (== q "a") (== q "b") (== q "c")) empty-s))))
      (map (fn (s) (mk-walk q s)) res)))
  (list "a" "b" "c"))

;; --- conj/disj nesting (distributivity check) ---

(mk-test
  "disj-of-conj"
  (let
    ((x (mk-var "x")) (y (mk-var "y")))
    (let
      ((res (stream-take 5 ((mk-disj (mk-conj (== x 1) (== y 2)) (mk-conj (== x 3) (== y 4))) empty-s))))
      (map (fn (s) (list (mk-walk x s) (mk-walk y s))) res)))
  (list (list 1 2) (list 3 4)))

;; --- ==-check (occurs-checked equality goal) ---

(mk-test
  "eq-check-no-occurs-fails"
  (let ((x (mk-var "x"))) ((==-check x (list 1 x)) empty-s))
  (list))

(mk-test
  "eq-check-no-occurs-non-occurring-succeeds"
  (let
    ((x (mk-var "x")))
    (mk-walk x (first ((==-check x 5) empty-s))))
  5)

(mk-tests-run!)