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