[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. c2521a212417b09547514
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. c2521a212417b095475148e321daaf6e59ef5b3d |
|
Date: |
Wed, 03 Jun 2009 22:02:28 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=c2521a212417b095475148e321daaf6e59ef5b3d
The branch, master has been updated
via c2521a212417b095475148e321daaf6e59ef5b3d (commit)
via 6fd367e742f42421d81362a6ee8b51bb7b35a9ab (commit)
via ee001750269b34179a90aa5c0dc90bd0ffdb8869 (commit)
via 0fb81f95b0222c5ba49efd3e36cf797df54c0863 (commit)
via 1d022387c8f2615cc94a27109db9b9e02d7d7831 (commit)
via f3130a2ecf218f3709de13c10c54e8586fe0aef2 (commit)
via 4c9c9b9b9822658ee32a9561f56ac3b9d87b0fee (commit)
via 727c259ac5c9a5415a0dac2ddbbc74193906caeb (commit)
via d1e47c6e6c9698cd8623d370db0056176aa42bd9 (commit)
via fcb6f5ff3332a3a4b3de7d735757f7d3db4ddff5 (commit)
via 5b197db838ae12aae948eef92d79d1f37548bac4 (commit)
from 2f9ae9b1040e1b9339bb0bc8b0013a5346622c44 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit c2521a212417b095475148e321daaf6e59ef5b3d
Author: Andy Wingo <address@hidden>
Date: Wed Jun 3 23:59:58 2009 +0200
fix error autocompiling parts of the compiler; make check works
* libguile/load.c (scm_try_autocompile): Punt if compiled-file-name does
not resolve, which would indicate that the file in question is part of
the compiler itself.
* test-suite/tests/elisp.test: Today I was an evil one -- disable
autocompilation for the elisp tests, as they are meant only for the
memoizer's eyes. Hopefully Daniel will fix this :-)
commit 6fd367e742f42421d81362a6ee8b51bb7b35a9ab
Author: Andy Wingo <address@hidden>
Date: Wed Jun 3 23:20:44 2009 +0200
tweaks to autocompile code
* libguile/load.c (compiled_is_newer): Tweak diagnostic output.
(do_try_autocompile, autocompile_catch_handler, scm_try_autocompile):
Rework to compute the name of the compiled file in advance. If the
computed name is different from the found .go file and is fresh, use it
directly.
Fixes the case where /usr/lib/.../foo.go is out of date but the user
doesn't have permissions to recompile, so we use the user's local
compile cache instead if it's fresh.
(scm_primitive_load): Pass the found .go file as well to
scm_try_autocompile.
commit ee001750269b34179a90aa5c0dc90bd0ffdb8869
Author: Andy Wingo <address@hidden>
Date: Wed Jun 3 18:22:39 2009 +0200
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.
commit 0fb81f95b0222c5ba49efd3e36cf797df54c0863
Author: Andy Wingo <address@hidden>
Date: Wed Jun 3 09:48:16 2009 +0200
add exception_on_error optional arg to primitive-load-path
* libguile/init.c (scm_load_startup_files): Use
scm_c_primitive_load_path.
* libguile/load.c (scm_primitive_load_path): Add an optional arg,
exception_on_error, which if #f will cause primitive-load-path to just
return #f if no file is found. This is to help out the semantics of
try-module-autoload. We can't just catch misc-error, because loading
the file could raise any exception.
(scm_c_primitive_load_path): Add the extra arg to
scm_primitive_load_path.
* libguile/load.h: Adapt scm_primitive_load_path prototype.
* module/ice-9/boot-9.scm (try-module-autoload): Refactor slightly to be
clearer.
commit 1d022387c8f2615cc94a27109db9b9e02d7d7831
Author: Andy Wingo <address@hidden>
Date: Wed Jun 3 09:24:35 2009 +0200
refactors to load.c to support auto-compilation
* libguile/load.c (compiled_is_newer): Factored out of
scm_primitive_load_path.
(scm_try_autocompile): New stub, for autocompiling. Currently just
returns false.
(scm_primitive_load_path): Refactor, and call out to
scm_try_autocompile if the .go is missing or not fresh.
commit f3130a2ecf218f3709de13c10c54e8586fe0aef2
Author: Andy Wingo <address@hidden>
Date: Wed Jun 3 09:02:48 2009 +0200
compiled-file-name tries to put the .go in the %load-compiled-path
* module/system/base/compile.scm (ensure-writable-dir): Rename from
ensure-directory.
(dsu-sort): Helper, does a decorate / sort / undecorate.
(compiled-file-name): Refactor to only return a writable filename. The
readable case is handled by load.c now, and the other case was silly.
Hopefully it will do the right thing.
(load-ensuring-compiled): Remove, load.c will call out to compile-file
if necessary.
(ensure-fallback-path): Remove, load.c will add the ~/.guile-ccache dir
to the load-compiled path, which will prompt its creation if necessary.
commit 4c9c9b9b9822658ee32a9561f56ac3b9d87b0fee
Author: Andy Wingo <address@hidden>
Date: Tue Jun 2 22:49:39 2009 +0200
install .go files under $libdir, not $datadir
* am/guilec: Install .go files to
$(pkglibdir)/$GUILE_EFFECTIVE_VERSION/ccache.
commit 727c259ac5c9a5415a0dac2ddbbc74193906caeb
Author: Andy Wingo <address@hidden>
Date: Tue Jun 2 22:39:30 2009 +0200
file-exists? doesn't cause a throw, simpler try-module-autoload
* module/ice-9/boot-9.scm (file-exists?): Change to use the stat
interface that doesn't throw exceptions.
(try-module-autoload): Simplify to take advantage of the fact that
primitive-load-path does the right thing with regards to loading
compiled files if they are available.
commit d1e47c6e6c9698cd8623d370db0056176aa42bd9
Author: Andy Wingo <address@hidden>
Date: Tue Jun 2 22:37:24 2009 +0200
update uninstalled-env.in for load-compiled path separation
* meta/uninstalled-env.in: Update to set GUILE_LOAD_COMPILED_PATH and
GUILE_SYSTEM_COMPILED_PATH.
commit fcb6f5ff3332a3a4b3de7d735757f7d3db4ddff5
Author: Andy Wingo <address@hidden>
Date: Tue Jun 2 22:20:21 2009 +0200
add exception-on-error optional arg to `stat' in scheme
* libguile/filesys.h:
* libguile/filesys.c (scm_stat): Add optional arg, exception-on-error,
which if #f (not the default) will just return #f instead of raising an
exception if the stat fails.
commit 5b197db838ae12aae948eef92d79d1f37548bac4
Author: Andy Wingo <address@hidden>
Date: Tue Jun 2 22:18:02 2009 +0200
separate the load-compiled path from the load path
* libguile/Makefile.am (libpath.h): Add definitions for SCM_CCACHE_DIR
and SCM_EFFECTIVE_VERSION. These are private, the header is not
installed. Add ccachedir to build-info. Rework some other build-info
definitions.
* libguile/load.c (scm_loc_load_compiled_path): New global, corresponding
to the new environment variable, GUILE_LOAD_COMPILED_PATH. Compiled
files will now be searched for in this path, and only in this path.
(scm_init_load_path): Init the load-compiled path too. We initialize it
with $pkglibdir/guile/$effective_version/ccache, and also with
$HOME/.guile-ccache/$effective_version/. This will respect the
libdir/datadir difference, and it is a preparation for automatic
compilation support.
(scm_primitive_load_path): Search only the GUILE_LOAD_COMPILED_PATH for
compiled files.
(scm_init_load): Cache scm_loc_load_compiled_path.
-----------------------------------------------------------------------
Summary of changes:
am/guilec | 7 +-
libguile/Makefile.am | 9 +-
libguile/filesys.c | 32 ++++--
libguile/filesys.h | 2 +-
libguile/init.c | 2 +-
libguile/load.c | 241 +++++++++++++++++++++++++++++++++-------
libguile/load.h | 2 +-
libguile/script.c | 30 +++++
meta/uninstalled-env.in | 21 +++-
module/ice-9/boot-9.scm | 28 +----
module/system/base/compile.scm | 79 ++++++++++---
test-suite/tests/elisp.test | 4 +
12 files changed, 356 insertions(+), 101 deletions(-)
diff --git a/am/guilec b/am/guilec
index f8690d3..796e259 100644
--- a/am/guilec
+++ b/am/guilec
@@ -2,12 +2,13 @@
GOBJECTS = $(SOURCES:%.scm=%.go)
moddir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/$(modpath)
-nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) $(GOBJECTS)
+nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES)
+ccachedir = $(pkglibdir)/$(GUILE_EFFECTIVE_VERSION)/ccache/$(modpath)
+ccache_DATA = $(GOBJECTS)
EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
CLEANFILES = $(GOBJECTS)
SUFFIXES = .scm .go
.scm.go:
- $(MKDIR_P) `dirname address@hidden
- $(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/Makefile.am b/libguile/Makefile.am
index fcf197a..b9e8e2b 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -286,6 +286,8 @@ libpath.h: $(srcdir)/Makefile.in
$(top_builddir)/config.status
@echo '#define SCM_PKGDATA_DIR "$(pkgdatadir)"' >> libpath.tmp
@echo '#define SCM_LIBRARY_DIR
"$(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)"'>>libpath.tmp
@echo '#define SCM_SITE_DIR "$(pkgdatadir)/site"' >> libpath.tmp
+ @echo '#define SCM_CCACHE_DIR
"$(pkglibdir)/$(GUILE_EFFECTIVE_VERSION)/ccache"' >> libpath.tmp
+ @echo '#define SCM_EFFECTIVE_VERSION "$(GUILE_EFFECTIVE_VERSION)"' >>
libpath.tmp
@echo '#define SCM_BUILD_INFO { \' >> libpath.tmp
@echo ' { "srcdir", "'"`cd @srcdir@; pwd`"'" }, \' >> libpath.tmp
@echo ' { "top_srcdir", "@top_srcdir_absolute@" }, \' >> libpath.tmp
@@ -299,12 +301,13 @@ libpath.h: $(srcdir)/Makefile.in
$(top_builddir)/config.status
@echo ' { "sharedstatedir", "@sharedstatedir@" }, \' >> libpath.tmp
@echo ' { "localstatedir", "@localstatedir@" }, \' >> libpath.tmp
@echo ' { "libdir", "@libdir@" }, \' >> libpath.tmp
+ @echo ' { "ccachedir", SCM_CCACHE_DIR }, \' >> libpath.tmp
@echo ' { "infodir", "@infodir@" }, \' >> libpath.tmp
@echo ' { "mandir", "@mandir@" }, \' >> libpath.tmp
@echo ' { "includedir", "@includedir@" }, \' >> libpath.tmp
- @echo ' { "pkgdatadir", "$(datadir)/@PACKAGE@" }, \' >> libpath.tmp
- @echo ' { "pkglibdir", "$(libdir)/@PACKAGE@" }, \' >> libpath.tmp
- @echo ' { "pkgincludedir", "$(includedir)/@PACKAGE@" }, \' \
+ @echo ' { "pkgdatadir", "@pkgdatadir@" }, \' >> libpath.tmp
+ @echo ' { "pkglibdir", "@pkglibdir@" }, \' >> libpath.tmp
+ @echo ' { "pkgincludedir", "@pkgincludedir@" }, \' \
>> libpath.tmp
@echo ' { "guileversion", "@GUILE_VERSION@" }, \' >> libpath.tmp
@echo ' { "libguileinterface", "@LIBGUILE_INTERFACE@" }, \' \
diff --git a/libguile/filesys.c b/libguile/filesys.c
index ec33328..4799dd4 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -580,17 +580,23 @@ static int fstat_Win32 (int fdes, struct stat *buf)
}
#endif /* __MINGW32__ */
-SCM_DEFINE (scm_stat, "stat", 1, 0, 0,
- (SCM object),
+SCM_DEFINE (scm_stat, "stat", 1, 1, 0,
+ (SCM object, SCM exception_on_error),
"Return an object containing various information about the file\n"
"determined by @var{obj}. @var{obj} can be a string containing\n"
"a file name or a port or integer file descriptor which is open\n"
"on a file (in which case @code{fstat} is used as the underlying\n"
"system call).\n"
"\n"
- "The object returned by @code{stat} can be passed as a single\n"
- "parameter to the following procedures, all of which return\n"
- "integers:\n"
+ "If the optional @var{exception_on_error} argument is true,
which\n"
+ "is the default, an exception will be raised if the underlying\n"
+ "system call returns an error, for example if the file is not\n"
+ "found or is not readable. Otherwise, an error will cause\n"
+ "@code{stat} to return @code{#f}."
+ "\n"
+ "The object returned by a successful call to @code{stat} can be\n"
+ "passed as a single parameter to the following procedures, all
of\n"
+ "which return integers:\n"
"\n"
"@table @code\n"
"@item stat:dev\n"
@@ -678,12 +684,16 @@ SCM_DEFINE (scm_stat, "stat", 1, 0, 0,
if (rv == -1)
{
- int en = errno;
-
- SCM_SYSERROR_MSG ("~A: ~S",
- scm_list_2 (scm_strerror (scm_from_int (en)),
- object),
- en);
+ if (SCM_UNBNDP (exception_on_error) || scm_is_true (exception_on_error))
+ {
+ int en = errno;
+ SCM_SYSERROR_MSG ("~A: ~S",
+ scm_list_2 (scm_strerror (scm_from_int (en)),
+ object),
+ en);
+ }
+ else
+ return SCM_BOOL_F;
}
return scm_stat2scm (&stat_temp);
}
diff --git a/libguile/filesys.h b/libguile/filesys.h
index a38a5b5..cf0a6ac 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -42,7 +42,7 @@ SCM_API SCM scm_open_fdes (SCM path, SCM flags, SCM mode);
SCM_API SCM scm_open (SCM path, SCM flags, SCM mode);
SCM_API SCM scm_close (SCM fd_or_port);
SCM_API SCM scm_close_fdes (SCM fd);
-SCM_API SCM scm_stat (SCM object);
+SCM_API SCM scm_stat (SCM object, SCM exception_on_error);
SCM_API SCM scm_link (SCM oldpath, SCM newpath);
SCM_API SCM scm_rename (SCM oldname, SCM newname);
SCM_API SCM scm_delete_file (SCM str);
diff --git a/libguile/init.c b/libguile/init.c
index dbc7f87..c72aeff 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -282,7 +282,7 @@ scm_load_startup_files ()
/* Load Ice-9. */
if (!scm_ice_9_already_loaded)
{
- scm_primitive_load_path (scm_from_locale_string ("ice-9/boot-9"));
+ scm_c_primitive_load_path ("ice-9/boot-9");
/* Load the init.scm file. */
if (scm_is_true (init_path))
diff --git a/libguile/load.c b/libguile/load.c
index 1b5b24f..4e127d6 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -53,6 +53,10 @@
#include <unistd.h>
#endif /* HAVE_UNISTD_H */
+#ifdef HAVE_PWD_H
+#include <pwd.h>
+#endif /* HAVE_PWD_H */
+
#ifndef R_OK
#define R_OK 4
#endif
@@ -174,9 +178,12 @@ static SCM *scm_loc_load_path;
/* List of extensions we try adding to the filenames. */
static SCM *scm_loc_load_extensions;
-/* Like %load-extensions, but for compiled files. */
+/* Like %load-path and %load-extensions, but for compiled files. */
+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),
@@ -209,6 +216,7 @@ scm_init_load_path ()
{
char *env;
SCM path = SCM_EOL;
+ SCM cpath = SCM_EOL;
#ifdef SCM_LIBRARY_DIR
env = getenv ("GUILE_SYSTEM_PATH");
@@ -222,13 +230,48 @@ scm_init_load_path ()
path = scm_list_3 (scm_from_locale_string (SCM_SITE_DIR),
scm_from_locale_string (SCM_LIBRARY_DIR),
scm_from_locale_string (SCM_PKGDATA_DIR));
+
+ env = getenv ("GUILE_SYSTEM_COMPILED_PATH");
+ if (env && strcmp (env, "") == 0)
+ /* like above */
+ ;
+ else if (env)
+ cpath = scm_parse_path (scm_from_locale_string (env), cpath);
+ else
+ {
+ char *home;
+
+ home = getenv ("HOME");
+#ifdef HAVE_GETPWENT
+ if (!home)
+ {
+ struct passwd *pwd;
+ pwd = getpwuid (getuid ());
+ if (pwd)
+ home = pwd->pw_dir;
+ }
+#endif /* HAVE_GETPWENT */
+ if (home)
+ { char buf[1024];
+ snprintf (buf, sizeof(buf),
+ "%s/.guile-ccache/" SCM_EFFECTIVE_VERSION, home);
+ cpath = scm_cons (scm_from_locale_string (buf), cpath);
+ }
+
+ cpath = scm_cons (scm_from_locale_string (SCM_CCACHE_DIR), cpath);
+ }
#endif /* SCM_LIBRARY_DIR */
env = getenv ("GUILE_LOAD_PATH");
if (env)
path = scm_parse_path (scm_from_locale_string (env), path);
+ env = getenv ("GUILE_LOAD_COMPILED_PATH");
+ if (env)
+ cpath = scm_parse_path (scm_from_locale_string (env), cpath);
+
*scm_loc_load_path = path;
+ *scm_loc_load_compiled_path = cpath;
}
SCM scm_listofnullstr;
@@ -508,66 +551,181 @@ SCM_DEFINE (scm_sys_search_load_path,
"%search-load-path", 1, 0, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0,
- (SCM filename),
+static int
+compiled_is_newer (SCM full_filename, SCM compiled_filename)
+{
+ char *source, *compiled;
+ struct stat stat_source, stat_compiled;
+ int res;
+
+ source = scm_to_locale_string (full_filename);
+ compiled = scm_to_locale_string (compiled_filename);
+
+ if (stat (source, &stat_source) == 0
+ && stat (compiled, &stat_compiled) == 0
+ && stat_source.st_mtime <= stat_compiled.st_mtime)
+ {
+ res = 1;
+ }
+ else
+ {
+ scm_puts (";;; note: source file ", scm_current_error_port ());
+ scm_puts (source, scm_current_error_port ());
+ scm_puts ("\n;;; newer than compiled ", scm_current_error_port ());
+ scm_puts (compiled, scm_current_error_port ());
+ scm_puts ("\n", scm_current_error_port ());
+ res = 0;
+
+ }
+ free (source);
+ free (compiled);
+ return res;
+}
+
+SCM_KEYWORD (k_output_file, "output-file");
+
+static SCM
+do_try_autocompile (void *data)
+{
+ SCM pair = PTR2SCM (data);
+ SCM comp_mod, compile_file, res;
+
+ scm_puts (";;; compiling ", scm_current_error_port ());
+ scm_display (scm_car (pair), 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_3 (scm_variable_ref (compile_file), scm_car (pair),
+ k_output_file, scm_cdr (pair));
+
+ 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 pair = PTR2SCM (data);
+ scm_puts (";;; WARNING: compilation of ", scm_current_error_port ());
+ scm_display (scm_car (pair), scm_current_error_port ());
+ scm_puts ("\n;;; to ", scm_current_error_port ());
+ scm_display (scm_cdr (pair), 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, SCM stale_compiled)
+{
+ static int message_shown = 0;
+ SCM comp_mod, compiled_file_name, new_compiled, pair;
+
+ 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;
+ }
+
+ comp_mod = scm_c_resolve_module ("system base compile");
+ compiled_file_name =
+ scm_module_variable (comp_mod,
+ scm_from_locale_symbol ("compiled-file-name"));
+
+ if (scm_is_false (compiled_file_name))
+ {
+ scm_puts (";;; it seems ", scm_current_error_port ());
+ scm_display (source, scm_current_error_port ());
+ scm_puts ("\n;;; is part of the compiler; skipping autocompilation\n",
+ scm_current_error_port ());
+ return SCM_BOOL_F;
+ }
+
+ new_compiled = scm_call_1 (scm_variable_ref (compiled_file_name), source);
+
+ if (scm_is_false (new_compiled))
+ return SCM_BOOL_F;
+ else if (!scm_is_true (scm_equal_p (new_compiled, stale_compiled))
+ && scm_is_true (scm_stat (new_compiled, SCM_BOOL_F))
+ && compiled_is_newer (source, new_compiled))
+ {
+ scm_puts (";;; found compiled file elsewhere: ",
+ scm_current_error_port ());
+ scm_display (new_compiled, scm_current_error_port ());
+ scm_newline (scm_current_error_port ());
+ return new_compiled;
+ }
+
+ pair = scm_cons (source, new_compiled);
+ return scm_c_catch (SCM_BOOL_T,
+ do_try_autocompile,
+ SCM2PTR (pair),
+ autocompile_catch_handler,
+ SCM2PTR (pair),
+ 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"
"load it into the top-level environment. If @var{filename} is a\n"
"relative pathname and is not found in the list of search paths,\n"
- "an error is signalled.")
+ "an error is signalled, unless the optional argument\n"
+ "@var{exception_on_not_found} is @code{#f}, in which case\n"
+ "@code{#f} is returned instead.")
#define FUNC_NAME s_scm_primitive_load_path
{
SCM full_filename, compiled_filename;
+ if (SCM_UNBNDP (exception_on_not_found))
+ exception_on_not_found = SCM_BOOL_T;
+
full_filename = scm_sys_search_load_path (filename);
- compiled_filename = scm_search_path (*scm_loc_load_path,
+ compiled_filename = scm_search_path (*scm_loc_load_compiled_path,
filename,
*scm_loc_load_compiled_extensions,
SCM_BOOL_T);
if (scm_is_false (full_filename) && scm_is_false (compiled_filename))
- SCM_MISC_ERROR ("Unable to find file ~S in load path",
- scm_list_1 (filename));
-
- if (scm_is_false (compiled_filename))
- return scm_primitive_load (full_filename);
+ {
+ if (scm_is_true (exception_on_not_found))
+ SCM_MISC_ERROR ("Unable to find file ~S in load path",
+ scm_list_1 (filename));
+ else
+ return SCM_BOOL_F;
+ }
- if (scm_is_false (full_filename))
+ if (scm_is_false (full_filename)
+ || (scm_is_true (compiled_filename)
+ && compiled_is_newer (full_filename, compiled_filename)))
return scm_load_compiled_with_vm (compiled_filename);
- {
- char *source, *compiled;
- struct stat stat_source, stat_compiled;
-
- source = scm_to_locale_string (full_filename);
- compiled = scm_to_locale_string (compiled_filename);
-
- if (stat (source, &stat_source) == 0
- && stat (compiled, &stat_compiled) == 0
- && stat_source.st_mtime <= stat_compiled.st_mtime)
- {
- free (source);
- free (compiled);
- return scm_load_compiled_with_vm (compiled_filename);
- }
- else
- {
- scm_puts (";;; note: source file ", scm_current_error_port ());
- scm_puts (source, scm_current_error_port ());
- scm_puts (" newer than compiled ", scm_current_error_port ());
- scm_puts (compiled, scm_current_error_port ());
- scm_puts ("\n", scm_current_error_port ());
- free (source);
- free (compiled);
- return scm_primitive_load (full_filename);
- }
- }
+ compiled_filename = scm_try_autocompile (full_filename, compiled_filename);
+ if (scm_is_true (compiled_filename))
+ return scm_load_compiled_with_vm (compiled_filename);
+ else
+ return scm_primitive_load (full_filename);
}
#undef FUNC_NAME
SCM
scm_c_primitive_load_path (const char *filename)
{
- return scm_primitive_load_path (scm_from_locale_string (filename));
+ return scm_primitive_load_path (scm_from_locale_string (filename),
+ SCM_BOOL_T);
}
@@ -600,11 +758,16 @@ scm_init_load ()
= SCM_VARIABLE_LOC (scm_c_define ("%load-extensions",
scm_list_2 (scm_from_locale_string
(".scm"),
scm_nullstr)));
+ scm_loc_load_compiled_path
+ = SCM_VARIABLE_LOC (scm_c_define ("%load-compiled-path", SCM_EOL));
scm_loc_load_compiled_extensions
= SCM_VARIABLE_LOC (scm_c_define ("%load-compiled-extensions",
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/load.h b/libguile/load.h
index 87f336e..0219873 100644
--- a/libguile/load.h
+++ b/libguile/load.h
@@ -33,7 +33,7 @@ SCM_API SCM scm_sys_library_dir (void);
SCM_API SCM scm_sys_site_dir (void);
SCM_API SCM scm_search_path (SCM path, SCM filename, SCM exts, SCM
require_exts);
SCM_API SCM scm_sys_search_load_path (SCM filename);
-SCM_API SCM scm_primitive_load_path (SCM filename);
+SCM_API SCM scm_primitive_load_path (SCM filename, SCM exception_on_not_found);
SCM_API SCM scm_c_primitive_load_path (const char *filename);
SCM_INTERNAL void scm_init_load_path (void);
SCM_INTERNAL void scm_init_load (void);
diff --git a/libguile/script.c b/libguile/script.c
index 14691c7..c61e85a 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))
diff --git a/meta/uninstalled-env.in b/meta/uninstalled-env.in
index d5c7949..b15237c 100644
--- a/meta/uninstalled-env.in
+++ b/meta/uninstalled-env.in
@@ -66,9 +66,26 @@ else
fi
export GUILE_LOAD_PATH
+if [ x"$GUILE_LOAD_COMPILED_PATH" = x ]
+then
+
GUILE_LOAD_COMPILED_PATH="${top_builddir}/guile-readline:${top_builddir}:${top_builddir}/module"
+else
+ for d in "${top_builddir}" "${top_builddir}/guile-readline" \
+ "${top_builddir}/module"
+ do
+ # This hair prevents double inclusion.
+ # The ":" prevents prefix aliasing.
+ case x"$GUILE_LOAD_COMPILED_PATH" in
+ x*${d}:*) ;;
+ *) GUILE_LOAD_COMPILED_PATH="${d}:$GUILE_LOAD_COMPILED_PATH" ;;
+ esac
+ done
+fi
+export GUILE_LOAD_COMPILED_PATH
+
# Don't look in installed dirs for guile modules
-if ( env | grep -v -q -E '^GUILE_SYSTEM_PATH=' ); then
- export GUILE_SYSTEM_PATH=
+if ( env | grep -v -q -E '^GUILE_SYSTEM_COMPILED_PATH=' ); then
+ export GUILE_SYSTEM_COMPILED_PATH=
fi
# handle LTDL_LIBRARY_PATH (no clobber)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 4406631..bb66ccf 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -611,12 +611,10 @@
(primitive-load-path "ice-9/networking"))
;; For reference, Emacs file-exists-p uses stat in this same way.
-;; ENHANCE-ME: Catching an exception from stat is a bit wasteful, do this in
-;; C where all that's needed is to inspect the return from stat().
(define file-exists?
(if (provided? 'posix)
(lambda (str)
- (->bool (false-if-exception (stat str))))
+ (->bool (stat str #f)))
(lambda (str)
(let ((port (catch 'system-error (lambda () (open-file str OPEN_READ))
(lambda args #f))))
@@ -2272,27 +2270,15 @@ module '(ice-9 q) '(make-q q-length))}."
(resolve-module dir-hint-module-name #f)
(and (not (autoload-done-or-in-progress? dir-hint name))
(let ((didit #f))
- (define (load-file proc file)
- (save-module-excursion (lambda () (proc file)))
- (set! didit #t))
(dynamic-wind
(lambda () (autoload-in-progress! dir-hint name))
(lambda ()
- (let ((file (in-vicinity dir-hint name)))
- (let ((compiled (and load-compiled
- (%search-load-path
- (string-append file ".go"))))
- (source (%search-load-path file)))
- (cond ((and source
- (or (not compiled)
- (< (stat:mtime (stat compiled))
- (stat:mtime (stat source)))))
- (if compiled
- (warn "source file" source "newer than" compiled))
- (with-fluid* current-reader #f
- (lambda () (load-file primitive-load source))))
- (compiled
- (load-file load-compiled compiled))))))
+ (with-fluid* current-reader #f
+ (lambda ()
+ (save-module-excursion
+ (lambda ()
+ (primitive-load-path (in-vicinity dir-hint name) #f)
+ (set! didit #t))))))
(lambda () (set-autoloaded! dir-hint name didit)))
didit))))
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index f6522f7..d5933ed 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -92,6 +92,65 @@
x
(lookup-language x)))
+;; Throws an exception if `dir' is not writable. The double-stat is OK,
+;; as this is only used during compilation.
+(define (ensure-writable-dir dir)
+ (if (file-exists? dir)
+ (if (access? dir W_OK)
+ #t
+ (error "directory not writable" dir))
+ (begin
+ (ensure-writable-dir (dirname dir))
+ (mkdir dir))))
+
+(define (dsu-sort list key less)
+ (map cdr
+ (stable-sort (map (lambda (x) (cons (key x) x)) list)
+ (lambda (x y) (less (car x) (car y))))))
+
+(define (compiled-file-name file)
+ (let ((cext (cond ((or (null? %load-compiled-extensions)
+ (string-null? (car %load-compiled-extensions)))
+ (warn "invalid %load-compiled-extensions"
+ %load-compiled-extensions)
+ ".go")
+ (else (car %load-compiled-extensions)))))
+ (define (strip-source-extension path)
+ (let lp ((exts %load-extensions))
+ (cond ((null? exts) file)
+ ((string-null? (car exts)) (lp (cdr exts)))
+ ((string-suffix? (car exts) path)
+ (substring path 0
+ (- (string-length path)
+ (string-length (car exts)))))
+ (else (lp (cdr exts))))))
+ ;; there is some trickery here. if no %load-compiled-path is a
+ ;; prefix of `file', the stability of the sort makes us end up
+ ;; trying to write first to last dir in the path, which is usually
+ ;; the $HOME ccache dir.
+ (let lp ((paths (dsu-sort (reverse %load-compiled-path)
+ (lambda (x)
+ (if (string-prefix? x file)
+ (string-length x)
+ 0))
+ >)))
+ (if (null? paths)
+ (error "no writable path when compiling" file)
+ (let ((rpath (in-vicinity
+ (car paths)
+ (string-append
+ (strip-source-extension
+ (if (string-prefix? (car paths) file)
+ (substring file (1+ (string-length (car paths))))
+ (substring file 1)))
+ cext))))
+ (if (and (false-if-exception
+ (ensure-writable-dir (dirname rpath)))
+ (or (not (file-exists? rpath))
+ (access? rpath W_OK)))
+ rpath
+ (lp (cdr paths))))))))
+
(define* (compile-file file #:key
(output-file #f)
(env #f)
@@ -100,6 +159,7 @@
(opts '()))
(let ((comp (or output-file (compiled-file-name file)))
(in (open-input-file file)))
+ (ensure-writable-dir (dirname comp))
(call-with-output-file/atomic comp
(lambda (port)
((language-printer (ensure-language to))
@@ -111,25 +171,6 @@
(read-and-compile (open-input-file file)
#:from from #:to to #:opts opts))
-(define (compiled-file-name file)
- (let ((base (basename file))
- (cext (cond ((or (null? %load-compiled-extensions)
- (string-null? (car %load-compiled-extensions)))
- (warn "invalid %load-compiled-extensions"
- %load-compiled-extensions)
- ".go")
- (else (car %load-compiled-extensions)))))
- (let lp ((exts %load-extensions))
- (cond ((null? exts) (string-append file cext))
- ((string-null? (car exts)) (lp (cdr exts)))
- ((string-suffix? (car exts) base)
- (string-append
- (dirname file) "/"
- (substring base 0
- (- (string-length base) (string-length (car exts))))
- cext))
- (else (lp (cdr exts)))))))
-
;;;
;;; Compiler interface
diff --git a/test-suite/tests/elisp.test b/test-suite/tests/elisp.test
index eaf6dbb..9e09970 100644
--- a/test-suite/tests/elisp.test
+++ b/test-suite/tests/elisp.test
@@ -23,6 +23,9 @@
(if *old-stack-level*
(debug-set! stack (* 2 *old-stack-level*)))
+(define *old-%load-should-autocompile* %load-should-autocompile)
+(set! %load-should-autocompile #f)
+
;;;
;;; elisp
;;;
@@ -350,6 +353,7 @@
))
+(set! %load-should-autocompile *old-%load-should-autocompile*)
(debug-set! stack *old-stack-level*)
;;; elisp.test ends here
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. c2521a212417b095475148e321daaf6e59ef5b3d,
Andy Wingo <=