aboutsummaryrefslogtreecommitdiff
path: root/src/algebra/strap
diff options
context:
space:
mode:
Diffstat (limited to 'src/algebra/strap')
-rw-r--r--src/algebra/strap/BOOLEAN.lsp7
-rw-r--r--src/algebra/strap/CLAGG-.lsp4
-rw-r--r--src/algebra/strap/EUCDOM-.lsp9
-rw-r--r--src/algebra/strap/FFIELDC-.lsp42
-rw-r--r--src/algebra/strap/HOAGG-.lsp7
-rw-r--r--src/algebra/strap/ILIST.lsp26
-rw-r--r--src/algebra/strap/INTDOM-.lsp9
-rw-r--r--src/algebra/strap/ISTRING.lsp195
-rw-r--r--src/algebra/strap/LSAGG-.lsp103
-rw-r--r--src/algebra/strap/URAGG-.lsp57
10 files changed, 231 insertions, 228 deletions
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))
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 15:56:18 +0000