From 4348e69c730e4e3faa7b993ac0dac5ec426a374c Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sun, 6 Jun 2010 05:36:53 +0000 Subject: * interp/c-util.boot (needPROGS?): New. (transformToBackendCode): Use it. Don't add unneeded PROG/RETURN. --- src/algebra/strap/BOOLEAN.lsp | 24 ++++------ src/algebra/strap/CHAR.lsp | 25 ++++------ src/algebra/strap/DFLOAT.lsp | 29 ++++++------ src/algebra/strap/HOAGG-.lsp | 31 ++++++------- src/algebra/strap/ILIST.lsp | 30 ++++++------ src/algebra/strap/INT.lsp | 24 ++++------ src/algebra/strap/ISTRING.lsp | 30 ++++++------ src/algebra/strap/LIST.lsp | 56 +++++++++++----------- src/algebra/strap/LNAGG-.lsp | 18 ++++---- src/algebra/strap/NNI.lsp | 33 ++++++------- src/algebra/strap/OUTFORM.lsp | 27 +++++------ src/algebra/strap/PI.lsp | 31 ++++++------- src/algebra/strap/POLYCAT-.lsp | 102 +++++++++++++++++++---------------------- src/algebra/strap/SINT.lsp | 30 ++++++------ src/algebra/strap/STAGG-.lsp | 34 +++++++------- src/algebra/strap/SYMBOL.lsp | 23 ++++------ src/algebra/strap/VECTOR.lsp | 26 +++++------ 17 files changed, 255 insertions(+), 318 deletions(-) (limited to 'src/algebra/strap') diff --git a/src/algebra/strap/BOOLEAN.lsp b/src/algebra/strap/BOOLEAN.lsp index 050afcf3..19bdb581 100644 --- a/src/algebra/strap/BOOLEAN.lsp +++ b/src/algebra/strap/BOOLEAN.lsp @@ -151,21 +151,17 @@ (COND (|x| '|true|) ('T '|false|))) (DEFUN |Boolean| () - (PROG () + (PROG (#0=#:G1424) (RETURN - (PROG (#0=#:G1424) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|Boolean|) |Boolean|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Boolean| - (LIST - (CONS NIL (CONS 1 (|Boolean;|)))))) - (LETT #0# T |Boolean|)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|Boolean|))))))))))) + (COND + ((LETT #0# (HGET |$ConstructorCache| '|Boolean|) |Boolean|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Boolean| + (LIST (CONS NIL (CONS 1 (|Boolean;|)))))) + (LETT #0# T |Boolean|)) + (COND ((NOT #0#) (HREM |$ConstructorCache| '|Boolean|))))))))) (DEFUN |Boolean;| () (LET ((|dv$| (LIST '|Boolean|)) ($ (|newShell| 39)) diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp index ad61a999..9e25c452 100644 --- a/src/algebra/strap/CHAR.lsp +++ b/src/algebra/strap/CHAR.lsp @@ -186,22 +186,17 @@ (CHAR-DOWNCASE |c|)) (DEFUN |Character| () - (PROG () + (PROG (#0=#:G1427) (RETURN - (PROG (#0=#:G1427) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|Character|) - |Character|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Character| - (LIST - (CONS NIL (CONS 1 (|Character;|)))))) - (LETT #0# T |Character|)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|Character|))))))))))) + (COND + ((LETT #0# (HGET |$ConstructorCache| '|Character|) |Character|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Character| + (LIST (CONS NIL (CONS 1 (|Character;|)))))) + (LETT #0# T |Character|)) + (COND ((NOT #0#) (HREM |$ConstructorCache| '|Character|))))))))) (DEFUN |Character;| () (LET ((|dv$| (LIST '|Character|)) ($ (|newShell| 58)) diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp index 5a1cdc90..5b2bd769 100644 --- a/src/algebra/strap/DFLOAT.lsp +++ b/src/algebra/strap/DFLOAT.lsp @@ -912,23 +912,20 @@ #0# (EXIT #0#))))) (DEFUN |DoubleFloat| () - (PROG () + (PROG (#0=#:G1562) (RETURN - (PROG (#0=#:G1562) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|DoubleFloat|) - |DoubleFloat|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|DoubleFloat| - (LIST - (CONS NIL - (CONS 1 (|DoubleFloat;|)))))) - (LETT #0# T |DoubleFloat|)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|DoubleFloat|))))))))))) + (COND + ((LETT #0# (HGET |$ConstructorCache| '|DoubleFloat|) + |DoubleFloat|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|DoubleFloat| + (LIST (CONS NIL + (CONS 1 (|DoubleFloat;|)))))) + (LETT #0# T |DoubleFloat|)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|DoubleFloat|))))))))) (DEFUN |DoubleFloat;| () (LET ((|dv$| (LIST '|DoubleFloat|)) ($ (|newShell| 164)) diff --git a/src/algebra/strap/HOAGG-.lsp b/src/algebra/strap/HOAGG-.lsp index 45b2d2a1..71f89bfd 100644 --- a/src/algebra/strap/HOAGG-.lsp +++ b/src/algebra/strap/HOAGG-.lsp @@ -195,24 +195,21 @@ ('T NIL)))))) (DEFUN |HOAGG-;coerce;AOf;10| (|x| $) - (PROG () - (RETURN + (SPADCALL (SPADCALL - (SPADCALL - (LET ((#0=#:G1434 (SPADCALL |x| (|getShellEntry| $ 15))) - (#1=#:G1433 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|a| (CAR #0#))) - (LETT #1# - (CONS (SPADCALL |a| - (|getShellEntry| $ 39)) - #1#) - |HOAGG-;coerce;AOf;10|)))) - (LETT #0# (CDR #0#) |HOAGG-;coerce;AOf;10|))) - (|getShellEntry| $ 41)) - (|getShellEntry| $ 42))))) + (LET ((#0=#:G1434 (SPADCALL |x| (|getShellEntry| $ 15))) + (#1=#:G1433 NIL)) + (LOOP + (COND + ((ATOM #0#) (RETURN (NREVERSE #1#))) + (T (LET ((|a| (CAR #0#))) + (LETT #1# + (CONS (SPADCALL |a| (|getShellEntry| $ 39)) + #1#) + |HOAGG-;coerce;AOf;10|)))) + (LETT #0# (CDR #0#) |HOAGG-;coerce;AOf;10|))) + (|getShellEntry| $ 41)) + (|getShellEntry| $ 42))) (DEFUN |HomogeneousAggregate&| (|#1| |#2|) (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp index f634b5e1..ea18f466 100644 --- a/src/algebra/strap/ILIST.lsp +++ b/src/algebra/strap/ILIST.lsp @@ -464,23 +464,21 @@ (DEFUN |IndexedList| (&REST #0=#:G1520 &AUX #1=#:G1518) (DSETQ #1# #0#) - (PROG () + (PROG (#2=#:G1519) (RETURN - (PROG (#2=#:G1519) - (RETURN - (COND - ((LETT #2# - (|lassocShiftWithFunction| (|devaluateList| #1#) - (HGET |$ConstructorCache| '|IndexedList|) - '|domainEqualList|) - |IndexedList|) - (|CDRwithIncrement| #2#)) - ('T - (UNWIND-PROTECT - (PROG1 (APPLY (|function| |IndexedList;|) #1#) - (LETT #2# T |IndexedList|)) - (COND - ((NOT #2#) (HREM |$ConstructorCache| '|IndexedList|))))))))))) + (COND + ((LETT #2# + (|lassocShiftWithFunction| (|devaluateList| #1#) + (HGET |$ConstructorCache| '|IndexedList|) + '|domainEqualList|) + |IndexedList|) + (|CDRwithIncrement| #2#)) + ('T + (UNWIND-PROTECT + (PROG1 (APPLY (|function| |IndexedList;|) #1#) + (LETT #2# T |IndexedList|)) + (COND + ((NOT #2#) (HREM |$ConstructorCache| '|IndexedList|))))))))) (DEFUN |IndexedList;| (|#1| |#2|) (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp index 23b42bf6..8fb11f5a 100644 --- a/src/algebra/strap/INT.lsp +++ b/src/algebra/strap/INT.lsp @@ -516,21 +516,17 @@ ('T (SPADCALL (LIST |p| |q|) (|getShellEntry| $ 126))))) (DEFUN |Integer| () - (PROG () + (PROG (#0=#:G1524) (RETURN - (PROG (#0=#:G1524) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|Integer|) |Integer|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Integer| - (LIST - (CONS NIL (CONS 1 (|Integer;|)))))) - (LETT #0# T |Integer|)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|Integer|))))))))))) + (COND + ((LETT #0# (HGET |$ConstructorCache| '|Integer|) |Integer|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Integer| + (LIST (CONS NIL (CONS 1 (|Integer;|)))))) + (LETT #0# T |Integer|)) + (COND ((NOT #0#) (HREM |$ConstructorCache| '|Integer|))))))))) (DEFUN |Integer;| () (LET ((|dv$| (LIST '|Integer|)) ($ (|newShell| 141)) diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp index 6ceaf1dc..7879d51f 100644 --- a/src/algebra/strap/ISTRING.lsp +++ b/src/algebra/strap/ISTRING.lsp @@ -813,24 +813,20 @@ #0# (EXIT #0#))))) (DEFUN |IndexedString| (#0=#:G1542) - (PROG () + (PROG (#1=#:G1543) (RETURN - (PROG (#1=#:G1543) - (RETURN - (COND - ((LETT #1# - (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) - (HGET |$ConstructorCache| '|IndexedString|) - '|domainEqualList|) - |IndexedString|) - (|CDRwithIncrement| #1#)) - ('T - (UNWIND-PROTECT - (PROG1 (|IndexedString;| #0#) - (LETT #1# T |IndexedString|)) - (COND - ((NOT #1#) - (HREM |$ConstructorCache| '|IndexedString|))))))))))) + (COND + ((LETT #1# + (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) + (HGET |$ConstructorCache| '|IndexedString|) + '|domainEqualList|) + |IndexedString|) + (|CDRwithIncrement| #1#)) + ('T + (UNWIND-PROTECT + (PROG1 (|IndexedString;| #0#) (LETT #1# T |IndexedString|)) + (COND + ((NOT #1#) (HREM |$ConstructorCache| '|IndexedString|))))))))) (DEFUN |IndexedString;| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp index a214f893..1898f8cb 100644 --- a/src/algebra/strap/LIST.lsp +++ b/src/algebra/strap/LIST.lsp @@ -172,39 +172,35 @@ (EXIT |lu|))))) (DEFUN |LIST;convert;$If;13| (|x| $) - (PROG () - (RETURN - (SPADCALL - (CONS (SPADCALL '|construct| (|getShellEntry| $ 47)) - (LET ((#0=#:G1444 |x|) (#1=#:G1443 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|a| (CAR #0#))) - (LETT #1# - (CONS (SPADCALL |a| - (|getShellEntry| $ 48)) - #1#) - |LIST;convert;$If;13|)))) - (LETT #0# (CDR #0#) |LIST;convert;$If;13|)))) - (|getShellEntry| $ 52))))) + (SPADCALL + (CONS (SPADCALL '|construct| (|getShellEntry| $ 47)) + (LET ((#0=#:G1444 |x|) (#1=#:G1443 NIL)) + (LOOP + (COND + ((ATOM #0#) (RETURN (NREVERSE #1#))) + (T (LET ((|a| (CAR #0#))) + (LETT #1# + (CONS (SPADCALL |a| + (|getShellEntry| $ 48)) + #1#) + |LIST;convert;$If;13|)))) + (LETT #0# (CDR #0#) |LIST;convert;$If;13|)))) + (|getShellEntry| $ 52))) (DEFUN |List| (#0=#:G1445) - (PROG () + (PROG (#1=#:G1446) (RETURN - (PROG (#1=#:G1446) - (RETURN - (COND - ((LETT #1# - (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) - (HGET |$ConstructorCache| '|List|) - '|domainEqualList|) - |List|) - (|CDRwithIncrement| #1#)) - ('T - (UNWIND-PROTECT - (PROG1 (|List;| #0#) (LETT #1# T |List|)) - (COND ((NOT #1#) (HREM |$ConstructorCache| '|List|))))))))))) + (COND + ((LETT #1# + (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) + (HGET |$ConstructorCache| '|List|) + '|domainEqualList|) + |List|) + (|CDRwithIncrement| #1#)) + ('T + (UNWIND-PROTECT + (PROG1 (|List;| #0#) (LETT #1# T |List|)) + (COND ((NOT #1#) (HREM |$ConstructorCache| '|List|))))))))) (DEFUN |List;| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$| (LIST '|List| |dv$1|)) diff --git a/src/algebra/strap/LNAGG-.lsp b/src/algebra/strap/LNAGG-.lsp index 9051a7b1..013dda16 100644 --- a/src/algebra/strap/LNAGG-.lsp +++ b/src/algebra/strap/LNAGG-.lsp @@ -21,16 +21,14 @@ |LNAGG-;maxIndex;AI;6|)) (DEFUN |LNAGG-;indices;AL;1| (|a| $) - (PROG () - (RETURN - (LET ((|i| (SPADCALL |a| (|getShellEntry| $ 9))) - (#0=#:G1412 (SPADCALL |a| (|getShellEntry| $ 10))) - (#1=#:G1411 NIL)) - (LOOP - (COND - ((> |i| #0#) (RETURN (NREVERSE #1#))) - (T (LETT #1# (CONS |i| #1#) |LNAGG-;indices;AL;1|))) - (LETT |i| (+ |i| 1) |LNAGG-;indices;AL;1|)))))) + (LET ((|i| (SPADCALL |a| (|getShellEntry| $ 9))) + (#0=#:G1412 (SPADCALL |a| (|getShellEntry| $ 10))) + (#1=#:G1411 NIL)) + (LOOP + (COND + ((> |i| #0#) (RETURN (NREVERSE #1#))) + (T (LETT #1# (CONS |i| #1#) |LNAGG-;indices;AL;1|))) + (LETT |i| (+ |i| 1) |LNAGG-;indices;AL;1|)))) (DEFUN |LNAGG-;index?;IAB;2| (|i| |a| $) (COND diff --git a/src/algebra/strap/NNI.lsp b/src/algebra/strap/NNI.lsp index 357b3954..9490e64c 100644 --- a/src/algebra/strap/NNI.lsp +++ b/src/algebra/strap/NNI.lsp @@ -42,25 +42,22 @@ '(|NonNegativeInteger|) |c|))))))))) (DEFUN |NonNegativeInteger| () - (PROG () + (PROG (#0=#:G1409) (RETURN - (PROG (#0=#:G1409) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|NonNegativeInteger|) - |NonNegativeInteger|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| - '|NonNegativeInteger| - (LIST - (CONS NIL - (CONS 1 (|NonNegativeInteger;|)))))) - (LETT #0# T |NonNegativeInteger|)) - (COND - ((NOT #0#) - (HREM |$ConstructorCache| '|NonNegativeInteger|))))))))))) + (COND + ((LETT #0# (HGET |$ConstructorCache| '|NonNegativeInteger|) + |NonNegativeInteger|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| + '|NonNegativeInteger| + (LIST (CONS NIL + (CONS 1 (|NonNegativeInteger;|)))))) + (LETT #0# T |NonNegativeInteger|)) + (COND + ((NOT #0#) + (HREM |$ConstructorCache| '|NonNegativeInteger|))))))))) (DEFUN |NonNegativeInteger;| () (LET ((|dv$| (LIST '|NonNegativeInteger|)) ($ (|newShell| 22)) diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp index 0e62d8b9..0e90fa71 100644 --- a/src/algebra/strap/OUTFORM.lsp +++ b/src/algebra/strap/OUTFORM.lsp @@ -1016,22 +1016,19 @@ (LIST 'INTSIGN |b| |c| |a|)) (DEFUN |OutputForm| () - (PROG () + (PROG (#0=#:G1557) (RETURN - (PROG (#0=#:G1557) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|OutputForm|) - |OutputForm|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|OutputForm| - (LIST - (CONS NIL (CONS 1 (|OutputForm;|)))))) - (LETT #0# T |OutputForm|)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|OutputForm|))))))))))) + (COND + ((LETT #0# (HGET |$ConstructorCache| '|OutputForm|) + |OutputForm|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|OutputForm| + (LIST (CONS NIL + (CONS 1 (|OutputForm;|)))))) + (LETT #0# T |OutputForm|)) + (COND ((NOT #0#) (HREM |$ConstructorCache| '|OutputForm|))))))))) (DEFUN |OutputForm;| () (LET ((|dv$| (LIST '|OutputForm|)) ($ (|newShell| 150)) diff --git a/src/algebra/strap/PI.lsp b/src/algebra/strap/PI.lsp index d40bdae0..c7fd8a31 100644 --- a/src/algebra/strap/PI.lsp +++ b/src/algebra/strap/PI.lsp @@ -5,25 +5,20 @@ '(|%igt| |#1| 0)) (DEFUN |PositiveInteger| () - (PROG () + (PROG (#0=#:G1401) (RETURN - (PROG (#0=#:G1401) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|PositiveInteger|) - |PositiveInteger|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| - '|PositiveInteger| - (LIST - (CONS NIL - (CONS 1 (|PositiveInteger;|)))))) - (LETT #0# T |PositiveInteger|)) - (COND - ((NOT #0#) - (HREM |$ConstructorCache| '|PositiveInteger|))))))))))) + (COND + ((LETT #0# (HGET |$ConstructorCache| '|PositiveInteger|) + |PositiveInteger|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|PositiveInteger| + (LIST (CONS NIL + (CONS 1 (|PositiveInteger;|)))))) + (LETT #0# T |PositiveInteger|)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|PositiveInteger|))))))))) (DEFUN |PositiveInteger;| () (LET ((|dv$| (LIST '|PositiveInteger|)) ($ (|newShell| 16)) diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp index 27bcc9e6..31e4004f 100644 --- a/src/algebra/strap/POLYCAT-.lsp +++ b/src/algebra/strap/POLYCAT-.lsp @@ -371,17 +371,15 @@ (|getShellEntry| $ 76))) (DEFUN |POLYCAT-;primitiveMonomials;SL;12| (|p| $) - (PROG () - (RETURN - (LET ((#0=#:G1699 (SPADCALL |p| (|getShellEntry| $ 35))) - (#1=#:G1698 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|q| (CAR #0#))) - (LETT #1# (CONS (|POLYCAT-;mkPrim| |q| $) #1#) - |POLYCAT-;primitiveMonomials;SL;12|)))) - (LETT #0# (CDR #0#) |POLYCAT-;primitiveMonomials;SL;12|)))))) + (LET ((#0=#:G1699 (SPADCALL |p| (|getShellEntry| $ 35))) + (#1=#:G1698 NIL)) + (LOOP + (COND + ((ATOM #0#) (RETURN (NREVERSE #1#))) + (T (LET ((|q| (CAR #0#))) + (LETT #1# (CONS (|POLYCAT-;mkPrim| |q| $) #1#) + |POLYCAT-;primitiveMonomials;SL;12|)))) + (LETT #0# (CDR #0#) |POLYCAT-;primitiveMonomials;SL;12|)))) (DEFUN |POLYCAT-;totalDegree;SNni;13| (|p| $) (PROG (#0=#:G1492 |d| |u|) @@ -481,23 +479,20 @@ (|getShellEntry| $ 96))) (DEFUN |POLYCAT-;allMonoms| (|l| $) - (PROG () - (RETURN + (SPADCALL (SPADCALL - (SPADCALL - (LET ((#0=#:G1701 |l|) (#1=#:G1700 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|p| (CAR #0#))) - (LETT #1# - (CONS (SPADCALL |p| - (|getShellEntry| $ 98)) - #1#) - |POLYCAT-;allMonoms|)))) - (LETT #0# (CDR #0#) |POLYCAT-;allMonoms|))) - (|getShellEntry| $ 99)) - (|getShellEntry| $ 100))))) + (LET ((#0=#:G1701 |l|) (#1=#:G1700 NIL)) + (LOOP + (COND + ((ATOM #0#) (RETURN (NREVERSE #1#))) + (T (LET ((|p| (CAR #0#))) + (LETT #1# + (CONS (SPADCALL |p| (|getShellEntry| $ 98)) + #1#) + |POLYCAT-;allMonoms|)))) + (LETT #0# (CDR #0#) |POLYCAT-;allMonoms|))) + (|getShellEntry| $ 99)) + (|getShellEntry| $ 100))) (DEFUN |POLYCAT-;P2R| (|p| |b| |n| $) (PROG (|w| |bj| #0=#:G1703 |i| #1=#:G1702) @@ -530,35 +525,30 @@ (EXIT |w|))))) (DEFUN |POLYCAT-;eq2R| (|l| |b| $) - (PROG () - (RETURN - (SPADCALL - (LET ((#0=#:G1707 |b|) (#1=#:G1704 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|bj| (CAR #0#))) - (LETT #1# - (CONS (LET ((#2=#:G1706 |l|) - (#3=#:G1705 NIL)) - (LOOP - (COND - ((ATOM #2#) - (RETURN (NREVERSE #3#))) - (T - (LET ((|p| (CAR #2#))) - (LETT #3# - (CONS - (SPADCALL |p| |bj| - (|getShellEntry| $ 106)) - #3#) - |POLYCAT-;eq2R|)))) - (LETT #2# (CDR #2#) - |POLYCAT-;eq2R|))) - #1#) - |POLYCAT-;eq2R|)))) - (LETT #0# (CDR #0#) |POLYCAT-;eq2R|))) - (|getShellEntry| $ 111))))) + (SPADCALL + (LET ((#0=#:G1707 |b|) (#1=#:G1704 NIL)) + (LOOP + (COND + ((ATOM #0#) (RETURN (NREVERSE #1#))) + (T (LET ((|bj| (CAR #0#))) + (LETT #1# + (CONS (LET ((#2=#:G1706 |l|) (#3=#:G1705 NIL)) + (LOOP + (COND + ((ATOM #2#) (RETURN (NREVERSE #3#))) + (T + (LET ((|p| (CAR #2#))) + (LETT #3# + (CONS + (SPADCALL |p| |bj| + (|getShellEntry| $ 106)) + #3#) + |POLYCAT-;eq2R|)))) + (LETT #2# (CDR #2#) |POLYCAT-;eq2R|))) + #1#) + |POLYCAT-;eq2R|)))) + (LETT #0# (CDR #0#) |POLYCAT-;eq2R|))) + (|getShellEntry| $ 111))) (DEFUN |POLYCAT-;reducedSystem;MM;20| (|m| $) (PROG (|b| |d| |mm| |l|) diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp index bac231f6..2197f582 100644 --- a/src/algebra/strap/SINT.lsp +++ b/src/algebra/strap/SINT.lsp @@ -528,24 +528,20 @@ ('T (VECTOR 1 |x| 1)))) (DEFUN |SingleInteger| () - (PROG () + (PROG (#0=#:G1495) (RETURN - (PROG (#0=#:G1495) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|SingleInteger|) - |SingleInteger|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|SingleInteger| - (LIST - (CONS NIL - (CONS 1 (|SingleInteger;|)))))) - (LETT #0# T |SingleInteger|)) - (COND - ((NOT #0#) - (HREM |$ConstructorCache| '|SingleInteger|))))))))))) + (COND + ((LETT #0# (HGET |$ConstructorCache| '|SingleInteger|) + |SingleInteger|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|SingleInteger| + (LIST (CONS NIL + (CONS 1 (|SingleInteger;|)))))) + (LETT #0# T |SingleInteger|)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|SingleInteger|))))))))) (DEFUN |SingleInteger;| () (LET ((|dv$| (LIST '|SingleInteger|)) ($ (|newShell| 116)) diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp index 2c69bba1..0f429a51 100644 --- a/src/algebra/strap/STAGG-.lsp +++ b/src/algebra/strap/STAGG-.lsp @@ -50,24 +50,22 @@ (SPADCALL |x| (|getShellEntry| $ 9))) (DEFUN |STAGG-;first;ANniA;3| (|x| |n| $) - (PROG () - (RETURN - (SPADCALL - (LET ((|i| 1) (#0=#:G1447 NIL)) - (LOOP - (COND - ((> |i| |n|) (RETURN (NREVERSE #0#))) - (T (LETT #0# - (CONS (|STAGG-;c2| |x| - (LETT |x| - (SPADCALL |x| - (|getShellEntry| $ 13)) - |STAGG-;first;ANniA;3|) - $) - #0#) - |STAGG-;first;ANniA;3|))) - (LETT |i| (+ |i| 1) |STAGG-;first;ANniA;3|))) - (|getShellEntry| $ 15))))) + (SPADCALL + (LET ((|i| 1) (#0=#:G1447 NIL)) + (LOOP + (COND + ((> |i| |n|) (RETURN (NREVERSE #0#))) + (T (LETT #0# + (CONS (|STAGG-;c2| |x| + (LETT |x| + (SPADCALL |x| + (|getShellEntry| $ 13)) + |STAGG-;first;ANniA;3|) + $) + #0#) + |STAGG-;first;ANniA;3|))) + (LETT |i| (+ |i| 1) |STAGG-;first;ANniA;3|))) + (|getShellEntry| $ 15))) (DEFUN |STAGG-;c2| (|x| |r| $) (COND diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp index 1071ebce..40ceb5c1 100644 --- a/src/algebra/strap/SYMBOL.lsp +++ b/src/algebra/strap/SYMBOL.lsp @@ -725,20 +725,17 @@ (DEFUN |SYMBOL;sample;$;35| ($) (DECLARE (IGNORE $)) '|aSymbol|) (DEFUN |Symbol| () - (PROG () + (PROG (#0=#:G1556) (RETURN - (PROG (#0=#:G1556) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|Symbol|) |Symbol|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Symbol| - (LIST - (CONS NIL (CONS 1 (|Symbol;|)))))) - (LETT #0# T |Symbol|)) - (COND ((NOT #0#) (HREM |$ConstructorCache| '|Symbol|))))))))))) + (COND + ((LETT #0# (HGET |$ConstructorCache| '|Symbol|) |Symbol|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Symbol| + (LIST (CONS NIL (CONS 1 (|Symbol;|)))))) + (LETT #0# T |Symbol|)) + (COND ((NOT #0#) (HREM |$ConstructorCache| '|Symbol|))))))))) (DEFUN |Symbol;| () (LET ((|dv$| (LIST '|Symbol|)) ($ (|newShell| 165)) diff --git a/src/algebra/strap/VECTOR.lsp b/src/algebra/strap/VECTOR.lsp index b3208017..4e5d078a 100644 --- a/src/algebra/strap/VECTOR.lsp +++ b/src/algebra/strap/VECTOR.lsp @@ -27,21 +27,19 @@ (|getShellEntry| $ 19))) (DEFUN |Vector| (#0=#:G1408) - (PROG () + (PROG (#1=#:G1409) (RETURN - (PROG (#1=#:G1409) - (RETURN - (COND - ((LETT #1# - (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) - (HGET |$ConstructorCache| '|Vector|) - '|domainEqualList|) - |Vector|) - (|CDRwithIncrement| #1#)) - ('T - (UNWIND-PROTECT - (PROG1 (|Vector;| #0#) (LETT #1# T |Vector|)) - (COND ((NOT #1#) (HREM |$ConstructorCache| '|Vector|))))))))))) + (COND + ((LETT #1# + (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) + (HGET |$ConstructorCache| '|Vector|) + '|domainEqualList|) + |Vector|) + (|CDRwithIncrement| #1#)) + ('T + (UNWIND-PROTECT + (PROG1 (|Vector;| #0#) (LETT #1# T |Vector|)) + (COND ((NOT #1#) (HREM |$ConstructorCache| '|Vector|))))))))) (DEFUN |Vector;| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$| (LIST '|Vector| |dv$1|)) -- cgit v1.2.3