From 1d90e9d7c906b1e9e94d1642bfd60c51609fd0df Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 12 Jan 2019 22:26:01 +0100
Subject: discovery: Add 'fold-module-public-variables*'.

* guix/discovery.scm (fold-module-public-variables*): New procedure.
---
 guix/discovery.scm | 28 ++++++++++++++++++++++++++--
 1 file changed, 26 insertions(+), 2 deletions(-)

(limited to 'guix/discovery.scm')

diff --git a/guix/discovery.scm b/guix/discovery.scm
index 3fc6e2c9e7..ef5ae73973 100644
--- a/guix/discovery.scm
+++ b/guix/discovery.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,7 +30,8 @@ (define-module (guix discovery)
             scheme-modules*
             fold-modules
             all-modules
-            fold-module-public-variables))
+            fold-module-public-variables
+            fold-module-public-variables*))
 
 ;;; Commentary:
 ;;;
@@ -147,10 +148,33 @@ (define* (all-modules path #:key (warn (const #f)))
 SUB-DIRECTORY."
   (fold-modules cons '() path #:warn warn))
 
+(define (fold-module-public-variables* proc init modules)
+  "Call (PROC MODULE SYMBOL VARIABLE) for each variable exported by one of MODULES,
+using INIT as the initial value of RESULT.  It is guaranteed to never traverse
+the same object twice."
+  ;; Here SEEN is populated by variables; if two different variables refer to
+  ;; the same object, we still let them through.
+  (identity                                       ;discard second return value
+   (fold2 (lambda (module result seen)
+            (fold2 (lambda (sym+var result seen)
+                     (match sym+var
+                       ((sym . var)
+                        (if (not (vhash-assq var seen))
+                            (values (proc module sym var result)
+                                    (vhash-consq var #t seen))
+                            (values result seen)))))
+                   result
+                   seen
+                   (module-map cons module)))
+          init
+          vlist-null
+          modules)))
+
 (define (fold-module-public-variables proc init modules)
   "Call (PROC OBJECT RESULT) for each variable exported by one of MODULES,
 using INIT as the initial value of RESULT.  It is guaranteed to never traverse
 the same object twice."
+  ;; Note: here SEEN is populated by objects, not by variables.
   (identity   ; discard second return value
    (fold2 (lambda (module result seen)
             (fold2 (lambda (var result seen)
-- 
cgit v1.2.3