prolog: copy_term/2 + functor/3 + arg/3, 14 tests; =.. deferred

lib/prolog/conformance.sh

@@ -23,6 +23,7 @@ SUITES=(
   "operators:lib/prolog/tests/operators.sx:pl-operators-tests-run!"
   "dynamic:lib/prolog/tests/dynamic.sx:pl-dynamic-tests-run!"
   "findall:lib/prolog/tests/findall.sx:pl-findall-tests-run!"
+  "term_inspect:lib/prolog/tests/term_inspect.sx:pl-term-inspect-tests-run!"
   "append:lib/prolog/tests/programs/append.sx:pl-append-tests-run!"
   "reverse:lib/prolog/tests/programs/reverse.sx:pl-reverse-tests-run!"
   "member:lib/prolog/tests/programs/member.sx:pl-member-tests-run!"

lib/prolog/runtime.sx

@@ -470,6 +470,90 @@
               ((rl (pl-mk-list-term sorted (pl-nil-term))))
               (pl-solve-eq! third-rt rl trail k))))))))
 
+(define
+  pl-solve-eq2!
+  (fn
+    (a1 b1 a2 b2 trail k)
+    (let
+      ((mark (pl-trail-mark trail)))
+      (cond
+        ((and (pl-unify! a1 b1 trail) (pl-unify! a2 b2 trail))
+          (let
+            ((r (k)))
+            (cond
+              (r true)
+              (true (begin (pl-trail-undo-to! trail mark) false)))))
+        (true (begin (pl-trail-undo-to! trail mark) false))))))
+
+(define
+  pl-make-fresh-args
+  (fn
+    (n)
+    (cond
+      ((<= n 0) (list))
+      (true (cons (pl-mk-rt-var "_") (pl-make-fresh-args (- n 1)))))))
+
+(define
+  pl-solve-functor-construct!
+  (fn
+    (term-rt name-rt arity-rt trail k)
+    (let
+      ((wn (pl-walk name-rt)) (wa (pl-walk arity-rt)))
+      (cond
+        ((and (pl-num? wa) (= (pl-num-val wa) 0))
+          (cond
+            ((or (pl-atom? wn) (pl-num? wn))
+              (pl-solve-eq! term-rt wn trail k))
+            (true false)))
+        ((and (pl-num? wa) (> (pl-num-val wa) 0) (pl-atom? wn))
+          (let
+            ((new-args (pl-make-fresh-args (pl-num-val wa))))
+            (pl-solve-eq!
+              term-rt
+              (list "compound" (pl-atom-name wn) new-args)
+              trail
+              k)))
+        (true false)))))
+
+(define
+  pl-solve-functor!
+  (fn
+    (term-rt name-rt arity-rt trail k)
+    (let
+      ((wt (pl-walk term-rt)))
+      (cond
+        ((pl-var? wt)
+          (pl-solve-functor-construct! term-rt name-rt arity-rt trail k))
+        ((pl-atom? wt)
+          (pl-solve-eq2! name-rt wt arity-rt (list "num" 0) trail k))
+        ((pl-num? wt)
+          (pl-solve-eq2! name-rt wt arity-rt (list "num" 0) trail k))
+        ((pl-compound? wt)
+          (pl-solve-eq2!
+            name-rt
+            (list "atom" (pl-fun wt))
+            arity-rt
+            (list "num" (len (pl-args wt)))
+            trail
+            k))
+        (true false)))))
+
+(define
+  pl-solve-arg!
+  (fn
+    (n-rt term-rt arg-rt trail k)
+    (let
+      ((wn (pl-walk n-rt)) (wt (pl-walk term-rt)))
+      (cond
+        ((and (pl-num? wn) (pl-compound? wt))
+          (let
+            ((idx (pl-num-val wn)) (args (pl-args wt)))
+            (cond
+              ((and (>= idx 1) (<= idx (len args)))
+                (pl-solve-eq! arg-rt (nth args (- idx 1)) trail k))
+              (true false))))
+        (true false)))))
+
 (define
   pl-retract-try-each
   (fn
@@ -622,6 +706,26 @@
             (nth (pl-args g) 2)
             trail
             k))
