IO predicates: term_to_atom/2, term_string/2, with_output_to/2, format/1,2, writeln/1
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled

Adds 6 new built-in predicates to the Prolog runtime and 24 tests covering
term<->atom conversion (bidirectional), output capture, format directives (~w/~a/~d/~n/~~).
456/456 tests passing.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-04-25 13:00:42 +00:00
parent 0be5eeafd8
commit be2000a048
5 changed files with 518 additions and 6 deletions

View File

@@ -37,6 +37,7 @@ SUITES=(
"meta_call:lib/prolog/tests/meta_call.sx:pl-meta-call-tests-run!"
"set_predicates:lib/prolog/tests/set_predicates.sx:pl-set-predicates-tests-run!"
"char_predicates:lib/prolog/tests/char_predicates.sx:pl-char-predicates-tests-run!"
"io_predicates:lib/prolog/tests/io_predicates.sx:pl-io-predicates-tests-run!"
)
SCRIPT='(epoch 1)

View File

@@ -1359,6 +1359,164 @@
k)
false))))
(define
pl-format-process
(fn
(fmt-str args-list)
(let
((chars (split fmt-str "")) (result "") (remaining args-list))
(define
do-char
(fn
(cs r rem)
(cond
((empty? cs) r)
((= (first cs) "~")
(if
(empty? (rest cs))
(str r "~")
(let
((directive (first (rest cs))) (tail (rest (rest cs))))
(cond
((= directive "n") (do-char tail (str r "\n") rem))
((= directive "N") (do-char tail (str r "\n") rem))
((= directive "t") (do-char tail (str r "\t") rem))
((= directive "~") (do-char tail (str r "~") rem))
((= directive "w")
(if
(empty? rem)
(do-char tail (str r "?") rem)
(do-char
tail
(str r (pl-format-term (first rem)))
(rest rem))))
((= directive "a")
(if
(empty? rem)
(do-char tail (str r "?") rem)
(do-char
tail
(str r (pl-format-term (first rem)))
(rest rem))))
((= directive "d")
(if
(empty? rem)
(do-char tail (str r "?") rem)
(do-char
tail
(str r (pl-format-term (first rem)))
(rest rem))))
(true (do-char tail (str r "~" directive) rem))))))
(true (do-char (rest cs) (str r (first cs)) rem)))))
(do-char chars "" args-list))))
(define
pl-solve-term-to-atom!
(fn
(term-arg atom-arg trail k)
(let
((t-walked (pl-walk term-arg)) (a-walked (pl-walk atom-arg)))
(cond
((not (pl-var? t-walked))
(let
((formatted (pl-format-term t-walked)))
(let
((result-atom (list "atom" formatted)))
(if (pl-unify! atom-arg result-atom trail) (k) false))))
((and (pl-var? t-walked) (pl-atom? a-walked))
(let
((atom-str (pl-atom-name a-walked)))
(let
((parsed (pl-parse (str atom-str "."))))
(if
(and (list? parsed) (> (len parsed) 0))
(let
((clause (first parsed)))
(let
((actual-term
(if
(and
(list? clause)
(= (len clause) 3)
(= (nth clause 0) "clause"))
(nth clause 1)
clause)))
(let
((fresh (pl-instantiate actual-term {})))
(if (pl-unify! term-arg fresh trail) (k) false))))
false))))
(true false)))))
(define
pl-solve-with-output-to!
(fn
(db sink goal trail cut-box k)
(let
((sink-walked (pl-walk-deep sink)))
(if
(and
(pl-compound? sink-walked)
(or
(= (pl-fun sink-walked) "atom")
(= (pl-fun sink-walked) "string"))
(= (len (pl-args sink-walked)) 1))
(let
((var (first (pl-args sink-walked)))
(saved-buffer pl-output-buffer))
(do
(set! pl-output-buffer "")
(let
((result (pl-solve-once! db goal trail)))
(let
((captured pl-output-buffer))
(do
(set! pl-output-buffer saved-buffer)
(if
result
(if (pl-unify! var (list "atom" captured) trail) (k) false)
false))))))
false))))
(define
pl-solve-writeln!
(fn
(term-arg k)
(do
(pl-output-write! (pl-format-term term-arg))
(pl-output-write! "\n")
(k))))
(define
pl-solve-format-1!
(fn
(fmt-arg k)
(let
((fmt-walked (pl-walk-deep fmt-arg)))
(if
(pl-atom? fmt-walked)
(do
(pl-output-write! (pl-format-process (pl-atom-name fmt-walked) (list)))
(k))
false))))
(define
pl-solve-format-2!
(fn
(db fmt-arg args-arg trail k)
(let
((fmt-walked (pl-walk-deep fmt-arg))
(args-walked (pl-walk-deep args-arg)))
(if
(pl-atom? fmt-walked)
(let
((args-sx (pl-prolog-list-to-sx args-walked)))
(do
(pl-output-write!
(pl-format-process (pl-atom-name fmt-walked) args-sx))
(k)))
false))))
(define
pl-solve!
(fn
@@ -2057,6 +2215,32 @@
(nth (pl-args g) 1)
trail
k))
((and (pl-compound? g) (= (pl-fun g) "term_to_atom") (= (len (pl-args g)) 2))
(pl-solve-term-to-atom!
(nth (pl-args g) 0)
(nth (pl-args g) 1)
trail
k))
((and (pl-compound? g) (= (pl-fun g) "term_string") (= (len (pl-args g)) 2))
(pl-solve-term-to-atom!
(nth (pl-args g) 0)
(nth (pl-args g) 1)
trail
k))
((and (pl-compound? g) (= (pl-fun g) "with_output_to") (= (len (pl-args g)) 2))
(pl-solve-with-output-to!
db
(nth (pl-args g) 0)
(nth (pl-args g) 1)
trail
cut-box
k))
((and (pl-compound? g) (= (pl-fun g) "writeln") (= (len (pl-args g)) 1))
(pl-solve-writeln! (nth (pl-args g) 0) k))
((and (pl-compound? g) (= (pl-fun g) "format") (= (len (pl-args g)) 1))
(pl-solve-format-1! (nth (pl-args g) 0) k))
((and (pl-compound? g) (= (pl-fun g) "format") (= (len (pl-args g)) 2))
(pl-solve-format-2! db (nth (pl-args g) 0) (nth (pl-args g) 1) trail k))
(true (pl-solve-user! db g trail cut-box k))))))
(define

View File

@@ -1,7 +1,7 @@
{
"total_passed": 432,
"total_passed": 456,
"total_failed": 0,
"total": 432,
"suites": {"parse":{"passed":25,"total":25,"failed":0},"unify":{"passed":47,"total":47,"failed":0},"clausedb":{"passed":14,"total":14,"failed":0},"solve":{"passed":62,"total":62,"failed":0},"operators":{"passed":19,"total":19,"failed":0},"dynamic":{"passed":11,"total":11,"failed":0},"findall":{"passed":11,"total":11,"failed":0},"term_inspect":{"passed":14,"total":14,"failed":0},"append":{"passed":6,"total":6,"failed":0},"reverse":{"passed":6,"total":6,"failed":0},"member":{"passed":7,"total":7,"failed":0},"nqueens":{"passed":6,"total":6,"failed":0},"family":{"passed":10,"total":10,"failed":0},"atoms":{"passed":34,"total":34,"failed":0},"query_api":{"passed":16,"total":16,"failed":0},"iso_predicates":{"passed":29,"total":29,"failed":0},"meta_predicates":{"passed":25,"total":25,"failed":0},"list_predicates":{"passed":33,"total":33,"failed":0},"meta_call":{"passed":15,"total":15,"failed":0},"set_predicates":{"passed":15,"total":15,"failed":0},"char_predicates":{"passed":27,"total":27,"failed":0}},
"generated": "2026-04-25T12:40:55+00:00"
"total": 456,
"suites": {"parse":{"passed":25,"total":25,"failed":0},"unify":{"passed":47,"total":47,"failed":0},"clausedb":{"passed":14,"total":14,"failed":0},"solve":{"passed":62,"total":62,"failed":0},"operators":{"passed":19,"total":19,"failed":0},"dynamic":{"passed":11,"total":11,"failed":0},"findall":{"passed":11,"total":11,"failed":0},"term_inspect":{"passed":14,"total":14,"failed":0},"append":{"passed":6,"total":6,"failed":0},"reverse":{"passed":6,"total":6,"failed":0},"member":{"passed":7,"total":7,"failed":0},"nqueens":{"passed":6,"total":6,"failed":0},"family":{"passed":10,"total":10,"failed":0},"atoms":{"passed":34,"total":34,"failed":0},"query_api":{"passed":16,"total":16,"failed":0},"iso_predicates":{"passed":29,"total":29,"failed":0},"meta_predicates":{"passed":25,"total":25,"failed":0},"list_predicates":{"passed":33,"total":33,"failed":0},"meta_call":{"passed":15,"total":15,"failed":0},"set_predicates":{"passed":15,"total":15,"failed":0},"char_predicates":{"passed":27,"total":27,"failed":0},"io_predicates":{"passed":24,"total":24,"failed":0}},
"generated": "2026-04-25T13:00:15+00:00"
}

View File

@@ -1,7 +1,7 @@
# Prolog scoreboard
**432 / 432 passing** (0 failure(s)).
Generated 2026-04-25T12:40:55+00:00.
**456 / 456 passing** (0 failure(s)).
Generated 2026-04-25T13:00:15+00:00.
| Suite | Passed | Total | Status |
|-------|--------|-------|--------|
@@ -26,6 +26,7 @@ Generated 2026-04-25T12:40:55+00:00.
| meta_call | 15 | 15 | ok |
| set_predicates | 15 | 15 | ok |
| char_predicates | 27 | 27 | ok |
| io_predicates | 24 | 24 | ok |
Run `bash lib/prolog/conformance.sh` to refresh. Override the binary
with `SX_SERVER=path/to/sx_server.exe bash …`.

View File

@@ -0,0 +1,326 @@
;; 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}))