prolog: ->/2 if-then-else (in ; and standalone), 9 tests

lib/prolog/runtime.sx

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

lib/prolog/tests/solve.sx

@@ -337,4 +337,88 @@
     (pl-mk-trail))
   true)
 
+(define pl-s-db-ite (pl-mk-db))
+
+(pl-db-load! pl-s-db-ite (pl-parse "p(1). p(2). q(yes). q(no)."))
+
+(pl-s-test!
+  "if-then-else: cond true → then runs"
+  (pl-solve-once!
+    pl-s-db-ite
+    (pl-s-goal ";(->(true, =(X, ok)), =(X, fallback))" {})
+    (pl-mk-trail))
+  true)
+
+(define pl-s-env-ite1 {})
+
+(pl-solve-once!
+  pl-s-db-ite
+  (pl-s-goal ";(->(true, =(X, ok)), =(X, fallback))" pl-s-env-ite1)
+  (pl-mk-trail))
+
+(pl-s-test!
+  "if-then-else: cond true binds via then"
+  (pl-atom-name (pl-walk-deep (dict-get pl-s-env-ite1 "X")))
+  "ok")
+
+(pl-s-test!
+  "if-then-else: cond false → else"
+  (pl-solve-once!
+    pl-s-db-ite
+    (pl-s-goal ";(->(fail, =(X, ok)), =(X, fallback))" {})
+    (pl-mk-trail))
+  true)
+
+(define pl-s-env-ite2 {})
+
+(pl-solve-once!
+  pl-s-db-ite
+  (pl-s-goal ";(->(fail, =(X, ok)), =(X, fallback))" pl-s-env-ite2)
+  (pl-mk-trail))
+
+(pl-s-test!
+  "if-then-else: cond false binds via else"
+  (pl-atom-name (pl-walk-deep (dict-get pl-s-env-ite2 "X")))
+  "fallback")
+
+(pl-s-test!
+  "if-then-else: cond commits to first solution (count = 1)"
+  (pl-solve-count!
+    pl-s-db-ite
+    (pl-s-goal ";(->(p(X), =(Y, found)), =(Y, none))" {})
+    (pl-mk-trail))
+  1)
+
+(pl-s-test!
+  "if-then-else: then can backtrack"
+  (pl-solve-count!
+    pl-s-db-ite
+    (pl-s-goal ";(->(true, p(X)), =(X, none))" {})
+    (pl-mk-trail))
+  2)
+
+(pl-s-test!
+  "if-then-else: else can backtrack"
+  (pl-solve-count!
+    pl-s-db-ite
+    (pl-s-goal ";(->(fail, =(X, ignored)), p(X))" {})
+    (pl-mk-trail))
+  2)
+
+(pl-s-test!
+  "standalone -> with true cond succeeds"
+  (pl-solve-once!
+    pl-s-db-ite
+    (pl-s-goal "->(true, =(X, hi))" {})
+    (pl-mk-trail))
+  true)
+
+(pl-s-test!
+  "standalone -> with false cond fails"
+  (pl-solve-once!
+    pl-s-db-ite
+    (pl-s-goal "->(fail, =(X, hi))" {})
+    (pl-mk-trail))
+  false)
+
 (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}))