Hi all,
Find attached updated versions of the patches that provide support for
R6RS-compatible versions and renaming bindings on export (the two core
modifications required to support the libraries implementation).
They've been rebased against the current HEAD and some reasonably
comprehensive documentation has been added.
Questions? Comments?
Regards,
Julian
From bb83bbd13263aca6a1e8b246fd68ce96f5dcdb43 Mon Sep 17 00:00:00 2001
From: Julian Graham <julian.gra...@aya.yale.edu>
Date: Thu, 10 Dec 2009 00:29:11 -0500
Subject: [PATCH 1/2] 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.
---
doc/ref/api-modules.texi | 50 +++++++++++++++++++++++++--------------------
module/ice-9/boot-9.scm | 24 +++++++++++++--------
2 files changed, 43 insertions(+), 31 deletions(-)
diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi
index 1c9ab23..65a3564 100644
--- a/doc/ref/api-modules.texi
+++ b/doc/ref/api-modules.texi
@@ -421,40 +421,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
-...@code{(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
-...@code{(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,
+...@code{#: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
@@ -562,8 +564,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")
@@ -573,9 +578,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
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 20da580..7bde50f 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2968,16 +2968,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 +2989,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
--
1.6.3.3
From 6dfb5e096b663a143cbacf1d7878bfdd54ee2b5a Mon Sep 17 00:00:00 2001
From: Julian Graham <julian.gra...@aya.yale.edu>
Date: Thu, 10 Dec 2009 11:26:31 -0500
Subject: [PATCH 2/2] 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.
---
doc/ref/api-modules.texi | 123 ++++++++++++++++++++++++++++++++++++++
module/ice-9/boot-9.scm | 149 +++++++++++++++++++++++++++++++++++++++++-----
2 files changed, 256 insertions(+), 16 deletions(-)
diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi
index 65a3564..f3fa7a7 100644
--- a/doc/ref/api-modules.texi
+++ b/doc/ref/api-modules.texi
@@ -153,6 +153,7 @@ there is still some flux.
* Module System Quirks:: Strange things to be aware of.
* 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
@@ -195,6 +196,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
+...@code{(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
@@ -324,6 +340,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:
+
+...@lisp
+ :version VERSION-SPEC
+...@end 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
@@ -485,6 +516,13 @@ instead of a comparison.
The @code{#:duplicates} (see below) provides fine-grain control about
duplicate binding handling on the module-user side.
+...@item #:version @var{list}
+...@cindex 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
+...@code{#: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
@@ -891,6 +929,91 @@ of the current module. The list of names is terminated by
@code{NULL}.
@end deftypefn
+
+...@node R6RS Version References
+...@subsubsection 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
+...@code{#: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:
+
+...@lisp
+ (SUB-VERSION-REFERENCE ...)
+ (and VERSION-REFERENCE ...)
+ (or VERSION-REFERENCE ...)
+ (not VERSION-REFERENCE)
+...@end lisp
+
+in which @var{sub-version-reference} is in turn one of:
+
+...@lisp
+ (SUB-VERSION)
+ (>= SUB-VERSION)
+ (<= SUB-VERSION)
+ (and SUB-VERSION-REFERENCE ...)
+ (or SUB-VERSION-REFERENCE ...)
+ (not SUB-VERSION-REFERENCE)
+...@end 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:
+
+...@itemize @bullet
+...@item
+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.
+
+...@item
+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.
+
+...@item
+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.
+
+...@item
+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.
+
+...@item
+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.
+
+...@item
+A @var{sub-version} matches a version element if one is @var{eqv?} to
+the other.
+...@end itemize
+
+For example, a module declared as:
+
+...@lisp
+ (define-module (mylib mymodule) #:version (1 2 0))
+...@end lisp
+
+would be successfully loaded by any of the following @code{use-modules}
+expressions:
+
+...@lisp
+ (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)))
+...@end lisp
+
+
@node Dynamic Libraries
@subsection Dynamic Libraries
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 7bde50f..830554f 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,101 @@
;; 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 prec lst)
+ (and (not (null? lst)) (or (prec (car lst)) (any prec (cdr lst)))))
+ (define (every prec lst)
+ (or (null? lst) (and (prec (car lst)) (every prec (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 +2035,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.
- already)
- (autoload
+ (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 +2099,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 +2160,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 +2282,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 +2353,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 +2383,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,8 +2402,11 @@ module '(ice-9 q) '(make-q q-length))}."
(lambda ()
(save-module-excursion
(lambda ()
- (primitive-load-path (in-vicinity dir-hint name) #f)
- (set! didit #t))))))
+ (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 +2963,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)
--
1.6.3.3
