;; lib/minikanren/tests/relations.sx — Phase 4 standard relations.
;;
;; Includes the classic miniKanren canaries: appendo forwards / backwards /
;; bidirectionally, membero, listo enumeration.

;; --- nullo / pairo ---

(mk-test
  "nullo-empty-succeeds"
  (run* q (nullo (list)))
  (list (make-symbol "_.0")))

(mk-test "nullo-non-empty-fails" (run* q (nullo (list 1))) (list))

(mk-test
  "pairo-non-empty-succeeds"
  (run* q (pairo (list 1 2)))
  (list (make-symbol "_.0")))

(mk-test "pairo-empty-fails" (run* q (pairo (list))) (list))

;; --- caro / cdro / firsto / resto ---

(mk-test
  "caro-extracts-head"
  (run* q (caro (list 1 2 3) q))
  (list 1))

(mk-test
  "cdro-extracts-tail"
  (run* q (cdro (list 1 2 3) q))
  (list (list 2 3)))

(mk-test
  "firsto-alias-of-caro"
  (run* q (firsto (list 10 20) q))
  (list 10))

(mk-test
  "resto-alias-of-cdro"
  (run* q (resto (list 10 20) q))
  (list (list 20)))

(mk-test
  "caro-cdro-build"
  (run*
    q
    (fresh
      (h t)
      (caro (list 1 2 3) h)
      (cdro (list 1 2 3) t)
      (== q (list h t))))
  (list (list 1 (list 2 3))))

;; --- conso ---

(mk-test
  "conso-forward"
  (run* q (conso 0 (list 1 2 3) q))
  (list (list 0 1 2 3)))

(mk-test
  "conso-extract-head"
  (run*
    q
    (conso
      q
      (list 2 3)
      (list 1 2 3)))
  (list 1))

(mk-test
  "conso-extract-tail"
  (run* q (conso 1 q (list 1 2 3)))
  (list (list 2 3)))

;; --- listo ---

(mk-test
  "listo-empty-succeeds"
  (run* q (listo (list)))
  (list (make-symbol "_.0")))

(mk-test
  "listo-finite-list-succeeds"
  (run* q (listo (list 1 2 3)))
  (list (make-symbol "_.0")))

(mk-test
  "listo-enumerates-shapes"
  (run 3 q (listo q))
  (list
    (list)
    (list (make-symbol "_.0"))
    (list (make-symbol "_.0") (make-symbol "_.1"))))

;; --- appendo: the canary ---

(mk-test
  "appendo-forward-simple"
  (run*
    q
    (appendo (list 1 2) (list 3 4) q))
  (list (list 1 2 3 4)))

(mk-test
  "appendo-forward-empty-l"
  (run* q (appendo (list) (list 3 4) q))
  (list (list 3 4)))

(mk-test
  "appendo-forward-empty-s"
  (run* q (appendo (list 1 2) (list) q))
  (list (list 1 2)))

(mk-test
  "appendo-recovers-tail"
  (run*
    q
    (appendo
      (list 1 2)
      q
      (list 1 2 3 4)))
  (list (list 3 4)))

(mk-test
  "appendo-recovers-prefix"
  (run*
    q
    (appendo
      q
      (list 3 4)
      (list 1 2 3 4)))
  (list (list 1 2)))

(mk-test
  "appendo-backward-all-splits"
  (run*
    q
    (fresh
      (l s)
      (appendo l s (list 1 2 3))
      (== q (list l s))))
  (list
    (list (list) (list 1 2 3))
    (list (list 1) (list 2 3))
    (list (list 1 2) (list 3))
    (list (list 1 2 3) (list))))

(mk-test
  "appendo-empty-empty-empty"
  (run* q (appendo (list) (list) q))
  (list (list)))

;; --- membero ---

(mk-test
  "membero-element-present"
  (run
    1
    q
    (membero 2 (list 1 2 3)))
  (list (make-symbol "_.0")))

(mk-test
  "membero-element-absent-empty"
  (run* q (membero 99 (list 1 2 3)))
  (list))

(mk-test
  "membero-enumerates"
  (run* q (membero q (list "a" "b" "c")))
  (list "a" "b" "c"))

;; --- reverseo ---

(mk-test
  "reverseo-forward"
  (run* q (reverseo (list 1 2 3) q))
  (list (list 3 2 1)))

(mk-test "reverseo-empty" (run* q (reverseo (list) q)) (list (list)))

(mk-test
  "reverseo-singleton"
  (run* q (reverseo (list 42) q))
  (list (list 42)))

(mk-test
  "reverseo-five"
  (run*
    q
    (reverseo (list 1 2 3 4 5) q))
  (list (list 5 4 3 2 1)))

(mk-test
  "reverseo-backward-one"
  (run 1 q (reverseo q (list 1 2 3)))
  (list (list 3 2 1)))

(mk-test
  "reverseo-round-trip"
  (run*
    q
    (fresh (mid) (reverseo (list "a" "b" "c") mid) (reverseo mid q)))
  (list (list "a" "b" "c")))

;; --- lengtho (Peano-style) ---

(mk-test "lengtho-empty-is-z" (run* q (lengtho (list) q)) (list :z))

(mk-test
  "lengtho-of-3"
  (run* q (lengtho (list "a" "b" "c") q))
  (list (list :s (list :s (list :s :z)))))

(mk-test
  "lengtho-empty-from-zero"
  (run 1 q (lengtho q :z))
  (list (list)))

(mk-test
  "lengtho-enumerates-of-length-2"
  (run 1 q (lengtho q (list :s (list :s :z))))
  (list (list (make-symbol "_.0") (make-symbol "_.1"))))

;; --- inserto ---

(mk-test
  "inserto-front"
  (run* q (inserto 0 (list 1 2 3) q))
  (list
    (list 0 1 2 3)
    (list 1 0 2 3)
    (list 1 2 0 3)
    (list 1 2 3 0)))

(mk-test
  "inserto-empty"
  (run* q (inserto 0 (list) q))
  (list (list 0)))

;; --- permuteo ---

(mk-test "permuteo-empty" (run* q (permuteo (list) q)) (list (list)))

(mk-test
  "permuteo-singleton"
  (run* q (permuteo (list 42) q))
  (list (list 42)))

(mk-test
  "permuteo-two"
  (run* q (permuteo (list 1 2) q))
  (list (list 1 2) (list 2 1)))

(mk-test
  "permuteo-three-as-set"
  (let
    ((perms (run* q (permuteo (list 1 2 3) q))))
    (and
      (= (len perms) 6)
      (and
        (some (fn (p) (= p (list 1 2 3))) perms)
        (and
          (some
            (fn (p) (= p (list 2 1 3)))
            perms)
          (and
            (some
              (fn (p) (= p (list 1 3 2)))
              perms)
            (and
              (some
                (fn (p) (= p (list 2 3 1)))
                perms)
              (and
                (some
                  (fn (p) (= p (list 3 1 2)))
                  perms)
                (some
                  (fn (p) (= p (list 3 2 1)))
                  perms))))))))
  true)

(mk-test
  "permuteo-backward-finds-input"
  (run 1 q (permuteo q (list "a" "b" "c")))
  (list (list "a" "b" "c")))

(mk-tests-run!)