From mboxrd@z Thu Jan  1 00:00:00 1970
Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Newsgroups: gmane.lisp.guile.devel
Subject: [PATCH v4 4/4] load: Display modules depth in output when using
 %load-verbosely.
Date: Mon, 25 Sep 2023 10:29:01 -0400
Message-ID: <20230925142945.14153-5-maxim.cournoyer@gmail.com>
References: <20230925142945.14153-1-maxim.cournoyer@gmail.com>
Mime-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: 8bit
Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214";
	logging-data="22547"; mail-complaints-to="usenet@ciao.gmane.io"
Cc: Maxime Devos <maximedevos@telenet.be>,
 Maxim Cournoyer <maxim.cournoyer@gmail.com>
To: guile-devel@gnu.org
Original-X-From: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Mon Sep 25 16:31:01 2023
Return-path: <guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org>
Envelope-to: guile-devel@m.gmane-mx.org
Original-Received: from lists.gnu.org ([209.51.188.17])
	by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
	(Exim 4.92)
	(envelope-from <guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org>)
	id 1qkmc0-0005ey-G0
	for guile-devel@m.gmane-mx.org; Mon, 25 Sep 2023 16:31:00 +0200
Original-Received: from localhost ([::1] helo=lists1p.gnu.org)
	by lists.gnu.org with esmtp (Exim 4.90_1)
	(envelope-from <guile-devel-bounces@gnu.org>)
	id 1qkmbE-00034E-4n; Mon, 25 Sep 2023 10:30:12 -0400
Original-Received: from eggs.gnu.org ([2001:470:142:3::10])
 by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <maxim.cournoyer@gmail.com>)
 id 1qkmbC-000341-As
 for guile-devel@gnu.org; Mon, 25 Sep 2023 10:30:10 -0400
Original-Received: from mail-qt1-x82e.google.com ([2607:f8b0:4864:20::82e])
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.90_1) (envelope-from <maxim.cournoyer@gmail.com>)
 id 1qkmb8-0004sl-Lt
 for guile-devel@gnu.org; Mon, 25 Sep 2023 10:30:09 -0400
Original-Received: by mail-qt1-x82e.google.com with SMTP id
 d75a77b69052e-418201cb9e9so4526991cf.0
 for <guile-devel@gnu.org>; Mon, 25 Sep 2023 07:30:05 -0700 (PDT)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=gmail.com; s=20230601; t=1695652204; x=1696257004; darn=gnu.org;
 h=content-transfer-encoding:mime-version:references:in-reply-to
 :message-id:date:subject:cc:to:from:from:to:cc:subject:date
 :message-id:reply-to;
 bh=BQSHJQDdjSU51CHKyi1jnjk0CoqllVEFZ0j/LyOZ0iE=;
 b=mdbp2ieG4zaxKjf7X9FFpzvtrFYAWLlxomQXrnEW+ctDKoiLr4AuA7KZUTR+KpElOh
 tGZHzWIzOG8mwqGpXsH2oDlOTrMBiNxgmUwJu31GkMqhwnaa6qYJ23qXbYEkMspWht/e
 eLrU5iW/g6mIv43l+9lbvTAC6Ra6ROYPwltsZMdz73ASlh0tf9IrLr6WIxpBCsGmERur
 EsfRSrUNaboY4DEjUKl7lJi9RgM1A3f5UvLz2NuOP8kSaCJrGuK0gClFFM+7LPxw8ZXn
 w0/blfkXWDxMGTdiZ2+7oOaQ2lubuvDHu8ukcE1jC0WKtrFgi57ZVy/GkZzDksmqa+Tq
 OQ7g==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20230601; t=1695652204; x=1696257004;
 h=content-transfer-encoding:mime-version:references:in-reply-to
 :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc
 :subject:date:message-id:reply-to;
 bh=BQSHJQDdjSU51CHKyi1jnjk0CoqllVEFZ0j/LyOZ0iE=;
 b=AGyzWiAMmhnC6l0FhpSYNv8gl7HMb+txgBJq0HTX6xTDeU5Oscb6UGu6EIGXF2WhUJ
 jVcspW4Yfdd17/NqtswpzSbXNEm6yjjCdbxgdZRMhRiPjM8AynI9TiWfAwzVtEAZ6ocq
 W4RID0J2RWqATEm4fp3bJqmNzPJZy6n2xFk/kFzRrCtvO1SGADscG4CvN6OgeDHmV3Uu
 YI3jJURsDGrhQpZ7rhhBIWS2TtWmKQ2r8qadQ8DJlsX/JBkuhbm6IZ84kFH0w3rMc0Y3
 8WFnFe/3yNXCqBQSg3Kv5PIe4/8eCncczj6pa8LMeom+KzUu90e19LrbCC94nUAxMVez
 DAqw==
X-Gm-Message-State: AOJu0Yy/CX4V9qKiBUslnGOkfujsLUxBJ3uZHwH+oCGN6fRy9xcex4Pj
 Xm/LIBxYSVTIV0QRcXD3rx6o/WITGRE=