+        ((and (pl-compound? g) (= (pl-fun g) "copy_term") (= (len (pl-args g)) 2))
+          (pl-solve-eq!
+            (nth (pl-args g) 1)
+            (pl-deep-copy (first (pl-args g)) {})
+            trail
+            k))
+        ((and (pl-compound? g) (= (pl-fun g) "functor") (= (len (pl-args g)) 3))
+          (pl-solve-functor!
+            (first (pl-args g))
+            (nth (pl-args g) 1)
+            (nth (pl-args g) 2)
+            trail
+            k))
+        ((and (pl-compound? g) (= (pl-fun g) "arg") (= (len (pl-args g)) 3))
+          (pl-solve-arg!
+            (first (pl-args g))
+            (nth (pl-args g) 1)
+            (nth (pl-args g) 2)
+            trail
+            k))
         (true (pl-solve-user! db g trail cut-box k))))))
 
 (define

lib/prolog/scoreboard.json

@@ -1,7 +1,7 @@
 {
-  "total_passed": 224,
+  "total_passed": 238,
   "total_failed": 0,
-  "total": 224,
-  "suites": {"parse":{"passed":25,"total":25,"failed":0},"unify":{"passed":47,"total":47,"failed":0},"clausedb":{"passed":14,"total":14,"failed":0},"solve":{"passed":62,"total":62,"failed":0},"operators":{"passed":19,"total":19,"failed":0},"dynamic":{"passed":11,"total":11,"failed":0},"findall":{"passed":11,"total":11,"failed":0},"append":{"passed":6,"total":6,"failed":0},"reverse":{"passed":6,"total":6,"failed":0},"member":{"passed":7,"total":7,"failed":0},"nqueens":{"passed":6,"total":6,"failed":0},"family":{"passed":10,"total":10,"failed":0}},
-  "generated": "2026-04-25T08:06:14+00:00"
+  "total": 238,
+  "suites": {"parse":{"passed":25,"total":25,"failed":0},"unify":{"passed":47,"total":47,"failed":0},"clausedb":{"passed":14,"total":14,"failed":0},"solve":{"passed":62,"total":62,"failed":0},"operators":{"passed":19,"total":19,"failed":0},"dynamic":{"passed":11,"total":11,"failed":0},"findall":{"passed":11,"total":11,"failed":0},"term_inspect":{"passed":14,"total":14,"failed":0},"append":{"passed":6,"total":6,"failed":0},"reverse":{"passed":6,"total":6,"failed":0},"member":{"passed":7,"total":7,"failed":0},"nqueens":{"passed":6,"total":6,"failed":0},"family":{"passed":10,"total":10,"failed":0}},
+  "generated": "2026-04-25T08:39:07+00:00"
 }

lib/prolog/scoreboard.md

@@ -1,7 +1,7 @@
 # Prolog scoreboard
 
-**224 / 224 passing** (0 failure(s)).
-Generated 2026-04-25T08:06:14+00:00.
+**238 / 238 passing** (0 failure(s)).
+Generated 2026-04-25T08:39:07+00:00.
 
 | Suite | Passed | Total | Status |
 |-------|--------|-------|--------|
@@ -12,6 +12,7 @@ Generated 2026-04-25T08:06:14+00:00.
 | operators | 19 | 19 | ok |
 | dynamic | 11 | 11 | ok |
 | findall | 11 | 11 | ok |
+| term_inspect | 14 | 14 | ok |
 | append | 6 | 6 | ok |
 | reverse | 6 | 6 | ok |
 | member | 7 | 7 | ok |

lib/prolog/tests/term_inspect.sx

@@ -0,0 +1,147 @@
+;; lib/prolog/tests/term_inspect.sx — copy_term/2, functor/3, arg/3.
+
+(define pl-tt-test-count 0)
+(define pl-tt-test-pass 0)
+(define pl-tt-test-fail 0)
+(define pl-tt-test-failures (list))
+
+(define
+  pl-tt-test!
+  (fn
+    (name got expected)
+    (begin
+      (set! pl-tt-test-count (+ pl-tt-test-count 1))
+      (if
+        (= got expected)
+        (set! pl-tt-test-pass (+ pl-tt-test-pass 1))
+        (begin
+          (set! pl-tt-test-fail (+ pl-tt-test-fail 1))
+          (append!
+            pl-tt-test-failures
+            (str name "\n    expected: " expected "\n    got:      " got)))))))
+
+(define
+  pl-tt-goal
+  (fn
+    (src env)
+    (pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))
+
+(define pl-tt-db (pl-mk-db))
+
+;; ── copy_term/2 ──
+
+(pl-tt-test!
+  "copy_term ground compound succeeds + copy = original"
+  (pl-solve-once!
+    pl-tt-db
+    (pl-tt-goal "copy_term(foo(a, b), X), X = foo(a, b)" {})
+    (pl-mk-trail))
+  true)
+
+(pl-tt-test!
+  "copy_term preserves var aliasing in source"
+  (pl-solve-once!
+    pl-tt-db
+    (pl-tt-goal "copy_term(p(Y, Y), p(A, B)), A = 5, B = 5" {})
+    (pl-mk-trail))
+  true)
+
+(pl-tt-test!
+  "copy_term distinct vars stay distinct"
+  (pl-solve-once!
+    pl-tt-db
+    (pl-tt-goal "copy_term(p(Y, Y), p(A, B)), A = 5, B = 6" {})
+    (pl-mk-trail))
+  false)
+
+(define pl-tt-env-1 {})
+(pl-solve-once!
+  pl-tt-db
+  (pl-tt-goal "copy_term(X, Y), Y = 5" pl-tt-env-1)
+  (pl-mk-trail))
+(pl-tt-test!
+  "copy_term: binding the copy doesn't bind the source"
+  (pl-var-bound? (dict-get pl-tt-env-1 "X"))
+  false)
+
+;; ── functor/3 ──
+
+(define pl-tt-env-2 {})
+(pl-solve-once!
+  pl-tt-db
+  (pl-tt-goal "functor(foo(a, b, c), F, N)" pl-tt-env-2)
+  (pl-mk-trail))
+(pl-tt-test!
+  "functor of compound: F = foo"
+  (pl-atom-name (pl-walk-deep (dict-get pl-tt-env-2 "F")))
+  "foo")
+(pl-tt-test!
+  "functor of compound: N = 3"
+  (pl-num-val (pl-walk-deep (dict-get pl-tt-env-2 "N")))
+  3)
+
+(define pl-tt-env-3 {})
+(pl-solve-once!
+  pl-tt-db
+  (pl-tt-goal "functor(hello, F, N)" pl-tt-env-3)
+  (pl-mk-trail))
+(pl-tt-test!
+  "functor of atom: F = hello"
+  (pl-atom-name (pl-walk-deep (dict-get pl-tt-env-3 "F")))
+  "hello")
+(pl-tt-test!
+  "functor of atom: N = 0"
+  (pl-num-val (pl-walk-deep (dict-get pl-tt-env-3 "N")))
+  0)
+
+(pl-tt-test!
+  "functor construct compound: T unifies with foo(a, b)"
+  (pl-solve-once!
+    pl-tt-db
+    (pl-tt-goal "functor(T, foo, 2), T = foo(a, b)" {})
+    (pl-mk-trail))
+  true)
+
+(pl-tt-test!
+  "functor construct atom: T = hello"
+  (pl-solve-once!
+    pl-tt-db
+    (pl-tt-goal "functor(T, hello, 0), T = hello" {})
+    (pl-mk-trail))
+  true)
+
+;; ── arg/3 ──
+
+(pl-tt-test!
+  "arg(1, foo(a, b, c), a)"
+  (pl-solve-once!
+    pl-tt-db
+    (pl-tt-goal "arg(1, foo(a, b, c), a)" {})
+    (pl-mk-trail))
+  true)
+
+(pl-tt-test!
+  "arg(2, foo(a, b, c), X) → X = b"
+  (pl-solve-once!
+    pl-tt-db
+    (pl-tt-goal "arg(2, foo(a, b, c), X), X = b" {})
+    (pl-mk-trail))
+  true)
+
+(pl-tt-test!
+  "arg out-of-range high fails"
+  (pl-solve-once!
+    pl-tt-db
+    (pl-tt-goal "arg(4, foo(a, b, c), X)" {})
+    (pl-mk-trail))
+  false)
+
+(pl-tt-test!
+  "arg(0, ...) fails (1-indexed)"
+  (pl-solve-once!
+    pl-tt-db
+    (pl-tt-goal "arg(0, foo(a), X)" {})
+    (pl-mk-trail))
+  false)
+
+(define pl-term-inspect-tests-run! (fn () {:failed pl-tt-test-fail :passed pl-tt-test-pass :total pl-tt-test-count :failures pl-tt-test-failures}))