guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-15-74-g6f


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-15-74-g6f06e8d
Date: Sun, 13 Feb 2011 14:12:35 +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=6f06e8d35f0780187c6bce62fe8ace8be055e727

The branch, master has been updated
       via  6f06e8d35f0780187c6bce62fe8ace8be055e727 (commit)
       via  c50775e2460da0c9fa49817fe22896d0369184ac (commit)
       via  6c51a40ace32a1540ffe6623ede64ce639b821fa (commit)
       via  d7265e376d27f6bf96bf60c01646ba8893acfba5 (commit)
      from  be90d0b6f9e79bc882b2289bf0a5ea1b3c082b3c (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 6f06e8d35f0780187c6bce62fe8ace8be055e727
Author: Andy Wingo <address@hidden>
Date:   Sun Feb 13 10:41:44 2011 +0100

    autocompile -> auto-compile
    
    * NEWS:
    * check-guile.in:
    * doc/guile.1:
    * doc/ref/scheme-scripts.texi:
    * libguile/init.c:
    * libguile/load.c:
    * libguile/load.h:
    * libguile/script.c:
    * module/Makefile.am:
    * module/ice-9/boot-9.scm:
    * module/scripts/compile.scm:
    * module/system/base/compile.scm:
    * test-suite/Makefile.am:
    * test-suite/tests/popen.test: Change "autocompile" to "auto-compile" or
      "auto_compile", as appropriate, in variable names, function names,
      command line arguments, and the documentation.

commit c50775e2460da0c9fa49817fe22896d0369184ac
Author: Andy Wingo <address@hidden>
Date:   Sat Feb 12 23:50:56 2011 +0100

    `load' is a macro (!) that resolves paths relative to source file dir
    
    * module/ice-9/boot-9.scm (load-in-vicinity): New helper, loads a file
      relative to a path.
      (load): Turn into a macro that captures the name of the source file
      being expanded, and dispatches to load-in-vicinity.  Referencing
      `load' by bare name returns a closure that embeds the current source
      file name.

commit 6c51a40ace32a1540ffe6623ede64ce639b821fa
Author: Andy Wingo <address@hidden>
Date:   Sun Feb 13 15:04:08 2011 +0100

    read-enable 'positions by default
    
    * libguile/read.c (scm_read_opts): Default "positions" to #t.  The
      compiler was already turning it on anyway, and this allows
      primitive-load without --auto-compile to also propagate source
      information through the expander, for better errors and to let macros
      know their source.
    
    * module/language/scheme/spec.scm: No need to enable positions here
      now.

commit d7265e376d27f6bf96bf60c01646ba8893acfba5
Author: Andy Wingo <address@hidden>
Date:   Sat Feb 12 22:19:28 2011 +0100

    use scm_c_make_struct in scm_values
    
    * libguile/values.c (scm_values): Micro-optimization.

-----------------------------------------------------------------------

Summary of changes:
 NEWS                            |    6 +-
 check-guile.in                  |    2 +-
 doc/guile.1                     |    4 +-
 doc/ref/scheme-scripts.texi     |    6 +-
 libguile/init.c                 |    2 +-
 libguile/load.c                 |   38 ++++----
 libguile/load.h                 |    6 +-
 libguile/read.c                 |    2 +-
 libguile/script.c               |   18 ++--
 libguile/values.c               |    5 +-
 module/Makefile.am              |    4 +-
 module/ice-9/boot-9.scm         |  204 +++++++++++++++++++++++----------------
 module/language/scheme/spec.scm |    8 +--
 module/scripts/compile.scm      |    6 +-
 module/system/base/compile.scm  |    2 +-
 test-suite/Makefile.am          |    2 +-
 test-suite/tests/popen.test     |    4 +-
 17 files changed, 174 insertions(+), 145 deletions(-)

diff --git a/NEWS b/NEWS
index 3c65d98..df44517 100644
--- a/NEWS
+++ b/NEWS
@@ -581,12 +581,12 @@ newer than that of the .scm file; if the .scm or .go 
files are moved
 after installation, care should be taken to preserve their original
 timestamps.
 
-Autocompiled files will be stored in the $XDG_CACHE_HOME/guile/ccache
+Auto-compiled files will be stored in the $XDG_CACHE_HOME/guile/ccache
 directory, where $XDG_CACHE_HOME defaults to ~/.cache. This directory
 will be created if needed.
 
-To inhibit autocompilation, set the GUILE_AUTO_COMPILE environment
-variable to 0, or pass --no-autocompile on the Guile command line.
+To inhibit automatic compilation, set the GUILE_AUTO_COMPILE environment
+variable to 0, or pass --no-auto-compile on the Guile command line.
 
 ** New POSIX procedures: `getrlimit' and `setrlimit'
 
diff --git a/check-guile.in b/check-guile.in
index 06b29c7..995199d 100644
--- a/check-guile.in
+++ b/check-guile.in
@@ -43,7 +43,7 @@ fi
 
 exec $guile \
     --debug \
-    --no-autocompile -e main -s "$TEST_SUITE_DIR/guile-test" \
+    --no-auto-compile -e main -s "$TEST_SUITE_DIR/guile-test" \
     --test-suite "$TEST_SUITE_DIR/tests" \
     --log-file check-guile.log "$@"
 
diff --git a/doc/guile.1 b/doc/guile.1
index 571638d..2d1fba9 100644
--- a/doc/guile.1
+++ b/doc/guile.1
@@ -60,9 +60,9 @@ conjuction with -s.
 .IP --debug
 Start guile with the debugging VM.  By default, on when invoked
 interactively, off otherwise.
-.IP --autocompile
+.IP --auto-compile
 Compile source files automatically (default behavior).
-.IP --no-autocompile
+.IP --no-auto-compile
 Disable automatic source file compilation.
 .IP --listen[=P]
 Listen on a port or socket for remote REPL connections.  See the manual
diff --git a/doc/ref/scheme-scripts.texi b/doc/ref/scheme-scripts.texi
index f6bf8b9..5a6f494 100644
--- a/doc/ref/scheme-scripts.texi
+++ b/doc/ref/scheme-scripts.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 
2010
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 
2010, 2011
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -219,12 +219,12 @@ development.
 
 @vnew{2.0}
 
address@hidden --autocompile
address@hidden --auto-compile
 Compile source files automatically (default behavior).
 
 @vnew{2.0}
 
address@hidden --no-autocompile
address@hidden --no-auto-compile
 Disable automatic source file compilation.
 
 @vnew{2.0}
diff --git a/libguile/init.c b/libguile/init.c
index 243e15e..9b8c4d0 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -546,7 +546,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
 
   atexit (cleanup_for_exit);
   scm_load_startup_files ();
-  scm_init_load_should_autocompile ();
+  scm_init_load_should_auto_compile ();
 
   /* Capture the dynamic state after loading boot-9, so that new threads end up
      in the guile-user module. */
diff --git a/libguile/load.c b/libguile/load.c
index cbf9dc0..cec59d1 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -207,9 +207,9 @@ 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;
+static SCM *scm_loc_load_should_auto_compile;
 
-/* The fallback path for autocompilation */
+/* The fallback path for auto-compilation */
 static SCM *scm_loc_compile_fallback_path;
 
 SCM_DEFINE (scm_parse_path, "parse-path", 1, 1, 0, 
@@ -669,7 +669,7 @@ compiled_is_fresh (SCM full_filename, SCM compiled_filename)
 SCM_KEYWORD (kw_env, "env");
 
 static SCM
-do_try_autocompile (void *data)
+do_try_auto_compile (void *data)
 {
   SCM source = PTR2SCM (data);
   SCM comp_mod, compile_file;
@@ -696,14 +696,14 @@ do_try_autocompile (void *data)
     {
       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_puts ("\n;;; is part of the compiler; skipping auto-compilation\n",
                 scm_current_error_port ());
       return SCM_BOOL_F;
     }
 }
 
 static SCM
-autocompile_catch_handler (void *data, SCM tag, SCM throw_args)
+auto_compile_catch_handler (void *data, SCM tag, SCM throw_args)
 {
   SCM source = PTR2SCM (data);
   scm_puts (";;; WARNING: compilation of ", scm_current_error_port ());
@@ -717,16 +717,16 @@ autocompile_catch_handler (void *data, SCM tag, SCM 
throw_args)
   return SCM_BOOL_F;
 }
 
-SCM_DEFINE (scm_sys_warn_autocompilation_enabled, 
"%warn-autocompilation-enabled", 0, 0, 0,
+SCM_DEFINE (scm_sys_warn_auto_compilation_enabled, 
"%warn-auto-compilation-enabled", 0, 0, 0,
            (void), "")
-#define FUNC_NAME s_scm_sys_warn_autocompilation_enabled
+#define FUNC_NAME s_scm_sys_warn_auto_compilation_enabled
 {
   static int message_shown = 0;
 
   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_puts (";;; note: auto-compilation is enabled, set 
GUILE_AUTO_COMPILE=0\n"
+                ";;;       or pass the --no-auto-compile argument to 
disable.\n",
                 scm_current_error_port ());
       message_shown = 1;
     }
@@ -736,16 +736,16 @@ SCM_DEFINE (scm_sys_warn_autocompilation_enabled, 
"%warn-autocompilation-enabled
 #undef FUNC_NAME
 
 static SCM
-scm_try_autocompile (SCM source)
+scm_try_auto_compile (SCM source)
 {
-  if (scm_is_false (*scm_loc_load_should_autocompile))
+  if (scm_is_false (*scm_loc_load_should_auto_compile))
     return SCM_BOOL_F;
 
-  scm_sys_warn_autocompilation_enabled ();
+  scm_sys_warn_auto_compilation_enabled ();
   return scm_c_catch (SCM_BOOL_T,
-                      do_try_autocompile,
+                      do_try_auto_compile,
                       SCM2PTR (source),
-                      autocompile_catch_handler,
+                      auto_compile_catch_handler,
                       SCM2PTR (source),
                       NULL, NULL);
 }
@@ -855,7 +855,7 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 
0, 0, 1,
 
   /* Otherwise, we bottom out here. */
   {
-    SCM freshly_compiled = scm_try_autocompile (full_filename);
+    SCM freshly_compiled = scm_try_auto_compile (full_filename);
 
     if (scm_is_true (freshly_compiled))
       return scm_load_compiled_with_vm (freshly_compiled);
@@ -933,8 +933,8 @@ scm_init_load ()
 
   scm_loc_compile_fallback_path
     = SCM_VARIABLE_LOC (scm_c_define ("%compile-fallback-path", SCM_BOOL_F));
-  scm_loc_load_should_autocompile
-    = SCM_VARIABLE_LOC (scm_c_define ("%load-should-autocompile", SCM_BOOL_F));
+  scm_loc_load_should_auto_compile
+    = SCM_VARIABLE_LOC (scm_c_define ("%load-should-auto-compile", 
SCM_BOOL_F));
 
   the_reader = scm_make_fluid ();
   scm_fluid_set_x (the_reader, SCM_BOOL_F);
@@ -950,9 +950,9 @@ scm_init_load ()
 }
 
 void
-scm_init_load_should_autocompile ()
+scm_init_load_should_auto_compile ()
 {
-  *scm_loc_load_should_autocompile =
+  *scm_loc_load_should_auto_compile =
     scm_from_bool (scm_getenv_int ("GUILE_AUTO_COMPILE", 1));
 }
   
diff --git a/libguile/load.h b/libguile/load.h
index d1afefb..0bddac2 100644
--- a/libguile/load.h
+++ b/libguile/load.h
@@ -3,7 +3,7 @@
 #ifndef SCM_LOAD_H
 #define SCM_LOAD_H
 
-/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008, 2009, 2010 Free 
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008, 2009, 2010, 2011 Free 
Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -37,10 +37,10 @@ SCM_API SCM scm_search_path (SCM path, SCM filename, SCM 
rest);
 SCM_API SCM scm_sys_search_load_path (SCM filename);
 SCM_API SCM scm_primitive_load_path (SCM filename_and_exception_on_not_found);
 SCM_API SCM scm_c_primitive_load_path (const char *filename);
-SCM_INTERNAL SCM scm_sys_warn_autocompilation_enabled (void);
+SCM_INTERNAL SCM scm_sys_warn_auto_compilation_enabled (void);
 SCM_INTERNAL void scm_init_load_path (void);
 SCM_INTERNAL void scm_init_load (void);
-SCM_INTERNAL void scm_init_load_should_autocompile (void);
+SCM_INTERNAL void scm_init_load_should_auto_compile (void);
 SCM_INTERNAL void scm_init_eval_in_scheme (void);
 
 #endif  /* SCM_LOAD_H */
diff --git a/libguile/read.c b/libguile/read.c
index 28a738e..5f0be31 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -66,7 +66,7 @@ SCM_SYMBOL (sym_nil, "nil");
 scm_t_option scm_read_opts[] = {
   { SCM_OPTION_BOOLEAN, "copy", 0,
     "Copy source code expressions." },
-  { SCM_OPTION_BOOLEAN, "positions", 0,
+  { SCM_OPTION_BOOLEAN, "positions", 1,
     "Record positions of source code expressions." },
   { SCM_OPTION_BOOLEAN, "case-insensitive", 0,
     "Convert symbols to lower case."},
diff --git a/libguile/script.c b/libguile/script.c
index b4dcd7b..bff7142 100644
--- a/libguile/script.c
+++ b/libguile/script.c
@@ -383,9 +383,9 @@ 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"
+           "  --auto-compile compile source files automatically\n"
+           "  --no-auto-compile disable automatic source file compilation\n"
+           "                 Default is to enable auto-compilation of source\n"
            "                 files.\n"
            "  --listen[=P]   Listen on a local port or a path for REPL 
clients.\n"
            "                 If P is not given, the default is local port 
37146.\n"
@@ -417,7 +417,7 @@ SCM_SYMBOL (sym_use_srfis, "use-srfis");
 SCM_SYMBOL (sym_load_path, "%load-path");
 SCM_SYMBOL (sym_load_extensions, "%load-extensions");
 SCM_SYMBOL (sym_set_x, "set!");
-SCM_SYMBOL (sym_sys_load_should_autocompile, "%load-should-autocompile");
+SCM_SYMBOL (sym_sys_load_should_auto_compile, "%load-should-auto-compile");
 SCM_SYMBOL (sym_cons, "cons");
 SCM_SYMBOL (sym_at, "@");
 SCM_SYMBOL (sym_atat, "@@");
@@ -612,14 +612,14 @@ scm_compile_shell_switches (int argc, char **argv)
          turn_on_debugging = 0;
        }
 
-      /* Do autocompile on/off now, because the form itself might need this
+      /* Do auto-compile on/off now, because the form itself might need this
          decision. */
-      else if (! strcmp (argv[i], "--autocompile"))
-        scm_variable_set_x (scm_c_lookup ("%load-should-autocompile"),
+      else if (! strcmp (argv[i], "--auto-compile"))
+        scm_variable_set_x (scm_c_lookup ("%load-should-auto-compile"),
                             SCM_BOOL_T);
 
-      else if (! strcmp (argv[i], "--no-autocompile"))
-        scm_variable_set_x (scm_c_lookup ("%load-should-autocompile"),
+      else if (! strcmp (argv[i], "--no-auto-compile"))
+        scm_variable_set_x (scm_c_lookup ("%load-should-auto-compile"),
                             SCM_BOOL_F);
 
       else if (! strcmp (argv[i], "-q")) /* don't load user init */ 
diff --git a/libguile/values.c b/libguile/values.c
index 967fcd6..8bbfc71 100644
--- a/libguile/values.c
+++ b/libguile/values.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2000, 2001, 2006, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2000, 2001, 2006, 2008, 2009, 2011 Free Software Foundation, 
Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -66,8 +66,7 @@ SCM_DEFINE (scm_values, "values", 0, 0, 1,
     result = SCM_CAR (args);
   else
     {
-      result = scm_make_struct (scm_values_vtable, SCM_INUM0,
-                               scm_list_1 (args));
+      result = scm_c_make_struct (scm_values_vtable, 0, 1, SCM_UNPACK (args));
     }
 
   return result;
diff --git a/module/Makefile.am b/module/Makefile.am
index f9fc367..9940900 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -1,6 +1,6 @@
 ## Process this file with automake to produce Makefile.in.
 ##
-##     Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+##     Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -75,7 +75,7 @@ ETAGS_ARGS +=                                 \
 
 include $(top_srcdir)/am/pre-inst-guile
 ice-9/psyntax-pp.scm.gen:
-       $(preinstguile) --no-autocompile -s $(srcdir)/ice-9/compile-psyntax.scm 
\
+       $(preinstguile) --no-auto-compile -s 
$(srcdir)/ice-9/compile-psyntax.scm \
                $(srcdir)/ice-9/psyntax.scm $(srcdir)/ice-9/psyntax-pp.scm
 
 .PHONY: ice-9/psyntax-pp.scm.gen
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 0c82a3b..09a285d 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1226,71 +1226,6 @@ VALUE."
 
 (set! %load-hook %load-announce)
 
-(define* (load name #: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
-  ;; date, and autocompilation is enabled, will try autocompilation, just
-  ;; as primitive-load-path does internally. primitive-load is
-  ;; unaffected. Returns #f if autocompilation failed or was disabled.
-  ;;
-  ;; NB: Unless we need to compile the file, this function should not cause
-  ;; (system base compile) to be loaded up. For that reason compiled-file-name
-  ;; partially duplicates functionality from (system base compile).
-  (define (compiled-file-name canon-path)
-    (and %compile-fallback-path
-         (string-append
-          %compile-fallback-path
-          ;; no need for '/' separator here, canon-path is absolute
-          canon-path
-          (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 (fresh-compiled-file-name go-path)
-    (catch #t
-      (lambda ()
-        (let* ((scmstat (stat name))
-               (gostat  (stat go-path #f)))
-          (if (and gostat
-                   (or (> (stat:mtime gostat) (stat:mtime scmstat))
-                       (and (= (stat:mtime gostat) (stat:mtime scmstat))
-                            (>= (stat:mtimensec gostat)
-                                (stat:mtimensec scmstat)))))
-              go-path
-              (begin
-                (if gostat
-                    (format (current-error-port)
-                            ";;; note: source file ~a\n;;;       newer than 
compiled ~a\n"
-                            name go-path))
-                (cond
-                 (%load-should-autocompile
-                  (%warn-autocompilation-enabled)
-                  (format (current-error-port) ";;; compiling ~a\n" name)
-                  ;; This use of @ is (ironically?) boot-safe, as modules have
-                  ;; not been booted yet, so the resolve-module call in psyntax
-                  ;; doesn't try to load a module, and compile-file will be
-                  ;; treated as a function, not a macro.
-                  (let ((cfn ((@ (system base compile) compile-file) name
-                              #:env (current-module))))
-                    (format (current-error-port) ";;; compiled ~a\n" cfn)
-                    cfn))
-                 (else #f))))))
-      (lambda (k . args)
-        (format (current-error-port)
-                ";;; WARNING: compilation of ~a failed:\n;;; key ~a, 
throw_args ~s\n"
-                name k args)
-        #f)))
-  (with-fluids ((current-reader reader))
-    (let ((cfn (and=> (and=> (false-if-exception (canonicalize-path name))
-                             compiled-file-name)
-                      fresh-compiled-file-name)))
-      (if cfn
-          (load-compiled cfn)
-          (start-stack 'load-stack
-                       (primitive-load name))))))
-
 
 
 ;;; {Reader Extensions}
@@ -1989,22 +1924,6 @@ VALUE."
                     (set-current-module outer-module)
                     (set! outer-module #f)))))
 
-(define basic-load load)
-
-(define* (load-module filename #:optional reader)
-  (save-module-excursion
-   (lambda ()
-     (let ((oldname (and (current-load-port)
-                         (port-filename (current-load-port)))))
-       (basic-load (if (and oldname
-                            (> (string-length filename) 0)
-                            (not (char=? (string-ref filename 0) #\/))
-                            (not (string=? (dirname oldname) ".")))
-                       (string-append (dirname oldname) "/" filename)
-                       filename)
-                   reader)))))
-
-
 
 
 ;;; {MODULE-REF -- exported}
@@ -2661,7 +2580,7 @@ module '(ice-9 q) '(make-q q-length))}."
                    ;; Here we could allow some other search strategy (other 
than
                    ;; primitive-load-path), for example using versions encoded
                    ;; into the file system -- but then we would have to figure
-                   ;; out how to locate the compiled file, do autocompilation,
+                   ;; out how to locate the compiled file, do auto-compilation,
                    ;; etc. Punt for now, and don't use versions when locating
                    ;; the file.
                    (primitive-load-path (in-vicinity dir-hint name) #f)
@@ -3194,8 +3113,6 @@ module '(ice-9 q) '(make-q q-length))}."
     ((_ name ...)
      (re-export name ...))))
 
-(define load load-module)
-
 
 
 ;;; {Parameters}
@@ -3319,6 +3236,125 @@ module '(ice-9 q) '(make-q q-length))}."
 
 
 
+;;; {`load'.}
+;;;
+;;; Load is tricky when combined with relative paths, compilation, and
+;;; the filesystem.  If a path is relative, what is it relative to?  The
+;;; path of the source file at the time it was compiled?  The path of
+;;; the compiled file?  What if both or either were installed?  And how
+;;; do you get that information?  Tricky, I say.
+;;;
+;;; To get around all of this, we're going to do something nasty, and
+;;; turn `load' into a macro.  That way it can know the path of the
+;;; source file with respect to which it was invoked, so it can resolve
+;;; relative paths with respect to the original source path.
+;;;
+;;; There is an exception, and that is that if the source file was in
+;;; the load path when it was compiled, instead of looking up against
+;;; the absolute source location, we load-from-path against the relative
+;;; source location.
+;;;
+
+(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
+  ;; date, and auto-compilation is enabled, will try auto-compilation, just
+  ;; as primitive-load-path does internally. primitive-load is
+  ;; unaffected. Returns #f if auto-compilation failed or was disabled.
+  ;;
+  ;; NB: Unless we need to compile the file, this function should not cause
+  ;; (system base compile) to be loaded up. For that reason compiled-file-name
+  ;; partially duplicates functionality from (system base compile).
+  ;;
+  (define (compiled-file-name canon-path)
+    (and %compile-fallback-path
+         (string-append
+          %compile-fallback-path
+          ;; no need for '/' separator here, canon-path is absolute
+          canon-path
+          (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 (fresh-compiled-file-name name go-path)
+    (catch #t
+      (lambda ()
+        (let* ((scmstat (stat name))
+               (gostat  (stat go-path #f)))
+          (if (and gostat
+                   (or (> (stat:mtime gostat) (stat:mtime scmstat))
+                       (and (= (stat:mtime gostat) (stat:mtime scmstat))
+                            (>= (stat:mtimensec gostat)
+                                (stat:mtimensec scmstat)))))
+              go-path
+              (begin
+                (if gostat
+                    (format (current-error-port)
+                            ";;; note: source file ~a\n;;;       newer than 
compiled ~a\n"
+                            name go-path))
+                (cond
+                 (%load-should-auto-compile
+                  (%warn-auto-compilation-enabled)
+                  (format (current-error-port) ";;; compiling ~a\n" name)
+                  (let ((cfn ((module-ref
+                               (resolve-interface '(system base compile))
+                               'compile-file)
+                              name
+                              #:env (current-module))))
+                    (format (current-error-port) ";;; compiled ~a\n" cfn)
+                    cfn))
+                 (else #f))))))
+      (lambda (k . args)
+        (format (current-error-port)
+                ";;; WARNING: compilation of ~a failed:\n;;; key ~a, 
throw_args ~s\n"
+                name k args)
+        #f)))
+
+  (define (absolute-path? path)
+    (string-prefix? "/" path))
+
+  (define (load-absolute abs-path)
+    (let ((cfn (let ((canon (false-if-exception (canonicalize-path abs-path))))
+                 (and canon
+                      (let ((go-path (compiled-file-name canon)))
+                        (and go-path
+                             (fresh-compiled-file-name abs-path go-path)))))))
+      (if cfn
+          (load-compiled cfn)
+          (start-stack 'load-stack
+                       (primitive-load abs-path)))))
+  
+  (save-module-excursion
+   (lambda ()
+     (with-fluids ((current-reader reader)
+                   (%file-port-name-canonicalization 'relative))
+       (cond
+        ((or (absolute-path? path))
+         (load-absolute path))
+        ((absolute-path? dir)
+         (load-absolute (in-vicinity dir path)))
+        (else
+         (load-from-path (in-vicinity dir path))))))))
+
+(define-syntax load
+  (make-variable-transformer
+   (lambda (x)
+     (let* ((src (syntax-source x))
+            (file (and src (assq-ref src 'filename)))
+            (dir (and (string? file) (dirname file))))
+       (syntax-case x ()
+         ((_ arg ...)
+          #`(load-in-vicinity #,(or dir #'(getcwd)) arg ...))
+         (id
+          (identifier? #'id)
+          #`(lambda args
+              (apply load-in-vicinity #,(or dir #'(getcwd)) args))))))))
+
+
+
 ;;; {`cond-expand' for SRFI-0 support.}
 ;;;
 ;;; This syntactic form expands into different commands or
diff --git a/module/language/scheme/spec.scm b/module/language/scheme/spec.scm
index 802a51d..0df4171 100644
--- a/module/language/scheme/spec.scm
+++ b/module/language/scheme/spec.scm
@@ -1,6 +1,6 @@
 ;;; Guile Scheme specification
 
-;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -26,12 +26,6 @@
   #:export (scheme))
 
 ;;;
-;;; Reader
-;;;
-
-(read-enable 'positions)
-
-;;;
 ;;; Language definition
 ;;;
 
diff --git a/module/scripts/compile.scm b/module/scripts/compile.scm
index f3853ff..9763d1d 100644
--- a/module/scripts/compile.scm
+++ b/module/scripts/compile.scm
@@ -1,6 +1,6 @@
 ;;; Compile --- Command-line Guile Scheme compiler  -*- coding: iso-8859-1 -*-
 
-;; Copyright 2005,2008,2009,2010 Free Software Foundation, Inc.
+;; Copyright 2005,2008,2009,2010,2011 Free Software Foundation, Inc.
 ;;
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public License
@@ -151,14 +151,14 @@ Compile each Guile source file FILE into a Guile object.
   -f, --from=LANG      specify a source language other than `scheme'
   -t, --to=LANG        specify a target language other than `objcode'
 
-Note that autocompilation will be turned off.
+Note that auto-compilation will be turned off.
 
 Report bugs to <~A>.~%"
                   %guile-bug-report-address)
           (exit 0)))
 
     (set! %load-path (append load-path %load-path))
-    (set! %load-should-autocompile #f)
+    (set! %load-should-auto-compile #f)
 
     (if (and output-file
              (or (null? input-files)
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index b4dfbcd..7d46713 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -118,7 +118,7 @@
                        (canonicalization 'relative))
   (with-fluids ((%file-port-name-canonicalization canonicalization))
     (let* ((comp (or output-file (compiled-file-name file)
-                     (error "failed to create path for autocompiled file"
+                     (error "failed to create path for auto-compiled file"
                             file)))
            (in (open-input-file file))
            (enc (file-encoding in)))
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 4d4b250..6cf1bd3 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -205,6 +205,6 @@ LALR_EXTRA +=                                       \
   lalr/run-guile-test.sh
 
 TESTS = $(LALR_TESTS)
-TESTS_ENVIRONMENT = $(top_builddir)/meta/guile --no-autocompile
+TESTS_ENVIRONMENT = $(top_builddir)/meta/guile --no-auto-compile
 
 EXTRA_DIST += $(LALR_EXTRA) $(LALR_TESTS) tests/sxml-match-tests.ss
diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test
index 5a92d60..6300c3b 100644
--- a/test-suite/tests/popen.test
+++ b/test-suite/tests/popen.test
@@ -1,6 +1,6 @@
 ;;;; popen.test --- exercise ice-9/popen.scm      -*- scheme -*-
 ;;;;
-;;;; Copyright 2003, 2006, 2010 Free Software Foundation, Inc.
+;;;; Copyright 2003, 2006, 2010, 2011 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -168,7 +168,7 @@
           (port (with-error-to-port (cdr c2p)
                   (lambda ()
                     (open-output-pipe
-                      (string-append "guile --no-autocompile -s \""
+                      (string-append "guile --no-auto-compile -s \""
                                      (getenv "TEST_SUITE_DIR")
                                      "/tests/popen-child.scm\""))))))
       (close-port (cdr c2p))   ;; write side


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]