[Guile-commits] GNU Guile branch, master, updated. release_1-9-2-3-g9591a2b

[Andy Wingo]

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=9591a2b016c5c11d2cd92ff0d43cd511f28bc07f

The branch, master has been updated
       via  9591a2b016c5c11d2cd92ff0d43cd511f28bc07f (commit)
      from  e33a910dd0f430f34c32fe6846899aee33fc2cf6 (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 9591a2b016c5c11d2cd92ff0d43cd511f28bc07f
Author: Andy Wingo <address@hidden>
Date:   Tue Aug 18 11:05:17 2009 +0200

    `load' autocompiles
    
    * libguile/load.h:
    * libguile/load.c (scm_sys_warn_autocompilation_enabled): New primitive,
      not exported. Since `load' autocompiles now, it should warn in the
      same way that the bits hardcoded into C warn.
      (scm_try_autocompile): Use scm_sys_warn_autocompilation_enabled.
    
    * module/ice-9/boot-9.scm (autocompiled-file-name): New helper.
      (load): Try autocompiling the argument, if appropriate. Will
      autocompile files passed on Guile's command line. `primitive-load' is
      unaffected.

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

Summary of changes:
 libguile/load.c         |   18 +++++++++++++-----
 libguile/load.h         |    1 +
 module/ice-9/boot-9.scm |   39 +++++++++++++++++++++++++++++++++++++--
 3 files changed, 51 insertions(+), 7 deletions(-)

diff --git a/libguile/load.c b/libguile/load.c
index 08324c5..8a6fadb 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -639,14 +639,11 @@ autocompile_catch_handler (void *data, SCM tag, SCM 
throw_args)
   return SCM_BOOL_F;
 }
 
-static SCM
-scm_try_autocompile (SCM source)
+SCM_DEFINE (scm_sys_warn_autocompilation_enabled, 
"%warn-autocompilation-enabled", 0, 0, 0,
+           (void), "")
 {
   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"
@@ -655,6 +652,17 @@ scm_try_autocompile (SCM source)
       message_shown = 1;
     }
 
+  return SCM_UNSPECIFIED;
+}
+
+  
+static SCM
+scm_try_autocompile (SCM source)
+{
+  if (scm_is_false (*scm_loc_load_should_autocompile))
+    return SCM_BOOL_F;
+
+  scm_sys_warn_autocompilation_enabled ();
   return scm_c_catch (SCM_BOOL_T,
                       do_try_autocompile,
                       SCM2PTR (source),
diff --git a/libguile/load.h b/libguile/load.h
index d5bc1b0..1a1a865 100644
--- a/libguile/load.h
+++ b/libguile/load.h
@@ -36,6 +36,7 @@ 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 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 void scm_init_load_path (void);
 SCM_INTERNAL void scm_init_load (void);
 
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 01569cb..574cb2b 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -867,11 +867,46 @@
 
 (set! %load-hook %load-announce)
 
+;;; 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.
+(define (autocompiled-file-name name)
+  (catch #t
+    (lambda ()
+      (let* ((cfn ((@ (system base compile) compiled-file-name) name))
+             (scmstat (stat name))
+             (gostat (stat cfn #f)))
+        (if (and gostat (= (stat:mtime gostat) (stat:mtime scmstat)))
+            cfn
+            (begin
+              (if gostat
+                  (format (current-error-port)
+                    ";;; note: source file ~a\n;;;       newer than compiled 
~a\n"
+                    name cfn))
+              (cond
+               (%load-should-autocompile
+                (%warn-autocompilation-enabled)
+                (format (current-error-port) ";;; compiling ~a\n" name)
+                (let ((cfn ((@ (system base compile) compile-file) name)))
+                  (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 (load name . reader)
   (with-fluid* current-reader (and (pair? reader) (car reader))
     (lambda ()
-      (start-stack 'load-stack
-                  (primitive-load name)))))
+      (let ((cfn (autocompiled-file-name name)))
+        (if cfn
+            (load-compiled cfn)
+            (start-stack 'load-stack
+                         (primitive-load name)))))))
 
 
 


hooks/post-receive
-- 
GNU Guile