prolog: operator-table parser + < > =< >= built-ins, 19 tests

lib/prolog/tests/operators.sx

@@ -0,0 +1,193 @@
+;; lib/prolog/tests/operators.sx — operator-table parsing + comparison built-ins.
+
+(define pl-op-test-count 0)
+(define pl-op-test-pass 0)
+(define pl-op-test-fail 0)
+(define pl-op-test-failures (list))
+
+(define
+  pl-op-test!
+  (fn
+    (name got expected)
+    (begin
+      (set! pl-op-test-count (+ pl-op-test-count 1))
+      (if
+        (= got expected)
+        (set! pl-op-test-pass (+ pl-op-test-pass 1))
+        (begin
+          (set! pl-op-test-fail (+ pl-op-test-fail 1))
+          (append!
+            pl-op-test-failures
+            (str name "\n    expected: " expected "\n    got:      " got)))))))
+
+(define pl-op-empty-db (pl-mk-db))
+
+(define
+  pl-op-body
+  (fn (src) (nth (first (pl-parse (str "g :- " src "."))) 2)))
+
+(define pl-op-goal (fn (src env) (pl-instantiate (pl-op-body src) env)))
+
+;; ── parsing tests ──
+
+(pl-op-test!
+  "infix +"
+  (pl-op-body "a + b")
+  (list "compound" "+" (list (list "atom" "a") (list "atom" "b"))))
+
+(pl-op-test!
+  "infix * tighter than +"
+  (pl-op-body "a + b * c")
+  (list
+    "compound"
+    "+"
+    (list
+      (list "atom" "a")
+      (list "compound" "*" (list (list "atom" "b") (list "atom" "c"))))))
+
+(pl-op-test!
+  "parens override precedence"
+  (pl-op-body "(a + b) * c")
+  (list
+    "compound"
+    "*"
+    (list
+      (list "compound" "+" (list (list "atom" "a") (list "atom" "b")))
+      (list "atom" "c"))))
+
+(pl-op-test!
+  "+ is yfx (left-assoc)"
+  (pl-op-body "a + b + c")
+  (list
+    "compound"
+    "+"
+    (list
+      (list "compound" "+" (list (list "atom" "a") (list "atom" "b")))
+      (list "atom" "c"))))
+
+(pl-op-test!
+  "; is xfy (right-assoc)"
+  (pl-op-body "a ; b ; c")
+  (list
+    "compound"
+    ";"
+    (list
+      (list "atom" "a")
+      (list "compound" ";" (list (list "atom" "b") (list "atom" "c"))))))
+
+(pl-op-test!
+  "= folds at 700"
+  (pl-op-body "X = 5")
+  (list "compound" "=" (list (list "var" "X") (list "num" 5))))
+
+(pl-op-test!
+  "is + nests via 700>500>400"
+  (pl-op-body "X is 2 + 3 * 4")
+  (list
+    "compound"
+    "is"
+    (list
+      (list "var" "X")
+      (list
+        "compound"
+        "+"
+        (list
+          (list "num" 2)
+          (list "compound" "*" (list (list "num" 3) (list "num" 4))))))))
+
+(pl-op-test!
+  "< parses at 700"
+  (pl-op-body "2 < 3")
+  (list "compound" "<" (list (list "num" 2) (list "num" 3))))
+
+(pl-op-test!
+  "mod parses as yfx 400"
+  (pl-op-body "10 mod 3")
+  (list "compound" "mod" (list (list "num" 10) (list "num" 3))))
+
+(pl-op-test!
+  "comma in body folds right-assoc"
+  (pl-op-body "a, b, c")
+  (list
+    "compound"
+    ","
+    (list
+      (list "atom" "a")
+      (list "compound" "," (list (list "atom" "b") (list "atom" "c"))))))
+
+;; ── solver tests via infix ──
+
+(pl-op-test!
+  "X is 2 + 3 binds X = 5"
+  (let
+    ((env {}) (trail (pl-mk-trail)))
+    (begin
+      (pl-solve-once! pl-op-empty-db (pl-op-goal "X is 2 + 3" env) trail)
+      (pl-num-val (pl-walk-deep (dict-get env "X")))))
+  5)
+
+(pl-op-test!
+  "infix conjunction parses + solves"
+  (pl-solve-once!
+    pl-op-empty-db
+    (pl-op-goal "X = 5, X = 5" {})
+    (pl-mk-trail))
+  true)
+
+(pl-op-test!
+  "infix mismatch fails"
+  (pl-solve-once!
+    pl-op-empty-db
+    (pl-op-goal "X = 5, X = 6" {})
+    (pl-mk-trail))
+  false)
+
+(pl-op-test!
+  "infix disjunction picks left"
+  (pl-solve-once!
+    pl-op-empty-db
+    (pl-op-goal "true ; fail" {})
+    (pl-mk-trail))
+  true)
+
+(pl-op-test!
+  "2 < 5 succeeds"
+  (pl-solve-once!
+    pl-op-empty-db
+    (pl-op-goal "2 < 5" {})
+    (pl-mk-trail))
+  true)
+
+(pl-op-test!
+  "5 < 2 fails"
+  (pl-solve-once!
+    pl-op-empty-db
+    (pl-op-goal "5 < 2" {})
+    (pl-mk-trail))
+  false)
+
+(pl-op-test!
+  "5 >= 5 succeeds"
+  (pl-solve-once!
+    pl-op-empty-db
+    (pl-op-goal "5 >= 5" {})
+    (pl-mk-trail))
+  true)
+
+(pl-op-test!
+  "3 =< 5 succeeds"
+  (pl-solve-once!
+    pl-op-empty-db
+    (pl-op-goal "3 =< 5" {})
+    (pl-mk-trail))
+  true)
+
+(pl-op-test!
+  "infix < with arithmetic both sides"
+  (pl-solve-once!
+    pl-op-empty-db
+    (pl-op-goal "1 + 2 < 2 * 3" {})
+    (pl-mk-trail))
+  true)
+
+(define pl-operators-tests-run! (fn () {:failed pl-op-test-fail :passed pl-op-test-pass :total pl-op-test-count :failures pl-op-test-failures}))