X-Google-Smtp-Source: AGHT+IG9Ficpvj1/i6fUWTdDHtCt9fvcNy8gSa2P+//vzWjpWAvKWPCAPI1yiqiE6hGIpOJEQU+Z2g==
X-Received: by 2002:a05:622a:1310:b0:412:6e6:b45b with SMTP id
 v16-20020a05622a131000b0041206e6b45bmr8133398qtk.38.1695652203780; 
 Mon, 25 Sep 2023 07:30:03 -0700 (PDT)
Original-Received: from localhost.localdomain (dsl-10-130-229.b2b2c.ca. [72.10.130.229])
 by smtp.gmail.com with ESMTPSA id
 t16-20020ac85310000000b00405553305casm3810571qtn.86.2023.09.25.07.30.03
 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
 Mon, 25 Sep 2023 07:30:03 -0700 (PDT)
X-Mailer: git-send-email 2.41.0
In-Reply-To: <20230925142945.14153-1-maxim.cournoyer@gmail.com>
Received-SPF: pass client-ip=2607:f8b0:4864:20::82e;
 envelope-from=maxim.cournoyer@gmail.com; helo=mail-qt1-x82e.google.com
X-Spam_score_int: -20
X-Spam_score: -2.1
X-Spam_bar: --
X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1,
 DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001,
 RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001,
 SPF_PASS=-0.001 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-BeenThere: guile-devel@gnu.org
X-Mailman-Version: 2.1.29
Precedence: list
List-Id: "Developers list for Guile,
 the GNU extensibility library" <guile-devel.gnu.org>
List-Unsubscribe: <https://lists.gnu.org/mailman/options/guile-devel>,
 <mailto:guile-devel-request@gnu.org?subject=unsubscribe>
List-Archive: <https://lists.gnu.org/archive/html/guile-devel>
List-Post: <mailto:guile-devel@gnu.org>
List-Help: <mailto:guile-devel-request@gnu.org?subject=help>
List-Subscribe: <https://lists.gnu.org/mailman/listinfo/guile-devel>,
 <mailto:guile-devel-request@gnu.org?subject=subscribe>
Errors-To: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org
Original-Sender: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org
Xref: news.gmane.io gmane.lisp.guile.devel:21988
Archived-At: <http://permalink.gmane.org/gmane.lisp.guile.devel/21988>

* 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.
(hook_args_data): New struct.
(call_hook_2_body, call_hook_1_handler, call_hook): New procedures.
(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 the second DEPTH
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@telenet.be>
---

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                        |  8 ++++
 THANKS                      |  1 +
 doc/guile-api.alist         |  4 +-
 doc/ref/api-evaluation.texi | 62 ++++++++++++++++++++------
 libguile/load.c             | 89 +++++++++++++++++++++++++++++++------
 libguile/load.h             |  4 +-
 module/ice-9/boot-9.scm     | 36 +++++++++------
 7 files changed, 160 insertions(+), 44 deletions(-)

diff --git a/NEWS b/NEWS
index b319404d7..b8b12f1f6 100644
--- a/NEWS
+++ b/NEWS
@@ -21,6 +21,14 @@ definitely unused---this is notably the case for modules that are only
 used at macro-expansion time, such as (srfi srfi-26).  In those cases,
 the compiler reports it as "possibly unused".
 
+** The %load-hook procedure is now applied with an extra 'depth' argument
+
+This 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.  It is hoped to be
+useful when troubleshooting tricky top-level module circular
+dependencies.
+
 * Bug fixes
 
 ** (ice-9 suspendable-ports) incorrect UTF-8 decoding
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 7c08e2494..2cccf0481 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 second 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,48 @@ 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} @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
+(define (%load-hook file depth)
+  (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
+
+@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
-(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 ...
+@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 +1003,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 +1017,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..094b6d985 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -72,35 +72,92 @@
 
 /* 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;
 
+struct hook_args_data {
+    SCM filename;
+    SCM depth;
+};
+
+static SCM call_hook_2_body(void *data) {
+    struct hook_args_data *args_data = data;
+    scm_call_2(*scm_loc_load_hook, args_data->filename, args_data->depth);
+    return SCM_BOOL_T;
+}
+
+static SCM call_hook_1_handler(void *data, SCM key, SCM args ) {
+    struct hook_args_data *args_data = data;
+    scm_call_1(*scm_loc_load_hook, args_data->filename);
+    return SCM_BOOL_T;
+}
+
+/* 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;
+
+  struct hook_args_data args_data;
+  args_data.filename = filename;
+  args_data.depth = depth;
+
+  /* For compatibility with older load hooks procedures, fall-back to
+     calling it with a single argument if calling it with two fails. */
+  scm_internal_catch (scm_from_latin1_symbol ("wrong-number-of-args"),
+                      call_hook_2_body, &args_data,
+                      call_hook_1_handler, &args_data);
+}
 
-SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, 
-           (SCM filename),
+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 +1220,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 +1241,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 +1314,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 +1325,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 897d8d01c..a1177e172 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 depth)
+  (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,7 @@ 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 (%current-module-load-depth)))
             (compiled))
           (start-stack 'load-stack
                        (primitive-load abs-file-name)))))
-- 
2.41.0