From 5a79300f8596c4dc3ff71e9faa587531f76798f7 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sun, 13 Feb 2011 19:18:02 +0100
Subject: [PATCH] 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.
---
 libguile/load.c               | 28 ++++++++++++++++++++++++----
 module/ice-9/boot-9.scm       |  8 +++++++-
 module/system/repl/common.scm |  2 +-
 3 files changed, 32 insertions(+), 6 deletions(-)

diff --git a/libguile/load.c b/libguile/load.c
index 082bebb3d..c2380b94e 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -668,6 +668,10 @@ compiled_is_fresh (SCM full_filename, SCM compiled_filename)
 }
 
 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
 do_try_auto_compile (void *data)
@@ -680,14 +684,30 @@ do_try_auto_compile (void *data)
   scm_newline (scm_current_error_port ());
 
   comp_mod = scm_c_resolve_module ("system base compile");
-  compile_file = scm_module_variable
-    (comp_mod, scm_from_latin1_symbol ("compile-file"));
+  compile_file = scm_module_variable (comp_mod, sym_compile_file);
 
   if (scm_is_true (compile_file))
     {
       /* Auto-compile in the context of the current module.  */
-      SCM res = scm_call_3 (scm_variable_ref (compile_file), source,
-			    kw_env, scm_current_module ());
+      SCM res, opts;
+      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_display (res, scm_current_error_port ());
       scm_newline (scm_current_error_port ());
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 89be440b5..0f89dcece 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -3259,6 +3259,10 @@ module '(ice-9 q) '(make-q q-length))}."
 ;;; 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)
   ;; 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
@@ -3303,10 +3307,12 @@ module '(ice-9 q) '(make-q q-length))}."
                  (%load-should-auto-compile
                   (%warn-auto-compilation-enabled)
                   (format (current-error-port) ";;; compiling ~a\n" name)
-                  (let ((cfn ((module-ref
+                  (let ((cfn
+                         ((module-ref
                                (resolve-interface '(system base compile))
                                'compile-file)
                               name
+                              #:opts %auto-compilation-options
                               #:env (current-module))))
                     (format (current-error-port) ";;; compiled ~a\n" cfn)
                     cfn))
diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index 0e7cb6905..70232ab76 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -107,7 +107,7 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
 
 (define repl-default-options
   (copy-tree
-   `((compile-options (#:warnings (unbound-variable arity-mismatch)) #f)
+   `((compile-options ,%auto-compilation-options #f)
      (trace #f #f)
      (interp #f #f)
      (prompt #f ,(lambda (prompt)
-- 
2.20.1