GNU bug report logs - #71268
[PATCH v5 0/4] Add module depth information to %load-verbosely output

Previous Next

Package: guile;

Reported by: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>

Date: Thu, 30 May 2024 02:31:01 UTC

Severity: normal

Tags: patch

To reply to this bug, email your comments to 71268 AT debbugs.gnu.org.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to bug-guile <at> gnu.org:
bug#71268; Package guile. (Thu, 30 May 2024 02:31:01 GMT) Full text and rfc822 format available.

Acknowledgement sent to Maxim Cournoyer <maxim.cournoyer <at> gmail.com>:
New bug report received and forwarded. Copy sent to bug-guile <at> gnu.org. (Thu, 30 May 2024 02:31:02 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: bug-guile <at> gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v5 0/4] Add module depth information to %load-verbosely output
Date: Wed, 29 May 2024 22:30:22 -0400
This change was made to support investigating cyclic module dependencies
that sometimes happen in GNU Guix and are difficult to
comprehend/debug.  For more context, see:
<https://issues.guix.gnu.org/65716>.

Changes in v5:
- Introduce the usage of keywords for %load-hooks, breaking backward
compatibility at the benefit of future stability and extensibility

Changes in v4:
- Remove with-output-to-port in %load-announce and adjust doc

Changes in v3:
- Replace PAD-COUNT with DEPTH in VISUAL-DEPTH guard.

Changes in v2:
- Guard against negative pad count when computing 'visual-depth'

Maxim Cournoyer (4):
  (ice-9 boot-9): Fix typo.
  .dir-locals: Set c-basic-offset to 2 for c-mode.
  guix.scm: Add git:send-email to environment, for convenience.
  load: Display modules depth in output when using %load-verbosely.

 .dir-locals.el                  |  1 +
 .guix/modules/guile-package.scm |  3 +-
 NEWS                            | 13 +++++++
 THANKS                          |  1 +
 doc/guile-api.alist             |  4 +-
 doc/ref/api-evaluation.texi     | 66 ++++++++++++++++++++++++++-------
 libguile/load.c                 | 64 +++++++++++++++++++++++++-------
 libguile/load.h                 |  4 +-
 module/ice-9/boot-9.scm         | 39 ++++++++++++-------
 9 files changed, 149 insertions(+), 46 deletions(-)


base-commit: 779a83d9c682345802f9a605cb8e2b4892129316
-- 
2.41.0





Information forwarded to bug-guile <at> gnu.org:
bug#71268; Package guile. (Sat, 01 Jun 2024 02:13:01 GMT) Full text and rfc822 format available.

Message #8 received at 71268 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 71268 <at> debbugs.gnu.org
Cc: Maxime Devos <maximedevos <at> telenet.be>,
 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v5 1/4] (ice-9 boot-9): Fix typo.
Date: Fri, 31 May 2024 22:10:08 -0400
* module/ice-9/boot-9.scm (module-use-interfaces!): Fix typo in doc string.
---

