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.

---
 doc/ref/guile/util.texi          | 12 ++++++++++++
 module/hnh/util.scm              | 19 +++++++++++++++++++
 scripts/module-introspection.scm | 15 +--------------
 tests/test/util.scm              |  7 +++++++
 4 files changed, 39 insertions(+), 14 deletions(-)

diff --git a/doc/ref/guile/util.texi b/doc/ref/guile/util.texi
index b5cce99a..f7cfe438 100644
--- a/doc/ref/guile/util.texi
+++ b/doc/ref/guile/util.texi
@@ -322,6 +322,18 @@ non-unique keys, returning all mathing records (instead of just the first).
 @end defun
 
 
+@defun uniq lst
+@defunx univ lst
+@defunx unique lst
+Sequeeze repeated elements in the input, similar to uniq(1).
+Matches the semantics of @code{eq?}, @code{eqv?}, and @code{equal?}.
+@end defun
+
+@defun uniqx = lst
+Uniq, but takes a custom comparison procedure.
+@end defun
+
+
 @defun vector-last v
 Returns the last element of @var{v}.
 @end defun
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)
diff --git a/scripts/module-introspection.scm b/scripts/module-introspection.scm
index dc430d8a..17068371 100644
--- a/scripts/module-introspection.scm
+++ b/scripts/module-introspection.scm
@@ -2,7 +2,6 @@
   :use-module (srfi srfi-1)
   :use-module (hnh util)
   :export (get-forms
-           uniq
            unique-symbols
            find-module-declaration
            module-declaration?
@@ -16,23 +15,11 @@
           done
           (loop (cons form done))))))
 
-
-(define (uniq lst)
-  (cond ((null? lst) lst)
-        ((null? (cdr lst)) lst)
-        ((and (pair? lst)
-              (eqv? (car lst) (cadr lst)))
-         (uniq (cons (car lst) (cddr lst))))
-        (else (cons (car lst)
-                    (uniq (cdr lst))))))
-
-
 (define (unique-symbols tree)
-  (uniq
+  (univ
    (sort* (filter symbol? (flatten tree))
           string<? symbol->string)))
 
-
 (define (module-declaration? form)
   (cond ((null? form) #f)
         ((not (pair? form)) #f)
diff --git a/tests/test/util.scm b/tests/test/util.scm
index 5e2aab4e..f87ed3c4 100644
--- a/tests/test/util.scm
+++ b/tests/test/util.scm
@@ -139,6 +139,13 @@
 (test-equal "assq-ref-all" '(1 3) (assq-ref-all '((a . 1) (b . 2) (a . 3)) 'a))
 (test-equal "assv-ref-all "'(1 3) (assv-ref-all '((a . 1) (b . 2) (a . 3)) 'a))
 
+
+(test-group "Unique family"
+  (test-equal
+    '(a b c b)
+    (uniq '(a b b c b b))))
+
+
 (test-equal "vector-last"
   1 (vector-last #(0 2 3 1)))
 
-- 
cgit v1.2.3