unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
To: guile-devel@gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Subject: [PATCH v3 6/6] module: Add srfi-151.
Date: Sat, 18 Nov 2023 01:05:38 -0500	[thread overview]
Message-ID: <20231118060621.24675-6-maxim.cournoyer@gmail.com> (raw)
In-Reply-To: <20231118060621.24675-1-maxim.cournoyer@gmail.com>

* module/srfi/srfi-151.scm
* module/srfi/srfi-151/bitwise-33.scm
* module/srfi/srfi-151/bitwise-60.scm
* module/srfi/srfi-151/bitwise-other.scm
* test-suite/tests/srfi-151.test
* test-suite/tests/srfi-151-test.scm: New files.
* am/bootstrap.am (SOURCES): Register srfi-151.scm.
(NOCOMP_SOURCES): Register srfi-151/bitwise-33.scm,
srfi-151/bitwise-60.scm and srfi-151/bitwise-other.scm.
* test-suite/Makefile.am (SCM_TESTS): Register srfi-151.test.
(EXTRA_DIST): Register srfi-151-test.scm.
* doc/ref/srfi-modules.texi (SRFI 151): Document it.

---

Changes in v3:
 - Add SRFI 151

 am/bootstrap.am                        |   4 +
 doc/ref/srfi-modules.texi              | 813 +++++++++++++++++++++++++
 module/srfi/srfi-151.scm               |  56 ++
 module/srfi/srfi-151/bitwise-33.scm    | 108 ++++
 module/srfi/srfi-151/bitwise-60.scm    |  70 +++
 module/srfi/srfi-151/bitwise-other.scm |  62 ++
 test-suite/Makefile.am                 |   2 +
 test-suite/tests/srfi-151-test.scm     | 381 ++++++++++++
 test-suite/tests/srfi-151.test         |  46 ++
 9 files changed, 1542 insertions(+)
 create mode 100644 module/srfi/srfi-151.scm
 create mode 100644 module/srfi/srfi-151/bitwise-33.scm
 create mode 100644 module/srfi/srfi-151/bitwise-60.scm
 create mode 100644 module/srfi/srfi-151/bitwise-other.scm
 create mode 100644 test-suite/tests/srfi-151-test.scm
 create mode 100644 test-suite/tests/srfi-151.test

diff --git a/am/bootstrap.am b/am/bootstrap.am
index ae977c48d..002f598ac 100644
--- a/am/bootstrap.am
+++ b/am/bootstrap.am
@@ -350,6 +350,7 @@ SOURCES =					\
   srfi/srfi-125.scm				\
   srfi/srfi-126.scm				\
   srfi/srfi-128.scm				\
+  srfi/srfi-151.scm                             \
   srfi/srfi-171.scm                             \
   srfi/srfi-171/gnu.scm                         \
   srfi/srfi-171/meta.scm                        \
@@ -442,6 +443,9 @@ NOCOMP_SOURCES =				\
   srfi/srfi-125/125.body.scm			\
   srfi/srfi-128/128.body1.scm			\
   srfi/srfi-128/128.body2.scm			\
+  srfi/srfi-151/bitwise-33.scm			\
+  srfi/srfi-151/bitwise-60.scm			\
+  srfi/srfi-151/bitwise-other.scm		\
   system/base/lalr.upstream.scm			\
   system/repl/describe.scm			\
   sxml/sxml-match.ss				\
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 087c27e4b..c42cc4d17 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -67,6 +67,7 @@ get the relevant SRFI documents from the SRFI home page
 * SRFI 125::                    Mutators.
 * SRFI 126::                    R6RS-based hash tables.
 * SRFI 128::                    Comparators.
+* SRFI 151::                    Bitwise Operations.
 * SRFI-171::                    Transducers.
 @end menu
 
@@ -7414,6 +7415,818 @@ returns true, @var{greater-than} is evaluated and its value returned.
 If @var{comparator} is omitted, a default comparator is used.
 @end deffn
 