(no changes since v1)

 module/ice-9/boot-9.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 378ae2457..10423d35e 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2927,7 +2927,7 @@ uses)."
 
 (define (module-use-interfaces! module interfaces)
   "Same as MODULE-USE!, but only notifies module observers after all
-interfaces are added to the inports list."
+interfaces are added to the imports list."
   (let* ((cur (module-uses module))
          (new (let lp ((in interfaces) (out '()))
                 (if (null? in)
-- 
2.41.0





Information forwarded to bug-guile <at> gnu.org:
bug#71268; Package guile. (Sat, 01 Jun 2024 02:13:02 GMT) Full text and rfc822 format available.

Message #11 received at 71268 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 71268 <at> debbugs.gnu.org
Cc: Maxime Devos <maximedevos <at> telenet.be>,
 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v5 2/4] .dir-locals: Set c-basic-offset to 2 for c-mode.
Date: Fri, 31 May 2024 22:10:09 -0400
* .dir-locals.el (c-mode): Set c-basic-offset to 2.
---

(no changes since v1)

 .dir-locals.el | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.dir-locals.el b/.dir-locals.el
index 908670479..f63bdc8a3 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -3,6 +3,7 @@
 ((nil             . ((fill-column . 72)
                      (tab-width   .  8)))
  (c-mode          . ((c-file-style . "gnu")
+                     (c-basic-offset . 2)
                      (indent-tabs-mode . nil)))
  (scheme-mode
   . ((indent-tabs-mode . nil)
-- 
2.41.0





Information forwarded to bug-guile <at> gnu.org:
bug#71268; Package guile. (Sat, 01 Jun 2024 02:13:02 GMT) Full text and rfc822 format available.

Message #14 received at 71268 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 71268 <at> debbugs.gnu.org
Cc: Maxime Devos <maximedevos <at> telenet.be>,
 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v5 3/4] guix.scm: Add git:send-email to environment,
 for convenience.
Date: Fri, 31 May 2024 22:10:10 -0400
* guix.scm (guile) [native-inputs]: Add git:send-email.
---

(no changes since v1)

 .guix/modules/guile-package.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/.guix/modules/guile-package.scm b/.guix/modules/guile-package.scm
index ad297a010..bca8d3cdf 100644
--- a/.guix/modules/guile-package.scm
+++ b/.guix/modules/guile-package.scm
@@ -112,10 +112,11 @@
                      gnu-gettext
                      flex
                      texinfo
-                     texlive-scheme-basic         ;for "make pdf"
+                     texlive-scheme-basic ;for "make pdf"
                      texlive-epsf
                      gperf
                      git
+                     `(,git "send-email") ;for convenience
                      gdb
                      strace
                      readline
-- 
2.41.0





Information forwarded to bug-guile <at> gnu.org:
bug#71268; Package guile. (Sat, 01 Jun 2024 02:13:03 GMT) Full text and rfc822 format available.

Message #17 received at 71268 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: 71268 <at> debbugs.gnu.org
Cc: Maxime Devos <maximedevos <at> telenet.be>,
 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH v5 4/4] load: Display modules depth in output when using
 %load-verbosely.
Date: Fri, 31 May 2024 22:10:11 -0400
* NEWS: Update news.
* THANKS: Add myself.
* doc/guile-api.alist (%load-announce, %load-hook): Add DEPTH argument.
* doc/ref/api-evaluation.texi (Loading): Document new
DEPTH argument for the primitive-load, primitive-load-path and
%load-hook procedures.  Update %load-hook example.  Document
%load-verbosely.
* libguile/load.c (scm_loc_load_hook): Update doc.
(call_hook): New procedure.
(scm_primitive_load): Modify to accept a single list of arguments, like
for scm_primitive_load_path, so to accept an optional DEPTH argument.
Call hook via the 'call_hook' procedure.
(scm_primitive_load_path): Accept a third optional DEPTH argument.  Call
hook via the 'call_hook' procedure.  Pass depth to the
'scm_primitive_load' procedure call.
* libguile/load.h (scm_primitive_load)
(scm_primitive_load_path): Add 'depth' to argument name.
* module/ice-9/boot-9.scm (%load-announce): Accept a DEPTH keyword
argument, and use it to display the modules loaded hierarchically.  Use
format instead of display.
(%current-module-load-depth): New parameter.
(resolve-module): Use it.
(try-module-autoload): Call primitive-load-path with it.
(load-in-vicinity): Invoke %load-hook with it.

Reviewed-by: Maxime Devos <maximedevos <at> telenet.be>
---

Changes in v5:
- Introduce the usage of keywords for %load-hooks, breaking backward
compatibility at the benefit of future stability and extensibility

Changes in v4:
- Remove with-output-to-port in %load-announce and adjust doc

Changes in v3:
- Replace PAD-COUNT with DEPTH in VISUAL-DEPTH guard.

Changes in v2:
- Guard against negative pad count when computing 'visual-depth'

 NEWS                        | 13 ++++++++
 THANKS                      |  1 +
 doc/guile-api.alist         |  4 +--
 doc/ref/api-evaluation.texi | 66 +++++++++++++++++++++++++++++--------
 libguile/load.c             | 64 +++++++++++++++++++++++++++--------
 libguile/load.h             |  4 +--
 module/ice-9/boot-9.scm     | 37 +++++++++++++--------
 7 files changed, 145 insertions(+), 44 deletions(-)

diff --git a/NEWS b/NEWS
index c9a713c1e..68a10555a 100644
--- a/NEWS
+++ b/NEWS
@@ -41,6 +41,19 @@ files.  See "Random Access" in the manual for details.
 
 A list of superclasses can now be provided via #:super.
 
+** The %load-hook procedure is now applied with an extra 'depth' argument
+
+This is a *backward incompatible* change that affects current
+user-defined load hooks.  New hooks should be defined using a signature
+like:
+
+(define* (my-hook file #:key (depth 0) #:allow-other-keys) ...)
+
+The newly introduced DEPTH argument is used to show the depth level of
+the module being load in the output when setting %load-verbosely to
+#t, which makes it easier to inspect which module caused others to be
+loaded.
+
 * Bug fixes
 
 ** Fix incorrect comparison between exact and inexact numbers
diff --git a/THANKS b/THANKS
index aa4877e95..546f79b45 100644
--- a/THANKS
+++ b/THANKS
@@ -5,6 +5,7 @@ Contributors since the last release:
 	    Rob Browning
         Tristan Colgate-McFarlane
           Aleix Conchillo Flaqué
+          Maxim Cournoyer
         Ludovic Courtès
           Jason Earl
            Paul Eggert
diff --git a/doc/guile-api.alist b/doc/guile-api.alist
index a1616149f..20c900166 100644
--- a/doc/guile-api.alist
+++ b/doc/guile-api.alist
@@ -37,9 +37,9 @@
 (%init-rdelim-builtins (groups Scheme) (scan-data "#<primitive-procedure %init-rdelim-builtins>"))
 (%init-rw-builtins (groups Scheme) (scan-data "#<primitive-procedure %init-rw-builtins>"))
 (%library-dir (groups Scheme) (scan-data "#<primitive-procedure %library-dir>"))
-(%load-announce (groups Scheme) (scan-data "#<procedure %load-announce (file)>"))
+(%load-announce (groups Scheme) (scan-data "#<procedure %load-announce (file depth)>"))
 (%load-extensions (groups Scheme) (scan-data ""))
-(%load-hook (groups Scheme) (scan-data "#<procedure %load-announce (file)>"))
+(%load-hook (groups Scheme) (scan-data "#<procedure %load-announce (file depth)>"))
 (%load-path (groups Scheme) (scan-data ""))
 (%load-verbosely (groups Scheme) (scan-data ""))
 (%make-void-port (groups Scheme) (scan-data "#<primitive-procedure %make-void-port>"))
diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 68bf38e54..48a811395 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -865,14 +865,20 @@ calling @code{load-compiled} on the resulting file is equivalent to
 calling @code{load} on the source file.
 @end deffn
 
-@deffn {Scheme Procedure} primitive-load filename
+@deffn {Scheme Procedure} primitive-load filename [depth]
 @deffnx {C Function} scm_primitive_load (filename)
 Load the file named @var{filename} and evaluate its contents in the
 top-level environment.  @var{filename} must either be a full pathname or
 be a pathname relative to the current directory.  If the variable
 @code{%load-hook} is defined, it should be bound to a procedure that
 will be called before any code is loaded.  See the documentation for
-@code{%load-hook} later in this section.
+@code{%load-hook} later in this section.  An optional keyword argument,
+@var{#:depth}, can be specified to track the depth at which modules are
+loaded.
+
+For compatibility with Guile 3.9 and earlier, the C function takes only
+one argument, which can be either a string (the file name) or an
+argument list.
 @end deffn
 
 @deftypefn {C Function} SCM scm_c_primitive_load (const char *filename)
@@ -905,20 +911,52 @@ change occurs at the right time.
 @end defvar
 
 @defvar %load-hook
-A procedure to be called @code{(%load-hook @var{filename})} whenever a
-file is loaded, or @code{#f} for no such call.  @code{%load-hook} is
-used by all of the loading functions (@code{load} and
-@code{primitive-load}, and @code{load-from-path} and
+A procedure to be called @code{(%load-hook @var{filename} #:depth @var{depth})}
+whenever a file is loaded, or @code{#f} for no such call.
+@code{%load-hook} is used by all of the loading functions (@code{load}
+and @code{primitive-load}, and @code{load-from-path} and
 @code{primitive-load-path} documented in the next section).
 
-For example an application can set this to show what's loaded,
+The default @code{%load-hook} is bound to a procedure that does
+something like:
 
 @example
-(set! %load-hook (lambda (filename)
-                   (format #t "Loading ~a ...\n" filename)))
-(load-from-path "foo.scm")
-@print{} Loading /usr/local/share/guile/site/foo.scm ...
+(define* (%load-hook file #:key (depth 0) #:allow-other-keys)
+  (when %load-verbosely
+    (let* ((pad-count (- 3 (string-length (number->string depth))))
+           (pad (if (> pad-count 0)
+                    (make-string pad-count #\space)
+                    ""))
+           (visual-depth (if (> depth 0)
+                             (make-string depth #\space)
+                             "")))
+      (format (current-warning-port)
+              ";;; loading ~a~a ~a~a~%" pad depth visual-depth file)
+      (force-output (current-warning-port)))))
 @end example
+
+It is important to define your @code{%load-hook} with at least the
+@code{#:depth} keyword argument as well as the @code{#:allow-other-keys}
+modifier, which allows for future backward compatibility of hooks.
+
+@vindex %load-verbosely, to enable default %load-hook output
+As you can see from the above procedure, an application can thus set the
+@code{%load-verbosely} variable to @code{#t} to enable the default load
+hook output, which produces something like:
+
+@example
+@print{};;; loading   0 guix/gnu/packages/abiword.scm
+@print{};;; loading   1  guix/build-system/glib-or-gtk.scm
+@print{};;; loading   2   guix/build/glib-or-gtk-build-system.scm
+@print{};;; loading   3    guix/build/gnu-build-system.scm
+@print{};;; loading   4     guix/build/gremlin.scm
+@print{};;; loading   5      guix/elf.scm
+@end example
+
+The number corresponds to the depth at which the module was loaded,
+which is a recursive process.  The indentation of the file name loaded
+corresponds to that depth value, to make it easy to visually discern
+which module caused others to be loaded.
 @end defvar
 
 @deffn {Scheme Procedure} current-load-port
@@ -969,7 +1007,7 @@ It's better to use @code{add-to-load-path} than to modify
 @code{%load-path} directly, because @code{add-to-load-path} takes care
 of modifying the path both at compile-time and at run-time.
 
-@deffn {Scheme Procedure} primitive-load-path filename [exception-on-not-found]
+@deffn {Scheme Procedure} primitive-load-path filename [exception-on-not-found] [depth]
 @deffnx {C Function} scm_primitive_load_path (filename)
 Search @code{%load-path} for the file named @var{filename} and
 load it into the top-level environment.  If @var{filename} is a
@@ -983,7 +1021,9 @@ second argument, @var{exception-on-not-found}.  If it is @code{#f},
 @code{#f} will be returned.  If it is a procedure, it will be called
 with no arguments.  (This allows a distinction to be made between
 exceptions raised by loading a file, and exceptions related to the
-loader itself.)  Otherwise an error is signaled.
+loader itself.)  Otherwise an error is signaled.  An optional third
+argument, @var{depth}, can be specified to track the depth at which modules are
+loaded.
 
 For compatibility with Guile 1.8 and earlier, the C function takes only
 one argument, which can be either a string (the file name) or an
diff --git a/libguile/load.c b/libguile/load.c
index 34e7934b9..77320d7dc 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -72,35 +72,67 @@
 
 /* Loading a file, given an absolute filename.  */
 
-/* Hook to run when we load a file, perhaps to announce the fact somewhere.
-   Applied to the full name of the file.  */
+/* Hook to run when we load a file, perhaps to announce the fact
+   somewhere.  Applied to the full name of the file and (since 3.10) an
+   optional depth counter.  */
 static SCM *scm_loc_load_hook;
 
 /* The current reader (a fluid).  */
 static SCM the_reader = SCM_BOOL_F;
 
+/* Helper to call %load-hook with the correct number of arguments. */
+static void call_hook (SCM hook, SCM filename, SCM depth) {
+  if (scm_is_false (hook))
+    return;
 
-SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, 
-           (SCM filename),
+  scm_call_3(hook, filename, scm_from_utf8_keyword("depth"), depth);
+}
+
+SCM_DEFINE (scm_primitive_load, "primitive-load", 0, 0, 1,
+            (SCM args),
 	    "Load the file named @var{filename} and evaluate its contents in\n"
 	    "the top-level environment. The load paths are not searched;\n"
 	    "@var{filename} must either be a full pathname or be a pathname\n"
 	    "relative to the current directory.  If the  variable\n"
 	    "@code{%load-hook} is defined, it should be bound to a procedure\n"
 	    "that will be called before any code is loaded.  See the\n"
-	    "documentation for @code{%load-hook} later in this section.")
+	    "documentation for @code{%load-hook} later in this section.\n"
+            "A second optional argument can be used to specify the depth\n"
+            "at which the module was loaded.")
 #define FUNC_NAME s_scm_primitive_load
 {
+  SCM filename;
+  SCM depth;
   SCM hook = *scm_loc_load_hook;
   SCM ret = SCM_UNSPECIFIED;
 
+  if (scm_is_string (args)) {
+      /* C code written for 3.9 and earlier expects this function to
+         take a single argument (the file name).  */
+      filename = args;
+      depth = scm_from_int(0);
+    }
+  else {
+    /* Starting from 3.10, this function takes 1 required and 1 optional
+       arguments. */
+    long len;
+
+    SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1, args, len);
+    if (len < 1 || len > 2)
+      scm_error_num_args_subr (FUNC_NAME);
+
+    filename = SCM_CAR (args);
+    SCM_VALIDATE_STRING (SCM_ARG1, filename);
+
+    depth = len > 1 ? SCM_CADR (args) : scm_from_int(0);
+  }
+
   SCM_VALIDATE_STRING (1, filename);
   if (scm_is_true (hook) && scm_is_false (scm_procedure_p (hook)))
     SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f",
 		    SCM_EOL);
 
-  if (!scm_is_false (hook))
-    scm_call_1 (hook, filename);
+  call_hook (hook, filename, depth);
 
   {
     SCM port;
@@ -1163,11 +1195,13 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
             "depending on the optional second argument,\n"
             "@var{exception_on_not_found}.  If it is @code{#f}, @code{#f}\n"
             "will be returned.  If it is a procedure, it will be called\n"
-            "with no arguments.  Otherwise an error is signaled.")
+            "with no arguments.  Otherwise an error is signaled.\n\n"
+            "A third optional argument may be provided to track module depth.")
 #define FUNC_NAME s_scm_primitive_load_path
 {
   SCM filename, exception_on_not_found;
   SCM full_filename, compiled_thunk;
+  SCM depth;
   SCM hook = *scm_loc_load_hook;
   struct stat stat_source, stat_compiled;
   int found_stale_compiled_file = 0;
@@ -1182,21 +1216,24 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
 	 single argument (the file name).  */
       filename = args;
       exception_on_not_found = SCM_UNDEFINED;
+      depth = scm_from_int (0);
     }
   else
     {
-      /* Starting from 1.9, this function takes 1 required and 1 optional
-	 argument.  */
+      /* Starting from 1.9, this function takes 1 required and 1
+	 optional arguments.  From 3.10, this function takes 1 required
+	 and 2 optional arguments.  */
       long len;
 
       SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1, args, len);
-      if (len < 1 || len > 2)
+      if (len < 1 || len > 3)
 	scm_error_num_args_subr (FUNC_NAME);
 
       filename = SCM_CAR (args);
       SCM_VALIDATE_STRING (SCM_ARG1, filename);
 
       exception_on_not_found = len > 1 ? SCM_CADR (args) : SCM_UNDEFINED;
+      depth = len > 2 ? SCM_CADDR (args) : scm_from_int (0);
     }
 
   if (SCM_UNBNDP (exception_on_not_found))
@@ -1252,8 +1289,7 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
                         scm_list_1 (filename));
     }
 
-  if (!scm_is_false (hook))
-    scm_call_1 (hook, full_filename);
+  call_hook(hook, full_filename, depth);
 
   if (scm_is_true (compiled_thunk))
     return scm_call_0 (compiled_thunk);
@@ -1264,7 +1300,7 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
       if (scm_is_true (freshly_compiled))
         return scm_call_0 (scm_load_thunk_from_file (freshly_compiled));
       else
-        return scm_primitive_load (full_filename);
+        return scm_primitive_load (scm_list_2 (full_filename, depth));
     }
 }
 #undef FUNC_NAME
diff --git a/libguile/load.h b/libguile/load.h
index 25f67b87b..d03019b44 100644
--- a/libguile/load.h
+++ b/libguile/load.h
@@ -27,7 +27,7 @@
 
 SCM_API SCM scm_parse_path (SCM path, SCM tail);
 SCM_API SCM scm_parse_path_with_ellipsis (SCM path, SCM base);
-SCM_API SCM scm_primitive_load (SCM filename);
+SCM_API SCM scm_primitive_load (SCM filename_and_depth);
 SCM_API SCM scm_c_primitive_load (const char *filename);
 SCM_API SCM scm_sys_package_data_dir (void);
 SCM_API SCM scm_sys_library_dir (void);
@@ -36,7 +36,7 @@ SCM_API SCM scm_sys_global_site_dir (void);
 SCM_API SCM scm_sys_site_ccache_dir (void);
 SCM_API SCM scm_search_path (SCM path, SCM filename, SCM rest);
 SCM_API SCM scm_sys_search_load_path (SCM filename);
-SCM_API SCM scm_primitive_load_path (SCM filename_and_exception_on_not_found);
+SCM_API SCM scm_primitive_load_path (SCM filename_and_exception_on_not_found_and_depth);
 SCM_API SCM scm_c_primitive_load_path (const char *filename);
 SCM_INTERNAL SCM scm_sys_warn_auto_compilation_enabled (void);
 SCM_INTERNAL void scm_init_load_path (void);
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 10423d35e..fb3d245bd 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2236,15 +2236,18 @@ name extensions listed in %load-extensions."
 (define %load-verbosely #f)
 (define (assert-load-verbosity v) (set! %load-verbosely v))
 
-(define (%load-announce file)
-  (if %load-verbosely
-      (with-output-to-port (current-warning-port)
-        (lambda ()
-          (display ";;; ")
-          (display "loading ")
-          (display file)
-          (newline)
-          (force-output)))))
+(define* (%load-announce file #:key (depth 0) #:allow-other-keys)
+  (when %load-verbosely
+    (let* ((pad-count (- 3 (string-length (number->string depth))))
+           (pad (if (> pad-count 0)
+                    (make-string pad-count #\space)
+                    ""))
+           (visual-depth (if (> depth 0)
+                             (make-string depth #\space)
+                             "")))
+      (format (current-warning-port)
+              ";;; loading ~a~a ~a~a~%" pad depth visual-depth file)
+      (force-output (current-warning-port)))))
 
 (set! %load-hook %load-announce)
 
@@ -3250,6 +3253,10 @@ deterministic."
     (set-module-declarative?! m (user-modules-declarative?))
     m))
 
+;;; This parameter is used to track the depth at which modules are
+;;; loaded.
+(define %current-module-load-depth (make-parameter -1))
+
 ;; NOTE: This binding is used in libguile/modules.c.
 ;;
 (define resolve-module
@@ -3272,8 +3279,10 @@ deterministic."
              already)
             (autoload
              ;; Try to autoload the module, and recurse.
-             (try-load-module name version)
-             (resolve-module name #f #:ensure ensure))
+             (parameterize ((%current-module-load-depth
+                             (1+ (%current-module-load-depth))))
+               (try-load-module name version)
+               (resolve-module name #f #:ensure ensure)))
             (else
              ;; No module found (or if one was, it had no public interface), and
              ;; we're not autoloading. Make an empty module if #:ensure is true.
@@ -3584,7 +3593,8 @@ but it fails to load."
                        (call/ec
                         (lambda (abort)
                           (primitive-load-path (in-vicinity dir-hint name)
-                                               abort)
+                                               abort
+                                               (%current-module-load-depth))
                           (set! didit #t)))))))
                 (lambda () (set-autoloaded! dir-hint name didit)))
               didit))))))
@@ -4406,7 +4416,8 @@ when none is available, reading FILE-NAME with READER."
       (if compiled
           (begin
             (if %load-hook
-                (%load-hook abs-file-name))
+                (%load-hook abs-file-name
+                            #:depth (%current-module-load-depth)))
             (compiled))
           (start-stack 'load-stack
                        (primitive-load abs-file-name)))))
-- 
2.41.0





This bug report was last modified 98 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.