From df02d2410007b60d0ee057da174552847c0005f0 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sat, 26 Feb 2011 22:32:20 +0000 Subject: * interp/g-opt.boot (optCond): Recognize conjunction and disjunction forms. --- src/algebra/strap/BOOLEAN.lsp | 25 ++++++++--- src/algebra/strap/HOAGG-.lsp | 37 ++++++++-------- src/algebra/strap/ILIST.lsp | 2 +- src/algebra/strap/INTDOM-.lsp | 7 ++-- src/algebra/strap/ISTRING.lsp | 98 +++++++++++++++++-------------------------- src/algebra/strap/LNAGG-.lsp | 6 +-- src/algebra/strap/LSAGG-.lsp | 6 +-- src/algebra/strap/OUTFORM.lsp | 2 +- src/algebra/strap/SYMBOL.lsp | 6 +-- src/algebra/strap/URAGG-.lsp | 27 ++++-------- 10 files changed, 96 insertions(+), 120 deletions(-) (limited to 'src/algebra/strap') diff --git a/src/algebra/strap/BOOLEAN.lsp b/src/algebra/strap/BOOLEAN.lsp index 360d36ef..0c693859 100644 --- a/src/algebra/strap/BOOLEAN.lsp +++ b/src/algebra/strap/BOOLEAN.lsp @@ -53,6 +53,9 @@ (DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) |BOOLEAN;nand;3$;12|)) +(PUT '|BOOLEAN;nand;3$;12| '|SPADreplace| + '(XLAM (|a| |b|) (|%or| (|%not| |a|) (|%not| |b|)))) + (DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) |BOOLEAN;=;3$;13|)) @@ -61,6 +64,9 @@ (DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) |BOOLEAN;implies;3$;14|)) +(PUT '|BOOLEAN;implies;3$;14| '|SPADreplace| + '(XLAM (|a| |b|) (|%or| (|%not| |a|) |b|))) + (DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) |BOOLEAN;equiv;3$;15|)) @@ -69,6 +75,9 @@ (DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) |BOOLEAN;<;3$;16|)) +(PUT '|BOOLEAN;<;3$;16| '|SPADreplace| + '(XLAM (|a| |b|) (|%and| |b| (|%not| |a|)))) + (DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 0)) |BOOLEAN;size;Nni;17|)) @@ -118,29 +127,35 @@ (DEFUN |BOOLEAN;nor;3$;11| (|a| |b| $) (COND (|a| NIL) (T (NOT |b|)))) -(DEFUN |BOOLEAN;nand;3$;12| (|a| |b| $) (COND (|a| (NOT |b|)) (T T))) +(DEFUN |BOOLEAN;nand;3$;12| (|a| |b| $) + (DECLARE (IGNORE $)) + (OR (NOT |a|) (NOT |b|))) (DEFUN |BOOLEAN;=;3$;13| (|a| |b| $) (DECLARE (IGNORE $)) (EQ |a| |b|)) -(DEFUN |BOOLEAN;implies;3$;14| (|a| |b| $) (COND (|a| |b|) (T T))) +(DEFUN |BOOLEAN;implies;3$;14| (|a| |b| $) + (DECLARE (IGNORE $)) + (OR (NOT |a|) |b|)) (DEFUN |BOOLEAN;equiv;3$;15| (|a| |b| $) (DECLARE (IGNORE $)) (EQ |a| |b|)) -(DEFUN |BOOLEAN;<;3$;16| (|a| |b| $) (COND (|b| (NOT |a|)) (T NIL))) +(DEFUN |BOOLEAN;<;3$;16| (|a| |b| $) + (DECLARE (IGNORE $)) + (AND |b| (NOT |a|))) (DEFUN |BOOLEAN;size;Nni;17| ($) (DECLARE (IGNORE $)) 2) (DEFUN |BOOLEAN;index;Pi$;18| (|i| $) - (COND ((SPADCALL |i| (|shellEntry| $ 26)) NIL) (T T))) + (NOT (SPADCALL |i| (|shellEntry| $ 26)))) (DEFUN |BOOLEAN;lookup;$Pi;19| (|a| $) (COND (|a| 1) (T 2))) (DEFUN |BOOLEAN;random;$;20| ($) - (COND ((SPADCALL (|random|) (|shellEntry| $ 26)) NIL) (T T))) + (NOT (SPADCALL (|random|) (|shellEntry| $ 26)))) (DEFUN |BOOLEAN;convert;$If;21| (|x| $) (COND (|x| '|true|) (T '|false|))) diff --git a/src/algebra/strap/HOAGG-.lsp b/src/algebra/strap/HOAGG-.lsp index 7e964eea..e4089147 100644 --- a/src/algebra/strap/HOAGG-.lsp +++ b/src/algebra/strap/HOAGG-.lsp @@ -88,25 +88,24 @@ (SPADCALL |x| (|shellEntry| $ 15))) (DEFUN |HOAGG-;=;2AB;7| (|x| |y| $) - (COND - ((SPADCALL |x| (SPADCALL |y| (|shellEntry| $ 32)) - (|shellEntry| $ 33)) - (LET ((#0=#:G1394 NIL) (#1=#:G1395 T) - (#2=#:G1406 (SPADCALL |x| (|shellEntry| $ 15))) - (#3=#:G1407 (SPADCALL |y| (|shellEntry| $ 15)))) - (LOOP - (COND - ((OR (ATOM #2#) (ATOM #3#)) (RETURN (COND (#1# T) (T #0#)))) - (T (LET ((|a| (CAR #2#)) (|b| (CAR #3#))) - (LET ((#4=#:G1393 (SPADCALL |a| |b| - (|shellEntry| $ 34)))) - (COND - (#1# (SETQ #0# #4#)) - (T (SETQ #0# (AND #0# #4#)))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#)) - (SETQ #3# (CDR #3#))))) - (T NIL))) + (AND (SPADCALL |x| (SPADCALL |y| (|shellEntry| $ 32)) + (|shellEntry| $ 33)) + (LET ((#0=#:G1394 NIL) (#1=#:G1395 T) + (#2=#:G1406 (SPADCALL |x| (|shellEntry| $ 15))) + (#3=#:G1407 (SPADCALL |y| (|shellEntry| $ 15)))) + (LOOP + (COND + ((OR (ATOM #2#) (ATOM #3#)) + (RETURN (COND (#1# T) (T #0#)))) + (T (LET ((|a| (CAR #2#)) (|b| (CAR #3#))) + (LET ((#4=#:G1393 + (SPADCALL |a| |b| (|shellEntry| $ 34)))) + (COND + (#1# (SETQ #0# #4#)) + (T (SETQ #0# (AND #0# #4#)))) + (SETQ #1# NIL))))) + (SETQ #2# (CDR #2#)) + (SETQ #3# (CDR #3#)))))) (DEFUN |HOAGG-;count;SANni;8| (|s| |x| $) (SPADCALL (CONS #'|HOAGG-;count;SANni;8!0| (VECTOR $ |s|)) |x| diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp index 5eb94cfe..64b04a6d 100644 --- a/src/algebra/strap/ILIST.lsp +++ b/src/algebra/strap/ILIST.lsp @@ -263,7 +263,7 @@ (RETURN-FROM |ILIST;=;2$B;22| NIL)) (T (SEQ (SETQ |x| (CDR |x|)) (EXIT (SETQ |y| (CDR |y|))))))))) - (EXIT (COND ((NULL |x|) (NULL |y|)) (T NIL))))))) + (EXIT (AND (NULL |x|) (NULL |y|))))))) (DEFUN |ILIST;latex;$S;23| (|x| $) (LET ((|s| "\\left[")) diff --git a/src/algebra/strap/INTDOM-.lsp b/src/algebra/strap/INTDOM-.lsp index 31205603..b2cee617 100644 --- a/src/algebra/strap/INTDOM-.lsp +++ b/src/algebra/strap/INTDOM-.lsp @@ -31,7 +31,7 @@ (T (SPADCALL (|spadConstant| $ 7) |x| (|shellEntry| $ 15))))) (DEFUN |INTDOM-;unit?;SB;4| (|x| $) - (COND ((EQL (CAR (SPADCALL |x| (|shellEntry| $ 17))) 1) NIL) (T T))) + (NOT (EQL (CAR (SPADCALL |x| (|shellEntry| $ 17))) 1))) (DEFUN |INTDOM-;associates?;2SB;5| (|x| |y| $) (SPADCALL (SVREF (SPADCALL |x| (|shellEntry| $ 10)) 1) @@ -42,10 +42,9 @@ ((SPADCALL |x| (|shellEntry| $ 13)) (SPADCALL |y| (|shellEntry| $ 13))) ((OR (SPADCALL |y| (|shellEntry| $ 13)) - (OR (EQL (CAR (SPADCALL |x| |y| (|shellEntry| $ 15))) 1) - (EQL (CAR (SPADCALL |y| |x| (|shellEntry| $ 15))) 1))) + (EQL (CAR (SPADCALL |x| |y| (|shellEntry| $ 15))) 1)) NIL) - (T T))) + (T (NOT (EQL (CAR (SPADCALL |y| |x| (|shellEntry| $ 15))) 1))))) (DEFUN |IntegralDomain&| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp index 75a3bef4..6f08c5c7 100644 --- a/src/algebra/strap/ISTRING.lsp +++ b/src/algebra/strap/ISTRING.lsp @@ -325,24 +325,20 @@ (LET ((|n| (SPADCALL |s| (|shellEntry| $ 47))) (|i| (SVREF $ 6))) (SEQ (LOOP (COND - ((NOT (COND - ((NOT (< |n| |i|)) - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) - |c| (|shellEntry| $ 70))) - (T NIL))) + ((NOT (AND (NOT (< |n| |i|)) + (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) + |c| (|shellEntry| $ 70)))) (RETURN NIL)) (T (SETQ |i| (+ |i| 1))))) (LETT |l| NIL |ISTRING;split;$CL;22|) (LOOP (COND - ((NOT (COND - ((NOT (< |n| |i|)) - (NOT (< (LETT |j| - (|ISTRING;position;C$2I;19| |c| - |s| |i| $) - |ISTRING;split;$CL;22|) - (SVREF $ 6)))) - (T NIL))) + ((NOT (AND (NOT (< |n| |i|)) + (NOT (< (LETT |j| + (|ISTRING;position;C$2I;19| |c| + |s| |i| $) + |ISTRING;split;$CL;22|) + (SVREF $ 6))))) (RETURN NIL)) (T (SEQ (SETQ |l| (SPADCALL @@ -355,13 +351,10 @@ (EXIT (LOOP (COND ((NOT - (COND - ((NOT (< |n| |i|)) - (SPADCALL - (|ISTRING;elt;$IC;30| |s| |i| - $) - |c| (|shellEntry| $ 70))) - (T NIL))) + (AND (NOT (< |n| |i|)) + (SPADCALL + (|ISTRING;elt;$IC;30| |s| |i| $) + |c| (|shellEntry| $ 70)))) (RETURN NIL)) (T (SETQ |i| (+ |i| 1)))))))))) (COND @@ -379,24 +372,20 @@ (LET ((|n| (SPADCALL |s| (|shellEntry| $ 47))) (|i| (SVREF $ 6))) (SEQ (LOOP (COND - ((NOT (COND - ((NOT (< |n| |i|)) - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) - |cc| (|shellEntry| $ 65))) - (T NIL))) + ((NOT (AND (NOT (< |n| |i|)) + (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) + |cc| (|shellEntry| $ 65)))) (RETURN NIL)) (T (SETQ |i| (+ |i| 1))))) (LETT |l| NIL |ISTRING;split;$CcL;23|) (LOOP (COND - ((NOT (COND - ((NOT (< |n| |i|)) - (NOT (< (LETT |j| - (|ISTRING;position;Cc$2I;20| - |cc| |s| |i| $) - |ISTRING;split;$CcL;23|) - (SVREF $ 6)))) - (T NIL))) + ((NOT (AND (NOT (< |n| |i|)) + (NOT (< (LETT |j| + (|ISTRING;position;Cc$2I;20| |cc| + |s| |i| $) + |ISTRING;split;$CcL;23|) + (SVREF $ 6))))) (RETURN NIL)) (T (SEQ (SETQ |l| (SPADCALL @@ -409,13 +398,10 @@ (EXIT (LOOP (COND ((NOT - (COND - ((NOT (< |n| |i|)) - (SPADCALL - (|ISTRING;elt;$IC;30| |s| |i| - $) - |cc| (|shellEntry| $ 65))) - (T NIL))) + (AND (NOT (< |n| |i|)) + (SPADCALL + (|ISTRING;elt;$IC;30| |s| |i| $) + |cc| (|shellEntry| $ 65)))) (RETURN NIL)) (T (SETQ |i| (+ |i| 1)))))))))) (COND @@ -431,11 +417,9 @@ (LET ((|n| (SPADCALL |s| (|shellEntry| $ 47))) (|i| (SVREF $ 6))) (SEQ (LOOP (COND - ((NOT (COND - ((NOT (< |n| |i|)) - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |c| - (|shellEntry| $ 70))) - (T NIL))) + ((NOT (AND (NOT (< |n| |i|)) + (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |c| + (|shellEntry| $ 70)))) (RETURN NIL)) (T (SETQ |i| (+ |i| 1))))) (EXIT (|ISTRING;elt;$Us$;31| |s| @@ -445,11 +429,9 @@ (LET ((|n| (SPADCALL |s| (|shellEntry| $ 47))) (|i| (SVREF $ 6))) (SEQ (LOOP (COND - ((NOT (COND - ((NOT (< |n| |i|)) - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |cc| - (|shellEntry| $ 65))) - (T NIL))) + ((NOT (AND (NOT (< |n| |i|)) + (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |cc| + (|shellEntry| $ 65)))) (RETURN NIL)) (T (SETQ |i| (+ |i| 1))))) (EXIT (|ISTRING;elt;$Us$;31| |s| @@ -459,11 +441,9 @@ (LET ((|j| (SPADCALL |s| (|shellEntry| $ 47)))) (SEQ (LOOP (COND - ((NOT (COND - ((NOT (< |j| (SVREF $ 6))) - (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) |c| - (|shellEntry| $ 70))) - (T NIL))) + ((NOT (AND (NOT (< |j| (SVREF $ 6))) + (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) |c| + (|shellEntry| $ 70)))) (RETURN NIL)) (T (SETQ |j| (- |j| 1))))) (EXIT (|ISTRING;elt;$Us$;31| |s| @@ -475,11 +455,9 @@ (LET ((|j| (SPADCALL |s| (|shellEntry| $ 47)))) (SEQ (LOOP (COND - ((NOT (COND - ((NOT (< |j| (SVREF $ 6))) - (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) |cc| - (|shellEntry| $ 65))) - (T NIL))) + ((NOT (AND (NOT (< |j| (SVREF $ 6))) + (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) |cc| + (|shellEntry| $ 65)))) (RETURN NIL)) (T (SETQ |j| (- |j| 1))))) (EXIT (|ISTRING;elt;$Us$;31| |s| diff --git a/src/algebra/strap/LNAGG-.lsp b/src/algebra/strap/LNAGG-.lsp index 03d465b5..52b5f081 100644 --- a/src/algebra/strap/LNAGG-.lsp +++ b/src/algebra/strap/LNAGG-.lsp @@ -31,10 +31,8 @@ (SETQ |i| (+ |i| 1))))) (DEFUN |LNAGG-;index?;IAB;2| (|i| |a| $) - (COND - ((NOT (< |i| (SPADCALL |a| (|shellEntry| $ 9)))) - (NOT (< (SPADCALL |a| (|shellEntry| $ 10)) |i|))) - (T NIL))) + (AND (NOT (< |i| (SPADCALL |a| (|shellEntry| $ 9)))) + (NOT (< (SPADCALL |a| (|shellEntry| $ 10)) |i|)))) (DEFUN |LNAGG-;concat;ASA;3| (|a| |x| $) (SPADCALL |a| (SPADCALL 1 |x| (|shellEntry| $ 21)) diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp index 2373264b..288e5efb 100644 --- a/src/algebra/strap/LSAGG-.lsp +++ b/src/algebra/strap/LSAGG-.lsp @@ -614,10 +614,8 @@ (T (SEQ (SETQ |x| (SPADCALL |x| (|shellEntry| $ 17))) (EXIT (SETQ |y| (SPADCALL |y| (|shellEntry| $ 17)))))))))) - (EXIT (COND - ((SPADCALL |x| (|shellEntry| $ 16)) - (NOT (SPADCALL |y| (|shellEntry| $ 16)))) - (T NIL))))) + (EXIT (AND (SPADCALL |x| (|shellEntry| $ 16)) + (NOT (SPADCALL |y| (|shellEntry| $ 16))))))) (DEFUN |ListAggregate&| (|#1| |#2|) (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp index 875112e0..adb05d9b 100644 --- a/src/algebra/strap/OUTFORM.lsp +++ b/src/algebra/strap/OUTFORM.lsp @@ -822,7 +822,7 @@ ((IDENTP |a|) |a|) ((STRINGP |a|) (INTERN |a|)) (T (RETURN-FROM |OUTFORM;infix?;$B;74| NIL))))) - (COND ((GET |e| 'INFIXOP) T) (T NIL)))) + (GET |e| 'INFIXOP))) (DEFUN |OUTFORM;elt;$L$;75| (|a| |l| $) (DECLARE (IGNORE $)) diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp index 298cb495..c9e9bd05 100644 --- a/src/algebra/strap/SYMBOL.lsp +++ b/src/algebra/strap/SYMBOL.lsp @@ -201,10 +201,8 @@ (LIST-LENGTH (SVREF |sc| 0))))) (SEQ (LOOP (COND - ((NOT (COND - ((NOT (< (LIST-LENGTH |ns|) 2)) - (ZEROP (|SPADfirst| |ns|))) - (T NIL))) + ((NOT (AND (NOT (< (LIST-LENGTH |ns|) 2)) + (ZEROP (|SPADfirst| |ns|)))) (RETURN NIL)) (T (SETQ |ns| (CDR |ns|))))) (EXIT (SPADCALL diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp index b1961279..acdd9c4a 100644 --- a/src/algebra/strap/URAGG-.lsp +++ b/src/algebra/strap/URAGG-.lsp @@ -163,10 +163,8 @@ (LET ((|i| |n|)) (SEQ (LOOP (COND - ((NOT (COND - ((PLUSP |i|) - (NOT (SPADCALL |l| (|shellEntry| $ 20)))) - (T NIL))) + ((NOT (AND (PLUSP |i|) + (NOT (SPADCALL |l| (|shellEntry| $ 20))))) (RETURN NIL)) (T (SEQ (SETQ |l| (SPADCALL |l| (|shellEntry| $ 14))) (EXIT (SETQ |i| (- |i| 1))))))) @@ -176,16 +174,13 @@ (LET ((|i| |n|)) (SEQ (LOOP (COND - ((NOT (COND - ((PLUSP |i|) - (NOT (SPADCALL |l| (|shellEntry| $ 20)))) - (T NIL))) + ((NOT (AND (PLUSP |i|) + (NOT (SPADCALL |l| (|shellEntry| $ 20))))) (RETURN NIL)) (T (SEQ (SETQ |l| (SPADCALL |l| (|shellEntry| $ 14))) (EXIT (SETQ |i| (- |i| 1))))))) - (EXIT (COND - ((ZEROP |i|) (NOT (SPADCALL |l| (|shellEntry| $ 20)))) - (T NIL)))))) + (EXIT (AND (ZEROP |i|) + (NOT (SPADCALL |l| (|shellEntry| $ 20)))))))) (DEFUN |URAGG-;size?;ANniB;14| (|l| |n| $) (LET ((|i| |n|)) @@ -197,9 +192,7 @@ (RETURN NIL)) (T (SEQ (SETQ |l| (SPADCALL |l| (|shellEntry| $ 14))) (EXIT (SETQ |i| (- |i| 1))))))) - (EXIT (COND - ((SPADCALL |l| (|shellEntry| $ 20)) (ZEROP |i|)) - (T NIL)))))) + (EXIT (AND (SPADCALL |l| (|shellEntry| $ 20)) (ZEROP |i|)))))) (DEFUN |URAGG-;#;ANni;15| (|x| $) (LET ((|k| 0)) @@ -377,10 +370,8 @@ (SPADCALL |y| (|shellEntry| $ 14))))))))) (SETQ |k| (+ |k| 1)))) - (EXIT (COND - ((SPADCALL |x| (|shellEntry| $ 20)) - (SPADCALL |y| (|shellEntry| $ 20))) - (T NIL))))))) + (EXIT (AND (SPADCALL |x| (|shellEntry| $ 20)) + (SPADCALL |y| (|shellEntry| $ 20)))))))) (DEFUN |URAGG-;node?;2AB;24| (|u| |v| $) (SEQ (LET ((|k| 0)) -- cgit v1.2.3