+@node SRFI 151
+@subsection SRFI 151 Bitwise Operations
+@cindex SRFI 151
+
+@menu
+* SRFI 151 Abstract::
+* SRFI 151 Rationale::
+* SRFI 151 Procedure index::
+* SRFI 151 Basic operations::
+* SRFI 151 Integer operations::
+* SRFI 151 Single-bit operations::
+* SRFI 151 Bit field operations::
+* SRFI 151 Bits conversion::
+* SRFI 151 Fold/unfold and generate::
+@end menu
+
+@node SRFI 151 Abstract
+@subsubsection SRFI 151 Abstract
+
+This SRFI proposes a coherent and comprehensive set of procedures for
+performing bitwise logical operations on integers; it is accompanied by
+a reference implementation of the spec in terms of a set of seven core
+operators.
+
+The precise semantics of these operators is almost never an issue. A
+consistent, portable set of @emph{names} and @emph{parameter
+conventions}, however, is.  Hence this SRFI, which is based mainly on
+@url{https://srfi.schemers.org/srfi-33/srfi-33.html, SRFI 33}, with some
+changes and additions from
+@url{http://srfi.schemers.org/srfi-33/mail-archive/msg00023.html, Olin's
+late revisions to SRFI 33} (which were never consummated).
+@url{https://srfi.schemers.org/srfi-60/srfi-60.html, SRFI 60} (based on
+SLIB) is smaller but has a few procedures of its own; some of its
+procedures have both native (often Common Lisp) and SRFI 33 names.  They
+have been incorporated into this SRFI.
+@url{http://www.r6rs.org/final/html/r6rs-lib/r6rs-lib-Z-H-12.html#node_sec_11.4,
+R6RS} is a subset of SRFI 60, except that all procedure names begin with
+a @code{bitwise-} prefix.  A few procedures have been added from the
+general vector @url{https://srfi.schemers.org/srfi-133/srfi-133.html,
+SRFI 133}.
+
+Among the applications of bitwise operations are: hashing, Galois-field
+calculations of error-detecting and error-correcting codes, cryptography
+and ciphers, pseudo-random number generation, register-transfer-level
+modeling of digital logic designs, Fast-Fourier transforms, packing and
+unpacking numbers in persistent data structures, space-filling curves
+with applications to dimension reduction and sparse multi-dimensional
+database indexes, and generating approximate seed values for
+root-finders and transcendental function algorithms.
+
+@noindent
+This SRFI differs from SRFI 142 in only two ways:
+
+@enumerate
+@item
+The @code{bitwise-if} function has the argument ordering of
+SLIB, SRFI 60, and R6RS rather than the ordering of SRFI 33.
+
+@item
+The order in which bits are processed by the procedures listed in the
+``Bits conversion'' section has been clarified and some of the
+procedures' names have been changed.  See the ``Bit processing order''
+section for details.
+@end enumerate
+
+@node SRFI 151 Rationale
+@subsubsection SRFI 151 Rationale
+
+@subheading General design principles
+
+@itemize
+@item
+These operations interpret exact integers using two's-complement
+representation.
+
+@item
+The associative bitwise ops are required to be n-ary.  Programmers can
+reliably write @code{bitwise-and} with 3 arguments, for example.
+
+@item
+The word @code{or} is never used by itself, only with modifiers:
+@code{xor}, @code{ior}, @code{nor}, @code{orc1}, or @code{orc2}.  This
+is the same rule as Common Lisp.
+
+@item
+Extra and redundant functions such as @code{bitwise-count},
+@code{bitwise-nor}and the bit-field ops have been included.  Settling on
+a standard choice of names makes it easier to read code that uses these
+sorts of operations.  It also means computations can be clearly
+expressed using the more powerful ops rather than synthesized with a
+snarled mess of @code{bitwise-and}s, @code{bitwise-or}s, and
+@code{bitwise-not}s.  What we gain is having an agreed-upon set of names
+by which we can refer to these functions.  If you believe in "small is
+beautiful," then what is your motivation for including anything beyond
+@code{bitwise-nand}?
+
+@item
+Programmers don't have to re-implement the redundant functions, and
+stumble over the boundary cases and error checking, but can express
+themselves using a full palette of building blocks.
+
+@item
+Compilers can directly implement many of these ops for great efficiency
+gains without requiring any tricky analysis.
+
+@item
+Logical right or left shift operations are excluded because they are not
+well defined on general integers; they are only defined on integers in
+some finite range.  Remember that, in this library, integers are
+interpreted as semi-infinite bit strings that have only a finite number
+of ones or a finite number of zeros.  Logical shifting operates on bit
+strings of some fixed size. If we shift left, then leftmost bits "fall
+off" the end (and zeros shift in on the right).  If we shift right, then
+zeros shift into the string on the left (and rightmost bits fall off the
+end). So to define a logical shift operation, we must specify the size
+of the window.
+@end itemize
+
+@subheading Common Lisp
+
+The core of this design mirrors the structure of Common Lisp's pretty
+closely.  Here are some differences:
+
+@itemize
+@item
+"load" and "deposit" are the wrong verbs (e.g., Common Lisp's @code{ldb}
+and @code{dpb} ops), since they have nothing to do with the store.
+
+@item
+@code{boole} has been removed; it is not one with the Way of Scheme.
+Boolean functions are directly encoded in Scheme as first-class
+functions.
+
+@item
+The name choices are more in tune with Scheme conventions (hyphenation,
+using @code{?} to mark a predicate, etc.)  Common Lisp's name choices
+were more historically motivated, for reasons of backward compatibility
+with Maclisp and Zetalisp.
+
+@item
+The prefix @code{log} has been changed to @code{bitwise-} (e.g,
+@code{lognot} to @code{bitwise-not}), as the prefix @code{bitwise-} more
+accurately reflects what they do.
+
+@item
+The six trivial binary boolean ops that return constants, the left or
+right arguments, and the @code{bitwise-not} of the left or right
+arguments, do not appear in this SRFI.
+
+@end itemize
+
+@subheading SRFI 33
+
+This SRFI contains all the procedures of SRFI 33, and retains their
+original names with these exceptions:
+
+@itemize
+@item
+The name @code{bitwise-merge} is replaced by @code{bitwise-if}, the name
+used in SRFI 60 and R6RS.
+
+@item
+The name @code{extract-bit-field} (@code{bit-field-extract} in Olin's
+revisions) is replaced by @code{bit-field}, the name used in SRFI 60 and
+R6RS.
+
+@item
+The names @code{any-bits-set?} and @code{all-bits-set?} are replaced by
+@code{any-bit-set?} and @code{every-bit-set?}, in accordance with Olin's
+revisions.
+
+@item
+The name @code{test-bit-field?} has been renamed @code{bit-field-any?}
+and supplemented with @code{bit-field-every?}, in accordance with Olin's
+revisions.
+
+@item
+Because @code{copy-bit-field} means different things in SRFI 33 and SRFI
+60, SRFI 33's name @code{copy-bit-field} (@code{bit-field-copy} in
+Olin's revisions) has been changed to @code{bit-field-replace-same}
+@end itemize
+
+@subheading SRFI 60
+
+SRFI 60 includes six procedures that do not have SRFI 33 equivalents.
+They are incorporated into this SRFI as follows:
+
+@itemize
+@item
+The names @code{rotate-bit-field} and @code{reverse-bit-field} are
+replaced by @code{bit-field-rotate} and @code{bit-field-reverse}, by
+analogy with Olin's revisions.
+
+@item
+The procedure @code{copy-bit} is incorporated into this SRFI with the
+same name.
+
+@item
+The procedures @code{integer->list} and @code{list->integer}are
+incorporated into this SRFI with the slightly different names
+@code{integer->bits}and @code{bits->integer} because they are
+incompatible with SRFI 60.
+
+@item
+The procedure @code{booleans->integer} is a convenient way to specify a
+bitwise integer: it accepts an arbitrary number of boolean arguments and
+returns a non-negative integer.  So in this SRFI it has the short name
+@code{bits}, roughly analogous to @code{list}, @code{string}, and
+@code{vector}
+@end itemize
+
+@subheading Other sources
+
+@itemize
+@item
+The following procedures are inspired by
+@url{https://srfi.schemers.org/srfi-133/srfi-133.html, SRFI 133}:
+@code{bit-swap}, @code{bitwise-fold}, @code{bitwise-for-each},
+@code{bitwise-unfold}.
+
+@item
+The procedure @code{bit-field-set} is the counterpart of
+@code{bit-field-clear}.
+
+@item
+The procedures @code{bits->vector} and @code{vector->bits} are inspired
+by their list counterparts.
+
+@item
+The @code{make-bitwise-generator} procedure is a generator constructor
+similar to those provided by
+@url{https://srfi.schemers.org/srfi/srfi-127.html, SRFI 127}.
+@end itemize
+
+@subheading Argument ordering and semantics
+
+In general, these procedures place the bitstring arguments to be
+operated on first.  Where the operation is not commutative, the
+"destination" argument that provides the background bits to be operated
+on is placed before the "source" argument that provides the bits to be
+transferred to it.
+
+@itemize
+@item
+In SRFI 33, @code{bitwise-nand} and @code{bitwise-nor} accepted an
+arbitrary number of arguments even though they are not commutative.
+Olin's late revisions made them dyadic, and so does this SRFI.
+
+@item
+Common Lisp bit-field operations use a @emph{byte spec} to encapsulate
+the position and size of the field.  SRFI 33 bit-field operations had
+leading @emph{position} and @emph{size}arguments instead.  These have
+been replaced in this SRFI by trailing @emph{start} (inclusive) and
+@emph{end} (exclusive) arguments, the convention used not only in SRFI
+60 and R6RS but also in most other subsequence operations in Scheme
+standards and SRFIs.
+
+@item
+In SRFI 60, the @code{bitwise-if} function was defined with a different
+argument ordering from SRFI 33's @code{bitwise-merge}, but was provided
+under both names, using the SLIB ordering.  SRFI 142 adopted the SRFI 33
+ordering rather than the SLIB and R6RS ordering.  Since SLIB and R6RS
+have seen far more usage than SRFI 33, this SRFI adopts the SRFI 60
+ordering instead.
+@end itemize
+
+@subheading Bit processing order
+
+In SLIB and SRFI 60, the the order in which bits were processed by
+@code{integer->list} and @code{list->integer} was not clearly specified.
+When SRFI 142 was written, the specification was clarified to process
+bits from least significant to most significant, so that
+@samp{(integer->list 6) => (#f #t #t)}.  However, the SLIB and SRFI 60
+implementation processed them from the most significant bit to the
+least-significant bit, so that @samp{(integer->list 6) => (#t #t #f)}.
+This SRFI retains the little-endian order, but renames the procedures to
+@code{bits->list} and @code{list->bits} to avoid a silent breaking
+change from SLIB and SRFI 60.  The same is true of the closely analogous
+@code{integer->vector}, @code{vector->integer}, and @code{bits}
+procedures.
+
+@node SRFI 151 Procedure index
+@subsubsection SRFI 151 Procedure index
+
+@lisp
+bitwise-not
+bitwise-and   bitwise-ior
+bitwise-xor   bitwise-eqv
+bitwise-nand  bitwise-nor
+bitwise-andc1 bitwise-andc2
+bitwise-orc1  bitwise-orc2
+arithmetic-shift bit-count
+integer-length bitwise-if
+bit-set? copy-bit bit-swap
+any-bit-set? every-bit-set?
+first-set-bit
+bit-field bit-field-any? bit-field-every?
+bit-field-clear bit-field-set
+bit-field-replace  bit-field-replace-same
+bit-field-rotate bit-field-reverse
+bits->list list->bits bits->vector vector->bits
+bits
+bitwise-fold bitwise-for-each bitwise-unfold
+make-bitwise-generator
+@end lisp
+
+In the following procedure specifications all parameters and return
+values are exact integers unless otherwise indicated (except that
+procedures with names ending in @samp{?} are predicates, as usual).  It
+is an error to pass values of other types as arguments to these
+functions.
+
+Bitstrings are represented by exact integers, using a two's-complement
+encoding of the bitstring.  Thus every integer represents a
+semi-infinite bitstring, having either a finite number of zeros
+(negative integers) or a finite number of ones (non-negative integers).
+The bits of a bitstring are numbered from the
+rightmost/least-significant bit: bit #0 is the rightmost or 2@sup{0}
+bit, bit #1 is the next or 2@sup{1} bit, and so forth.
+
+@node SRFI 151 Basic operations
+@subsubsection SRFI 151 Basic operations
+
+@deffn {Scheme Procedure} bitwise-not i
+
+Returns the bitwise complement of @emph{i}; that is, all 1 bits are changed
+to 0 bits and all 0 bits to 1 bits.
+
+@lisp
+  (bitwise-not 10) => -11
+  (bitwise-not -37) => 36
+@end lisp
+
+@end deffn
+
+The following ten procedures correspond to the useful set of non-trivial
+two-argument boolean functions.  For each such function, the
+corresponding bitwise operator maps that function across a pair of
+bitstrings in a bit-wise fashion.  The core idea of this group of
+functions is this bitwise ``lifting'' of the set of dyadic boolean
+functions to bitstring parameters.
+
+@deffn {Scheme Procedure} bitwise-and i @dots{}
+@deffnx {Scheme Procedure} bitwise-ior i @dots{}
+@deffnx {Scheme Procedure} bitwise-xor i @dots{}
+@deffnx {Scheme Procedure} bitwise-eqv i @dots{}
+
+These operations are associative.  When passed no arguments, the procedures
+return the identity values -1, 0, 0, and -1 respectively.
+
+The @code{bitwise-eqv} procedure produces the complement of the
+@code{bitwise-xor} procedure.  When applied to three arguments, it does
+@emph{not} produce a 1 bit everywhere that @var{a}, @var{b} and @var{c}
+all agree.  That is, it does @emph{not} produce:
+
+@lisp
+     (bitwise-ior (bitwise-and a b c)
+                  (bitwise-and (bitwise-not a)
+                               (bitwise-not b)
+                               (bitwise-not c)))
+@end lisp
+
+Rather, it produces @samp{(bitwise-eqv @var{a} (bitwise-eqv @var{b}
+@var{c}))} or the equivalent @samp{(bitwise-eqv (bitwise-eqv @var{a}
+@var{b}) @var{c})}:
+
+@lisp
+      (bitwise-ior 3  10)     =>  11
+      (bitwise-and 11 26)     =>  10
+      (bitwise-xor 3 10)      =>   9
+      (bitwise-eqv 37 12)     => -42
+      (bitwise-and 37 12)     =>   4
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} bitwise-nand i j
+@deffnx {Scheme Procedure} bitwise-nor i j
+@deffnx {Scheme Procedure} bitwise-andc1 i j
+@deffnx {Scheme Procedure} bitwise-andc2 i j
+@deffnx {Scheme Procedure} bitwise-orc1 i j
+@deffnx {Scheme Procedure} bitwise-orc2 i j
+
+These operations are not associative.
+
+@lisp
+      (bitwise-nand 11 26) =>  -11
+      (bitwise-nor  11 26) => -28
+      (bitwise-andc1 11 26) => 16
+      (bitwise-andc2 11 26) => 1
+      (bitwise-orc1 11 26) => -2
+      (bitwise-orc2 11 26) => -17
+@end lisp
+@end deffn
+
+@node SRFI 151 Integer operations
+@subsubsection SRFI 151 Integer operations
+
+@deffn {Scheme Procedure} arithmetic-shift i count
+
+Return the arithmetic left shift when @var{count}>0; right shift when
+@var{count}<0.
+
+@lisp
+    (arithmetic-shift 8 2) => 32
+    (arithmetic-shift 4 0) => 4
+    (arithmetic-shift 8 -1) => 4
+    (arithmetic-shift -100000000000000000000000000000000 -100) => -79
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} bit-count i
+
+Return the population count of 1's (@emph{i} >= 0) or 0's (@emph{i} <
+0).  The result is always non-negative.
+
+@quotation note
+The R6RS analogue @code{bitwise-bit-count} applies @code{bitwise-not} to
+the population count before returning it if @emph{i} is negative.
+@end quotation
+
+@lisp
+    (bit-count 0) =>  0
+    (bit-count -1) =>  0
+    (bit-count 7) =>  3
+    (bit-count  13) =>  3 ;Two's-complement binary: ...0001101
+    (bit-count -13) =>  2 ;Two's-complement binary: ...1110011
+    (bit-count  30) =>  4 ;Two's-complement binary: ...0011110
+    (bit-count -30) =>  4 ;Two's-complement binary: ...1100010
+    (bit-count (expt 2 100)) =>  1
+    (bit-count (- (expt 2 100))) =>  100
+    (bit-count (- (1+ (expt 2 100)))) =>  1
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} integer-length i
+
+The number of bits needed to represent @var{i}, i.e.
+
+@lisp
+	(ceiling (/ (log (if (negative? integer)
+			     (- integer)
+			     (+ 1 integer)))
+		    (log 2)))
+@end lisp
+
+The result is always non-negative.
+
+For non-negative @var{i}, this is the number of bits needed to represent
+@var{i} in an unsigned binary representation. For all @var{i}, @samp{(+
+1 (integer-length @var{i}))} is the number of bits needed to represent
+@var{i} in a signed twos-complement representation.
+
+@lisp
+    (integer-length  0) => 0
+    (integer-length  1) => 1
+    (integer-length -1) => 0
+    (integer-length  7) => 3
+    (integer-length -7) => 3
+    (integer-length  8) => 4
+    (integer-length -8) => 3
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} bitwise-if mask i j
+
+Merge the bitstrings @var{i} and @var{j}, with bitstring @var{mask}
+determining from which string to take each bit.  That is, if the
+@var{k}th bit of @var{mask} is 1, then the @var{k}th bit of the result
+is the @var{k}th bit of @var{i}, otherwise the @var{k}th bit of @var{j}.
+
+@lisp
+    (bitwise-if 3 1 8) => 9
+    (bitwise-if 3 8 1) => 0
+    (bitwise-if 1 1 2) => 3
+    (bitwise-if #b00111100 #b11110000 #b00001111) => #b00110011
+@end lisp
+@end deffn
+
+@node SRFI 151 Single-bit operations
+@subsubsection SRFI 151 Single-bit operations
+
+As always, the rightmost/least-significant bit in @var{i} is bit 0.
+
+@deffn {Scheme Procedure} bit-set? index i
+
+Is bit @var{index} set in bitstring @var{i} (where @var{index} is a
+non-negative exact integer)?
+
+@quotation note
+The R6RS analogue @code{bitwise-bit-set?} accepts its arguments in the
+opposite order.
+@end quotation
+
+@lisp
+    (bit-set? 1 1) =>  false
+    (bit-set? 0 1) =>  true
+    (bit-set? 3 10) =>  true
+    (bit-set? 1000000 -1) =>  true
+    (bit-set? 2 6) =>  true
+    (bit-set? 0 6) =>  false
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} copy-bit index i boolean
+
+Return an integer the same as @var{i} except in the @var{index}th bit,
+which is 1 if @var{boolean} is @code{#t} and 0 if @var{boolean} is
+@code{#f}.
+
+@quotation note
+The R6RS analogue @code{bitwise-copy-bit} as originally documented has a
+completely different interface.  @samp{(bitwise-copy-bit @var{dest}
+@var{ndex} @var{source})} replaces the @var{index}'th bit of @var{dest}
+with the @var{index}'th bit of @var{source}.  It is equivalent to
+@samp{(bit-field-replace-same @var{dest} @var{source} @var{index} (+
+@var{index} 1))}.
+@end quotation
+
+@lisp
+(copy-bit 0 0 #t) => #b1
+(copy-bit 2 0 #t) => #b100
+(copy-bit 2 #b1111 #f) => #b1011
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} bit-swap index@sub{1} index@sub{2} i
+
+Return an integer the same as @var{i} except that the
+@var{index@sub{1}}th bit and the @var{index@sub{2}}th bit have been
+exchanged.
+
+@lisp
+(bit-swap 0 2 4) => #b1
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} any-bit-set? test-bits i
+@deffnx {Scheme Procedure} every-bit-set? test-bits i
+
+Determine if any/all of the bits set in bitstring @var{test-bits} are
+set in bitstring @var{i}.  I.e., return @samp{(not (zero? (bitwise-and
+@var{test-bits} @var{i})))} and @samp{(= @var{test-bits} (bitwise-and
+@var{test-bits} @var{i}))} respectively.
+
+@lisp
+    (any-bit-set? 3 6) => #t
+    (any-bit-set? 3 12) => #f
+    (every-bit-set? 4 6) => #t
+    (every-bit-set? 7 6) => #f
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} first-set-bit i
+
+Return the index of the first (smallest index) 1 bit in bitstring
+@var{i}.  Return -1 if @var{i} contains no 1 bits (i.e., if @var{i} is
+zero).
+
+@lisp
+    (first-set-bit 1) => 0
+    (first-set-bit 2) => 1
+    (first-set-bit 0) => -1
+    (first-set-bit 40) => 3
+    (first-set-bit -28) => 2
+    (first-set-bit (expt  2 99)) => 99
+    (first-set-bit (expt -2 99)) => 99
+@end lisp
+@end deffn
+
+@node SRFI 151 Bit field operations
+@subsubsection SRFI 151 Bit field operations
+
+These functions operate on a contiguous field of bits (a "byte", in
+Common Lisp parlance) in a given bitstring.  The @var{start} and
+@var{end} arguments, which are not optional, are non-negative exact
+integers specifying the field: it is the @var{end-start} bits running
+from bit @var{start} to bit @var{end}-1.
+
+@deffn {Scheme Procedure} bit-field i start end
+
+Return the field from @var{i}, shifted down to the least-significant
+position in the result.
+
+@lisp
+   (bit-field #b1101101010 0 4) => #b1010
+   (bit-field #b1101101010 3 9) => #b101101
+   (bit-field #b1101101010 4 9) => #b10110
+   (bit-field #b1101101010 4 10) => #b110110
+   (bit-field 6 0 1) => 0
+   (bit-field 6 1 3) => 3
+   (bit-field 6 2 999) => 1
+   (bit-field #x100000000000000000000000000000000 128 129) => 1
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} bit-field-any? i start end
+
+Return true if any of the field's bits are set in bitstring @var{i},
+and false otherwise.
+
+@lisp
+  (bit-field-any? #b1001001 1 6) => #t
+  (bit-field-any? #b1000001 1 6) => #f
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} bit-field-every? i start end
+
+Return false if any of the field's bits are not set in bitstring
+@var{i}, and true otherwise.
+
+@lisp
+  (bit-field-every? #b1011110 1 5) => #t
+  (bit-field-every? #b1011010 1 5) => #f
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} bit-field-clear i start end
+@deffnx {Scheme Procedure} bit-field-set i start end
+
+Return @var{i} with the field's bits set to all 0s/1s.
+
+@lisp
+   (bit-field-clear #b101010 1 4) => #b100000
+   (bit-field-set #b101010 1 4) => #b101110
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} bit-field-replace dest source start end
+
+Return @var{dest} with the field replaced by the least-significant
+@var{end-start} bits in @var{source}.
+
+@lisp
+   (bit-field-replace #b101010 #b010 1 4) => #b100100
+   (bit-field-replace #b110 1 0 1) => #b111
+   (bit-field-replace #b110 1 1 2) => #b110
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} bit-field-replace-same dest source start end
+
+Return @var{dest} with its field replaced by the corresponding field in
+@var{source}.
+
+@lisp
+   (bit-field-replace-same #b1111 #b0000 1 3) => #b1001
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} bit-field-rotate i count start end
+
+Return @var{i} with the field cyclically permuted by @var{count} bits
+towards high-order.
+
+@quotation note
+The R6RS analogue @code{bitwise-rotate-bit-field} uses the argument
+ordering @var{i} @var{start} @var{end} @var{count}.
+@end quotation
+
+@lisp
+   (bit-field-rotate #b110 0 0 10) => #b110
+   (bit-field-rotate #b110 0 0 256) => #b110
+   (bit-field-rotate #x100000000000000000000000000000000 1 0 129) => 1
+   (bit-field-rotate #b110 1 1 2) => #b110
+   (bit-field-rotate #b110 1 2 4) => #b1010
+   (bit-field-rotate #b0111 -1 1 4) => #b1011
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} bit-field-reverse i start end
+
+Return @var{i} with the order of the bits in the field reversed.
+
+@lisp
+   (bit-field-reverse 6 1 3) => 6
+   (bit-field-reverse 6 1 4) => 12
+   (bit-field-reverse 1 0 32) => #x80000000
+   (bit-field-reverse 1 0 31) => #x40000000
+   (bit-field-reverse 1 0 30) => #x20000000
+   (bit-field-reverse #x140000000000000000000000000000000 0 129) => 5
+@end lisp
+@end deffn
+
+@node SRFI 151 Bits conversion
+@subsubsection SRFI 151 Bits conversion
+
+@deffn {Scheme Procedure} bits->list i [len]
+@deffnx {Scheme Procedure} bits->vector i [len]
+
+Return a list/vector of @var{len} booleans corresponding to each bit of
+the non-negative integer @var{i}, returning bit #0 as the first element,
+bit #1 as the second, and so on.  @code{#t} is returned for each 1;
+@code{#f} for 0.
+
+@lisp
+   (bits->list #b1110101) => (#t #f #t #f #t #t #t)
+   (bits->list 3 5) => (#t #t #f #f #f)
+   (bits->list 6 4) => (#f #t #t #f)
+   (bits->vector #b1110101) => #(#t #f #t #f #t #t #t)
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} list->bits list
+@deffnx {Scheme Procedure} vector->bits vector
+
+Return an integer formed from the booleans in @var{list}/@var{vector},
+using the first element as bit #0, the second element as bit #1, and so
+on.  It is an error if @var{list}/@var{vector} contains non-booleans.  A
+1 bit is coded for each @code{#t}; a 0 bit for @code{#f}.  Note that the
+result is never a negative integer.
+
+@lisp
+   (list->bits '(#t #f #t #f #t #t #t)) => #b1110101
+   (list->bits '(#f #f #t #f #t #f #t #t #t)) => #b111010100
+   (list->bits '(#f #t #t)) => 6
+   (list->bits '(#f #t #t #f)) => 6
+   (list->bits '(#f #f #t #t)) => 12
+   (vector->bits '#(#t #f #t #f #t #t #t)) => #b1110101
+   (vector->bits '#(#f #f #t #f #t #f #t #t #t)) => #b111010100
+   (vector->bits '#(#f #t #t)) => 6
+   (vector->bits '#(#f #t #t #f)) => 6
+   (vector->bits '#(#f #f #t #t)) => 12
+@end lisp
+
+For positive integers,
+@code{bits->list} and @code{list->bits} are inverses in the sense of @code{equal?},
+and so are @code{bits->vector} and @code{vector->bits}
+@end deffn
+
+@deffn {Scheme Procedure} bits bool @dots{}
+
+Return the integer coded by the @code{bool} arguments.  The first
+argument is bit #0, the second argument is bit #1, and so on.  Note that
+the result is never a negative integer.
+
+@lisp
+  (bits #t #f #t #f #t #t #t) => #b1110101
+  (bits #f #f #t #f #t #f #t #t #t) => #b111010100
+@end lisp
+@end deffn
+
+@node SRFI 151 Fold/unfold and generate
+@subsubsection SRFI 151 Fold, unfold, and generate
+
+It is an error if the arguments named @var{proc}, @var{top}?,
+@var{apper} or @var{successor} are not procedures.  The arguments named
+@var{seed} may be any Scheme object.
+
+@deffn {Scheme Procedure} bitwise-fold proc seed i
+
+For each bit @var{b} of @var{i} from bit #0 (inclusive) to bit
+@samp{(integer-length @var{i})}(exclusive), @var{proc} is called as
+@samp{(@var{proc} @var{b} @var{r})}, where @var{r} is the current
+accumulated result.  The initial value of @var{r} is @var{seed}, and
+the value returned by @var{proc} becomes the next accumulated result.
+When the last bit has been processed, the final accumulated result
+becomes the result of @code{bitwise-fold}.
+
+@lisp
+  (bitwise-fold cons '() #b1010111) => (#t #f #t #f #t #t #t)
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} bitwise-for-each proc i
+
+Repeatedly apply @var{proc} to the bits of @var{i} starting with bit
+#0 (inclusive) and ending with bit @samp{(integer-length @var{i})}
+(exclusive).  The values returned by @var{proc} are discarded.  Return
+an unspecified value.
+
+@lisp
+      (let ((count 0))
+        (bitwise-for-each (lambda (b) (if b (set! count (+ count 1))))
+                          #b1010111)
+        count)
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} bitwise-unfold stop? mapper successor seed
+
+Generate a non-negative integer bit by bit, starting with bit 0.  If the
+result of applying @var{stop?} to the current state (whose initial value
+is @var{seed}) is true, return the currently accumulated bits as an
+integer.  Otherwise, apply @var{mapper} to the current state to obtain
+the next bit of the result by interpreting a true value as a 1 bit and a
+false value as a 0 bit.  Then get a new state by applying
+@var{successor} to the current state, and repeat this algorithm.
+
+@lisp
+  (bitwise-unfold (lambda (i) (= i 10))
+                  even?
+                  (lambda (i) (+ i 1))
+                  0) => #b101010101
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} make-bitwise-generator i
+
+Return a @url{https://srfi.schemers.org/srfi-121/srfi-121.html, SRFI
+121} generator that generates all the bits of @var{i} starting with bit
+#0.  Note that the generator is infinite.
+
+@lisp
+  (let ((g (make-bitwise-generator #b110)))
+    (test #f (g))
+    (test #t (g))
+    (test #t (g))
+    (test #f (g)))
+@end lisp
+@end deffn
+
 @node SRFI-171
 @subsection Transducers
 @cindex SRFI-171
diff --git a/module/srfi/srfi-151.scm b/module/srfi/srfi-151.scm
new file mode 100644
index 000000000..beb004b87
--- /dev/null
+++ b/module/srfi/srfi-151.scm
@@ -0,0 +1,56 @@
+;; Copyright (C) John Cowan (2016). All Rights Reserved.
+
+;; Permission is hereby granted, free of charge, to any person obtaining
+;; a copy of this software and associated documentation files (the
+;; "Software"), to deal in the Software without restriction, including
+;; without limitation the rights to use, copy, modify, merge, publish,
+;; distribute, sublicense, and/or sell copies of the Software, and to
+;; permit persons to whom the Software is furnished to do so, subject to
+;; the following conditions:
+
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+(define-library (srfi srfi-151)
+  (import (scheme base))
+  (import (scheme case-lambda))
+
+  (export bitwise-not bitwise-and bitwise-ior bitwise-xor bitwise-eqv
+          bitwise-nand bitwise-nor bitwise-andc1 bitwise-andc2
+          bitwise-orc1 bitwise-orc2)
+  (export arithmetic-shift bit-count integer-length bitwise-if
+          bit-set? copy-bit bit-swap any-bit-set? every-bit-set?  first-set-bit)
+  (export bit-field bit-field-any? bit-field-every?  bit-field-clear bit-field-set
+          bit-field-replace  bit-field-replace-same
+          bit-field-rotate bit-field-reverse)
+  (export bits->list list->bits bits->vector vector->bits bits
+          bitwise-fold bitwise-for-each bitwise-unfold make-bitwise-generator)
+
+  ;; Provide core functions
+  (import (only (rnrs arithmetic bitwise)
+                bitwise-not bitwise-and bitwise-ior bitwise-xor
+                bitwise-bit-count))
+  (import (rename (only (rnrs arithmetic bitwise)
+                        bitwise-arithmetic-shift bitwise-length)
+                  (bitwise-arithmetic-shift arithmetic-shift)
+                  (bitwise-length integer-length)))
+
+  (begin
+    (define (bit-count i) ; Negative case different to R6RS bitwise-bit-count
+      (if (>= i 0)
+          (bitwise-bit-count i)
+          (bitwise-bit-count (bitwise-not i)))))
+
+  ;; Stable part of the implementation
+  (include "srfi-151/bitwise-33.scm")
+  (include "srfi-151/bitwise-60.scm")
+  (include "srfi-151/bitwise-other.scm"))
diff --git a/module/srfi/srfi-151/bitwise-33.scm b/module/srfi/srfi-151/bitwise-33.scm
new file mode 100644
index 000000000..92f8056d0
--- /dev/null
+++ b/module/srfi/srfi-151/bitwise-33.scm
@@ -0,0 +1,108 @@
+;;;; bitwise-33 - Olin Shivers's code from SRFI-33 with modified names
+
+;;; Olin Shivers is the sole author of this code, and he has placed it in
+;;; the public domain.
+;;;
+;;; A good implementation might choose to provide direct compiler/interpreter
+;;; support for these derived functions, or might simply define them to be
+;;; integrable -- i.e., inline-expanded.
+;;;
+;;; The seven non-trivial boolean functions in terms
+;;; of not, and, or & xor.
+
+(define (bitwise-nand  i j)  (bitwise-not (bitwise-and i j)))
+(define (bitwise-nor   i j)  (bitwise-not (bitwise-ior i j)))
+(define (bitwise-andc1 i j)  (bitwise-and (bitwise-not i) j))
+(define (bitwise-andc2 i j)  (bitwise-and i (bitwise-not j)))
+(define (bitwise-orc1  i j)  (bitwise-ior (bitwise-not i) j))
+(define (bitwise-orc2  i j)  (bitwise-ior i (bitwise-not j)))
+
+;;; This is a general definition, but less than efficient.  It should also
+;;; receive primitive compiler/interpreter support so that the expensive
+;;; n-ary mechanism is not invoked in the standard cases -- that is,
+;;; an application of BITWISE-EQV should be rewritten into an equivalent
+;;; tree applying some two-argument primitive to the arguments, in the
+;;; same manner that statically-known n-ary applications of associative
+;;; operations such as + and * are handled efficiently:
+;;;   (bitwise-eqv)         => -1
+;;;   (bitwise-eqv i)       => i
+;;;   (bitwise-eqv i j)     => (%bitwise-eqv i j)
+;;;   (bitwise-eqv i j k)   => (%bitwise-eqv (%bitwise-eqv i j) k)
+;;;   (bitwise-eqv i j k l) => (%bitwise-eqv (%bitwise-eqv (%bitwise-eqv i j) k) l)
+
+(define (bitwise-eqv . args)
+  (let lp ((args args) (ans -1))
+    (if (pair? args)
+        (lp (cdr args) (bitwise-not (bitwise-xor ans (car args))))
+	ans)))
+
+;;; Helper function -- make a mask of SIZE 1-bits, e.g. (%MASK 3) = #b111.
+;;; Suppose your Scheme's fixnums are N bits wide (counting the sign bit,
+;;; not counting any tag bits). This version, due to Marc Feeley, will
+;;; handle SIZE in the range [0,N-1] without overflowing to bignums.
+;;; (For SIZE >= N, the correct bignum value is also produced.)
+
+(define (mask start end) (bitwise-not (arithmetic-shift -1 (- end start))))
+
+;;; This alternate, mathematically-equivalent expression
+;;;     (- (arithmetic-shift 1 size) 1)
+;;; is not as good -- it only handles SIZE in the range [0,N-2] without
+;;; overflowing to bignums.
+;;;
+;;; Finally, note that even Feeley's expression can't build an N-bit mask
+;;; without bignum help. This is fundamental, since the interpretation
+;;; of fixed-size fixnum bit patterns as semi-infinite-bit-strings is that
+;;; you replicate the high bit out to infinity. So you have to have a
+;;; zero "stop bit" appearing after that highest one bit to turn off the
+;;; replication of the ones.
+
+(define (bit-set? index n)
+  (not (zero? (bitwise-and (arithmetic-shift 1 index) n))))
+
+(define (any-bit-set? test-bits n) (not (zero? (bitwise-and test-bits n))))
+
+(define (every-bit-set? test-bits n) (= test-bits (bitwise-and test-bits n)))
+
+;;; Bit-field ops
+
+(define (bit-field n start end)
+  (bitwise-and (mask start end) (arithmetic-shift n (- start))))
+
+(define (bit-field-any? n start end)
+  (not (zero? (bitwise-and (arithmetic-shift n (- start)) (mask start end)))))
+
+;; Part of Olin's late revisions; code by John Cowan; public domain.
+(define (bit-field-every? n start end)
+  (let ((m (mask start end)))
+    (eqv? m (bitwise-and (arithmetic-shift n (- start)) m))))
+
+;; Integrating i-b-f reduces nicely.
+(define (bit-field-clear n start end)
+  (bit-field-replace n 0 start end))
+
+;; Counterpart to above, not in SRFI 33, written by John Cowan, public domain
+(define (bit-field-set n start end)
+  (bit-field-replace n -1 start end))
+
+;;; Oops -- intermediate ARITHMETIC-SHIFT can fixnum-overflow on fixnum args.
+;(define (bit-field-replace newfield n start end)
+;  (bit-field-replace-same (arithmetic-shift newfield start) n start end))
+
+;;; This three-line version won't fixnum-overflow on fixnum args.
+(define (bit-field-replace n newfield start end)
+  (let ((m (mask start end)))
+    (bitwise-ior (bitwise-and n (bitwise-not (arithmetic-shift m start)))
+		 (arithmetic-shift (bitwise-and newfield m) start))))
+
+(define (bit-field-replace-same to from start end)
+  (bitwise-if (arithmetic-shift (mask start end) start) from to))
+
+;; Simple definition
+;(define (first-set-bit i)
+;  (and (not (zero? i))
+;       (let lp ((j 0) (i start))
+;         (if (bit-set? i 0) j
+;             (lp (+ j 1) (arithmetic-shift i 1))))))
+
+;;; Clever definition, assuming you have a fast BIT-COUNT.
+(define (first-set-bit i) (- (bit-count (bitwise-xor i (- i 1))) 1))
diff --git a/module/srfi/srfi-151/bitwise-60.scm b/module/srfi/srfi-151/bitwise-60.scm
new file mode 100644
index 000000000..3f91cd632
--- /dev/null
+++ b/module/srfi/srfi-151/bitwise-60.scm
@@ -0,0 +1,70 @@
+;;;; bitwise-60 - SRFI-60 procedures without SRFI-33 analogues, renamed
+;;; Copyright (C) 1991, 1993, 2001, 2003, 2005 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(define (bit-field-rotate n count start end)
+  (define width (- end start))
+  (set! count (modulo count width))
+  (let ((mask (bitwise-not (arithmetic-shift -1 width))))
+    (define zn (bitwise-and mask (arithmetic-shift n (- start))))
+    (bitwise-ior (arithmetic-shift
+             (bitwise-ior (bitwise-and mask (arithmetic-shift zn count))
+                     (arithmetic-shift zn (- count width)))
+             start)
+            (bitwise-and (bitwise-not (arithmetic-shift mask start)) n))))
+
+(define (bit-reverse k n)
+  (do ((m (if (negative? n) (bitwise-not n) n) (arithmetic-shift m -1))
+       (k (+ -1 k) (+ -1 k))
+       (rvs 0 (bitwise-ior (arithmetic-shift rvs 1) (bitwise-and 1 m))))
+      ((negative? k) (if (negative? n) (bitwise-not rvs) rvs))))
+
+
+(define (bit-field-reverse n start end)
+  (define width (- end start))
+  (let ((mask (bitwise-not (arithmetic-shift -1 width))))
+    (define zn (bitwise-and mask (arithmetic-shift n (- start))))
+    (bitwise-ior (arithmetic-shift (bit-reverse width zn) start)
+            (bitwise-and (bitwise-not (arithmetic-shift mask start)) n))))
+
+(define (copy-bit index to bool)
+  (if bool
+      (bitwise-ior to (arithmetic-shift 1 index))
+      (bitwise-and to (bitwise-not (arithmetic-shift 1 index)))))
+
+(define (bits->list k . len)
+  (if (null? len)
+      (do ((k k (arithmetic-shift k -1))
+           (lst '() (cons (odd? k) lst)))
+          ((<= k 0) (reverse lst)))
+      (do ((idx (+ -1 (car len)) (+ -1 idx))
+           (k k (arithmetic-shift k -1))
+           (lst '() (cons (odd? k) lst)))
+          ((negative? idx) (reverse lst)))))
+
+(define (list->bits bools)
+  (do ((bs (reverse bools) (cdr bs))
+       (acc 0 (+ acc acc (if (car bs) 1 0))))
+      ((null? bs) acc)))
+
+(define (bits . bools)
+  (list->bits bools))
+
+(define (bitwise-if mask n0 n1)
+  (bitwise-ior (bitwise-and mask n0)
+               (bitwise-and (bitwise-not mask) n1)))
diff --git a/module/srfi/srfi-151/bitwise-other.scm b/module/srfi/srfi-151/bitwise-other.scm
new file mode 100644
index 000000000..7f7b9b96e
--- /dev/null
+++ b/module/srfi/srfi-151/bitwise-other.scm
@@ -0,0 +1,62 @@
+;;;; bitwise-other - functions not from SRFI 33 or SRFI 60
+;;; Copyright John Cowan 2017
+
+;; Permission is hereby granted, free of charge, to any person obtaining
+;; a copy of this software and associated documentation files (the
+;; "Software"), to deal in the Software without restriction, including
+;; without limitation the rights to use, copy, modify, merge, publish,
+;; distribute, sublicense, and/or sell copies of the Software, and to
+;; permit persons to whom the Software is furnished to do so, subject to
+;; the following conditions:
+
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+(define bits->vector
+  (case-lambda
+    ((i) (list->vector (bits->list i)))
+    ((i len) (list->vector (bits->list i len)))))
+
+(define (vector->bits vector) (list->bits (vector->list vector)))
+
+(define (bit-swap n1 n2 i)
+  (let ((n1-bit (bit-set? n1 i))
+        (n2-bit (bit-set? n2 i)))
+    (copy-bit n2 (copy-bit n1 i n2-bit) n1-bit)))
+
+(define (bitwise-fold proc seed i)
+  (let ((len (integer-length i)))
+    (let loop ((n 0) (r seed))
+      (if (= n len)
+        r
+        (loop (+ n 1) (proc (bit-set? n i) r))))))
+
+(define (bitwise-for-each proc i)
+  (let ((len (integer-length i)))
+    (let loop ((n 0))
+      (when (< n len)
+        (proc (bit-set? n i))
+        (loop (+ n 1))))))
+
+(define (bitwise-unfold stop? mapper successor seed)
+  (let loop ((n 0) (result 0) (state seed))
+    (if (stop? state)
+      result
+        (loop (+ n 1)
+              (copy-bit n result (mapper state))
+              (successor state)))))
+
+(define (make-bitwise-generator i)
+  (lambda ()
+    (let ((bit (bit-set? 0 i)))
+       (set! i (arithmetic-shift i -1))
+       bit)))
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 13eb1f24f..f51db8830 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -165,6 +165,7 @@ SCM_TESTS = tests/00-initial-env.test		\
             tests/srfi-125.test			\
             tests/srfi-126.test			\
             tests/srfi-128.test			\
+            tests/srfi-151.test			\
             tests/srfi-171.test                 \
 	    tests/srfi-4.test			\
 	    tests/srfi-9.test			\
@@ -214,6 +215,7 @@ EXTRA_DIST = \
 	tests/srfi-125-test.scm \
 	tests/srfi-126-test.scm \
 	tests/srfi-128-test.scm \
+	tests/srfi-151-test.scm \
 	ChangeLog-2008
 
 \f
diff --git a/test-suite/tests/srfi-151-test.scm b/test-suite/tests/srfi-151-test.scm
new file mode 100644
index 000000000..b5f6d32cd
--- /dev/null
+++ b/test-suite/tests/srfi-151-test.scm
@@ -0,0 +1,381 @@
+;; Copyright (C) John Cowan (2016). All Rights Reserved.
+
+;; Permission is hereby granted, free of charge, to any person obtaining
+;; a copy of this software and associated documentation files (the
+;; "Software"), to deal in the Software without restriction, including
+;; without limitation the rights to use, copy, modify, merge, publish,
+;; distribute, sublicense, and/or sell copies of the Software, and to
+;; permit persons to whom the Software is furnished to do so, subject to
+;; the following conditions:
+
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+;;; START Guile-specific modifications.
+;;;
+;;; The 'imports' are turned into 'use-modules' and srfi-64 is used.
+;;; Two macros are added for compatibility with Chicken Scheme's 'test'
+;;; library.  A 'test-begin' call is added.
+(use-modules (srfi srfi-151)
+             (srfi srfi-64))
+
+(define-syntax-rule (test arg ...)
+  (test-equal arg ...))
+
+(define-syntax-rule (test-exit arg ...)
+  (test-end))
+
+(test-begin "srfi-151")
+;;; END Guile-specific modifications.
+
+(test-group "bitwise"
+ (test-group "bitwise/basic"
+  (test "test-1" -1 (bitwise-not 0))
+  (test "test-122" 0 (bitwise-not -1))
+  (test "test-248" -11 (bitwise-not 10))
+  (test "test-249" 36 (bitwise-not -37))
+  (test "test-2" 0 (bitwise-and #b0 #b1))
+  (test "test-10" 1680869008 (bitwise-and -193073517 1689392892))
+  (test "test-20" 3769478 (bitwise-and 1694076839 -4290775858))
+  (test "test-115" 6 (bitwise-and 14 6))
+  (test "test-251" 10 (bitwise-and 11 26))
+  (test "test-254" 4 (bitwise-and 37 12))
+  (test "test-288" 1 (bitwise-and #b1 #b1))
+  (test "test-289" 0 (bitwise-and #b1 #b10))
+  (test "test-290" #b10 (bitwise-and #b11 #b10))
+  (test "test-291" #b101 (bitwise-and #b101 #b111))
+  (test "test-292" #b111 (bitwise-and -1 #b111))
+  (test "test-293" #b110 (bitwise-and -2 #b111))
+  (test "test-294" 3769478 (bitwise-and -4290775858 1694076839))
+  (test "test-11" -4294967295 (bitwise-ior 1 (- -1 #xffffffff)))
+  (test "test-12" -18446744073709551615 (bitwise-ior 1 (- -1 #xffffffffffffffff)))
+  (test "test-117" 14 (bitwise-ior 10 12))
+  (test "test-250" 11 (bitwise-ior 3  10))
+  (test "test-13" -4294967126 (bitwise-xor #b10101010 (- -1 #xffffffff)))
+  (test "test-15" -18446744073709551446 (bitwise-xor #b10101010 (- -1 #xffffffffffffffff)))
+  (test "test-16" -2600468497 (bitwise-ior 1694076839 -4290775858))
+  (test "test-17" -184549633 (bitwise-ior -193073517 1689392892))
+  (test "test-18" -2604237975 (bitwise-xor 1694076839 -4290775858))
+  (test "test-19" -1865418641 (bitwise-xor -193073517 1689392892))
+  (test "test-119" 6 (bitwise-xor 10 12))
+  (test "test-252" 9 (bitwise-xor 3 10))
+  (test "test-14" (bitwise-not -4294967126) (bitwise-eqv #b10101010 (- -1 #xffffffff)))
+  (test "test-253" -42 (bitwise-eqv 37 12))
+  (test "test-27" -1 (bitwise-nand 0 0))
+  (test "test-28" -1 (bitwise-nand 0 -1))
+  (test "test-29" -124 (bitwise-nand -1 123))
+  (test "test-326" -11 (bitwise-nand 11 26))
+  (test "test-327" -28 (bitwise-nor  11 26))
+  (test "test-317" 0 (bitwise-nor -1 123))
+  (test "test-328" 16 (bitwise-andc1 11 26))
+  (test "test-329" 1 (bitwise-andc2 11 26))
+  (test "test-330" -2 (bitwise-orc1 11 26))
+  (test "test-30" -1 (bitwise-nor 0 0))
+  (test "test-31" 0 (bitwise-nor 0 -1))
+  (test "test-22" 0 (bitwise-andc1 0 0))
+  (test "test-23" -1 (bitwise-andc1 0 -1))
+  (test "test-24" 123 (bitwise-andc1 0 123))
+  (test "test-25" 0 (bitwise-andc2 0 0))
+  (test "test-26" -1 (bitwise-andc2 -1 0))
+  (test "test-318" -1 (bitwise-orc1 0 0))
+  (test "test-319" -1 (bitwise-orc1 0 -1))
+  (test "test-320" 0 (bitwise-orc1 -1 0))
+  (test "test-321" -124 (bitwise-orc1 123 0))
+  (test "test-322" -1 (bitwise-orc2 0 0))
+  (test "test-323" -1 (bitwise-orc2 -1 0))
+  (test "test-324" 0 (bitwise-orc2 0 -1))
+  (test "test-325" -124 (bitwise-orc2 0 123))
+ )
+ (test-group "bitwise/integer"
+  (test "test-78" #x1000000000000000100000000000000000000000000000000
+      (arithmetic-shift #x100000000000000010000000000000000 64))
+  (test "test-79" #x8e73b0f7da0e6452c810f32b809079e5
+      (arithmetic-shift #x8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b -64))
+  (test "test-196" 2 (arithmetic-shift 1 1))
+  (test "test-197" 0 (arithmetic-shift 1 -1))
+  (test "test-331" 1 (arithmetic-shift 1 0))
+  (test "test-333" 4 (arithmetic-shift 1 2))
+  (test "test-334" 8 (arithmetic-shift 1 3))
+  (test "test-335" 16 (arithmetic-shift 1 4))
+  (test "test-336" (expt 2 31) (arithmetic-shift 1 31))
+  (test "test-337" (expt 2 32) (arithmetic-shift 1 32))
+  (test "test-338" (expt 2 33) (arithmetic-shift 1 33))
+  (test "test-339" (expt 2 63) (arithmetic-shift 1 63))
+  (test "test-340" (expt 2 64) (arithmetic-shift 1 64))
+  (test "test-341" (expt 2 65) (arithmetic-shift 1 65))
+  (test "test-342" (expt 2 127) (arithmetic-shift 1 127))
+  (test "test-343" (expt 2 128) (arithmetic-shift 1 128))
+  (test "test-344" (expt 2 129) (arithmetic-shift 1 129))
+  (test "test-345" 3028397001194014464 (arithmetic-shift 11829675785914119 8))
+  (test "test-346" -1 (arithmetic-shift -1 0))
+  (test "test-347" -2 (arithmetic-shift -1 1))
+  (test "test-348" -4 (arithmetic-shift -1 2))
+  (test "test-349" -8 (arithmetic-shift -1 3))
+  (test "test-350" -16 (arithmetic-shift -1 4))
+  (test "test-351" (- (expt 2 31)) (arithmetic-shift -1 31))
+  (test "test-352" (- (expt 2 32)) (arithmetic-shift -1 32))
+  (test "test-353" (- (expt 2 33)) (arithmetic-shift -1 33))
+  (test "test-354" (- (expt 2 63)) (arithmetic-shift -1 63))
+  (test "test-355" (- (expt 2 64)) (arithmetic-shift -1 64))
+  (test "test-356" (- (expt 2 65)) (arithmetic-shift -1 65))
+  (test "test-357" (- (expt 2 127)) (arithmetic-shift -1 127))
+  (test "test-358" (- (expt 2 128)) (arithmetic-shift -1 128))
+  (test "test-359" (- (expt 2 129)) (arithmetic-shift -1 129))
+  (test "test-360" 0 (arithmetic-shift 1 -63))
+  (test "test-361" 0 (arithmetic-shift 1 -64))
+  (test "test-362" 0 (arithmetic-shift 1 -65))
+  (test "test-255" 32 (arithmetic-shift 8 2))
+  (test "test-256" 4 (arithmetic-shift 4 0))
+  (test "test-257" 4 (arithmetic-shift 8 -1))
+  (test "test-258" -79 (arithmetic-shift -100000000000000000000000000000000 -100))
+  (test "test-135" 2 (bit-count 12))
+  (test "test-263" 0 (integer-length  0))
+  (test "test-264" 1 (integer-length  1))
+  (test "test-265" 0 (integer-length -1))
+  (test "test-266" 3 (integer-length  7))
+  (test "test-267" 3 (integer-length -7))
+  (test "test-268" 4 (integer-length  8))
+  (test "test-269" 3 (integer-length -8))
+  (test "test-125" 9 (bitwise-if 3 1 8))
+  (test "test-126" 0 (bitwise-if 3 8 1))
+  (test "test-373" 3 (bitwise-if 1 1 2))
+  (test "test-378" #b00110011 (bitwise-if #b00111100 #b11110000 #b00001111))
+ )
+ (test-group "bitwise/single"
+  (test "test-160" #t (bit-set? 0 1))
+  (test "test-161" #f (bit-set? 1 1))
+  (test "test-162" #f (bit-set? 1 8))
+  (test "test-163" #t (bit-set? 10000 -1))
+  (test "test-167" #t (bit-set? 1000 -1))
+  (test "test-541" #t (bit-set? 64 #x10000000000000000))
+  (test "test-542" #f (bit-set? 64 1))
+  (test "test-272" #t (bit-set? 3 10))
+  (test "test-273" #t (bit-set? 2 6))
+  (test "test-274" #f (bit-set? 0 6))
+  (test "test-168" 0 (copy-bit 0 0 #f))
+  (test "test-169" 0 (copy-bit 30 0 #f))
+  (test "test-170" 0 (copy-bit 31 0 #f))
+  (test "test-171" 0 (copy-bit 62 0 #f))
+  (test "test-172" 0 (copy-bit 63 0 #f))
+  (test "test-173" 0 (copy-bit 128 0 #f))
+  (test "test-174" -1 (copy-bit 0 -1 #t))
+  (test "test-175" -1 (copy-bit 30 -1 #t))
+  (test "test-176" -1 (copy-bit 31 -1 #t))
+  (test "test-177" -1 (copy-bit 62 -1 #t))
+  (test "test-178" -1 (copy-bit 63 -1 #t))
+  (test "test-179" -1 (copy-bit 128 -1 #t))
+  (test "test-180" 1 (copy-bit 0 0 #t))
+  (test "test-181" #x106 (copy-bit 8 6 #t))
+  (test "test-182" 6 (copy-bit 8 6 #f))
+  (test "test-183" -2 (copy-bit 0 -1 #f))
+  (test "test-184" 0 (copy-bit 128 #x100000000000000000000000000000000 #f))
+  (test "test-185" #x100000000000000000000000000000000
+		 (copy-bit 128 #x100000000000000000000000000000000 #t))
+  (test "test-186" #x100000000000000000000000000000000
+		 (copy-bit 64 #x100000000000000000000000000000000 #f))
+  (test "test-187" #x-100000000000000000000000000000000
+		 (copy-bit 64 #x-100000000000000000000000000000000 #f))
+  (test "test-188" #x-100000000000000000000000000000000
+		 (copy-bit 256 #x-100000000000000000000000000000000 #t))
+  (test "test-276" #b100 (copy-bit 2 0 #t))
+  (test "test-277" #b1011 (copy-bit 2 #b1111 #f))
+  (test "test-379" #b1 (copy-bit 0 0 #t))
+  (test "test-100" #b1011 (bit-swap 1 2 #b1101))
+  (test "test-101" #b1011 (bit-swap 2 1 #b1101))
+  (test "test-382" #b1110 (bit-swap 0 1 #b1101))
+  (test "test-102" #b10000000101 (bit-swap 3 10 #b1101))
+  (test "test-278" 1 (bit-swap 0 2 4))
+  (test "test-129" #t (any-bit-set? 3 6))
+  (test "test-130" #f (any-bit-set? 3 12))
+  (test "test-133" #t (every-bit-set? 4 6))
+  (test "test-134" #f (every-bit-set? 7 6))
+  (test "test-141" -1 (first-set-bit 0))
+  (test "test-142" 0 (first-set-bit 1))
+  (test "test-143" 0 (first-set-bit 3))
+  (test "test-144" 2 (first-set-bit 4))
+  (test "test-145" 1 (first-set-bit 6))
+  (test "test-146" 0 (first-set-bit -1))
+  (test "test-147" 1 (first-set-bit -2))
+  (test "test-148" 0 (first-set-bit -3))
+  (test "test-149" 2 (first-set-bit -4))
+  (test "test-150" 128 (first-set-bit #x100000000000000000000000000000000))
+  (test "test-280" 1 (first-set-bit 2))
+  (test "test-282" 3 (first-set-bit 40))
+  (test "test-283" 2 (first-set-bit -28))
+  (test "test-284" 99 (first-set-bit (expt  2 99)))
+  (test "test-285" 99 (first-set-bit (expt -2 99)))
+ )
+ (test-group "bitwise/field"
+  (test "test-189" 0 (bit-field 6 0 1))
+  (test "test-190" 3 (bit-field 6 1 3))
+  (test "test-191" 1 (bit-field 6 2 999))
+  (test "test-192" 1 (bit-field #x100000000000000000000000000000000 128 129))
+  (test "test-363" #b1010 (bit-field #b1101101010 0 4))
+  (test "test-364" #b101101 (bit-field #b1101101010 3 9))
+  (test "test-365" #b10110 (bit-field #b1101101010 4 9))
+  (test "test-366" #b110110 (bit-field #b1101101010 4 10))
+  (test "test-367" #t (bit-field-any? #b101101 0 2))
+  (test "test-368" #t (bit-field-any? #b101101 2 4))
+  (test "test-369" #f (bit-field-any? #b101101 1 2))
+  (test "test-370" #f (bit-field-every? #b101101 0 2))
+  (test "test-371" #t (bit-field-every? #b101101 2 4))
+  (test "test-372" #t (bit-field-every? #b101101 0 1))
+  (test "test-374" #b100000 (bit-field-clear #b101010 1 4))
+  (test "test-375" #b101110 (bit-field-set #b101010 1 4))
+  (test "test-193" #b111 (bit-field-replace #b110 1 0 1))
+  (test "test-194" #b110 (bit-field-replace #b110 1 1 2))
+  (test "test-195" #b010 (bit-field-replace #b110 1 1 3))
+  (test "test-376" #b100100 (bit-field-replace #b101010 #b010 1 4))
+  (test "test-377" #b1001 (bit-field-replace-same #b1111 #b0000 1 3))
+  (test "test-200" #b110  (bit-field-rotate #b110 1 1 2))
+  (test "test-201" #b1010 (bit-field-rotate #b110 1 2 4))
+  (test "test-202" #b1011 (bit-field-rotate #b0111 -1 1 4))
+  (test "test-203" #b0  (bit-field-rotate #b0 128 0 256))
+  (test "test-204" #b1  (bit-field-rotate #b1 128 1 256))
+      (test "test-205" #x100000000000000000000000000000000
+	    (bit-field-rotate #x100000000000000000000000000000000 128 0 64))
+      (test "test-206" #x100000000000000000000000000000008
+	    (bit-field-rotate #x100000000000000000000000000000001 3 0 64))
+      (test "test-207" #x100000000000000002000000000000000
+	    (bit-field-rotate #x100000000000000000000000000000001 -3 0 64))
+  (test "test-208" #b110 (bit-field-rotate #b110 0 0 10))
+  (test "test-209" #b110 (bit-field-rotate #b110 0 0 256))
+  (test "test-475" 1 (bit-field-rotate #x100000000000000000000000000000000 1 0 129))
+  (test "test-211" 6 (bit-field-reverse 6 1 3))
+  (test "test-212" 12 (bit-field-reverse 6 1 4))
+  (test "test-213" #x80000000 (bit-field-reverse 1 0 32))
+  (test "test-214" #x40000000 (bit-field-reverse 1 0 31))
+  (test "test-215" #x20000000 (bit-field-reverse 1 0 30))
+  (test "test-216" (bitwise-ior (arithmetic-shift -1 32) #xFBFFFFFF)
+		 (bit-field-reverse -2 0 27))
+  (test "test-217" (bitwise-ior (arithmetic-shift -1 32) #xF7FFFFFF)
+		 (bit-field-reverse -2 0 28))
+  (test "test-218" (bitwise-ior (arithmetic-shift -1 32) #xEFFFFFFF)
+		 (bit-field-reverse -2 0 29))
+  (test "test-219" (bitwise-ior (arithmetic-shift -1 32) #xDFFFFFFF)
+		 (bit-field-reverse -2 0 30))
+  (test "test-220" (bitwise-ior (arithmetic-shift -1 32) #xBFFFFFFF)
+		 (bit-field-reverse -2 0 31))
+  (test "test-221" (bitwise-ior (arithmetic-shift -1 32) #x7FFFFFFF)
+		 (bit-field-reverse -2 0 32))
+  (test "test-222" 5 (bit-field-reverse #x140000000000000000000000000000000 0 129))
+ )
+ (test-group "bitwise/conversion"
+  (test "test-103" '(#t #f #t #f #t #t #t) (bits->list #b1110101))
+  (test "test-104" '(#f #t #f #t) (bits->list #b111010 4))
+  (test "test-106" #b1110101 (list->bits '(#t #f #t #f #t #t #t)))
+  (test "test-107" #b111010100 (list->bits '(#f #f #t #f #t #f #t #t #t)))
+  (test "test-223" '(#t #t) (bits->list 3))
+  (test "test-224" '(#f #t #t #f) (bits->list 6 4))
+  (test "test-225" '(#f #t) (bits->list 6 2))
+    (test "test-226" '(#t #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f)
+	    (bits->list 1 128))
+  (test "test-228" '(#f
+		     #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		     #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		     #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		     #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		     #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		     #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		     #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		     #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #t)
+		   (bits->list #x100000000000000000000000000000000))
+  (test "test-229" 6 (list->bits '(#f #t #t)))
+  (test "test-230" 12 (list->bits '(#f #f #t #t)))
+  (test "test-231" 6 (list->bits '(#f #t #t #f)))
+  (test "test-232" 2 (list->bits '(#f #t)))
+  (test "test-233" 1 (list->bits
+	     '(#t #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		  #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		  #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		  #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		  #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		  #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		  #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		  #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f)))
+  (test "test-234" #x100000000000000000000000000000000
+		 (list->bits
+		  '(#f
+		    #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		    #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		    #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		    #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		    #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		    #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		    #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
+		    #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #t)))
+  (test "test-235" #x03FFFFFF (list->bits '(#t #t
+						#t #t #t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t)))
+  (test "test-236" #x07FFFFFF (list->bits '(#t #t #t
+						#t #t #t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t)))
+  (test "test-237" #x0FFFFFFF (list->bits '(#t #t #t #t
+						#t #t #t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t)))
+  (test "test-238" #x1FFFFFFF (list->bits '(#t #t #t #t #t
+						#t #t #t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t)))
+  (test "test-239" #x3FFFFFFF (list->bits '(#t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t)))
+  (test "test-240" #x7FFFFFFF (list->bits '(#t #t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t)))
+  (test "test-241" #xFFFFFFFF (list->bits '(#t #t #t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t
+						#t #t #t #t #t #t #t #t)))
+  (test "test-242" #x1FFFFFFFF (list->bits '(#t
+					      #t #t #t #t #t #t #t #t
+					      #t #t #t #t #t #t #t #t
+					      #t #t #t #t #t #t #t #t
+					      #t #t #t #t #t #t #t #t)))
+  (test "test-490" 1 (list->bits '(#t #f)))
+  (test "test-108" #b1110101 (vector->bits '#(#t #f #t #f #t #t #t)))
+  (test "test-109" #b00011010100 (vector->bits '#(#f #f #t #f #t #f #t #t)))
+  (test "test-105" '#(#t #t #t #f #t #f #t #f #f) (bits->vector #b1010111 9))
+  (test "test-105" '#(#t #t #t #f #t #f #t #f #f) (bits->vector #b1010111 9))
+  (test "test-110" #b1110101 (bits #t #f #t #f #t #t #t))
+  (test "test-243" 0 (bits))
+  (test "test-111" #b111010100 (bits #f #f #t #f #t #f #t #t #t))
+ )
+ (test-group "bitwise/fold"
+  (test "test-112" '(#t #f #t #f #t #t #t) (bitwise-fold cons '() #b1010111))
+  (test "test-113" 5
+      (let ((count 0))
+        (bitwise-for-each (lambda (b) (if b (set! count (+ count 1))))
+                          #b1010111)
+        count))
+  (test "test-114" #b101010101
+      (bitwise-unfold (lambda (i) (= i 10)) even? (lambda (i) (+ i 1)) 0))
+  (let ((g (make-bitwise-generator #b110)))
+    (test "test-244a" #f (g))
+    (test "test-244b" #t (g))
+    (test "test-244c" #t (g))
+    (test "test-244d" #f (g)))
+ )
+)
+(test-exit)
diff --git a/test-suite/tests/srfi-151.test b/test-suite/tests/srfi-151.test
new file mode 100644
index 000000000..6c535b39e
--- /dev/null
+++ b/test-suite/tests/srfi-151.test
@@ -0,0 +1,46 @@
+;;;; srfi-151.test --- Test suite for SRFI-151.  -*- scheme -*-
+;;;;
+;;;; Copyright (C) 2023 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-151)
+  #:use-module (srfi srfi-64))
+
+(define report (@@ (test-suite lib) report))
+
+(define (guile-test-runner)
+  (let ((runner (test-runner-null)))
+    (test-runner-on-test-end! runner
+      (lambda (runner)
+        (let* ((result-alist (test-result-alist runner))
+               (result-kind (assq-ref result-alist 'result-kind))
+               (test-name (list (assq-ref result-alist 'test-name))))
+          (case result-kind
+            ((pass)  (report 'pass     test-name))
+            ((xpass) (report 'upass    test-name))
+            ((skip)  (report 'untested test-name))
+            ((fail xfail)
+             (apply report result-kind test-name result-alist))
+            (else #t)))))
+    runner))
+
+(test-with-runner
+ (guile-test-runner)
+ (primitive-load-path "tests/srfi-151-test.scm"))
+
+;;; Local Variables:
+;;; eval: (put 'test-runner-on-test-end! 'scheme-indent-function 1)
+;;; End:
-- 
2.41.0




      parent reply	other threads:[~2023-11-18  6:05 UTC|newest]

Thread overview: 6+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-11-18  6:05 [PATCH v3 1/6] module: Add srfi-126 Maxim Cournoyer
2023-11-18  6:05 ` [PATCH v3 2/6] tests: Add new compile-file tests Maxim Cournoyer
2023-11-18  6:05 ` [PATCH v3 3/6] ice-9: Fix 'include' when used in compilation contexts Maxim Cournoyer
2023-11-18  6:05 ` [PATCH v3 4/6] module: Add srfi-128 Maxim Cournoyer
2023-11-18  6:05 ` [PATCH v3 5/6] module: Add srfi-125 Maxim Cournoyer
2023-11-18  6:05 ` Maxim Cournoyer [this message]

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/guile/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20231118060621.24675-6-maxim.cournoyer@gmail.com \
    --to=maxim.cournoyer@gmail.com \
    --cc=guile-devel@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).