prolog: \=/2 + ;/2 + call/1 built-ins, 11 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
This commit is contained in:
@@ -301,6 +301,12 @@
|
||||
((and (pl-atom? g) (= (pl-atom-name g) "fail")) false)
|
||||
((and (pl-compound? g) (= (pl-fun g) "=") (= (len (pl-args g)) 2))
|
||||
(pl-solve-eq! (first (pl-args g)) (nth (pl-args g) 1) trail k))
|
||||
((and (pl-compound? g) (= (pl-fun g) "\\=") (= (len (pl-args g)) 2))
|
||||
(pl-solve-not-eq!
|
||||
(first (pl-args g))
|
||||
(nth (pl-args g) 1)
|
||||
trail
|
||||
k))
|
||||
((and (pl-compound? g) (= (pl-fun g) ",") (= (len (pl-args g)) 2))
|
||||
(pl-solve!
|
||||
db
|
||||
@@ -308,8 +314,48 @@
|
||||
trail
|
||||
cut-box
|
||||
(fn () (pl-solve! db (nth (pl-args g) 1) trail cut-box k))))
|
||||
((and (pl-compound? g) (= (pl-fun g) ";") (= (len (pl-args g)) 2))
|
||||
(pl-solve-or!
|
||||
db
|
||||
(first (pl-args g))
|
||||
(nth (pl-args g) 1)
|
||||
trail
|
||||
cut-box
|
||||
k))
|
||||
((and (pl-compound? g) (= (pl-fun g) "call") (= (len (pl-args g)) 1))
|
||||
(let
|
||||
((call-cb {:cut false}))
|
||||
(pl-solve! db (first (pl-args g)) trail call-cb k)))
|
||||
(true (pl-solve-user! db g trail cut-box k))))))
|
||||
|
||||
(define
|
||||
pl-solve-not-eq!
|
||||
(fn
|
||||
(a b trail k)
|
||||
(let
|
||||
((mark (pl-trail-mark trail)))
|
||||
(let
|
||||
((unified (pl-unify! a b trail)))
|
||||
(begin
|
||||
(pl-trail-undo-to! trail mark)
|
||||
(cond (unified false) (true (k))))))))
|
||||
|
||||
(define
|
||||
pl-solve-or!
|
||||
(fn
|
||||
(db a b trail cut-box k)
|
||||
(let
|
||||
((mark (pl-trail-mark trail)))
|
||||
(let
|
||||
((r (pl-solve! db a trail cut-box k)))
|
||||
(cond
|
||||
(r true)
|
||||
((dict-get cut-box :cut) false)
|
||||
(true
|
||||
(begin
|
||||
(pl-trail-undo-to! trail mark)
|
||||
(pl-solve! db b trail cut-box k))))))))
|
||||
|
||||
(define
|
||||
pl-solve-eq!
|
||||
(fn
|
||||
|
||||
@@ -240,4 +240,101 @@
|
||||
(pl-solve-count! pl-s-db-cut5 (pl-s-goal "p" {}) (pl-mk-trail))
|
||||
2)
|
||||
|
||||
(pl-s-test!
|
||||
"\\= different atoms succeeds"
|
||||
(pl-solve-once!
|
||||
pl-s-empty-db
|
||||
(pl-s-goal "\\=(a, b)" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
(pl-s-test!
|
||||
"\\= same atoms fails"
|
||||
(pl-solve-once!
|
||||
pl-s-empty-db
|
||||
(pl-s-goal "\\=(a, a)" {})
|
||||
(pl-mk-trail))
|
||||
false)
|
||||
|
||||
(pl-s-test!
|
||||
"\\= var-vs-atom would unify so fails"
|
||||
(pl-solve-once!
|
||||
pl-s-empty-db
|
||||
(pl-s-goal "\\=(X, a)" {})
|
||||
(pl-mk-trail))
|
||||
false)
|
||||
|
||||
(define pl-s-env-ne {})
|
||||
|
||||
(define pl-s-trail-ne (pl-mk-trail))
|
||||
|
||||
(define pl-s-goal-ne (pl-s-goal "\\=(X, a)" pl-s-env-ne))
|
||||
|
||||
(pl-solve-once! pl-s-empty-db pl-s-goal-ne pl-s-trail-ne)
|
||||
|
||||
(pl-s-test!
|
||||
"\\= leaves no bindings"
|
||||
(pl-var-bound? (dict-get pl-s-env-ne "X"))
|
||||
false)
|
||||
|
||||
(pl-s-test!
|
||||
"; left succeeds"
|
||||
(pl-solve-once!
|
||||
pl-s-empty-db
|
||||
(pl-s-goal ";(true, fail)" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
(pl-s-test!
|
||||
"; right succeeds when left fails"
|
||||
(pl-solve-once!
|
||||
pl-s-empty-db
|
||||
(pl-s-goal ";(fail, true)" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
(pl-s-test!
|
||||
"; both fail"
|
||||
(pl-solve-once!
|
||||
pl-s-empty-db
|
||||
(pl-s-goal ";(fail, fail)" {})
|
||||
(pl-mk-trail))
|
||||
false)
|
||||
|
||||
(pl-s-test!
|
||||
"; both branches counted"
|
||||
(pl-solve-count!
|
||||
pl-s-empty-db
|
||||
(pl-s-goal ";(true, true)" {})
|
||||
(pl-mk-trail))
|
||||
2)
|
||||
|
||||
(define pl-s-db-call (pl-mk-db))
|
||||
|
||||
(pl-db-load! pl-s-db-call (pl-parse "p(1). p(2)."))
|
||||
|
||||
(pl-s-test!
|
||||
"call(true) succeeds"
|
||||
(pl-solve-once!
|
||||
pl-s-db-call
|
||||
(pl-s-goal "call(true)" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
(pl-s-test!
|
||||
"call(p(X)) yields all solutions"
|
||||
(pl-solve-count!
|
||||
pl-s-db-call
|
||||
(pl-s-goal "call(p(X))" {})
|
||||
(pl-mk-trail))
|
||||
2)
|
||||
|
||||
(pl-s-test!
|
||||
"call of bound goal var resolves"
|
||||
(pl-solve-once!
|
||||
pl-s-db-call
|
||||
(pl-s-goal "=(G, true), call(G)" {})
|
||||
(pl-mk-trail))
|
||||
true)
|
||||
|
||||
(define pl-solve-tests-run! (fn () {:failed pl-s-test-fail :passed pl-s-test-pass :total pl-s-test-count :failures pl-s-test-failures}))
|
||||
|
||||
@@ -53,7 +53,7 @@ Representation choices (finalise in phase 1, document here):
|
||||
- [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`
|
||||
- [x] 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 — first cut: trail-based undo + CPS k (no shift/reset yet, per briefing gotcha). Built-ins so far: `true/0`, `fail/0`, `=/2`, `,/2`. Refactor to delimited conts later.
|
||||
- [x] Cut (`!`): cut barrier at current choice-point frame; collapse all up to barrier — two-cut-box scheme: each `pl-solve-user!` creates a fresh inner-cut-box (set by `!` in this predicate's body) AND snapshots the outer-cut-box state on entry. After body fails, abandon clause alternatives if (a) inner was set or (b) outer transitioned false→true during this call. Lets post-cut goals backtrack normally while blocking pre-cut alternatives. 6 cut tests cover bare cut, clause-commit, choice-commit, cut+fail, post-cut backtracking, nested-cut isolation.
|
||||
- [ ] Built-ins: `=/2`, `\\=/2`, `true/0`, `fail/0`, `!/0`, `,/2`, `;/2`, `->/2` inside `;`, `call/1`, `write/1`, `nl/0`
|
||||
- [ ] Built-ins: `=/2`, `\\=/2`, `true/0`, `fail/0`, `!/0`, `,/2`, `;/2`, `->/2` inside `;`, `call/1`, `write/1`, `nl/0` — done so far: `=/2`, `true/0`, `fail/0`, `!/0`, `,/2`, `\\=/2`, `;/2`, `call/1`. Pending: `->/2` inside `;`, `write/1`, `nl/0`. Note: cut-transparency via `;` not testable yet without operator support — `;(,(a,!), b)` parser-rejects because `,` is body-operator-only.
|
||||
- [ ] Arithmetic `is/2` with `+ - * / mod abs`
|
||||
- [ ] Classic programs in `lib/prolog/tests/programs/`:
|
||||
- [ ] `append.pl` — list append (with backtracking)
|
||||
@@ -88,6 +88,7 @@ Representation choices (finalise in phase 1, document here):
|
||||
|
||||
_Newest first. Agent appends on every commit._
|
||||
|
||||
- 2026-04-25 — Built-ins `\=/2`, `;/2`, `call/1` landed. `pl-solve-not-eq!` (try unify, always undo, succeed iff unify failed). `pl-solve-or!` (try left, on failure check cut and only try right if not cut). `call/1` opens a fresh inner cut-box (ISO opacity: cut inside `call(G)` commits G, not caller). 11 new tests in `tests/solve.sx` cover atoms+vars for `\=`, both branches + count for `;`, and `call/1` against atoms / compounds / bound goal vars. Total 121 (+11). Box not yet ticked — `->/2`, `write/1`, `nl/0` still pending.
|
||||
- 2026-04-25 — Cut (`!/0`) landed. `pl-cut?` predicate; solver functions all take a `cut-box`; `pl-solve-user!` creates a fresh inner-cut-box and snapshots `outer-was-cut`; `pl-try-clauses!` abandons alternatives when inner.cut OR (outer.cut transitioned false→true during this call). 6 new cut tests in `tests/solve.sx` covering bare cut, clause-commit, choice-commit, cut+fail blocks alt clauses, post-cut goal backtracks freely, inner cut isolation. Total 110 (+6).
|
||||
- 2026-04-25 — Phase 3 DFS solver landed (CPS, trail-based backtracking; delimited conts deferred). `pl-solve!` + `pl-solve-eq!` + `pl-solve-user!` + `pl-try-clauses!` + `pl-solve-once!` + `pl-solve-count!` in runtime.sx. Built-ins: `true/0`, `fail/0`, `=/2`, `,/2`. New `tests/solve.sx` 18/18 green covers atomic goals, =, conjunction, fact lookup, multi-solution count, recursive ancestor rule, trail-undo verification. Bug fix: `pl-instantiate` had no `("clause" h b)` case → vars in rule head/body were never instantiated, so rule resolution silently failed against runtime-var goals. Added clause case to recurse with shared var-env. Total 104 (+18).
|
||||
- 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!).
|
||||
|
||||
Reference in New Issue
Block a user