r6rs libraries, round three

[Julian Graham <joolean@gmail.com>]

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