>From a0463d1b2aee68587e4183df1be3a16ba445ad3c Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer 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