[Guile-commits] GNU Guile branch, wip-r6rs-libraries, updated. release_1-9-8-95-gbd8f6ea

[Julian Graham]

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=bd8f6ea27b3165835159ee7d497d9ba21b5373f8

The branch, wip-r6rs-libraries has been updated
       via  bd8f6ea27b3165835159ee7d497d9ba21b5373f8 (commit)
       via  df4fe677417bbf8accbf9d9f30798c06bcffdaaf (commit)
       via  61c295c8e405124711c579b30893787b8112b7d6 (commit)
      from  c5fe4d905656a0fa71b76298c5390c339e6903f9 (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 bd8f6ea27b3165835159ee7d497d9ba21b5373f8
Author: Julian Graham <address@hidden>
Date:   Tue Mar 30 14:38:27 2010 -0400

    Implementation and test case for R6RS (rnrs eval) library.
    
    * module/Makefile.am: Add rnrs/6/eval.scm to RNRS_SOURCES.
    * module/rnrs/6/eval.scm: New file
    * test-suite/Makefile.am: Add tests/r6rs-eval.test to SCM_TESTS.
    * test-suite/tests/r6rs-eval.test: New file.

commit df4fe677417bbf8accbf9d9f30798c06bcffdaaf
Author: Julian Graham <address@hidden>
Date:   Tue Mar 30 14:27:00 2010 -0400

    Fix syntax and consolidate imports for (rnrs lists).
    
    * module/rnrs/6/lists.scm: Import syntax is
      `(only (import-set) id-1 ...)', not `(only (import-set) (id-1 ...))';
      use `rename' form as wrapper instead of creating separate custom
      interface on SRFI-1.

commit 61c295c8e405124711c579b30893787b8112b7d6
Author: Julian Graham <address@hidden>
Date:   Tue Mar 30 14:17:43 2010 -0400

    Resolve syncase pattern matching issue with `prefix' import form.
    
    * module/ice-9/boot-9.scm (import): Prevent local binding for `prefix'
      function from overriding the literal declaration in the syntax-case
      expression.

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

Summary of changes:
 module/Makefile.am                                 |    1 +
 module/ice-9/boot-9.scm                            |   13 ++++---
 module/rnrs/6/{control.scm => eval.scm}            |   34 +++++++++++--------
 module/rnrs/6/lists.scm                            |   27 ++++++++++-----
 test-suite/Makefile.am                             |    1 +
 .../tests/r6rs-eval.test                           |   16 ++++++---
 6 files changed, 58 insertions(+), 34 deletions(-)
 copy module/rnrs/6/{control.scm => eval.scm} (56%)
 copy module/rnrs/6/programs.scm => test-suite/tests/r6rs-eval.test (64%)

diff --git a/module/Makefile.am b/module/Makefile.am
index 363849f..6271c13 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -260,6 +260,7 @@ RNRS_SOURCES =                                      \
   rnrs/6/conditions.scm                                \
   rnrs/6/control.scm                           \
   rnrs/6/enums.scm                             \
+  rnrs/6/eval.scm                              \
   rnrs/6/exceptions.scm                                \
   rnrs/6/files.scm                             \
   rnrs/6/hashtables.scm                                \
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 55bfd51..2a9ed4e 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -3259,10 +3259,10 @@ module '(ice-9 q) '(make-q q-length))}."
   (lambda (stx)
     (define transform-import-set
       (lambda (stx)
-       (define (prefix pre str) (string->symbol (string-append pre str)))
+       (define (add-prefix pre str) (string->symbol (string-append pre str)))
        (define (load-library name version)
          (define (transform-library-name name)
-           (define (make-srfi n) (cons 'srfi (list (prefix "srfi-" n))))
+           (define (make-srfi n) (cons 'srfi (list (add-prefix "srfi-" n))))
            (or (and (>= (length name) 2)
                     (eq? (car name) 'srfi)
                     (let* ((str (symbol->string (cadr name)))
@@ -3291,12 +3291,13 @@ module '(ice-9 q) '(make-q q-length))}."
                   (except-set (syntax->datum #'(identifier ...))))            
               (cons (car inner) (filter (lambda (s) (not (memq s except-set))) 
                                         (cdr inner)))))
-           ((prefix import-set ident)
+           ((prefix import-set identifier)
             (let ((inner (f #'import-set))
-                  (prefix-string (symbol->string (syntax->datum #'ident))))
+                  (prefix-string (symbol->string 
+                                  (syntax->datum #'identifier))))
               (cons (car inner)
-                    (map (lambda (s)
-                           (cons s (prefix prefix-string (symbol->string s))))
+                    (map (lambda (s) (cons s (add-prefix prefix-string 
+                                                         (symbol->string s))))
                          (cdr inner)))))
            ((rename import-set (id-1 id-2) ...)
             (let* ((inner (f #'import-set))
diff --git a/module/rnrs/6/control.scm b/module/rnrs/6/eval.scm
similarity index 56%
copy from module/rnrs/6/control.scm
copy to module/rnrs/6/eval.scm
index 69351c6..d58f877 100644
--- a/module/rnrs/6/control.scm
+++ b/module/rnrs/6/eval.scm
@@ -1,4 +1,4 @@
-;;; control.scm --- The R6RS control structures library
+;;; eval.scm --- The R6RS `eval' library
 
 ;;      Copyright (C) 2010 Free Software Foundation, Inc.
 ;;
@@ -17,17 +17,23 @@
 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 
-(library (rnrs control (6))
-  (export when unless do case-lambda)
-  (import (rnrs base (6))
-          (only (guile) do case-lambda))
+(library (rnrs eval (6))
+  (export eval environment)
+  (import (only (guile) eval 
+                       make-module 
+                       module-uses
+                       beautify-user-module! 
+                       set-module-uses!)
+         (rnrs base (6))
+         (rnrs io simple (6))
+         (rnrs lists (6)))
 
-  (define-syntax when
-    (syntax-rules ()
-      ((when test result1 result2 ...)
-       (if test (begin result1 result2 ...)))))
-
-  (define-syntax unless
-    (syntax-rules ()
-      ((unless test result1 result2 ...)
-       (if (not test) (begin result1 result2 ...))))))
+  (define (environment . import-specs)
+    (let ((module (make-module))
+         (needs-purify? (not (member '(guile) import-specs))))
+      (beautify-user-module! module)
+      (for-each (lambda (import-spec) (eval (list 'import import-spec) module))
+               import-specs)
+      (if needs-purify? (set-module-uses! module (cdr (module-uses module))))
+      module))
+)
diff --git a/module/rnrs/6/lists.scm b/module/rnrs/6/lists.scm
index 7544a73..c9d913b 100644
--- a/module/rnrs/6/lists.scm
+++ b/module/rnrs/6/lists.scm
@@ -21,15 +21,24 @@
   (export find for-all exists filter partition fold-left fold-right remp 
remove 
          remv remq memp member memv memq assp assoc assv assq cons*)
   (import (rnrs base (6))
-          (only (guile) (filter member memv memq assoc assv assq cons*))
-         (only (srfi srfi-1) (find partition fold-right filter-map))
-         (rename (srfi srfi-1) (fold fold-left) 
-                               (any exists) 
-                               (every for-all)
-                               (remove remp)
-                               
-                               (member memp-internal)
-                               (assoc assp-internal)))
+          (only (guile) filter member memv memq assoc assv assq cons*)
+         (rename (only (srfi srfi-1) fold 
+                                     any 
+                                     every 
+                                     remove 
+                                     member 
+                                     assoc 
+                                     find 
+                                     partition
+                                     fold-right 
+                                     filter-map)
+                 (fold fold-left) 
+                 (any exists) 
+                 (every for-all)
+                 (remove remp)
+                 
+                 (member memp-internal)
+                 (assoc assp-internal)))
 
   (define (remove obj list) (remp (lambda (elt) (equal? obj elt)) list))
   (define (remv obj list) (remp (lambda (elt) (eqv? obj elt)) list))
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 17fdde2..849b004 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -74,6 +74,7 @@ SCM_TESTS = tests/alist.test                  \
            tests/r6rs-conditions.test          \
            tests/r6rs-control.test             \
            tests/r6rs-enums.test               \
+           tests/r6rs-eval.test                \
            tests/r6rs-exceptions.test          \
            tests/r6rs-files.test               \
            tests/r6rs-hashtables.test          \
diff --git a/module/rnrs/6/programs.scm b/test-suite/tests/r6rs-eval.test
similarity index 64%
copy from module/rnrs/6/programs.scm
copy to test-suite/tests/r6rs-eval.test
index 4daa781..cfc4b6b 100644
--- a/module/rnrs/6/programs.scm
+++ b/test-suite/tests/r6rs-eval.test
@@ -1,11 +1,11 @@
-;;; programs.scm --- The R6RS process management library
+;;; r6rs-eval.test --- Test suite for R6RS (rnrs eval)
 
 ;;      Copyright (C) 2010 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.
+;; version 3 of the Lice6nse, 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
@@ -17,6 +17,12 @@
 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 
-(library (rnrs programs (6))
-  (export command-line exit)
-  (import (only (guile) command-line exit)))
+(define-module (test-suite test-rnrs-eval)
+  :use-module ((rnrs eval) :version (6))
+  :use-module (test-suite lib))
+
+(with-test-prefix "environment"
+  (pass-if "simple"
+    (eqv? (eval '(eval:car (eval:cons 2 4))
+               (environment '(prefix (only (rnrs base) car cons) eval:)))
+         2)))


hooks/post-receive
-- 
GNU Guile