1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 16:20:17 +02:00

Implement SRFI-111 Boxes.

* module/srfi/srfi-111.scm: New file.
* module/Makefile.am (SRFI_SOURCES): Add srfi/srfi-111.scm.
* test-suite/tests/srfi-111.test: New file.
* test-suite/Makefile.am (SCM_TESTS): Add tests/srfi-111.test.
* doc/ref/srfi-modules.texi (SRFI-111): New node.
This commit is contained in:
Mark H Weaver 2014-01-24 00:21:17 -05:00
parent 60617d819d
commit 3e2e49650c
5 changed files with 130 additions and 1 deletions

View file

@ -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
@ -5181,6 +5182,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:

View file

@ -295,7 +295,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 \

37
module/srfi/srfi-111.scm Normal file
View file

@ -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)))

View file

@ -139,6 +139,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 \

View file

@ -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)))))))