prolog: \=/2 + ;/2 + call/1 built-ins, 11 tests

lib/prolog/runtime.sx

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

lib/prolog/tests/solve.sx

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