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-6-33-gdca


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-6-33-gdca1401
Date: Tue, 22 Dec 2009 19:51:00 +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=dca14012bd9c62178890ff82d29c655ae71d2977

The branch, master has been updated
       via  dca14012bd9c62178890ff82d29c655ae71d2977 (commit)
       via  78c22f5edc3c74bc50e52d5291ddc5c80c20ba8a (commit)
      from  820f33aaed18b37f68bc4abfeea52df2df3bd374 (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 dca14012bd9c62178890ff82d29c655ae71d2977
Author: Julian Graham <address@hidden>
Date:   Tue Dec 22 00:33:12 2009 +0100

    Complete support for version information in Guile's `module' form.
    
    * module/ice-9/boot-9.scm (try-load-module, try-module-autoload): Check
      for version argument and use `find-versioned-module' if present.
    * module/ice-9/boot-9.scm (find-versioned-module, version-matches?)
      (module-version, set-module-version!, version-matches?): New
      functions.
    * module/ice-9/boot-9.scm (module-type, make-module, resolve-module)
      (try-load-module, process-define-module, make-autoload-interface)
      (compile-interface-spec): Add awareness and checking of version
      information.
    * doc/ref/api-modules.texi (R6RS Version References): New subsubsection.
      (General Information about Modules): Explain differences in search
      process when version references are used.
      (Using Guile Modules) (Creating Guile Modules): Document `#:version'
      keyword.

commit 78c22f5edc3c74bc50e52d5291ddc5c80c20ba8a
Author: Julian Graham <address@hidden>
Date:   Thu Dec 10 00:29:11 2009 -0500

    Support for renaming bindings on module export.
    
    * module/ice-9/boot-9.scm (module-export!, module-replace!)
      (module-re-export!): Allow members of export list to be pairs, mapping
      internal names to external ones.
    
    * doc/ref/api-modules.texi (Creating Guile Modules): Update
      documentation for `#:export', `#:export-syntax', `#:replace',
      `#:re-export', `#:re-export-syntax', `export', and `re-export' to
      reflect new format for arguments.

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

Summary of changes:
 doc/ref/api-modules.texi |  175 ++++++++++++++++++++++++++++++++++++++++------
 module/ice-9/boot-9.scm  |  169 ++++++++++++++++++++++++++++++++++++++------
 2 files changed, 299 insertions(+), 45 deletions(-)

diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi
index d528a81..a717386 100644
--- a/doc/ref/api-modules.texi
+++ b/doc/ref/api-modules.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, 2007, 
2008
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 
2008, 2009
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -152,6 +152,7 @@ there is still some flux.
 * Module System Reflection::    Accessing module objects at run-time.
 * Included Guile Modules::      Which modules come with Guile?
 * Accessing Modules from C::    How to work with modules with C code.
+* R6RS Version References::     Using version numbers with modules.
 @end menu
 
 @node General Information about Modules
@@ -194,6 +195,21 @@ would result in the filename @code{ice-9/popen.scm} and 
searched in the
 installation directories of Guile and in all other directories in the
 load path.
 
+A slightly different search mechanism is used when a client module
+specifies a version reference as part of a request to load a module
+(@pxref{R6RS Version References}).  Instead of searching the directories
+in the load path for a single filename, Guile uses the elements of the 
+version reference to locate matching, numbered subdirectories of a 
+constructed base path.  For example, a request for the 
address@hidden(rnrs base)} module with version reference @code{(6)} would cause
+Guile to discover the @code{rnrs/6} subdirectory (if it exists in any of
+the directories in the load path) and search its contents for the
+filename @code{base.scm}.
+
+When multiple modules are found that match a version reference, Guile
+sorts these modules by version number, followed by the length of their
+version specifications, in order to choose a ``best'' match.
+
 @c FIXME::martin:  Not sure about this, maybe someone knows better?
 Every module has a so-called syntax transformer associated with it.
 This is a procedure which performs all syntax transformation for the
@@ -319,6 +335,21 @@ omitted, the returned interface has no bindings.  If the 
@code{:select}
 clause is omitted, @var{renamer} operates on the used module's public
 interface.
 
