* interp/g-util.boot: Expand new bit vector operators.

	* interp/g-opt.boot (opt2bit): New.
	(opt2bool): Likewise.
	* interp/bits.lisp (BVEC-SIZE): Remove.
	(BVEC-COPY): Likewise.
	(BVEC-CONCAT): Likewise.
	(BVEC-EQUAL): Likewise.
	(BVEC-AND): Likewise.
	(BVEC-OR): Likewise.
	(BVEC-XOR): Likewise.
	(BVEC-NAND): Likewise.
	(BVEC-NOR): Likewise.
	(BVEC-NOT): Likewise.
	* algebra/boolean.spad.pamphlet (IndexedBits): Remove uses of
	Lisp-level functions.

4 files changed, 78 insertions, 13 deletions

diff --git a/src/interp/bits.lisp b/src/interp/bits.lisp
index 4ae37adf..5b20b3e7 100644
--- a/src/interp/bits.lisp
+++ b/src/interp/bits.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007, Gabriel Dos Reis.
+;; Copyright (C) 2007-2011, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -55,20 +55,10 @@
 
 (defmacro bvec-elt       (bv i)    `(sbit ,bv ,i))
 (defmacro bvec-setelt    (bv i x)  `(setf (sbit ,bv ,i) ,x))
-(defmacro bvec-size      (bv)      `(size ,bv))
 
-(defun    bvec-copy      (bv)      (copy-seq bv))
-(defun    bvec-concat    (bv1 bv2) (concatenate '(vector bit) bv1 bv2))
-(defun    bvec-equal     (bv1 bv2) (equal    bv1 bv2))
 (defun    bvec-greater   (bv1 bv2)
   (let ((pos (mismatch bv1 bv2)))
     (cond ((or (null pos) (>= pos (length bv1))) nil)
           ((< pos (length bv2)) (> (bit bv1 pos) (bit bv2 pos)))
           ((find 1 bv1 :start pos) t)
           (t nil))))
-(defun    bvec-and       (bv1 bv2) (bit-and  bv1 bv2))
-(defun    bvec-or        (bv1 bv2) (bit-ior  bv1 bv2))
-(defun    bvec-xor       (bv1 bv2) (bit-xor  bv1 bv2))
-(defun    bvec-nand      (bv1 bv2) (bit-nand bv1 bv2))
-(defun    bvec-nor       (bv1 bv2) (bit-nor  bv1 bv2))
-(defun    bvec-not       (bv)      (bit-not  bv))
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 8bed62d1..827a750a 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -453,13 +453,16 @@ $VMsideEffectFreeOperators ==
         %lreverse %lempty? %hash %ismall? %string? %f2s
         %ccst %ceq %clt %cle %cgt %cge %c2i %i2c %s2c %cup %cdown %sname
         %strlength %streq %i2s %schar %strlt %strconc %strcopy %strstc
-        %vref %vlength %before?)
+        %vref %vlength
+        %bitvecnot %bitvecand %bitvecnand %bivecor %bitvecnor %bitvecxor
+        %bitveccopy %bitvecconc %bitveclength %bitvecref %bitveceq
+        %before?)
 
 ++ List of simple VM operators
 $simpleVMoperators == 
   append($VMsideEffectFreeOperators,
     ['CONS,'LIST,'VECTOR,'STRINGIMAGE,'FUNCALL,'%gensym, '%lreverse_!,
-      '%strstc,"MAKE-FULL-CVEC","BVEC-MAKE-FULL","COND"])
+      '%strstc,'%makebitvec,"MAKE-FULL-CVEC","BVEC-MAKE-FULL","COND"])
 
 ++ Return true if the `form' is semi-simple with respect to
 ++ to the list of operators `ops'.
@@ -749,6 +752,18 @@ optIquo(x is ['%iquo,a,b]) ==
   integer? a and integer? b => a quo b
   x
 
+-- Boolean <-> bit conversion.
+opt2bit(x is ['%2bit,a]) ==
+  a is '%true => 1
+  a is '%false => 0
+  x
+
+opt2bool(x is ['%2bool,a]) ==
+  integer? a =>
+    a = 1 => '%true
+    '%false
+  x
+
 --%  
 --% optimizer hash table
 --%
@@ -776,6 +791,8 @@ for x in '( (%call         optCall) _
            (%irem        optIrem)_
            (%iquo        optIquo)_
            (%imul        optImul)_
+           (%2bit        opt2bit)_
+           (%2bool       opt2bool)_
            (LIST         optLIST)_
            (QSMINUS      optQSMINUS)_
            (SPADCALL     optSPADCALL)_
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index fb98bc83..197da15a 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -366,6 +366,45 @@ expandStrlt ['%strlt,x,y] ==
 expandStrstc ['%strstc,x,y,z] ==
   expandToVMForm ['%store,['%schar,x,y],z]
 
+-- bit vector operations
+expandBitvecnot ['%bitvecnot,x] ==
+  ['BIT_-NOT,expandToVMForm x]
+
+expandBitvecand ['%bitvecand,x,y] ==
+  ['BIT_-AND,expandToVMForm x,expandToVMForm y]
+
+expandBitvecnand ['%bitvecnand,x,y] ==
+  ['BIT_-NAND,expandToVMForm x,expandToVMForm y]
+
+expandBitvecor ['%bitvecor,x,y] ==
+  ['BIT_-IOR,expandToVMForm x,expandToVMForm y]
+
+expandBitvecnor ['%bitvecnor,x,y] ==
+  ['BIT_-NOR,expandToVMForm x,expandToVMForm y]
+
+expandBitvecxor ['%bitvecxor,x,y] ==
+  ['BIT_-XOR,expandToVMForm x,expandToVMForm y]
+
+expandBitveclength ['%bitveclength,x] ==
+  ['LENGTH,expandToVMForm x]
+
+expandBitveccopy ['%bitveccopy,x] ==
+  ['COPY_-SEQ,expandToVMForm x]
+
+expandBitvecconc ['%bitvecconc,x,y] ==
+  ['CONCATENATE, quoteForm '%BitVector,expandToVMForm x,expandToVMForm y]
+
+expandBitvecref ['%bitvecref,x,y] ==
+  ['SBIT,expandToVMForm x,expandToVMForm y]
+
+expandBitveceq ['%bitveceq,x,y] ==
+  ['EQUAL,expandToVMForm x,expandToVMForm y]
+
+expandMakebitvec ['%makebitvec,x,y] ==
+  ['MAKE_-ARRAY,['LIST,expandToVMForm x],
+     KEYWORD::ELEMENT_-TYPE,quoteForm '%Bit,
+       KEYWORD::INITIAL_-ELEMENT,expandToVMForm y]
+
 -- Local variable bindings
 expandBind ['%bind,inits,:body] ==
   body := expandToVMForm body
@@ -583,6 +622,19 @@ for x in [
    ['%strlt,   :function expandStrlt],
    ['%strstc,  :function expandStrstc],
 
+   ['%bitvecnot,    :function expandBitvecnot],
+   ['%bitvecand,    :function expandBitvecand],
+   ['%bitvecnand,   :function expandBitvecnand],
+   ['%bitvecor,     :function expandBitvecor],
+   ['%bitvecxor,    :function expandBitvecxor],
+   ['%bitvecnor,    :function expandBitvecnor],
+   ['%bitveclength, :function expandBitveclength],
+   ['%bitveccopy,   :function expandBitveccopy],
+   ['%bitvecconc,   :function expandBitvecconc],
+   ['%bitveceq,     :function expandBitveceq],
+   ['%bitvecref,   :function expandBitvecref],
+   ['%makebitvec,   :function expandMakebitvec],
+
    ['%peq,     :function expandPeq],
    ['%before?, :function expandBefore?],
 
diff --git a/src/interp/types.boot b/src/interp/types.boot
index 60139497..6022a5cb 100644
--- a/src/interp/types.boot
+++ b/src/interp/types.boot
@@ -52,6 +52,10 @@ namespace BOOT
 %Boolean <=> 
   BOOLEAN
 
+++ Type of a bit value.
+%Bit <=>
+  BIT
+
 ++ Type of 8-bit sized unsigned integer values.
 %Byte <=>
   UNSIGNED_-BYTE 8
@@ -115,6 +119,8 @@ namespace BOOT
 
 %Vector a <=> VECTOR a
 
+%BitVector <=> %Vector %Bit
+
 %Thing <=> true
 
 %Sequence <=> SEQUENCE