Implementation and test cases for the R6RS (rnrs control) library.

* module/Makefile.am: Add rnrs/6/base.scm and rnrs/6/control.scm to
  RNRS_SOURCES.
* module/rnrs/6/base.scm, control.scm: New files.
* test-suite/Makefile.am: Add tests/r6rs-control.test to SCM_TESTS.
* test-suite/tests/r6rs-control.test: New file.

module/Makefile.am

@@ -256,6 +256,8 @@ SRFI_SOURCES = \
   srfi/srfi-98.scm
 
 RNRS_SOURCES =					\
+  rnrs/6/base.scm				\
+  rnrs/6/control.scm				\
   rnrs/bytevector.scm				\
   rnrs/io/ports.scm
 

module/rnrs/6/base.scm

@@ -0,0 +1,77 @@
+;;; base.scm --- The R6RS base library
+
+;;      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.
+;; 
+;; 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
+
+
+(library (rnrs base (6))
+  (export boolean? symbol? char? vector? null? pair? number? string? procedure?
+	 
+	  define define-syntax syntax-rules lambda let let* let-values 
+	  let*-values letrec begin 
+
+	  quote lambda if set! cond case 
+	 
+	  or and not
+	 
+	  eqv? equal? eq?
+	 
+	  + - * / max min abs numerator denominator gcd lcm floor ceiling
+	  truncate round rationalize real-part imag-part make-rectangular angle
+	  div mod div-and-mod div0 mod0 div0-and-mod0
+	  
+	  expt exact-integer-sqrt sqrt exp log sin cos tan asin acos atan 
+	  make-polar magnitude angle
+	 
+	  complex? real? rational? integer? exact? inexact? real-valued?
+	  rational-valued? integer-values? zero? positive? negative? odd? even?
+	  nan? finite? infinite?
+
+	  exact inexact = < > <= >= 
+
+	  number->string string->number
+
+	  cons car cdr caar cadr cdar cddr caaar caadr cadar cdaar caddr cdadr 
+	  cddar cdddr caaaar caaadr caadar cadaar cdaaar cddaar cdadar cdaadr 
+	  cadadr caaddr caddar cadddr cdaddr cddadr cdddar cddddr
+
+	  list? list length append reverse list-tail list-ref map for-each
+
+	  symbol->string symbol->string symbol=?
+
+	  char->integer integer->char char=? char<? char>? char<=? char>=?
+
+	  make-string string string-length string-ref string=? string<? string>?
+	  string<=? string>=? substring string-append string->list list->string
+	  string-for-each string-copy
+
+	  vector? make-vector vector vector-length vector-ref vector-set! 
+	  vector->list list->vector vector-fill! vector-map vector-for-each
+
+	  error assertion-violation assert
+
+	  call-with-current-continuation call/cc call-with-values dynamic-wind
+	  values apply
+
+	  quasiquote unquote unquote-splicing
+
+	  let-syntax letrec-syntax
+
+	  syntax-rules identifier-syntax)
+ (import (guile)
+	 (rename (only (guile (6)) for-each map) (for-each vector-for-each) 
+		                                 (map vector-map))
+	 (srfi srfi-11)))

module/rnrs/6/control.scm

@@ -0,0 +1,33 @@
+;;; control.scm --- The R6RS control structures library
+
+;;      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.
+;; 
+;; 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
+
+
+(library (rnrs control (6))
+  (export when unless do case-lambda)
+  (import (rnrs base (6))
+          (only (guile) do case-lambda))
+
+  (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 ...))))))

test-suite/Makefile.am

@@ -76,6 +76,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/q.test			\
 	    tests/r4rs.test			\
 	    tests/r5rs_pitfall.test		\
+	    tests/r6rs-control.test		\
 	    tests/r6rs-ports.test		\
 	    tests/rnrs-libraries.test		\
 	    tests/ramap.test			\

test-suite/tests/r6rs-control.test

@@ -0,0 +1,34 @@
+;;; r6rs-control.test --- Test suite for R6RS (rnrs control)
+
+;;      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.
+;; 
+;; 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
+
+
+(define-module (test-suite test-rnrs-control)
+  :use-module ((rnrs control) :version (6))
+  :use-module (test-suite lib))
+
+(with-test-prefix "when"
+  (pass-if "when true"
+    (eq? (when (> 3 2) 'greater) 'greater))
+  (pass-if "when false"
+    (unspecified? (when (< 3 2) 'greater))))
+
+(with-test-prefix "unless"
+  (pass-if "unless true"
+    (unspecified? (unless (> 3 2) 'less)))
+  (pass-if "unless false"
+    (eq? (unless (< 3 2) 'less) 'less)))