+In addition to the above, @var{spec} can also include a @code{:version} 
+clause, of the form:
+
address@hidden
+ :version VERSION-SPEC
address@hidden lisp
+
+where @var{version-spec} is an R6RS-compatible version reference.  The 
+presence of this clause changes Guile's search behavior as described in
+the section on module name resolution 
+(@pxref{General Information about Modules}).  An error will be signaled 
+in the case in which a module with the same name has already been 
+loaded, if that module specifies a version and that version is not 
+compatible with @var{version-spec}.
+
 Signal error if module name is not resolvable.
 @end deffn
 
@@ -416,40 +447,42 @@ the module is used.
 
 @item #:export @var{list}
 @cindex export
-Export all identifiers in @var{list} which must be a list of symbols.
-This is equivalent to @code{(export @var{list})} in the module body.
+Export all identifiers in @var{list} which must be a list of symbols
+or pairs of symbols. This is equivalent to @code{(export @var{list})} 
+in the module body.
 
 @item #:re-export @var{list}
 @cindex re-export
 Re-export all identifiers in @var{list} which must be a list of
-symbols.  The symbols in @var{list} must be imported by the current
-module from other modules.  This is equivalent to @code{re-export}
-below.
+symbols or pairs of symbols.  The symbols in @var{list} must be 
+imported by the current module from other modules.  This is equivalent
+to @code{re-export} below.
 
 @item #:export-syntax @var{list}
 @cindex export-syntax
-Export all identifiers in @var{list} which must be a list of symbols.
-The identifiers in @var{list} must refer to macros (@pxref{Macros})
-defined in the current module.  This is equivalent to
address@hidden(export-syntax @var{list})} in the module body.
+Export all identifiers in @var{list} which must be a list of symbols
+or pairs of symbols.  The identifiers in @var{list} must refer to 
+macros (@pxref{Macros}) defined in the current module.  This is 
+equivalent to @code{(export-syntax @var{list})} in the module body.
 
 @item #:re-export-syntax @var{list}
 @cindex re-export-syntax
 Re-export all identifiers in @var{list} which must be a list of
-symbols.  The symbols in @var{list} must refer to macros imported by
-the current module from other modules.  This is equivalent to
address@hidden(re-export-syntax @var{list})} in the module body. 
+symbols or pairs of symbols.  The symbols in @var{list} must refer to
+macros imported by the current module from other modules.  This is 
+equivalent to @code{(re-export-syntax @var{list})} in the module body. 
 
 @item #:replace @var{list}
 @cindex replace
 @cindex replacing binding
 @cindex overriding binding
 @cindex duplicate binding
