Re: [PATCH v4 4/4] load: Display modules depth in output when using %load-verbosely.

[Maxim Cournoyer <maxim.cournoyer@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 6423 bytes --]

Hi Maxime,

Maxime Devos <maximedevos@telenet.be> writes:

[...]

>>> I now see:
>>>
>>>> +  /* 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);
>>> But that doesn't work properly, as it catches too much -- the
>>> 'wrong-numer-of-args' might be caused by something inside the handler
>>> instead of an incorrect-arity invocation of the handler itself.
>>>
>>> Something like 'program-arity' would be more accurate, albeit not 100%
>>> guaranteed.  But for backwards compatibility it might be good enough.
>>> (Caveat: I don't know if uncompiled procedures have arity information,
>>> though perhaps you could go ‘no arity information -> assume new
>>> interface'.)
>>>
>>> (On the C level, there is scm_i_procedure_arity.)
>> I see what you mean about potential nested wrong-number-of-args being
>> raised by the hook procedure itself, but I'm not sure how that can be
>> improved.  I had tried introspecting the arity of a procedure and it
>> didn't work on the C side, at least using 'scm_procedure_minimum_arity'
>> (which is implemented in terms of scm_i_procedure_arity).  From my
>> #guile IRC logs:
>> --8<---------------cut here---------------start------------->8---
>> 2023-09-08 21:13:50 apteryx interesting, arity =
>> scm_procedure_minimum_arity (hook); doesn't work in load.c
>> 2023-09-08 21:14:03	apteryx	it produces arity=(0 0 #t)
>> --8<---------------cut here---------------end--------------->8---
>> Also, what do you mean by 'not 100% guaranteed' ?  I think catching
>> too
>> many errors here is a better trade than catching none.
>
> I think the opposite -- if the load hook really wants to catch its own
> wrong-number-of-args, it can just do that by inserting an appropriate
> 'catch', whereas the load hook cannot remove the overly wide
> implicitly catch of primitive_load.


> Implicitly catching the errors is also an API violation, as it is not
> documented that primitive-load, load-in-vicinity, etc., implicitly
> suppress errors.

OK, I agree!

I tried using scm_program_minimum_arity in libguile/load.c like so:

--8<---------------cut here---------------start------------->8---
modified   libguile/load.c
@@ -52,6 +52,7 @@
 #include "loader.h"
 #include "modules.h"
 #include "pairs.h"
+#include "procprop.h"
 #include "procs.h"
 #include "read.h"
 #include "srfi-13.h"
@@ -80,21 +81,26 @@ 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;
-};
+/* Predicate to check whether HOOK is of the new type, accepting extra
+   keyword arguments and a rest argument. */
+static SCM new_hook_p (SCM hook) {
+  SCM arity;
+  uint nreqs;                   /* number of required arguments */
+  uint nopts;                   /* number of optional arguments */
+  SCM restp;                    /* accepts rest argument? */
 
-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;
-}
+  arity = scm_procedure_minimum_arity(hook);
 
-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);
+  /* In case the hook has no arity information, simply assumes it uses
+     the newer interface. */
+  if (scm_is_eq(SCM_BOOL_F, arity))
     return SCM_BOOL_T;
+
+  nreqs = scm_to_uint(scm_car(arity));
+  nopts = scm_to_uint(scm_cadr(arity));
+  restp = scm_caddr(arity);
+
+  return scm_from_bool(!restp && (nreqs + nopts) <= 1);
 }
 
 /* Helper to call %load-hook with the correct number of arguments. */
