[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-125-g1052739

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=1052739b74380978a080ee5604cb1a8d0648a4d6

The branch, master has been updated
       via  1052739b74380978a080ee5604cb1a8d0648a4d6 (commit)
       via  73b03e98a74b213ecb8907a649e0d00234cf237d (commit)
      from  eba5ea7a4f780115cd49c90bcec7624d5481802b (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 1052739b74380978a080ee5604cb1a8d0648a4d6
Author: Andy Wingo <address@hidden>
Date:   Sun Jun 20 23:59:57 2010 +0200

    rnrs modules #:replace as appropriate
    
    * module/ice-9/boot-9.scm (export!): New syntax, as export is to
      module-export!, export! is to module-replace!. I thought that taking
      up the name `replace' would be presumptuous, hence the name mismatch.
    
    * module/ice-9/r6rs-libraries.scm (library): Calculate not only
      re-exports, but replacements as well.

commit 73b03e98a74b213ecb8907a649e0d00234cf237d
Author: Andy Wingo <address@hidden>
Date:   Sun Jun 20 23:15:29 2010 +0200

    ensure unicode-capable rnrs string ports
    
    * module/rnrs/io/ports.scm (open-string-input-port):
      (open-string-output-port): Ensure that the ports are unicode-capable
      by binding %default-port-encoding to "UTF-8".

-----------------------------------------------------------------------

Summary of changes:
 module/ice-9/boot-9.scm         |    8 ++++++++
 module/ice-9/r6rs-libraries.scm |   38 +++++++++++++++++++++++++-------------
 module/rnrs/io/ports.scm        |    6 ++++--
 3 files changed, 37 insertions(+), 15 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 89abc36..3803ba2 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -3036,6 +3036,14 @@ module '(ice-9 q) '(make-q q-length))}."
         (lambda ()
           (module-re-export! (current-module) '(name ...))))))))
 
+(define-syntax export!
+  (syntax-rules ()
+    ((_ name ...)
+     (eval-when (eval load compile expand)
+       (call-with-deferred-observers
+        (lambda ()
+          (module-replace! (current-module) '(name ...))))))))
+
 (define-syntax export-syntax
   (syntax-rules ()
     ((_ name ...)
diff --git a/module/ice-9/r6rs-libraries.scm b/module/ice-9/r6rs-libraries.scm
index 6fcde27..bf1127e 100644
--- a/module/ice-9/r6rs-libraries.scm
+++ b/module/ice-9/r6rs-libraries.scm
@@ -121,26 +121,36 @@
     (define (compute-exports ifaces specs)
       (define (re-export? sym)
         (or-map (lambda (iface) (module-local-variable iface sym)) ifaces))
+      (define (replace? sym)
+        (module-local-variable the-scm-module sym))
       
-      (let lp ((specs specs) (e '()) (r '()))
+      (let lp ((specs specs) (e '()) (r '()) (x '()))
         (syntax-case specs (rename)
-          (() (values e r))
+          (() (values e r x))
           (((rename (from to) ...) . rest)
            (and (and-map identifier? #'(from ...))
                 (and-map identifier? #'(to ...)))
-           (let lp2 ((in #'((from . to) ...)) (e e) (r r))
+           (let lp2 ((in #'((from . to) ...)) (e e) (r r) (x x))
              (syntax-case in ()
-               (() (lp #'rest e r))
+               (() (lp #'rest e r x))
                (((from . to) . in)
-                (if (re-export? (syntax->datum #'from))
-                    (lp2 #'in e (cons #'(from . to) r))
-                    (lp2 #'in (cons #'(from . to) e) r))))))
+                (cond
+                 ((re-export? (syntax->datum #'from))
+                  (lp2 #'in e (cons #'(from . to) r) x))
+                 ((replace? (syntax->datum #'from))
+                  (lp2 #'in e r (cons #'(from . to) x)))
+                 (else
+                  (lp2 #'in (cons #'(from . to) e) r x)))))))
           ((id . rest)
            (identifier? #'id)
            (let ((sym (syntax->datum #'id)))
-             (if (re-export? sym)
-                 (lp #'rest e (cons #'id r))
-                 (lp #'rest (cons #'id e) r)))))))
+             (cond
+              ((re-export? sym)
+               (lp #'rest e (cons #'id r) x))
+              ((replace? sym)
+               (lp #'rest e r (cons #'id x)))
+              (else
+               (lp #'rest (cons #'id e) r x))))))))
 
     (syntax-case stx (export import)
       ((_ (name name* ...)
@@ -169,9 +179,10 @@
                        (import-set (resolve-r6rs-interface #'import-set))))
                    #'(ispec ...))
               #'(espec ...)))
-         (lambda (exports re-exports)
+         (lambda (exports re-exports replacements)
            (with-syntax (((e ...) exports)
-                         ((r ...) re-exports))
+                         ((r ...) re-exports)
+                         ((x ...) replacements))
              ;; It would be nice to push the module that was current before the
              ;; definition, and pop it after the library definition, but I
              ;; actually can't see a way to do that. Helper procedures perhaps,
@@ -183,8 +194,9 @@
                    #:version (version ...))
                  (import ispec)
                  ...
-                 (re-export r ...)
                  (export e ...)
+                 (re-export r ...)
+                 (export! x ...)
                  (@@ (name name* ...) body)
                  ...))))))))
     
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
index 4916bba..04dabe6 100644
--- a/module/rnrs/io/ports.scm
+++ b/module/rnrs/io/ports.scm
@@ -110,12 +110,14 @@ read from/written to in @var{port}."
 
 (define (open-string-input-port str)
   "Open an input port that will read from @var{str}."
-  (open-input-string str))
+  (with-fluids ((%default-port-encoding "UTF-8"))
+    (open-input-string str)))
 
 (define (open-string-output-port)
   "Return two values: an output port that will collect characters written to it
 as a string, and a thunk to retrieve the characters associated with that port."
-  (let ((port (open-output-string)))
+  (let ((port (with-fluids ((%default-port-encoding "UTF-8"))
+                (open-output-string))))
     (values port
             (lambda () (get-output-string port)))))
 


hooks/post-receive
-- 
GNU Guile