coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

prolog: is/2 arithmetic with + - * / mod abs, 11 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Details

Browse Source
This commit is contained in:
giles
2026-04-25 03:27:56 +00:00
parent 072735a6de
commit 7fb4c52159
3 changed files with 169 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

47
lib/prolog/runtime.sx
View File

@@ -309,6 +309,12 @@
(nth (pl-args g) 1)
trail
k))
((and (pl-compound? g) (= (pl-fun g) "is") (= (len (pl-args g)) 2))
(pl-solve-eq!
(first (pl-args g))
(list "num" (pl-eval-arith (nth (pl-args g) 1)))
trail
k))
((and (pl-compound? g) (= (pl-fun g) ",") (= (len (pl-args g)) 2))
(pl-solve!
db
@@ -429,6 +435,47 @@
(str (pl-fun w) "(" (pl-format-args (pl-args w)) ")"))
(true (str w))))))
(define
pl-eval-arith
(fn
(t)
(let
((w (pl-walk-deep t)))
(cond
((pl-num? w) (pl-num-val w))
((pl-compound? w)
(let
((f (pl-fun w)) (args (pl-args w)))
(cond
((and (= f "+") (= (len args) 2))
(+
(pl-eval-arith (first args))
(pl-eval-arith (nth args 1))))
((and (= f "-") (= (len args) 2))
(-
(pl-eval-arith (first args))
(pl-eval-arith (nth args 1))))
((and (= f "-") (= (len args) 1))
(- 0 (pl-eval-arith (first args))))
((and (= f "*") (= (len args) 2))
(*
(pl-eval-arith (first args))
(pl-eval-arith (nth args 1))))
((and (= f "/") (= (len args) 2))
(/
(pl-eval-arith (first args))
(pl-eval-arith (nth args 1))))
((and (= f "mod") (= (len args) 2))
(mod
(pl-eval-arith (first args))
(pl-eval-arith (nth args 1))))
((and (= f "abs") (= (len args) 1))
(let
((v (pl-eval-arith (first args))))
(cond ((< v 0) (- 0 v)) (true v))))
(true 0))))
(true 0)))))
(define
pl-solve-not-eq!
(fn