@@ -102,15 +108,11 @@ 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);
+  if (new_hook_p(hook)) {
+    scm_call_3(hook, filename, scm_from_utf8_keyword("depth"), depth);
+  } else {
+    scm_call_1(hook, filename);
+  }
 }
 
 SCM_DEFINE (scm_primitive_load, "primitive-load", 0, 0, 1,
--8<---------------cut here---------------end--------------->8---

Unfortunately, it fails to build with an error that hints that perhaps
using scm_procedure_minimum_arity that early is not supported?

--8<---------------cut here---------------start------------->8---
Making all in module
make[2]: Entering directory '/home/maxim/src/guile/module'
make[2]: Nothing to be done for 'all'.
make[2]: Leaving directory '/home/maxim/src/guile/module'
Making all in stage0
make[2]: Entering directory '/home/maxim/src/guile/stage0'
make[2]: Nothing to be done for 'all'.
make[2]: Leaving directory '/home/maxim/src/guile/stage0'
Making all in stage1
make[2]: Entering directory '/home/maxim/src/guile/stage1'
  BOOTSTRAP(stage1) GUILEC ice-9/boot-9.go
;;; note: source file /home/maxim/src/guile/module/ice-9/boot-9.scm
;;;       newer than compiled /home/maxim/src/guile/stage1/ice-9/boot-9.go
;;; found fresh compiled file at /home/maxim/src/guile/stage0/ice-9/boot-9.go
guile: uncaught exception:
In procedure private-lookup: Module named (system vm program) does not exist
Cannot exit gracefully when init is in progress; aborting.
make[2]: *** [Makefile:2512: ice-9/boot-9.go] Aborted
make[2]: Leaving directory '/home/maxim/src/guile/stage1'
make[1]: *** [Makefile:2205: all-recursive] Error 1
make[1]: Leaving directory '/home/maxim/src/guile'
make: *** [Makefile:2090 : all] Erreur 2
--8<---------------cut here---------------end--------------->8---

See the attached patch file below if you'd like to experiment
with it.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-on-top-of-v4-arity-check-wip.patch --]
[-- Type: text/x-patch, Size: 5359 bytes --]

From a0463d1b2aee68587e4183df1be3a16ba445ad3c Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Date: Sat, 21 Oct 2023 23:12:08 -0400
Subject: [PATCH] on top of v4 arity check wip

---
 doc/ref/api-evaluation.texi |  6 ++---
 libguile/load.c             | 44 +++++++++++++++++++------------------
 module/ice-9/boot-9.scm     |  5 +++--
 3 files changed, 29 insertions(+), 26 deletions(-)

diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 2cccf0481..6cc32ca17 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -872,8 +872,8 @@ 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.  An optional second argument,
-@var{depth}, can be specified to track the depth at which modules are
+@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
@@ -921,7 +921,7 @@ The default @code{%load-hook} is bound to a procedure that does
 something like:
 
 @example
-(define (%load-hook file depth)
+(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)
diff --git a/libguile/load.c b/libguile/load.c
index 094b6d985..3af7d8844 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -52,6 +52,7 @@
 #include "loader.h"
 #include "modules.h"
 #include "pairs.h"
+#include "procprop.h"
 #include "procs.h"
 #include "read.h"
 #include "srfi-13.h"
@@ -80,21 +81,26 @@ 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;
-};
+/* Predicate to check whether HOOK is of the new type, accepting extra
+   keyword arguments and a rest argument. */
+static SCM new_hook_p (SCM hook) {
+  SCM arity;
+  uint nreqs;                   /* number of required arguments */
+  uint nopts;                   /* number of optional arguments */
+  SCM restp;                    /* accepts rest argument? */
 
-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;
-}
+  arity = scm_procedure_minimum_arity(hook);
 
-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);
+  /* In case the hook has no arity information, simply assumes it uses
+     the newer interface. */
+  if (scm_is_eq(SCM_BOOL_F, arity))
     return SCM_BOOL_T;
+
+  nreqs = scm_to_uint(scm_car(arity));
+  nopts = scm_to_uint(scm_cadr(arity));
+  restp = scm_caddr(arity);
+
+  return scm_from_bool(!restp && (nreqs + nopts) <= 1);
 }
 
 /* Helper to call %load-hook with the correct number of arguments. */
