coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

prolog: \=/2 + ;/2 + call/1 built-ins, 11 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Details

Browse Source
This commit is contained in:
giles
2026-04-25 01:48:57 +00:00
parent f019d42727
commit 3adad8e50e
3 changed files with 145 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

46
lib/prolog/runtime.sx
View File

@@ -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