Merge commit 'ca5e0414e9'

Conflicts:
	module/language/tree-il/primitives.scm

doc/ref/srfi-modules.texi

@@ -59,6 +59,7 @@ get the relevant SRFI documents from the SRFI home page
 * SRFI-88::                     Keyword objects.
 * SRFI-98::                     Accessing environment variables.
 * SRFI-105::                    Curly-infix expressions.
+* SRFI-111::                    Boxes.
 @end menu
 
 
@@ -5174,6 +5175,30 @@ directive @code{#!curly-infix-and-bracket-lists}.  For example:
 
 For more information on reader options, @xref{Scheme Read}.
 
+@node SRFI-111
+@subsection SRFI-111 Boxes.
+@cindex SRFI-111
+
+@uref{http://srfi.schemers.org/srfi-111/srfi-111.html, SRFI-111}
+provides boxes: objects with a single mutable cell.
+
+@deffn {Scheme Procedure} box value
+Return a newly allocated box whose contents is initialized to
+@var{value}.
+@end deffn
+
+@deffn {Scheme Procedure} box? obj
+Return true if @var{obj} is a box, otherwise return false.
+@end deffn
+
+@deffn {Scheme Procedure} unbox box
+Return the current contents of @var{box}.
+@end deffn
+
+@deffn {Scheme Procedure} set-box! box value
+Set the contents of @var{box} to @var{value}.
+@end deffn
+
 @c srfi-modules.texi ends here
 
 @c Local Variables:

module/Makefile.am

@@ -310,7 +310,8 @@ SRFI_SOURCES = \
   srfi/srfi-67.scm \
   srfi/srfi-69.scm \
   srfi/srfi-88.scm \
-  srfi/srfi-98.scm
+  srfi/srfi-98.scm \
+  srfi/srfi-111.scm
 
 RNRS_SOURCES =					\
   rnrs/base.scm					\

module/language/tree-il/primitives.scm

@@ -1,6 +1,6 @@
 ;;; open-coding primitive procedures
 
-;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 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
@@ -45,7 +45,7 @@
     values
     eq? eqv? equal?
     memq memv
-    = < > <= >= zero?
+    = < > <= >= zero? positive? negative?
     + * - / 1- 1+ quotient remainder modulo
     ash logand logior logxor lognot
     not
@@ -161,7 +161,7 @@
 (define *effect-free-primitives*
   `(values
     eq? eqv? equal?
-    = < > <= >= zero?
+    = < > <= >= zero? positive? negative?
     ash logand logior logxor lognot
     + * - / 1- 1+ quotient remainder modulo
     not
@@ -374,6 +374,12 @@
 (define-primitive-expander zero? (x)
   (= x 0))
 
+(define-primitive-expander positive? (x)
+  (> x 0))
+
+(define-primitive-expander negative? (x)
+  (< x 0))
+
 ;; FIXME: All the code that uses `const?' is redundant with `peval'.
 
 (define-primitive-expander +

module/srfi/srfi-111.scm

@@ -0,0 +1,37 @@
+;;; srfi-111.scm -- SRFI 111 Boxes
+
+;;      Copyright (C) 2014 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 (srfi srfi-111)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:export (box box? unbox set-box!))
+
+(cond-expand-provide (current-module) '(srfi-111))
+
+(define-record-type <box>
+  (box value)
+  box?
+  (value unbox set-box!))
+
+(set-record-type-printer! <box>
+  (lambda (box port)
+    (display "#<box " port)
+    (display (number->string (object-address box) 16) port)
+    (display " value: ")
+    (write (unbox box) port)
+    (display ">" port)))

test-suite/Makefile.am

@@ -143,6 +143,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/srfi-69.test			\
 	    tests/srfi-88.test			\
 	    tests/srfi-105.test			\
+	    tests/srfi-111.test			\
 	    tests/srfi-4.test			\
 	    tests/srfi-9.test			\
 	    tests/statprof.test			\

test-suite/tests/srfi-111.test

@@ -0,0 +1,65 @@
+;;;; srfi-111.test --- Test suite for SRFI-111 (Boxes). -*- scheme -*-
+;;;;
+;;;; Copyright (C) 2014 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-srfi-111)
+  #:use-module (test-suite lib)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-111))
+
+(with-test-prefix "srfi-111"
+
+  (let ((test-vals '(#f #t #\space "string" -5 #e1e100 1e-30 #(a vector))))
+    (pass-if-equal "box and unbox"
+        test-vals
+      (map (lambda (x)
+             (unbox (box x)))
+           test-vals))
+
+    (pass-if "box?"
+      (and (box? (box 5))
+           (not (any box? test-vals))))
+
+    (pass-if-equal "set-box!"
+        "string"
+      (let ((b (box #f)))
+        (set-box! b "string")
+        (unbox b)))
+
+    (pass-if "eq? on boxes"
+      (let ((box1 (box #f))
+            (box2 (box #f)))
+        (and (eq? box1 box1)
+             (eq? box2 box2)
+             (not (eq? box1 box2)))))
+
+    (pass-if "eqv? on boxes"
+      (let ((box1 (box #f))
+            (box2 (box #f)))
+        (and (eqv? box1 box1)
+             (eqv? box2 box2)
+             (not (eqv? box1 box2)))))
+
+    (pass-if "equal? on boxes"
+      (let ((box1 (box "foo"))
+            (box2 (box "bar")))
+        (and (equal? box1 box1)
+             (equal? box2 box2)
+             (not (equal? box1 box2))
+             ;; Guile extension, not guaranteed by SRFI-111.
+             (begin (set-box! box2 (string #\f #\o #\o))
+                    (equal? box1 box2)))))))