r6rs libraries, round three

View: New views
12 Messages — Rating Filter:   Alert me  

r6rs libraries, round three

by Julian Graham :: Rate this Message:

Reply to Author | View Threaded | Show Only this Message

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@.../msg03259.html
[2] - http://article.gmane.org/gmane.lisp.guile.devel/8585

[0001-Initial-support-for-version-information-in-Guile-s.patch]

From a1d49c00cd6cc144bf526481e5ba7da6aefa0822 Mon Sep 17 00:00:00 2001
From: Julian Graham <julian.graham@...>
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



Re: r6rs libraries, round three

by Julian Graham :: Rate this Message:

Reply to Author | View Threaded | Show Only this Message

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

[0001-Initial-support-for-version-information-in-Guile-s.patch]

From a1d49c00cd6cc144bf526481e5ba7da6aefa0822 Mon Sep 17 00:00:00 2001
From: Julian Graham <julian.graham@...>
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



[0002-Complete-support-for-version-information-in-Guile-s.patch]

From 0c44462a331f3b3b2ce641fd083e11dacc55970b Mon Sep 17 00:00:00 2001
From: Julian Graham <julian.graham@...>
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



Re: r6rs libraries, round three

by Julian Graham :: Rate this Message:

Reply to Author | View Threaded | Show Only this Message

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



Re: r6rs libraries, round three

by Andy Wingo :: Rate this Message:

Reply to Author | View Threaded | Show Only this Message

Hi Julian,

On Sat 24 Oct 2009 21:10, Julian Graham <joolean@...> 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/



Re: r6rs libraries, round three

by Julian Graham :: Rate this Message:

Reply to Author | View Threaded | Show Only this Message

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



Re: r6rs libraries, round three

by Julian Graham :: Rate this Message:

Reply to Author | View Threaded | Show Only this Message

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@.../msg04506.html
[2] - http://www.mail-archive.com/guile-devel@.../msg04660.html

[0001-Complete-support-for-version-information-in-Guile-s.patch]

From adcbc77ca4ca68f26da05a204154d826a832a7b7 Mon Sep 17 00:00:00 2001
From: Julian Graham <julian.graham@...>
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



[0001-Support-for-renaming-bindings-on-module-export.patch]

From d5b1ca509e6888119702e75ce35cd1e55d295525 Mon Sep 17 00:00:00 2001
From: Julian Graham <julian.graham@...>
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



[r6rs-libraries.scm]

(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)))))))))




r6rs-examples.tar.gz (1K) Download Attachment
r6rs-libs.tar.gz (3K) Download Attachment

Re: r6rs libraries, round three

by Julian Graham :: Rate this Message:

Reply to Author | View Threaded | Show Only this Message

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



Re: r6rs libraries, round three

by Andy Wingo :: Rate this Message:

Reply to Author | View Threaded | Show Only this Message

Hi Julian!

On Sun 01 Nov 2009 20:26, Julian Graham <joolean@...> 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/



Re: r6rs libraries, round three

by Julian Graham :: Rate this Message:

Reply to Author | View Threaded | Show Only this Message

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



Re: r6rs libraries, round three

by Andreas Rottmann :: Rate this Message:

Reply to Author | View Threaded | Show Only this Message

Andy Wingo <wingo@...> writes:

> Hi Julian!
>
> On Sun 01 Nov 2009 20:26, Julian Graham <joolean@...> 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/>



Re: r6rs libraries, round three

by Andreas Rottmann :: Rate this Message:

Reply to Author | View Threaded | Show Only this Message

Julian Graham <joolean@...> 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/>



Re: r6rs libraries, round three

by Julian Graham :: Rate this Message:

Reply to Author | View Threaded | Show Only this Message

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@.../msg03673.html