[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-37-gb321908

[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=b3219085d92f6ab67347f251b651a65c3a7b6c1e

The branch, stable-2.0 has been updated
       via  b3219085d92f6ab67347f251b651a65c3a7b6c1e (commit)
       via  f6fd2c03a5f8b910e666b91b73e94da9eb6d03a2 (commit)
      from  7f420e49e462ae8faa60d61358ce4e1fdbbb0f21 (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 b3219085d92f6ab67347f251b651a65c3a7b6c1e
Author: Andy Wingo <address@hidden>
Date:   Mon Jan 21 19:07:19 2013 +0100

    read-and-compile closes input file after seeing EOF
    
    * module/system/base/compile.scm (read-and-compile): Close the input
      port after we read all of its data.  Perhaps this cleans up some NFS
      ghosts that David Pirotte was seeing.

commit f6fd2c03a5f8b910e666b91b73e94da9eb6d03a2
Author: Andy Wingo <address@hidden>
Date:   Sun Jan 20 19:33:42 2013 +0100

    fix try-module-autoload, which did not detect failure to find the file
    
    * libguile/load.c (scm_primitive_load_path): If the second argument is a
      procedure, call it like a thunk.
    
    * doc/ref/api-evaluation.texi (Load Paths): Update docs.
    
    * module/ice-9/boot-9.scm (resolve-interface): Use `unless'.
      (try-module-autoload): Use the new primitive-load-path to detect
      failure to find an appropriate file.  Fixes a bug reported by Diogo
      F. S. Ramos.  Thanks to Noah Lavine for tracking it down.

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

Summary of changes:
 doc/ref/api-evaluation.texi    |   21 +++++++++++++--------
 libguile/load.c                |   22 +++++++++++++---------
 module/ice-9/boot-9.scm        |   29 +++++++++++++++++++++--------
 module/system/base/compile.scm |    3 ++-
 4 files changed, 49 insertions(+), 26 deletions(-)

diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 2e5a3d2..f80d7ad 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.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, 
2006, 2009, 2010, 2011, 2012
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 
2006, 2009, 2010, 2011, 2012, 2013
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -878,15 +878,20 @@ of modifying the path both at compile-time and at 
run-time.
 Search @code{%load-path} for the file named @var{filename} and
 load it into the top-level environment.  If @var{filename} is a
 relative pathname and is not found in the list of search paths,
-an error is signalled. Preferentially loads a compiled version of the
+an error is signalled.  Preferentially loads a compiled version of the
 file, if it is available and up-to-date.
 
-By default or if @var{exception-on-not-found} is true, an exception is
-raised if @var{filename} is not found.  If @var{exception-on-not-found}
-is @code{#f} and @var{filename} is not found, no exception is raised and
address@hidden is returned.  For compatibility with Guile 1.8 and earlier,
-the C function takes only one argument, which can be either a string
-(the file name) or an argument list.
+If @var{filename} is a relative pathname and is not found in the list of
+search paths, one of three things may happen, depending on the optional
+second argument, @var{exception-on-not-found}.  If it is @code{#f},
address@hidden will be returned.  If it is a procedure, it will be called
+with no arguments.  (This allows a distinction to be made between
+exceptions raised by loading a file, and exceptions related to the
+loader itself.)  Otherwise an error is signalled.
+
+For compatibility with Guile 1.8 and earlier, the C function takes only
+one argument, which can be either a string (the file name) or an
+argument list.
 @end deffn
 
 @deffn {Scheme Procedure} %search-load-path filename
diff --git a/libguile/load.c b/libguile/load.c
index 723f3fd..84b6705 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2004, 2006, 2008,
- *   2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+ *   2009, 2010, 2011, 2012, 2013 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
@@ -846,11 +846,13 @@ canonical_suffix (SCM fname)
 SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
            (SCM args),
            "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, unless the optional argument\n"
-            "@var{exception_on_not_found} is @code{#f}, in which case\n"
-            "@code{#f} is returned instead.")
+           "load it into the top-level environment.\n\n"
+            "If @var{filename} is a relative pathname and is not found in\n"
+            "the list of search paths, one of three things may happen,\n"
+            "depending on the optional second argument,\n"
+            "@var{exception_on_not_found}.  If it is @code{#f}, @code{#f}\n"
+            "will be returned.  If it is a procedure, it will be called\n"
+            "with no arguments.  Otherwise an error is signalled.")
 #define FUNC_NAME s_scm_primitive_load_path
 {
   SCM filename, exception_on_not_found;
@@ -924,11 +926,13 @@ SCM_DEFINE (scm_primitive_load_path, 
"primitive-load-path", 0, 0, 1,
   
   if (scm_is_false (full_filename) && scm_is_false (compiled_filename))
     {
-      if (scm_is_true (exception_on_not_found))
+      if (scm_is_true (scm_procedure_p (exception_on_not_found)))
+        return scm_call_0 (exception_on_not_found);
+      else if (scm_is_false (exception_on_not_found))
+        return SCM_BOOL_F;
+      else
         SCM_MISC_ERROR ("Unable to find file ~S in load path",
                         scm_list_1 (filename));
-      else
-        return SCM_BOOL_F;
     }
 
   if (!scm_is_false (hook))
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index e426374..77bb84a 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1,7 +1,7 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
 
 ;;;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;;;;   2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
+;;;;   2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013
 ;;;;   Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -2593,8 +2593,8 @@ VALUE."
                             version)
   (let* ((module (resolve-module name #t version #:ensure #f))
          (public-i (and module (module-public-interface module))))
-    (and (or (not module) (not public-i))
-         (error "no code for module" name))
+    (unless public-i
+      (error "no code for module" name))
     (if (and (not select) (null? hide) (eq? renamer identity))
         public-i
         (let ((selection (or select (module-map (lambda (sym var) sym)
@@ -2765,10 +2765,13 @@ module '(ice-9 q) '(make-q q-length))}."
 
 (define autoloads-in-progress '())
 
-;; This function is called from "modules.c".  If you change it, be
-;; sure to update "modules.c" as well.
-
+;; This function is called from scm_load_scheme_module in
+;; "deprecated.c".  Please do not change its interface.
+;;
 (define* (try-module-autoload module-name #:optional version)
+  "Try to load a module of the given name.  If it is not found, return
+#f.  Otherwise return #t.  May raise an exception if a file is found,
+but it fails to load."
   (let* ((reverse-name (reverse module-name))
          (name (symbol->string (car reverse-name)))
          (dir-hint-module-name (reverse (cdr reverse-name)))
@@ -2785,6 +2788,13 @@ module '(ice-9 q) '(make-q q-length))}."
               (with-fluids ((current-reader #f))
                 (save-module-excursion
                  (lambda () 
+                   (define (call/ec proc)
+                     (let ((tag (make-prompt-tag)))
+                       (call-with-prompt
+                        tag
+                        (lambda ()
+                          (proc (lambda () (abort-to-prompt tag))))
+                        (lambda (k) (values)))))
                    ;; The initial environment when loading a module is a fresh
                    ;; user module.
                    (set-current-module (make-fresh-user-module))
@@ -2794,8 +2804,11 @@ module '(ice-9 q) '(make-q q-length))}."
                    ;; 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)
-                   (set! didit #t)))))
+                   (call/ec
+                    (lambda (abort)
+                      (primitive-load-path (in-vicinity dir-hint name)
+                                           abort)
+                      (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 afcb55a..1c3320a 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -1,6 +1,6 @@
 ;;; High-level compiler interface
 
-;; Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 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
@@ -200,6 +200,7 @@
           (let ((x ((language-reader (current-language)) port cenv)))
             (cond
              ((eof-object? x)
+              (close-port port)
               (compile ((language-joiner joint) (reverse exps) env)
                        #:from joint #:to to
                        ;; env can be false if no expressions were read.


hooks/post-receive
-- 
GNU Guile