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. 5ea401bffe2ea60545338


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. 5ea401bffe2ea60545338a48767f4c75d48642c7
Date: Thu, 04 Jun 2009 23:20:02 +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=5ea401bffe2ea60545338a48767f4c75d48642c7

The branch, master has been updated
       via  5ea401bffe2ea60545338a48767f4c75d48642c7 (commit)
      from  b193d904bb9e8c1f8aa8b4a985b03aa59c4e6a21 (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 5ea401bffe2ea60545338a48767f4c75d48642c7
Author: Andy Wingo <address@hidden>
Date:   Fri Jun 5 01:20:19 2009 +0200

    further autocompilation tweaks
    
    * module/system/base/compile.scm (compiled-file-name):
    * libguile/load.c (scm_init_load_path, scm_try_autocompile)
      (scm_primitive_load_path): Rework so that we search for .go files in
      the load-compiled path and in the fallback path, but we only
      autocompile to the fallback path. Should produce a more desirable 
experience.

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

Summary of changes:
 libguile/load.c                |   78 ++++++++++++++++++++++------------------
 module/system/base/compile.scm |   74 +++++++++++++++++---------------------
 2 files changed, 76 insertions(+), 76 deletions(-)

diff --git a/libguile/load.c b/libguile/load.c
index 4e127d6..f54015b 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -185,6 +185,9 @@ static SCM *scm_loc_load_compiled_extensions;
 /* Whether we should try to auto-compile. */
 static SCM *scm_loc_load_should_autocompile;
 
+/* The fallback path for autocompilation */
+static SCM *scm_loc_compile_fallback_path;
+
 SCM_DEFINE (scm_parse_path, "parse-path", 1, 1, 0, 
             (SCM path, SCM tail),
            "Parse @var{path}, which is expected to be a colon-separated\n"
@@ -239,6 +242,10 @@ scm_init_load_path ()
     cpath = scm_parse_path (scm_from_locale_string (env), cpath);
   else
     {
+      /* the idea: if GUILE_SYSTEM_COMPILED_PATH is set, then it seems we're 
working
+         against an uninstalled Guile, in which case we shouldn't be 
autocompiling,
+         otherwise offer up the user's home directory as penance for not having
+         up-to-date .go files. */
       char *home;
 
       home = getenv ("HOME");
@@ -255,9 +262,9 @@ scm_init_load_path ()
         { char buf[1024];
           snprintf (buf, sizeof(buf),
                     "%s/.guile-ccache/" SCM_EFFECTIVE_VERSION, home);
-          cpath = scm_cons (scm_from_locale_string (buf), cpath);
+          *scm_loc_compile_fallback_path = scm_from_locale_string (buf);
         }
-      
+
       cpath = scm_cons (scm_from_locale_string (SCM_CCACHE_DIR), cpath);
     }
 #endif /* SCM_LIBRARY_DIR */
@@ -624,10 +631,10 @@ autocompile_catch_handler (void *data, SCM tag, SCM 
throw_args)
 }
 
 static SCM
-scm_try_autocompile (SCM source, SCM stale_compiled)
+scm_try_autocompile (SCM source, SCM compiled)
 {
   static int message_shown = 0;
-  SCM comp_mod, compiled_file_name, new_compiled, pair;
+  SCM pair;
   
   if (scm_is_false (*scm_loc_load_should_autocompile))
     return SCM_BOOL_F;
@@ -640,36 +647,7 @@ scm_try_autocompile (SCM source, SCM stale_compiled)
       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);
+  pair = scm_cons (source, compiled);
   return scm_c_catch (SCM_BOOL_T,
                       do_try_autocompile,
                       SCM2PTR (pair),
@@ -699,6 +677,31 @@ SCM_DEFINE (scm_primitive_load_path, 
"primitive-load-path", 1, 1, 0,
                                        *scm_loc_load_compiled_extensions,
                                        SCM_BOOL_T);
 
+  if (scm_is_false (compiled_filename)
+      && scm_is_true (full_filename)
+      && scm_is_true (*scm_loc_compile_fallback_path))
+    {
+      SCM comp_mod, compiled_file_name;
+
+      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 (full_filename, scm_current_error_port ());
+          scm_puts ("\n;;; is part of the compiler; skipping 
autocompilation\n",
+                    scm_current_error_port ());
+          return SCM_BOOL_F;
+        }
+
+      /* very confusing var names ... */
+      compiled_filename = scm_call_1 (scm_variable_ref (compiled_file_name),
+                                      full_filename);
+    }
+  
   if (scm_is_false (full_filename) && scm_is_false (compiled_filename))
     {
       if (scm_is_true (exception_on_not_found))
@@ -713,7 +716,9 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 
1, 1, 0,
           && compiled_is_newer (full_filename, compiled_filename)))
     return scm_load_compiled_with_vm (compiled_filename);
 
-  compiled_filename = scm_try_autocompile (full_filename, compiled_filename);
+  if (scm_is_true (compiled_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
@@ -765,6 +770,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_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));
 
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index d5933ed..77a3fe1 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -108,48 +108,40 @@
        (stable-sort (map (lambda (x) (cons (key x) x)) list)
                     (lambda (x y) (less (car x) (car y))))))
 
+;;; This function is among the trickiest I've ever written. I tried many
+;;; variants. In the end, simple is best, of course.
+;;;
+;;; After turning this around a number of times, it seems that the the
+;;; desired behavior is that .go files should exist in a path, for
+;;; searching. That is orthogonal to this function. For writing .go
+;;; files, either you know where they should go, in which case you pass
+;;; the path directly, assuming they will end up in the path, as in the
+;;; srcdir != builddir case; or you don't know, in which case this
+;;; function is called, and we just put them in your own ccache dir in
+;;; ~/.guile-ccache.
 (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 (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))))))
+  (define (compiled-extension)
+    (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))))
+  (and %compile-fallback-path
+       (let ((f (string-append %compile-fallback-path "/"
+                               (strip-source-extension file)
+                               (compiled-extension))))
+         (and (false-if-exception (ensure-writable-dir (dirname f)))
+              f))))
 
 (define* (compile-file file #:key
                        (output-file #f)


hooks/post-receive
-- 
GNU Guile




reply via email to

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