Define lexicographical ordering on Bits in Spad

7 files changed, 17 insertions, 66 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 43ce7ad2..173cc693 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,8 @@
+2013-05-26  Gabriel Dos Reis  <gdr@cse.tamu.edu>
+
+	* algebra/boolean.spad.pamphlet (IndexedBits)[<]: Define in Spad.
+	* interp/bits.lisp: Remove.
+
 2013-05-26  Gabriel Dos Reis  <gdr@integrable-solutions.net>
 
 	* interp/sys-utility.boot (makeFilename): Move from nlib.lisp.
diff --git a/src/algebra/boolean.spad.pamphlet b/src/algebra/boolean.spad.pamphlet
index de430f03..14abe29e 100644
--- a/src/algebra/boolean.spad.pamphlet
+++ b/src/algebra/boolean.spad.pamphlet
@@ -137,7 +137,6 @@ IndexedBits(mn:Integer): BitAggregate()
         import %bitvecref: (%,Integer) -> NonNegativeInteger
                                                       from Foreign Builtin
         import %bitveceq: (%,%) -> Boolean            from Foreign Builtin
-        import %bitveclt: (%,%) -> Boolean            from Foreign Builtin
         import %bitvecnot: % -> %                     from Foreign Builtin
         import %bitvecand: (%,%) -> %                 from Foreign Builtin
         import %bitvecor: (%,%) -> %                  from Foreign Builtin
@@ -165,7 +164,15 @@ IndexedBits(mn:Integer): BitAggregate()
         copy v          == %bitveccopy v
         #v              == %bitveclength v
         v = u           == %bitveceq(v,u)
-        v < u           == %bitveclt(v,u)
+        u < v           ==    -- lexicographic
+          nu := #u
+          nv := #v
+          for i in 0.. repeat
+            i >= nu => return or/[%bitvecref(v,j) = 1 for j in i..nv-1]
+            i >= nv => return false
+            %bitvecref(u,i) < %bitvecref(v,i) => return true
+            %bitvecref(u,i) > %bitvecref(v,i) => return false
+
         u and v         == (#v=#u => %bitvecand(v,u); map("and",v,u))
         u or v          == (#v=#u => %bitvecor(v,u); map("or", v,u))
         xor(v,u)        == (#v=#u => %bitvecxor(v,u); map("xor",v,u))
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 5718c61d..195bef45 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -74,7 +74,7 @@ OBJS=   boot-pkg.$(FASLEXT)	types.$(FASLEXT)	 \
 	                     	util.$(FASLEXT)		 \
 	unlisp.$(FASLEXT)	g-util.$(FASLEXT)	\
 	g-opt.$(FASLEXT)	c-util.$(FASLEXT)	\
-	astr.$(FASLEXT)		bits.$(FASLEXT)		\
+	astr.$(FASLEXT)		                  	\
 	ht-util.$(FASLEXT)	bc-util.$(FASLEXT)	\
 	br-search.$(FASLEXT)	alql.$(FASLEXT)		\
 	buildom.$(FASLEXT)	                        \
@@ -337,7 +337,7 @@ cparse.$(FASLEXT): ptrees.$(FASLEXT)
 macex.$(FASLEXT): ptrees.$(FASLEXT)
 ptrees.$(FASLEXT): posit.$(FASLEXT) serror.$(FASLEXT)
 pile.$(FASLEXT): scan.$(FASLEXT)
-scan.$(FASLEXT): incl.$(FASLEXT) bits.$(FASLEXT) dq.$(FASLEXT) sys-utility.$(FASLEXT)
+scan.$(FASLEXT): incl.$(FASLEXT) dq.$(FASLEXT) sys-utility.$(FASLEXT)
 incl.$(FASLEXT): cstream.$(FASLEXT) cformat.$(FASLEXT)
 cformat.$(FASLEXT): unlisp.$(FASLEXT) posit.$(FASLEXT)
 serror.$(FASLEXT): posit.$(FASLEXT)
@@ -346,7 +346,6 @@ posit.$(FASLEXT): sys-macros.$(FASLEXT) astr.$(FASLEXT)
 intfile.$(FASLEXT): cstream.$(FASLEXT)
 cstream.$(FASLEXT): sys-macros.$(FASLEXT)
 astr.$(FASLEXT): vmlisp.$(FASLEXT)
-bits.$(FASLEXT): boot-pkg.$(FASLEXT)
 dq.$(FASLEXT): types.$(FASLEXT)
 
 ## General support and utilities.
diff --git a/src/interp/bits.lisp b/src/interp/bits.lisp
deleted file mode 100644
index 8a97cb10..00000000
--- a/src/interp/bits.lisp
+++ /dev/null
@@ -1,55 +0,0 @@
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-;; All rights reserved.
-;; Copyright (C) 2007-2011, Gabriel Dos Reis.
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are
-;; met:
-;;
-;;     - Redistributions of source code must retain the above copyright
-;;       notice, this list of conditions and the following disclaimer.
-;;
-;;     - 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.
-;;
-;;     - Neither the name of The Numerical ALgorithms Group Ltd. 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 OWNER
-;; 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.
-
-
-;;; The types "bit" and "bit vector" are implemented differently
-;;; in different variants of lisp.
-;;; These lisp macros/functions will have different implementations 
-;;; on different lisp systems.
-
-;;; The operations which traverse entire vectors are given as functions
-;;; since the function calling overhead will be relatively small.
-;;; The operations which extract or set a single part of the vector are
-;;; provided as macros.
-
-(IMPORT-MODULE "boot-pkg")
-(in-package "BOOT")
-
-;;; SMW Nov 88: Created
- 
-(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))))
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index df9d1e75..47859de8 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -662,7 +662,7 @@ $VMsideEffectFreeOperators ==
     %vector %aref %vref %vlength %vcopy
     %bitvector
     %bitvecnot %bitvecand %bitvecnand %bivecor %bitvecnor %bitvecxor
-    %bitveccopy %bitvecconc %bitveclength %bitvecref %bitveceq %bitveclt
+    %bitveccopy %bitvecconc %bitveclength %bitvecref %bitveceq
     %before? %equal %sptreq %ident? %property %tref
     %void %retract %pullback %lambda %closure %external
     %type2form)
diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot
index d421fc3a..e7b9abaf 100644
--- a/src/interp/lisp-backend.boot
+++ b/src/interp/lisp-backend.boot
@@ -406,9 +406,6 @@ expandBitvecref ['%bitvecref,x,y] ==
 expandBitveceq ['%bitveceq,x,y] ==
   ['EQUAL,expandToVMForm x,expandToVMForm y]
 
-expandBitveclt ['%bitveclt,x,y] ==
-  ['BVEC_-GREATER,expandToVMForm y,expandToVMForm x]
-
 expandBitvector ['%bitvector,x,y] ==
   ['MAKE_-ARRAY,['LIST,expandToVMForm x],
      KEYWORD::ELEMENT_-TYPE,quote '%Bit,
@@ -735,7 +732,6 @@ for x in [
    ['%bitveccopy,   :function expandBitveccopy],
    ['%bitvecconc,   :function expandBitvecconc],
    ['%bitveceq,     :function expandBitveceq],
-   ['%bitveclt,     :function expandBitveclt],
    ['%bitvecref,   :function expandBitvecref],
    ['%bitvector,   :function expandBitvector],
 
diff --git a/src/interp/scan.boot b/src/interp/scan.boot
index c314a439..835712bd 100644
--- a/src/interp/scan.boot
+++ b/src/interp/scan.boot
@@ -32,7 +32,6 @@
 -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 
-import bits
 import dq
 import incl
 import sys_-utility