prolog-query SX API: pl-load + pl-query-all + pl-query-one + pl-query (+16 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -30,12 +30,14 @@ SUITES=(
|
||||
"nqueens:lib/prolog/tests/programs/nqueens.sx:pl-nqueens-tests-run!"
|
||||
"family:lib/prolog/tests/programs/family.sx:pl-family-tests-run!"
|
||||
"atoms:lib/prolog/tests/atoms.sx:pl-atom-tests-run!"
|
||||
"query_api:lib/prolog/tests/query_api.sx:pl-query-api-tests-run!"
|
||||
)
|
||||
|
||||
SCRIPT='(epoch 1)
|
||||
(load "lib/prolog/tokenizer.sx")
|
||||
(load "lib/prolog/parser.sx")
|
||||
(load "lib/prolog/runtime.sx")'
|
||||
(load "lib/prolog/runtime.sx")
|
||||
(load "lib/prolog/query.sx")'
|
||||
for entry in "${SUITES[@]}"; do
|
||||
IFS=: read -r _ file _ <<< "$entry"
|
||||
SCRIPT+=$'\n(load "'"$file"$'")'
|
||||
|
||||
114
lib/prolog/query.sx
Normal file
114
lib/prolog/query.sx
Normal file
@@ -0,0 +1,114 @@
|
||||
;; lib/prolog/query.sx — high-level Prolog query API for SX/Hyperscript callers.
|
||||
;;
|
||||
;; Requires tokenizer.sx, parser.sx, runtime.sx to be loaded first.
|
||||
;;
|
||||
;; Public API:
|
||||
;; (pl-load source-str) → db
|
||||
;; (pl-query-all db query-str) → list of solution dicts {var-name → term-string}
|
||||
;; (pl-query-one db query-str) → first solution dict or nil
|
||||
;; (pl-query source-str query-str) → list of solution dicts (convenience)
|
||||
|
||||
;; Collect variable name strings from a parse-time AST (pre-instantiation).
|
||||
;; Returns list of unique strings, excluding anonymous "_".
|
||||
(define
|
||||
pl-query-extract-vars
|
||||
(fn
|
||||
(ast)
|
||||
(let
|
||||
((seen {}))
|
||||
(let
|
||||
((collect!
|
||||
(fn
|
||||
(t)
|
||||
(cond
|
||||
((not (list? t)) nil)
|
||||
((empty? t) nil)
|
||||
((= (first t) "var")
|
||||
(if
|
||||
(not (= (nth t 1) "_"))
|
||||
(dict-set! seen (nth t 1) true)
|
||||
nil))
|
||||
((= (first t) "compound")
|
||||
(for-each collect! (nth t 2)))
|
||||
(true nil)))))
|
||||
(collect! ast)
|
||||
(keys seen)))))
|
||||
|
||||
;; Build a solution dict from a var-env after a successful solve.
|
||||
;; Maps each variable name string to its formatted term value.
|
||||
(define
|
||||
pl-query-solution-dict
|
||||
(fn
|
||||
(var-names var-env)
|
||||
(let
|
||||
((d {}))
|
||||
(for-each
|
||||
(fn (name) (dict-set! d name (pl-format-term (dict-get var-env name))))
|
||||
var-names)
|
||||
d)))
|
||||
|
||||
;; Parse source-str and load clauses into a fresh DB.
|
||||
;; Returns the DB for reuse across multiple queries.
|
||||
(define
|
||||
pl-load
|
||||
(fn
|
||||
(source-str)
|
||||
(let
|
||||
((db (pl-mk-db)))
|
||||
(if
|
||||
(and (string? source-str) (not (= source-str "")))
|
||||
(pl-db-load! db (pl-parse source-str))
|
||||
nil)
|
||||
db)))
|
||||
|
||||
;; Run query-str against db, returning a list of solution dicts.
|
||||
;; Each dict maps variable name strings to their formatted term values.
|
||||
;; Returns an empty list if no solutions.
|
||||
(define
|
||||
pl-query-all
|
||||
(fn
|
||||
(db query-str)
|
||||
(let
|
||||
((parsed (pl-parse (str "q_ :- " query-str "."))))
|
||||
(let
|
||||
((body-ast (nth (first parsed) 2)))
|
||||
(let
|
||||
((var-names (pl-query-extract-vars body-ast))
|
||||
(var-env {}))
|
||||
(let
|
||||
((goal (pl-instantiate body-ast var-env))
|
||||
(trail (pl-mk-trail))
|
||||
(solutions (list)))
|
||||
(let
|
||||
((mark (pl-trail-mark trail)))
|
||||
(pl-solve!
|
||||
db
|
||||
goal
|
||||
trail
|
||||
{:cut false}
|
||||
(fn
|
||||
()
|
||||
(begin
|
||||
(append!
|
||||
solutions
|
||||
(pl-query-solution-dict var-names var-env))
|
||||
false)))
|
||||
(pl-trail-undo-to! trail mark)
|
||||
solutions)))))))
|
||||
|
||||
;; Return the first solution dict, or nil if no solutions.
|
||||
(define
|
||||
pl-query-one
|
||||
(fn
|
||||
(db query-str)
|
||||
(let
|
||||
((all (pl-query-all db query-str)))
|
||||
(if (empty? all) nil (first all)))))
|
||||
|
||||
;; Convenience: parse source-str, then run query-str against it.
|
||||
;; Returns a list of solution dicts. Creates a fresh DB each call.
|
||||
(define
|
||||
pl-query
|
||||
(fn
|
||||
(source-str query-str)
|
||||
(pl-query-all (pl-load source-str) query-str)))
|
||||
@@ -1,7 +1,7 @@
|
||||
{
|
||||
"total_passed": 272,
|
||||
"total_passed": 288,
|
||||
"total_failed": 0,
|
||||
"total": 272,
|
||||
"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}},
|
||||
"generated": "2026-04-25T09:26:33+00:00"
|
||||
"total": 288,
|
||||
"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}},
|
||||
"generated": "2026-04-25T09:58:25+00:00"
|
||||
}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# Prolog scoreboard
|
||||
|
||||
**272 / 272 passing** (0 failure(s)).
|
||||
Generated 2026-04-25T09:26:33+00:00.
|
||||
**288 / 288 passing** (0 failure(s)).
|
||||
Generated 2026-04-25T09:58:25+00:00.
|
||||
|
||||
| Suite | Passed | Total | Status |
|
||||
|-------|--------|-------|--------|
|
||||
@@ -19,6 +19,7 @@ Generated 2026-04-25T09:26:33+00:00.
|
||||
| nqueens | 6 | 6 | ok |
|
||||
| family | 10 | 10 | ok |
|
||||
| atoms | 34 | 34 | ok |
|
||||
| query_api | 16 | 16 | ok |
|
||||
|
||||
Run `bash lib/prolog/conformance.sh` to refresh. Override the binary
|
||||
with `SX_SERVER=path/to/sx_server.exe bash …`.
|
||||
|
||||
127
lib/prolog/tests/query_api.sx
Normal file
127
lib/prolog/tests/query_api.sx
Normal file
@@ -0,0 +1,127 @@
|
||||
;; lib/prolog/tests/query_api.sx — tests for pl-load/pl-query-all/pl-query-one/pl-query
|
||||
|
||||
(define pl-qa-test-count 0)
|
||||
(define pl-qa-test-pass 0)
|
||||
(define pl-qa-test-fail 0)
|
||||
(define pl-qa-test-failures (list))
|
||||
|
||||
(define
|
||||
pl-qa-test!
|
||||
(fn
|
||||
(name got expected)
|
||||
(begin
|
||||
(set! pl-qa-test-count (+ pl-qa-test-count 1))
|
||||
(if
|
||||
(= got expected)
|
||||
(set! pl-qa-test-pass (+ pl-qa-test-pass 1))
|
||||
(begin
|
||||
(set! pl-qa-test-fail (+ pl-qa-test-fail 1))
|
||||
(append!
|
||||
pl-qa-test-failures
|
||||
(str name "\n expected: " expected "\n got: " got)))))))
|
||||
|
||||
(define
|
||||
pl-qa-src
|
||||
"parent(tom, bob). parent(tom, liz). parent(bob, ann). ancestor(X, Y) :- parent(X, Y). ancestor(X, Y) :- parent(X, Z), ancestor(Z, Y).")
|
||||
|
||||
(define pl-qa-db (pl-load pl-qa-src))
|
||||
|
||||
;; ── pl-load ──
|
||||
|
||||
(pl-qa-test!
|
||||
"pl-load returns a usable DB (pl-query-all non-nil)"
|
||||
(not (nil? pl-qa-db))
|
||||
true)
|
||||
|
||||
;; ── pl-query-all: basic fact lookup ──
|
||||
|
||||
(pl-qa-test!
|
||||
"query-all parent(tom, X): 2 solutions"
|
||||
(len (pl-query-all pl-qa-db "parent(tom, X)"))
|
||||
2)
|
||||
|
||||
(pl-qa-test!
|
||||
"query-all parent(tom, X): first solution X=bob"
|
||||
(dict-get (first (pl-query-all pl-qa-db "parent(tom, X)")) "X")
|
||||
"bob")
|
||||
|
||||
(pl-qa-test!
|
||||
"query-all parent(tom, X): second solution X=liz"
|
||||
(dict-get (nth (pl-query-all pl-qa-db "parent(tom, X)") 1) "X")
|
||||
"liz")
|
||||
|
||||
;; ── pl-query-all: no solutions ──
|
||||
|
||||
(pl-qa-test!
|
||||
"query-all no solutions returns empty list"
|
||||
(pl-query-all pl-qa-db "parent(liz, X)")
|
||||
(list))
|
||||
|
||||
;; ── pl-query-all: boolean query (no vars) ──
|
||||
|
||||
(pl-qa-test!
|
||||
"boolean success: 1 solution (empty dict)"
|
||||
(len (pl-query-all pl-qa-db "parent(tom, bob)"))
|
||||
1)
|
||||
|
||||
(pl-qa-test!
|
||||
"boolean success: solution has no bindings"
|
||||
(empty? (keys (first (pl-query-all pl-qa-db "parent(tom, bob)"))))
|
||||
true)
|
||||
|
||||
(pl-qa-test!
|
||||
"boolean fail: 0 solutions"
|
||||
(len (pl-query-all pl-qa-db "parent(bob, tom)"))
|
||||
0)
|
||||
|
||||
;; ── pl-query-all: multi-var ──
|
||||
|
||||
(pl-qa-test!
|
||||
"query-all parent(X, Y): 3 solutions total"
|
||||
(len (pl-query-all pl-qa-db "parent(X, Y)"))
|
||||
3)
|
||||
|
||||
;; ── pl-query-all: rule-based (ancestor/2) ──
|
||||
|
||||
(pl-qa-test!
|
||||
"query-all ancestor(tom, X): 3 descendants (bob, liz, ann)"
|
||||
(len (pl-query-all pl-qa-db "ancestor(tom, X)"))
|
||||
3)
|
||||
|
||||
;; ── pl-query-all: built-in in query ──
|
||||
|
||||
(pl-qa-test!
|
||||
"query with is/2 built-in"
|
||||
(dict-get (first (pl-query-all pl-qa-db "X is 2 + 3")) "X")
|
||||
"5")
|
||||
|
||||
;; ── pl-query-one ──
|
||||
|
||||
(pl-qa-test!
|
||||
"query-one returns first solution"
|
||||
(dict-get (pl-query-one pl-qa-db "parent(tom, X)") "X")
|
||||
"bob")
|
||||
|
||||
(pl-qa-test!
|
||||
"query-one returns nil for no solutions"
|
||||
(pl-query-one pl-qa-db "parent(liz, X)")
|
||||
nil)
|
||||
|
||||
;; ── pl-query convenience ──
|
||||
|
||||
(pl-qa-test!
|
||||
"pl-query convenience: count solutions"
|
||||
(len (pl-query "likes(alice, bob). likes(alice, carol)." "likes(alice, X)"))
|
||||
2)
|
||||
|
||||
(pl-qa-test!
|
||||
"pl-query convenience: first solution"
|
||||
(dict-get (first (pl-query "likes(alice, bob). likes(alice, carol)." "likes(alice, X)")) "X")
|
||||
"bob")
|
||||
|
||||
(pl-qa-test!
|
||||
"pl-query with empty source (built-ins only)"
|
||||
(dict-get (first (pl-query "" "X is 6 * 7")) "X")
|
||||
"42")
|
||||
|
||||
(define pl-query-api-tests-run! (fn () {:failed pl-qa-test-fail :passed pl-qa-test-pass :total pl-qa-test-count :failures pl-qa-test-failures}))
|
||||
@@ -72,7 +72,7 @@ Representation choices (finalise in phase 1, document here):
|
||||
- [x] String/atom predicates
|
||||
|
||||
### Phase 5 — Hyperscript integration
|
||||
- [ ] `prolog-query` primitive callable from SX/Hyperscript
|
||||
- [x] `prolog-query` primitive callable from SX/Hyperscript
|
||||
- [ ] Hyperscript DSL: `when allowed(user, :edit) then …`
|
||||
- [ ] Integration suite
|
||||
|
||||
@@ -88,6 +88,7 @@ Representation choices (finalise in phase 1, document here):
|
||||
|
||||
_Newest first. Agent appends on every commit._
|
||||
|
||||
- 2026-04-25 — `prolog-query` SX API (`lib/prolog/query.sx`). New public API layer: `pl-load source-str → db`, `pl-query-all db query-str → list of solution dicts`, `pl-query-one db query-str → dict or nil`, `pl-query src query → list` (convenience). Each solution dict maps variable name strings to their formatted term strings. Var names extracted from pre-instantiation parse AST. Trail is marked before solve and reset after to ensure clean state. 16 tests in `tests/query_api.sx` cover fact lookup, no-solution, boolean queries, multi-var, recursive rules, is/2 built-in, query-one, convenience form. Total **288** (+16).
|
||||
- 2026-04-25 — String/atom predicates. Type-test predicates: `var/1`, `nonvar/1`, `atom/1`, `number/1`, `integer/1`, `float/1` (always-fail), `compound/1`, `callable/1`, `atomic/1`, `is_list/1`. String/atom operations: `atom_length/2`, `atom_concat/3` (3 modes: both-ground, result+first, result+second), `atom_chars/2` (bidirectional), `atom_codes/2` (bidirectional), `char_code/2` (bidirectional), `number_codes/2`, `number_chars/2`. 7 helper functions in runtime.sx (`pl-list-to-prolog`, `pl-proper-list?`, `pl-prolog-list-to-sx`, `pl-solve-atom-concat!`, `pl-solve-atom-chars!`, `pl-solve-atom-codes!`, `pl-solve-char-code!`). 34 tests in `tests/atoms.sx`. Total **272** (+34).
|
||||
- 2026-04-25 — `copy_term/2` + `functor/3` + `arg/3` (term inspection). `copy_term` is a one-line dispatch to existing `pl-deep-copy`. `functor/3` is bidirectional — decomposes a bound compound/atom/num into name+arity OR constructs from ground name+arity (atom+positive-arity → compound with N anonymous fresh args via `pl-make-fresh-args`; arity 0 → atom/num). `arg/3` extracts 1-indexed arg with bounds-fail. New helper `pl-solve-eq2!` for paired-unification with shared trail-undo. 14 tests in `tests/term_inspect.sx`. Total **238** (+14). `=..` deferred — `.` always tokenizes as clause terminator; needs special lexer case.
|
||||
- 2026-04-25 — `findall/3` + `bagof/3` + `setof/3`. Shared collector `pl-collect-solutions` runs the goal in a fresh cut-box, deep-copies the template per success (`pl-deep-copy` walks term, allocates fresh runtime vars via shared var-map so co-occurrences keep aliasing), returns false to keep backtracking, then `pl-trail-undo-to!` to clean up. `findall` always builds a list. `bagof` fails on empty. `setof` uses a `pl-format-term`-keyed dict + SX `sort` for dedupe + ordering. New `tests/findall.sx` 11 tests. Total **224** (+11). Existential `^` deferred — needs operator.
|
||||
|
||||
Reference in New Issue
Block a user