-Export all identifiers in @var{list} (a list of symbols) and mark them
-as @dfn{replacing bindings}.  In the module user's name space, this
-will have the effect of replacing any binding with the same name that
-is not also ``replacing''.  Normally a replacement results in an
-``override'' warning message, @code{#:replace} avoids that.
+Export all identifiers in @var{list} (a list of symbols or pairs of
+symbols) and mark them as @dfn{replacing bindings}.  In the module 
+user's name space, this will have the effect of replacing any binding 
+with the same name that is not also ``replacing''.  Normally a 
+replacement results in an ``override'' warning message, 
address@hidden:replace} avoids that.
 
 This is useful for modules that export bindings that have the same
 name as core bindings.  @code{#:replace}, in a sense, lets Guile know
@@ -478,6 +511,13 @@ instead of a comparison.
 The @code{#:duplicates} (see below) provides fine-grain control about
 duplicate binding handling on the module-user side.
 
address@hidden #:version @var{list}
address@hidden module version
+Specify a version for the module in the form of @var{list}, a list of
+zero or more exact, nonnegative integers.  The corresponding 
address@hidden:version} option in the @code{use-modules} form allows callers
+to restrict the value of this option in various ways.
+
 @item #:duplicates @var{list}
 @cindex duplicate binding handlers
 @cindex duplicate binding
@@ -557,8 +597,11 @@ do not know anything about dangerous procedures.
 @c end
 
 @deffn syntax export variable @dots{}
-Add all @var{variable}s (which must be symbols) to the list of exported
-bindings of the current module.
+Add all @var{variable}s (which must be symbols or pairs of symbols) to 
+the list of exported bindings of the current module.  If @var{variable}
+is a pair, its @code{car} gives the name of the variable as seen by the
+current module and its @code{cdr} specifies a name for the binding in
+the current module's public interface.
 @end deffn
 
 @c begin (scm-doc-string "boot-9.scm" "define-public")
@@ -568,9 +611,10 @@ Equivalent to @code{(begin (define foo ...) (export foo))}.
 @c end
 
 @deffn syntax re-export variable @dots{}
-Add all @var{variable}s (which must be symbols) to the list of
-re-exported bindings of the current module.  Re-exported bindings must
-be imported by the current module from some other module.
+Add all @var{variable}s (which must be symbols or pairs of symbols) to 
+the list of re-exported bindings of the current module.  Pairs of 
+symbols are handled as in @code{export}.  Re-exported bindings must be
+imported by the current module from some other module.
 @end deffn
 
 @node Module System Reflection
@@ -849,6 +893,91 @@ of the current module.  The list of names is terminated by
 @code{NULL}.
 @end deftypefn
 
+
address@hidden R6RS Version References
address@hidden R6RS Version References
+
+Guile's module system includes support for locating modules based on
+a declared version specifier of the same form as the one described in
+R6RS (@pxref{Library form, R6RS Library Form,, r6rs, The Revised^6 
+Report on the Algorithmic Language Scheme}).  By using the 
address@hidden:version} keyword in a @code{define-module} form, a module may
+specify a version as a list of zero or more exact, nonnegative integers.
+
+This version can then be used to locate the module during the module
+search process.  Client modules and callers of the @code{use-modules} 
+function may specify constraints on the versions of target modules by
+providing a @dfn{version reference}, which has one of the following
+forms:
+
address@hidden
+ (@var{sub-version-reference} ...)
+ (and @var{version-reference} ...)
+ (or @var{version-reference} ...)
+ (not @var{version-reference})
address@hidden lisp
+
+in which @var{sub-version-reference} is in turn one of:
+
address@hidden
+ (@var{sub-version})
+ (>= @var{sub-version})
+ (<= @var{sub-version})
+ (and @var{sub-version-reference} ...)
+ (or @var{sub-version-reference} ...)
+ (not @var{sub-version-reference})
address@hidden lisp
+
+in which @var{sub-version} is an exact, nonnegative integer as above. A
+version reference matches a declared module version if each element of
+the version reference matches a corresponding element of the module 
+version, according to the following rules:
+
address@hidden @bullet
address@hidden
+The @code{and} sub-form matches a version or version element if every 
+element in the tail of the sub-form matches the specified version or 
+version element.
+
address@hidden
+The @code{or} sub-form matches a version or version element if any 
+element in the tail of the sub-form matches the specified version or
+version element.
+
address@hidden
+The @code{not} sub-form matches a version or version element if the tail
+of the sub-form does not match the version or version element.  
+
address@hidden
+The @code{>=} sub-form matches a version element if the element is 
+greater than or equal to the @var{sub-version} in the tail of the 
+sub-form.
+
address@hidden
+The @code{<=} sub-form matches a version element if the version is less
+than or equal to the @var{sub-version} in the tail of the sub-form.
+
address@hidden
+A @var{sub-version} matches a version element if one is @var{eqv?} to
+the other.
address@hidden itemize
+
+For example, a module declared as:
+
address@hidden
+ (define-module (mylib mymodule) #:version (1 2 0))
address@hidden lisp
+
+would be successfully loaded by any of the following @code{use-modules}
+expressions:
+
address@hidden
+ (use-modules ((mylib mymodule) #:version (1 2 (>= 0))))
+ (use-modules ((mylib mymodule) #:version (or (1 2 0) (1 2 1))))
+ (use-modules ((mylib mymodule) #:version ((and (>= 1) (not 2)) 2 0)))
address@hidden lisp
+
+
 @node Dynamic Libraries
 @subsection Dynamic Libraries
 
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 83462f7..1b8b053 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1253,7 +1253,7 @@
   (make-record-type 'module
                     '(obarray uses binder eval-closure transformer name kind
                       duplicates-handlers import-obarray
-                      observers weak-observers)
+                      observers weak-observers version)
                     %print-module))
 
 ;; make-module &opt size uses binder
@@ -1294,7 +1294,7 @@
                                           #f #f #f
                                           (make-hash-table 
%default-import-size)
                                           '()
-                                          (make-weak-key-hash-table 31))))
+                                          (make-weak-key-hash-table 31) #f)))
 
           ;; We can't pass this as an argument to module-constructor,
           ;; because we need it to close over a pointer to the module
@@ -1316,6 +1316,8 @@
 
 ;; (define module-transformer (record-accessor module-type 'transformer))
 (define set-module-transformer! (record-modifier module-type 'transformer))
+(define module-version (record-accessor module-type 'version))
+(define set-module-version! (record-modifier module-type 'version))
 ;; (define module-name (record-accessor module-type 'name)) wait until mods 
are booted
 (define set-module-name! (record-modifier module-type 'name))
 (define module-kind (record-accessor module-type 'kind))
@@ -1921,6 +1923,7 @@
             (eq? interface module))
         (let ((interface (make-module 31)))
           (set-module-name! interface (module-name module))
+          (set-module-version! interface (module-version module))
           (set-module-kind! interface 'interface)
           (set-module-public-interface! module interface))))
   (if (and (not (memq the-scm-module (module-uses module)))
@@ -1928,6 +1931,103 @@
       ;; Import the default set of bindings (from the SCM module) in MODULE.
       (module-use! module the-scm-module)))
 
+(define (version-matches? version-ref target)
+  (define (any pred lst)
+    (and (not (null? lst)) (or (pred (car lst)) (any pred (cdr lst)))))
+  (define (every pred lst) 
+    (or (null? lst) (and (pred (car lst)) (every pred (cdr lst)))))
+  (define (sub-versions-match? v-refs t)
+    (define (sub-version-matches? v-ref t)
+      (define (curried-sub-version-matches? v)
+        (sub-version-matches? v t))
+      (cond ((number? v-ref) (eqv? v-ref t))
+            ((list? v-ref)
+             (let ((cv (car v-ref)))
+               (cond ((eq? cv '>=) (>= t (cadr v-ref)))
+                     ((eq? cv '<=) (<= t (cadr v-ref)))
+                     ((eq? cv 'and) 
+                      (every curried-sub-version-matches? (cdr v-ref)))
+                     ((eq? cv 'or)
+                      (any curried-sub-version-matches? (cdr v-ref)))
+                     ((eq? cv 'not) (not (sub-version-matches? (cadr v-ref) 
t)))
+                     (else (error "Incompatible sub-version reference" cv)))))
+            (else (error "Incompatible sub-version reference" v-ref))))
+    (or (null? v-refs)
+        (and (not (null? t))
+             (sub-version-matches? (car v-refs) (car t))
+             (sub-versions-match? (cdr v-refs) (cdr t)))))
+  (define (curried-version-matches? v)
+    (version-matches? v target))
+  (or (null? version-ref)
+      (let ((cv (car version-ref)))
+        (cond ((eq? cv 'and) (every curried-version-matches? (cdr 
version-ref)))
+              ((eq? cv 'or) (any curried-version-matches? (cdr version-ref)))
+              ((eq? cv 'not) (not version-matches? (cadr version-ref) target))
+              (else (sub-versions-match? version-ref target))))))
+
+(define (find-versioned-module dir-hint name version-ref roots)
+  (define (subdir-pair-less pair1 pair2)
+    (define (numlist-less lst1 lst2)
+      (or (null? lst2) 
+          (and (not (null? lst1))
+               (cond ((> (car lst1) (car lst2)) #t)
+                     ((< (car lst1) (car lst2)) #f)
+                     (else (numlist-less (cdr lst1) (cdr lst2)))))))
+    (numlist-less (car pair1) (car pair2)))
+  (define (match-version-and-file pair)
+    (and (version-matches? version-ref (car pair))
+         (let ((filenames                            
+                (filter (lambda (file)
+                          (let ((s (false-if-exception (stat file))))
+                            (and s (eq? (stat:type s) 'regular))))
+                        (map (lambda (ext)
+                               (string-append (cdr pair) "/" name ext))
+                             %load-extensions))))
+           (and (not (null? filenames))
+                (cons (car pair) (car filenames))))))
+    
+  (define (match-version-recursive root-pairs leaf-pairs)
+    (define (filter-subdirs root-pairs ret)
+      (define (filter-subdir root-pair dstrm subdir-pairs)
+        (let ((entry (readdir dstrm)))
+          (if (eof-object? entry)
+              subdir-pairs
+              (let* ((subdir (string-append (cdr root-pair) "/" entry))
+                     (num (string->number entry))
+                     (num (and num (append (car root-pair) (list num)))))
+                (if (and num (eq? (stat:type (stat subdir)) 'directory))
+                    (filter-subdir 
+                     root-pair dstrm (cons (cons num subdir) subdir-pairs))
+                    (filter-subdir root-pair dstrm subdir-pairs))))))
+      
+      (or (and (null? root-pairs) ret)
+          (let* ((rp (car root-pairs))
+                 (dstrm (false-if-exception (opendir (cdr rp)))))
+            (if dstrm
+                (let ((subdir-pairs (filter-subdir rp dstrm '())))
+                  (closedir dstrm)
+                  (filter-subdirs (cdr root-pairs) 
+                                  (or (and (null? subdir-pairs) ret)
+                                      (append ret subdir-pairs))))
+                (filter-subdirs (cdr root-pairs) ret)))))
+    
+    (or (and (null? root-pairs) leaf-pairs)
+        (let ((matching-subdir-pairs (filter-subdirs root-pairs '())))
+          (match-version-recursive
+           matching-subdir-pairs
+           (append leaf-pairs (filter pair? (map match-version-and-file 
+                                                 matching-subdir-pairs)))))))
+  (define (make-root-pair root)
+    (cons '() (string-append root "/" dir-hint)))
+
+  (let* ((root-pairs (map make-root-pair roots))
+         (matches (if (null? version-ref) 
+                      (filter pair? (map match-version-and-file root-pairs))
+                      '()))
+         (matches (append matches (match-version-recursive root-pairs '()))))
+    (and (null? matches) (error "No matching modules found."))
+    (cdar (sort matches subdir-pair-less))))
+
 (define (make-fresh-user-module)
   (let ((m (make-module)))
     (beautify-user-module! m)
@@ -1937,20 +2037,25 @@
 ;;
 (define resolve-module
   (let ((the-root-module the-root-module))
-    (lambda (name . maybe-autoload)
+    (lambda (name . args)
       (if (equal? name '(guile))
           the-root-module
           (let ((full-name (append '(%app modules) name)))
-            (let ((already (nested-ref the-root-module full-name))
-                  (autoload (or (null? maybe-autoload) (car maybe-autoload))))
+            (let* ((already (nested-ref the-root-module full-name))
+                   (numargs (length args))
+                   (autoload (or (= numargs 0) (car args)))
+                   (version (and (> numargs 1) (cadr args))))
               (cond
                ((and already (module? already)
                      (or (not autoload) (module-public-interface already)))
                 ;; A hit, a palpable hit.
+                (if (and version 
+                         (not (version-matches? version (module-version 
already))))
+                    (error "incompatible module version already loaded" name))
                 already)
                (autoload
                 ;; Try to autoload the module, and recurse.
-                (try-load-module name)
+                (try-load-module name version)
                 (resolve-module name #f))
                (else
                 ;; A module is not bound (but maybe something else is),
@@ -1996,8 +2101,8 @@
 
 ;; (define-special-value '(%app modules new-ws) (lambda () (make-scm-module)))
 
-(define (try-load-module name)
-  (try-module-autoload name))
+(define (try-load-module name version)
+  (try-module-autoload name version))
 
 (define (purify-module! module)
   "Removes bindings in MODULE which are inherited from the (guile) module."
@@ -2057,7 +2162,8 @@
                       (let ((prefix (get-keyword-arg args #:prefix #f)))
                         (and prefix (symbol-prefix-proc prefix)))
                       identity))
-         (module (resolve-module name))
+         (version (get-keyword-arg args #:version #f))
+         (module (resolve-module name #t version))
          (public-i (and module (module-public-interface module))))
     (and (or (not module) (not public-i))
          (error "no code for module" name))
@@ -2178,6 +2284,14 @@
              (purify-module! module)
              (loop (cdr kws) reversed-interfaces exports re-exports
                    replacements autoloads))
+            ((#:version)
+             (or (pair? (cdr kws))
+                 (unrecognized kws))
+             (let ((version (cadr kws)))
+               (set-module-version! module version)
+               (set-module-version! (module-public-interface module) version))
+             (loop (cddr kws) reversed-interfaces exports re-exports
+                   replacements autoloads))
             ((#:duplicates)
              (if (not (pair? (cdr kws)))
                  (unrecognized kws))
@@ -2241,7 +2355,7 @@
                           (set-car! autoload i)))
                     (module-local-variable i sym))))))
     (module-constructor (make-hash-table 0) '() b #f #f name 'autoload #f
-                        (make-hash-table 0) '() (make-weak-value-hash-table 
31))))
+                        (make-hash-table 0) '() (make-weak-value-hash-table 
31) #f)))
 
 (define (module-autoload! module . args)
   "Have @var{module} automatically load the module named @var{name} when one
@@ -2271,9 +2385,10 @@ module '(ice-9 q) '(make-q q-length))}."
 ;; This function is called from "modules.c".  If you change it, be
 ;; sure to update "modules.c" as well.
 
-(define (try-module-autoload module-name)
+(define (try-module-autoload module-name . args)
   (let* ((reverse-name (reverse module-name))
          (name (symbol->string (car reverse-name)))
+         (version (and (not (null? args)) (car args)))
          (dir-hint-module-name (reverse (cdr reverse-name)))
          (dir-hint (apply string-append
                           (map (lambda (elt)
@@ -2289,7 +2404,10 @@ module '(ice-9 q) '(make-q q-length))}."
                 (lambda ()
                   (save-module-excursion
                    (lambda () 
-                     (primitive-load-path (in-vicinity dir-hint name) #f)
+                     (if version
+                         (load (find-versioned-module
+                                dir-hint name version %load-path))
+                         (primitive-load-path (in-vicinity dir-hint name) #f))
                      (set! didit #t))))))
             (lambda () (set-autoloaded! dir-hint name didit)))
            didit))))
@@ -2847,7 +2965,8 @@ module '(ice-9 q) '(make-q q-length))}."
     '((:select #:select #t)
       (:hide   #:hide   #t)
       (:prefix #:prefix #t)
-      (:renamer #:renamer #f)))
+      (:renamer #:renamer #f)
+      (:version #:version #t)))
   (if (not (pair? (car spec)))
       `(',spec)
       `(',(car spec)
@@ -2968,16 +3087,20 @@ module '(ice-9 q) '(make-q q-length))}."
 (define (module-export! m names)
   (let ((public-i (module-public-interface m)))
     (for-each (lambda (name)
-                (let ((var (module-ensure-local-variable! m name)))
-                  (module-add! public-i name var)))
+                (let* ((internal-name (if (pair? name) (car name) name))
+                       (external-name (if (pair? name) (cdr name) name))
+                       (var (module-ensure-local-variable! m internal-name)))
+                  (module-add! public-i external-name var)))
               names)))
 
 (define (module-replace! m names)
   (let ((public-i (module-public-interface m)))
     (for-each (lambda (name)
-                (let ((var (module-ensure-local-variable! m name)))
+                (let* ((internal-name (if (pair? name) (car name) name))
+                       (external-name (if (pair? name) (cdr name) name))
+                       (var (module-ensure-local-variable! m internal-name)))
                   (set-object-property! var 'replace #t)
-                  (module-add! public-i name var)))
+                  (module-add! public-i external-name var)))
               names)))
 
 ;; Re-export a imported variable
@@ -2985,13 +3108,15 @@ module '(ice-9 q) '(make-q q-length))}."
 (define (module-re-export! m names)
   (let ((public-i (module-public-interface m)))
     (for-each (lambda (name)
-                (let ((var (module-variable m name)))
+                (let* ((internal-name (if (pair? name) (car name) name))
+                       (external-name (if (pair? name) (cdr name) name))
+                       (var (module-variable m internal-name)))
                   (cond ((not var)
-                         (error "Undefined variable:" name))
-                        ((eq? var (module-local-variable m name))
-                         (error "re-exporting local variable:" name))
+                         (error "Undefined variable:" internal-name))
+                        ((eq? var (module-local-variable m internal-name))
+                         (error "re-exporting local variable:" internal-name))
                         (else
-                         (module-add! public-i name var)))))
+                         (module-add! public-i external-name var)))))
               names)))
 
 (defmacro export names


hooks/post-receive
-- 
GNU Guile




reply via email to

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