summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
Diffstat (limited to 'module')
-rw-r--r--module/Makefile.am3
-rw-r--r--module/language/tree-il/primitives.scm12
-rw-r--r--module/srfi/srfi-111.scm37
3 files changed, 48 insertions, 4 deletions
diff --git a/module/Makefile.am b/module/Makefile.am
index 4c75221f1..362170693 100644
--- a/module/Makefile.am
+++ b/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 \
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index 84c07a0ea..71437b2b6 100644
--- a/module/language/tree-il/primitives.scm
+++ b/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 +
diff --git a/module/srfi/srfi-111.scm b/module/srfi/srfi-111.scm
new file mode 100644
index 000000000..3d3cd896b
--- /dev/null
+++ b/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)))