From e8ca9eab6dee408a68683147e9df2f0c81c4354e Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sun, 27 Feb 2011 00:57:26 +0000 Subject: * interp/g-opt.boot (optCond): Recognize conjunction and disjunction forms. --- src/algebra/strap/BOOLEAN.lsp | 7 +- src/algebra/strap/CLAGG-.lsp | 4 +- src/algebra/strap/EUCDOM-.lsp | 9 +- src/algebra/strap/FFIELDC-.lsp | 42 +++++---- src/algebra/strap/HOAGG-.lsp | 7 +- src/algebra/strap/ILIST.lsp | 26 +++--- src/algebra/strap/INTDOM-.lsp | 9 +- src/algebra/strap/ISTRING.lsp | 195 +++++++++++++++++++++-------------------- src/algebra/strap/LSAGG-.lsp | 103 ++++++++++------------ src/algebra/strap/URAGG-.lsp | 57 ++++++------ 10 files changed, 231 insertions(+), 228 deletions(-) (limited to 'src/algebra/strap') diff --git a/src/algebra/strap/BOOLEAN.lsp b/src/algebra/strap/BOOLEAN.lsp index 0c693859..f8e98842 100644 --- a/src/algebra/strap/BOOLEAN.lsp +++ b/src/algebra/strap/BOOLEAN.lsp @@ -50,6 +50,9 @@ (DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) |BOOLEAN;nor;3$;11|)) +(PUT '|BOOLEAN;nor;3$;11| '|SPADreplace| + '(XLAM (|a| |b|) (|%and| (|%not| |a|) (|%not| |b|)))) + (DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) |BOOLEAN;nand;3$;12|)) @@ -125,7 +128,9 @@ (DEFUN |BOOLEAN;xor;3$;10| (|a| |b| $) (COND (|a| (NOT |b|)) (T |b|))) -(DEFUN |BOOLEAN;nor;3$;11| (|a| |b| $) (COND (|a| NIL) (T (NOT |b|)))) +(DEFUN |BOOLEAN;nor;3$;11| (|a| |b| $) + (DECLARE (IGNORE $)) + (AND (NOT |a|) (NOT |b|))) (DEFUN |BOOLEAN;nand;3$;12| (|a| |b| $) (DECLARE (IGNORE $)) diff --git a/src/algebra/strap/CLAGG-.lsp b/src/algebra/strap/CLAGG-.lsp index 953b9dcf..33c77f54 100644 --- a/src/algebra/strap/CLAGG-.lsp +++ b/src/algebra/strap/CLAGG-.lsp @@ -64,7 +64,7 @@ (#2=#:G1405 (SPADCALL |c| (|shellEntry| $ 9)))) (LOOP (COND - ((ATOM #2#) (RETURN (COND (#1# NIL) (T #0#)))) + ((ATOM #2#) (RETURN (AND (NOT #1#) #0#))) (T (LET ((|x| (CAR #2#))) (LET ((#3=#:G1381 (SPADCALL |x| |f|))) (COND (#1# (SETQ #0# #3#)) (T (SETQ #0# (OR #0# #3#)))) @@ -76,7 +76,7 @@ (#2=#:G1406 (SPADCALL |c| (|shellEntry| $ 9)))) (LOOP (COND - ((ATOM #2#) (RETURN (COND (#1# T) (T #0#)))) + ((ATOM #2#) (RETURN (OR #1# #0#))) (T (LET ((|x| (CAR #2#))) (LET ((#3=#:G1385 (SPADCALL |x| |f|))) (COND diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp index 1146ff3e..2df9a4ab 100644 --- a/src/algebra/strap/EUCDOM-.lsp +++ b/src/algebra/strap/EUCDOM-.lsp @@ -36,11 +36,10 @@ |EUCDOM-;multiEuclidean;LSU;11|)) (DEFUN |EUCDOM-;sizeLess?;2SB;1| (|x| |y| $) - (COND - ((SPADCALL |y| (|shellEntry| $ 8)) NIL) - ((SPADCALL |x| (|shellEntry| $ 8)) T) - (T (< (SPADCALL |x| (|shellEntry| $ 12)) - (SPADCALL |y| (|shellEntry| $ 12)))))) + (AND (NOT (SPADCALL |y| (|shellEntry| $ 8))) + (OR (SPADCALL |x| (|shellEntry| $ 8)) + (< (SPADCALL |x| (|shellEntry| $ 12)) + (SPADCALL |y| (|shellEntry| $ 12)))))) (DEFUN |EUCDOM-;quo;3S;2| (|x| |y| $) (CAR (SPADCALL |x| |y| (|shellEntry| $ 16)))) diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp index 80bd0663..81b79b54 100644 --- a/src/algebra/strap/FFIELDC-.lsp +++ b/src/algebra/strap/FFIELDC-.lsp @@ -115,25 +115,29 @@ (EXIT |e|)))))) (DEFUN |FFIELDC-;primitive?;SB;9| (|a| $) - (COND - ((SPADCALL |a| (|shellEntry| $ 16)) NIL) - (T (LET ((|explist| (SPADCALL (|shellEntry| $ 56))) - (|q| (- (SPADCALL (|shellEntry| $ 40)) 1)) - (|equalone| NIL)) - (SEQ (LET ((#0=#:G1488 |explist|) (|exp| NIL)) - (LOOP - (COND - ((OR (ATOM #0#) (PROGN (SETQ |exp| (CAR #0#)) NIL) - (NOT (NOT |equalone|))) - (RETURN NIL)) - (T (SETQ |equalone| - (SPADCALL - (SPADCALL |a| - (TRUNCATE |q| (CAR |exp|)) - (|shellEntry| $ 58)) - (|shellEntry| $ 59))))) - (SETQ #0# (CDR #0#)))) - (EXIT (NOT |equalone|))))))) + (PROG (|explist| |q| |equalone|) + (RETURN + (AND (NOT (SPADCALL |a| (|shellEntry| $ 16))) + (SEQ (LETT |explist| (SPADCALL (|shellEntry| $ 56)) + |FFIELDC-;primitive?;SB;9|) + (LETT |q| (- (SPADCALL (|shellEntry| $ 40)) 1) + |FFIELDC-;primitive?;SB;9|) + (LETT |equalone| NIL |FFIELDC-;primitive?;SB;9|) + (LET ((#0=#:G1488 |explist|) (|exp| NIL)) + (LOOP + (COND + ((OR (ATOM #0#) + (PROGN (SETQ |exp| (CAR #0#)) NIL) + (NOT (NOT |equalone|))) + (RETURN NIL)) + (T (SETQ |equalone| + (SPADCALL + (SPADCALL |a| + (TRUNCATE |q| (CAR |exp|)) + (|shellEntry| $ 58)) + (|shellEntry| $ 59))))) + (SETQ #0# (CDR #0#)))) + (EXIT (NOT |equalone|))))))) (DEFUN |FFIELDC-;order;SPi;10| (|e| $) (PROG (|primeDivisor| |a| |goon|) diff --git a/src/algebra/strap/HOAGG-.lsp b/src/algebra/strap/HOAGG-.lsp index e4089147..e501fcf8 100644 --- a/src/algebra/strap/HOAGG-.lsp +++ b/src/algebra/strap/HOAGG-.lsp @@ -48,7 +48,7 @@ (#2=#:G1403 (SPADCALL |c| (|shellEntry| $ 15)))) (LOOP (COND - ((ATOM #2#) (RETURN (COND (#1# NIL) (T #0#)))) + ((ATOM #2#) (RETURN (AND (NOT #1#) #0#))) (T (LET ((|x| (CAR #2#))) (LET ((#3=#:G1379 (SPADCALL |x| |f|))) (COND (#1# (SETQ #0# #3#)) (T (SETQ #0# (OR #0# #3#)))) @@ -60,7 +60,7 @@ (#2=#:G1404 (SPADCALL |c| (|shellEntry| $ 15)))) (LOOP (COND - ((ATOM #2#) (RETURN (COND (#1# T) (T #0#)))) + ((ATOM #2#) (RETURN (OR #1# #0#))) (T (LET ((|x| (CAR #2#))) (LET ((#3=#:G1384 (SPADCALL |x| |f|))) (COND @@ -95,8 +95,7 @@ (#3=#:G1407 (SPADCALL |y| (|shellEntry| $ 15)))) (LOOP (COND - ((OR (ATOM #2#) (ATOM #3#)) - (RETURN (COND (#1# T) (T #0#)))) + ((OR (ATOM #2#) (ATOM #3#)) (RETURN (OR #1# #0#))) (T (LET ((|a| (CAR #2#)) (|b| (CAR #3#))) (LET ((#4=#:G1393 (SPADCALL |a| |b| (|shellEntry| $ 34)))) diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp index 64b04a6d..6efd96a6 100644 --- a/src/algebra/strap/ILIST.lsp +++ b/src/algebra/strap/ILIST.lsp @@ -251,19 +251,17 @@ (|shellEntry| $ 45)))))))))))) (DEFUN |ILIST;=;2$B;22| (|x| |y| $) - (COND - ((EQ |x| |y|) T) - (T (SEQ (LOOP - (COND - ((NOT (COND ((NULL |x|) NIL) (T (NOT (NULL |y|))))) - (RETURN NIL)) - (T (COND - ((SPADCALL (CAR |x|) (CAR |y|) - (|shellEntry| $ 53)) - (RETURN-FROM |ILIST;=;2$B;22| NIL)) - (T (SEQ (SETQ |x| (CDR |x|)) - (EXIT (SETQ |y| (CDR |y|))))))))) - (EXIT (AND (NULL |x|) (NULL |y|))))))) + (OR (EQ |x| |y|) + (SEQ (LOOP + (COND + ((NOT (AND (NOT (NULL |x|)) (NOT (NULL |y|)))) + (RETURN NIL)) + (T (COND + ((SPADCALL (CAR |x|) (CAR |y|) (|shellEntry| $ 53)) + (RETURN-FROM |ILIST;=;2$B;22| NIL)) + (T (SEQ (SETQ |x| (CDR |x|)) + (EXIT (SETQ |y| (CDR |y|))))))))) + (EXIT (AND (NULL |x|) (NULL |y|)))))) (DEFUN |ILIST;latex;$S;23| (|x| $) (LET ((|s| "\\left[")) @@ -353,7 +351,7 @@ (EXIT (SETQ |q| (CDR |q|)))))) (LOOP (COND - ((NOT (COND ((NULL |p|) NIL) (T (NOT (NULL |q|))))) + ((NOT (AND (NOT (NULL |p|)) (NOT (NULL |q|)))) (RETURN NIL)) (T (COND ((SPADCALL (CAR |p|) (CAR |q|) |f|) diff --git a/src/algebra/strap/INTDOM-.lsp b/src/algebra/strap/INTDOM-.lsp index b2cee617..ccb1ee57 100644 --- a/src/algebra/strap/INTDOM-.lsp +++ b/src/algebra/strap/INTDOM-.lsp @@ -41,10 +41,11 @@ (COND ((SPADCALL |x| (|shellEntry| $ 13)) (SPADCALL |y| (|shellEntry| $ 13))) - ((OR (SPADCALL |y| (|shellEntry| $ 13)) - (EQL (CAR (SPADCALL |x| |y| (|shellEntry| $ 15))) 1)) - NIL) - (T (NOT (EQL (CAR (SPADCALL |y| |x| (|shellEntry| $ 15))) 1))))) + (T (AND (NOT (SPADCALL |y| (|shellEntry| $ 13))) + (AND (NOT (EQL (CAR (SPADCALL |x| |y| (|shellEntry| $ 15))) + 1)) + (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 6f08c5c7..cbb527db 100644 --- a/src/algebra/strap/ISTRING.lsp +++ b/src/algebra/strap/ISTRING.lsp @@ -242,22 +242,23 @@ (SEQ (SETQ |startpos| (- |startpos| (SVREF $ 6))) (EXIT (COND ((MINUSP |startpos|) (|error| "index out of bounds")) - ((< (- |nw| |startpos|) |np|) NIL) - (T (SEQ (LET ((|ip| 0) (#0=#:G1514 (- |np| 1)) - (|iw| |startpos|)) - (LOOP - (COND - ((> |ip| #0#) (RETURN NIL)) - (T (COND - ((NOT - (CHAR= (CHAR |part| |ip|) - (CHAR |whole| |iw|))) - (RETURN-FROM - |ISTRING;substring?;2$IB;17| - NIL))))) - (SETQ |ip| (+ |ip| 1)) - (SETQ |iw| (+ |iw| 1)))) - (EXIT T)))))))) + (T (AND (NOT (< (- |nw| |startpos|) |np|)) + (SEQ (LET ((|ip| 0) (#0=#:G1514 (- |np| 1)) + (|iw| |startpos|)) + (LOOP + (COND + ((> |ip| #0#) (RETURN NIL)) + (T + (COND + ((NOT + (CHAR= (CHAR |part| |ip|) + (CHAR |whole| |iw|))) + (RETURN-FROM + |ISTRING;substring?;2$IB;17| + NIL))))) + (SETQ |ip| (+ |ip| 1)) + (SETQ |iw| (+ |iw| 1)))) + (EXIT T))))))))) (DEFUN |ISTRING;position;2$2I;18| (|s| |t| |startpos| $) (PROG (|r|) @@ -314,10 +315,9 @@ (DEFUN |ISTRING;suffix?;2$B;21| (|s| |t| $) (LET ((|m| (SPADCALL |s| (|shellEntry| $ 47))) (|n| (SPADCALL |t| (|shellEntry| $ 47)))) - (COND - ((< |n| |m|) NIL) - (T (|ISTRING;substring?;2$IB;17| |s| |t| - (- (+ (SVREF $ 6) |n|) |m|) $))))) + (AND (NOT (< |n| |m|)) + (|ISTRING;substring?;2$IB;17| |s| |t| + (- (+ (SVREF $ 6) |n|) |m|) $)))) (DEFUN |ISTRING;split;$CL;22| (|s| |c| $) (PROG (|l| |j|) @@ -543,79 +543,88 @@ (EXIT (COND ((EQL |p| (- |m| 1)) (NOT (NULL (STRING= |pattern| |target|)))) - ((AND (SPADCALL |p| |m| (|shellEntry| $ 88)) - (NOT (SPADCALL - (|ISTRING;elt;$Us$;31| |pattern| - (SPADCALL |m| (- |p| 1) - (|shellEntry| $ 24)) - $) - |target| (|shellEntry| $ 89)))) - NIL) - (T (SEQ (LETT |i| |p| |ISTRING;match?;2$CB;34|) - (LETT |q| - (LET - ((#1=#:G1502 - (|ISTRING;position;C$2I;19| - |dontcare| |pattern| (+ |p| 1) - $))) - (|check-subtype| - (NOT (MINUSP #1#)) - '(|NonNegativeInteger|) #1#)) - |ISTRING;match?;2$CB;34|) - (LOOP - (COND - ((NOT (SPADCALL |q| (- |m| 1) - (|shellEntry| $ 88))) - (RETURN NIL)) - (T (SEQ - (LETT |s| - (|ISTRING;elt;$Us$;31| |pattern| - (SPADCALL (+ |p| 1) (- |q| 1) - (|shellEntry| $ 24)) - $) - |ISTRING;match?;2$CB;34|) - (SETQ |i| - (LET - ((#2=#:G1503 - (|ISTRING;position;2$2I;18| - |s| |target| |i| $))) - (|check-subtype| - (NOT (MINUSP #2#)) - '(|NonNegativeInteger|) #2#))) - (EXIT - (COND - ((EQL |i| (- |m| 1)) - (RETURN-FROM - |ISTRING;match?;2$CB;34| - NIL)) - (T - (SEQ - (SETQ |i| - (+ |i| (LENGTH |s|))) - (SETQ |p| |q|) - (EXIT - (SETQ |q| - (LET - ((#3=#:G1504 - (|ISTRING;position;C$2I;19| - |dontcare| |pattern| - (+ |q| 1) $))) - (|check-subtype| - (NOT (MINUSP #3#)) - '(|NonNegativeInteger|) - #3#)))))))))))) - (COND - ((AND (SPADCALL |p| |n| - (|shellEntry| $ 88)) - (NOT - (|ISTRING;suffix?;2$B;21| - (|ISTRING;elt;$Us$;31| |pattern| - (SPADCALL (+ |p| 1) |n| - (|shellEntry| $ 24)) - $) - |target| $))) - (EXIT NIL))) - (EXIT T)))))))))) + (T (AND (NOT (AND (SPADCALL |p| |m| + (|shellEntry| $ 88)) + (NOT + (SPADCALL + (|ISTRING;elt;$Us$;31| + |pattern| + (SPADCALL |m| (- |p| 1) + (|shellEntry| $ 24)) + $) + |target| (|shellEntry| $ 89))))) + (SEQ (LETT |i| |p| + |ISTRING;match?;2$CB;34|) + (LETT |q| + (LET + ((#1=#:G1502 + (|ISTRING;position;C$2I;19| + |dontcare| |pattern| + (+ |p| 1) $))) + (|check-subtype| + (NOT (MINUSP #1#)) + '(|NonNegativeInteger|) #1#)) + |ISTRING;match?;2$CB;34|) + (LOOP + (COND + ((NOT + (SPADCALL |q| (- |m| 1) + (|shellEntry| $ 88))) + (RETURN NIL)) + (T + (SEQ + (LETT |s| + (|ISTRING;elt;$Us$;31| + |pattern| + (SPADCALL (+ |p| 1) (- |q| 1) + (|shellEntry| $ 24)) + $) + |ISTRING;match?;2$CB;34|) + (SETQ |i| + (LET + ((#2=#:G1503 + (|ISTRING;position;2$2I;18| + |s| |target| |i| $))) + (|check-subtype| + (NOT (MINUSP #2#)) + '(|NonNegativeInteger|) + #2#))) + (EXIT + (COND + ((EQL |i| (- |m| 1)) + (RETURN-FROM + |ISTRING;match?;2$CB;34| + NIL)) + (T + (SEQ + (SETQ |i| + (+ |i| (LENGTH |s|))) + (SETQ |p| |q|) + (EXIT + (SETQ |q| + (LET + ((#3=#:G1504 + (|ISTRING;position;C$2I;19| + |dontcare| |pattern| + (+ |q| 1) $))) + (|check-subtype| + (NOT (MINUSP #3#)) + '(|NonNegativeInteger|) + #3#)))))))))))) + (COND + ((AND + (SPADCALL |p| |n| + (|shellEntry| $ 88)) + (NOT + (|ISTRING;suffix?;2$B;21| + (|ISTRING;elt;$Us$;31| + |pattern| + (SPADCALL (+ |p| 1) |n| + (|shellEntry| $ 24)) + $) + |target| $))) + (EXIT NIL))) + (EXIT T))))))))))) (DEFUN |IndexedString| (#0=#:G1519) (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp index 288e5efb..a71dae77 100644 --- a/src/algebra/strap/LSAGG-.lsp +++ b/src/algebra/strap/LSAGG-.lsp @@ -110,11 +110,10 @@ (RETURN (SEQ (LOOP (COND - ((NOT (COND - ((SPADCALL |x| (|shellEntry| $ 16)) NIL) - (T (NOT (SPADCALL + ((NOT (AND (NOT (SPADCALL |x| (|shellEntry| $ 16))) + (NOT (SPADCALL (SPADCALL |x| (|shellEntry| $ 18)) - |f|))))) + |f|)))) (RETURN NIL)) (T (SETQ |x| (SPADCALL |x| (|shellEntry| $ 17)))))) (EXIT (COND @@ -171,9 +170,8 @@ (|shellEntry| $ 17))))))) (LOOP (COND - ((NOT (COND - ((SPADCALL |p| (|shellEntry| $ 16)) NIL) - (T (NOT (SPADCALL |q| (|shellEntry| $ 16)))))) + ((NOT (AND (NOT (SPADCALL |p| (|shellEntry| $ 16))) + (NOT (SPADCALL |q| (|shellEntry| $ 16))))) (RETURN NIL)) (T (COND ((SPADCALL (SPADCALL |p| (|shellEntry| $ 18)) @@ -239,10 +237,9 @@ (RETURN (SEQ (LOOP (COND - ((NOT (COND - ((SPADCALL |x| (|shellEntry| $ 16)) NIL) - (T (SPADCALL (SPADCALL |x| (|shellEntry| $ 18)) - |f|)))) + ((NOT (AND (NOT (SPADCALL |x| (|shellEntry| $ 16))) + (SPADCALL (SPADCALL |x| (|shellEntry| $ 18)) + |f|))) (RETURN NIL)) (T (SETQ |x| (SPADCALL |x| (|shellEntry| $ 17)))))) (EXIT (COND @@ -338,10 +335,9 @@ (DEFUN |LSAGG-;find;MAU;12| (|f| |x| $) (SEQ (LOOP (COND - ((NOT (COND - ((SPADCALL |x| (|shellEntry| $ 16)) NIL) - (T (NOT (SPADCALL (SPADCALL |x| (|shellEntry| $ 18)) - |f|))))) + ((NOT (AND (NOT (SPADCALL |x| (|shellEntry| $ 16))) + (NOT (SPADCALL (SPADCALL |x| (|shellEntry| $ 18)) + |f|)))) (RETURN NIL)) (T (SETQ |x| (SPADCALL |x| (|shellEntry| $ 17)))))) (EXIT (COND @@ -352,11 +348,10 @@ (LET ((|k| (SPADCALL |x| (|shellEntry| $ 33)))) (SEQ (LOOP (COND - ((NOT (COND - ((SPADCALL |x| (|shellEntry| $ 16)) NIL) - (T (NOT (SPADCALL + ((NOT (AND (NOT (SPADCALL |x| (|shellEntry| $ 16))) + (NOT (SPADCALL (SPADCALL |x| (|shellEntry| $ 18)) - |f|))))) + |f|)))) (RETURN NIL)) (T (SEQ (SETQ |x| (SPADCALL |x| (|shellEntry| $ 17))) (EXIT (SETQ |k| (+ |k| 1))))))) @@ -394,25 +389,26 @@ (|shellEntry| $ 23))))))))))) (DEFUN |LSAGG-;sorted?;MAB;15| (|f| |l| $) - (COND - ((SPADCALL |l| (|shellEntry| $ 16)) T) - (T (LET ((|p| (SPADCALL |l| (|shellEntry| $ 17)))) - (SEQ (LOOP - (COND - ((NOT (NOT (SPADCALL |p| (|shellEntry| $ 16)))) - (RETURN NIL)) - (T (SEQ (COND - ((NOT (SPADCALL - (SPADCALL |l| - (|shellEntry| $ 18)) - (SPADCALL |p| - (|shellEntry| $ 18)) - |f|)) - (RETURN-FROM |LSAGG-;sorted?;MAB;15| NIL))) - (EXIT (SETQ |p| - (SPADCALL (SETQ |l| |p|) - (|shellEntry| $ 17)))))))) - (EXIT T)))))) + (PROG (|p|) + (RETURN + (OR (SPADCALL |l| (|shellEntry| $ 16)) + (SEQ (LETT |p| (SPADCALL |l| (|shellEntry| $ 17)) + |LSAGG-;sorted?;MAB;15|) + (LOOP + (COND + ((NOT (NOT (SPADCALL |p| (|shellEntry| $ 16)))) + (RETURN NIL)) + (T (SEQ (COND + ((NOT (SPADCALL + (SPADCALL |l| (|shellEntry| $ 18)) + (SPADCALL |p| (|shellEntry| $ 18)) + |f|)) + (RETURN-FROM |LSAGG-;sorted?;MAB;15| + NIL))) + (EXIT (SETQ |p| + (SPADCALL (SETQ |l| |p|) + (|shellEntry| $ 17)))))))) + (EXIT T)))))) (DEFUN |LSAGG-;reduce;MA2S;16| (|f| |x| |i| $) (LET ((|r| |i|)) @@ -431,9 +427,8 @@ (LET ((|r| |i|)) (SEQ (LOOP (COND - ((NOT (COND - ((SPADCALL |x| (|shellEntry| $ 16)) NIL) - (T (SPADCALL |r| |a| (|shellEntry| $ 61))))) + ((NOT (AND (NOT (SPADCALL |x| (|shellEntry| $ 16))) + (SPADCALL |r| |a| (|shellEntry| $ 61)))) (RETURN NIL)) (T (SEQ (SETQ |r| (SPADCALL |r| @@ -456,9 +451,8 @@ (LET ((|z| (SPADCALL (|shellEntry| $ 13)))) (SEQ (LOOP (COND - ((NOT (COND - ((SPADCALL |x| (|shellEntry| $ 16)) NIL) - (T (NOT (SPADCALL |y| (|shellEntry| $ 16)))))) + ((NOT (AND (NOT (SPADCALL |x| (|shellEntry| $ 16))) + (NOT (SPADCALL |y| (|shellEntry| $ 16))))) (RETURN NIL)) (T (SEQ (SETQ |z| (SPADCALL @@ -532,10 +526,10 @@ |LSAGG-;copyInto!;2AIA;22|) (LOOP (COND - ((NOT (COND - ((SPADCALL |z| (|shellEntry| $ 16)) NIL) - (T (NOT (SPADCALL |x| - (|shellEntry| $ 16)))))) + ((NOT (AND (NOT (SPADCALL |z| + (|shellEntry| $ 16))) + (NOT (SPADCALL |x| + (|shellEntry| $ 16))))) (RETURN NIL)) (T (SEQ (SPADCALL |z| (SPADCALL |x| (|shellEntry| $ 18)) @@ -561,11 +555,11 @@ (LETT |k| |s| |LSAGG-;position;SA2I;23|) (LOOP (COND - ((NOT (COND - ((SPADCALL |x| (|shellEntry| $ 16)) NIL) - (T (SPADCALL |w| + ((NOT (AND (NOT (SPADCALL |x| + (|shellEntry| $ 16))) + (SPADCALL |w| (SPADCALL |x| (|shellEntry| $ 18)) - (|shellEntry| $ 61))))) + (|shellEntry| $ 61)))) (RETURN NIL)) (T (SEQ (SETQ |x| (SPADCALL |x| (|shellEntry| $ 17))) @@ -599,9 +593,8 @@ (DEFUN |LSAGG-;<;2AB;25| (|x| |y| $) (SEQ (LOOP (COND - ((NOT (COND - ((SPADCALL |x| (|shellEntry| $ 16)) NIL) - (T (NOT (SPADCALL |y| (|shellEntry| $ 16)))))) + ((NOT (AND (NOT (SPADCALL |x| (|shellEntry| $ 16))) + (NOT (SPADCALL |y| (|shellEntry| $ 16))))) (RETURN NIL)) (T (COND ((SPADCALL (SPADCALL |x| (|shellEntry| $ 18)) diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp index acdd9c4a..d0071f47 100644 --- a/src/algebra/strap/URAGG-.lsp +++ b/src/algebra/strap/URAGG-.lsp @@ -126,9 +126,8 @@ (|shellEntry| $ 8))) (DEFUN |URAGG-;cyclic?;AB;6| (|x| $) - (COND - ((SPADCALL |x| (|shellEntry| $ 20)) NIL) - (T (NOT (SPADCALL (|URAGG-;findCycle| |x| $) (|shellEntry| $ 20)))))) + (AND (NOT (SPADCALL |x| (|shellEntry| $ 20))) + (NOT (SPADCALL (|URAGG-;findCycle| |x| $) (|shellEntry| $ 20))))) (DEFUN |URAGG-;last;AS;7| (|x| $) (SPADCALL (SPADCALL |x| (|shellEntry| $ 24)) (|shellEntry| $ 8))) @@ -186,9 +185,8 @@ (LET ((|i| |n|)) (SEQ (LOOP (COND - ((NOT (COND - ((SPADCALL |l| (|shellEntry| $ 20)) NIL) - (T (PLUSP |i|)))) + ((NOT (AND (NOT (SPADCALL |l| (|shellEntry| $ 20))) + (PLUSP |i|))) (RETURN NIL)) (T (SEQ (SETQ |l| (SPADCALL |l| (|shellEntry| $ 14))) (EXIT (SETQ |i| (- |i| 1))))))) @@ -347,31 +345,28 @@ (|shellEntry| $ 63)))))) (DEFUN |URAGG-;=;2AB;23| (|x| |y| $) - (COND - ((SPADCALL |x| |y| (|shellEntry| $ 54)) T) - (T (SEQ (LET ((|k| 0)) - (LOOP - (COND - ((NOT (COND - ((SPADCALL |x| (|shellEntry| $ 20)) NIL) - (T (NOT (SPADCALL |y| (|shellEntry| $ 20)))))) - (RETURN NIL)) - (T (COND - ((AND (EQL |k| 1000) - (SPADCALL |x| (|shellEntry| $ 48))) - (|error| "cyclic list")) - ((SPADCALL (SPADCALL |x| (|shellEntry| $ 8)) - (SPADCALL |y| (|shellEntry| $ 8)) - (|shellEntry| $ 66)) - (RETURN-FROM |URAGG-;=;2AB;23| NIL)) - (T (SEQ (SETQ |x| - (SPADCALL |x| (|shellEntry| $ 14))) - (EXIT (SETQ |y| - (SPADCALL |y| - (|shellEntry| $ 14))))))))) - (SETQ |k| (+ |k| 1)))) - (EXIT (AND (SPADCALL |x| (|shellEntry| $ 20)) - (SPADCALL |y| (|shellEntry| $ 20)))))))) + (OR (SPADCALL |x| |y| (|shellEntry| $ 54)) + (SEQ (LET ((|k| 0)) + (LOOP + (COND + ((NOT (AND (NOT (SPADCALL |x| (|shellEntry| $ 20))) + (NOT (SPADCALL |y| (|shellEntry| $ 20))))) + (RETURN NIL)) + (T (COND + ((AND (EQL |k| 1000) + (SPADCALL |x| (|shellEntry| $ 48))) + (|error| "cyclic list")) + ((SPADCALL (SPADCALL |x| (|shellEntry| $ 8)) + (SPADCALL |y| (|shellEntry| $ 8)) + (|shellEntry| $ 66)) + (RETURN-FROM |URAGG-;=;2AB;23| NIL)) + (T (SEQ (SETQ |x| + (SPADCALL |x| (|shellEntry| $ 14))) + (EXIT (SETQ |y| + (SPADCALL |y| (|shellEntry| $ 14))))))))) + (SETQ |k| (+ |k| 1)))) + (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