List/utility predicates: ==/2, \==/2, flatten/2, numlist/3, atomic_list_concat/2,3, sum_list/2, max_list/2, min_list/2, delete/3
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
33 new tests, all 375/375 conformance tests passing. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -886,6 +886,154 @@
|
||||
k))
|
||||
(true false)))))
|
||||
|
||||
;; ── Structural equality helper (for ==/2, \==/2, delete/3) ────────
|
||||
(define
|
||||
pl-struct-eq?
|
||||
(fn
|
||||
(a b)
|
||||
(cond
|
||||
((and (pl-var? a) (pl-var? b))
|
||||
(= (dict-get a :id) (dict-get b :id)))
|
||||
((and (pl-atom? a) (pl-atom? b))
|
||||
(= (pl-atom-name a) (pl-atom-name b)))
|
||||
((and (pl-num? a) (pl-num? b))
|
||||
(= (pl-num-val a) (pl-num-val b)))
|
||||
((and (pl-compound? a) (pl-compound? b))
|
||||
(if
|
||||
(and
|
||||
(= (pl-fun a) (pl-fun b))
|
||||
(= (len (pl-args a)) (len (pl-args b))))
|
||||
(let
|
||||
((all-eq true)
|
||||
(i 0))
|
||||
(begin
|
||||
(for-each
|
||||
(fn (ai)
|
||||
(begin
|
||||
(if
|
||||
(not (pl-struct-eq? ai (nth (pl-args b) i)))
|
||||
(set! all-eq false)
|
||||
nil)
|
||||
(set! i (+ i 1))))
|
||||
(pl-args a))
|
||||
all-eq))
|
||||
false))
|
||||
(true false))))
|
||||
|
||||
;; ── Flatten helper: collect all non-list leaves into SX list ───────
|
||||
(define
|
||||
pl-flatten-prolog
|
||||
(fn
|
||||
(t)
|
||||
(let
|
||||
((w (pl-walk-deep t)))
|
||||
(cond
|
||||
((and (pl-atom? w) (= (pl-atom-name w) "[]")) (list))
|
||||
((and (pl-compound? w) (= (pl-fun w) ".") (= (len (pl-args w)) 2))
|
||||
(let
|
||||
((h (pl-walk-deep (first (pl-args w))))
|
||||
(tl (nth (pl-args w) 1)))
|
||||
(if
|
||||
(or
|
||||
(and (pl-atom? h) (= (pl-atom-name h) "[]"))
|
||||
(and (pl-compound? h) (= (pl-fun h) ".")))
|
||||
(append (pl-flatten-prolog h) (pl-flatten-prolog tl))
|
||||
(cons h (pl-flatten-prolog tl)))))
|
||||
(true (list w))))))
|
||||
|
||||
;; ── numlist helper: build SX list of ("num" i) for i in [lo..hi] ──
|
||||
(define
|
||||
pl-numlist-build
|
||||
(fn
|
||||
(lo hi)
|
||||
(if
|
||||
(> lo hi)
|
||||
(list)
|
||||
(cons (list "num" lo) (pl-numlist-build (+ lo 1) hi)))))
|
||||
|
||||
;; ── atomic_list_concat helper: collect atom names / num vals ───────
|
||||
(define
|
||||
pl-atomic-list-collect
|
||||
(fn
|
||||
(prolog-list)
|
||||
(let
|
||||
((items (pl-prolog-list-to-sx prolog-list)))
|
||||
(map
|
||||
(fn (item)
|
||||
(let
|
||||
((w (pl-walk-deep item)))
|
||||
(cond
|
||||
((pl-atom? w) (pl-atom-name w))
|
||||
((pl-num? w) (str (pl-num-val w)))
|
||||
(true ""))))
|
||||
items))))
|
||||
|
||||
;; ── sum_list helper ────────────────────────────────────────────────
|
||||
(define
|
||||
pl-sum-list-sx
|
||||
(fn
|
||||
(prolog-list)
|
||||
(let
|
||||
((items (pl-prolog-list-to-sx prolog-list)))
|
||||
(reduce
|
||||
(fn (acc item)
|
||||
(+ acc (pl-num-val (pl-walk-deep item))))
|
||||
0
|
||||
items))))
|
||||
|
||||
;; ── max_list / min_list helpers ────────────────────────────────────
|
||||
(define
|
||||
pl-max-list-sx
|
||||
(fn
|
||||
(prolog-list)
|
||||
(let
|
||||
((items (pl-prolog-list-to-sx prolog-list)))
|
||||
(reduce
|
||||
(fn (acc item)
|
||||
(let ((v (pl-num-val (pl-walk-deep item))))
|
||||
(if (> v acc) v acc)))
|
||||
(pl-num-val (pl-walk-deep (first items)))
|
||||
(rest items)))))
|
||||
|
||||
(define
|
||||
pl-min-list-sx
|
||||
(fn
|
||||
(prolog-list)
|
||||
(let
|
||||
((items (pl-prolog-list-to-sx prolog-list)))
|
||||
(reduce
|
||||
(fn (acc item)
|
||||
(let ((v (pl-num-val (pl-walk-deep item))))
|
||||
(if (< v acc) v acc)))
|
||||
(pl-num-val (pl-walk-deep (first items)))
|
||||
(rest items)))))
|
||||
|
||||
;; ── delete/3 helper: remove elements struct-equal to elem ──────────
|
||||
(define
|
||||
pl-delete-sx
|
||||
(fn
|
||||
(prolog-list elem)
|
||||
(let
|
||||
((items (pl-prolog-list-to-sx prolog-list))
|
||||
(ew (pl-walk-deep elem)))
|
||||
(filter
|
||||
(fn (item)
|
||||
(not (pl-struct-eq? (pl-walk-deep item) ew)))
|
||||
items))))
|
||||
|
||||
;; ── join string list with separator ────────────────────────────────
|
||||
(define
|
||||
pl-join-strings
|
||||
(fn
|
||||
(strs sep)
|
||||
(if
|
||||
(empty? strs)
|
||||
""
|
||||
(reduce
|
||||
(fn (acc s) (str acc sep s))
|
||||
(first strs)
|
||||
(rest strs)))))
|
||||
|
||||
(define
|
||||
pl-solve!
|
||||
(fn
|
||||
@@ -1326,6 +1474,148 @@
|
||||
k)))
|
||||
false))
|
||||
(true false))))
|
||||
|
||||
;; ==/2 — structural equality (no binding)
|
||||
((and (pl-compound? g) (= (pl-fun g) "==") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((a (pl-walk-deep (first (pl-args g))))
|
||||
(b (pl-walk-deep (nth (pl-args g) 1))))
|
||||
(if (pl-struct-eq? a b) (k) false)))
|
||||
|
||||
;; \==/2 — structural inequality
|
||||
((and (pl-compound? g) (= (pl-fun g) "\\==") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((a (pl-walk-deep (first (pl-args g))))
|
||||
(b (pl-walk-deep (nth (pl-args g) 1))))
|
||||
(if (pl-struct-eq? a b) false (k))))
|
||||
|
||||
;; flatten/2
|
||||
((and (pl-compound? g) (= (pl-fun g) "flatten") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((lst-rt (pl-walk (first (pl-args g)))))
|
||||
(if
|
||||
(pl-proper-list? lst-rt)
|
||||
(let
|
||||
((flat-sx (pl-flatten-prolog lst-rt)))
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(pl-list-to-prolog flat-sx)
|
||||
trail
|
||||
k))
|
||||
false)))
|
||||
|
||||
;; numlist/3
|
||||
((and (pl-compound? g) (= (pl-fun g) "numlist") (= (len (pl-args g)) 3))
|
||||
(let
|
||||
((wlo (pl-walk-deep (first (pl-args g))))
|
||||
(whi (pl-walk-deep (nth (pl-args g) 1))))
|
||||
(if
|
||||
(and (pl-num? wlo) (pl-num? whi))
|
||||
(let
|
||||
((lo (pl-num-val wlo)) (hi (pl-num-val whi)))
|
||||
(if
|
||||
(> lo hi)
|
||||
false
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 2)
|
||||
(pl-list-to-prolog (pl-numlist-build lo hi))
|
||||
trail
|
||||
k)))
|
||||
false)))
|
||||
|
||||
;; atomic_list_concat/2 — no separator
|
||||
((and
|
||||
(pl-compound? g)
|
||||
(= (pl-fun g) "atomic_list_concat")
|
||||
(= (len (pl-args g)) 2))
|
||||
(let
|
||||
((lst-rt (pl-walk (first (pl-args g)))))
|
||||
(if
|
||||
(pl-proper-list? lst-rt)
|
||||
(let
|
||||
((strs (pl-atomic-list-collect lst-rt)))
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(list "atom" (reduce (fn (a b) (str a b)) "" strs))
|
||||
trail
|
||||
k))
|
||||
false)))
|
||||
|
||||
;; atomic_list_concat/3 — with separator
|
||||
((and
|
||||
(pl-compound? g)
|
||||
(= (pl-fun g) "atomic_list_concat")
|
||||
(= (len (pl-args g)) 3))
|
||||
(let
|
||||
((lst-rt (pl-walk (first (pl-args g))))
|
||||
(sep-rt (pl-walk-deep (nth (pl-args g) 1))))
|
||||
(if
|
||||
(and (pl-proper-list? lst-rt) (pl-atom? sep-rt))
|
||||
(let
|
||||
((strs (pl-atomic-list-collect lst-rt))
|
||||
(sep (pl-atom-name sep-rt)))
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 2)
|
||||
(list "atom" (pl-join-strings strs sep))
|
||||
trail
|
||||
k))
|
||||
false)))
|
||||
|
||||
;; sum_list/2
|
||||
((and (pl-compound? g) (= (pl-fun g) "sum_list") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((lst-rt (pl-walk (first (pl-args g)))))
|
||||
(if
|
||||
(pl-proper-list? lst-rt)
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(list "num" (pl-sum-list-sx lst-rt))
|
||||
trail
|
||||
k)
|
||||
false)))
|
||||
|
||||
;; max_list/2
|
||||
((and (pl-compound? g) (= (pl-fun g) "max_list") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((lst-rt (pl-walk (first (pl-args g)))))
|
||||
(if
|
||||
(and (pl-proper-list? lst-rt) (not (and (pl-atom? lst-rt) (= (pl-atom-name lst-rt) "[]"))))
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(list "num" (pl-max-list-sx lst-rt))
|
||||
trail
|
||||
k)
|
||||
false)))
|
||||
|
||||
;; min_list/2
|
||||
((and (pl-compound? g) (= (pl-fun g) "min_list") (= (len (pl-args g)) 2))
|
||||
(let
|
||||
((lst-rt (pl-walk (first (pl-args g)))))
|
||||
(if
|
||||
(and (pl-proper-list? lst-rt) (not (and (pl-atom? lst-rt) (= (pl-atom-name lst-rt) "[]"))))
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 1)
|
||||
(list "num" (pl-min-list-sx lst-rt))
|
||||
trail
|
||||
k)
|
||||
false)))
|
||||
|
||||
;; delete/3
|
||||
((and (pl-compound? g) (= (pl-fun g) "delete") (= (len (pl-args g)) 3))
|
||||
(let
|
||||
((lst-rt (pl-walk (first (pl-args g))))
|
||||
(elem-rt (nth (pl-args g) 1)))
|
||||
(if
|
||||
(pl-proper-list? lst-rt)
|
||||
(let
|
||||
((filtered (pl-delete-sx lst-rt elem-rt)))
|
||||
(pl-solve-eq!
|
||||
(nth (pl-args g) 2)
|
||||
(pl-list-to-prolog filtered)
|
||||
trail
|
||||
k))
|
||||
false)))
|
||||
|
||||
(true (pl-solve-user! db g trail cut-box k))))))
|
||||
|
||||
(define
|
||||
|
||||
Reference in New Issue
Block a user