From 907931e62d154564089a2e88145d56afa68231fa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Thu, 17 Mar 2022 20:28:48 +0100
Subject: Add uniq family of procedures.

---
 module/hnh/util.scm | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

(limited to 'module/hnh/util.scm')

diff --git a/module/hnh/util.scm b/module/hnh/util.scm
index 7509fc86..d5923e79 100644
--- a/module/hnh/util.scm
+++ b/module/hnh/util.scm
@@ -58,6 +58,11 @@
            assq-ref-all
            assv-ref-all
 
+           uniq
+           univ
+           uniqv
+           unique
+
            vector-last
 
            ->string
@@ -543,6 +548,20 @@
 (define (assv-ref-all alist key)  (ass%-ref-all alist key eqv?))
 
 
+(define (unique% = lst)
+  (cond ((null? lst) lst)
+        ((null? (cdr lst)) lst)
+        ((and (pair? lst)
+              (= (car lst) (cadr lst)))
+         (uniq (cons (car lst) (cddr lst))))
+        (else (cons (car lst)
+                    (uniq (cdr lst))))))
+
+(define (uniq lst) (unique% eq? lst))
+(define (uniqv lst) (unique% eqv? lst))
+(define univ uniqv)
+(define (unique lst) (unique% equal? lst))
+
 
 
 (define (vector-last v)
-- 
cgit v1.2.3