* r6rs libraries, round three
@ 2009-09-26 20:10 Julian Graham
2009-10-01 4:32 ` Julian Graham
0 siblings, 1 reply; 19+ messages in thread
From: Julian Graham @ 2009-09-26 20:10 UTC (permalink / raw)
To: guile-devel
[-- Attachment #1: Type: text/plain, Size: 2829 bytes --]
Hi Guilers,
Having been motivated by an extended discussion with Andy over pints
in Brooklyn last weekend, I've resolved to return to the issue of R6RS
library support once more. As discussed the last time we took this
on, I think the first step is getting support for version information
into the modules system. Find attached a patch that adds trivial
support for versions to boot-9.scm. Applying this patch gives you the
ability to specify an R6RS-compatible (i.e., `(x y z...)' where x, y,
and z are whole numbers) version, via a #:version keyword argument,
for both the `define-module' and `use-modules' forms. Specifying a
version in your `use-modules' that doesn't match the version of an
already-loaded module with that name will raise an error.
This patch is "trivial" because version matching at the moment is done
via `equal?' and thus doesn't support the full range of matching
behavior outlined by R6RS. More importantly, though, it's missing
support for matching versions on disk. I got most of the way through
an initial implementation of that when I found myself in some
trickiness.
To recap, what I think we decided about storing versioned modules was:
Module version numbers can be represented in a directory hierarchy:
[dir-hint] / x / y / z / module.scm, e.g. ice-9/0/1/2/readline.scm.
This is approach has the benefit that it can co-exist with the
traditional directory structure for Guile modules, since numbers can't
be confused with module name components [1].
But this also means that the path searching performed by
`primitive-load-path' won't work for locating these modules, and
Andy's symlink solution [2] doesn't really help that much, since R6RS
version matching sometimes requires that we select a number based on a
set of constraints, not just a straight-up wildcard.
The solution I'm working on does the following:
1. Combine every entry in `%load-path' with the "dir hint" to produce
a list of root paths to search.
2. For every component of the version reference, for every root path,
find all subdirectories with names that match the reference.
3. Sort the results in numerically descending order; these are the new
root paths.
4. Loop back to step 2 until all components of the version reference
have been matched and a module file has been found.
The problem I ran into is that once I've finished this procedure, I've
got an absolute path to the module, and I want to load it by
performing the same autocompilation heuristics that
`primitive-load-path' provides -- but that function only works on
relative paths. How come this magic hasn't been added to
`primitive-load' (or some other function that operates on absolute
paths)?
Regards,
Julian
[1] - http://www.mail-archive.com/guile-devel@gnu.org/msg03259.html
[2] - http://article.gmane.org/gmane.lisp.guile.devel/8585
[-- Attachment #2: 0001-Initial-support-for-version-information-in-Guile-s.patch --]
[-- Type: text/x-diff, Size: 5821 bytes --]
From a1d49c00cd6cc144bf526481e5ba7da6aefa0822 Mon Sep 17 00:00:00 2001
From: Julian Graham <julian.graham@aya.yale.edu>
Date: Sat, 26 Sep 2009 14:52:56 -0400
Subject: [PATCH] Initial support for version information in Guile's `module' form.
* module/ice-9/boot-9.scm (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.
---
module/ice-9/boot-9.scm | 42 ++++++++++++++++++++++++++++++------------
1 files changed, 30 insertions(+), 12 deletions(-)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index a1537d1..b49f799 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1332,8 +1332,8 @@
(define module-type
(make-record-type 'module
'(obarray uses binder eval-closure transformer name kind
- duplicates-handlers import-obarray
- observers weak-observers)
+ duplicates-handlers import-obarray observers
+ weak-observers version)
%print-module))
;; make-module &opt size uses binder
@@ -1374,13 +1374,12 @@
#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
;; itself.
(set-module-eval-closure! module (standard-eval-closure module))
-
module))))
(define module-constructor (record-constructor module-type))
@@ -1396,6 +1395,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))
@@ -2008,24 +2009,32 @@
;; Import the default set of bindings (from the SCM module) in MODULE.
(module-use! module the-scm-module)))
+;; Temporary kludge before implementing full version matching.
+(define version-matches? equal?)
+
;; NOTE: This binding is used in libguile/modules.c.
;;
(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.
+ (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),
@@ -2071,7 +2080,7 @@
;; (define-special-value '(%app modules new-ws) (lambda () (make-scm-module)))
-(define (try-load-module name)
+(define (try-load-module name version)
(try-module-autoload name))
(define (purify-module! module)
@@ -2132,7 +2141,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))
@@ -2253,6 +2263,12 @@
(purify-module! module)
(loop (cdr kws) reversed-interfaces exports re-exports
replacements autoloads))
+ ((#:version)
+ (or (pair? (cdr kws))
+ (unrecognized kws))
+ (set-module-version! module (cadr kws))
+ (loop (cddr kws) reversed-interfaces exports re-exports
+ replacements autoloads))
((#:duplicates)
(if (not (pair? (cdr kws)))
(unrecognized kws))
@@ -2316,7 +2332,8 @@
(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
@@ -2921,7 +2938,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 #f)))
(if (not (pair? (car spec)))
`(',spec)
`(',(car spec)
--
1.6.0.4
^ permalink raw reply related [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-09-26 20:10 r6rs libraries, round three Julian Graham
@ 2009-10-01 4:32 ` Julian Graham
2009-10-24 19:10 ` Julian Graham
0 siblings, 1 reply; 19+ messages in thread
From: Julian Graham @ 2009-10-01 4:32 UTC (permalink / raw)
To: guile-devel
[-- Attachment #1: Type: text/plain, Size: 830 bytes --]
Hi Guilers,
Okay, after poking around in the manual and the code, it looks like
`load-module' does what I need.
Find attached two patches that, combined, add full support for
R6RS-style version information to Guile's module system. I've done a
bit of testing and believe that this code does the Right Thing in a
variety of situations -- e.g., it always attempts to select the
"highest" version number but can recover from situations in which
paths corresponding to higher-numbered versions don't contain actual
module implementations.
Questions, comments? If it seems like this code is on the right
track, I'll add documentation to the appropriate locations.
boot-9.scm is getting a little bit crowded, though -- I don't suppose
it makes sense to move some of the module handling code to an
auxiliary file?
Regards,
Julian
[-- Attachment #2: 0001-Initial-support-for-version-information-in-Guile-s.patch --]
[-- Type: text/x-diff, Size: 5821 bytes --]
From a1d49c00cd6cc144bf526481e5ba7da6aefa0822 Mon Sep 17 00:00:00 2001
From: Julian Graham <julian.graham@aya.yale.edu>
Date: Sat, 26 Sep 2009 14:52:56 -0400
Subject: [PATCH] Initial support for version information in Guile's `module' form.
* module/ice-9/boot-9.scm (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.
---
module/ice-9/boot-9.scm | 42 ++++++++++++++++++++++++++++++------------
1 files changed, 30 insertions(+), 12 deletions(-)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index a1537d1..b49f799 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1332,8 +1332,8 @@
(define module-type
(make-record-type 'module
'(obarray uses binder eval-closure transformer name kind
- duplicates-handlers import-obarray
- observers weak-observers)
+ duplicates-handlers import-obarray observers
+ weak-observers version)
%print-module))
;; make-module &opt size uses binder
@@ -1374,13 +1374,12 @@
#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
;; itself.
(set-module-eval-closure! module (standard-eval-closure module))
-
module))))
(define module-constructor (record-constructor module-type))
@@ -1396,6 +1395,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))
@@ -2008,24 +2009,32 @@
;; Import the default set of bindings (from the SCM module) in MODULE.
(module-use! module the-scm-module)))
+;; Temporary kludge before implementing full version matching.
+(define version-matches? equal?)
+
;; NOTE: This binding is used in libguile/modules.c.
;;
(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.
+ (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),
@@ -2071,7 +2080,7 @@
;; (define-special-value '(%app modules new-ws) (lambda () (make-scm-module)))
-(define (try-load-module name)
+(define (try-load-module name version)
(try-module-autoload name))
(define (purify-module! module)
@@ -2132,7 +2141,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))
@@ -2253,6 +2263,12 @@
(purify-module! module)
(loop (cdr kws) reversed-interfaces exports re-exports
replacements autoloads))
+ ((#:version)
+ (or (pair? (cdr kws))
+ (unrecognized kws))
+ (set-module-version! module (cadr kws))
+ (loop (cddr kws) reversed-interfaces exports re-exports
+ replacements autoloads))
((#:duplicates)
(if (not (pair? (cdr kws)))
(unrecognized kws))
@@ -2316,7 +2332,8 @@
(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
@@ -2921,7 +2938,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 #f)))
(if (not (pair? (car spec)))
`(',spec)
`(',(car spec)
--
1.6.0.4
[-- Attachment #3: 0002-Complete-support-for-version-information-in-Guile-s.patch --]
[-- Type: text/x-diff, Size: 6333 bytes --]
From 0c44462a331f3b3b2ce641fd083e11dacc55970b Mon Sep 17 00:00:00 2001
From: Julian Graham <julian.graham@aya.yale.edu>
Date: Thu, 1 Oct 2009 00:16:55 -0400
Subject: [PATCH] Complete support for version information in Guile's `module' form.
* module/ice-9/boot-9.scm (find-versioned-module): New function.
* module/ice-9/boot-9.scm (version-matches?): Implement full R6RS
version-matching syntax.
* 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 | 102 ++++++++++++++++++++++++++++++++++++++++++++---
1 files changed, 96 insertions(+), 6 deletions(-)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index b49f799..fd0dea6 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2009,8 +2009,94 @@
;; Import the default set of bindings (from the SCM module) in MODULE.
(module-use! module the-scm-module)))
-;; Temporary kludge before implementing full version matching.
-(define version-matches? equal?)
+(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-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)))))
+
+ (define (match-version-and-file pair)
+ (and (version-matches? version-ref (car pair))
+ (let ((filenames
+ (filter file-exists?
+ (map (lambda (ext)
+ (string-append (cdr pair) "/" name ext))
+ %load-extensions))))
+ (and (not (null? filenames))
+ (cons (car pair) (car filenames))))))
+
+ (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 ((matches (match-version-recursive (map make-root-pair roots) '())))
+ (and (null? matches) (error "No matching modules found."))
+ (cdar (sort matches subdir-pair-less))))
;; NOTE: This binding is used in libguile/modules.c.
;;
@@ -2081,7 +2167,7 @@
;; (define-special-value '(%app modules new-ws) (lambda () (make-scm-module)))
(define (try-load-module name version)
- (try-module-autoload name))
+ (try-module-autoload name version))
(define (purify-module! module)
"Removes bindings in MODULE which are inherited from the (guile) module."
@@ -2363,9 +2449,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)
@@ -2381,8 +2468,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))))
--
1.6.0.4
^ permalink raw reply related [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-10-01 4:32 ` Julian Graham
@ 2009-10-24 19:10 ` Julian Graham
2009-10-25 22:01 ` Andy Wingo
0 siblings, 1 reply; 19+ messages in thread
From: Julian Graham @ 2009-10-24 19:10 UTC (permalink / raw)
To: guile-devel
Hi all,
Besides version, another thing that would be very useful to have
"native" Guile support for is being able to export bindings with names
other than the ones given to them within the module -- that is, to be
able to "rename" variables exported as part of the module's public
interface in `define-module', similar to what the `#:select' keyword
allows you to do for imported bindings.
In fact, it could even work the same the way: a given element in the
list passed with the `#:export' keyword could be either a symbol or a
pair in which the car is the module-local name and the cdr is the name
to use in the module's public interface.
What do people think?
Regards,
Julian
^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-10-24 19:10 ` Julian Graham
@ 2009-10-25 22:01 ` Andy Wingo
2009-10-26 3:53 ` Julian Graham
0 siblings, 1 reply; 19+ messages in thread
From: Andy Wingo @ 2009-10-25 22:01 UTC (permalink / raw)
To: Julian Graham; +Cc: guile-devel
Hi Julian,
On Sat 24 Oct 2009 21:10, Julian Graham <joolean@gmail.com> writes:
> Besides version, another thing that would be very useful to have
> "native" Guile support for is being able to export bindings with names
> other than the ones given to them within the module
It should work now, though with hacks -- if you manipulate the
module-public-interface directly. But perhaps some more baked in support
would be useful.
> to be able to "rename" variables exported as part of the module's
> public interface in `define-module', similar to what the `#:select'
> keyword allows you to do for imported bindings.
Would you not want programmatic renaming as well?
> What do people think?
Can you explain a use case a bit more? I think having trouble grasping
why you would want to do this :)
Andy
--
http://wingolog.org/
^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-10-25 22:01 ` Andy Wingo
@ 2009-10-26 3:53 ` Julian Graham
2009-11-01 19:26 ` Julian Graham
0 siblings, 1 reply; 19+ messages in thread
From: Julian Graham @ 2009-10-26 3:53 UTC (permalink / raw)
To: Andy Wingo; +Cc: guile-devel
Hi Andy,
> It should work now, though with hacks -- if you manipulate the
> module-public-interface directly. But perhaps some more baked in support
> would be useful.
Oh, certainly -- as I've learned over these many months, you can do
some very interesting things by working with the lower-level module
API. And indeed, that was how I did things in my initial
implementation back in March. But...
> Can you explain a use case a bit more? I think having trouble grasping
> why you would want to do this :)
I'm trying to write a macro to convert `library' forms into
`define-module' forms. All of the contortions you can put your
imported symbols through in R6RS can be flattened into a form that
maps quite neatly onto define-module's #:select, but #:export and
#:reexport aren't as flexible. Specifically, the use case is
implementing the
(rename (<identifier1> <identifier2>) ...)
form for R6RS library export-specs. Like you said, you can manipulate
the public interface directly -- I could, say, insert the code to do
this as part of transforming the library body -- but it would be nice
if I could leave the management of the interface entirely up to
`define-module'.
Regards,
Julian
^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-10-26 3:53 ` Julian Graham
@ 2009-11-01 19:26 ` Julian Graham
2009-11-16 20:47 ` Julian Graham
2009-11-17 19:56 ` Andy Wingo
0 siblings, 2 replies; 19+ messages in thread
From: Julian Graham @ 2009-11-01 19:26 UTC (permalink / raw)
To: guile-devel
[-- Attachment #1: Type: text/plain, Size: 2213 bytes --]
Hi all,
Find attached a working prototype of R6RS library support, in the form
of a Guile module called `(r6rs-libraries)'. The module depends on
the two attached patches, which add, respectively, support for the
`#:version' keyword [1] and support for renaming bindings on export
[2]. It works by transforming the R6RS `library' form into Guile's
native `define-module' form. Because it's implemented as a macro,
it's only required at expansion time -- the resulting compiled module
has no dependencies on anything besides other Guile modules.
Andreas Rottmann's quasisyntax implementation is included as part of
`(r6rs-libraries)' since it's not yet in master and I was finding it
difficult to model some things without `unsyntax-splicing'.
Also attached are a minimal set of R6RS libraries (as
`r6rs-libs.tar.gz') needed to bootstrap the examples from chapter 7 of
the R6RS spec (attached as `r6rs-examples.tar.gz'). If you place the
r6rs-libraries.scm and the contents of these tarballs somwhere in your
`%load-path', you can run the "balloon party" example as follows:
scheme@(guile-user)> (use-modules (r6rs-libraries))
scheme@(guile-user)> (use-modules (main))
Boom 108
Boom 24
...and the "let-div" example as follows:
scheme@(guile-user)> (use-modules (r6rs-libraries))
scheme@(guile-user)> (use-modules (let-div))
scheme@(guile-user)> (let-div 5 2 (q r) (display "q: ") (display q)
(display " r: ") (display r) (newline))
q: 2 r: 1
There are certainly some aspects of this implementation that require
review -- in particular, I've added infrastructure to distinguish
between imports targeted for different "phases" (i.e., `run', `expand'
... (meta n)), but at the moment, all imports are currently included
via #:use-module, which means they're visible at every point from
expansion to runtime. R6RS seems to explicitly allow this, though,
and, quite frankly, it's much easier to implement.
As I said earlier, I'm happy to provide full documentation for all of
this code if the consensus is that I'm on the right track.
Regards,
Julian
[1] - http://www.mail-archive.com/guile-devel@gnu.org/msg04506.html
[2] - http://www.mail-archive.com/guile-devel@gnu.org/msg04660.html
[-- Attachment #2: 0001-Complete-support-for-version-information-in-Guile-s.patch --]
[-- Type: text/x-diff, Size: 11465 bytes --]
From adcbc77ca4ca68f26da05a204154d826a832a7b7 Mon Sep 17 00:00:00 2001
From: Julian Graham <julian.graham@aya.yale.edu>
Date: Sun, 25 Oct 2009 13:17:40 -0400
Subject: [PATCH] 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.
---
module/ice-9/boot-9.scm | 149 ++++++++++++++++++++++++++++++++++++++++++-----
1 files changed, 133 insertions(+), 16 deletions(-)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 5852477..3d92fad 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1333,7 +1333,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
@@ -1374,7 +1374,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
@@ -1396,6 +1396,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))
@@ -2001,6 +2003,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)))
@@ -2008,6 +2011,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)
@@ -2017,20 +2115,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),
@@ -2076,8 +2179,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."
@@ -2137,7 +2240,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))
@@ -2258,6 +2362,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))
@@ -2321,7 +2433,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
@@ -2351,9 +2463,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)
@@ -2369,8 +2482,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))))
@@ -2927,7 +3043,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.0.4
[-- Attachment #3: 0001-Support-for-renaming-bindings-on-module-export.patch --]
[-- Type: text/x-diff, Size: 2588 bytes --]
From d5b1ca509e6888119702e75ce35cd1e55d295525 Mon Sep 17 00:00:00 2001
From: Julian Graham <julian.graham@aya.yale.edu>
Date: Sat, 31 Oct 2009 13:02:13 -0400
Subject: [PATCH] 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.
---
module/ice-9/boot-9.scm | 24 +++++++++++++++---------
1 files changed, 15 insertions(+), 9 deletions(-)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 3d92fad..63f1493 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -3165,16 +3165,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
@@ -3182,13 +3186,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.0.4
[-- Attachment #4: r6rs-libraries.scm --]
[-- Type: text/x-scheme, Size: 7712 bytes --]
(define-module (r6rs-libraries)
#:export-syntax (library))
(use-modules (ice-9 receive))
(use-modules (srfi srfi-1))
(define-syntax quasisyntax
(lambda (e)
;; Expand returns a list of the form
;; [template[t/e, ...] (replacement ...)]
;; Here template[t/e ...] denotes the original template
;; with unquoted expressions e replaced by fresh
;; variables t, followed by the appropriate ellipses
;; if e is also spliced.
;; The second part of the return value is the list of
;; replacements, each of the form (t e) if e is just
;; unquoted, or ((t ...) e) if e is also spliced.
;; This will be the list of bindings of the resulting
;; with-syntax expression.
(define (expand x level)
(syntax-case x (quasisyntax unsyntax unsyntax-splicing)
((quasisyntax e)
(with-syntax (((k _) x) ;; original identifier must be copied
((e* reps) (expand (syntax e) (+ level 1))))
(syntax ((k e*) reps))))
((unsyntax e)
(= level 0)
(with-syntax (((t) (generate-temporaries '(t))))
(syntax (t ((t e))))))
(((unsyntax e ...) . r)
(= level 0)
(with-syntax (((r* (rep ...)) (expand (syntax r) 0))
((t ...) (generate-temporaries (syntax (e ...)))))
(syntax ((t ... . r*)
((t e) ... rep ...)))))
(((unsyntax-splicing e ...) . r)
(= level 0)
(with-syntax (((r* (rep ...)) (expand (syntax r) 0))
((t ...) (generate-temporaries (syntax (e ...)))))
(with-syntax ((((t ...) ...) (syntax ((t (... ...)) ...))))
(syntax ((t ... ... . r*)
(((t ...) e) ... rep ...))))))
((k . r)
(and (> level 0)
(identifier? (syntax k))
(or (free-identifier=? (syntax k) (syntax unsyntax))
(free-identifier=? (syntax k) (syntax unsyntax-splicing))))
(with-syntax (((r* reps) (expand (syntax r) (- level 1))))
(syntax ((k . r*) reps))))
((h . t)
(with-syntax (((h* (rep1 ...)) (expand (syntax h) level))
((t* (rep2 ...)) (expand (syntax t) level)))
(syntax ((h* . t*)
(rep1 ... rep2 ...)))))
(#(e ...)
(with-syntax ((((e* ...) reps)
(expand (vector->list (syntax #(e ...))) level)))
(syntax (#(e* ...) reps))))
(other
(syntax (other ())))))
(syntax-case e ()
((_ template)
(with-syntax (((template* replacements) (expand (syntax template) 0)))
(syntax
(with-syntax replacements (syntax template*))))))))
(define-syntax unsyntax
(lambda (e)
(syntax-violation 'unsyntax "Invalid expression" e)))
(define-syntax unsyntax-splicing
(lambda (e)
(syntax-violation 'unsyntax "Invalid expression" e)))
(define (flatten-import-spec import-spec phase-map import-map)
(define (flatten-inner import-set)
(define (load-library library-ref)
(let* ((v (car (last-pair library-ref))))
(if (pair? v)
(resolve-interface
(drop-right library-ref 1) #:version v)
(resolve-interface library-ref #:version '()))))
(define (export-eq? x y)
(if (list? y) (eq? x (cadr y)) (eq? x y)))
(if (or (not (list? import-set)))
(error))
(case (car import-set)
((library)
(let ((l (load-library (cadr import-set))))
(cons l (module-map (lambda (sym var) sym) l))))
((only)
(let ((l (flatten-inner (cadr import-set))))
(cons (car l) (lset-intersection
export-eq? (cdr l) (cddr import-set)))))
((except)
(let ((l (flatten-inner (cadr import-set))))
(cons (car l) (lset-difference
export-eq? (cdr l) (cddr import-set)))))
((prefix)
(let ((l (flatten-inner (cadr import-set)))
(p (symbol-prefix-proc (caddr import-set))))
(cons (car l)
(map (lambda (x)
(if (list? x)
(cons (car x) (p (cadr x)))
(cons x (p x))))
(cdr l)))))
((rename)
(let ((l (flatten-inner (cadr import-set))))
(cons (car l)
(map (lambda (x)
(let ((r (find (lambda (y)
(eq? (car y)
(if (list? x)
(car x) x)))
(cddr import-set))))
(if r (cons (if (list? x) (car x) x)
(cadr x)) x)))
(cdr l)))))
(else (let ((l (load-library import-set)))
(cons l (module-map (lambda (sym var) sym) l))))))
(let* ((phase (and (eq? (car import-spec) 'for)
(let ((p (list-ref import-spec 2)))
(case p ((run) 0) ((expand) 1) (else (cadr p))))))
(unwrapped-import-spec (if phase (cadr import-spec) import-spec))
(ilist (flatten-inner unwrapped-import-spec))
(public-interface (car ilist))
(interface
(append (list (module-name public-interface))
(if (module-version public-interface)
(list #:version (module-version public-interface))
(list))
(if (null? (cdr ilist)) '() (list #:select (cdr ilist))))))
(for-each (lambda (x) (hashq-set! import-map x #t))
(map (lambda (x) (if (pair? x) (cdr x) x)) (cdr ilist)))
(let* ((phase (or phase 0))
(phased-imports (hashv-ref phase-map phase)))
(if phased-imports
(hashv-set! phase-map phase (append phased-imports (list interface)))
(hashv-set! phase-map phase (list interface))))))
(define (resolve-export-spec export-specs import-map)
(define (imported? sym) (hashq-ref import-map (if (pair? sym) (car sym) sym)))
(define (flatten-renames export-spec)
(if (list? export-spec)
(map (lambda (x) (cons (car x) (cadr x))) (cdr export-spec))
(list export-spec)))
(partition imported? (apply append (map flatten-renames export-specs))))
(define-syntax library
(lambda (x)
(syntax-case x (export import)
((_ library-name
(export . export-specs)
(import . import-specs)
. library-body)
(let* ((imports (syntax->datum (syntax import-specs)))
(import-map (make-hash-table))
(phase-map (make-hash-table))
(ln-datum (syntax->datum (syntax library-name)))
(version (let ((v (car (last-pair ln-datum)))) (and (list? v) v)))
(name (if version (drop-right ln-datum 1) ln-datum))
(exports (syntax->datum (syntax export-specs)))
(body-exprs (syntax->datum (syntax library-body))))
(for-each (lambda (x) (flatten-import-spec x phase-map import-map))
imports)
(let ((runtime-imports (hashv-ref phase-map 0))
(@@-import '(((guile) #:select (@@ quote)))))
(if runtime-imports
(hashv-set! phase-map 0 (append runtime-imports @@-import))))
(receive
(re-exports exports)
(resolve-export-spec exports import-map)
(with-syntax
((name (datum->syntax #'library-name name))
(all-imports (if (not (null? imports))
(datum->syntax
#'import-specs
(apply append '()
(map (lambda (x) (list #:use-module x))
(apply append '()
(hash-map->list (lambda (k v) v)
phase-map)))))
'()))
(body-exprs (if (not (null? body-exprs))
(datum->syntax #'library-body body-exprs)
'())))
#`(begin
(define-module name
#,@(if version (list #:version version) '())
#:pure
#,@(syntax all-imports)
#,@(if (not (null? re-exports))
(datum->syntax #'export-specs `(#:re-export ,re-exports))
'())
#,@(if (not (null? exports))
(datum->syntax #'export-specs `(#:export ,exports))
'()))
#,@(syntax body-exprs)))))))))
[-- Attachment #5: r6rs-examples.tar.gz --]
[-- Type: application/x-gzip, Size: 1128 bytes --]
[-- Attachment #6: r6rs-libs.tar.gz --]
[-- Type: application/x-gzip, Size: 2548 bytes --]
^ permalink raw reply related [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-11-01 19:26 ` Julian Graham
@ 2009-11-16 20:47 ` Julian Graham
2009-11-17 19:56 ` Andy Wingo
1 sibling, 0 replies; 19+ messages in thread
From: Julian Graham @ 2009-11-16 20:47 UTC (permalink / raw)
To: guile-devel
> As I said earlier, I'm happy to provide full documentation for all of
> this code if the consensus is that I'm on the right track.
Any feeling either way on those patches? I'm happy to create a remote
tracking branch if that'd make it easier for people to review.
^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-11-01 19:26 ` Julian Graham
2009-11-16 20:47 ` Julian Graham
@ 2009-11-17 19:56 ` Andy Wingo
2009-11-17 20:55 ` Julian Graham
2009-11-18 1:18 ` Andreas Rottmann
1 sibling, 2 replies; 19+ messages in thread
From: Andy Wingo @ 2009-11-17 19:56 UTC (permalink / raw)
To: Julian Graham; +Cc: guile-devel
Hi Julian!
On Sun 01 Nov 2009 20:26, Julian Graham <joolean@gmail.com> writes:
> Find attached a working prototype of R6RS library support
I think I missed this one, it was threaded above the end of guile-devel
that I read :-) Sorry about that.
Note that quasisyntax is now merged. You can do things without
quasisyntax using with-syntax. I haven't actually had the pleasure yet
of using quasisyntax :P
Your code is remarkably short. That is my initial impression, positive
:-) But I need to get to writing the NEWS now for today's release. I'll
take a look at these within the next week hopefully. Please poke if you
don't get another response in the next week.
This might be excellent!
Andy
--
http://wingolog.org/
^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-11-17 19:56 ` Andy Wingo
@ 2009-11-17 20:55 ` Julian Graham
2009-11-18 1:33 ` Andreas Rottmann
2009-11-18 1:18 ` Andreas Rottmann
1 sibling, 1 reply; 19+ messages in thread
From: Julian Graham @ 2009-11-17 20:55 UTC (permalink / raw)
To: Andy Wingo; +Cc: guile-devel
Hi Andy,
> Note that quasisyntax is now merged. You can do things without
> quasisyntax using with-syntax.
Of course -- our version of quasisyntax is implemented in terms of
with-syntax! I was just being lazy.
> Your code is remarkably short. That is my initial impression, positive
> :-) But I need to get to writing the NEWS now for today's release. I'll
> take a look at these within the next week hopefully. Please poke if you
> don't get another response in the next week.
I probably should have said "rough prototype" instead of "working
prototype" -- the actual macro that transforms library definitions
into module definitions is kind of gross and uses datum->syntax a fair
amount where it probably doesn't need to / shouldn't. I'm no syncase
wizard. But I'm pretty sure it works for conventional libraries that
import and export macros and regular bindings. (What I worry about
are some of the hairier use cases of the whole "phased import"
mechanism -- like a binding that's imported at `meta' level 2 or
higher sharing a name with definition imported for use at runtime.)
What I'm mostly interested in is whether you guys think the version
and export patches are worth merging in some form or another -- my
assumption has been these are features we actually want for Guile's
module system.
Thanks,
Julian
^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-11-17 19:56 ` Andy Wingo
2009-11-17 20:55 ` Julian Graham
@ 2009-11-18 1:18 ` Andreas Rottmann
1 sibling, 0 replies; 19+ messages in thread
From: Andreas Rottmann @ 2009-11-18 1:18 UTC (permalink / raw)
To: Andy Wingo; +Cc: guile-devel
Andy Wingo <wingo@pobox.com> writes:
> Hi Julian!
>
> On Sun 01 Nov 2009 20:26, Julian Graham <joolean@gmail.com> writes:
>
>> Find attached a working prototype of R6RS library support
>
> I think I missed this one, it was threaded above the end of guile-devel
> that I read :-) Sorry about that.
>
> Note that quasisyntax is now merged. You can do things without
> quasisyntax using with-syntax. I haven't actually had the pleasure yet
> of using quasisyntax :P
>
Speaking of psyntax: have you had a look at my tail patterns patch[0]
yet? If it is deemed, ok, I can add ChangeLog and NEWS entries, and
update the documentation (anything else?).
[0] http://article.gmane.org/gmane.lisp.guile.devel/9605/match=tail+pattern
Regards, Rotty
--
Andreas Rottmann -- <http://rotty.yi.org/>
^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-11-17 20:55 ` Julian Graham
@ 2009-11-18 1:33 ` Andreas Rottmann
2009-11-18 6:40 ` Julian Graham
0 siblings, 1 reply; 19+ messages in thread
From: Andreas Rottmann @ 2009-11-18 1:33 UTC (permalink / raw)
To: Julian Graham; +Cc: Andy Wingo, guile-devel
Julian Graham <joolean@gmail.com> writes:
> I probably should have said "rough prototype" instead of "working
> prototype" -- the actual macro that transforms library definitions
> into module definitions is kind of gross and uses datum->syntax a fair
> amount where it probably doesn't need to / shouldn't. I'm no syncase
> wizard. But I'm pretty sure it works for conventional libraries that
> import and export macros and regular bindings. (What I worry about
> are some of the hairier use cases of the whole "phased import"
> mechanism -- like a binding that's imported at `meta' level 2 or
> higher sharing a name with definition imported for use at runtime.)
>
IIRC, R6RS doesn't /require/ that implementations are able to
differentiate bindings from different phases -- e.g. Ikarus essentially
ignores phase specifications (implicit phasing -- there were some
discussions about that on ikarus-users, which I can't find ATM, but [0]
should sum the issue up nicely).
[0] http://www.phyast.pitt.edu/~micheles/scheme/scheme21.html
> What I'm mostly interested in is whether you guys think the version
> and export patches are worth merging in some form or another -- my
> assumption has been these are features we actually want for Guile's
> module system.
>
Are you aware of SRFI-103? It got recently revised to leave out
versions; not supporting them is an option, I guess. Quoting from R6RS:
,----
| When more than one library is identified by a library reference, the
| choice of libraries is determined in some implementation-dependent
| manner.
|
| To avoid problems such as incompatible types and replicated state,
| implementations should prohibit the two libraries whose library names
| consist of the same sequence of identifiers but whose versions do not
| match to co-exist in the same program.
`----
This makes me wonder if versions can be used (or rather be relied on)
sensibly in portable libraries at all...
Regards, Rotty
--
Andreas Rottmann -- <http://rotty.yi.org/>
^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-11-18 1:33 ` Andreas Rottmann
@ 2009-11-18 6:40 ` Julian Graham
2009-12-13 3:24 ` Julian Graham
0 siblings, 1 reply; 19+ messages in thread
From: Julian Graham @ 2009-11-18 6:40 UTC (permalink / raw)
To: Andreas Rottmann; +Cc: Andy Wingo, guile-devel
Hi Andreas,
> IIRC, R6RS doesn't /require/ that implementations are able to
> differentiate bindings from different phases -- e.g. Ikarus essentially
> ignores phase specifications (implicit phasing -- there were some
> discussions about that on ikarus-users, which I can't find ATM, but [0]
> should sum the issue up nicely).
You're right, it doesn't -- at least, it's not required that an
implementation prevent you from referencing an identifier at a phase
other than the one it was imported for. I was reading that part of
the spec in terms of non-macro definitions, but, come to think of it,
it's got to apply to macros as well. So importing everything at once
sounds like it'll work just fine.
> Are you aware of SRFI-103? It got recently revised to leave out
> versions; not supporting them is an option, I guess. Quoting from R6RS:
I was tracking SRFI-103 for a while back when it was (I think)
SRFI-100. I'm interested to see how it pans out, but I'm not sure I
agree with its rationale -- it seems mostly useful for implementations
that don't currently have their own library search mechanism. The bit
about "distributing and using library files in a portable way" seems a
bit hand-wavy to me.
> This makes me wonder if versions can be used (or rather be relied on)
> sensibly in portable libraries at all...
Yes, it's a bit thorny. We discussed the limitations in a thread [1]
a while back. The implementation I did reflects the outcome of that
thread, which was that the version of a library that gets loaded is a
function of the import statements, the available libraries, and the
set of already-loaded libraries -- which means that it's not a fully
predictable process from the point of view of library authors, but
that in practice, collisions aren't likely for a variety of reasons.
Regards,
Julian
[1] - http://www.mail-archive.com/guile-devel@gnu.org/msg03673.html
^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-11-18 6:40 ` Julian Graham
@ 2009-12-13 3:24 ` Julian Graham
2009-12-22 0:10 ` Andy Wingo
0 siblings, 1 reply; 19+ messages in thread
From: Julian Graham @ 2009-12-13 3:24 UTC (permalink / raw)
To: guile-devel
[-- Attachment #1: Type: text/plain, Size: 367 bytes --]
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
[-- Attachment #2: 0001-Support-for-renaming-bindings-on-module-export.patch --]
[-- Type: text/x-patch, Size: 7226 bytes --]
From bb83bbd13263aca6a1e8b246fd68ce96f5dcdb43 Mon Sep 17 00:00:00 2001
From: Julian Graham <julian.graham@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
[-- Attachment #3: 0002-Complete-support-for-version-information-in-Guile-s-.patch --]
[-- Type: text/x-patch, Size: 17893 bytes --]
From 6dfb5e096b663a143cbacf1d7878bfdd54ee2b5a Mon Sep 17 00:00:00 2001
From: Julian Graham <julian.graham@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
^ permalink raw reply related [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-12-13 3:24 ` Julian Graham
@ 2009-12-22 0:10 ` Andy Wingo
2009-12-23 15:35 ` Julian Graham
0 siblings, 1 reply; 19+ messages in thread
From: Andy Wingo @ 2009-12-22 0:10 UTC (permalink / raw)
To: Julian Graham; +Cc: guile-devel
On Sun 13 Dec 2009 04:24, Julian Graham <joolean@gmail.com> writes:
> 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.
Thanks for all. I wrapped your commit messages, detabbed the files, and
did some minor editing. Please look at the diffs relative to your
patches. But other than that, thanks very much! :-))
Andy
--
http://wingolog.org/
^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-12-22 0:10 ` Andy Wingo
@ 2009-12-23 15:35 ` Julian Graham
2009-12-23 16:10 ` Neil Jerram
2009-12-24 13:25 ` Andy Wingo
0 siblings, 2 replies; 19+ messages in thread
From: Julian Graham @ 2009-12-23 15:35 UTC (permalink / raw)
To: Andy Wingo; +Cc: guile-devel
> Thanks for all. I wrapped your commit messages, detabbed the files, and
> did some minor editing. Please look at the diffs relative to your
> patches. But other than that, thanks very much! :-))
No, thank /you/! ¡Que buena sorpresa!
On a related note, I assume Emacs' `scheme-mode' has been adding
unwanted tabs? What should I do to correct this in my local
environment?
Regards,
Julian
^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-12-23 15:35 ` Julian Graham
@ 2009-12-23 16:10 ` Neil Jerram
2009-12-28 22:42 ` Ludovic Courtès
2009-12-24 13:25 ` Andy Wingo
1 sibling, 1 reply; 19+ messages in thread
From: Neil Jerram @ 2009-12-23 16:10 UTC (permalink / raw)
To: Julian Graham; +Cc: Andy Wingo, guile-devel
Julian Graham <joolean@gmail.com> writes:
> On a related note, I assume Emacs' `scheme-mode' has been adding
> unwanted tabs? What should I do to correct this in my local
> environment?
(setq indent-tabs-mode nil)
Neil
^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-12-23 15:35 ` Julian Graham
2009-12-23 16:10 ` Neil Jerram
@ 2009-12-24 13:25 ` Andy Wingo
2009-12-27 20:04 ` Julian Graham
1 sibling, 1 reply; 19+ messages in thread
From: Andy Wingo @ 2009-12-24 13:25 UTC (permalink / raw)
To: Julian Graham; +Cc: guile-devel
On Wed 23 Dec 2009 16:35, Julian Graham <joolean@gmail.com> writes:
>> Thanks for all. I wrapped your commit messages, detabbed the files, and
>> did some minor editing. Please look at the diffs relative to your
>> patches. But other than that, thanks very much! :-))
>
> No, thank /you/! ¡Que buena sorpresa!
>
> On a related note, I assume Emacs' `scheme-mode' has been adding
> unwanted tabs? What should I do to correct this in my local
> environment?
M-x customize-variable indent-tabs-mode, change to nil.
Cheers,
Andy
--
http://wingolog.org/
^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-12-24 13:25 ` Andy Wingo
@ 2009-12-27 20:04 ` Julian Graham
0 siblings, 0 replies; 19+ messages in thread
From: Julian Graham @ 2009-12-27 20:04 UTC (permalink / raw)
To: guile-devel
[-- Attachment #1: Type: text/plain, Size: 2441 bytes --]
Hi all,
Find attached a revised and polished version of the `(ice-9
r6rs-libraries)' module I submitted a couple of months ago. This
version includes the following changes:
* The library transformer code's been cleaned up and compacted (by
more than 30%) and now uses a `defmacro' form similar to the one used
by `use-modules' and `define-module' instead of the messy
syncase-based transformer it was using originally.
* I've re-organized the code to more closely resemble the structure of
`use-modules' and 'define-module' -- the macros delegate syntax
parsing to a set of "processing" functions. In addition to making the
macros simpler, this should make it easier to unify the module and
library systems in the future, if desired.
* I've added an `import' macro as specified by R6RS 8.1 "Top Level
Program Syntax" [0].
* The module also supports the convention, specified by SRFI-97, that
SRFIs can be loaded as R6RS libraries by importing them as `(srfi
:[n])' -- my implementation transforms library names of that form to
the form used by Guile, `(srfi srfi-[n])'.
In case anyone missed the earlier emails on this topic, this module
contains macros that transform the R6RS `library' and 'import' forms
into Guile's native `define-module' and 'use-modules' forms. In
concert with the version and binding export patches that were pushed
last week, this means that Guile now supports R6RS 7 "Libraries" [1],
and can thus share code (unmodified!) with any other conforming Scheme
implementation.
I consider this version of the code to be tentatively "complete." You
can try it out by dropping r6rs-libraries.scm into module/ice-9 and
then loading it in the REPL or including it as a dependency of a
normal Guile module. I'm very interested in any feedback people might
have, particularly when it comes to the name of the module and where
it belongs / when it should be loaded (always? Not in the REPL?). If
no one objects, I'll add some documentation and push it.
As I mentioned to Andy on IRC, I'm working on a first pass at a set of
implementations of the R6RS Standard Libraries (minus the work already
done by Ludovic et al on bytevectors, etc.), as much as possible as
wrappers around Guile's existing functionality. I should have some
status on that soon.
Regards,
Julian
[0] - http://www.r6rs.org/final/html/r6rs/r6rs-Z-H-11.html#node_sec_8.1
[1] - http://www.r6rs.org/final/html/r6rs/r6rs-Z-H-10.html#node_chap_7
[-- Attachment #2: r6rs-libraries.scm --]
[-- Type: text/x-scheme, Size: 4630 bytes --]
;;; r6rs-libraries.scm --- Support for R6RS `library' and `import' forms
;; Copyright (C) 2009 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 as published by the Free Software Foundation; either
;; version 3 of the License, or (at your option) any later version.
;;
;; This library is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
^L
(define-module (ice-9 r6rs-libraries)
#:use-module (ice-9 optargs)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
#:use-module (srfi srfi-11)
#:export-syntax (library import))
(define (name-and-version lst)
(let-values (((head tail) (split-at lst (- (length lst) 1))))
(if (pair? (car tail)) (values head (car tail)) (values lst '()))))
(define srfi-regex (make-regexp "^\\:([0-9]+)$"))
(define* (process-import args #:optional import-map)
(define (flatten im)
(define (load-library library-ref)
(define (transform-library-name name)
(define (make-srfi m)
(cons 'srfi (list (string->symbol
(string-append "srfi-" (match:substring m 1))))))
(or (and (>= (length name) 2)
(eq? (car name) 'srfi)
(and=> (regexp-exec srfi-regex (symbol->string (cadr name)))
make-srfi))
name))
(let-values (((name version) (name-and-version library-ref)))
(resolve-interface (transform-library-name name) #:version version)))
(define (exeq? x y) (if (list? y) (eq? x (cadr y)) (eq? x y)))
(if (or (not (list? im))) (error))
(let* ((op (car im))
(l (case op
((only except prefix rename) (flatten (cadr im)))
((library) (load-library (cadr im)))
(else (load-library im)))))
(case op
((library) (cons l (module-map (lambda (sym var) sym) l)))
((only) (cons (car l) (lset-intersection exeq? (cdr l) (cddr im))))
((except) (cons (car l) (lset-difference exeq? (cdr l) (cddr im))))
((prefix) (let ((p (symbol-prefix-proc (caddr im))))
(cons (car l) (map (lambda (x)
(if (list? x)
(cons (car x) (p (cadr x)))
(cons x (p x))))
(cdr l)))))
((rename) (let ((f (lambda (y)
(eq? (car y) (if (list? x) (car x) x)))))
(cons (car l)
(map (lambda (x)
(let ((r (find f (cddr im))))
(if r (cons (if (list? x) (car x) x)
(cadr x)) x)))
(cdr l)))))
(else (cons l (module-map (lambda (sym var) sym) l))))))
(let* ((unwrapped-import-spec (if (eq? (car args) 'for) (cadr args) args))
(ilist (flatten unwrapped-import-spec))
(public-interface (car ilist)))
(if import-map (for-each (lambda (x) (hashq-set! import-map x #t))
(map (lambda (x) (if (pair? x) (cdr x) x))
(cdr ilist))))
(append (list (module-name public-interface))
(if (module-version public-interface)
(list #:version (module-version public-interface))
(list))
(if (null? (cdr ilist)) '() (list #:select (cdr ilist))))))
(define (process-library args)
(define (resolve-export-spec export-specs imports)
(define (imported? sym) (hashq-ref imports sym))
(define (flatten-renames export-spec)
(if (list? export-spec)
(map (lambda (x) (cons (car x) (cadr x))) (cdr export-spec))
(list export-spec)))
(partition imported? (apply append (map flatten-renames export-specs))))
(let ((import-map (make-hash-table)))
(let-values
(((library-name version) (name-and-version (car args)))
((imports)
(apply append (map (lambda (x)
(list #:use-module (process-import x import-map)))
(cdaddr args))))
((re-exports exports) (resolve-export-spec (cdadr args) import-map)))
`(define-module ,library-name
,@(if (null? version) '() (cons #:version version))
,@imports
,@(if (null? exports) '() (list #:export exports))
,@(if (null? re-exports) '() (list #:re-export re-exports))))))
(defmacro library args
(let ((transformed-args (process-library args)))
`(begin
,transformed-args
,@(cdddr args))))
(defmacro import args
(let ((transformed-args (map process-import args)))
`(use-modules ,@transformed-args)))
;;; r6rs-libraries.scm ends here
^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: r6rs libraries, round three
2009-12-23 16:10 ` Neil Jerram
@ 2009-12-28 22:42 ` Ludovic Courtès
0 siblings, 0 replies; 19+ messages in thread
From: Ludovic Courtès @ 2009-12-28 22:42 UTC (permalink / raw)
To: guile-devel
Hello,
Neil Jerram <neil@ossau.uklinux.net> writes:
> Julian Graham <joolean@gmail.com> writes:
>
>> On a related note, I assume Emacs' `scheme-mode' has been adding
>> unwanted tabs? What should I do to correct this in my local
>> environment?
>
> (setq indent-tabs-mode nil)
We should put that in ‘.dir-locals.el’, once for all.
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 19+ messages in thread
end of thread, other threads:[~2009-12-28 22:42 UTC | newest]
Thread overview: 19+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2009-09-26 20:10 r6rs libraries, round three Julian Graham
2009-10-01 4:32 ` Julian Graham
2009-10-24 19:10 ` Julian Graham
2009-10-25 22:01 ` Andy Wingo
2009-10-26 3:53 ` Julian Graham
2009-11-01 19:26 ` Julian Graham
2009-11-16 20:47 ` Julian Graham
2009-11-17 19:56 ` Andy Wingo
2009-11-17 20:55 ` Julian Graham
2009-11-18 1:33 ` Andreas Rottmann
2009-11-18 6:40 ` Julian Graham
2009-12-13 3:24 ` Julian Graham
2009-12-22 0:10 ` Andy Wingo
2009-12-23 15:35 ` Julian Graham
2009-12-23 16:10 ` Neil Jerram
2009-12-28 22:42 ` Ludovic Courtès
2009-12-24 13:25 ` Andy Wingo
2009-12-27 20:04 ` Julian Graham
2009-11-18 1:18 ` Andreas Rottmann
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).