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 ." - (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 with . Assumes and each member of have size ." - (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 is less than . Used by term-sort below. and are each assumed to be of length ." - (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 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 is true does it follow that term is true>? In other words, is contained in ? Assumes that and are of 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 len)) (do ((i 0 (1+ i)) (t2-cur)) @@ -331,14 +331,14 @@ "Can the two terms, , be combined into one. Returns the combined result if true. Assumes and are of 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 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 and are the same. Assumes and are of 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 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: does not match " 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 is larger than . Here, is larger than if there are more E's followed by H's followed by K's in than ." - (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 and each member of has 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 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 but none of the one's from the term . 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 to a bit string of length 4096. 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 ." (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