From be2000a048d323d4e322c79921ead317157ffa0b Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 25 Apr 2026 13:00:42 +0000 Subject: [PATCH] IO predicates: term_to_atom/2, term_string/2, with_output_to/2, format/1,2, writeln/1 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 --- lib/prolog/conformance.sh | 1 + lib/prolog/runtime.sx | 184 +++++++++++++++++ lib/prolog/scoreboard.json | 8 +- lib/prolog/scoreboard.md | 5 +- lib/prolog/tests/io_predicates.sx | 326 ++++++++++++++++++++++++++++++ 5 files changed, 518 insertions(+), 6 deletions(-) create mode 100644 lib/prolog/tests/io_predicates.sx diff --git a/lib/prolog/conformance.sh b/lib/prolog/conformance.sh index 85f87d92..d293732b 100755 --- a/lib/prolog/conformance.sh +++ b/lib/prolog/conformance.sh @@ -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) diff --git a/lib/prolog/runtime.sx b/lib/prolog/runtime.sx index ef3edfb7..4e6f77a7 100644 --- a/lib/prolog/runtime.sx +++ b/lib/prolog/runtime.sx @@ -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 diff --git a/lib/prolog/scoreboard.json b/lib/prolog/scoreboard.json index 3995ec66..500ad23e 100644 --- a/lib/prolog/scoreboard.json +++ b/lib/prolog/scoreboard.json @@ -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" } diff --git a/lib/prolog/scoreboard.md b/lib/prolog/scoreboard.md index 2d40f88c..28979c27 100644 --- a/lib/prolog/scoreboard.md +++ b/lib/prolog/scoreboard.md @@ -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 …`. diff --git a/lib/prolog/tests/io_predicates.sx b/lib/prolog/tests/io_predicates.sx new file mode 100644 index 00000000..dc52c57e --- /dev/null +++ b/lib/prolog/tests/io_predicates.sx @@ -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}))