path: root/dev-lisp/cl-rsm-bool-comp/files/cl-rsm-bool-comp-1.0-gentoo.patch

diff -ur cl-rsm-bool-comp-1.0.orig/bool-comp.lisp cl-rsm-bool-comp-1.0/bool-comp.lisp
--- cl-rsm-bool-comp-1.0.orig/bool-comp.lisp	2003-09-11 11:40:46.000000000 -0500
+++ cl-rsm-bool-comp-1.0/bool-comp.lisp	2003-10-26 17:48:50.000000000 -0600
@@ -151,7 +151,7 @@
 has all entries set to K.
 Returns t if at least one entry differs from K; otherwise nil."
   (declare (type fixnum size)
-           (type vector (unsigned-byte 2) term))
+           (type (vector (unsigned-byte 2) *) term))
   (do ((i 0 (1+ i)))
       ((= i size) nil)
     (declare (type fixnum i))
@@ -164,7 +164,7 @@
   (let* ((len (term-length args))
          (term (make-array len :initial-element e 
                            :element-type '(unsigned-byte 2))))
-    (declare (type vector (unsigned-byte 2) term)
+    (declare (type (vector (unsigned-byte 2) *) term)
              (type fixnum len))
     (do ((i 0 (1+ i))
          (cur args (cdr cur)))
@@ -176,10 +176,10 @@
 
 (defun copy-term (term len)
   "Copy a term."
-  (declare (type vector (unsigned-byte 2) term)
+  (declare (type (vector (unsigned-byte 2) *) term)
            (type fixnum len))
   (let ((new-term (make-identity-term len)))
-    (declare (type vector (unsigned-byte 2) new-term))
+    (declare (type (vector (unsigned-byte 2) *) new-term))
     (do ((i 0 (1+ i)))
         ((= i len) new-term)
       (declare (type fixnum i))
@@ -189,18 +189,18 @@
 
 (defun invert-term (term)
   "Finds the logical negation of a term."
-  (declare (type vector (unsigned-byte 2) term))
+  (declare (type (vector (unsigned-byte 2) *) term))
   (let ((len (term-length term))
         (temp-term nil)
         (result nil))
-    (declare (type vector (unsigned-byte 2) temp-term)
+    (declare (type (vector (unsigned-byte 2) *) temp-term)
              (type fixnum len))
     (do ((i 0 (1+ i))
          (new-term (make-identity-term (term-length term))))
         ((= len i) result)
       (declare (type fixnum i)
-               (type vector (unsigned-byte 2) new-term)
-               (type vector (unsigned-byte 2) temp-term))
+               (type (vector (unsigned-byte 2) *) new-term)
+               (type (vector (unsigned-byte 2) *) temp-term))
       (case (term-ref term i)
         (#.h (setf temp-term (copy-term new-term len))
              (term-set new-term i h)
@@ -215,13 +215,13 @@
 (defun term-mult (t1 t2 size)
   "Takes the logical AND of two terms of the same size.
 Assumes both terms are of size <size>."
-  (declare (type vector (unsigned-byte 2) t1)
-           (type vector (unsigned-byte 2) t2)
+  (declare (type (vector (unsigned-byte 2) *) t1)
+           (type (vector (unsigned-byte 2) *) t2)
            (type fixnum size))
   (let ((prod (make-identity-term size))
         val
         t2-cur)
-    (declare (type vector (unsigned-byte 2) prod)
+    (declare (type (vector (unsigned-byte 2) *) prod)
              (type (unsigned-byte 2) val)
              (type (unsigned-byte 2) t2-cur))    
     (do ((i 0 (1+ i)))
@@ -244,7 +244,7 @@
 (defun term-list-mult (t1 tl2 t-len)
   "Creates a new list by doing a term-wise AND of <tl2> with <t1>.
 Assumes <tl> and each member of <tl2> have size <t-len>."
-  (declare (type vector (unsigned-byte 2) t1))
+  (declare (type (vector (unsigned-byte 2) *) t1))
   (if (or (null t1) (null tl2)) 
     (error "term-list-mult: null list")
     (progn
@@ -253,7 +253,7 @@
             (prod nil))
         (do ((curj tl2 (cdr curj)))
             ((null curj) (or result zero-term))
-          (declare (type vector (unsigned-byte 2) prod))
+          (declare (type (vector (unsigned-byte 2) *) prod))
           (setf prod (term-mult t1 (car curj) t-len))
           (when (not (is-zero-term prod)) (push prod result)))))))
 
@@ -268,13 +268,13 @@
         (result nil))
     (do ((curi tl1 (cdr curi)))
         ((null curi) (or result zero-term))
-      (declare (type vector (unsigned-byte 2) t1-item)
-               (type vector (unsigned-byte 2) prod))
+      (declare (type (vector (unsigned-byte 2) *) t1-item)
+               (type (vector (unsigned-byte 2) *) prod))
       (setf t1-item (car curi))
       (do ((curj tl2 (cdr curj)))
           ((null curj))
         (let ((item (car curj)))
-          (declare (type vector (unsigned-byte 2) item))
+          (declare (type (vector (unsigned-byte 2) *) item))
           (setf prod (term-mult t1-item item t-len))
           (when (not (is-zero-term prod)) (push prod result)))))))
 
@@ -283,8 +283,8 @@
   "Predicate that determines if <t1> is less than <t2>.
 Used by term-sort below.
 <t1> and <t2> are each assumed to be of length <len>."
-  (declare (type vector (unsigned-byte 2) t1)
-           (type vector (unsigned-byte 2) t2)
+  (declare (type (vector (unsigned-byte 2) *) t1)
+           (type (vector (unsigned-byte 2) *) t2)
            (type fixnum len))
   (dotimes (i len nil)
     (let ((c1 (term-ref t1 i))
@@ -300,8 +300,8 @@
   "Sorts terms using the <compare-by-size> the term comparator."
   (declare (type fixnum len))
   (sort tl #'(lambda (t1 t2) 
-               (declare (type vector (unsigned-byte 2) t1)
-                        (type vector (unsigned-byte 2) t2))
+               (declare (type (vector (unsigned-byte 2) *) t1)
+                        (type (vector (unsigned-byte 2) *) t2))
                (compare-by-size t1 t2 len))))
 
 
@@ -309,8 +309,8 @@
   "Whenever term <t1> is true does it follow that term <t2> is true>?
 In other words, is <t1> contained in <t2>?
 Assumes that <t1> and <t2> are of size <len>."
-  (declare (type vector (unsigned-byte 2) t1)
-           (type vector (unsigned-byte 2) t2)
+  (declare (type (vector (unsigned-byte 2) *) t1)
+           (type (vector (unsigned-byte 2) *) t2)
            (type fixnum len))
   (do ((i 0 (1+ i))
        (t2-cur))
@@ -331,14 +331,14 @@
   "Can the two terms, <t1> <t2>, be combined into one.
 Returns the combined result if true.
 Assumes <t1> and <t2> are of size <len>."
-  (declare (type vector (unsigned-byte 2) t1)
-           (type vector (unsigned-byte 2) t2)
+  (declare (type (vector (unsigned-byte 2) *) t1)
+           (type (vector (unsigned-byte 2) *) t2)
            (type fixnum len))
   (let (c1 
         c2
         (index -1)
         term)
-    (declare (type vector (unsigned-byte 2) term)
+    (declare (type (vector (unsigned-byte 2) *) term)
              (type (unsigned-byte 2) c1)
              (type (unsigned-byte 2) c2)
              (type fixnum index))
@@ -367,8 +367,8 @@
 (defun term-eql (t1 t2 len)
   "Predicate: Checks to see if the terms <t1> and <t2> are the same.
 Assumes <t1> and <t2> are of size <len>."
-  (declare (type vector (unsigned-byte 2) t1)
-           (type vector (unsigned-byte 2) t2)
+  (declare (type (vector (unsigned-byte 2) *) t1)
+           (type (vector (unsigned-byte 2) *) t2)
            (type fixnum len))
   (if (or (null t1) (null t2))
     nil
@@ -397,8 +397,8 @@
           ((null next) (values (cons (car curr) result) rm-dup-flag))
         (let ((fc (car curr))
               (fn (car next)))
-          (declare (type vector (unsigned-byte 2) fc)
-                   (type vector (unsigned-byte 2) fn))
+          (declare (type (vector (unsigned-byte 2) *) fc)
+                   (type (vector (unsigned-byte 2) *) fn))
           (if (term-eql fc fn len)
             (if (null (cdr next)) 
               (return-from remove-successive-term-pairs (values result t))
@@ -443,8 +443,8 @@
        term c-term 
        (n-list nil nil))
       ((null cursor) result)
-    (declare (type vector (unsigned-byte 2) term)
-             (type vector (unsigned-byte 2) c-term))
+    (declare (type (vector (unsigned-byte 2) *) term)
+             (type (vector (unsigned-byte 2) *) c-term))
     (setf c-term (car cursor))
     (setf term (copy-term c-term size))
     (do ((i 0 (1+ i)))
@@ -501,7 +501,7 @@
   (declare (type fixnum size))
   (let* ((term (make-identity-term size))
          (pos (is-var? var)))
-    (declare (type vector (unsigned-byte 2) term))
+    (declare (type (vector (unsigned-byte 2) *) term))
     (when pos
       (do ((i 0 (1+ i)))
           ((= i size) term)
@@ -572,9 +572,9 @@
   (declare (type fixnum p1)
            (type fixnum p2)
            (type fixnum len)
-           (type vector (unsigned-byte 2) term))
+           (type (vector (unsigned-byte 2) *) term))
   (let ((copy (copy-term term len)))
-    (declare (type vector (unsigned-byte 2) copy))
+    (declare (type (vector (unsigned-byte 2) *) copy))
     (rotatef (term-ref copy p1)
              (term-ref copy p2))
     copy))
@@ -592,8 +592,8 @@
       ((null cur) result)
     (let* ((term (car cur))
            (copy (copy-term term len)))
-      (declare (type vector (unsigned-byte 2) term)
-               (type vector (unsigned-byte 2) copy))
+      (declare (type (vector (unsigned-byte 2) *) term)
+               (type (vector (unsigned-byte 2) *) copy))
       (rotatef (term-ref copy p1) (term-ref copy p2))
       (push copy result))))
 
@@ -607,7 +607,7 @@
            (type fixnum p2)
            (type fixnum len))
   (let ((flip (make-identity-term len)))
-    (declare (type vector (unsigned-byte 2) flip))
+    (declare (type (vector (unsigned-byte 2) *) flip))
     (case projection
       (#.hh 
        (term-set flip p1 h)
@@ -642,7 +642,7 @@
     (do ((cursor tl (cdr cursor)))
         ((null cursor) result)
       (let ((term (car cursor)))
-        (declare (type vector (unsigned-byte 2) term))
+        (declare (type (vector (unsigned-byte 2) *) term))
         (unless (= (term-ref term p1) (term-ref term p2))
           (push term result))))
     (when result
@@ -702,7 +702,7 @@
 Example: (rsm.bool-comp::eval-function '(#(E H E) #(H E K)) 3 #(2 1 0)) = 
            1 * 1 * 1 + 1 * 1 * 1 = 0"
   (declare (type fixnum size)
-           (type vector (unsigned-byte 2) val))
+           (type (vector (unsigned-byte 2) *) val))
   (if (not (= size (term-length val)))
       (error "eval-function: <size=~a> does not match <val term length=~a>" 
              size (term-length val))
@@ -711,7 +711,7 @@
       (declare (type fixnum xor-sum)
                (type fixnum cur-val))
       (dolist (term tl xor-sum)
-        (declare (type vector (unsigned-byte 2) term))
+        (declare (type (vector (unsigned-byte 2) *) term))
         (setf cur-val 
               (do ((i 0 (1+ i))
                    (curr 0))
@@ -731,8 +731,8 @@
 (defun compare-by-weight (t1 t2 size)
   "Returns true if <t1> is larger than <t2>. Here, <t1> is larger than <t2> 
 if there are more E's followed by H's followed by K's in <t1> than <t2>."
-  (declare (type vector (unsigned-byte 2) t1)
-           (type vector (unsigned-byte 2) t2)
+  (declare (type (vector (unsigned-byte 2) *) t1)
+           (type (vector (unsigned-byte 2) *) t2)
            (type fixnum size))
   (let ((sum1 0)
         (sum2 0)
@@ -761,7 +761,7 @@
   (do ((cursor tl (cdr cursor)))
       ((null cursor) t)
     (let ((item (car cursor)))
-      (declare (type vector (unsigned-byte 2) item))
+      (declare (type (vector (unsigned-byte 2) *) item))
       (when (is-zero-term (term-mult item term size))
         (return-from is-orthog? nil)))))
 
@@ -772,7 +772,7 @@
 Assumes <term> and each member of <tl> has size <size>."
   (declare (type fixnum size)
            (type fixnum start-count)
-           (type vector (unsigned-byte 2) term))
+           (type (vector (unsigned-byte 2) *) term))
   (if (null tl)
     (= (mod start-count 2) 0)
     (do ((cursor tl (cdr cursor))
@@ -781,8 +781,8 @@
          (count start-count))
         ((null cursor) (= (mod count 2) 0))
       (declare (type fixnum count)
-               (type vector (unsigned-byte 2) prod)
-               (type vector (unsigned-byte 2) last))
+               (type (vector (unsigned-byte 2) *) prod)
+               (type (vector (unsigned-byte 2) *) last))
       (setf prod (term-mult prod (car cursor) size))
       (if  (is-zero-term prod)
         (setf prod last)
@@ -803,8 +803,8 @@
         (last-prod-list (list (list (cons (car tl) (car tl)))))
         (count 1))
     (declare (type fixnum count)
-             (type vector (unsigned-byte 2) prod)
-             (type vector (unsigned-byte 2) last-prod))
+             (type (vector (unsigned-byte 2) *) prod)
+             (type (vector (unsigned-byte 2) *) last-prod))
     (do ((cursor (cdr tl) (cdr cursor)))
         ((null cursor) nil)
       (setf prod (term-mult (car cursor) prod size))
@@ -829,7 +829,7 @@
              (val nil)
              (last-val nil))
             ((null cursor) nil)
-          (declare (type vector (unsigned-byte 2) curr))
+          (declare (type (vector (unsigned-byte 2) *) curr))
           (setf pair (car cursor))
           (setf last-prod (caar pair))
           (setf last-val (cdar pair))
@@ -839,8 +839,8 @@
                          (c-last2 nil))
                         ((= i size) nil)
                       (declare (type fixnum i)
-                               (type vector (unsigned-byte 2) c-last)
-                               (type vector (unsigned-byte 2) c-last2))
+                               (type (vector (unsigned-byte 2) *) c-last)
+                               (type (vector (unsigned-byte 2) *) c-last2))
                       (when (and (= (term-ref last-prod i) e) 
                                  (/= (term-ref curr i) e))
                         (case (term-ref curr i)
@@ -877,7 +877,7 @@
   "Converts all E elements of <term> to 0."
   (declare (type fixnum size))
   (let ((val (copy-term term size)))
-    (declare (type vector (unsigned-byte 2) val))
+    (declare (type (vector (unsigned-byte 2) *) val))
     (do ((i 0 (1+ i)))
         ((= i size) val)
       (declare (type fixnum i))
@@ -892,7 +892,7 @@
   (declare (type fixnum size))
   (let ((val (make-array size :initial-element 0 
                          :element-type '(unsigned-byte 2))))
-    (declare (type vector (unsigned-byte 2) val))
+    (declare (type (vector (unsigned-byte 2) *) val))
     (when (= (eval-function tl size val) 1)
       (return-from is-symmetric-function-non-zero? val))
     (do ((i 0 (1+ i)))
@@ -909,14 +909,14 @@
 one's of the term <term> but none of the one's from the term <piece>.
 Example: (rsm.bool-comp::break-off-pieces #(1 2 1) #(1 2 2) 3)
           (#(1 2 0))"
-  (declare (type vector (unsigned-byte 2) term)
-           (type vector (unsigned-byte 2) piece)
+  (declare (type (vector (unsigned-byte 2) *) term)
+           (type (vector (unsigned-byte 2) *) piece)
            (type fixnum size))
   (if (is-contained? term piece size) 
     nil
     (progn
       (let (prod)
-        (declare (type vector (unsigned-byte 2) prod))
+        (declare (type (vector (unsigned-byte 2) *) prod))
         (setf prod (term-mult piece term size))
         (if (is-zero-term prod)
           (list term)
@@ -925,8 +925,8 @@
                 (result nil))
             (declare (type (unsigned-byte 2) t1)
                      (type (unsigned-byte 2) p1)
-                     (type vector (unsigned-byte 2) break-off)
-                     (type vector (unsigned-byte 2) cur))
+                     (type (vector (unsigned-byte 2) *) break-off)
+                     (type (vector (unsigned-byte 2) *) cur))
             (do ((i 0 (1+ i)))
                 ((= i size) result)
               (declare (type fixnum i))
@@ -1021,7 +1021,7 @@
            (type fixnum size))
   (let ((e-term (make-identity-term (- size 2)))
         (count 0))
-    (declare (type vector (unsigned-byte 2) e-term)
+    (declare (type (vector (unsigned-byte 2) *) e-term)
              (type fixnum count))
     (dotimes (idx size e-term)
       (declare (type fixnum idx))
@@ -1050,8 +1050,8 @@
          (term nil)
          (e-term nil))
         ((null cursor) (values invariant complement))
-      (declare (type vector (unsigned-byte 2) term)
-               (type vector (unsigned-byte 2) e-term))
+      (declare (type (vector (unsigned-byte 2) *) term)
+               (type (vector (unsigned-byte 2) *) e-term))
       (setf term (car cursor))
       (setf e-term (excise-term term i j size))
       (case proj
@@ -1090,7 +1090,7 @@
     (declare (type fixnum count)
              (type (unsigned-byte 2) ni)
              (type (unsigned-byte 2) nj)
-             (type vector (unsigned-byte 2) a-term))
+             (type (vector (unsigned-byte 2) *) a-term))
     (case proj
       (#.hh (setf ni h nj h))
       (#.hk (setf ni h nj k))
@@ -1123,7 +1123,7 @@
 (defun convert-term->bit-string-l (term size)
   "Convert a (long) tensor term of size <size> to a bit string of length 4096.
 <size> is assumed to be <= 12."
-  (declare (type vector (unsigned-byte 2) term)
+  (declare (type (vector (unsigned-byte 2) *) term)
            (type fixnum size))
   (let ((b-string ballones))
     (do ((i 0 (1+ i)))
@@ -1169,7 +1169,7 @@
            (type fixnum size))
   (let ((term (make-array size :initial-element 0 
                           :element-type '(unsigned-byte 2))))
-    (declare (type vector (unsigned-byte 2) term))
+    (declare (type (vector (unsigned-byte 2) *) term))
     (multiple-value-bind (d m) (truncate num 2)
       (if (= 1 m)
         (setf (aref term 0) 1)
@@ -1326,7 +1326,7 @@
   (let* ((is-negated (is-negated? var))
          (num (get-number-from-var var))
          (term (make-identity-term size)))
-    (declare (type vector (unsigned-byte 2) term)
+    (declare (type (vector (unsigned-byte 2) *) term)
              (type fixnum num))
     (if (string= var "1")
       term
@@ -1338,7 +1338,7 @@
   (declare (type fixnum size))
   (let ((vars (split varterm "*"))
         (term (make-identity-term size)))
-    (declare (type vector (unsigned-byte 2) term))
+    (declare (type (vector (unsigned-byte 2) *) term))
     (dolist (var vars term)
       (let* ((is-negated (is-negated? var))
              (num (get-number-from-var var)))
@@ -1708,8 +1708,7 @@
                     (let ((copy (copy-list (cdr tree)))
                           (atoms nil))
                       (setf copy (sort copy #'is-more-atomic?))
-                      (do ()
-                          ()
+                      (loop
                         (if (and (not (null (car copy))) (atom (car copy)))
                           (push (pop copy) atoms)
                           (return)))
@@ -1734,8 +1733,7 @@
                     (let ((copy (copy-list (cdr tree)))
                           (atoms nil))
                       (setf copy (sort copy #'is-more-atomic?))
-                      (do ()
-                          ()
+                      (loop
                         (if (and (not (null (car copy))) (atom (car copy)))
                           (push (pop copy) atoms)
                           (return)))
@@ -1842,7 +1840,7 @@
   "Makes a random term of size <size>."
   (declare (type fixnum size))
   (let ((term (make-identity-term size)))
-    (declare (type vector (unsigned-byte 2) term))
+    (declare (type (vector (unsigned-byte 2) *) term))
     (dotimes (i size term)
       (declare (type fixnum i))
       (term-set term i (random 3)))))
Only in cl-rsm-bool-comp-1.0: bool-comp.lisp~
Only in cl-rsm-bool-comp-1.0: bool-comp.x86f