;; lib/minikanren/tests/goals.sx — Phase 2 tests for stream.sx + goals.sx.
;;
;; Streams use a tagged shape internally (`(:s head tail)`) so that mature
;; cells can have thunk tails — SX has no improper pairs. Test assertions
;; therefore stream-take into a plain SX list, or check goal effects via
;; mk-walk on the resulting subst, instead of inspecting raw streams.

;; --- stream-take base cases (input streams use s-cons / mzero) ---

(mk-test
  "stream-take-zero-from-mature"
  (stream-take 0 (s-cons (empty-subst) mzero))
  (list))

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

(mk-test
  "stream-take-mature-pair"
  (stream-take 5 (s-cons :a (s-cons :b mzero)))
  (list :a :b))

(mk-test
  "stream-take-fewer-than-available"
  (stream-take 1 (s-cons :a (s-cons :b mzero)))
  (list :a))

(mk-test
  "stream-take-all-with-neg-1"
  (stream-take -1 (s-cons :a (s-cons :b (s-cons :c mzero))))
  (list :a :b :c))

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

(mk-test
  "stream-take-forces-thunk"
  (stream-take 5 (fn () (s-cons :x mzero)))
  (list :x))

(mk-test
  "stream-take-forces-nested-thunks"
  (stream-take 5 (fn () (fn () (s-cons :y mzero))))
  (list :y))

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

(mk-test
  "mplus-empty-left"
  (stream-take 5 (mk-mplus mzero (s-cons :r mzero)))
  (list :r))

(mk-test
  "mplus-empty-right"
  (stream-take 5 (mk-mplus (s-cons :l mzero) mzero))
  (list :l))

(mk-test
  "mplus-mature-mature"
  (stream-take
    5
    (mk-mplus (s-cons :a (s-cons :b mzero)) (s-cons :c (s-cons :d mzero))))
  (list :a :b :c :d))

(mk-test
  "mplus-with-paused-left-swaps"
  (stream-take
    5
    (mk-mplus
      (fn () (s-cons :a (s-cons :b mzero)))
      (s-cons :c (s-cons :d mzero))))
  (list :c :d :a :b))

;; --- mk-bind ---

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

(mk-test
  "bind-singleton-identity"
  (stream-take
    5
    (mk-bind (s-cons 5 mzero) (fn (x) (unit x))))
  (list 5))

(mk-test
  "bind-flat-multi"
  (stream-take
    10
    (mk-bind
      (s-cons 1 (s-cons 2 mzero))
      (fn (x) (s-cons x (s-cons (* x 10) mzero)))))
  (list 1 10 2 20))

(mk-test
  "bind-fail-prunes-some"
  (stream-take
    10
    (mk-bind
      (s-cons 1 (s-cons 2 (s-cons 3 mzero)))
      (fn (x) (if (= x 2) mzero (unit x)))))
  (list 1 3))

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

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

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

;; --- == ---

(mk-test
  "eq-ground-success"
  (stream-take 5 ((== 1 1) empty-s))
  (list empty-s))

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

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

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

(mk-test
  "eq-list-mismatch-fails"
  (stream-take
    5
    ((== (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 (stream-take 5 ((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")))
    (stream-take
      5
      ((conj2 (== x 1) (== x 2)) empty-s)))
  (list))

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

(mk-test
  "conj-single-is-goal"
  (let
    ((x (mk-var "x")))
    (mk-walk
      x
      (first
        (stream-take 5 ((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 (stream-take 5 ((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"
  (stream-take 5 ((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 ---

(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 ---

(mk-test
  "eq-check-no-occurs-fails"
  (let
    ((x (mk-var "x")))
    (stream-take 5 ((==-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 (stream-take 5 ((==-check x 5) empty-s)))))
  5)

(mk-tests-run!)