summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-06-03 18:22:39 +0200
committerAndy Wingo <wingo@pobox.com>2009-06-03 22:20:55 +0200
commitee001750269b34179a90aa5c0dc90bd0ffdb8869 (patch)
treea2ff599513d198154dd959f1fadba49ce05f2a44
parent0fb81f95b0222c5ba49efd3e36cf797df54c0863 (diff)
downloadguile-ee001750269b34179a90aa5c0dc90bd0ffdb8869.tar.gz
implement autocompilation
* am/guilec (.scm.go): Set GUILE_AUTO_COMPILE=0 when compiling individual files, and remove the mkdir -p as compile-file takes care of that now. * libguile/load.c (do_try_autocompile, autocompile_catch_handler) (scm_try_autocompile, scm_init_load): Implement autocompilation. * libguile/script.c (scm_shell_usage, scm_compile_shell_switches): Add --autocompile / --no-autocompile command-line options, and support for the GUILE_AUTO_COMPILE environment variable, defaulting to autocompilation enabled.
-rw-r--r--am/guilec3
-rw-r--r--libguile/load.c62
-rw-r--r--libguile/script.c30
3 files changed, 92 insertions, 3 deletions
diff --git a/am/guilec b/am/guilec
index 37f56bd40..796e259c3 100644
--- a/am/guilec
+++ b/am/guilec
@@ -11,5 +11,4 @@ CLEANFILES = $(GOBJECTS)
SUFFIXES = .scm .go
.scm.go:
- $(MKDIR_P) `dirname $@`
- $(top_builddir)/meta/uninstalled-env guile-tools compile -o "$@" "$<"
+ GUILE_AUTO_COMPILE=0 $(top_builddir)/meta/uninstalled-env guile-tools compile -o "$@" "$<"
diff --git a/libguile/load.c b/libguile/load.c
index 6b5d1a528..19f22a321 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -182,6 +182,8 @@ static SCM *scm_loc_load_extensions;
static SCM *scm_loc_load_compiled_path;
static SCM *scm_loc_load_compiled_extensions;
+/* Whether we should try to auto-compile. */
+static SCM *scm_loc_load_should_autocompile;
SCM_DEFINE (scm_parse_path, "parse-path", 1, 1, 0,
(SCM path, SCM tail),
@@ -581,11 +583,66 @@ compiled_is_newer (SCM full_filename, SCM compiled_filename)
}
static SCM
-scm_try_autocompile (SCM source)
+do_try_autocompile (void *data)
{
+ SCM source = PTR2SCM (data);
+ SCM comp_mod, compile_file, res;
+
+ scm_puts (";;; compiling ", scm_current_error_port ());
+ scm_display (source, scm_current_error_port ());
+ scm_newline (scm_current_error_port ());
+
+ comp_mod = scm_c_resolve_module ("system base compile");
+ compile_file = scm_c_module_lookup (comp_mod, "compile-file");
+ res = scm_call_1 (scm_variable_ref (compile_file), source);
+
+ scm_puts (";;; compiled ", scm_current_error_port ());
+ scm_display (res, scm_current_error_port ());
+ scm_newline (scm_current_error_port ());
+
+ return res;
+}
+
+static SCM
+autocompile_catch_handler (void *data, SCM tag, SCM throw_args)
+{
+ SCM source = PTR2SCM (data);
+ scm_puts (";;; WARNING: compilation of ", scm_current_error_port ());
+ scm_display (source, scm_current_error_port ());
+ scm_puts (" failed\n", scm_current_error_port ());
+ scm_puts (";;; key ", scm_current_error_port ());
+ scm_write (tag, scm_current_error_port ());
+ scm_puts (", throw args ", scm_current_error_port ());
+ scm_write (throw_args, scm_current_error_port ());
+ scm_newline (scm_current_error_port ());
return SCM_BOOL_F;
}
+static SCM
+scm_try_autocompile (SCM source)
+{
+ static int message_shown = 0;
+
+ if (scm_is_false (*scm_loc_load_should_autocompile))
+ return SCM_BOOL_F;
+
+ if (!message_shown)
+ {
+ scm_puts (";;; note: autocompilation is enabled, set GUILE_AUTO_COMPILE=0\n"
+ ";;; or pass the --no-autocompile argument to disable\n",
+ scm_current_error_port ());
+ message_shown = 1;
+ }
+
+ /* fixme: wrap in a `catch' */
+ return scm_c_catch (SCM_BOOL_T,
+ do_try_autocompile,
+ SCM2PTR (source),
+ autocompile_catch_handler,
+ SCM2PTR (source),
+ NULL, NULL);
+}
+
SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 1, 0,
(SCM filename, SCM exception_on_not_found),
"Search @var{%load-path} for the file named @var{filename} and\n"
@@ -673,6 +730,9 @@ scm_init_load ()
scm_list_1 (scm_from_locale_string (".go"))));
scm_loc_load_hook = SCM_VARIABLE_LOC (scm_c_define ("%load-hook", SCM_BOOL_F));
+ scm_loc_load_should_autocompile
+ = SCM_VARIABLE_LOC (scm_c_define ("%load-should-autocompile", SCM_BOOL_F));
+
the_reader = scm_make_fluid ();
the_reader_fluid_num = SCM_FLUID_NUM (the_reader);
SCM_FAST_FLUID_SET_X (the_reader_fluid_num, SCM_BOOL_F);
diff --git a/libguile/script.c b/libguile/script.c
index 14691c738..c61e85a8d 100644
--- a/libguile/script.c
+++ b/libguile/script.c
@@ -29,6 +29,7 @@
#include "libguile/eval.h"
#include "libguile/feature.h"
#include "libguile/load.h"
+#include "libguile/private-gc.h" /* scm_getenv_int */
#include "libguile/read.h"
#include "libguile/script.h"
#include "libguile/strings.h"
@@ -376,6 +377,10 @@ scm_shell_usage (int fatal, char *message)
" --no-debug start with normal evaluator\n"
" Default is to enable debugging for interactive\n"
" use, but not for `-s' and `-c'.\n"
+ " --autocompile compile source files automatically\n"
+ " --no-autocompile disable automatic source file compilation\n"
+ " Default is to enable autocompilation of source\n"
+ " files.\n"
" -q inhibit loading of user init file\n"
" --emacs enable Emacs protocol (experimental)\n"
" --use-srfi=LS load SRFI modules for the SRFIs in LS,\n"
@@ -404,6 +409,7 @@ SCM_SYMBOL (sym_quit, "quit");
SCM_SYMBOL (sym_use_srfis, "use-srfis");
SCM_SYMBOL (sym_load_path, "%load-path");
SCM_SYMBOL (sym_set_x, "set!");
+SCM_SYMBOL (sym_sys_load_should_autocompile, "%load-should-autocompile");
SCM_SYMBOL (sym_cons, "cons");
SCM_SYMBOL (sym_at, "@");
SCM_SYMBOL (sym_atat, "@@");
@@ -448,6 +454,8 @@ scm_compile_shell_switches (int argc, char **argv)
int use_emacs_interface = 0;
int turn_on_debugging = 0;
int dont_turn_on_debugging = 0;
+ int turn_on_autocompile = 0;
+ int dont_turn_on_autocompile = 0;
int i;
char *argv0 = guile;
@@ -584,6 +592,18 @@ scm_compile_shell_switches (int argc, char **argv)
turn_on_debugging = 0;
}
+ else if (! strcmp (argv[i], "--autocompile"))
+ {
+ turn_on_autocompile = 1;
+ dont_turn_on_autocompile = 0;
+ }
+
+ else if (! strcmp (argv[i], "--no-autocompile"))
+ {
+ dont_turn_on_autocompile = 1;
+ turn_on_autocompile = 0;
+ }
+
else if (! strcmp (argv[i], "--emacs")) /* use emacs protocol */
use_emacs_interface = 1;
@@ -701,6 +721,16 @@ scm_compile_shell_switches (int argc, char **argv)
tail = scm_cons (scm_cons (sym_load_user_init, SCM_EOL), tail);
}
+ /* If GUILE_AUTO_COMPILE is not set and no args are given, default to
+ autocompilation. */
+ if (turn_on_autocompile || (scm_getenv_int ("GUILE_AUTO_COMPILE", 1)
+ && !dont_turn_on_autocompile))
+ {
+ tail = scm_cons (scm_list_3 (sym_set_x, sym_sys_load_should_autocompile,
+ SCM_BOOL_T),
+ tail);
+ }
+
/* If debugging was requested, or we are interactive and debugging
was not explicitly turned off, turn on debugging. */
if (turn_on_debugging || (interactive && !dont_turn_on_debugging))