rose-ash/lib/prolog/tests/io_predicates.sx

;; lib/prolog/tests/io_predicates.sx — term_to_atom/2, term_string/2,
;;   with_output_to/2, writeln/1, format/1, format/2

(define pl-io-test-count 0)
(define pl-io-test-pass 0)
(define pl-io-test-fail 0)
(define pl-io-test-failures (list))

(define
  pl-io-test!
  (fn
    (name got expected)
    (begin
      (set! pl-io-test-count (+ pl-io-test-count 1))
      (if
        (= got expected)
        (set! pl-io-test-pass (+ pl-io-test-pass 1))
        (begin
          (set! pl-io-test-fail (+ pl-io-test-fail 1))
          (append!
            pl-io-test-failures
            (str name "\n    expected: " expected "\n    got:      " got)))))))

(define
  pl-io-goal
  (fn
    (src env)
    (pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))

(define pl-io-db (pl-mk-db))

;; helper: get output buffer after running a goal
(define
  pl-io-capture!
  (fn
    (goal)
    (do
      (pl-output-clear!)
      (pl-solve-once! pl-io-db goal (pl-mk-trail))
      pl-output-buffer)))

;; ─── term_to_atom/2 — bound Term direction ─────────────────────────────────

(pl-io-test!
  "term_to_atom(foo(a,b), A) — compound"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "term_to_atom(foo(a,b), A)" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "A"))))
  "foo(a, b)")

(pl-io-test!
  "term_to_atom(hello, A) — atom"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "term_to_atom(hello, A)" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "A"))))
  "hello")

(pl-io-test!
  "term_to_atom(42, A) — number"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "term_to_atom(42, A)" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "A"))))
  "42")

(pl-io-test!
  "term_to_atom(foo(a,b), 'foo(a, b)') — succeeds when Atom matches"
  (pl-solve-once!
    pl-io-db
    (pl-io-goal "term_to_atom(foo(a,b), 'foo(a, b)')" {})
    (pl-mk-trail))
  true)

(pl-io-test!
  "term_to_atom(hello, world) — fails on mismatch"
  (pl-solve-once!
    pl-io-db
    (pl-io-goal "term_to_atom(hello, world)" {})
    (pl-mk-trail))
  false)

;; ─── term_to_atom/2 — parse direction (Atom bound, Term unbound) ───────────

(pl-io-test!
  "term_to_atom(T, 'foo(a)') — parse direction gives compound"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "term_to_atom(T, 'foo(a)')" env)
      (pl-mk-trail))
    (let
      ((t (pl-walk-deep (dict-get env "T"))))
      (and (pl-compound? t) (= (pl-fun t) "foo"))))
  true)

(pl-io-test!
  "term_to_atom(T, hello) — parse direction gives atom"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "term_to_atom(T, hello)" env)
      (pl-mk-trail))
    (let
      ((t (pl-walk-deep (dict-get env "T"))))
      (and (pl-atom? t) (= (pl-atom-name t) "hello"))))
  true)

;; ─── term_string/2 — alias ──────────────────────────────────────────────────

(pl-io-test!
  "term_string(bar(x), A) — same as term_to_atom"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "term_string(bar(x), A)" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "A"))))
  "bar(x)")

(pl-io-test!
  "term_string(42, A) — number to string"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "term_string(42, A)" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "A"))))
  "42")

;; ─── writeln/1 ─────────────────────────────────────────────────────────────

(pl-io-test!
  "writeln(hello) writes 'hello\n'"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "with_output_to(atom(X), writeln(hello))" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "X"))))
  "hello
")

(pl-io-test!
  "writeln(42) writes '42\n'"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "with_output_to(atom(X), writeln(42))" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "X"))))
  "42
")

;; ─── with_output_to/2 ──────────────────────────────────────────────────────

(pl-io-test!
  "with_output_to(atom(X), write(foo)) — captures write output"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "with_output_to(atom(X), write(foo))" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "X"))))
  "foo")

(pl-io-test!
  "with_output_to(atom(X), (write(a), write(b))) — concat output"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "with_output_to(atom(X), (write(a), write(b)))" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "X"))))
  "ab")

(pl-io-test!
  "with_output_to(atom(X), nl) — captures newline"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "with_output_to(atom(X), nl)" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "X"))))
  "
")

(pl-io-test!
  "with_output_to(atom(X), true) — captures empty string"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "with_output_to(atom(X), true)" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "X"))))
  "")

(pl-io-test!
  "with_output_to(string(X), write(hello)) — string sink works"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "with_output_to(string(X), write(hello))" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "X"))))
  "hello")

(pl-io-test!
  "with_output_to(atom(X), fail) — fails when goal fails"
  (pl-solve-once!
    pl-io-db
    (pl-io-goal "with_output_to(atom(X), fail)" {})
    (pl-mk-trail))
  false)

;; ─── format/1 ──────────────────────────────────────────────────────────────

(pl-io-test!
  "format('hello~n') — tilde-n becomes newline"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "with_output_to(atom(X), format('hello~n'))" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "X"))))
  "hello
")

(pl-io-test!
  "format('~~') — double tilde becomes single tilde"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "with_output_to(atom(X), format('~~'))" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "X"))))
  "~")

(pl-io-test!
  "format('abc') — plain text passes through"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "with_output_to(atom(X), format(abc))" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "X"))))
  "abc")

;; ─── format/2 ──────────────────────────────────────────────────────────────

(pl-io-test!
  "format('~w+~w', [1,2]) — two ~w args"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "with_output_to(atom(X), format('~w+~w', [1,2]))" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "X"))))
  "1+2")

(pl-io-test!
  "format('hello ~a!', [world]) — ~a with atom arg"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "with_output_to(atom(X), format('hello ~a!', [world]))" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "X"))))
  "hello world!")

(pl-io-test!
  "format('n=~d', [42]) — ~d with integer arg"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "with_output_to(atom(X), format('n=~d', [42]))" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "X"))))
  "n=42")

(pl-io-test!
  "format('~w', [foo(a)]) — ~w with compound"
  (let
    ((env {}))
    (pl-solve-once!
      pl-io-db
      (pl-io-goal "with_output_to(atom(X), format('~w', [foo(a)]))" env)
      (pl-mk-trail))
    (pl-atom-name (pl-walk-deep (dict-get env "X"))))
  "foo(a)")

(define
  pl-io-predicates-tests-run!
  (fn
    ()
    {:failed pl-io-test-fail
      :passed pl-io-test-pass
      :total pl-io-test-count
      :failures pl-io-test-failures}))