From 8cfffbeccdab028f780dcaf9f4ffaf97d7393a1e Mon Sep 17 00:00:00 2001 From: Daniel Cerqueira Date: Sun, 16 Aug 2026 12:59:14 +0100 Subject: add diff operator - and remove and diff and differ - and update documentation - and update all lali scripts --- README.md | 27 ++++++---------- examples/abacus/reading.lali | 62 ++++++++++++++++++------------------ examples/abacus/writing.lali | 62 ++++++++++++++++++------------------ examples/hanoi.lali | 2 +- examples/mandelbrot.lali | 2 +- examples/speech/en-random.lali | 12 +++---- examples/speech/en-random_more.lali | 12 +++---- examples/speech/pt-fixed_answer.lali | 12 +++---- examples/speech/pt-identify.lali | 4 +-- examples/speech/pt-random.lali | 12 +++---- examples/speech/pt-random_more.lali | 12 +++---- liblali.c | 24 ++++++++------ test/main.lali | 31 +++++++----------- 13 files changed, 132 insertions(+), 142 deletions(-) diff --git a/README.md b/README.md index c2ed2c1..2bd4b8b 100644 --- a/README.md +++ b/README.md @@ -130,23 +130,16 @@ which is `y`: ### Predicates -`(dif x y)` returns `t` if `x` and `y` refers to different objects, or if they are -numbers with different values, or if they are string objects with different -contents: - - (dif +1 +1) ; f - (dif +1 +2) ; t - (dif 'a 'a) ; f - (dif 'a 'b) ; t - (dif t t) ; f - (dif t f) ; t - (dif '(a b) '(a b)) ; t - -`(differ x y)` returns `t` if `x` and `y` are objects of different structure and -each of their elements satisfy the `dif` predicate, otherwise `f`: - - (differ '(a b) '(a)) ; t - (differ '(a b) '(a b)) ; f +`(diff x y)` returns `t` if `x` and `y` are different, otherwise `f`: + + (diff +1 +1) ; f + (diff +1 +2) ; t + (diff 'a 'a) ; f + (diff 'a 'b) ; t + (diff t t) ; f + (diff t f) ; t + (diff '(a b) '(a)) ; t + (diff '(a b) '(a b)) ; f `(space x)` returns `t` if `x` is an empty list `()`, otherwise `f`: diff --git a/examples/abacus/reading.lali b/examples/abacus/reading.lali index 6663bb3..2f34f00 100755 --- a/examples/abacus/reading.lali +++ b/examples/abacus/reading.lali @@ -4,47 +4,47 @@ ;; functions (defun random-number (cases) (fill - ((dif cases +0) (cons (random +9) ())) + ((diff cases +0) (cons (random +9) ())) (f (cons (random +9) (random-number (- cases +1)))))) (defun number-to-symbol (num) (fill - ((dif +0 num) '0) - ((dif +1 num) '1) - ((dif +2 num) '2) - ((dif +3 num) '3) - ((dif +4 num) '4) - ((dif +5 num) '5) - ((dif +6 num) '6) - ((dif +7 num) '7) - ((dif +8 num) '8) - ((dif +9 num) '9))) + ((diff +0 num) '0) + ((diff +1 num) '1) + ((diff +2 num) '2) + ((diff +3 num) '3) + ((diff +4 num) '4) + ((diff +5 num) '5) + ((diff +6 num) '6) + ((diff +7 num) '7) + ((diff +8 num) '8) + ((diff +9 num) '9))) (defun number-to-earth-rod (num) (fill - ((dif +0 num) "[@-@][@@@@-@]") - ((dif +1 num) "[@-@][@@@-@@]") - ((dif +2 num) "[@-@][@@-@@@]") - ((dif +3 num) "[@-@][@-@@@@]") - ((dif +4 num) "[@-@][-@@@@@]") - ((dif +5 num) "[-@@][@@@@-@]") - ((dif +6 num) "[-@@][@@@-@@]") - ((dif +7 num) "[-@@][@@-@@@]") - ((dif +8 num) "[-@@][@-@@@@]") - ((dif +9 num) "[-@@][-@@@@@]"))) + ((diff +0 num) "[@-@][@@@@-@]") + ((diff +1 num) "[@-@][@@@-@@]") + ((diff +2 num) "[@-@][@@-@@@]") + ((diff +3 num) "[@-@][@-@@@@]") + ((diff +4 num) "[@-@][-@@@@@]") + ((diff +5 num) "[-@@][@@@@-@]") + ((diff +6 num) "[-@@][@@@-@@]") + ((diff +7 num) "[-@@][@@-@@@]") + ((diff +8 num) "[-@@][@-@@@@]") + ((diff +9 num) "[-@@][-@@@@@]"))) (defun number-to-air-rod (num) (fill - ((dif +0 num) "[@-@@@@][@-@]") - ((dif +1 num) "[@@-@@@][@-@]") - ((dif +2 num) "[@@@-@@][@-@]") - ((dif +3 num) "[@@@@-@][@-@]") - ((dif +4 num) "[@@@@@-][@-@]") - ((dif +5 num) "[@-@@@@][@@-]") - ((dif +6 num) "[@@-@@@][@@-]") - ((dif +7 num) "[@@@-@@][@@-]") - ((dif +8 num) "[@@@@-@][@@-]") - ((dif +9 num) "[@@@@@-][@@-]"))) + ((diff +0 num) "[@-@@@@][@-@]") + ((diff +1 num) "[@@-@@@][@-@]") + ((diff +2 num) "[@@@-@@][@-@]") + ((diff +3 num) "[@@@@-@][@-@]") + ((diff +4 num) "[@@@@@-][@-@]") + ((diff +5 num) "[@-@@@@][@@-]") + ((diff +6 num) "[@@-@@@][@@-]") + ((diff +7 num) "[@@@-@@][@@-]") + ((diff +8 num) "[@@@@-@][@@-]") + ((diff +9 num) "[@@@@@-][@@-]"))) ;; main (defun main () diff --git a/examples/abacus/writing.lali b/examples/abacus/writing.lali index 17fd7c4..4876582 100755 --- a/examples/abacus/writing.lali +++ b/examples/abacus/writing.lali @@ -4,47 +4,47 @@ ;; functions (defun random-number (cases) (fill - ((dif cases +0) (cons (random +9) ())) + ((diff cases +0) (cons (random +9) ())) (f (cons (random +9) (random-number (- cases +1)))))) (defun number-to-symbol (num) (fill - ((dif +0 num) '0) - ((dif +1 num) '1) - ((dif +2 num) '2) - ((dif +3 num) '3) - ((dif +4 num) '4) - ((dif +5 num) '5) - ((dif +6 num) '6) - ((dif +7 num) '7) - ((dif +8 num) '8) - ((dif +9 num) '9))) + ((diff +0 num) '0) + ((diff +1 num) '1) + ((diff +2 num) '2) + ((diff +3 num) '3) + ((diff +4 num) '4) + ((diff +5 num) '5) + ((diff +6 num) '6) + ((diff +7 num) '7) + ((diff +8 num) '8) + ((diff +9 num) '9))) (defun number-to-earth-rod (num) (fill - ((dif +0 num) "[@-@][@@@@-@]") - ((dif +1 num) "[@-@][@@@-@@]") - ((dif +2 num) "[@-@][@@-@@@]") - ((dif +3 num) "[@-@][@-@@@@]") - ((dif +4 num) "[@-@][-@@@@@]") - ((dif +5 num) "[-@@][@@@@-@]") - ((dif +6 num) "[-@@][@@@-@@]") - ((dif +7 num) "[-@@][@@-@@@]") - ((dif +8 num) "[-@@][@-@@@@]") - ((dif +9 num) "[-@@][-@@@@@]"))) + ((diff +0 num) "[@-@][@@@@-@]") + ((diff +1 num) "[@-@][@@@-@@]") + ((diff +2 num) "[@-@][@@-@@@]") + ((diff +3 num) "[@-@][@-@@@@]") + ((diff +4 num) "[@-@][-@@@@@]") + ((diff +5 num) "[-@@][@@@@-@]") + ((diff +6 num) "[-@@][@@@-@@]") + ((diff +7 num) "[-@@][@@-@@@]") + ((diff +8 num) "[-@@][@-@@@@]") + ((diff +9 num) "[-@@][-@@@@@]"))) (defun number-to-air-rod (num) (fill - ((dif +0 num) "[@-@@@@][@-@]") - ((dif +1 num) "[@@-@@@][@-@]") - ((dif +2 num) "[@@@-@@][@-@]") - ((dif +3 num) "[@@@@-@][@-@]") - ((dif +4 num) "[@@@@@-][@-@]") - ((dif +5 num) "[@-@@@@][@@-]") - ((dif +6 num) "[@@-@@@][@@-]") - ((dif +7 num) "[@@@-@@][@@-]") - ((dif +8 num) "[@@@@-@][@@-]") - ((dif +9 num) "[@@@@@-][@@-]"))) + ((diff +0 num) "[@-@@@@][@-@]") + ((diff +1 num) "[@@-@@@][@-@]") + ((diff +2 num) "[@@@-@@][@-@]") + ((diff +3 num) "[@@@@-@][@-@]") + ((diff +4 num) "[@@@@@-][@-@]") + ((diff +5 num) "[@-@@@@][@@-]") + ((diff +6 num) "[@@-@@@][@@-]") + ((diff +7 num) "[@@@-@@][@@-]") + ((diff +8 num) "[@@@@-@][@@-]") + ((diff +9 num) "[@@@@@-][@@-]"))) ;; main (defun main () diff --git a/examples/hanoi.lali b/examples/hanoi.lali index 59e3d10..786633c 100644 --- a/examples/hanoi.lali +++ b/examples/hanoi.lali @@ -7,7 +7,7 @@ (newline)) (defun hanoi-move (num from to via) - (fill ((dif num +1) + (fill ((diff num +1) (hanoi-print num from to)) (f (prog diff --git a/examples/mandelbrot.lali b/examples/mandelbrot.lali index c07b07d..0268deb 100644 --- a/examples/mandelbrot.lali +++ b/examples/mandelbrot.lali @@ -6,7 +6,7 @@ "2" "3" "4" "5" "6" "7" "8" "9" "%" "*" "&" "$" "@" "#")) (defun mandelbrot-iter (x y x0 y0 i) - (fill ((dif i +28) " ") + (fill ((diff i +28) " ") ((not (> (+ (* x0 x0) (* y0 y0)) +4)) (nth i mandelbrot-chars)) (f (mandelbrot-iter x y (+ (- (* x0 x0) (* y0 y0)) x) (+ (* +2 x0 y0) y) diff --git a/examples/speech/en-random.lali b/examples/speech/en-random.lali index 9ac271d..9deb0b0 100755 --- a/examples/speech/en-random.lali +++ b/examples/speech/en-random.lali @@ -23,13 +23,13 @@ (defun assoc (el lst) (fill - ((dif el (car (car lst))) (car lst)) + ((diff el (car (car lst))) (car lst)) ((algo lst) '(f f)) (f (assoc el (cdr lst))))) (defun without (el lst) (fill - ((dif el (car lst)) f) + ((diff el (car lst)) f) ((algo (car lst)) t) (f (without el (cdr lst))))) @@ -76,7 +76,7 @@ (set 'question-score target-question) (set 'my-words (readl)) - (differ my-words '(f)) + (diff my-words '(f)) (set 'answer-score (get-answer-score (map (lambda (word) @@ -85,7 +85,7 @@ (princ "\n~") (newline) (fill - ((dif target-answer + ((diff target-answer (+ question-score answer-score)) 'correct) (f 'wrong)))) @@ -93,8 +93,8 @@ (defun loop () (set 'res (main)) (fill - ((dif res 'correct) (loop)) - ((dif res 'wrong) (prog (princ ">> wrong") (newline))) + ((diff res 'correct) (loop)) + ((diff res 'wrong) (prog (princ ">> wrong") (newline))) (f f))) diff --git a/examples/speech/en-random_more.lali b/examples/speech/en-random_more.lali index fd94c6e..63c63c2 100755 --- a/examples/speech/en-random_more.lali +++ b/examples/speech/en-random_more.lali @@ -37,13 +37,13 @@ (defun assoc (el lst) (fill - ((dif el (car (car lst))) (car lst)) + ((diff el (car (car lst))) (car lst)) ((algo lst) '(f f)) (f (assoc el (cdr lst))))) (defun without (el lst) (fill - ((dif el (car lst)) f) + ((diff el (car lst)) f) ((algo (car lst)) t) (f (without el (cdr lst))))) @@ -102,7 +102,7 @@ (set 'question-score target-question) (set 'my-words (readl)) - (differ my-words '(f)) + (diff my-words '(f)) (set 'answer-score (get-answer-score (map (lambda (word) @@ -111,7 +111,7 @@ (princ "\n~") (newline) (fill - ((dif target-answer + ((diff target-answer (+ question-score answer-score)) 'correct) (f 'wrong)))) @@ -119,8 +119,8 @@ (defun loop () (set 'res (main)) (fill - ((dif res 'correct) (loop)) - ((dif res 'wrong) (prog (princ ">> wrong") (newline))) + ((diff res 'correct) (loop)) + ((diff res 'wrong) (prog (princ ">> wrong") (newline))) (f f))) diff --git a/examples/speech/pt-fixed_answer.lali b/examples/speech/pt-fixed_answer.lali index 0002672..b500975 100755 --- a/examples/speech/pt-fixed_answer.lali +++ b/examples/speech/pt-fixed_answer.lali @@ -18,13 +18,13 @@ (defun assoc (el lst) (fill - ((dif el (car (car lst))) (car lst)) + ((diff el (car (car lst))) (car lst)) ((algo lst) '(f f)) (f (assoc el (cdr lst))))) (defun without (el lst) (fill - ((dif el (car lst)) f) + ((diff el (car lst)) f) ((algo (car lst)) t) (f (without el (cdr lst))))) @@ -72,14 +72,14 @@ (set 'question-score target-question) (set 'my-reply (readl)) - (differ my-reply '(f)) + (diff my-reply '(f)) (set 'answer-score (get-answer-score (map (lambda (word) (car (cdr (assoc word reply)))) my-reply))) (fill - ((dif target-answer + ((diff target-answer (+ question-score answer-score)) 'correct) (f 'wrong)))) @@ -87,8 +87,8 @@ (defun loop () (set 'res (main)) (fill - ((dif res 'correct) (loop)) - ((dif res 'wrong) (prog (princ ">> errado") (newline))) + ((diff res 'correct) (loop)) + ((diff res 'wrong) (prog (princ ">> errado") (newline))) (f f))) (loop) diff --git a/examples/speech/pt-identify.lali b/examples/speech/pt-identify.lali index bef74ef..7dd69b6 100755 --- a/examples/speech/pt-identify.lali +++ b/examples/speech/pt-identify.lali @@ -12,7 +12,7 @@ (defun assoc (number lst) (fill - ((dif number (car (car lst))) (car lst)) + ((diff number (car (car lst))) (car lst)) ((algo lst) f) (f (assoc number (cdr lst))))) @@ -35,7 +35,7 @@ (set 'it-quest (assoc target-question question)) (princ (car (cdr it-quest))) (princ "\b?") - (not (dif (read) (car (cdr (cdr it-quest))))))) + (not (diff (read) (car (cdr (cdr it-quest))))))) (defun loop () (fill diff --git a/examples/speech/pt-random.lali b/examples/speech/pt-random.lali index e038f68..5454dc1 100755 --- a/examples/speech/pt-random.lali +++ b/examples/speech/pt-random.lali @@ -25,13 +25,13 @@ (defun assoc (el lst) (fill - ((dif el (car (car lst))) (car lst)) + ((diff el (car (car lst))) (car lst)) ((algo lst) '(f f f)) (f (assoc el (cdr lst))))) (defun without (el lst) (fill - ((dif el (car lst)) f) + ((diff el (car lst)) f) ((algo (car lst)) t) (f (without el (cdr lst))))) @@ -83,7 +83,7 @@ (set 'question-score target-question) (set 'my-words (readl)) - (differ my-words '(f)) + (diff my-words '(f)) (set 'answer-score (get-answer-score (map (lambda (word) @@ -92,7 +92,7 @@ (princ "\n~") (newline) (fill - ((dif target-answer + ((diff target-answer (+ question-score answer-score)) 'correct) (f 'wrong)))) @@ -100,8 +100,8 @@ (defun loop () (set 'res (main)) (fill - ((dif res 'correct) (loop)) - ((dif res 'wrong) (prog (princ ">> errado") (newline))) + ((diff res 'correct) (loop)) + ((diff res 'wrong) (prog (princ ">> errado") (newline))) (f f))) diff --git a/examples/speech/pt-random_more.lali b/examples/speech/pt-random_more.lali index 0c91c2c..94cd41c 100755 --- a/examples/speech/pt-random_more.lali +++ b/examples/speech/pt-random_more.lali @@ -37,13 +37,13 @@ (defun assoc (el lst) (fill - ((dif el (car (car lst))) (car lst)) + ((diff el (car (car lst))) (car lst)) ((algo lst) '(f f)) (f (assoc el (cdr lst))))) (defun without (el lst) (fill - ((dif el (car lst)) f) + ((diff el (car lst)) f) ((algo (car lst)) t) (f (without el (cdr lst))))) @@ -102,7 +102,7 @@ (set 'question-score target-question) (set 'my-words (readl)) - (differ my-words '(f)) + (diff my-words '(f)) (set 'answer-score (get-answer-score (map (lambda (word) @@ -111,7 +111,7 @@ (princ "\n~") (newline) (fill - ((dif target-answer + ((diff target-answer (+ question-score answer-score)) 'correct) (f 'wrong)))) @@ -119,8 +119,8 @@ (defun loop () (set 'res (main)) (fill - ((dif res 'correct) (loop)) - ((dif res 'wrong) (prog (princ ">> errado") (newline))) + ((diff res 'correct) (loop)) + ((diff res 'wrong) (prog (princ ">> errado") (newline))) (f f))) diff --git a/liblali.c b/liblali.c index 38f28b5..cfd4d76 100644 --- a/liblali.c +++ b/liblali.c @@ -847,13 +847,22 @@ Object *primitiveAtom(Object **args, GC_PARAM) { * } */ -Object *primitiveDif(Object **args, GC_PARAM) { +Object *primitiveDiff(Object **args, GC_PARAM) { Object *first = (*args)->car, *second = (*args)->cdr->car; if ((first->type == TYPE_NUMBER && second->type == TYPE_NUMBER) || (first->type == TYPE_STRING && second->type == TYPE_STRING) || (first->type == TYPE_SYMBOL && second->type == TYPE_SYMBOL)) return strcmp(first->string, second->string) ? t : f; + else if (first->type == TYPE_CONS && second->type == TYPE_CONS) { + for (; (first->cdr != nil || second->cdr != nil); + first = first->cdr, second = second->cdr) { + if (strcmp(first->string, second->string)) + return t; + } + return (strcmp(first->car->string, second->car->string) || + (first->cdr != nil && second->cdr != nil)) ? t : f; + } else return t; } @@ -1282,7 +1291,7 @@ Primitive primitives[] = { { "space", 1, 1, primitiveSpace }, { "atom", 1, 1, primitiveAtom }, /* { "eq", 2, 2, primitiveEq }, */ - { "dif", 2, 2, primitiveDif }, + { "diff", 2, 2, primitiveDiff }, { "car", 1, 1, primitiveCar }, { "cdr", 1, 1, primitiveCdr }, { "cons", 2, 2, primitiveCons }, @@ -1631,7 +1640,7 @@ static char *stdlib = LISP( (defmacro defun (name params . body) (list (quote set) (list quote name) (list (quote lambda) params . body))) - (defun not (x) (fill ((dif x n) n) + (defun not (x) (fill ((diff x n) n) (x t) (f f))) @@ -1639,7 +1648,7 @@ static char *stdlib = LISP( (defun listp (x) (not (atom x))) - (defun zerop (x) (not (dif x +0))) + (defun zerop (x) (not (diff x +0))) (defmacro and args (fill ((algo args) t) @@ -1664,13 +1673,8 @@ static char *stdlib = LISP( (defun singul (x) (not (consp x))) - (defun differ (x y) - (fill ((and (consp x) (consp y)) (dif x y)) - (f (or (differ (car x) (car y)) - (differ (cdr x) (cdr y)))))) - (defun nth (num xs) - (fill ((dif num +0) (car xs)) + (fill ((diff num +0) (car xs)) (f (nth (- num +1) (cdr xs))))) (defun append (xs y) diff --git a/test/main.lali b/test/main.lali index 5ad4b55..a63cef7 100644 --- a/test/main.lali +++ b/test/main.lali @@ -3,11 +3,11 @@ (defun test (test-expr res) (newline) (princ - (list (fill ((differ (eval test-expr) res) '+) + (list (fill ((diff (eval test-expr) res) '+) ('f 'fail)) '--> test-expr)) (and success - (set 'success (fill ((differ (eval test-expr) res) t) + (set 'success (fill ((diff (eval test-expr) res) t) (f f))))) ;; atom @@ -17,23 +17,16 @@ (test '(atom '(x a)) f) ;(test '(atom 'a) undef) -;; dif -(test '(dif () 'b) t) -(test '(dif () ()) f) -(test '(dif 'a 'b) t) -(test '(dif 'a 'a) f) -(test '(dif 'a '(b . c)) t) -(test '(dif 'a '(b c)) t) -(test '(dif '(b . c) '(b . c)) t) -(test '(dif '(b c) '(b c)) t) - -;; differ -(test '(differ 'a ()) t) -(test '(differ () ()) f) -(test '(differ 'a '(b c)) t) -(test '(differ '(a b) '(b c)) t) -(test '(differ '(b . c) '(b . c)) f) -(test '(differ '(b c) '(b c)) f) +;; diff +(test '(diff 'a ()) t) +(test '(diff () 'b) t) +(test '(diff () ()) f) +(test '(diff 'a 'b) t) +(test '(diff 'a 'a) f) +(test '(diff 'a '(b c)) t) +(test '(diff '(a b) '(b c)) t) +(test '(diff '(b . c) '(b . c)) f) +(test '(diff '(b c) '(b c)) f) ;; car (test '(car ()) ()) -- cgit