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

prolog: ->/2 if-then-else (in ; and standalone), 9 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 02:23:44 +00:00
parent 3adad8e50e
commit 1846be0bd8
3 changed files with 145 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

75
lib/prolog/runtime.sx
View File

@@ -322,12 +322,71 @@
trail
cut-box
k))
((and (pl-compound? g) (= (pl-fun g) "->") (= (len (pl-args g)) 2))
(pl-solve-if-then-else!
db
(first (pl-args g))
(nth (pl-args g) 1)
(list "atom" "fail")
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-or!
(fn
(db a b trail cut-box k)
(cond
((and (pl-compound? a) (= (pl-fun a) "->") (= (len (pl-args a)) 2))
(pl-solve-if-then-else!
db
(first (pl-args a))
(nth (pl-args a) 1)
b
trail
cut-box
k))
(true
(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-if-then-else!
(fn
(db cond-goal then-goal else-goal trail cut-box k)
(let
((mark (pl-trail-mark trail)))
(let
((local-cb {:cut false}))
(let
((found {:val false}))
(pl-solve!
db
cond-goal
trail
local-cb
(fn () (begin (dict-set! found :val true) true)))
(cond
((dict-get found :val) (pl-solve! db then-goal trail cut-box k))
(true
(begin
(pl-trail-undo-to! trail mark)
(pl-solve! db else-goal trail cut-box k)))))))))
(define
pl-solve-not-eq!
(fn
@@ -340,22 +399,6 @@
(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