prolog: clause DB + loader (functor/arity → clauses), 14 tests green
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled

This commit is contained in:
2026-04-24 23:59:46 +00:00
parent 60b7f0d7bb
commit 1888c272f9
3 changed files with 149 additions and 1 deletions

View File

@@ -230,3 +230,51 @@
(pl-unify! t1 t2 trail)
true
(do (pl-trail-undo-to! trail mark) false)))))
(define pl-mk-db (fn () {:clauses {}}))
(define
pl-head-key
(fn
(head)
(cond
((pl-compound? head) (str (pl-fun head) "/" (len (pl-args head))))
((pl-atom? head) (str (pl-atom-name head) "/0"))
(true (error "pl-head-key: invalid head")))))
(define pl-clause-key (fn (clause) (pl-head-key (nth clause 1))))
(define pl-goal-key (fn (goal) (pl-head-key goal)))
(define
pl-db-add!
(fn
(db clause)
(let
((key (pl-clause-key clause)) (table (dict-get db :clauses)))
(cond
((nil? (dict-get table key)) (dict-set! table key (list clause)))
(true (begin (append! (dict-get table key) clause) nil))))))
(define
pl-db-load!
(fn
(db program)
(cond
((empty? program) nil)
(true
(begin
(pl-db-add! db (first program))
(pl-db-load! db (rest program)))))))
(define
pl-db-lookup
(fn
(db key)
(let
((v (dict-get (dict-get db :clauses) key)))
(cond ((nil? v) (list)) (true v)))))
(define
pl-db-lookup-goal
(fn (db goal) (pl-db-lookup db (pl-goal-key goal))))

View File

@@ -0,0 +1,99 @@
;; lib/prolog/tests/clausedb.sx — Clause DB unit tests
(define pl-db-test-count 0)
(define pl-db-test-pass 0)
(define pl-db-test-fail 0)
(define pl-db-test-failures (list))
(define
pl-db-test!
(fn
(name got expected)
(begin
(set! pl-db-test-count (+ pl-db-test-count 1))
(if
(= got expected)
(set! pl-db-test-pass (+ pl-db-test-pass 1))
(begin
(set! pl-db-test-fail (+ pl-db-test-fail 1))
(append!
pl-db-test-failures
(str name "\n expected: " expected "\n got: " got)))))))
(pl-db-test!
"head-key atom arity 0"
(pl-head-key (nth (first (pl-parse "foo.")) 1))
"foo/0")
(pl-db-test!
"head-key compound arity 2"
(pl-head-key (nth (first (pl-parse "bar(a, b).")) 1))
"bar/2")
(pl-db-test!
"clause-key of :- clause"
(pl-clause-key (first (pl-parse "likes(mary, X) :- friendly(X).")))
"likes/2")
(pl-db-test!
"empty db lookup returns empty list"
(len (pl-db-lookup (pl-mk-db) "parent/2"))
0)
(define pl-db-t1 (pl-mk-db))
(pl-db-load! pl-db-t1 (pl-parse "foo(a). foo(b). foo(c)."))
(pl-db-test!
"three facts same functor"
(len (pl-db-lookup pl-db-t1 "foo/1"))
3)
(pl-db-test!
"mismatching key returns empty"
(len (pl-db-lookup pl-db-t1 "foo/2"))
0)
(pl-db-test!
"first clause has arg a"
(pl-atom-name
(first (pl-args (nth (first (pl-db-lookup pl-db-t1 "foo/1")) 1))))
"a")
(pl-db-test!
"third clause has arg c"
(pl-atom-name
(first (pl-args (nth (nth (pl-db-lookup pl-db-t1 "foo/1") 2) 1))))
"c")
(define pl-db-t2 (pl-mk-db))
(pl-db-load! pl-db-t2 (pl-parse "foo. bar. foo. parent(a, b). parent(c, d)."))
(pl-db-test!
"atom heads keyed as foo/0"
(len (pl-db-lookup pl-db-t2 "foo/0"))
2)
(pl-db-test!
"atom heads keyed as bar/0"
(len (pl-db-lookup pl-db-t2 "bar/0"))
1)
(pl-db-test!
"compound heads keyed as parent/2"
(len (pl-db-lookup pl-db-t2 "parent/2"))
2)
(pl-db-test!
"lookup-goal extracts functor/arity"
(len
(pl-db-lookup-goal pl-db-t2 (nth (first (pl-parse "parent(X, Y).")) 1)))
2)
(pl-db-test!
"lookup-goal on atom goal"
(len (pl-db-lookup-goal pl-db-t2 (nth (first (pl-parse "foo.")) 1)))
2)
(pl-db-test!
"stored clause is clause form"
(first (first (pl-db-lookup pl-db-t2 "parent/2")))
"clause")
(define pl-clausedb-tests-run! (fn () {:failed pl-db-test-fail :passed pl-db-test-pass :total pl-db-test-count :failures pl-db-test-failures}))

View File

@@ -50,7 +50,7 @@ Representation choices (finalise in phase 1, document here):
- [x] 30+ unification tests in `lib/prolog/tests/unify.sx`: atoms, vars, compounds, lists, cyclic (no-occurs-check), mutual occurs — 47 pass
### Phase 3 — clause DB + DFS solver + cut + first classic programs
- [ ] Clause DB: `"functor/arity" → list-of-clauses`, loader inserts
- [x] Clause DB: `"functor/arity" → list-of-clauses`, loader inserts`pl-mk-db` / `pl-db-add!` / `pl-db-load!` / `pl-db-lookup` / `pl-db-lookup-goal`, 14 tests in `tests/clausedb.sx`
- [ ] Solver: DFS with choice points backed by delimited continuations (`lib/callcc.sx`). On goal entry, capture; per matching clause, unify head + recurse body; on failure, undo trail, try next
- [ ] Cut (`!`): cut barrier at current choice-point frame; collapse all up to barrier
- [ ] Built-ins: `=/2`, `\\=/2`, `true/0`, `fail/0`, `!/0`, `,/2`, `;/2`, `->/2` inside `;`, `call/1`, `write/1`, `nl/0`
@@ -88,6 +88,7 @@ Representation choices (finalise in phase 1, document here):
_Newest first. Agent appends on every commit._
- 2026-04-24 — Phase 3 clause DB landed: `pl-mk-db` + `pl-head-key` / `pl-clause-key` / `pl-goal-key` + `pl-db-add!` / `pl-db-load!` / `pl-db-lookup` / `pl-db-lookup-goal` in runtime.sx. New `tests/clausedb.sx` 14/14 green. Total 86 (+14). Loader preserves declaration order (append!).
- 2026-04-24 — Verified phase 1+2 already implemented on loops/prolog: `pl-parse-tests-run!` 25/25, `pl-unify-tests-run!` 47/47 (72 total). Ticked phase 1+2 boxes.
- _(awaiting phase 1)_