aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog5
-rw-r--r--src/algebra/strap/BOOLEAN.lsp24
-rw-r--r--src/algebra/strap/CHAR.lsp25
-rw-r--r--src/algebra/strap/DFLOAT.lsp29
-rw-r--r--src/algebra/strap/HOAGG-.lsp31
-rw-r--r--src/algebra/strap/ILIST.lsp30
-rw-r--r--src/algebra/strap/INT.lsp24
-rw-r--r--src/algebra/strap/ISTRING.lsp30
-rw-r--r--src/algebra/strap/LIST.lsp56
-rw-r--r--src/algebra/strap/LNAGG-.lsp18
-rw-r--r--src/algebra/strap/NNI.lsp33
-rw-r--r--src/algebra/strap/OUTFORM.lsp27
-rw-r--r--src/algebra/strap/PI.lsp31
-rw-r--r--src/algebra/strap/POLYCAT-.lsp102
-rw-r--r--src/algebra/strap/SINT.lsp30
-rw-r--r--src/algebra/strap/STAGG-.lsp34
-rw-r--r--src/algebra/strap/SYMBOL.lsp23
-rw-r--r--src/algebra/strap/VECTOR.lsp26
-rw-r--r--src/interp/c-util.boot12
19 files changed, 271 insertions, 319 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index dfcd6218..df9e3960 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,8 @@
+2010-06-06 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/c-util.boot (needPROGS?): New.
+ (transformToBackendCode): Use it. Don't add unneeded PROG/RETURN.
+
2010-06-05 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/compiler.boot (compRepeatOrCollect): Compile list
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|))
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 6090497d..2798bf98 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1587,6 +1587,16 @@ simplifySEQ form ==
stmts.first := simplifySEQ first stmts
form
+++ Return true if the Lisp `form' has a `RETURN' form
+++ that needs to be enclosed in a `PROG' form.
+needsPROG? form ==
+ isAtomicForm form => false
+ op := form.op
+ op = 'RETURN => true
+ op in '(LOOP PROG) => false
+ form is ['BLOCK,=nil,:.] => false
+ or/[needsPROG? x for x in form]
+
++ Generate Lisp code by lowering middle end defining form `x'.
++ x has the strucrure: <name, parms, stmt1, ...>
transformToBackendCode: %Form -> %Code
@@ -1612,7 +1622,7 @@ transformToBackendCode x ==
body :=
fluids ~= nil =>
[["PROG",lvars,declareGlobalVariables fluids, ["RETURN",:body]]]
- lvars ~= nil or CONTAINED("RETURN",body) =>
+ lvars ~= nil or needsPROG? body =>
[["PROG",lvars,["RETURN",:body]]]
body
-- add reference parameters to the list of special variables.
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-03 15:07:54 +0000