mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-11 14:21:10 +02:00
Add %auto-compilation-options', used by
compile-file' when auto-compiling.
* module/ice-9/boot-9.scm (%auto-compilation-options): New variable. (load-in-vicinity): Honor it. * libguile/load.c (kw_opts, sym_compile_file, sym_auto_compilation_options): New variables. (do_try_auto_compile): Honor %AUTO-COMPILATION-OPTIONS. * module/system/repl/common.scm (repl-default-options): Have `compile-options' default to %AUTO-COMPILATION-OPTIONS.
This commit is contained in:
parent
a4060f6710
commit
5a79300f85
3 changed files with 32 additions and 6 deletions
|
@ -668,6 +668,10 @@ compiled_is_fresh (SCM full_filename, SCM compiled_filename)
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM_KEYWORD (kw_env, "env");
|
SCM_KEYWORD (kw_env, "env");
|
||||||
|
SCM_KEYWORD (kw_opts, "opts");
|
||||||
|
|
||||||
|
SCM_SYMBOL (sym_compile_file, "compile-file");
|
||||||
|
SCM_SYMBOL (sym_auto_compilation_options, "%auto-compilation-options");
|
||||||
|
|
||||||
static SCM
|
static SCM
|
||||||
do_try_auto_compile (void *data)
|
do_try_auto_compile (void *data)
|
||||||
|
@ -680,14 +684,30 @@ do_try_auto_compile (void *data)
|
||||||
scm_newline (scm_current_error_port ());
|
scm_newline (scm_current_error_port ());
|
||||||
|
|
||||||
comp_mod = scm_c_resolve_module ("system base compile");
|
comp_mod = scm_c_resolve_module ("system base compile");
|
||||||
compile_file = scm_module_variable
|
compile_file = scm_module_variable (comp_mod, sym_compile_file);
|
||||||
(comp_mod, scm_from_latin1_symbol ("compile-file"));
|
|
||||||
|
|
||||||
if (scm_is_true (compile_file))
|
if (scm_is_true (compile_file))
|
||||||
{
|
{
|
||||||
/* Auto-compile in the context of the current module. */
|
/* Auto-compile in the context of the current module. */
|
||||||
SCM res = scm_call_3 (scm_variable_ref (compile_file), source,
|
SCM res, opts;
|
||||||
kw_env, scm_current_module ());
|
SCM args[5];
|
||||||
|
|
||||||
|
opts = scm_module_variable (scm_the_root_module (),
|
||||||
|
sym_auto_compilation_options);
|
||||||
|
if (SCM_VARIABLEP (opts))
|
||||||
|
opts = SCM_VARIABLE_REF (opts);
|
||||||
|
else
|
||||||
|
opts = SCM_EOL;
|
||||||
|
|
||||||
|
args[0] = source;
|
||||||
|
args[1] = kw_opts;
|
||||||
|
args[2] = opts;
|
||||||
|
args[3] = kw_env;
|
||||||
|
args[4] = scm_current_module ();
|
||||||
|
|
||||||
|
/* Assume `*current-warning-prefix*' has an appropriate value. */
|
||||||
|
res = scm_call_n (scm_variable_ref (compile_file), args, 5);
|
||||||
|
|
||||||
scm_puts (";;; compiled ", scm_current_error_port ());
|
scm_puts (";;; compiled ", scm_current_error_port ());
|
||||||
scm_display (res, scm_current_error_port ());
|
scm_display (res, scm_current_error_port ());
|
||||||
scm_newline (scm_current_error_port ());
|
scm_newline (scm_current_error_port ());
|
||||||
|
|
|
@ -3259,6 +3259,10 @@ module '(ice-9 q) '(make-q q-length))}."
|
||||||
;;; source location.
|
;;; source location.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
|
(define %auto-compilation-options
|
||||||
|
;; Default `compile-file' option when auto-compiling.
|
||||||
|
'(#:warnings (unbound-variable arity-mismatch)))
|
||||||
|
|
||||||
(define* (load-in-vicinity dir path #:optional reader)
|
(define* (load-in-vicinity dir path #:optional reader)
|
||||||
;; Returns the .go file corresponding to `name'. Does not search load
|
;; Returns the .go file corresponding to `name'. Does not search load
|
||||||
;; paths, only the fallback path. If the .go file is missing or out of
|
;; paths, only the fallback path. If the .go file is missing or out of
|
||||||
|
@ -3303,10 +3307,12 @@ module '(ice-9 q) '(make-q q-length))}."
|
||||||
(%load-should-auto-compile
|
(%load-should-auto-compile
|
||||||
(%warn-auto-compilation-enabled)
|
(%warn-auto-compilation-enabled)
|
||||||
(format (current-error-port) ";;; compiling ~a\n" name)
|
(format (current-error-port) ";;; compiling ~a\n" name)
|
||||||
(let ((cfn ((module-ref
|
(let ((cfn
|
||||||
|
((module-ref
|
||||||
(resolve-interface '(system base compile))
|
(resolve-interface '(system base compile))
|
||||||
'compile-file)
|
'compile-file)
|
||||||
name
|
name
|
||||||
|
#:opts %auto-compilation-options
|
||||||
#:env (current-module))))
|
#:env (current-module))))
|
||||||
(format (current-error-port) ";;; compiled ~a\n" cfn)
|
(format (current-error-port) ";;; compiled ~a\n" cfn)
|
||||||
cfn))
|
cfn))
|
||||||
|
|
|
@ -107,7 +107,7 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
|
||||||
|
|
||||||
(define repl-default-options
|
(define repl-default-options
|
||||||
(copy-tree
|
(copy-tree
|
||||||
`((compile-options (#:warnings (unbound-variable arity-mismatch)) #f)
|
`((compile-options ,%auto-compilation-options #f)
|
||||||
(trace #f #f)
|
(trace #f #f)
|
||||||
(interp #f #f)
|
(interp #f #f)
|
||||||
(prompt #f ,(lambda (prompt)
|
(prompt #f ,(lambda (prompt)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue