From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp11.migadu.com ([2001:41d0:403:478a::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms9.migadu.com with LMTPS id 4ENkDtk1/WTAfAAA9RJhRA:P1 (envelope-from ) for ; Sun, 10 Sep 2023 05:19:53 +0200 Received: from aspmx1.migadu.com ([2001:41d0:403:478a::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp11.migadu.com with LMTPS id 4ENkDtk1/WTAfAAA9RJhRA (envelope-from ) for ; Sun, 10 Sep 2023 05:19:53 +0200 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 0FBB434301 for ; Sun, 10 Sep 2023 05:19:51 +0200 (CEST) Authentication-Results: aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gmail.com header.s=20221208 header.b=aJqK7mBt; spf=pass (aspmx1.migadu.com: domain of "guix-devel-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-devel-bounces+larch=yhetil.org@gnu.org"; dmarc=fail reason="SPF not aligned (relaxed)" header.from=gmail.com (policy=none) ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1694315993; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references:list-id:list-help: list-unsubscribe:list-subscribe:list-post:dkim-signature; bh=8PnO2GUe5G6wpoiD047kGFH35CaJ6oQEz4eDvldIu4Q=; b=W6wY8QG90yAJ99Z4kUwTrJ2n7ag+s7fJzEQdLY+LEufDGr14Kf0sCJErsznCcUjN7FxBSV laUw+AUnWC9wyyazmu7msWJyV0W8samV9bd3R31IHOgxuvB0mZhb7nynISTGKw7wdwzI8a DTY0kvbC21NamUzUCwwqSHDWNMVqfIdsrzigh4BxSXOtFU8Q7G+kcNwz9ft9YXc/ki52fE HaUY6rZlialmd5LTTqNVoclniw5E710BbUPZou099LGPdOCR/sq/CW0CGtiLYmER9FDoua N7ZWRHWRV/Yte/lAgEKNvAvBGvmSw6doj3Tl51WxD1ccNNFiOPeuM7FaBv5Pkg== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1694315993; a=rsa-sha256; cv=none; b=I7RYkaYIj8Zeem2iojRseV17gPDvEnZwKH5Eo9+GjQMQVSfDKcvHSinLnLVjmG5ueIiTho e/hpBiaGlkZlGgESdygn3XgvZMUBsfQonvlX+aLEi9wSxIf91K5PtvU9O0eK+2pEIBDVNB FdRzupAk8luiPTn/QQB9knpqCAqq5MEqLFG2MQAXtHOK9hoseC7fSIwFuV/jKze+k4j7zy 7OmyE9CIbUwKANMHxKfk04bRNqUHg52qndQ6vZ9bpWO3PMxet63pCfz1QFWQJSUY5ciLsy c/GZrynZAmTV5D66vpc0Zl194wzW8+2TfoB6FiPh73VDMtM6XhzAf++sPYoEmQ== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gmail.com header.s=20221208 header.b=aJqK7mBt; spf=pass (aspmx1.migadu.com: domain of "guix-devel-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-devel-bounces+larch=yhetil.org@gnu.org"; dmarc=fail reason="SPF not aligned (relaxed)" header.from=gmail.com (policy=none) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qfAyZ-0002Bi-An; Sat, 09 Sep 2023 23:19:07 -0400 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 ) id 1qfAyY-0002BL-32 for guix-devel@gnu.org; Sat, 09 Sep 2023 23:19:06 -0400 Received: from mail-qv1-xf2c.google.com ([2607:f8b0:4864:20::f2c]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qfAyU-0006Gy-VM for guix-devel@gnu.org; Sat, 09 Sep 2023 23:19:05 -0400 Received: by mail-qv1-xf2c.google.com with SMTP id 6a1803df08f44-649921ec030so19004096d6.1 for ; Sat, 09 Sep 2023 20:19:02 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20221208; t=1694315942; x=1694920742; 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=9fbYNh0KW8rEo3Ug0ci6pSntEAvMD+IroI+nor9aBQo=; b=aJqK7mBtAklAcxhoNzF+AfCRwKPQCKGkUqN47NY4s1T3erzcSeYEXsIkST7Oaj9PzD UnUCRZKsyFm3pMPbvmDNPrUPFnhw6B5WJ9r8wucXZi/BlCMww0oFLYCqDjtacCUu1g9s 5U466j0CAdue5rLVcBbbH6EbwIzljLnQoabno1gZ/vmZVvp6ukvDVeVCz0/8+L47nLZz +YDKkd5gDg7OiozIt7PvpAUdf6IyjvHLtS3Cg27gyTeKQy7QGbc6eSJZ3Xo0TT8Nt8dl JT2pM1A1TxPnLJDoxxs5Qeh33OX8ObpnFjKR8ONBx70wMZvYX4bsTnS+LhBnlVbCzHLv BbhQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1694315942; x=1694920742; 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=9fbYNh0KW8rEo3Ug0ci6pSntEAvMD+IroI+nor9aBQo=; b=iLHZvQd7vTZHNdzygRgfypo9zHdxpg2OqUiLH8dqr1a5o40NPAmzipKYdFcyT1tjBQ cLjItnxa97KV1ecrOr4E63r1jr4k/vOzHlNCMyeUpzg8cWFsEBUYcxIFQiYd9NUuaGCi oVh9o8NzfZysz/i0IdQ7tlD2cKTpi6JgEXkoHOyb1sU9iTQuod6h2c3kTqxrOJs4+rKw tNeMYfrCqhEwwiKh0oJ/6jCq5ewZZ0mXgmUgs1eORFpIn70AGqmtXneYGoS1W+n4yeFh XvSRfp4FeZWM5PbuvPv12I9kYFJA/NQ26LWdp5tt+t7/BspvLAFJUi2DHSmg36GJ7tar oy/w== X-Gm-Message-State: AOJu0YxrmxPqMyLRXHCbEUfVQ78PNtsLzsxmeUBLSZCneT3gHF92XGhI 1oNYDiVCsdIZxOsIrv0CNBE1KZjI+Yo= X-Google-Smtp-Source: AGHT+IHPj+GL7yUD76qfEciYDn9PUriFUV41XZPu/DWvq5Nx7TSVsO7XFsNnf9DGWwUPi1Iqu7kI8A== X-Received: by 2002:a05:620a:3904:b0:76d:3475:2e05 with SMTP id qr4-20020a05620a390400b0076d34752e05mr7756837qkn.11.1694315941533; Sat, 09 Sep 2023 20:19:01 -0700 (PDT) Received: from localhost.localdomain (dsl-155-89.b2b2c.ca. [66.158.155.89]) by smtp.gmail.com with ESMTPSA id w3-20020a05620a148300b00767d2870e39sm1658821qkj.41.2023.09.09.20.19.00 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sat, 09 Sep 2023 20:19:01 -0700 (PDT) From: Maxim Cournoyer To: guix-devel@gnu.org Cc: Maxim Cournoyer Subject: [PATCH 4/4] load: Display modules depth in output when using %load-verbosely. Date: Sat, 9 Sep 2023 23:17:24 -0400 Message-ID: <20230910031844.24765-5-maxim.cournoyer@gmail.com> X-Mailer: git-send-email 2.41.0 In-Reply-To: <20230910031844.24765-1-maxim.cournoyer@gmail.com> References: <20230910031844.24765-1-maxim.cournoyer@gmail.com> MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit Received-SPF: pass client-ip=2607:f8b0:4864:20::f2c; envelope-from=maxim.cournoyer@gmail.com; helo=mail-qv1-xf2c.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: guix-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+larch=yhetil.org@gnu.org Sender: guix-devel-bounces+larch=yhetil.org@gnu.org X-Migadu-Country: US X-Migadu-Flow: FLOW_IN X-Migadu-Scanner: mx0.migadu.com X-Migadu-Spam-Score: -0.31 X-Spam-Score: -0.31 X-Migadu-Queue-Id: 0FBB434301 X-TUID: YbuT1QqkUWBq * 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. --- NEWS | 8 ++++ THANKS | 1 + doc/guile-api.alist | 4 +- doc/ref/api-evaluation.texi | 61 +++++++++++++++++++------ libguile/load.c | 89 +++++++++++++++++++++++++++++++------ libguile/load.h | 4 +- module/ice-9/boot-9.scm | 35 +++++++++------ 7 files changed, 158 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 "#")) (%init-rw-builtins (groups Scheme) (scan-data "#")) (%library-dir (groups Scheme) (scan-data "#")) -(%load-announce (groups Scheme) (scan-data "#")) +(%load-announce (groups Scheme) (scan-data "#")) (%load-extensions (groups Scheme) (scan-data "")) -(%load-hook (groups Scheme) (scan-data "#")) +(%load-hook (groups Scheme) (scan-data "#")) (%load-path (groups Scheme) (scan-data "")) (%load-verbosely (groups Scheme) (scan-data "")) (%make-void-port (groups Scheme) (scan-data "#")) diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi index 7c08e2494..ca0a22739 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,47 @@ 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 + (with-output-to-port (current-warning-port) + (lambda () + (let* ((pad-count (- 3 (string-length (number->string depth)))) + (pad (if (> pad-count 0) + (make-string pad-count #\space) + "")) + (visual-depth (make-string depth #\space))) + (format #t ";;; loading ~a~a ~a~a~%" pad depth visual-depth file) + (force-output)))))) +@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 +1002,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 +1016,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..203172585 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -2236,15 +2236,17 @@ 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 + (with-output-to-port (current-warning-port) + (lambda () + (let* ((pad-count (- 3 (string-length (number->string depth)))) + (pad (if (> pad-count 0) + (make-string pad-count #\space) + "")) + (visual-depth (make-string depth #\space))) + (format #t ";;; loading ~a~a ~a~a~%" pad depth visual-depth file) + (force-output)))))) (set! %load-hook %load-announce) @@ -3250,6 +3252,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 +3278,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 +3592,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 +4415,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