[uim-commit] r1418 - in branches/r5rs: scm sigscheme sigscheme/test
yamaken at freedesktop.org
yamaken at freedesktop.org
Sun Sep 4 20:10:39 PDT 2005
Author: yamaken
Date: 2005-09-04 20:10:36 -0700 (Sun, 04 Sep 2005)
New Revision: 1418
Added:
branches/r5rs/sigscheme/operations-srfi60.c
branches/r5rs/sigscheme/test/test-srfi60.scm
Modified:
branches/r5rs/scm/util.scm
branches/r5rs/sigscheme/operations-siod.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
branches/r5rs/sigscheme/sigschemeinternal.h
Log:
* This commit adds SRFI-60 procedures and replace legacy SIOD bitwise
operations with equivalent SRFI-60 ones
* sigscheme/sigschemeinternal.h
- (SCM_REDUCE_BY_BINOP, SCM_REDUCE_BY_FUNC, SCM_REDUCE_INTERNAL):
New macro
* sigscheme/sigscheme.h
- (SCM_USE_SRFI60, SCM_DEFINE_ALIAS): New macro
- Define SCM_USE_SRFI60 as 1 if SCM_COMPAT_SIOD, as dependency resolution
- (ScmOp_SRFI60_logand, ScmOp_SRFI60_logior, ScmOp_SRFI60_logxor,
ScmOp_SRFI60_lognot, ScmOp_SRFI60_bitwise_if,
ScmOp_SRFI60_logtest): New function
- (ScmOp_bit_and, ScmOp_bit_or, ScmOp_bit_xor, ScmOp_bit_not): Removed
* sigscheme/operations-srfi60.c
- New file
- (ScmOp_SRFI60_logand, ScmOp_SRFI60_logior, ScmOp_SRFI60_logxor,
ScmOp_SRFI60_lognot, ScmOp_SRFI60_bitwise_if,
ScmOp_SRFI60_logtest): New function
* sigscheme/operations-siod.c
- (ScmOp_bit_and, ScmOp_bit_or, ScmOp_bit_xor, ScmOp_bit_not): Removed
* sigscheme/sigscheme.c
- (SigScm_Initialize):
* Add registration for logand, logior, logxor, lognot, bitwise-if,
logtest
* Add aliases bitwise-and, bitwise-ior, bitwise-xor, bitwise-not,
bitwise-merge, any-bits-set?
* Replace SIOD-compatible bitwise operations bit-and, bit-or,
bit-xor, bit-not with alias to equivalent SRFI-60 ones
* sigscheme/operations.c
- Add #include "operations-srfi60.c"
* scm/util.scm
- (bitwise-not, bitwise-and, bitwise-ior, bitwise-xor): Removed
* sigscheme/test/test-srfi60.scm
- New file
- All tests are passed
- (logand, logior, logxor, lognot, bitwise-if, logtest, bitwise-and,
bitwise-ior, bitwise-xor, bitwise-not, bitwise-merge,
any-bits-set?): New test
Modified: branches/r5rs/scm/util.scm
===================================================================
--- branches/r5rs/scm/util.scm 2005-09-04 22:37:54 UTC (rev 1417)
+++ branches/r5rs/scm/util.scm 2005-09-05 03:10:36 UTC (rev 1418)
@@ -528,20 +528,6 @@
alist))))
-;; SRFI-60 procedures
-;; Siod's bit operation procedures take only two arguments
-;; TODO: write tests
-(define bitwise-not bit-not)
-(define bitwise-and
- (lambda xs
- (fold bit-and (bitwise-not 0) xs)))
-(define bitwise-ior
- (lambda xs
- (fold bit-or 0 xs)))
-(define bitwise-xor
- (lambda xs
- (fold bit-xor 0 xs)))
-
;;
;; uim-specific utilities
;;
Modified: branches/r5rs/sigscheme/operations-siod.c
===================================================================
--- branches/r5rs/sigscheme/operations-siod.c 2005-09-04 22:37:54 UTC (rev 1417)
+++ branches/r5rs/sigscheme/operations-siod.c 2005-09-05 03:10:36 UTC (rev 1418)
@@ -127,44 +127,6 @@
return SCM_FALSE;
}
-ScmObj ScmOp_bit_and(ScmObj obj1, ScmObj obj2)
-{
- if (!INTP(obj1))
- SigScm_ErrorObj("bit-and : number required but got ", obj1);
- if (!INTP(obj2))
- SigScm_ErrorObj("bit-and : number required but got ", obj2);
-
- return Scm_NewInt(SCM_INT_VALUE(obj1) & SCM_INT_VALUE(obj2));
-}
-
-ScmObj ScmOp_bit_or(ScmObj obj1, ScmObj obj2)
-{
- if (!INTP(obj1))
- SigScm_ErrorObj("bit-or : number required but got ", obj1);
- if (!INTP(obj2))
- SigScm_ErrorObj("bit-or : number required but got ", obj2);
-
- return Scm_NewInt(SCM_INT_VALUE(obj1) | SCM_INT_VALUE(obj2));
-}
-
-ScmObj ScmOp_bit_xor(ScmObj obj1, ScmObj obj2)
-{
- if (!INTP(obj1))
- SigScm_ErrorObj("bit-xor : number required but got ", obj1);
- if (!INTP(obj2))
- SigScm_ErrorObj("bit-xor : number required but got ", obj2);
-
- return Scm_NewInt(SCM_INT_VALUE(obj1) ^ SCM_INT_VALUE(obj2));
-}
-
-ScmObj ScmOp_bit_not(ScmObj obj)
-{
- if (!INTP(obj))
- SigScm_ErrorObj("bit-not : number required but got ", obj);
-
- return Scm_NewInt(~SCM_INT_VALUE(obj));
-}
-
ScmObj ScmOp_the_environment(ScmObj arg, ScmObj env)
{
return env;
Added: branches/r5rs/sigscheme/operations-srfi60.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi60.c 2005-09-04 22:37:54 UTC (rev 1417)
+++ branches/r5rs/sigscheme/operations-srfi60.c 2005-09-05 03:10:36 UTC (rev 1418)
@@ -0,0 +1,123 @@
+/*===========================================================================
+ * FileName : operations-srfi60.c
+ * About : SRFI-60 integers as bits
+ *
+ * Copyright (C) 2005 by YamaKen
+ *
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. Neither the name of authors nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+ * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+ * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+ * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ * =========================================================================*/
+/*=======================================
+ System Include
+=======================================*/
+
+/*=======================================
+ Local Include
+=======================================*/
+#include "sigscheme.h"
+#include "sigschemeinternal.h"
+
+/*=======================================
+ File Local Struct Declarations
+=======================================*/
+
+/*=======================================
+ File Local Macro Declarations
+=======================================*/
+
+/*=======================================
+ Variable Declarations
+=======================================*/
+
+/*=======================================
+ File Local Function Declarations
+=======================================*/
+
+/*=======================================
+ Function Implementations
+=======================================*/
+
+/*=============================================================================
+ SRFI-60 : Integers as Bits
+=============================================================================*/
+
+/* Bitwise Operations */
+ScmObj ScmOp_SRFI60_logand(ScmObj args, ScmObj env)
+{
+ SCM_REDUCE_BY_BINOP(&, 0, args, env,
+ int, INTP, SCM_INT_VALUE, Scm_NewInt,
+ "logand : integer required but got ");
+}
+
+ScmObj ScmOp_SRFI60_logior(ScmObj args, ScmObj env)
+{
+ SCM_REDUCE_BY_BINOP(|, 0, args, env,
+ int, INTP, SCM_INT_VALUE, Scm_NewInt,
+ "logior : integer required but got ");
+}
+
+ScmObj ScmOp_SRFI60_logxor(ScmObj args, ScmObj env)
+{
+ SCM_REDUCE_BY_BINOP(^, 0, args, env,
+ int, INTP, SCM_INT_VALUE, Scm_NewInt,
+ "logxor : integer required but got ");
+}
+
+ScmObj ScmOp_SRFI60_lognot(ScmObj n)
+{
+ if (!INTP(n))
+ SigScm_ErrorObj("lognot : integer required but got ", n);
+
+ return Scm_NewInt(~SCM_INT_VALUE(n));
+}
+
+ScmObj ScmOp_SRFI60_bitwise_if(ScmObj mask, ScmObj n0, ScmObj n1)
+{
+ int result, c_mask;
+
+ if (!INTP(mask))
+ SigScm_ErrorObj("bitwise-if : integer required but got ", mask);
+ if (!INTP(n0))
+ SigScm_ErrorObj("bitwise-if : integer required but got ", n0);
+ if (!INTP(n1))
+ SigScm_ErrorObj("bitwise-if : integer required but got ", n1);
+
+ c_mask = SCM_INT_VALUE(mask);
+ result = (c_mask & SCM_INT_VALUE(n0)) | (~c_mask & SCM_INT_VALUE(n1));
+
+ return Scm_NewInt(result);
+}
+
+ScmObj ScmOp_SRFI60_logtest(ScmObj j, ScmObj k)
+{
+ if (!INTP(j))
+ SigScm_ErrorObj("logtest : integer required but got ", j);
+ if (!INTP(k))
+ SigScm_ErrorObj("logtest : integer required but got ", k);
+
+ return (SCM_INT_VALUE(j) & SCM_INT_VALUE(k)) ? SCM_TRUE : SCM_FALSE;
+}
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-09-04 22:37:54 UTC (rev 1417)
+++ branches/r5rs/sigscheme/operations.c 2005-09-05 03:10:36 UTC (rev 1418)
@@ -2033,6 +2033,9 @@
#if SCM_USE_SRFI38
#include "operations-srfi38.c"
#endif
+#if SCM_USE_SRFI60
+#include "operations-srfi60.c"
+#endif
#if SCM_COMPAT_SIOD
#include "operations-siod.c"
#endif
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-09-04 22:37:54 UTC (rev 1417)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-09-05 03:10:36 UTC (rev 1418)
@@ -332,6 +332,23 @@
=======================================================================*/
Scm_RegisterFuncEvaledList("write-with-shared-structure", ScmOp_SRFI38_write_with_shared_structure);
#endif
+#if SCM_USE_SRFI60
+ /*=======================================================================
+ SRFI-60 Procedures
+ =======================================================================*/
+ Scm_RegisterFuncRawList("logand" , ScmOp_SRFI60_logand);
+ Scm_RegisterFuncRawList("logior" , ScmOp_SRFI60_logior);
+ Scm_RegisterFuncRawList("logxor" , ScmOp_SRFI60_logxor);
+ Scm_RegisterFunc1("lognot" , ScmOp_SRFI60_lognot);
+ Scm_RegisterFunc3("bitwise-if" , ScmOp_SRFI60_bitwise_if);
+ Scm_RegisterFunc2("logtest" , ScmOp_SRFI60_logtest);
+ SCM_DEFINE_ALIAS("bitwise-and" , "logand");
+ SCM_DEFINE_ALIAS("bitwise-ior" , "logior");
+ SCM_DEFINE_ALIAS("bitwise-xor" , "logxor");
+ SCM_DEFINE_ALIAS("bitwise-not" , "lognot");
+ SCM_DEFINE_ALIAS("bitwise-merge" , "bitwise-if");
+ SCM_DEFINE_ALIAS("any-bits-set?" , "logtest");
+#endif
#if SCM_COMPAT_SIOD
/*=======================================================================
@@ -342,10 +359,10 @@
Scm_RegisterFunc1("symbol-value" , ScmOp_symbol_value);
Scm_RegisterFunc2("set-symbol-value!" , ScmOp_set_symbol_value);
Scm_RegisterFunc2("=" , ScmOp_siod_eql);
- Scm_RegisterFunc2("bit-and" , ScmOp_bit_and);
- Scm_RegisterFunc2("bit-or" , ScmOp_bit_or);
- Scm_RegisterFunc2("bit-xor" , ScmOp_bit_xor);
- Scm_RegisterFunc1("bit-not" , ScmOp_bit_not);
+ SCM_DEFINE_ALIAS("bit-and" , "logand");
+ SCM_DEFINE_ALIAS("bit-or" , "logior");
+ SCM_DEFINE_ALIAS("bit-xor" , "logxor");
+ SCM_DEFINE_ALIAS("bit-not" , "lognot");
Scm_RegisterFuncEvaledList("the-environment" , ScmOp_the_environment);
Scm_RegisterFunc1("%%closure-code" , ScmOp_closure_code);
Scm_RegisterFuncEvaledList("verbose" , ScmOp_verbose);
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-09-04 22:37:54 UTC (rev 1417)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-09-05 03:10:36 UTC (rev 1418)
@@ -71,6 +71,7 @@
#define SCM_USE_SRFI8 1 /* use SRFI-8 receive procedure written in C */
#define SCM_USE_SRFI23 1 /* use SRFI-23 error procedure written in C */
#define SCM_USE_SRFI38 1 /* use SRFI-38 write/ss written in C */
+#define SCM_USE_SRFI60 1 /* use SRFI-60 integers as bits written in C*/
#define SCM_USE_NONSTD_FEATURES 1 /* use Non-R5RS standard features */
#define SCM_COMPAT_SIOD 1 /* use SIOD compatible features */
#define SCM_COMPAT_SIOD_BUGS 1 /* emulate the buggy behaviors of SIOD */
@@ -78,6 +79,11 @@
#define SCM_STRICT_ARGCHECK 0 /* enable strict argument check */
#define SCM_ACCESSOR_ASSERT 0 /* enable strict type check with accessor */
+/* dependency resolution */
+#if SCM_COMPAT_SIOD
+#define SCM_USE_SRFI60 1
+#endif
+
int SigScm_Die(const char *msg, const char *filename, int line); /* error.c */
#define SCM_ASSERT(cond) \
(cond ? 0 : SigScm_Die("assertion failed.", __FILE__, __LINE__))
@@ -95,6 +101,10 @@
#define SCM_LIST_5(elm1, elm2, elm3, elm4, elm5) \
(SCM_CONS((elm1), SCM_LIST_4(elm2, elm3, elm4, elm5)))
+#define SCM_DEFINE_ALIAS(newsym, sym) \
+ (SCM_SYMBOL_SET_VCELL(Scm_Intern(newsym), \
+ SCM_SYMBOL_VCELL(Scm_Intern(sym))))
+
/*=======================================
Function Declarations
=======================================*/
@@ -377,16 +387,21 @@
/* operations-srfi38.c */
ScmObj ScmOp_SRFI38_write_with_shared_structure(ScmObj arg, ScmObj env);
#endif
+#if SCM_USE_SRFI60
+/* operations-srfi60.c */
+ScmObj ScmOp_SRFI60_logand(ScmObj args, ScmObj env);
+ScmObj ScmOp_SRFI60_logior(ScmObj args, ScmObj env);
+ScmObj ScmOp_SRFI60_logxor(ScmObj args, ScmObj env);
+ScmObj ScmOp_SRFI60_lognot(ScmObj n);
+ScmObj ScmOp_SRFI60_bitwise_if(ScmObj mask, ScmObj n0, ScmObj n1);
+ScmObj ScmOp_SRFI60_logtest(ScmObj j, ScmObj k);
+#endif
#if SCM_COMPAT_SIOD
/* operations-siod.c */
ScmObj ScmOp_symbol_boundp(ScmObj obj);
ScmObj ScmOp_symbol_value(ScmObj var);
ScmObj ScmOp_set_symbol_value(ScmObj var, ScmObj val);
ScmObj ScmOp_siod_eql(ScmObj obj1, ScmObj obj2);
-ScmObj ScmOp_bit_and(ScmObj obj1, ScmObj obj2);
-ScmObj ScmOp_bit_or(ScmObj obj1, ScmObj obj2);
-ScmObj ScmOp_bit_xor(ScmObj obj1, ScmObj obj2);
-ScmObj ScmOp_bit_not(ScmObj obj);
ScmObj ScmOp_the_environment(ScmObj arg, ScmObj env);
ScmObj ScmOp_closure_code(ScmObj closure);
ScmObj ScmOp_verbose(ScmObj args, ScmObj env);
Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h 2005-09-04 22:37:54 UTC (rev 1417)
+++ branches/r5rs/sigscheme/sigschemeinternal.h 2005-09-05 03:10:36 UTC (rev 1418)
@@ -148,7 +148,7 @@
/*
* TODO: rename appropriately
* Since 'CHECK' sounds a positive check as like as 'ASSERT', its opposite
- * meaning may confuse users. So I suggest other name such as 'UNFILLED'.
+ * meaning may confuse users. So I suggest another name such as 'UNFILLED'.
* -- YamaKen 2005-09-05
*/
#define CHECK_1_ARG(arg) (NULLP(arg))
@@ -157,6 +157,52 @@
#define CHECK_4_ARGS(arg) (CHECK_3_ARGS(arg) || NULLP(CDR(CDDR(arg))))
#define CHECK_5_ARGS(arg) (CHECK_4_ARGS(arg) || NULLP(CDDR(CDDR(arg))))
+#define SCM_REDUCE_BY_BINOP(op, ridentity, lst, env, \
+ ctype, validp, extract, make, err_header) \
+ SCM_REDUCE_INTERNAL(((extract(elm)) op accum), ridentity, lst, env, \
+ ctype, validp, extract, make, err_header)
+
+#define SCM_REDUCE_BY_FUNC(f, ridentity, lst, env, \
+ ctype, validp, extract, make, err_header) \
+ SCM_REDUCE_INTERNAL(f(extract(elm), accum), ridentity, lst, env, \
+ ctype, validp, extract, make, err_header)
+
+#define SCM_REDUCE_INTERNAL(fexp, ridentity, lst, env, \
+ ctype, validp, extract, make, err_header) \
+ do { \
+ ScmObj elm, rest; \
+ ctype accum; \
+ \
+ /* 0 */ \
+ if (NULLP(lst)) { \
+ return make(ridentity); \
+ } \
+ \
+ /* 1 */ \
+ elm = ScmOp_eval(CAR(lst), env); \
+ if (!validp(elm)) { \
+ SigScm_ErrorObj(err_header, elm); \
+ return SCM_FALSE; \
+ } else if (NULLP(CDR(lst))) { \
+ return elm; \
+ } \
+ \
+ /* 2+ */ \
+ accum = extract(elm); \
+ rest = CDR(lst); \
+ do { \
+ elm = ScmOp_eval(CAR(rest), env); \
+ rest = CDR(rest); \
+ if (!validp(elm)) { \
+ SigScm_ErrorObj(err_header, elm); \
+ return SCM_FALSE; \
+ } \
+ accum = fexp; \
+ } while (!NULLP(rest)); \
+ \
+ return make(accum); \
+ } while (/* CONSTCOND */ 0)
+
/*=======================================
Function Declarations
=======================================*/
Added: branches/r5rs/sigscheme/test/test-srfi60.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-srfi60.scm 2005-09-04 22:37:54 UTC (rev 1417)
+++ branches/r5rs/sigscheme/test/test-srfi60.scm 2005-09-05 03:10:36 UTC (rev 1418)
@@ -0,0 +1,108 @@
+;; FileName : test-srfi60.scm
+;; About : unit test for SRFI-60 integers as bits
+;;
+;; Copyright (C) 2005 by YamaKen
+;;
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in the
+;; documentation and/or other materials provided with the distribution.
+;; 3. Neither the name of authors nor the names of its contributors
+;; may be used to endorse or promote products derived from this software
+;; without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+;; IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+;; THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(load "test/unittest.scm")
+
+
+;;
+;; Bitwise Operations
+;;
+
+;; logand
+(assert-equal? "logand" 0 (logand))
+(assert-equal? "logand" 0 (logand 0))
+(assert-equal? "logand" #b11 (logand #b11))
+(assert-equal? "logand" #b10 (logand #b1010 #b10))
+(assert-equal? "logand" 0 (logand #b1010 #b100))
+(assert-equal? "logand" #b1010 (logand #b1010 #b1110))
+(assert-equal? "logand" #b1000 (logand #b1010 #b1110 #b101000))
+(assert-equal? "logand" 0 (logand #b1010 #b1110 #b101000 0))
+
+;; logior
+(assert-equal? "logior" 0 (logior))
+(assert-equal? "logior" 0 (logior 0))
+(assert-equal? "logior" #b11 (logior #b11))
+(assert-equal? "logior" #b1010 (logior #b1010 #b10))
+(assert-equal? "logior" #b1110 (logior #b1010 #b100))
+(assert-equal? "logior" #b1110 (logior #b1010 #b1110))
+(assert-equal? "logior" #b101110 (logior #b1010 #b1110 #b101000))
+(assert-equal? "logior" #b101110 (logior #b1010 #b1110 #b101000 0))
+
+;; logxor
+(assert-equal? "logxor" 0 (logxor))
+(assert-equal? "logxor" 0 (logxor 0))
+(assert-equal? "logxor" #b11 (logxor #b11))
+(assert-equal? "logxor" #b1000 (logxor #b1010 #b10))
+(assert-equal? "logxor" #b1110 (logxor #b1010 #b100))
+(assert-equal? "logxor" #b0100 (logxor #b1010 #b1110))
+(assert-equal? "logxor" #b101100 (logxor #b1010 #b1110 #b101000))
+(assert-equal? "logxor" #b101100 (logxor #b1010 #b1110 #b101000 0))
+
+;; lognot
+(assert-equal? "lognot" -1 (lognot 0))
+(assert-equal? "lognot" 0 (lognot -1))
+(assert-equal? "lognot" -2 (lognot 1))
+(assert-equal? "lognot" 1 (lognot -2))
+(assert-equal? "lognot" (- -1 #b1010) (lognot #b1010))
+(assert-equal? "lognot" (- -1 #b0101) (lognot #b0101))
+
+;; bitwise-if
+(assert-equal? "bitwise-if" 0 (bitwise-if 0 0 0))
+(assert-equal? "bitwise-if" 0 (bitwise-if 0 1 0))
+(assert-equal? "bitwise-if" 1 (bitwise-if 0 0 1))
+(assert-equal? "bitwise-if" 1 (bitwise-if 0 1 1))
+(assert-equal? "bitwise-if" 0 (bitwise-if 1 0 0))
+(assert-equal? "bitwise-if" 1 (bitwise-if 1 1 0))
+(assert-equal? "bitwise-if" 0 (bitwise-if 1 0 1))
+(assert-equal? "bitwise-if" 1 (bitwise-if 1 1 1))
+(assert-equal? "bitwise-if" #b0010100 (bitwise-if #b11100 #b1010101 #b0000000))
+(assert-equal? "bitwise-if" #b0110110 (bitwise-if #b11100 #b1010101 #b0101010))
+(assert-equal? "bitwise-if" #b0100010 (bitwise-if #b11100 #b0000000 #b0101010))
+
+;; logtest
+(assert-false "logtest" (logtest 0 0))
+(assert-false "logtest" (logtest 1 0))
+(assert-false "logtest" (logtest 0 1))
+(assert-true "logtest" (logtest 1 1))
+(assert-true "logtest" (logtest #b1010 #b10))
+(assert-false "logtest" (logtest #b1010 #b100))
+(assert-true "logtest" (logtest #b1010 #b1110))
+
+;; aliases
+(assert-eq? "bitwise-and" bitwise-and logand)
+(assert-eq? "bitwise-ior" bitwise-ior logior)
+(assert-eq? "bitwise-xor" bitwise-xor logxor)
+(assert-eq? "bitwise-not" bitwise-not lognot)
+(assert-eq? "bitwise-merge" bitwise-merge bitwise-if)
+(assert-eq? "any-bits-set?" any-bits-set? logtest)
+
+(total-report)
More information about the uim-commit
mailing list