@@ -102,15 +108,11 @@ 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);
+  if (new_hook_p(hook)) {
+    scm_call_3(hook, filename, scm_from_utf8_keyword("depth"), depth);
+  } else {
+    scm_call_1(hook, filename);
+  }
 }
 
 SCM_DEFINE (scm_primitive_load, "primitive-load", 0, 0, 1,
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index a1177e172..ad9ace8c8 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2236,7 +2236,7 @@ name extensions listed in %load-extensions."
 (define %load-verbosely #f)
 (define (assert-load-verbosity v) (set! %load-verbosely v))
 
-(define (%load-announce file depth)
+(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)
@@ -4416,7 +4416,8 @@ when none is available, reading FILE-NAME with READER."
       (if compiled
           (begin
             (if %load-hook
-                (%load-hook abs-file-name (%current-module-load-depth)))
+                (%load-hook abs-file-name
+                            #:depth (%current-module-load-depth)))
             (compiled))
           (start-stack 'load-stack
                        (primitive-load abs-file-name)))))

base-commit: 8441d8ff5671db690eb239cfea4dcfdee6d6dcdb
prerequisite-patch-id: 73b2c2e4cdba4082690935d77d8b9df1175d82c8
prerequisite-patch-id: a4a96623fa9d08a3032734e30e01808c1f646956
prerequisite-patch-id: f983f023aedefef1c1ecfb07e99555a57ac2b62a
prerequisite-patch-id: 4745e61c60672254d05ee5936b0750bb0a904a47
-- 
2.41.0


[-- Attachment #3: Type: text/plain, Size: 2711 bytes --]


> (Also, you forgot doing the arity checks in ice-9/boot-9.scm; there
> are users of %load-hook outside boot-9.scm.)

Ugh.  Thanks for spotting that.

[...]

>>>>> To prevent future API breaks, I propose documenting turning %load-hook
>>>>> into a keyword argument procedure with #:allow-other-keys, as
>>>>> something like:
>>>>>
>>>>>     (lambda* (file-name #:key (depth the-default) #:allow-other-keys)
>>>>>       ...)
>>>>>
>>>>> and in the documentation mention that more keywords may be added in
>>>>> the future (and hence #:allow-other-keys).
>>>>>
>>>>> I think it's quite plausible that there will be more such arguments in
>>>>> the future!
>>>> That sounds like a good idea, helas as I understand, with the
>>>> current
>>>> solution, everything needs to be kept as fixed positional arguments so
>>>> we can make sense of them on the C side (which accepts a list of 1 or
>>>> more items, expected to be given in order).  So unless you have other
>>>> ideas that would also ensure backward-compatibility concern on the C
>>>> side, I'd leave it as is for now
>>> The C side doesn't expect anything -- the C side only_calls_  the load
>>> hook, it doesn't implement the load hook, as far as I can tell.
>>>
>>> More concretely, as I understand it, all you need to do on the C-side
>>> is replacing
>>>
>>>> +  scm_call_2(hook, full_filename, depth);
>>> by
>>>
>>>> +  scm_call_3(hook, full_filename,  scm_from_utf8_keyword("depth"),
>>>    depth);
>>>
>>> (using SCM_KEYWORD instead might be preferred).
>> Thanks for the concrete example.  I think I was thinking in terms of
>> scm_primitive_load, which is the one carrying the extra information
>> provided to the %load-hook (e.g. the depth) during its recursive calls.
>> Since we're stuck with positional arguments for scm_primitive_load for
>> backward compatibility, I see little value having a more flexible arity
>> for the %load-hook (they will have to evolve together if they do, as I
>> see it).
>
> We are not stuck with the positional arguments.  There is no backwards
> incompatibility on the Scheme side (besides the initial 'add rest
> arguments' or 'add keyword arguments' thing'), and on the C side you
> could simply define scm_primitive_load2, late scm_primitive_load3,
> etc., or the hack that you are using currently.

[...]

I'm convinced here again, thanks for all the details and thoughtful
examples!  I've made the change, and given the above error encountered
trying to go fancy with the arity, I've just thrown the towel on that
and accepted a backward incompatible change for user hooks arity, that
I've documented in NEWS.  A v5 revision of this series will be sent
soon, and you'll be CC'd on it.

-- 
Thanks,
Maxim