prolog: clause DB + loader (functor/arity → clauses), 14 tests green
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
This commit is contained in:
@@ -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))))
|
||||
|
||||
99
lib/prolog/tests/clausedb.sx
Normal file
99
lib/prolog/tests/clausedb.sx
Normal 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}))
|
||||
@@ -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)_
|
||||
|
||||
|
||||
Reference in New Issue
Block a user