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 <[email protected]> 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 <[email protected]> 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 <[email protected]> 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
