aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xconfigure18
-rw-r--r--configure.ac2
-rw-r--r--configure.ac.pamphlet2
-rw-r--r--src/ChangeLog5
-rw-r--r--src/algebra/strap/ABELGRP.lsp4
-rw-r--r--src/algebra/strap/ABELMON.lsp2
-rw-r--r--src/algebra/strap/ABELSG.lsp2
-rw-r--r--src/algebra/strap/ALAGG.lsp8
-rw-r--r--src/algebra/strap/BOOLEAN.lsp2
-rw-r--r--src/algebra/strap/CABMON.lsp2
-rw-r--r--src/algebra/strap/CHAR.lsp6
-rw-r--r--src/algebra/strap/CLAGG-.lsp6
-rw-r--r--src/algebra/strap/CLAGG.lsp6
-rw-r--r--src/algebra/strap/COMRING.lsp2
-rw-r--r--src/algebra/strap/DFLOAT.lsp16
-rw-r--r--src/algebra/strap/DIFRING.lsp2
-rw-r--r--src/algebra/strap/DIVRING.lsp4
-rw-r--r--src/algebra/strap/ENTIRER.lsp2
-rw-r--r--src/algebra/strap/EUCDOM-.lsp10
-rw-r--r--src/algebra/strap/EUCDOM.lsp2
-rw-r--r--src/algebra/strap/FFIELDC-.lsp12
-rw-r--r--src/algebra/strap/FFIELDC.lsp2
-rw-r--r--src/algebra/strap/FPS-.lsp2
-rw-r--r--src/algebra/strap/FPS.lsp2
-rw-r--r--src/algebra/strap/GCDDOM-.lsp2
-rw-r--r--src/algebra/strap/GCDDOM.lsp2
-rw-r--r--src/algebra/strap/HOAGG-.lsp12
-rw-r--r--src/algebra/strap/HOAGG.lsp6
-rw-r--r--src/algebra/strap/ILIST.lsp12
-rw-r--r--src/algebra/strap/INS-.lsp4
-rw-r--r--src/algebra/strap/INS.lsp6
-rw-r--r--src/algebra/strap/INT.lsp4
-rw-r--r--src/algebra/strap/INTDOM.lsp2
-rw-r--r--src/algebra/strap/ISTRING.lsp24
-rw-r--r--src/algebra/strap/LIST.lsp6
-rw-r--r--src/algebra/strap/LNAGG-.lsp2
-rw-r--r--src/algebra/strap/LNAGG.lsp8
-rw-r--r--src/algebra/strap/LSAGG-.lsp18
-rw-r--r--src/algebra/strap/LSAGG.lsp6
-rw-r--r--src/algebra/strap/MONOID.lsp2
-rw-r--r--src/algebra/strap/MTSCAT.lsp8
-rw-r--r--src/algebra/strap/NNI.lsp2
-rw-r--r--src/algebra/strap/OINTDOM.lsp2
-rw-r--r--src/algebra/strap/ORDRING.lsp2
-rw-r--r--src/algebra/strap/OUTFORM.lsp8
-rw-r--r--src/algebra/strap/PI.lsp2
-rw-r--r--src/algebra/strap/POLYCAT-.lsp54
-rw-r--r--src/algebra/strap/POLYCAT.lsp6
-rw-r--r--src/algebra/strap/QFCAT.lsp6
-rw-r--r--src/algebra/strap/RCAGG.lsp6
-rw-r--r--src/algebra/strap/RING.lsp4
-rw-r--r--src/algebra/strap/RNG.lsp2
-rw-r--r--src/algebra/strap/RNS.lsp6
-rw-r--r--src/algebra/strap/SETAGG.lsp6
-rw-r--r--src/algebra/strap/SINT.lsp4
-rw-r--r--src/algebra/strap/STAGG-.lsp6
-rw-r--r--src/algebra/strap/STAGG.lsp6
-rw-r--r--src/algebra/strap/SYMBOL.lsp14
-rw-r--r--src/algebra/strap/UFD-.lsp2
-rw-r--r--src/algebra/strap/UFD.lsp2
-rw-r--r--src/algebra/strap/URAGG-.lsp10
-rw-r--r--src/algebra/strap/URAGG.lsp6
-rw-r--r--src/algebra/strap/VECTOR.lsp4
-rw-r--r--src/boot/ast.boot22
-rw-r--r--src/boot/strap/ast.clisp720
-rw-r--r--src/boot/strap/translator.clisp181
66 files changed, 666 insertions, 662 deletions
diff --git a/configure b/configure
index 33637a03..818c96bb 100755
--- a/configure
+++ b/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.63 for OpenAxiom 1.4.0-2009-08-27.
+# Generated by GNU Autoconf 2.63 for OpenAxiom 1.4.0-2009-08-28.
#
# Report bugs to <open-axiom-bugs@lists.sf.net>.
#
@@ -745,8 +745,8 @@ SHELL=${CONFIG_SHELL-/bin/sh}
# Identity of this package.
PACKAGE_NAME='OpenAxiom'
PACKAGE_TARNAME='openaxiom'
-PACKAGE_VERSION='1.4.0-2009-08-27'
-PACKAGE_STRING='OpenAxiom 1.4.0-2009-08-27'
+PACKAGE_VERSION='1.4.0-2009-08-28'
+PACKAGE_STRING='OpenAxiom 1.4.0-2009-08-28'
PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net'
ac_unique_file="src/Makefile.pamphlet"
@@ -1501,7 +1501,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures OpenAxiom 1.4.0-2009-08-27 to adapt to many kinds of systems.
+\`configure' configures OpenAxiom 1.4.0-2009-08-28 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1571,7 +1571,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2009-08-27:";;
+ short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2009-08-28:";;
esac
cat <<\_ACEOF
@@ -1674,7 +1674,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OpenAxiom configure 1.4.0-2009-08-27
+OpenAxiom configure 1.4.0-2009-08-28
generated by GNU Autoconf 2.63
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
@@ -1688,7 +1688,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by OpenAxiom $as_me 1.4.0-2009-08-27, which was
+It was created by OpenAxiom $as_me 1.4.0-2009-08-28, which was
generated by GNU Autoconf 2.63. Invocation command line was
$ $0 $@
@@ -17677,7 +17677,7 @@ exec 6>&1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by OpenAxiom $as_me 1.4.0-2009-08-27, which was
+This file was extended by OpenAxiom $as_me 1.4.0-2009-08-28, which was
generated by GNU Autoconf 2.63. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -17740,7 +17740,7 @@ Report bugs to <bug-autoconf@gnu.org>."
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_version="\\
-OpenAxiom config.status 1.4.0-2009-08-27
+OpenAxiom config.status 1.4.0-2009-08-28
configured by $0, generated by GNU Autoconf 2.63,
with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"
diff --git a/configure.ac b/configure.ac
index 44a5be91..e2e95ea3 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,6 +1,6 @@
sinclude(config/open-axiom.m4)
sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.4.0-2009-08-27],
+AC_INIT([OpenAxiom], [1.4.0-2009-08-28],
[open-axiom-bugs@lists.sf.net])
AC_CONFIG_AUX_DIR(config)
diff --git a/configure.ac.pamphlet b/configure.ac.pamphlet
index 812bf371..9b1ed6fb 100644
--- a/configure.ac.pamphlet
+++ b/configure.ac.pamphlet
@@ -1154,7 +1154,7 @@ information:
<<Autoconf init>>=
sinclude(config/open-axiom.m4)
sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.4.0-2009-08-27],
+AC_INIT([OpenAxiom], [1.4.0-2009-08-28],
[open-axiom-bugs@lists.sf.net])
@
diff --git a/src/ChangeLog b/src/ChangeLog
index 0c20ceca..fc878a1c 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,8 @@
+2009-08-28 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * boot/ast.boot (bfCase): Don't introduce temporary for scrutinee
+ when it is already reduced.
+
2009-08-27 Gabriel Dos Reis <gdr@cs.tamu.edu>
* boot/tokens.boot: "namespace" is now a keyword.
diff --git a/src/algebra/strap/ABELGRP.lsp b/src/algebra/strap/ABELGRP.lsp
index cd7922b8..76b577bb 100644
--- a/src/algebra/strap/ABELGRP.lsp
+++ b/src/algebra/strap/ABELGRP.lsp
@@ -4,10 +4,10 @@
(DEFPARAMETER |AbelianGroup;AL| 'NIL)
(DEFUN |AbelianGroup;| ()
- (PROG (#0=#:G1400)
+ (PROG (#0=#:G1398)
(RETURN
(PROG1 (LETT #0#
- (|sublisV| (PAIR '(#1=#:G1399) (LIST '(|Integer|)))
+ (|sublisV| (PAIR '(#1=#:G1397) (LIST '(|Integer|)))
(|Join| (|CancellationAbelianMonoid|)
(|LeftLinearSet| '#1#)
(|mkCategory| '|domain|
diff --git a/src/algebra/strap/ABELMON.lsp b/src/algebra/strap/ABELMON.lsp
index 85ac824d..8c7d5627 100644
--- a/src/algebra/strap/ABELMON.lsp
+++ b/src/algebra/strap/ABELMON.lsp
@@ -4,7 +4,7 @@
(DEFPARAMETER |AbelianMonoid;AL| 'NIL)
(DEFUN |AbelianMonoid;| ()
- (PROG (#0=#:G1399)
+ (PROG (#0=#:G1397)
(RETURN
(PROG1 (LETT #0#
(|Join| (|AbelianSemiGroup|)
diff --git a/src/algebra/strap/ABELSG.lsp b/src/algebra/strap/ABELSG.lsp
index fa84d4fa..cd0db00c 100644
--- a/src/algebra/strap/ABELSG.lsp
+++ b/src/algebra/strap/ABELSG.lsp
@@ -4,7 +4,7 @@
(DEFPARAMETER |AbelianSemiGroup;AL| 'NIL)
(DEFUN |AbelianSemiGroup;| ()
- (PROG (#0=#:G1398)
+ (PROG (#0=#:G1396)
(RETURN
(PROG1 (LETT #0#
(|Join| (|SetCategory|)
diff --git a/src/algebra/strap/ALAGG.lsp b/src/algebra/strap/ALAGG.lsp
index 59eceb44..79a6854d 100644
--- a/src/algebra/strap/ALAGG.lsp
+++ b/src/algebra/strap/ALAGG.lsp
@@ -6,7 +6,7 @@
(DEFPARAMETER |AssociationListAggregate;AL| 'NIL)
(DEFUN |AssociationListAggregate;| (|t#1| |t#2|)
- (PROG (#0=#:G1400)
+ (PROG (#0=#:G1398)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -14,7 +14,7 @@
(LIST (|devaluate| |t#1|)
(|devaluate| |t#2|)))
(|sublisV|
- (PAIR '(#1=#:G1399)
+ (PAIR '(#1=#:G1397)
(LIST '(|Record| (|:| |key| |t#1|)
(|:| |entry| |t#2|))))
(COND
@@ -38,9 +38,9 @@
(LIST '|AssociationListAggregate| (|devaluate| |t#1|)
(|devaluate| |t#2|)))))))
-(DEFUN |AssociationListAggregate| (&REST #0=#:G1403 &AUX #1=#:G1401)
+(DEFUN |AssociationListAggregate| (&REST #0=#:G1401 &AUX #1=#:G1399)
(DSETQ #1# #0#)
- (LET (#2=#:G1402)
+ (LET (#2=#:G1400)
(COND
((SETQ #2#
(|assoc| (|devaluateList| #1#)
diff --git a/src/algebra/strap/BOOLEAN.lsp b/src/algebra/strap/BOOLEAN.lsp
index 61b9fc33..5075ccfd 100644
--- a/src/algebra/strap/BOOLEAN.lsp
+++ b/src/algebra/strap/BOOLEAN.lsp
@@ -151,7 +151,7 @@
(DEFUN |Boolean| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1425)
+ (PROG (#0=#:G1423)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|Boolean|) |Boolean|)
diff --git a/src/algebra/strap/CABMON.lsp b/src/algebra/strap/CABMON.lsp
index 60c3073e..7f0c5d45 100644
--- a/src/algebra/strap/CABMON.lsp
+++ b/src/algebra/strap/CABMON.lsp
@@ -4,7 +4,7 @@
(DEFPARAMETER |CancellationAbelianMonoid;AL| 'NIL)
(DEFUN |CancellationAbelianMonoid;| ()
- (PROG (#0=#:G1398)
+ (PROG (#0=#:G1396)
(RETURN
(PROG1 (LETT #0#
(|Join| (|AbelianMonoid|)
diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp
index 63b98540..e1d85545 100644
--- a/src/algebra/strap/CHAR.lsp
+++ b/src/algebra/strap/CHAR.lsp
@@ -123,14 +123,14 @@
(DEFUN |CHAR;size;Nni;6| ($) (DECLARE (IGNORE $)) 256)
(DEFUN |CHAR;index;Pi$;7| (|n| $)
- (PROG (#0=#:G1405)
+ (PROG (#0=#:G1403)
(RETURN
(CODE-CHAR
(PROG1 (LETT #0# (- |n| 1) |CHAR;index;Pi$;7|)
(|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))))))
(DEFUN |CHAR;lookup;$Pi;8| (|c| $)
- (PROG (#0=#:G1407)
+ (PROG (#0=#:G1405)
(RETURN
(PROG1 (LETT #0# (+ 1 (CHAR-CODE |c|)) |CHAR;lookup;$Pi;8|)
(|check-subtype| (> #0# 0) '(|PositiveInteger|) #0#)))))
@@ -192,7 +192,7 @@
(DEFUN |Character| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1428)
+ (PROG (#0=#:G1426)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|Character|)
diff --git a/src/algebra/strap/CLAGG-.lsp b/src/algebra/strap/CLAGG-.lsp
index 15cd3abb..a8375014 100644
--- a/src/algebra/strap/CLAGG-.lsp
+++ b/src/algebra/strap/CLAGG-.lsp
@@ -45,7 +45,7 @@
(LENGTH (SPADCALL |c| (|getShellEntry| $ 9))))
(DEFUN |CLAGG-;count;MANni;2| (|f| |c| $)
- (PROG (|x| #0=#:G1430 #1=#:G1404 #2=#:G1402 #3=#:G1403)
+ (PROG (|x| #0=#:G1428 #1=#:G1402 #2=#:G1400 #3=#:G1401)
(RETURN
(SEQ (PROGN
(LETT #3# NIL |CLAGG-;count;MANni;2|)
@@ -75,7 +75,7 @@
(COND (#3# #2#) ('T 0)))))))
(DEFUN |CLAGG-;any?;MAB;3| (|f| |c| $)
- (PROG (|x| #0=#:G1431 #1=#:G1409 #2=#:G1407 #3=#:G1408)
+ (PROG (|x| #0=#:G1429 #1=#:G1407 #2=#:G1405 #3=#:G1406)
(RETURN
(SEQ (PROGN
(LETT #3# NIL |CLAGG-;any?;MAB;3|)
@@ -103,7 +103,7 @@
(COND (#3# #2#) ('T NIL)))))))
(DEFUN |CLAGG-;every?;MAB;4| (|f| |c| $)
- (PROG (|x| #0=#:G1432 #1=#:G1413 #2=#:G1411 #3=#:G1412)
+ (PROG (|x| #0=#:G1430 #1=#:G1411 #2=#:G1409 #3=#:G1410)
(RETURN
(SEQ (PROGN
(LETT #3# NIL |CLAGG-;every?;MAB;4|)
diff --git a/src/algebra/strap/CLAGG.lsp b/src/algebra/strap/CLAGG.lsp
index 0e38f978..ce380a1a 100644
--- a/src/algebra/strap/CLAGG.lsp
+++ b/src/algebra/strap/CLAGG.lsp
@@ -6,7 +6,7 @@
(DEFPARAMETER |Collection;AL| 'NIL)
(DEFUN |Collection;| (|t#1|)
- (PROG (#0=#:G1398)
+ (PROG (#0=#:G1396)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -93,8 +93,8 @@
(|setShellEntry| #0# 0
(LIST '|Collection| (|devaluate| |t#1|)))))))
-(DEFUN |Collection| (#0=#:G1399)
- (LET (#1=#:G1400)
+(DEFUN |Collection| (#0=#:G1397)
+ (LET (#1=#:G1398)
(COND
((SETQ #1# (|assoc| (|devaluate| #0#) |Collection;AL|))
(CDR #1#))
diff --git a/src/algebra/strap/COMRING.lsp b/src/algebra/strap/COMRING.lsp
index 765ee131..9857fe0f 100644
--- a/src/algebra/strap/COMRING.lsp
+++ b/src/algebra/strap/COMRING.lsp
@@ -4,7 +4,7 @@
(DEFPARAMETER |CommutativeRing;AL| 'NIL)
(DEFUN |CommutativeRing;| ()
- (PROG (#0=#:G1398)
+ (PROG (#0=#:G1396)
(RETURN
(PROG1 (LETT #0#
(|Join| (|Ring|) (|BiModule| '$ '$)
diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp
index 57155b44..5af80d38 100644
--- a/src/algebra/strap/DFLOAT.lsp
+++ b/src/algebra/strap/DFLOAT.lsp
@@ -452,7 +452,7 @@
(FLOAT-DIGITS 0.0))
(DEFUN |DFLOAT;bits;Pi;10| ($)
- (PROG (#0=#:G1425)
+ (PROG (#0=#:G1423)
(RETURN
(COND
((EQL (FLOAT-RADIX 0.0) 2) (FLOAT-DIGITS 0.0))
@@ -659,7 +659,7 @@
(EXIT |theta|))))))))
(DEFUN |DFLOAT;retract;$F;80| (|x| $)
- (PROG (#0=#:G1504)
+ (PROG (#0=#:G1502)
(RETURN
(|DFLOAT;rationalApproximation;$2NniF;87| |x|
(PROG1 (LETT #0# (- (FLOAT-DIGITS 0.0) 1)
@@ -668,7 +668,7 @@
(FLOAT-RADIX 0.0) $))))
(DEFUN |DFLOAT;retractIfCan;$U;81| (|x| $)
- (PROG (#0=#:G1509)
+ (PROG (#0=#:G1507)
(RETURN
(CONS 0
(|DFLOAT;rationalApproximation;$2NniF;87| |x|
@@ -703,7 +703,7 @@
(FLOAT-SIGN 1.0 |x|))
(DEFUN |DFLOAT;manexp| (|x| $)
- (PROG (|s| #0=#:G1530 |me| |two53|)
+ (PROG (|s| #0=#:G1528 |me| |two53|)
(RETURN
(SEQ (EXIT (COND
((ZEROP |x|) (CONS 0 0))
@@ -737,8 +737,8 @@
#0# (EXIT #0#)))))
(DEFUN |DFLOAT;rationalApproximation;$2NniF;87| (|f| |d| |b| $)
- (PROG (|#G109| |nu| |ex| BASE #0=#:G1533 |de| |tol| |#G110| |q| |r|
- |p2| |q2| #1=#:G1542 |#G111| |#G112| |p0| |p1| |#G113|
+ (PROG (|#G109| |nu| |ex| BASE #0=#:G1531 |de| |tol| |#G110| |q| |r|
+ |p2| |q2| #1=#:G1540 |#G111| |#G112| |p0| |p1| |#G113|
|#G114| |q0| |q1| |#G115| |#G116| |s| |t|)
(RETURN
(SEQ (EXIT (SEQ (PROGN
@@ -858,7 +858,7 @@
#1# (EXIT #1#)))))
(DEFUN |DFLOAT;**;$F$;88| (|x| |r| $)
- (PROG (|n| |d| #0=#:G1552)
+ (PROG (|n| |d| #0=#:G1550)
(RETURN
(SEQ (EXIT (COND
((ZEROP |x|)
@@ -920,7 +920,7 @@
(DEFUN |DoubleFloat| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1564)
+ (PROG (#0=#:G1562)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|DoubleFloat|)
diff --git a/src/algebra/strap/DIFRING.lsp b/src/algebra/strap/DIFRING.lsp
index 83564864..d3d403d7 100644
--- a/src/algebra/strap/DIFRING.lsp
+++ b/src/algebra/strap/DIFRING.lsp
@@ -4,7 +4,7 @@
(DEFPARAMETER |DifferentialRing;AL| 'NIL)
(DEFUN |DifferentialRing;| ()
- (PROG (#0=#:G1398)
+ (PROG (#0=#:G1396)
(RETURN
(PROG1 (LETT #0#
(|Join| (|Ring|)
diff --git a/src/algebra/strap/DIVRING.lsp b/src/algebra/strap/DIVRING.lsp
index 804f4abb..40a7f53a 100644
--- a/src/algebra/strap/DIVRING.lsp
+++ b/src/algebra/strap/DIVRING.lsp
@@ -4,11 +4,11 @@
(DEFPARAMETER |DivisionRing;AL| 'NIL)
(DEFUN |DivisionRing;| ()
- (PROG (#0=#:G1401)
+ (PROG (#0=#:G1399)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
- (PAIR '(#1=#:G1400)
+ (PAIR '(#1=#:G1398)
(LIST '(|Fraction| (|Integer|))))
(|Join| (|EntireRing|) (|Algebra| '#1#)
(|mkCategory| '|domain|
diff --git a/src/algebra/strap/ENTIRER.lsp b/src/algebra/strap/ENTIRER.lsp
index 76e417cd..bb905363 100644
--- a/src/algebra/strap/ENTIRER.lsp
+++ b/src/algebra/strap/ENTIRER.lsp
@@ -4,7 +4,7 @@
(DEFPARAMETER |EntireRing;AL| 'NIL)
(DEFUN |EntireRing;| ()
- (PROG (#0=#:G1398)
+ (PROG (#0=#:G1396)
(RETURN
(PROG1 (LETT #0#
(|Join| (|Ring|) (|BiModule| '$ '$)
diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp
index 349e80b8..b8aa478a 100644
--- a/src/algebra/strap/EUCDOM-.lsp
+++ b/src/algebra/strap/EUCDOM-.lsp
@@ -230,7 +230,7 @@
(|getShellEntry| $ 33))))))))))))))))
(DEFUN |EUCDOM-;principalIdeal;LR;9| (|l| $)
- (PROG (|uca| |v| |u| #0=#:G1519 |vv| #1=#:G1520)
+ (PROG (|uca| |v| |u| #0=#:G1517 |vv| #1=#:G1518)
(RETURN
(SEQ (COND
((SPADCALL |l| NIL (|getShellEntry| $ 42))
@@ -287,7 +287,7 @@
(QVELT |u| 2))))))))))
(DEFUN |EUCDOM-;expressIdealMember;LSU;10| (|l| |z| $)
- (PROG (#0=#:G1521 #1=#:G1522 |pid| |q| #2=#:G1523 |v| #3=#:G1524)
+ (PROG (#0=#:G1519 #1=#:G1520 |pid| |q| #2=#:G1521 |v| #3=#:G1522)
(RETURN
(SEQ (COND
((SPADCALL |z| (|spadConstant| $ 19)
@@ -352,9 +352,9 @@
(EXIT (NREVERSE0 #2#)))))))))))))))
(DEFUN |EUCDOM-;multiEuclidean;LSU;11| (|l| |z| $)
- (PROG (|n| |l1| |l2| #0=#:G1398 #1=#:G1525 #2=#:G1506 #3=#:G1504
- #4=#:G1505 #5=#:G1399 #6=#:G1526 #7=#:G1509 #8=#:G1507
- #9=#:G1508 |u| |v1| |v2|)
+ (PROG (|n| |l1| |l2| #0=#:G1396 #1=#:G1523 #2=#:G1504 #3=#:G1502
+ #4=#:G1503 #5=#:G1397 #6=#:G1524 #7=#:G1507 #8=#:G1505
+ #9=#:G1506 |u| |v1| |v2|)
(RETURN
(SEQ (LETT |n| (LENGTH |l|) |EUCDOM-;multiEuclidean;LSU;11|)
(EXIT (COND
diff --git a/src/algebra/strap/EUCDOM.lsp b/src/algebra/strap/EUCDOM.lsp
index f9666922..b4b66503 100644
--- a/src/algebra/strap/EUCDOM.lsp
+++ b/src/algebra/strap/EUCDOM.lsp
@@ -4,7 +4,7 @@
(DEFPARAMETER |EuclideanDomain;AL| 'NIL)
(DEFUN |EuclideanDomain;| ()
- (PROG (#0=#:G1415)
+ (PROG (#0=#:G1413)
(RETURN
(PROG1 (LETT #0#
(|Join| (|PrincipalIdealDomain|)
diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp
index 33406123..73b5852e 100644
--- a/src/algebra/strap/FFIELDC-.lsp
+++ b/src/algebra/strap/FFIELDC-.lsp
@@ -125,7 +125,7 @@
(EXIT |e|)))))
(DEFUN |FFIELDC-;primitive?;SB;9| (|a| $)
- (PROG (|explist| |q| |exp| #0=#:G1514 |equalone|)
+ (PROG (|explist| |q| |exp| #0=#:G1512 |equalone|)
(RETURN
(SEQ (COND
((SPADCALL |a| (|getShellEntry| $ 16)) NIL)
@@ -158,7 +158,7 @@
(EXIT (NOT |equalone|)))))))))
(DEFUN |FFIELDC-;order;SPi;10| (|e| $)
- (PROG (|lof| |rec| #0=#:G1515 |primeDivisor| |j| #1=#:G1516 |a|
+ (PROG (|lof| |rec| #0=#:G1513 |primeDivisor| |j| #1=#:G1514 |a|
|goon| |ord|)
(RETURN
(SEQ (COND
@@ -223,7 +223,7 @@
(EXIT |ord|))))))))
(DEFUN |FFIELDC-;discreteLog;SNni;11| (|b| $)
- (PROG (|faclist| |gen| |groupord| |f| #0=#:G1517 |fac| |t| #1=#:G1518
+ (PROG (|faclist| |gen| |groupord| |f| #0=#:G1515 |fac| |t| #1=#:G1516
|exp| |exptable| |n| |end| |i| |rho| |found| |disc1| |c|
|mult| |disclog| |a|)
(RETURN
@@ -378,8 +378,8 @@
(EXIT |disclog|))))))))))))
(DEFUN |FFIELDC-;discreteLog;2SU;12| (|logbase| |b| $)
- (PROG (|groupord| |faclist| |f| #0=#:G1519 |fac| |primroot| |t|
- #1=#:G1520 |exp| |rhoHelp| #2=#:G1500 |rho| |disclog|
+ (PROG (|groupord| |faclist| |f| #0=#:G1517 |fac| |primroot| |t|
+ #1=#:G1518 |exp| |rhoHelp| #2=#:G1498 |rho| |disclog|
|mult| |a|)
(RETURN
(SEQ (EXIT (COND
@@ -507,7 +507,7 @@
(SPADCALL |f| (|getShellEntry| $ 100)))
(DEFUN |FFIELDC-;factorSquareFreePolynomial| (|f| $)
- (PROG (|flist| |u| #0=#:G1521 #1=#:G1510 #2=#:G1508 #3=#:G1509)
+ (PROG (|flist| |u| #0=#:G1519 #1=#:G1508 #2=#:G1506 #3=#:G1507)
(RETURN
(SEQ (COND
((SPADCALL |f| (|spadConstant| $ 101)
diff --git a/src/algebra/strap/FFIELDC.lsp b/src/algebra/strap/FFIELDC.lsp
index df1d9b1c..3a31837f 100644
--- a/src/algebra/strap/FFIELDC.lsp
+++ b/src/algebra/strap/FFIELDC.lsp
@@ -4,7 +4,7 @@
(DEFPARAMETER |FiniteFieldCategory;AL| 'NIL)
(DEFUN |FiniteFieldCategory;| ()
- (PROG (#0=#:G1406)
+ (PROG (#0=#:G1404)
(RETURN
(PROG1 (LETT #0#
(|Join| (|FieldOfPrimeCharacteristic|) (|Finite|)
diff --git a/src/algebra/strap/FPS-.lsp b/src/algebra/strap/FPS-.lsp
index 9cf0ec3d..772c59fc 100644
--- a/src/algebra/strap/FPS-.lsp
+++ b/src/algebra/strap/FPS-.lsp
@@ -12,7 +12,7 @@
(|getShellEntry| $ 10)))
(DEFUN |FPS-;digits;Pi;2| ($)
- (PROG (#0=#:G1402)
+ (PROG (#0=#:G1400)
(RETURN
(PROG1 (LETT #0#
(MAX 1
diff --git a/src/algebra/strap/FPS.lsp b/src/algebra/strap/FPS.lsp
index f6d25aef..36d099b4 100644
--- a/src/algebra/strap/FPS.lsp
+++ b/src/algebra/strap/FPS.lsp
@@ -4,7 +4,7 @@
(DEFPARAMETER |FloatingPointSystem;AL| 'NIL)
(DEFUN |FloatingPointSystem;| ()
- (PROG (#0=#:G1398)
+ (PROG (#0=#:G1396)
(RETURN
(PROG1 (LETT #0#
(|Join| (|RealNumberSystem|)
diff --git a/src/algebra/strap/GCDDOM-.lsp b/src/algebra/strap/GCDDOM-.lsp
index 678f4829..19d50170 100644
--- a/src/algebra/strap/GCDDOM-.lsp
+++ b/src/algebra/strap/GCDDOM-.lsp
@@ -43,7 +43,7 @@
(|getShellEntry| $ 19)))
(DEFUN |GCDDOM-;gcdPolynomial;3Sup;4| (|p1| |p2| $)
- (PROG (|e2| |e1| |c1| |p| |c2| #0=#:G1419)
+ (PROG (|e2| |e1| |c1| |p| |c2| #0=#:G1417)
(RETURN
(SEQ (COND
((SPADCALL |p1| (|getShellEntry| $ 24))
diff --git a/src/algebra/strap/GCDDOM.lsp b/src/algebra/strap/GCDDOM.lsp
index cfddb57a..f3866954 100644
--- a/src/algebra/strap/GCDDOM.lsp
+++ b/src/algebra/strap/GCDDOM.lsp
@@ -4,7 +4,7 @@
(DEFPARAMETER |GcdDomain;AL| 'NIL)
(DEFUN |GcdDomain;| ()
- (PROG (#0=#:G1404)
+ (PROG (#0=#:G1402)
(RETURN
(PROG1 (LETT #0#
(|Join| (|IntegralDomain|)
diff --git a/src/algebra/strap/HOAGG-.lsp b/src/algebra/strap/HOAGG-.lsp
index 876ac7a3..f5a748ef 100644
--- a/src/algebra/strap/HOAGG-.lsp
+++ b/src/algebra/strap/HOAGG-.lsp
@@ -45,7 +45,7 @@
(LENGTH (SPADCALL |c| (|getShellEntry| $ 15))))
(DEFUN |HOAGG-;any?;MAB;3| (|f| |c| $)
- (PROG (|x| #0=#:G1429 #1=#:G1407 #2=#:G1405 #3=#:G1406)
+ (PROG (|x| #0=#:G1427 #1=#:G1405 #2=#:G1403 #3=#:G1404)
(RETURN
(SEQ (PROGN
(LETT #3# NIL |HOAGG-;any?;MAB;3|)
@@ -73,7 +73,7 @@
(COND (#3# #2#) ('T NIL)))))))
(DEFUN |HOAGG-;every?;MAB;4| (|f| |c| $)
- (PROG (|x| #0=#:G1430 #1=#:G1412 #2=#:G1410 #3=#:G1411)
+ (PROG (|x| #0=#:G1428 #1=#:G1410 #2=#:G1408 #3=#:G1409)
(RETURN
(SEQ (PROGN
(LETT #3# NIL |HOAGG-;every?;MAB;4|)
@@ -101,7 +101,7 @@
(COND (#3# #2#) ('T T)))))))
(DEFUN |HOAGG-;count;MANni;5| (|f| |c| $)
- (PROG (|x| #0=#:G1431 #1=#:G1416 #2=#:G1414 #3=#:G1415)
+ (PROG (|x| #0=#:G1429 #1=#:G1414 #2=#:G1412 #3=#:G1413)
(RETURN
(SEQ (PROGN
(LETT #3# NIL |HOAGG-;count;MANni;5|)
@@ -150,8 +150,8 @@
(|getShellEntry| (|getShellEntry| $$ 0) 30)))
(DEFUN |HOAGG-;=;2AB;9| (|x| |y| $)
- (PROG (|b| #0=#:G1433 |a| #1=#:G1432 #2=#:G1423 #3=#:G1421
- #4=#:G1422)
+ (PROG (|b| #0=#:G1431 |a| #1=#:G1430 #2=#:G1421 #3=#:G1419
+ #4=#:G1420)
(RETURN
(SEQ (COND
((SPADCALL |x| (SPADCALL |y| (|getShellEntry| $ 35))
@@ -195,7 +195,7 @@
('T NIL))))))
(DEFUN |HOAGG-;coerce;AOf;10| (|x| $)
- (PROG (#0=#:G1434 |a| #1=#:G1435)
+ (PROG (#0=#:G1432 |a| #1=#:G1433)
(RETURN
(SEQ (SPADCALL
(SPADCALL
diff --git a/src/algebra/strap/HOAGG.lsp b/src/algebra/strap/HOAGG.lsp
index ca81df7e..97d2ffb6 100644
--- a/src/algebra/strap/HOAGG.lsp
+++ b/src/algebra/strap/HOAGG.lsp
@@ -6,7 +6,7 @@
(DEFPARAMETER |HomogeneousAggregate;AL| 'NIL)
(DEFUN |HomogeneousAggregate;| (|t#1|)
- (PROG (#0=#:G1399)
+ (PROG (#0=#:G1397)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -100,8 +100,8 @@
(|setShellEntry| #0# 0
(LIST '|HomogeneousAggregate| (|devaluate| |t#1|)))))))
-(DEFUN |HomogeneousAggregate| (#0=#:G1400)
- (LET (#1=#:G1401)
+(DEFUN |HomogeneousAggregate| (#0=#:G1398)
+ (LET (#1=#:G1399)
(COND
((SETQ #1# (|assoc| (|devaluate| #0#) |HomogeneousAggregate;AL|))
(CDR #1#))
diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp
index 1d888979..397baaa5 100644
--- a/src/algebra/strap/ILIST.lsp
+++ b/src/algebra/strap/ILIST.lsp
@@ -258,7 +258,7 @@
(|getShellEntry| $ 49)))))))))))
(DEFUN |ILIST;=;2$B;22| (|x| |y| $)
- (PROG (#0=#:G1470)
+ (PROG (#0=#:G1468)
(RETURN
(SEQ (EXIT (COND
((EQ |x| |y|) T)
@@ -307,7 +307,7 @@
(EXIT (STRCONC |s| " \\right]"))))))
(DEFUN |ILIST;member?;S$B;24| (|s| |x| $)
- (PROG (#0=#:G1478)
+ (PROG (#0=#:G1476)
(RETURN
(SEQ (EXIT (SEQ (SEQ G190
(COND ((NULL (NOT (NULL |x|))) (GO G191)))
@@ -420,7 +420,7 @@
(EXIT |r|))))))))
(DEFUN |ILIST;split!;$I$;29| (|p| |n| $)
- (PROG (#0=#:G1507 |q|)
+ (PROG (#0=#:G1505 |q|)
(RETURN
(SEQ (COND
((< |n| 1) (|error| "index out of range"))
@@ -437,7 +437,7 @@
(QRPLACD |p| NIL) (EXIT |q|))))))))
(DEFUN |ILIST;mergeSort| (|f| |p| |n| $)
- (PROG (#0=#:G1511 |l| |q|)
+ (PROG (#0=#:G1509 |l| |q|)
(RETURN
(SEQ (COND
((EQL |n| 2)
@@ -464,11 +464,11 @@
|ILIST;mergeSort|)
(EXIT (|ILIST;merge!;M3$;28| |f| |p| |q| $))))))))))
-(DEFUN |IndexedList| (&REST #0=#:G1523 &AUX #1=#:G1521)
+(DEFUN |IndexedList| (&REST #0=#:G1521 &AUX #1=#:G1519)
(DSETQ #1# #0#)
(PROG ()
(RETURN
- (PROG (#2=#:G1522)
+ (PROG (#2=#:G1520)
(RETURN
(COND
((LETT #2#
diff --git a/src/algebra/strap/INS-.lsp b/src/algebra/strap/INS-.lsp
index 17951fda..d9e55191 100644
--- a/src/algebra/strap/INS-.lsp
+++ b/src/algebra/strap/INS-.lsp
@@ -120,7 +120,7 @@
(DEFUN |INS-;rational?;SB;8| (|x| $) (DECLARE (IGNORE $)) T)
(DEFUN |INS-;euclideanSize;SNni;9| (|x| $)
- (PROG (#0=#:G1426 #1=#:G1427)
+ (PROG (#0=#:G1424 #1=#:G1425)
(RETURN
(COND
((SPADCALL |x| (|spadConstant| $ 10) (|getShellEntry| $ 27))
@@ -279,7 +279,7 @@
('T |c1|)))))))
(DEFUN |INS-;powmod;4S;29| (|x| |n| |p| $)
- (PROG (|y| #0=#:G1484 |z|)
+ (PROG (|y| #0=#:G1482 |z|)
(RETURN
(SEQ (EXIT (SEQ (COND
((SPADCALL |x| (|getShellEntry| $ 85))
diff --git a/src/algebra/strap/INS.lsp b/src/algebra/strap/INS.lsp
index dd9be9b6..ef6261ca 100644
--- a/src/algebra/strap/INS.lsp
+++ b/src/algebra/strap/INS.lsp
@@ -4,12 +4,12 @@
(DEFPARAMETER |IntegerNumberSystem;AL| 'NIL)
(DEFUN |IntegerNumberSystem;| ()
- (PROG (#0=#:G1415)
+ (PROG (#0=#:G1413)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
- (PAIR '(#1=#:G1409 #2=#:G1410 #3=#:G1411
- #4=#:G1412 #5=#:G1413 #6=#:G1414)
+ (PAIR '(#1=#:G1407 #2=#:G1408 #3=#:G1409
+ #4=#:G1410 #5=#:G1411 #6=#:G1412)
(LIST '(|Integer|) '(|Integer|)
'(|Integer|) '(|InputForm|)
'(|Pattern| (|Integer|))
diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp
index bee3b83c..39bb22ff 100644
--- a/src/algebra/strap/INT.lsp
+++ b/src/algebra/strap/INT.lsp
@@ -472,7 +472,7 @@
(SPADCALL |p| (|getShellEntry| $ 107)))
(DEFUN |INT;factorPolynomial| (|p| $)
- (PROG (|pp| #0=#:G1500)
+ (PROG (|pp| #0=#:G1498)
(RETURN
(SEQ (LETT |pp| (SPADCALL |p| (|getShellEntry| $ 108))
|INT;factorPolynomial|)
@@ -515,7 +515,7 @@
(DEFUN |Integer| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1525)
+ (PROG (#0=#:G1523)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|Integer|) |Integer|)
diff --git a/src/algebra/strap/INTDOM.lsp b/src/algebra/strap/INTDOM.lsp
index 1b0a0fcd..383d7838 100644
--- a/src/algebra/strap/INTDOM.lsp
+++ b/src/algebra/strap/INTDOM.lsp
@@ -4,7 +4,7 @@
(DEFPARAMETER |IntegralDomain;AL| 'NIL)
(DEFUN |IntegralDomain;| ()
- (PROG (#0=#:G1404)
+ (PROG (#0=#:G1402)
(RETURN
(PROG1 (LETT #0#
(|Join| (|CommutativeRing|) (|Algebra| '$)
diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index 0e14d2ed..a3c23c36 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -181,8 +181,8 @@
(STRCONC "\\mbox{``" (STRCONC |s| "''}")))
(DEFUN |ISTRING;replace;$Us2$;15| (|s| |sg| |t| $)
- (PROG (|l| |m| |n| |h| #0=#:G1439 |r| #1=#:G1537 #2=#:G1538 |i|
- #3=#:G1539 |k|)
+ (PROG (|l| |m| |n| |h| #0=#:G1437 |r| #1=#:G1535 #2=#:G1536 |i|
+ #3=#:G1537 |k|)
(RETURN
(SEQ (LETT |l|
(- (SPADCALL |sg| (|getShellEntry| $ 44))
@@ -254,7 +254,7 @@
(EXIT |c|))))))
(DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $)
- (PROG (|np| |nw| |iw| |ip| #0=#:G1540 #1=#:G1453 #2=#:G1449)
+ (PROG (|np| |nw| |iw| |ip| #0=#:G1538 #1=#:G1451 #2=#:G1447)
(RETURN
(SEQ (EXIT (SEQ (LETT |np| (QCSIZE |part|)
|ISTRING;substring?;2$IB;17|)
@@ -323,7 +323,7 @@
('T (+ |r| (|getShellEntry| $ 6)))))))))))))
(DEFUN |ISTRING;position;C$2I;19| (|c| |t| |startpos| $)
- (PROG (|r| #0=#:G1541 #1=#:G1463)
+ (PROG (|r| #0=#:G1539 #1=#:G1461)
(RETURN
(SEQ (EXIT (SEQ (LETT |startpos|
(- |startpos| (|getShellEntry| $ 6))
@@ -359,7 +359,7 @@
#1# (EXIT #1#)))))
(DEFUN |ISTRING;position;Cc$2I;20| (|cc| |t| |startpos| $)
- (PROG (|r| #0=#:G1542 #1=#:G1469)
+ (PROG (|r| #0=#:G1540 #1=#:G1467)
(RETURN
(SEQ (EXIT (SEQ (LETT |startpos|
(- |startpos| (|getShellEntry| $ 6))
@@ -570,7 +570,7 @@
(SPADCALL |i| |n| (|getShellEntry| $ 24)) $))))))
(DEFUN |ISTRING;rightTrim;$C$;26| (|s| |c| $)
- (PROG (|j| #0=#:G1543)
+ (PROG (|j| #0=#:G1541)
(RETURN
(SEQ (SEQ (LETT |j| (SPADCALL |s| (|getShellEntry| $ 47))
|ISTRING;rightTrim;$C$;26|)
@@ -591,7 +591,7 @@
$))))))
(DEFUN |ISTRING;rightTrim;$Cc$;27| (|s| |cc| $)
- (PROG (|j| #0=#:G1544)
+ (PROG (|j| #0=#:G1542)
(RETURN
(SEQ (SEQ (LETT |j| (SPADCALL |s| (|getShellEntry| $ 47))
|ISTRING;rightTrim;$Cc$;27|)
@@ -612,7 +612,7 @@
$))))))
(DEFUN |ISTRING;concat;L$;28| (|l| $)
- (PROG (#0=#:G1545 #1=#:G1498 #2=#:G1496 #3=#:G1497 |t| |s| #4=#:G1546
+ (PROG (#0=#:G1543 #1=#:G1496 #2=#:G1494 #3=#:G1495 |t| |s| #4=#:G1544
|i|)
(RETURN
(SEQ (LETT |t|
@@ -734,8 +734,8 @@
(|stringMatch| |pattern| |target| (CHARACTER |wildcard|)))
(DEFUN |ISTRING;match?;2$CB;34| (|pattern| |target| |dontcare| $)
- (PROG (|n| |m| #0=#:G1517 #1=#:G1520 |s| #2=#:G1521 #3=#:G1530 |i|
- |p| #4=#:G1522 |q|)
+ (PROG (|n| |m| #0=#:G1515 #1=#:G1518 |s| #2=#:G1519 #3=#:G1528 |i|
+ |p| #4=#:G1520 |q|)
(RETURN
(SEQ (EXIT (SEQ (LETT |n|
(SPADCALL |pattern| (|getShellEntry| $ 47))
@@ -849,10 +849,10 @@
(EXIT T)))))))
#3# (EXIT #3#)))))
-(DEFUN |IndexedString| (#0=#:G1547)
+(DEFUN |IndexedString| (#0=#:G1545)
(PROG ()
(RETURN
- (PROG (#1=#:G1548)
+ (PROG (#1=#:G1546)
(RETURN
(COND
((LETT #1#
diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp
index 544d88fe..09c53e63 100644
--- a/src/algebra/strap/LIST.lsp
+++ b/src/algebra/strap/LIST.lsp
@@ -155,7 +155,7 @@
(EXIT |lu|)))))
(DEFUN |LIST;convert;$If;13| (|x| $)
- (PROG (#0=#:G1444 |a| #1=#:G1445)
+ (PROG (#0=#:G1442 |a| #1=#:G1443)
(RETURN
(SEQ (SPADCALL
(CONS (SPADCALL '|construct| (|getShellEntry| $ 47))
@@ -179,10 +179,10 @@
(GO G190) G191 (EXIT (NREVERSE0 #0#)))))
(|getShellEntry| $ 52))))))
-(DEFUN |List| (#0=#:G1446)
+(DEFUN |List| (#0=#:G1444)
(PROG ()
(RETURN
- (PROG (#1=#:G1447)
+ (PROG (#1=#:G1445)
(RETURN
(COND
((LETT #1#
diff --git a/src/algebra/strap/LNAGG-.lsp b/src/algebra/strap/LNAGG-.lsp
index d91e5ede..b8aa5086 100644
--- a/src/algebra/strap/LNAGG-.lsp
+++ b/src/algebra/strap/LNAGG-.lsp
@@ -21,7 +21,7 @@
|LNAGG-;maxIndex;AI;6|))
(DEFUN |LNAGG-;indices;AL;1| (|a| $)
- (PROG (#0=#:G1411 |i| #1=#:G1412)
+ (PROG (#0=#:G1409 |i| #1=#:G1410)
(RETURN
(SEQ (PROGN
(LETT #0# NIL |LNAGG-;indices;AL;1|)
diff --git a/src/algebra/strap/LNAGG.lsp b/src/algebra/strap/LNAGG.lsp
index a2b7f4cc..04e85650 100644
--- a/src/algebra/strap/LNAGG.lsp
+++ b/src/algebra/strap/LNAGG.lsp
@@ -6,13 +6,13 @@
(DEFPARAMETER |LinearAggregate;AL| 'NIL)
(DEFUN |LinearAggregate;| (|t#1|)
- (PROG (#0=#:G1400)
+ (PROG (#0=#:G1398)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
(PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
(|sublisV|
- (PAIR '(#1=#:G1399) (LIST '(|Integer|)))
+ (PAIR '(#1=#:G1397) (LIST '(|Integer|)))
(COND
(|LinearAggregate;CAT|)
('T
@@ -70,8 +70,8 @@
(|setShellEntry| #0# 0
(LIST '|LinearAggregate| (|devaluate| |t#1|)))))))
-(DEFUN |LinearAggregate| (#0=#:G1401)
- (LET (#1=#:G1402)
+(DEFUN |LinearAggregate| (#0=#:G1399)
+ (LET (#1=#:G1400)
(COND
((SETQ #1# (|assoc| (|devaluate| #0#) |LinearAggregate;AL|))
(CDR #1#))
diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp
index c345ca12..bf18f9db 100644
--- a/src/algebra/strap/LSAGG-.lsp
+++ b/src/algebra/strap/LSAGG-.lsp
@@ -230,7 +230,7 @@
(EXIT |r|))))))))
(DEFUN |LSAGG-;insert!;SAIA;7| (|s| |x| |i| $)
- (PROG (|m| #0=#:G1465 |y| |z|)
+ (PROG (|m| #0=#:G1463 |y| |z|)
(RETURN
(SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 33))
|LSAGG-;insert!;SAIA;7|)
@@ -257,7 +257,7 @@
(EXIT |x|)))))))))
(DEFUN |LSAGG-;insert!;2AIA;8| (|w| |x| |i| $)
- (PROG (|m| #0=#:G1469 |y| |z|)
+ (PROG (|m| #0=#:G1467 |y| |z|)
(RETURN
(SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 33))
|LSAGG-;insert!;2AIA;8|)
@@ -336,7 +336,7 @@
(EXIT |x|)))))))))
(DEFUN |LSAGG-;delete!;AIA;10| (|x| |i| $)
- (PROG (|m| #0=#:G1481 |y|)
+ (PROG (|m| #0=#:G1479 |y|)
(RETURN
(SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 33))
|LSAGG-;delete!;AIA;10|)
@@ -360,7 +360,7 @@
(EXIT |x|)))))))))
(DEFUN |LSAGG-;delete!;AUsA;11| (|x| |i| $)
- (PROG (|l| |m| |h| #0=#:G1486 #1=#:G1487 |t| #2=#:G1488)
+ (PROG (|l| |m| |h| #0=#:G1484 #1=#:G1485 |t| #2=#:G1486)
(RETURN
(SEQ (LETT |l| (SPADCALL |i| (|getShellEntry| $ 46))
|LSAGG-;delete!;AUsA;11|)
@@ -453,7 +453,7 @@
('T |k|)))))))
(DEFUN |LSAGG-;mergeSort| (|f| |p| |n| $)
- (PROG (#0=#:G1508 |l| |q|)
+ (PROG (#0=#:G1506 |l| |q|)
(RETURN
(SEQ (COND
((EQL |n| 2)
@@ -487,7 +487,7 @@
(|getShellEntry| $ 23)))))))))))
(DEFUN |LSAGG-;sorted?;MAB;15| (|f| |l| $)
- (PROG (#0=#:G1517 |p|)
+ (PROG (#0=#:G1515 |p|)
(RETURN
(SEQ (EXIT (COND
((SPADCALL |l| (|getShellEntry| $ 16)) T)
@@ -667,7 +667,7 @@
(EXIT (SPADCALL |y| (|getShellEntry| $ 57)))))))
(DEFUN |LSAGG-;copyInto!;2AIA;22| (|y| |x| |s| $)
- (PROG (|m| #0=#:G1546 |z|)
+ (PROG (|m| #0=#:G1544 |z|)
(RETURN
(SEQ (LETT |m| (SPADCALL |y| (|getShellEntry| $ 33))
|LSAGG-;copyInto!;2AIA;22|)
@@ -711,7 +711,7 @@
(EXIT |y|)))))))))
(DEFUN |LSAGG-;position;SA2I;23| (|w| |x| |s| $)
- (PROG (|m| #0=#:G1553 |k|)
+ (PROG (|m| #0=#:G1551 |k|)
(RETURN
(SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 33))
|LSAGG-;position;SA2I;23|)
@@ -787,7 +787,7 @@
(|getShellEntry| $ 76))))))
(DEFUN |LSAGG-;<;2AB;25| (|x| |y| $)
- (PROG (#0=#:G1567)
+ (PROG (#0=#:G1565)
(RETURN
(SEQ (EXIT (SEQ (SEQ G190
(COND
diff --git a/src/algebra/strap/LSAGG.lsp b/src/algebra/strap/LSAGG.lsp
index b5b6f97d..03de8f30 100644
--- a/src/algebra/strap/LSAGG.lsp
+++ b/src/algebra/strap/LSAGG.lsp
@@ -6,7 +6,7 @@
(DEFPARAMETER |ListAggregate;AL| 'NIL)
(DEFUN |ListAggregate;| (|t#1|)
- (PROG (#0=#:G1431)
+ (PROG (#0=#:G1429)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -27,8 +27,8 @@
(|setShellEntry| #0# 0
(LIST '|ListAggregate| (|devaluate| |t#1|)))))))
-(DEFUN |ListAggregate| (#0=#:G1432)
- (LET (#1=#:G1433)
+(DEFUN |ListAggregate| (#0=#:G1430)
+ (LET (#1=#:G1431)
(COND
((SETQ #1# (|assoc| (|devaluate| #0#) |ListAggregate;AL|))
(CDR #1#))
diff --git a/src/algebra/strap/MONOID.lsp b/src/algebra/strap/MONOID.lsp
index 4aead1bb..538e9b0e 100644
--- a/src/algebra/strap/MONOID.lsp
+++ b/src/algebra/strap/MONOID.lsp
@@ -4,7 +4,7 @@
(DEFPARAMETER |Monoid;AL| 'NIL)
(DEFUN |Monoid;| ()
- (PROG (#0=#:G1400)
+ (PROG (#0=#:G1398)
(RETURN
(PROG1 (LETT #0#
(|Join| (|SemiGroup|)
diff --git a/src/algebra/strap/MTSCAT.lsp b/src/algebra/strap/MTSCAT.lsp
index da94918a..52c28886 100644
--- a/src/algebra/strap/MTSCAT.lsp
+++ b/src/algebra/strap/MTSCAT.lsp
@@ -6,7 +6,7 @@
(DEFPARAMETER |MultivariateTaylorSeriesCategory;AL| 'NIL)
(DEFUN |MultivariateTaylorSeriesCategory;| (|t#1| |t#2|)
- (PROG (#0=#:G1400)
+ (PROG (#0=#:G1398)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -14,7 +14,7 @@
(LIST (|devaluate| |t#1|)
(|devaluate| |t#2|)))
(|sublisV|
- (PAIR '(#1=#:G1399)
+ (PAIR '(#1=#:G1397)
(LIST '(|IndexedExponents| |t#2|)))
(COND
(|MultivariateTaylorSeriesCategory;CAT|)
@@ -89,9 +89,9 @@
(|devaluate| |t#1|) (|devaluate| |t#2|)))))))
(DEFUN |MultivariateTaylorSeriesCategory|
- (&REST #0=#:G1403 &AUX #1=#:G1401)
+ (&REST #0=#:G1401 &AUX #1=#:G1399)
(DSETQ #1# #0#)
- (LET (#2=#:G1402)
+ (LET (#2=#:G1400)
(COND
((SETQ #2#
(|assoc| (|devaluateList| #1#)
diff --git a/src/algebra/strap/NNI.lsp b/src/algebra/strap/NNI.lsp
index 09094de7..8ec72966 100644
--- a/src/algebra/strap/NNI.lsp
+++ b/src/algebra/strap/NNI.lsp
@@ -44,7 +44,7 @@
(DEFUN |NonNegativeInteger| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1410)
+ (PROG (#0=#:G1408)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|NonNegativeInteger|)
diff --git a/src/algebra/strap/OINTDOM.lsp b/src/algebra/strap/OINTDOM.lsp
index c7f20569..20250a95 100644
--- a/src/algebra/strap/OINTDOM.lsp
+++ b/src/algebra/strap/OINTDOM.lsp
@@ -4,7 +4,7 @@
(DEFPARAMETER |OrderedIntegralDomain;AL| 'NIL)
(DEFUN |OrderedIntegralDomain;| ()
- (PROG (#0=#:G1398)
+ (PROG (#0=#:G1396)
(RETURN
(PROG1 (LETT #0# (|Join| (|IntegralDomain|) (|OrderedRing|))
|OrderedIntegralDomain|)
diff --git a/src/algebra/strap/ORDRING.lsp b/src/algebra/strap/ORDRING.lsp
index 8fccdd4c..c5109a0a 100644
--- a/src/algebra/strap/ORDRING.lsp
+++ b/src/algebra/strap/ORDRING.lsp
@@ -4,7 +4,7 @@
(DEFPARAMETER |OrderedRing;AL| 'NIL)
(DEFUN |OrderedRing;| ()
- (PROG (#0=#:G1404)
+ (PROG (#0=#:G1402)
(RETURN
(PROG1 (LETT #0#
(|Join| (|OrderedAbelianGroup|) (|Ring|) (|Monoid|)
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index 99e80e06..9f6d60da 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -624,7 +624,7 @@
(|OUTFORM;rspace;2I$;30| |n| (- |m| 1) $) $))))
(DEFUN |OUTFORM;matrix;L$;31| (|ll| $)
- (PROG (#0=#:G1554 |l| #1=#:G1555 |lv|)
+ (PROG (#0=#:G1552 |l| #1=#:G1553 |lv|)
(RETURN
(SEQ (LETT |lv|
(PROGN
@@ -658,7 +658,7 @@
(CONS 'AGGSET |l|))
(DEFUN |OUTFORM;blankSeparate;L$;35| (|l| $)
- (PROG (|c| |u| #0=#:G1556 |l1|)
+ (PROG (|c| |u| #0=#:G1554 |l1|)
(RETURN
(SEQ (LETT |c| 'CONCATB |OUTFORM;blankSeparate;L$;35|)
(LETT |l1| NIL |OUTFORM;blankSeparate;L$;35|)
@@ -841,7 +841,7 @@
(DEFUN |OUTFORM;empty;$;73| ($) (DECLARE (IGNORE $)) (LIST 'NOTHING))
(DEFUN |OUTFORM;infix?;$B;74| (|a| $)
- (PROG (#0=#:G1497 |e|)
+ (PROG (#0=#:G1495 |e|)
(RETURN
(SEQ (EXIT (SEQ (LETT |e|
(COND
@@ -1013,7 +1013,7 @@
(DEFUN |OutputForm| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1558)
+ (PROG (#0=#:G1556)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|OutputForm|)
diff --git a/src/algebra/strap/PI.lsp b/src/algebra/strap/PI.lsp
index ec59ac28..4365f9eb 100644
--- a/src/algebra/strap/PI.lsp
+++ b/src/algebra/strap/PI.lsp
@@ -7,7 +7,7 @@
(DEFUN |PositiveInteger| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1402)
+ (PROG (#0=#:G1400)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|PositiveInteger|)
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp
index 3452900c..e3cc7b35 100644
--- a/src/algebra/strap/POLYCAT-.lsp
+++ b/src/algebra/strap/POLYCAT-.lsp
@@ -142,8 +142,8 @@
|POLYCAT-;convert;SIf;43|))
(DEFUN |POLYCAT-;eval;SLS;1| (|p| |l| $)
- (PROG (#0=#:G1692 #1=#:G1428 #2=#:G1693 #3=#:G1694 |lvar| #4=#:G1695
- |e| #5=#:G1696)
+ (PROG (#0=#:G1690 #1=#:G1426 #2=#:G1691 #3=#:G1692 |lvar| #4=#:G1693
+ |e| #5=#:G1694)
(RETURN
(SEQ (COND
((NULL |l|) |p|)
@@ -256,7 +256,7 @@
('T (CONS 0 |l|))))))
(DEFUN |POLYCAT-;isTimes;SU;4| (|p| $)
- (PROG (|lv| #0=#:G1697 |v| #1=#:G1698 |l| |r|)
+ (PROG (|lv| #0=#:G1695 |v| #1=#:G1696 |l| |r|)
(RETURN
(SEQ (COND
((OR (NULL (LETT |lv|
@@ -358,7 +358,7 @@
(CDR |lv|) (CDR |ln|) (|getShellEntry| $ 70)))))
(DEFUN |POLYCAT-;retract;SVarSet;9| (|p| $)
- (PROG (#0=#:G1479 |q|)
+ (PROG (#0=#:G1477 |q|)
(RETURN
(SEQ (LETT |q|
(PROG2 (LETT #0# (SPADCALL |p| (|getShellEntry| $ 53))
@@ -374,7 +374,7 @@
('T (|error| "Polynomial is not a single variable"))))))))
(DEFUN |POLYCAT-;retractIfCan;SU;10| (|p| $)
- (PROG (|q| #0=#:G1487)
+ (PROG (|q| #0=#:G1485)
(RETURN
(SEQ (EXIT (SEQ (SEQ (LETT |q|
(SPADCALL |p| (|getShellEntry| $ 53))
@@ -398,7 +398,7 @@
(|getShellEntry| $ 76)))
(DEFUN |POLYCAT-;primitiveMonomials;SL;12| (|p| $)
- (PROG (#0=#:G1699 |q| #1=#:G1700)
+ (PROG (#0=#:G1697 |q| #1=#:G1698)
(RETURN
(SEQ (PROGN
(LETT #0# NIL |POLYCAT-;primitiveMonomials;SL;12|)
@@ -420,7 +420,7 @@
(GO G190) G191 (EXIT (NREVERSE0 #0#))))))))
(DEFUN |POLYCAT-;totalDegree;SNni;13| (|p| $)
- (PROG (#0=#:G1493 |d| |u|)
+ (PROG (#0=#:G1491 |d| |u|)
(RETURN
(SEQ (COND
((SPADCALL |p| (|getShellEntry| $ 78)) 0)
@@ -460,7 +460,7 @@
(EXIT |d|))))))))
(DEFUN |POLYCAT-;totalDegree;SLNni;14| (|p| |lv| $)
- (PROG (#0=#:G1501 |v| |w| |d| |u|)
+ (PROG (#0=#:G1499 |v| |w| |d| |u|)
(RETURN
(SEQ (COND
((SPADCALL |p| (|getShellEntry| $ 78)) 0)
@@ -517,7 +517,7 @@
(|getShellEntry| $ 96)))
(DEFUN |POLYCAT-;allMonoms| (|l| $)
- (PROG (#0=#:G1701 |p| #1=#:G1702)
+ (PROG (#0=#:G1699 |p| #1=#:G1700)
(RETURN
(SEQ (SPADCALL
(SPADCALL
@@ -543,7 +543,7 @@
(|getShellEntry| $ 100))))))
(DEFUN |POLYCAT-;P2R| (|p| |b| |n| $)
- (PROG (|w| |bj| #0=#:G1704 |i| #1=#:G1703)
+ (PROG (|w| |bj| #0=#:G1702 |i| #1=#:G1701)
(RETURN
(SEQ (LETT |w|
(SPADCALL |n| (|spadConstant| $ 28)
@@ -573,7 +573,7 @@
(EXIT |w|)))))
(DEFUN |POLYCAT-;eq2R| (|l| |b| $)
- (PROG (#0=#:G1705 |bj| #1=#:G1706 #2=#:G1707 |p| #3=#:G1708)
+ (PROG (#0=#:G1703 |bj| #1=#:G1704 #2=#:G1705 |p| #3=#:G1706)
(RETURN
(SEQ (SPADCALL
(PROGN
@@ -616,7 +616,7 @@
(|getShellEntry| $ 111))))))
(DEFUN |POLYCAT-;reducedSystem;MM;20| (|m| $)
- (PROG (#0=#:G1709 |r| #1=#:G1710 |b| #2=#:G1711 |bj| #3=#:G1712 |d|
+ (PROG (#0=#:G1707 |r| #1=#:G1708 |b| #2=#:G1709 |bj| #3=#:G1710 |d|
|mm| |l|)
(RETURN
(SEQ (LETT |l| (SPADCALL |m| (|getShellEntry| $ 114))
@@ -690,7 +690,7 @@
(EXIT |mm|)))))
(DEFUN |POLYCAT-;reducedSystem;MVR;21| (|m| |v| $)
- (PROG (#0=#:G1713 |s| #1=#:G1714 |b| #2=#:G1715 |bj| #3=#:G1716 |d|
+ (PROG (#0=#:G1711 |s| #1=#:G1712 |b| #2=#:G1713 |bj| #3=#:G1714 |d|
|n| |mm| |w| |l| |r|)
(RETURN
(SEQ (LETT |l| (SPADCALL |m| (|getShellEntry| $ 114))
@@ -794,8 +794,8 @@
(SPADCALL |pp| (|getShellEntry| $ 146)))
(DEFUN |POLYCAT-;factor;SF;26| (|p| $)
- (PROG (|v| |ansR| #0=#:G1717 |w| #1=#:G1718 |up| |ansSUP| #2=#:G1719
- |ww| #3=#:G1720)
+ (PROG (|v| |ansR| #0=#:G1715 |w| #1=#:G1716 |up| |ansSUP| #2=#:G1717
+ |ww| #3=#:G1718)
(RETURN
(SEQ (LETT |v| (SPADCALL |p| (|getShellEntry| $ 53))
|POLYCAT-;factor;SF;26|)
@@ -894,13 +894,13 @@
(|getShellEntry| $ 159)))))))))))
(DEFUN |POLYCAT-;conditionP;MU;27| (|mat| $)
- (PROG (|ll| #0=#:G1721 |z| #1=#:G1722 |ch| |l| #2=#:G1723 #3=#:G1724
- #4=#:G1584 #5=#:G1582 #6=#:G1583 #7=#:G1725 |vars| |degs|
- #8=#:G1726 |d| #9=#:G1727 |nd| #10=#:G1611 #11=#:G1591
- |deg1| |redmons| #12=#:G1728 |v| #13=#:G1730 |u|
- #14=#:G1729 |llR| |monslist| |ans| #15=#:G1612 |mons|
- #16=#:G1731 |m| #17=#:G1732 |i| #18=#:G1607 #19=#:G1605
- #20=#:G1606)
+ (PROG (|ll| #0=#:G1719 |z| #1=#:G1720 |ch| |l| #2=#:G1721 #3=#:G1722
+ #4=#:G1582 #5=#:G1580 #6=#:G1581 #7=#:G1723 |vars| |degs|
+ #8=#:G1724 |d| #9=#:G1725 |nd| #10=#:G1609 #11=#:G1589
+ |deg1| |redmons| #12=#:G1726 |v| #13=#:G1728 |u|
+ #14=#:G1727 |llR| |monslist| |ans| #15=#:G1610 |mons|
+ #16=#:G1729 |m| #17=#:G1730 |i| #18=#:G1605 #19=#:G1603
+ #20=#:G1604)
(RETURN
(SEQ (EXIT (SEQ (LETT |ll|
(SPADCALL
@@ -1148,7 +1148,7 @@
(EXIT
(CONS 0
(LET
- ((#21=#:G1613
+ ((#21=#:G1611
(|makeSimpleArray|
(|getVMType|
(|getShellEntry| $ 6))
@@ -1264,7 +1264,7 @@
$))))))))))
(DEFUN |POLYCAT-;charthRootlv| (|p| |vars| |ch| $)
- (PROG (|v| |dd| |cp| |d| #0=#:G1634 |ans| |ansx| #1=#:G1641)
+ (PROG (|v| |dd| |cp| |d| #0=#:G1632 |ans| |ansx| #1=#:G1639)
(RETURN
(SEQ (EXIT (COND
((NULL |vars|)
@@ -1393,7 +1393,7 @@
(SPADCALL |p| (|getShellEntry| $ 197)))
(DEFUN |POLYCAT-;squareFreePart;2S;34| (|p| $)
- (PROG (|s| |f| #0=#:G1733 #1=#:G1655 #2=#:G1653 #3=#:G1654)
+ (PROG (|s| |f| #0=#:G1731 #1=#:G1653 #2=#:G1651 #3=#:G1652)
(RETURN
(SEQ (SPADCALL
(SPADCALL
@@ -1438,7 +1438,7 @@
(|getShellEntry| $ 204)))
(DEFUN |POLYCAT-;primitivePart;2S;36| (|p| $)
- (PROG (#0=#:G1659)
+ (PROG (#0=#:G1657)
(RETURN
(QVELT (SPADCALL
(PROG2 (LETT #0#
@@ -1454,7 +1454,7 @@
1))))
(DEFUN |POLYCAT-;primitivePart;SVarSetS;37| (|p| |v| $)
- (PROG (#0=#:G1665)
+ (PROG (#0=#:G1663)
(RETURN
(QVELT (SPADCALL
(PROG2 (LETT #0#
diff --git a/src/algebra/strap/POLYCAT.lsp b/src/algebra/strap/POLYCAT.lsp
index ea77dcd8..83429409 100644
--- a/src/algebra/strap/POLYCAT.lsp
+++ b/src/algebra/strap/POLYCAT.lsp
@@ -6,7 +6,7 @@
(DEFPARAMETER |PolynomialCategory;AL| 'NIL)
(DEFUN |PolynomialCategory;| (|t#1| |t#2| |t#3|)
- (PROG (#0=#:G1417)
+ (PROG (#0=#:G1415)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -220,9 +220,9 @@
(LIST '|PolynomialCategory| (|devaluate| |t#1|)
(|devaluate| |t#2|) (|devaluate| |t#3|)))))))
-(DEFUN |PolynomialCategory| (&REST #0=#:G1420 &AUX #1=#:G1418)
+(DEFUN |PolynomialCategory| (&REST #0=#:G1418 &AUX #1=#:G1416)
(DSETQ #1# #0#)
- (LET (#2=#:G1419)
+ (LET (#2=#:G1417)
(COND
((SETQ #2#
(|assoc| (|devaluateList| #1#) |PolynomialCategory;AL|))
diff --git a/src/algebra/strap/QFCAT.lsp b/src/algebra/strap/QFCAT.lsp
index d694d366..ce1aa731 100644
--- a/src/algebra/strap/QFCAT.lsp
+++ b/src/algebra/strap/QFCAT.lsp
@@ -6,7 +6,7 @@
(DEFPARAMETER |QuotientFieldCategory;AL| 'NIL)
(DEFUN |QuotientFieldCategory;| (|t#1|)
- (PROG (#0=#:G1400)
+ (PROG (#0=#:G1398)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -92,8 +92,8 @@
(|setShellEntry| #0# 0
(LIST '|QuotientFieldCategory| (|devaluate| |t#1|)))))))
-(DEFUN |QuotientFieldCategory| (#0=#:G1401)
- (LET (#1=#:G1402)
+(DEFUN |QuotientFieldCategory| (#0=#:G1399)
+ (LET (#1=#:G1400)
(COND
((SETQ #1#
(|assoc| (|devaluate| #0#) |QuotientFieldCategory;AL|))
diff --git a/src/algebra/strap/RCAGG.lsp b/src/algebra/strap/RCAGG.lsp
index 88af0575..2d2d62e0 100644
--- a/src/algebra/strap/RCAGG.lsp
+++ b/src/algebra/strap/RCAGG.lsp
@@ -6,7 +6,7 @@
(DEFPARAMETER |RecursiveAggregate;AL| 'NIL)
(DEFUN |RecursiveAggregate;| (|t#1|)
- (PROG (#0=#:G1398)
+ (PROG (#0=#:G1396)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -63,8 +63,8 @@
(|setShellEntry| #0# 0
(LIST '|RecursiveAggregate| (|devaluate| |t#1|)))))))
-(DEFUN |RecursiveAggregate| (#0=#:G1399)
- (LET (#1=#:G1400)
+(DEFUN |RecursiveAggregate| (#0=#:G1397)
+ (LET (#1=#:G1398)
(COND
((SETQ #1# (|assoc| (|devaluate| #0#) |RecursiveAggregate;AL|))
(CDR #1#))
diff --git a/src/algebra/strap/RING.lsp b/src/algebra/strap/RING.lsp
index e661083d..c2acbb0c 100644
--- a/src/algebra/strap/RING.lsp
+++ b/src/algebra/strap/RING.lsp
@@ -4,10 +4,10 @@
(DEFPARAMETER |Ring;AL| 'NIL)
(DEFUN |Ring;| ()
- (PROG (#0=#:G1399)
+ (PROG (#0=#:G1397)
(RETURN
(PROG1 (LETT #0#
- (|sublisV| (PAIR '(#1=#:G1398) (LIST '(|Integer|)))
+ (|sublisV| (PAIR '(#1=#:G1396) (LIST '(|Integer|)))
(|Join| (|Rng|) (|Monoid|) (|LeftModule| '$)
(|CoercibleFrom| '#1#)
(|mkCategory| '|package|
diff --git a/src/algebra/strap/RNG.lsp b/src/algebra/strap/RNG.lsp
index 973189e7..e4e3fddb 100644
--- a/src/algebra/strap/RNG.lsp
+++ b/src/algebra/strap/RNG.lsp
@@ -4,7 +4,7 @@
(DEFPARAMETER |Rng;AL| 'NIL)
(DEFUN |Rng;| ()
- (PROG (#0=#:G1398)
+ (PROG (#0=#:G1396)
(RETURN
(PROG1 (LETT #0# (|Join| (|AbelianGroup|) (|SemiGroup|)) |Rng|)
(|setShellEntry| #0# 0 '(|Rng|))))))
diff --git a/src/algebra/strap/RNS.lsp b/src/algebra/strap/RNS.lsp
index fd65a996..6a02c744 100644
--- a/src/algebra/strap/RNS.lsp
+++ b/src/algebra/strap/RNS.lsp
@@ -4,12 +4,12 @@
(DEFPARAMETER |RealNumberSystem;AL| 'NIL)
(DEFUN |RealNumberSystem;| ()
- (PROG (#0=#:G1407)
+ (PROG (#0=#:G1405)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
- (PAIR '(#1=#:G1403 #2=#:G1404 #3=#:G1405
- #4=#:G1406)
+ (PAIR '(#1=#:G1401 #2=#:G1402 #3=#:G1403
+ #4=#:G1404)
(LIST '(|Integer|)
'(|Fraction| (|Integer|))
'(|Pattern| (|Float|)) '(|Float|)))
diff --git a/src/algebra/strap/SETAGG.lsp b/src/algebra/strap/SETAGG.lsp
index 96c45f22..88c198b3 100644
--- a/src/algebra/strap/SETAGG.lsp
+++ b/src/algebra/strap/SETAGG.lsp
@@ -6,7 +6,7 @@
(DEFPARAMETER |SetAggregate;AL| 'NIL)
(DEFUN |SetAggregate;| (|t#1|)
- (PROG (#0=#:G1398)
+ (PROG (#0=#:G1396)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -47,8 +47,8 @@
(|setShellEntry| #0# 0
(LIST '|SetAggregate| (|devaluate| |t#1|)))))))
-(DEFUN |SetAggregate| (#0=#:G1399)
- (LET (#1=#:G1400)
+(DEFUN |SetAggregate| (#0=#:G1397)
+ (LET (#1=#:G1398)
(COND
((SETQ #1# (|assoc| (|devaluate| #0#) |SetAggregate;AL|))
(CDR #1#))
diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp
index a0fa2e8a..6f567c8e 100644
--- a/src/algebra/strap/SINT.lsp
+++ b/src/algebra/strap/SINT.lsp
@@ -461,7 +461,7 @@
(+ (- |$ShortMaximum| |$ShortMinimum|) 1))
(DEFUN |SINT;index;Pi$;53| (|i| $)
- (PROG (#0=#:G1459)
+ (PROG (#0=#:G1457)
(RETURN
(PROG1 (LETT #0# (- (+ |i| |$ShortMinimum|) 1)
|SINT;index;Pi$;53|)
@@ -504,7 +504,7 @@
(DEFUN |SingleInteger| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1494)
+ (PROG (#0=#:G1492)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|SingleInteger|)
diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp
index 97751dd5..4fabe92e 100644
--- a/src/algebra/strap/STAGG-.lsp
+++ b/src/algebra/strap/STAGG-.lsp
@@ -50,7 +50,7 @@
(SPADCALL |x| (|getShellEntry| $ 9)))
(DEFUN |STAGG-;first;ANniA;3| (|x| |n| $)
- (PROG (#0=#:G1448 |i|)
+ (PROG (#0=#:G1446 |i|)
(RETURN
(SEQ (SPADCALL
(PROGN
@@ -94,7 +94,7 @@
(EXIT (SPADCALL |x| (|getShellEntry| $ 22)))))
(DEFUN |STAGG-;elt;AUsA;6| (|x| |i| $)
- (PROG (|l| |h| #0=#:G1418)
+ (PROG (|l| |h| #0=#:G1416)
(RETURN
(SEQ (LETT |l|
(- (SPADCALL |i| (|getShellEntry| $ 31))
@@ -195,7 +195,7 @@
(EXIT (SPADCALL |x| |s| (|getShellEntry| $ 48)))))
(DEFUN |STAGG-;setelt;AUs2S;12| (|x| |i| |s| $)
- (PROG (|l| |h| #0=#:G1438 |z| |y|)
+ (PROG (|l| |h| #0=#:G1436 |z| |y|)
(RETURN
(SEQ (LETT |l|
(- (SPADCALL |i| (|getShellEntry| $ 31))
diff --git a/src/algebra/strap/STAGG.lsp b/src/algebra/strap/STAGG.lsp
index 0feed81e..2b88ed22 100644
--- a/src/algebra/strap/STAGG.lsp
+++ b/src/algebra/strap/STAGG.lsp
@@ -6,7 +6,7 @@
(DEFPARAMETER |StreamAggregate;AL| 'NIL)
(DEFUN |StreamAggregate;| (|t#1|)
- (PROG (#0=#:G1405)
+ (PROG (#0=#:G1403)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -30,8 +30,8 @@
(|setShellEntry| #0# 0
(LIST '|StreamAggregate| (|devaluate| |t#1|)))))))
-(DEFUN |StreamAggregate| (#0=#:G1406)
- (LET (#1=#:G1407)
+(DEFUN |StreamAggregate| (#0=#:G1404)
+ (LET (#1=#:G1405)
(COND
((SETQ #1# (|assoc| (|devaluate| #0#) |StreamAggregate;AL|))
(CDR #1#))
diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp
index 3a333e20..56936104 100644
--- a/src/algebra/strap/SYMBOL.lsp
+++ b/src/algebra/strap/SYMBOL.lsp
@@ -209,7 +209,7 @@
(SPADCALL |x| (|getShellEntry| $ 81)))
(DEFUN |SYMBOL;syprefix| (|sc| $)
- (PROG (|ns| #0=#:G1549 |n| #1=#:G1550)
+ (PROG (|ns| #0=#:G1547 |n| #1=#:G1548)
(RETURN
(SEQ (LETT |ns|
(LIST (LENGTH (QVELT |sc| 3)) (LENGTH (QVELT |sc| 2))
@@ -438,7 +438,7 @@
(EXIT |s|)))))
(DEFUN |SYMBOL;anyRadix| (|n| |s| $)
- (PROG (|qr| |ns| #0=#:G1505)
+ (PROG (|qr| |ns| #0=#:G1503)
(RETURN
(SEQ (EXIT (SEQ (LETT |ns| "" |SYMBOL;anyRadix|)
(EXIT (SEQ G190 NIL
@@ -530,7 +530,7 @@
(|SYMBOL;scripts;$R;32| |x| $) $))))))
(DEFUN |SYMBOL;resetNew;V;29| ($)
- (PROG (|k| #0=#:G1551)
+ (PROG (|k| #0=#:G1549)
(RETURN
(SEQ (SPADCALL (|getShellEntry| $ 10) 0 (|getShellEntry| $ 123))
(SEQ (LETT |k| NIL |SYMBOL;resetNew;V;29|)
@@ -554,7 +554,7 @@
(DEFUN |SYMBOL;scripted?;$B;30| (|sy| $) (NOT (ATOM |sy|)))
(DEFUN |SYMBOL;name;2$;31| (|sy| $)
- (PROG (|str| |i| #0=#:G1552 #1=#:G1532 #2=#:G1530)
+ (PROG (|str| |i| #0=#:G1550 #1=#:G1530 #2=#:G1528)
(RETURN
(SEQ (EXIT (COND
((NOT (|SYMBOL;scripted?;$B;30| |sy| $)) |sy|)
@@ -607,8 +607,8 @@
#1# (EXIT #1#)))))
(DEFUN |SYMBOL;scripts;$R;32| (|sy| $)
- (PROG (|lscripts| |str| |nstr| |j| #0=#:G1535 |nscripts| |m| |n|
- #1=#:G1553 |i| #2=#:G1554 |a| #3=#:G1555 |allscripts|)
+ (PROG (|lscripts| |str| |nstr| |j| #0=#:G1533 |nscripts| |m| |n|
+ #1=#:G1551 |i| #2=#:G1552 |a| #3=#:G1553 |allscripts|)
(RETURN
(SEQ (COND
((NOT (|SYMBOL;scripted?;$B;30| |sy| $))
@@ -750,7 +750,7 @@
(DEFUN |Symbol| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1557)
+ (PROG (#0=#:G1555)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|Symbol|) |Symbol|)
diff --git a/src/algebra/strap/UFD-.lsp b/src/algebra/strap/UFD-.lsp
index b82436ab..594ac9fa 100644
--- a/src/algebra/strap/UFD-.lsp
+++ b/src/algebra/strap/UFD-.lsp
@@ -8,7 +8,7 @@
|UFD-;prime?;SB;2|))
(DEFUN |UFD-;squareFreePart;2S;1| (|x| $)
- (PROG (|s| |f| #0=#:G1420 #1=#:G1407 #2=#:G1405 #3=#:G1406)
+ (PROG (|s| |f| #0=#:G1418 #1=#:G1405 #2=#:G1403 #3=#:G1404)
(RETURN
(SEQ (SPADCALL
(SPADCALL
diff --git a/src/algebra/strap/UFD.lsp b/src/algebra/strap/UFD.lsp
index 0065ba95..36c60cf4 100644
--- a/src/algebra/strap/UFD.lsp
+++ b/src/algebra/strap/UFD.lsp
@@ -4,7 +4,7 @@
(DEFPARAMETER |UniqueFactorizationDomain;AL| 'NIL)
(DEFUN |UniqueFactorizationDomain;| ()
- (PROG (#0=#:G1398)
+ (PROG (#0=#:G1396)
(RETURN
(PROG1 (LETT #0#
(|Join| (|GcdDomain|)
diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp
index 9528b39e..3cde7fc7 100644
--- a/src/algebra/strap/URAGG-.lsp
+++ b/src/algebra/strap/URAGG-.lsp
@@ -274,7 +274,7 @@
(EXIT |x|))))))))
(DEFUN |URAGG-;findCycle| (|x| $)
- (PROG (#0=#:G1476 |y|)
+ (PROG (#0=#:G1474 |y|)
(RETURN
(SEQ (EXIT (SEQ (LETT |y| (SPADCALL |x| (|getShellEntry| $ 14))
|URAGG-;findCycle|)
@@ -435,7 +435,7 @@
(EXIT |x|)))))
(DEFUN |URAGG-;last;ANniA;22| (|x| |n| $)
- (PROG (|m| #0=#:G1499)
+ (PROG (|m| #0=#:G1497)
(RETURN
(SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 60))
|URAGG-;last;ANniA;22|)
@@ -452,7 +452,7 @@
(|getShellEntry| $ 63)))))))))
(DEFUN |URAGG-;=;2AB;23| (|x| |y| $)
- (PROG (|k| #0=#:G1509)
+ (PROG (|k| #0=#:G1507)
(RETURN
(SEQ (EXIT (COND
((SPADCALL |x| |y| (|getShellEntry| $ 53)) T)
@@ -506,7 +506,7 @@
#0# (EXIT #0#)))))
(DEFUN |URAGG-;node?;2AB;24| (|u| |v| $)
- (PROG (|k| #0=#:G1514)
+ (PROG (|k| #0=#:G1512)
(RETURN
(SEQ (EXIT (SEQ (SEQ (LETT |k| 0 |URAGG-;node?;2AB;24|) G190
(COND
@@ -574,7 +574,7 @@
(SPADCALL |u| |s| (|getShellEntry| $ 70)))
(DEFUN |URAGG-;split!;AIA;32| (|p| |n| $)
- (PROG (#0=#:G1525 |q|)
+ (PROG (#0=#:G1523 |q|)
(RETURN
(SEQ (COND
((< |n| 1) (|error| "index out of range"))
diff --git a/src/algebra/strap/URAGG.lsp b/src/algebra/strap/URAGG.lsp
index bd58193e..baa0c9f1 100644
--- a/src/algebra/strap/URAGG.lsp
+++ b/src/algebra/strap/URAGG.lsp
@@ -6,7 +6,7 @@
(DEFPARAMETER |UnaryRecursiveAggregate;AL| 'NIL)
(DEFUN |UnaryRecursiveAggregate;| (|t#1|)
- (PROG (#0=#:G1426)
+ (PROG (#0=#:G1424)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -99,8 +99,8 @@
(|setShellEntry| #0# 0
(LIST '|UnaryRecursiveAggregate| (|devaluate| |t#1|)))))))
-(DEFUN |UnaryRecursiveAggregate| (#0=#:G1427)
- (LET (#1=#:G1428)
+(DEFUN |UnaryRecursiveAggregate| (#0=#:G1425)
+ (LET (#1=#:G1426)
(COND
((SETQ #1#
(|assoc| (|devaluate| #0#) |UnaryRecursiveAggregate;AL|))
diff --git a/src/algebra/strap/VECTOR.lsp b/src/algebra/strap/VECTOR.lsp
index c9db05ae..6b8ecf36 100644
--- a/src/algebra/strap/VECTOR.lsp
+++ b/src/algebra/strap/VECTOR.lsp
@@ -17,10 +17,10 @@
(|getShellEntry| $ 16)))
(|getShellEntry| $ 18)))
-(DEFUN |Vector| (#0=#:G1408)
+(DEFUN |Vector| (#0=#:G1406)
(PROG ()
(RETURN
- (PROG (#1=#:G1409)
+ (PROG (#1=#:G1407)
(RETURN
(COND
((LETT #1#
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index eb0f6940..adfa6b2e 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -1143,12 +1143,22 @@ bfCaseItem(x,y) ==
bfCase: (%Thing,%Thing) -> %List
bfCase(x,y)==
- g:=bfGenSymbol()
- g1:=bfGenSymbol()
- a:=bfLET(g,x)
- b:=bfLET(g1,["CDR",g])
- c:=bfCaseItems (g1,y)
- bfMKPROGN [a,b,["CASE",["CAR", g],:c]]
+ -- Introduce a temporary to hold the value of the scrutinee.
+ -- To minimize the number of GENSYMS and assignments, we want
+ -- to do this only when the scrutinee is not reduced yet.
+ g :=
+ atom x => x
+ bfGenSymbol()
+ a :=
+ EQ(g,x) => nil
+ [[g,x]]
+ -- We need a temporary for the rest of the structure.
+ g1 := bfGenSymbol()
+ -- locally bind newly introduced temporaries in the alternatives
+ inits := [:a,[g1,["CDR",g]]]
+ body := ["CASE",["CAR", g], :bfCaseItems (g1,y)]
+ #inits = 1 => ["LET",inits,body]
+ ["LET*",inits,body]
bfCaseItems: (%Thing,%List) -> %List
bfCaseItems(g,x) ==
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 0a044053..79e2f582 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -258,13 +258,10 @@
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfCompDef|))
(DEFUN |bfCompDef| (|x|)
- (PROG (|body| |ISTMP#3| |args| |ISTMP#2| |op| |ISTMP#1| |def|
- |bfVar#80| |bfVar#79|)
+ (PROG (|body| |ISTMP#3| |args| |ISTMP#2| |op| |ISTMP#1| |def|)
(RETURN
- (PROGN
- (SETQ |bfVar#79| |x|)
- (SETQ |bfVar#80| (CDR |bfVar#79|))
- (CASE (CAR |bfVar#79|)
+ (LET ((|bfVar#79| (CDR |x|)))
+ (CASE (CAR |x|)
(|%ConstantDefinition| |x|)
(T (COND
((AND (CONSP |x|)
@@ -316,22 +313,22 @@
(PROGN
(SETQ |a| (COND ((|bfTupleP| |b|) (CDR |b|)) ('T (LIST |b|))))
(COND
- ((LET ((|bfVar#82| NIL) (|bfVar#81| |a|) (|x| NIL))
+ ((LET ((|bfVar#81| NIL) (|bfVar#80| |a|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#81|)
- (PROGN (SETQ |x| (CAR |bfVar#81|)) NIL))
- (RETURN |bfVar#82|))
+ ((OR (ATOM |bfVar#80|)
+ (PROGN (SETQ |x| (CAR |bfVar#80|)) NIL))
+ (RETURN |bfVar#81|))
('T
(PROGN
- (SETQ |bfVar#82|
+ (SETQ |bfVar#81|
(AND (CONSP |x|) (EQ (CAR |x|) 'COLON)
(PROGN
(SETQ |ISTMP#1| (CDR |x|))
(AND (CONSP |ISTMP#1|)
(EQ (CDR |ISTMP#1|) NIL)))))
- (COND (|bfVar#82| (RETURN |bfVar#82|))))))
- (SETQ |bfVar#81| (CDR |bfVar#81|))))
+ (COND (|bfVar#81| (RETURN |bfVar#81|))))))
+ (SETQ |bfVar#80| (CDR |bfVar#80|))))
(|bfMakeCons| |a|))
('T (CONS 'LIST |a|)))))))
@@ -491,19 +488,19 @@
(COND
((NULL |iters|) (LIST NIL NIL NIL NIL NIL NIL))
('T (SETQ |f| (CAR |iters|)) (SETQ |r| (|bfSep| (CDR |iters|)))
- (LET ((|bfVar#85| NIL) (|bfVar#83| |f|) (|i| NIL)
- (|bfVar#84| |r|) (|j| NIL))
+ (LET ((|bfVar#84| NIL) (|bfVar#82| |f|) (|i| NIL)
+ (|bfVar#83| |r|) (|j| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#83|)
- (PROGN (SETQ |i| (CAR |bfVar#83|)) NIL)
- (ATOM |bfVar#84|)
- (PROGN (SETQ |j| (CAR |bfVar#84|)) NIL))
- (RETURN (NREVERSE |bfVar#85|)))
+ ((OR (ATOM |bfVar#82|)
+ (PROGN (SETQ |i| (CAR |bfVar#82|)) NIL)
+ (ATOM |bfVar#83|)
+ (PROGN (SETQ |j| (CAR |bfVar#83|)) NIL))
+ (RETURN (NREVERSE |bfVar#84|)))
('T
- (SETQ |bfVar#85| (CONS (APPEND |i| |j|) |bfVar#85|))))
- (SETQ |bfVar#83| (CDR |bfVar#83|))
- (SETQ |bfVar#84| (CDR |bfVar#84|)))))))))
+ (SETQ |bfVar#84| (CONS (APPEND |i| |j|) |bfVar#84|))))
+ (SETQ |bfVar#82| (CDR |bfVar#82|))
+ (SETQ |bfVar#83| (CDR |bfVar#83|)))))))))
(DEFUN |bfReduce| (|op| |y|)
(PROG (|it| |ny| |g2| |body| |g1| |g| |init| |a|)
@@ -618,25 +615,25 @@
(COND
(|vars| (SETQ |loop|
(LIST 'LET
- (LET ((|bfVar#88| NIL)
- (|bfVar#86| |vars|) (|v| NIL)
- (|bfVar#87| |inits|) (|i| NIL))
+ (LET ((|bfVar#87| NIL)
+ (|bfVar#85| |vars|) (|v| NIL)
+ (|bfVar#86| |inits|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#86|)
+ ((OR (ATOM |bfVar#85|)
(PROGN
- (SETQ |v| (CAR |bfVar#86|))
+ (SETQ |v| (CAR |bfVar#85|))
NIL)
- (ATOM |bfVar#87|)
+ (ATOM |bfVar#86|)
(PROGN
- (SETQ |i| (CAR |bfVar#87|))
+ (SETQ |i| (CAR |bfVar#86|))
NIL))
- (RETURN (NREVERSE |bfVar#88|)))
+ (RETURN (NREVERSE |bfVar#87|)))
('T
- (SETQ |bfVar#88|
- (CONS (LIST |v| |i|) |bfVar#88|))))
- (SETQ |bfVar#86| (CDR |bfVar#86|))
- (SETQ |bfVar#87| (CDR |bfVar#87|))))
+ (SETQ |bfVar#87|
+ (CONS (LIST |v| |i|) |bfVar#87|))))
+ (SETQ |bfVar#85| (CDR |bfVar#85|))
+ (SETQ |bfVar#86| (CDR |bfVar#86|))))
|loop|))))
|loop|))))
@@ -1228,17 +1225,17 @@
((NULL (CDR |l|)) (CAR |l|))
('T
(CONS 'OR
- (LET ((|bfVar#90| NIL) (|bfVar#89| |l|) (|c| NIL))
+ (LET ((|bfVar#89| NIL) (|bfVar#88| |l|) (|c| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#89|)
- (PROGN (SETQ |c| (CAR |bfVar#89|)) NIL))
- (RETURN (NREVERSE |bfVar#90|)))
+ ((OR (ATOM |bfVar#88|)
+ (PROGN (SETQ |c| (CAR |bfVar#88|)) NIL))
+ (RETURN (NREVERSE |bfVar#89|)))
('T
- (SETQ |bfVar#90|
+ (SETQ |bfVar#89|
(APPEND (REVERSE (|bfFlatten| 'OR |c|))
- |bfVar#90|))))
- (SETQ |bfVar#89| (CDR |bfVar#89|))))))))
+ |bfVar#89|))))
+ (SETQ |bfVar#88| (CDR |bfVar#88|))))))))
(DEFUN |bfAND| (|l|)
(COND
@@ -1246,17 +1243,17 @@
((NULL (CDR |l|)) (CAR |l|))
('T
(CONS 'AND
- (LET ((|bfVar#92| NIL) (|bfVar#91| |l|) (|c| NIL))
+ (LET ((|bfVar#91| NIL) (|bfVar#90| |l|) (|c| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#91|)
- (PROGN (SETQ |c| (CAR |bfVar#91|)) NIL))
- (RETURN (NREVERSE |bfVar#92|)))
+ ((OR (ATOM |bfVar#90|)
+ (PROGN (SETQ |c| (CAR |bfVar#90|)) NIL))
+ (RETURN (NREVERSE |bfVar#91|)))
('T
- (SETQ |bfVar#92|
+ (SETQ |bfVar#91|
(APPEND (REVERSE (|bfFlatten| 'AND |c|))
- |bfVar#92|))))
- (SETQ |bfVar#91| (CDR |bfVar#91|))))))))
+ |bfVar#91|))))
+ (SETQ |bfVar#90| (CDR |bfVar#90|))))))))
(DEFUN |defQuoteId| (|x|)
(AND (EQCAR |x| 'QUOTE) (IDENTP (CADR |x|))))
@@ -1293,55 +1290,55 @@
(SETQ |nargl| (CADDR . #0#))
(SETQ |largl| (CADDDR . #0#))
(SETQ |sb|
- (LET ((|bfVar#95| NIL) (|bfVar#93| |nargl|) (|i| NIL)
- (|bfVar#94| |sgargl|) (|j| NIL))
+ (LET ((|bfVar#94| NIL) (|bfVar#92| |nargl|) (|i| NIL)
+ (|bfVar#93| |sgargl|) (|j| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#93|)
- (PROGN (SETQ |i| (CAR |bfVar#93|)) NIL)
- (ATOM |bfVar#94|)
- (PROGN (SETQ |j| (CAR |bfVar#94|)) NIL))
- (RETURN (NREVERSE |bfVar#95|)))
+ ((OR (ATOM |bfVar#92|)
+ (PROGN (SETQ |i| (CAR |bfVar#92|)) NIL)
+ (ATOM |bfVar#93|)
+ (PROGN (SETQ |j| (CAR |bfVar#93|)) NIL))
+ (RETURN (NREVERSE |bfVar#94|)))
(#1='T
- (SETQ |bfVar#95| (CONS (CONS |i| |j|) |bfVar#95|))))
- (SETQ |bfVar#93| (CDR |bfVar#93|))
- (SETQ |bfVar#94| (CDR |bfVar#94|)))))
+ (SETQ |bfVar#94| (CONS (CONS |i| |j|) |bfVar#94|))))
+ (SETQ |bfVar#92| (CDR |bfVar#92|))
+ (SETQ |bfVar#93| (CDR |bfVar#93|)))))
(SETQ |body| (SUBLIS |sb| |body|))
(SETQ |sb2|
- (LET ((|bfVar#98| NIL) (|bfVar#96| |sgargl|) (|i| NIL)
- (|bfVar#97| |largl|) (|j| NIL))
+ (LET ((|bfVar#97| NIL) (|bfVar#95| |sgargl|) (|i| NIL)
+ (|bfVar#96| |largl|) (|j| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#96|)
- (PROGN (SETQ |i| (CAR |bfVar#96|)) NIL)
- (ATOM |bfVar#97|)
- (PROGN (SETQ |j| (CAR |bfVar#97|)) NIL))
- (RETURN (NREVERSE |bfVar#98|)))
+ ((OR (ATOM |bfVar#95|)
+ (PROGN (SETQ |i| (CAR |bfVar#95|)) NIL)
+ (ATOM |bfVar#96|)
+ (PROGN (SETQ |j| (CAR |bfVar#96|)) NIL))
+ (RETURN (NREVERSE |bfVar#97|)))
(#1#
- (SETQ |bfVar#98|
+ (SETQ |bfVar#97|
(CONS (LIST 'CONS (LIST 'QUOTE |i|) |j|)
- |bfVar#98|))))
- (SETQ |bfVar#96| (CDR |bfVar#96|))
- (SETQ |bfVar#97| (CDR |bfVar#97|)))))
+ |bfVar#97|))))
+ (SETQ |bfVar#95| (CDR |bfVar#95|))
+ (SETQ |bfVar#96| (CDR |bfVar#96|)))))
(SETQ |body|
(LIST 'SUBLIS (CONS 'LIST |sb2|) (LIST 'QUOTE |body|)))
(SETQ |lamex| (LIST 'MLAMBDA |gargl| |body|))
(SETQ |def| (LIST |op| |lamex|))
(|bfTuple|
(CONS (|shoeComp| |def|)
- (LET ((|bfVar#100| NIL) (|bfVar#99| |$wheredefs|)
+ (LET ((|bfVar#99| NIL) (|bfVar#98| |$wheredefs|)
(|d| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#99|)
- (PROGN (SETQ |d| (CAR |bfVar#99|)) NIL))
- (RETURN (NREVERSE |bfVar#100|)))
+ ((OR (ATOM |bfVar#98|)
+ (PROGN (SETQ |d| (CAR |bfVar#98|)) NIL))
+ (RETURN (NREVERSE |bfVar#99|)))
(#1#
- (SETQ |bfVar#100|
+ (SETQ |bfVar#99|
(APPEND (REVERSE
(|shoeComps| (|bfDef1| |d|)))
- |bfVar#100|))))
- (SETQ |bfVar#99| (CDR |bfVar#99|))))))))))
+ |bfVar#99|))))
+ (SETQ |bfVar#98| (CDR |bfVar#98|))))))))))
(DEFUN |bfGargl| (|argl|)
(PROG (|f| |d| |c| |b| |a| |LETTMP#1|)
@@ -1361,13 +1358,13 @@
(LIST (CONS |f| |a|) (CONS |f| |b|) (CONS (CAR |argl|) |c|)
(CONS |f| |d|)))))))))
-(DEFUN |bfDef1| (|bfVar#101|)
+(DEFUN |bfDef1| (|bfVar#100|)
(PROG (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args|
|op| |defOp|)
(RETURN
(PROGN
- (SETQ |defOp| (CAR |bfVar#101|))
- (SETQ |op| (CADR . #0=(|bfVar#101|)))
+ (SETQ |defOp| (CAR |bfVar#100|))
+ (SETQ |op| (CADR . #0=(|bfVar#100|)))
(SETQ |args| (CADDR . #0#))
(SETQ |body| (CADDDR . #0#))
(SETQ |argl|
@@ -1413,31 +1410,31 @@
(|bfCompHash| |op1| |arg1| |body1|)))
('T
(|bfTuple|
- (LET ((|bfVar#103| NIL)
- (|bfVar#102|
+ (LET ((|bfVar#102| NIL)
+ (|bfVar#101|
(CONS (LIST |defOp| |op| |args| |body|)
|$wheredefs|))
(|d| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#102|)
- (PROGN (SETQ |d| (CAR |bfVar#102|)) NIL))
- (RETURN (NREVERSE |bfVar#103|)))
+ ((OR (ATOM |bfVar#101|)
+ (PROGN (SETQ |d| (CAR |bfVar#101|)) NIL))
+ (RETURN (NREVERSE |bfVar#102|)))
('T
- (SETQ |bfVar#103|
+ (SETQ |bfVar#102|
(APPEND (REVERSE (|shoeComps| (|bfDef1| |d|)))
- |bfVar#103|))))
- (SETQ |bfVar#102| (CDR |bfVar#102|))))))))))
+ |bfVar#102|))))
+ (SETQ |bfVar#101| (CDR |bfVar#101|))))))))))
(DEFUN |shoeComps| (|x|)
- (LET ((|bfVar#105| NIL) (|bfVar#104| |x|) (|def| NIL))
+ (LET ((|bfVar#104| NIL) (|bfVar#103| |x|) (|def| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#104|)
- (PROGN (SETQ |def| (CAR |bfVar#104|)) NIL))
- (RETURN (NREVERSE |bfVar#105|)))
- ('T (SETQ |bfVar#105| (CONS (|shoeComp| |def|) |bfVar#105|))))
- (SETQ |bfVar#104| (CDR |bfVar#104|)))))
+ ((OR (ATOM |bfVar#103|)
+ (PROGN (SETQ |def| (CAR |bfVar#103|)) NIL))
+ (RETURN (NREVERSE |bfVar#104|)))
+ ('T (SETQ |bfVar#104| (CONS (|shoeComp| |def|) |bfVar#104|))))
+ (SETQ |bfVar#103| (CDR |bfVar#103|)))))
(DEFUN |shoeComp| (|x|)
(PROG (|a|)
@@ -1494,7 +1491,7 @@
(|bfParameterList| |name1| |name2|) |body2|))))))
(DEFUN |bfInsertLet1| (|y| |body|)
- (PROG (|bfVar#107| |bfVar#106| |g| |b| |r| |ISTMP#2| |l| |ISTMP#1|)
+ (PROG (|g| |b| |r| |ISTMP#2| |l| |ISTMP#1|)
(RETURN
(COND
((AND (CONSP |y|) (EQ (CAR |y|) 'L%T)
@@ -1521,13 +1518,11 @@
(COND
((ATOM |y|) (LIST NIL NIL |g| |body|))
(#1#
- (PROGN
- (SETQ |bfVar#106| |y|)
- (SETQ |bfVar#107| (CDR |bfVar#106|))
- (CASE (CAR |bfVar#106|)
+ (LET ((|bfVar#105| (CDR |y|)))
+ (CASE (CAR |y|)
(|%DefaultValue|
- (LET ((|p| (CAR |bfVar#107|))
- (|v| (CADR |bfVar#107|)))
+ (LET ((|p| (CAR |bfVar#105|))
+ (|v| (CADR |bfVar#105|)))
(LIST NIL NIL (LIST '&OPTIONAL (LIST |p| |v|))
|body|)))
(T (LIST NIL NIL |g|
@@ -1590,17 +1585,17 @@
(COND
((MEMBER |op| '(RETURN RETURN-FROM)) T)
((MEMBER |op| '(LET PROG LOOP BLOCK DECLARE LAMBDA)) NIL)
- ((LET ((|bfVar#109| NIL) (|bfVar#108| |body|) (|t| NIL))
+ ((LET ((|bfVar#107| NIL) (|bfVar#106| |body|) (|t| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#108|)
- (PROGN (SETQ |t| (CAR |bfVar#108|)) NIL))
- (RETURN |bfVar#109|))
+ ((OR (ATOM |bfVar#106|)
+ (PROGN (SETQ |t| (CAR |bfVar#106|)) NIL))
+ (RETURN |bfVar#107|))
('T
(PROGN
- (SETQ |bfVar#109| (|needsPROG| |t|))
- (COND (|bfVar#109| (RETURN |bfVar#109|))))))
- (SETQ |bfVar#108| (CDR |bfVar#108|))))
+ (SETQ |bfVar#107| (|needsPROG| |t|))
+ (COND (|bfVar#107| (RETURN |bfVar#107|))))))
+ (SETQ |bfVar#106| (CDR |bfVar#106|))))
T)
(#0# NIL))))))))
@@ -1703,11 +1698,11 @@
((MEMQ U '(PROG LAMBDA))
(PROGN
(SETQ |newbindings| NIL)
- (LET ((|bfVar#110| (CADR |x|)) (|y| NIL))
+ (LET ((|bfVar#108| (CADR |x|)) (|y| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#110|)
- (PROGN (SETQ |y| (CAR |bfVar#110|)) NIL))
+ ((OR (ATOM |bfVar#108|)
+ (PROGN (SETQ |y| (CAR |bfVar#108|)) NIL))
(RETURN NIL))
(#1='T
(COND
@@ -1717,23 +1712,23 @@
(SETQ |$locVars| (CONS |y| |$locVars|))
(SETQ |newbindings|
(CONS |y| |newbindings|))))))))
- (SETQ |bfVar#110| (CDR |bfVar#110|))))
+ (SETQ |bfVar#108| (CDR |bfVar#108|))))
(SETQ |res| (|shoeCompTran1| (CDDR |x|)))
(SETQ |$locVars|
- (LET ((|bfVar#112| NIL) (|bfVar#111| |$locVars|)
+ (LET ((|bfVar#110| NIL) (|bfVar#109| |$locVars|)
(|y| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#111|)
+ ((OR (ATOM |bfVar#109|)
(PROGN
- (SETQ |y| (CAR |bfVar#111|))
+ (SETQ |y| (CAR |bfVar#109|))
NIL))
- (RETURN (NREVERSE |bfVar#112|)))
+ (RETURN (NREVERSE |bfVar#110|)))
(#1#
(AND (NOT (MEMQ |y| |newbindings|))
- (SETQ |bfVar#112|
- (CONS |y| |bfVar#112|)))))
- (SETQ |bfVar#111| (CDR |bfVar#111|)))))))
+ (SETQ |bfVar#110|
+ (CONS |y| |bfVar#110|)))))
+ (SETQ |bfVar#109| (CDR |bfVar#109|)))))))
(#0#
(PROGN
(|shoeCompTran1| (CAR |x|))
@@ -1820,14 +1815,14 @@
(RETURN
(PROGN
(SETQ |a|
- (LET ((|bfVar#113| NIL) (|c| |l|))
+ (LET ((|bfVar#111| NIL) (|c| |l|))
(LOOP
(COND
- ((ATOM |c|) (RETURN (NREVERSE |bfVar#113|)))
+ ((ATOM |c|) (RETURN (NREVERSE |bfVar#111|)))
('T
- (SETQ |bfVar#113|
+ (SETQ |bfVar#111|
(APPEND (REVERSE (|bfFlattenSeq| |c|))
- |bfVar#113|))))
+ |bfVar#111|))))
(SETQ |c| (CDR |c|)))))
(COND
((NULL |a|) NIL)
@@ -1847,17 +1842,17 @@
((EQCAR |f| 'PROGN)
(COND
((CDR |x|)
- (LET ((|bfVar#115| NIL) (|bfVar#114| (CDR |f|))
+ (LET ((|bfVar#113| NIL) (|bfVar#112| (CDR |f|))
(|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#114|)
- (PROGN (SETQ |i| (CAR |bfVar#114|)) NIL))
- (RETURN (NREVERSE |bfVar#115|)))
+ ((OR (ATOM |bfVar#112|)
+ (PROGN (SETQ |i| (CAR |bfVar#112|)) NIL))
+ (RETURN (NREVERSE |bfVar#113|)))
('T
(AND (NOT (ATOM |i|))
- (SETQ |bfVar#115| (CONS |i| |bfVar#115|)))))
- (SETQ |bfVar#114| (CDR |bfVar#114|)))))
+ (SETQ |bfVar#113| (CONS |i| |bfVar#113|)))))
+ (SETQ |bfVar#112| (CDR |bfVar#112|)))))
(#0# (CDR |f|))))
(#0# (LIST |f|)))))))))
@@ -1870,11 +1865,11 @@
(#0='T
(PROGN
(SETQ |transform|
- (LET ((|bfVar#117| NIL) (|bfVar#116| |l|) (|x| NIL))
+ (LET ((|bfVar#115| NIL) (|bfVar#114| |l|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#116|)
- (PROGN (SETQ |x| (CAR |bfVar#116|)) NIL)
+ ((OR (ATOM |bfVar#114|)
+ (PROGN (SETQ |x| (CAR |bfVar#114|)) NIL)
(NOT (AND (CONSP |x|) (EQ (CAR |x|) 'COND)
(PROGN
(SETQ |ISTMP#1| (CDR |x|))
@@ -1909,11 +1904,11 @@
(SETQ |b|
(CAR |ISTMP#5|))
'T))))))))))))))
- (RETURN (NREVERSE |bfVar#117|)))
+ (RETURN (NREVERSE |bfVar#115|)))
('T
- (SETQ |bfVar#117|
- (CONS (LIST |a| |b|) |bfVar#117|))))
- (SETQ |bfVar#116| (CDR |bfVar#116|)))))
+ (SETQ |bfVar#115|
+ (CONS (LIST |a| |b|) |bfVar#115|))))
+ (SETQ |bfVar#114| (CDR |bfVar#114|)))))
(SETQ |no| (LENGTH |transform|))
(SETQ |before| (|bfTake| |no| |l|))
(SETQ |aft| (|bfDrop| |no| |l|))
@@ -1946,12 +1941,12 @@
(SETQ |defs| (CADR . #0=(|LETTMP#1|)))
(SETQ |nondefs| (CADDR . #0#))
(SETQ |a|
- (LET ((|bfVar#119| NIL) (|bfVar#118| |defs|) (|d| NIL))
+ (LET ((|bfVar#117| NIL) (|bfVar#116| |defs|) (|d| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#118|)
- (PROGN (SETQ |d| (CAR |bfVar#118|)) NIL))
- (RETURN (NREVERSE |bfVar#119|)))
+ ((OR (ATOM |bfVar#116|)
+ (PROGN (SETQ |d| (CAR |bfVar#116|)) NIL))
+ (RETURN (NREVERSE |bfVar#117|)))
('T
(AND (CONSP |d|)
(PROGN
@@ -1970,11 +1965,11 @@
(PROGN
(SETQ |body| (CAR |ISTMP#3|))
'T)))))))
- (SETQ |bfVar#119|
+ (SETQ |bfVar#117|
(CONS (LIST |def| |op| |args|
(|bfSUBLIS| |opassoc| |body|))
- |bfVar#119|)))))
- (SETQ |bfVar#118| (CDR |bfVar#118|)))))
+ |bfVar#117|)))))
+ (SETQ |bfVar#116| (CDR |bfVar#116|)))))
(SETQ |$wheredefs| (APPEND |a| |$wheredefs|))
(|bfMKPROGN|
(|bfSUBLIS| |opassoc| (NCONC |nondefs| (LIST |expr|))))))))
@@ -2052,16 +2047,16 @@
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List|) |%List|) |bfStruct|))
(DEFUN |bfStruct| (|name| |arglist|)
- (|bfTuple| (LET ((|bfVar#121| NIL) (|bfVar#120| |arglist|) (|i| NIL))
+ (|bfTuple| (LET ((|bfVar#119| NIL) (|bfVar#118| |arglist|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#120|)
- (PROGN (SETQ |i| (CAR |bfVar#120|)) NIL))
- (RETURN (NREVERSE |bfVar#121|)))
+ ((OR (ATOM |bfVar#118|)
+ (PROGN (SETQ |i| (CAR |bfVar#118|)) NIL))
+ (RETURN (NREVERSE |bfVar#119|)))
('T
- (SETQ |bfVar#121|
- (CONS (|bfCreateDef| |i|) |bfVar#121|))))
- (SETQ |bfVar#120| (CDR |bfVar#120|))))))
+ (SETQ |bfVar#119|
+ (CONS (|bfCreateDef| |i|) |bfVar#119|))))
+ (SETQ |bfVar#118| (CDR |bfVar#118|))))))
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfCreateDef|))
@@ -2073,17 +2068,17 @@
(LIST 'DEFCONSTANT |f| (LIST 'LIST (LIST 'QUOTE |f|))))
('T
(SETQ |a|
- (LET ((|bfVar#123| NIL) (|bfVar#122| (CDR |x|))
+ (LET ((|bfVar#121| NIL) (|bfVar#120| (CDR |x|))
(|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#122|)
- (PROGN (SETQ |i| (CAR |bfVar#122|)) NIL))
- (RETURN (NREVERSE |bfVar#123|)))
+ ((OR (ATOM |bfVar#120|)
+ (PROGN (SETQ |i| (CAR |bfVar#120|)) NIL))
+ (RETURN (NREVERSE |bfVar#121|)))
('T
- (SETQ |bfVar#123|
- (CONS (|bfGenSymbol|) |bfVar#123|))))
- (SETQ |bfVar#122| (CDR |bfVar#122|)))))
+ (SETQ |bfVar#121|
+ (CONS (|bfGenSymbol|) |bfVar#121|))))
+ (SETQ |bfVar#120| (CDR |bfVar#120|)))))
(LIST 'DEFUN (CAR |x|) |a|
(LIST 'CONS (LIST 'QUOTE (CAR |x|)) (CONS 'LIST |a|))))))))
@@ -2094,38 +2089,43 @@
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing|) |%List|) |bfCase|))
(DEFUN |bfCase| (|x| |y|)
- (PROG (|c| |b| |a| |g1| |g|)
+ (PROG (|body| |inits| |g1| |a| |g|)
(RETURN
(PROGN
- (SETQ |g| (|bfGenSymbol|))
+ (SETQ |g| (COND ((ATOM |x|) |x|) (#0='T (|bfGenSymbol|))))
+ (SETQ |a|
+ (COND ((EQ |g| |x|) NIL) (#0# (LIST (LIST |g| |x|)))))
(SETQ |g1| (|bfGenSymbol|))
- (SETQ |a| (|bfLET| |g| |x|))
- (SETQ |b| (|bfLET| |g1| (LIST 'CDR |g|)))
- (SETQ |c| (|bfCaseItems| |g1| |y|))
- (|bfMKPROGN|
- (LIST |a| |b| (CONS 'CASE (CONS (LIST 'CAR |g|) |c|))))))))
+ (SETQ |inits|
+ (APPEND |a| (CONS (LIST |g1| (LIST 'CDR |g|)) NIL)))
+ (SETQ |body|
+ (CONS 'CASE
+ (CONS (LIST 'CAR |g|) (|bfCaseItems| |g1| |y|))))
+ (COND
+ ((EQL (LENGTH |inits|) 1) (LIST 'LET |inits| |body|))
+ (#0# (LIST 'LET* |inits| |body|)))))))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List|) |%List|) |bfCaseItems|))
(DEFUN |bfCaseItems| (|g| |x|)
(PROG (|j| |ISTMP#1| |i|)
(RETURN
- (LET ((|bfVar#126| NIL) (|bfVar#125| |x|) (|bfVar#124| NIL))
+ (LET ((|bfVar#124| NIL) (|bfVar#123| |x|) (|bfVar#122| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#125|)
- (PROGN (SETQ |bfVar#124| (CAR |bfVar#125|)) NIL))
- (RETURN (NREVERSE |bfVar#126|)))
+ ((OR (ATOM |bfVar#123|)
+ (PROGN (SETQ |bfVar#122| (CAR |bfVar#123|)) NIL))
+ (RETURN (NREVERSE |bfVar#124|)))
('T
- (AND (CONSP |bfVar#124|)
+ (AND (CONSP |bfVar#122|)
(PROGN
- (SETQ |i| (CAR |bfVar#124|))
- (SETQ |ISTMP#1| (CDR |bfVar#124|))
+ (SETQ |i| (CAR |bfVar#122|))
+ (SETQ |ISTMP#1| (CDR |bfVar#122|))
(AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
(PROGN (SETQ |j| (CAR |ISTMP#1|)) 'T)))
- (SETQ |bfVar#126|
- (CONS (|bfCI| |g| |i| |j|) |bfVar#126|)))))
- (SETQ |bfVar#125| (CDR |bfVar#125|)))))))
+ (SETQ |bfVar#124|
+ (CONS (|bfCI| |g| |i| |j|) |bfVar#124|)))))
+ (SETQ |bfVar#123| (CDR |bfVar#123|)))))))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%List|) |bfCI|))
@@ -2138,20 +2138,20 @@
((NULL |a|) (LIST (CAR |x|) |y|))
('T
(SETQ |b|
- (LET ((|bfVar#128| NIL) (|bfVar#127| |a|) (|i| NIL)
+ (LET ((|bfVar#126| NIL) (|bfVar#125| |a|) (|i| NIL)
(|j| 0))
(LOOP
(COND
- ((OR (ATOM |bfVar#127|)
- (PROGN (SETQ |i| (CAR |bfVar#127|)) NIL))
- (RETURN (NREVERSE |bfVar#128|)))
+ ((OR (ATOM |bfVar#125|)
+ (PROGN (SETQ |i| (CAR |bfVar#125|)) NIL))
+ (RETURN (NREVERSE |bfVar#126|)))
('T
(AND (NOT (EQ |i| 'DOT))
- (SETQ |bfVar#128|
+ (SETQ |bfVar#126|
(CONS
(LIST |i| (|bfCARCDR| |j| |g|))
- |bfVar#128|)))))
- (SETQ |bfVar#127| (CDR |bfVar#127|))
+ |bfVar#126|)))))
+ (SETQ |bfVar#125| (CDR |bfVar#125|))
(SETQ |j| (+ |j| 1)))))
(COND
((NULL |b|) (LIST (CAR |x|) |y|))
@@ -2170,23 +2170,19 @@
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List|) |%Thing|) |bfTry|))
(DEFUN |bfTry| (|e| |cs|)
- (PROG (|bfVar#130| |bfVar#129|)
- (RETURN
- (COND
- ((NULL |cs|) |e|)
- (#0='T
- (PROGN
- (SETQ |bfVar#129| (CAR |cs|))
- (SETQ |bfVar#130| (CDR |bfVar#129|))
- (CASE (CAR |bfVar#129|)
- (|%Catch|
- (LET ((|tag| (CAR |bfVar#130|)))
- (COND
- ((ATOM |tag|)
- (|bfTry| (LIST 'CATCH (LIST 'QUOTE |tag|) |e|)
- (CDR |cs|)))
- (#0# (|bpTrap|)))))
- (T (|bpTrap|)))))))))
+ (COND
+ ((NULL |cs|) |e|)
+ (#0='T
+ (LET* ((|bfVar#127| (CAR |cs|)) (|bfVar#128| (CDR |bfVar#127|)))
+ (CASE (CAR |bfVar#127|)
+ (|%Catch|
+ (LET ((|tag| (CAR |bfVar#128|)))
+ (COND
+ ((ATOM |tag|)
+ (|bfTry| (LIST 'CATCH (LIST 'QUOTE |tag|) |e|)
+ (CDR |cs|)))
+ (#0# (|bpTrap|)))))
+ (T (|bpTrap|)))))))
(DEFUN |bfThrow| (|e|)
(COND
@@ -2201,16 +2197,16 @@
(COND ((MEMBER |form| |params|) |form|) (#0='T (|quote| |form|))))
(#0#
(CONS 'LIST
- (LET ((|bfVar#132| NIL) (|bfVar#131| |form|) (|t| NIL))
+ (LET ((|bfVar#130| NIL) (|bfVar#129| |form|) (|t| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#131|)
- (PROGN (SETQ |t| (CAR |bfVar#131|)) NIL))
- (RETURN (NREVERSE |bfVar#132|)))
+ ((OR (ATOM |bfVar#129|)
+ (PROGN (SETQ |t| (CAR |bfVar#129|)) NIL))
+ (RETURN (NREVERSE |bfVar#130|)))
('T
- (SETQ |bfVar#132|
- (CONS (|backquote| |t| |params|) |bfVar#132|))))
- (SETQ |bfVar#131| (CDR |bfVar#131|))))))))
+ (SETQ |bfVar#130|
+ (CONS (|backquote| |t| |params|) |bfVar#130|))))
+ (SETQ |bfVar#129| (CDR |bfVar#129|))))))))
(DEFUN |genTypeAlias| (|head| |body|)
(PROG (|args| |op|)
@@ -2408,52 +2404,52 @@
(RETURN
(PROGN
(SETQ |argtypes|
- (LET ((|bfVar#134| NIL) (|bfVar#133| |s|) (|x| NIL))
+ (LET ((|bfVar#132| NIL) (|bfVar#131| |s|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#133|)
- (PROGN (SETQ |x| (CAR |bfVar#133|)) NIL))
- (RETURN (NREVERSE |bfVar#134|)))
+ ((OR (ATOM |bfVar#131|)
+ (PROGN (SETQ |x| (CAR |bfVar#131|)) NIL))
+ (RETURN (NREVERSE |bfVar#132|)))
(#0='T
- (SETQ |bfVar#134|
+ (SETQ |bfVar#132|
(CONS (|nativeArgumentType| |x|)
- |bfVar#134|))))
- (SETQ |bfVar#133| (CDR |bfVar#133|)))))
+ |bfVar#132|))))
+ (SETQ |bfVar#131| (CDR |bfVar#131|)))))
(SETQ |rettype| (|nativeReturnType| |t|))
(COND
- ((LET ((|bfVar#136| T) (|bfVar#135| (CONS |t| |s|))
+ ((LET ((|bfVar#134| T) (|bfVar#133| (CONS |t| |s|))
(|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#135|)
- (PROGN (SETQ |x| (CAR |bfVar#135|)) NIL))
- (RETURN |bfVar#136|))
+ ((OR (ATOM |bfVar#133|)
+ (PROGN (SETQ |x| (CAR |bfVar#133|)) NIL))
+ (RETURN |bfVar#134|))
(#0#
(PROGN
- (SETQ |bfVar#136| (|isSimpleNativeType| |x|))
- (COND ((NOT |bfVar#136|) (RETURN NIL))))))
- (SETQ |bfVar#135| (CDR |bfVar#135|))))
+ (SETQ |bfVar#134| (|isSimpleNativeType| |x|))
+ (COND ((NOT |bfVar#134|) (RETURN NIL))))))
+ (SETQ |bfVar#133| (CDR |bfVar#133|))))
(LIST (LIST 'DEFENTRY |op| |argtypes|
(LIST |rettype| (SYMBOL-NAME |op'|)))))
(#1='T
(PROGN
(SETQ |cop| (CONCAT (SYMBOL-NAME |op'|) "_stub"))
(SETQ |cargs|
- (LET ((|bfVar#143| NIL)
- (|bfVar#142| (- (LENGTH |s|) 1)) (|i| 0))
+ (LET ((|bfVar#141| NIL)
+ (|bfVar#140| (- (LENGTH |s|) 1)) (|i| 0))
(LOOP
(COND
- ((> |i| |bfVar#142|)
- (RETURN (NREVERSE |bfVar#143|)))
+ ((> |i| |bfVar#140|)
+ (RETURN (NREVERSE |bfVar#141|)))
(#0#
- (SETQ |bfVar#143|
+ (SETQ |bfVar#141|
(CONS (|genGCLnativeTranslation,mkCArgName|
|i|)
- |bfVar#143|))))
+ |bfVar#141|))))
(SETQ |i| (+ |i| 1)))))
(SETQ |ccode|
- (LET ((|bfVar#139| "")
- (|bfVar#141|
+ (LET ((|bfVar#137| "")
+ (|bfVar#139|
(CONS (|genGCLnativeTranslation,gclTypeInC|
|t|)
(CONS " "
@@ -2461,20 +2457,20 @@
(CONS "("
(APPEND
(LET
- ((|bfVar#137| NIL) (|x| |s|)
+ ((|bfVar#135| NIL) (|x| |s|)
(|a| |cargs|))
(LOOP
(COND
((OR (ATOM |x|)
(ATOM |a|))
(RETURN
- (NREVERSE |bfVar#137|)))
+ (NREVERSE |bfVar#135|)))
(#0#
- (SETQ |bfVar#137|
+ (SETQ |bfVar#135|
(CONS
(|genGCLnativeTranslation,cparm|
|x| |a|)
- |bfVar#137|))))
+ |bfVar#135|))))
(SETQ |x| (CDR |x|))
(SETQ |a| (CDR |a|))))
(CONS ") { "
@@ -2487,7 +2483,7 @@
(CONS "("
(APPEND
(LET
- ((|bfVar#138| NIL)
+ ((|bfVar#136| NIL)
(|x| |s|) (|a| |cargs|))
(LOOP
(COND
@@ -2495,28 +2491,28 @@
(ATOM |a|))
(RETURN
(NREVERSE
- |bfVar#138|)))
+ |bfVar#136|)))
(#0#
- (SETQ |bfVar#138|
+ (SETQ |bfVar#136|
(CONS
(|genGCLnativeTranslation,gclArgsInC|
|x| |a|)
- |bfVar#138|))))
+ |bfVar#136|))))
(SETQ |x| (CDR |x|))
(SETQ |a| (CDR |a|))))
(CONS "); }" NIL))))))))))))
- (|bfVar#140| NIL))
+ (|bfVar#138| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#141|)
+ ((OR (ATOM |bfVar#139|)
(PROGN
- (SETQ |bfVar#140| (CAR |bfVar#141|))
+ (SETQ |bfVar#138| (CAR |bfVar#139|))
NIL))
- (RETURN |bfVar#139|))
+ (RETURN |bfVar#137|))
(#0#
- (SETQ |bfVar#139|
- (CONCAT |bfVar#139| |bfVar#140|))))
- (SETQ |bfVar#141| (CDR |bfVar#141|)))))
+ (SETQ |bfVar#137|
+ (CONCAT |bfVar#137| |bfVar#138|))))
+ (SETQ |bfVar#139| (CDR |bfVar#139|)))))
(LIST (LIST 'CLINES |ccode|)
(LIST 'DEFENTRY |op| |argtypes|
(LIST |rettype| |cop|))))))))))
@@ -2579,18 +2575,18 @@
(PROGN
(SETQ |args| NIL)
(SETQ |argtypes| NIL)
- (LET ((|bfVar#144| |s|) (|x| NIL))
+ (LET ((|bfVar#142| |s|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#144|)
- (PROGN (SETQ |x| (CAR |bfVar#144|)) NIL))
+ ((OR (ATOM |bfVar#142|)
+ (PROGN (SETQ |x| (CAR |bfVar#142|)) NIL))
(RETURN NIL))
('T
(PROGN
(SETQ |argtypes|
(CONS (|nativeArgumentType| |x|) |argtypes|))
(SETQ |args| (CONS (GENSYM) |args|)))))
- (SETQ |bfVar#144| (CDR |bfVar#144|))))
+ (SETQ |bfVar#142| (CDR |bfVar#142|))))
(SETQ |args| (REVERSE |args|))
(SETQ |rettype| (|nativeReturnType| |t|))
(LIST (LIST 'DEFUN |op| |args|
@@ -2601,39 +2597,39 @@
:ONE-LINER T)))))))
(DEFUN |genECLnativeTranslation,callTemplate| (|op| |n| |s|)
- (LET ((|bfVar#148| "")
- (|bfVar#150|
+ (LET ((|bfVar#146| "")
+ (|bfVar#148|
(CONS (SYMBOL-NAME |op|)
(CONS "("
- (APPEND (LET ((|bfVar#147| NIL)
- (|bfVar#145| (- |n| 1)) (|i| 0)
- (|bfVar#146| |s|) (|x| NIL))
+ (APPEND (LET ((|bfVar#145| NIL)
+ (|bfVar#143| (- |n| 1)) (|i| 0)
+ (|bfVar#144| |s|) (|x| NIL))
(LOOP
(COND
- ((OR (> |i| |bfVar#145|)
- (ATOM |bfVar#146|)
+ ((OR (> |i| |bfVar#143|)
+ (ATOM |bfVar#144|)
(PROGN
- (SETQ |x| (CAR |bfVar#146|))
+ (SETQ |x| (CAR |bfVar#144|))
NIL))
- (RETURN (NREVERSE |bfVar#147|)))
+ (RETURN (NREVERSE |bfVar#145|)))
(#0='T
- (SETQ |bfVar#147|
+ (SETQ |bfVar#145|
(CONS
(|genECLnativeTranslation,sharpArg|
|i| |x|)
- |bfVar#147|))))
+ |bfVar#145|))))
(SETQ |i| (+ |i| 1))
- (SETQ |bfVar#146|
- (CDR |bfVar#146|))))
+ (SETQ |bfVar#144|
+ (CDR |bfVar#144|))))
(CONS ")" NIL)))))
- (|bfVar#149| NIL))
+ (|bfVar#147| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#150|)
- (PROGN (SETQ |bfVar#149| (CAR |bfVar#150|)) NIL))
- (RETURN |bfVar#148|))
- (#0# (SETQ |bfVar#148| (CONCAT |bfVar#148| |bfVar#149|))))
- (SETQ |bfVar#150| (CDR |bfVar#150|)))))
+ ((OR (ATOM |bfVar#148|)
+ (PROGN (SETQ |bfVar#147| (CAR |bfVar#148|)) NIL))
+ (RETURN |bfVar#146|))
+ (#0# (SETQ |bfVar#146| (CONCAT |bfVar#146| |bfVar#147|))))
+ (SETQ |bfVar#148| (CDR |bfVar#148|)))))
(DEFUN |genECLnativeTranslation,sharpArg| (|i| |x|)
(COND
@@ -2678,40 +2674,40 @@
(PROGN
(SETQ |rettype| (|nativeReturnType| |t|))
(SETQ |argtypes|
- (LET ((|bfVar#152| NIL) (|bfVar#151| |s|) (|x| NIL))
+ (LET ((|bfVar#150| NIL) (|bfVar#149| |s|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#151|)
- (PROGN (SETQ |x| (CAR |bfVar#151|)) NIL))
- (RETURN (NREVERSE |bfVar#152|)))
+ ((OR (ATOM |bfVar#149|)
+ (PROGN (SETQ |x| (CAR |bfVar#149|)) NIL))
+ (RETURN (NREVERSE |bfVar#150|)))
(#0='T
- (SETQ |bfVar#152|
+ (SETQ |bfVar#150|
(CONS (|nativeArgumentType| |x|)
- |bfVar#152|))))
- (SETQ |bfVar#151| (CDR |bfVar#151|)))))
+ |bfVar#150|))))
+ (SETQ |bfVar#149| (CDR |bfVar#149|)))))
(SETQ |n| (INTERN (CONCAT (SYMBOL-NAME |op|) "%clisp-hack")))
(SETQ |parms|
- (LET ((|bfVar#154| NIL) (|bfVar#153| |s|) (|x| NIL))
+ (LET ((|bfVar#152| NIL) (|bfVar#151| |s|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#153|)
- (PROGN (SETQ |x| (CAR |bfVar#153|)) NIL))
- (RETURN (NREVERSE |bfVar#154|)))
+ ((OR (ATOM |bfVar#151|)
+ (PROGN (SETQ |x| (CAR |bfVar#151|)) NIL))
+ (RETURN (NREVERSE |bfVar#152|)))
(#0#
- (SETQ |bfVar#154|
- (CONS (GENSYM "parm") |bfVar#154|))))
- (SETQ |bfVar#153| (CDR |bfVar#153|)))))
+ (SETQ |bfVar#152|
+ (CONS (GENSYM "parm") |bfVar#152|))))
+ (SETQ |bfVar#151| (CDR |bfVar#151|)))))
(SETQ |unstableArgs| NIL)
- (LET ((|bfVar#155| |parms|) (|p| NIL) (|bfVar#156| |s|)
- (|x| NIL) (|bfVar#157| |argtypes|) (|y| NIL))
+ (LET ((|bfVar#153| |parms|) (|p| NIL) (|bfVar#154| |s|)
+ (|x| NIL) (|bfVar#155| |argtypes|) (|y| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#155|)
- (PROGN (SETQ |p| (CAR |bfVar#155|)) NIL)
- (ATOM |bfVar#156|)
- (PROGN (SETQ |x| (CAR |bfVar#156|)) NIL)
- (ATOM |bfVar#157|)
- (PROGN (SETQ |y| (CAR |bfVar#157|)) NIL))
+ ((OR (ATOM |bfVar#153|)
+ (PROGN (SETQ |p| (CAR |bfVar#153|)) NIL)
+ (ATOM |bfVar#154|)
+ (PROGN (SETQ |x| (CAR |bfVar#154|)) NIL)
+ (ATOM |bfVar#155|)
+ (PROGN (SETQ |y| (CAR |bfVar#155|)) NIL))
(RETURN NIL))
(#0#
(COND
@@ -2720,33 +2716,33 @@
(SETQ |unstableArgs|
(CONS (CONS |p| (CONS |x| |y|))
|unstableArgs|)))))))
- (SETQ |bfVar#155| (CDR |bfVar#155|))
- (SETQ |bfVar#156| (CDR |bfVar#156|))
- (SETQ |bfVar#157| (CDR |bfVar#157|))))
+ (SETQ |bfVar#153| (CDR |bfVar#153|))
+ (SETQ |bfVar#154| (CDR |bfVar#154|))
+ (SETQ |bfVar#155| (CDR |bfVar#155|))))
(SETQ |foreignDecl|
(LIST (|bfColonColon| 'FFI 'DEF-CALL-OUT) |n|
(LIST :NAME (SYMBOL-NAME |op'|))
(CONS :ARGUMENTS
- (LET ((|bfVar#160| NIL)
- (|bfVar#158| |argtypes|) (|x| NIL)
- (|bfVar#159| |parms|) (|a| NIL))
+ (LET ((|bfVar#158| NIL)
+ (|bfVar#156| |argtypes|) (|x| NIL)
+ (|bfVar#157| |parms|) (|a| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#158|)
+ ((OR (ATOM |bfVar#156|)
(PROGN
- (SETQ |x| (CAR |bfVar#158|))
+ (SETQ |x| (CAR |bfVar#156|))
NIL)
- (ATOM |bfVar#159|)
+ (ATOM |bfVar#157|)
(PROGN
- (SETQ |a| (CAR |bfVar#159|))
+ (SETQ |a| (CAR |bfVar#157|))
NIL))
- (RETURN (NREVERSE |bfVar#160|)))
+ (RETURN (NREVERSE |bfVar#158|)))
(#0#
- (SETQ |bfVar#160|
+ (SETQ |bfVar#158|
(CONS (LIST |a| |x|)
- |bfVar#160|))))
- (SETQ |bfVar#158| (CDR |bfVar#158|))
- (SETQ |bfVar#159| (CDR |bfVar#159|)))))
+ |bfVar#158|))))
+ (SETQ |bfVar#156| (CDR |bfVar#156|))
+ (SETQ |bfVar#157| (CDR |bfVar#157|)))))
(LIST :RETURN-TYPE |rettype|)
(LIST :LANGUAGE :STDC)))
(SETQ |forwardingFun|
@@ -2756,67 +2752,67 @@
(#1='T
(PROGN
(SETQ |localPairs|
- (LET ((|bfVar#163| NIL)
- (|bfVar#162| |unstableArgs|)
- (|bfVar#161| NIL))
+ (LET ((|bfVar#161| NIL)
+ (|bfVar#160| |unstableArgs|)
+ (|bfVar#159| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#162|)
+ ((OR (ATOM |bfVar#160|)
(PROGN
- (SETQ |bfVar#161|
- (CAR |bfVar#162|))
+ (SETQ |bfVar#159|
+ (CAR |bfVar#160|))
NIL))
- (RETURN (NREVERSE |bfVar#163|)))
+ (RETURN (NREVERSE |bfVar#161|)))
(#0#
- (AND (CONSP |bfVar#161|)
+ (AND (CONSP |bfVar#159|)
(PROGN
- (SETQ |a| (CAR |bfVar#161|))
+ (SETQ |a| (CAR |bfVar#159|))
(SETQ |ISTMP#1|
- (CDR |bfVar#161|))
+ (CDR |bfVar#159|))
(AND (CONSP |ISTMP#1|)
(PROGN
(SETQ |x| (CAR |ISTMP#1|))
(SETQ |y| (CDR |ISTMP#1|))
#2='T)))
- (SETQ |bfVar#163|
+ (SETQ |bfVar#161|
(CONS
(CONS |a|
(CONS |x|
(CONS |y| (GENSYM "loc"))))
- |bfVar#163|)))))
- (SETQ |bfVar#162| (CDR |bfVar#162|)))))
+ |bfVar#161|)))))
+ (SETQ |bfVar#160| (CDR |bfVar#160|)))))
(SETQ |call|
(CONS |n|
- (LET ((|bfVar#165| NIL)
- (|bfVar#164| |parms|) (|p| NIL))
+ (LET ((|bfVar#163| NIL)
+ (|bfVar#162| |parms|) (|p| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#164|)
+ ((OR (ATOM |bfVar#162|)
(PROGN
- (SETQ |p| (CAR |bfVar#164|))
+ (SETQ |p| (CAR |bfVar#162|))
NIL))
- (RETURN (NREVERSE |bfVar#165|)))
+ (RETURN (NREVERSE |bfVar#163|)))
(#0#
- (SETQ |bfVar#165|
+ (SETQ |bfVar#163|
(CONS
(|genCLISPnativeTranslation,actualArg|
|p| |localPairs|)
- |bfVar#165|))))
- (SETQ |bfVar#164| (CDR |bfVar#164|))))))
+ |bfVar#163|))))
+ (SETQ |bfVar#162| (CDR |bfVar#162|))))))
(SETQ |call|
(PROGN
(SETQ |fixups|
- (LET ((|bfVar#167| NIL)
- (|bfVar#166| |localPairs|)
+ (LET ((|bfVar#165| NIL)
+ (|bfVar#164| |localPairs|)
(|p| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#166|)
+ ((OR (ATOM |bfVar#164|)
(PROGN
- (SETQ |p| (CAR |bfVar#166|))
+ (SETQ |p| (CAR |bfVar#164|))
NIL))
(RETURN
- (NREVERSE |bfVar#167|)))
+ (NREVERSE |bfVar#165|)))
(#0#
(AND
(NOT
@@ -2824,28 +2820,28 @@
(SETQ |q|
(|genCLISPnativeTranslation,copyBack|
|p|))))
- (SETQ |bfVar#167|
- (CONS |q| |bfVar#167|)))))
- (SETQ |bfVar#166|
- (CDR |bfVar#166|)))))
+ (SETQ |bfVar#165|
+ (CONS |q| |bfVar#165|)))))
+ (SETQ |bfVar#164|
+ (CDR |bfVar#164|)))))
(COND
((NULL |fixups|) (LIST |call|))
(#1#
(LIST (CONS 'PROG1
(CONS |call| |fixups|)))))))
- (LET ((|bfVar#169| |localPairs|) (|bfVar#168| NIL))
+ (LET ((|bfVar#167| |localPairs|) (|bfVar#166| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#169|)
+ ((OR (ATOM |bfVar#167|)
(PROGN
- (SETQ |bfVar#168| (CAR |bfVar#169|))
+ (SETQ |bfVar#166| (CAR |bfVar#167|))
NIL))
(RETURN NIL))
(#0#
- (AND (CONSP |bfVar#168|)
+ (AND (CONSP |bfVar#166|)
(PROGN
- (SETQ |p| (CAR |bfVar#168|))
- (SETQ |ISTMP#1| (CDR |bfVar#168|))
+ (SETQ |p| (CAR |bfVar#166|))
+ (SETQ |ISTMP#1| (CDR |bfVar#166|))
(AND (CONSP |ISTMP#1|)
(PROGN
(SETQ |x| (CAR |ISTMP#1|))
@@ -2869,18 +2865,18 @@
|p|)
|p|)
|call|)))))))
- (SETQ |bfVar#169| (CDR |bfVar#169|))))
+ (SETQ |bfVar#167| (CDR |bfVar#167|))))
(CONS 'DEFUN (CONS |op| (CONS |parms| |call|)))))))
(SETQ |$foreignsDefsForCLisp|
(CONS |foreignDecl| |$foreignsDefsForCLisp|))
(LIST |forwardingFun|)))))
-(DEFUN |genCLISPnativeTranslation,copyBack| (|bfVar#170|)
+(DEFUN |genCLISPnativeTranslation,copyBack| (|bfVar#168|)
(PROG (|a| |y| |x| |p|)
(RETURN
(PROGN
- (SETQ |p| (CAR |bfVar#170|))
- (SETQ |x| (CADR . #0=(|bfVar#170|)))
+ (SETQ |p| (CAR |bfVar#168|))
+ (SETQ |x| (CADR . #0=(|bfVar#168|)))
(SETQ |y| (CADDR . #0#))
(SETQ |a| (CDDDR . #0#))
(COND
@@ -2905,37 +2901,37 @@
(PROGN
(SETQ |rettype| (|nativeReturnType| |t|))
(SETQ |argtypes|
- (LET ((|bfVar#172| NIL) (|bfVar#171| |s|) (|x| NIL))
+ (LET ((|bfVar#170| NIL) (|bfVar#169| |s|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#171|)
- (PROGN (SETQ |x| (CAR |bfVar#171|)) NIL))
- (RETURN (NREVERSE |bfVar#172|)))
+ ((OR (ATOM |bfVar#169|)
+ (PROGN (SETQ |x| (CAR |bfVar#169|)) NIL))
+ (RETURN (NREVERSE |bfVar#170|)))
(#0='T
- (SETQ |bfVar#172|
+ (SETQ |bfVar#170|
(CONS (|nativeArgumentType| |x|)
- |bfVar#172|))))
- (SETQ |bfVar#171| (CDR |bfVar#171|)))))
+ |bfVar#170|))))
+ (SETQ |bfVar#169| (CDR |bfVar#169|)))))
(SETQ |args|
- (LET ((|bfVar#174| NIL) (|bfVar#173| |s|) (|x| NIL))
+ (LET ((|bfVar#172| NIL) (|bfVar#171| |s|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#173|)
- (PROGN (SETQ |x| (CAR |bfVar#173|)) NIL))
- (RETURN (NREVERSE |bfVar#174|)))
+ ((OR (ATOM |bfVar#171|)
+ (PROGN (SETQ |x| (CAR |bfVar#171|)) NIL))
+ (RETURN (NREVERSE |bfVar#172|)))
(#0#
- (SETQ |bfVar#174| (CONS (GENSYM) |bfVar#174|))))
- (SETQ |bfVar#173| (CDR |bfVar#173|)))))
+ (SETQ |bfVar#172| (CONS (GENSYM) |bfVar#172|))))
+ (SETQ |bfVar#171| (CDR |bfVar#171|)))))
(SETQ |unstableArgs| NIL)
(SETQ |newArgs| NIL)
- (LET ((|bfVar#175| |args|) (|a| NIL) (|bfVar#176| |s|)
+ (LET ((|bfVar#173| |args|) (|a| NIL) (|bfVar#174| |s|)
(|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#175|)
- (PROGN (SETQ |a| (CAR |bfVar#175|)) NIL)
- (ATOM |bfVar#176|)
- (PROGN (SETQ |x| (CAR |bfVar#176|)) NIL))
+ ((OR (ATOM |bfVar#173|)
+ (PROGN (SETQ |a| (CAR |bfVar#173|)) NIL)
+ (ATOM |bfVar#174|)
+ (PROGN (SETQ |x| (CAR |bfVar#174|)) NIL))
(RETURN NIL))
(#0#
(PROGN
@@ -2944,8 +2940,8 @@
(COND
((|needsStableReference?| |x|)
(SETQ |unstableArgs| (CONS |a| |unstableArgs|)))))))
- (SETQ |bfVar#175| (CDR |bfVar#175|))
- (SETQ |bfVar#176| (CDR |bfVar#176|))))
+ (SETQ |bfVar#173| (CDR |bfVar#173|))
+ (SETQ |bfVar#174| (CDR |bfVar#174|))))
(SETQ |op'|
(COND
((|%hasFeature| :WIN32)
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 593ad5cb..056fe0ec 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -557,16 +557,12 @@
('T (LIST 'DECLAIM (LIST 'TYPE |t| |n|)))))))
(DEFUN |translateSignatureDeclaration| (|d|)
- (PROG (|bfVar#10| |bfVar#9|)
- (RETURN
- (PROGN
- (SETQ |bfVar#9| |d|)
- (SETQ |bfVar#10| (CDR |bfVar#9|))
- (CASE (CAR |bfVar#9|)
- (|%Signature|
- (LET ((|n| (CAR |bfVar#10|)) (|t| (CADR |bfVar#10|)))
- (|genDeclaration| |n| |t|)))
- (T (|coreError| "signature expected")))))))
+ (LET ((|bfVar#9| (CDR |d|)))
+ (CASE (CAR |d|)
+ (|%Signature|
+ (LET ((|n| (CAR |bfVar#9|)) (|t| (CADR |bfVar#9|)))
+ (|genDeclaration| |n| |t|)))
+ (T (|coreError| "signature expected")))))
(DEFUN |translateToplevelExpression| (|expr|)
(PROG (|expr'|)
@@ -576,17 +572,17 @@
(SETQ |expr'|
(CDR (CDR (|shoeCompTran|
(LIST 'LAMBDA (LIST '|x|) |expr|)))))
- (LET ((|bfVar#11| |expr'|) (|t| NIL))
+ (LET ((|bfVar#10| |expr'|) (|t| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#11|)
- (PROGN (SETQ |t| (CAR |bfVar#11|)) NIL))
+ ((OR (ATOM |bfVar#10|)
+ (PROGN (SETQ |t| (CAR |bfVar#10|)) NIL))
(RETURN NIL))
('T
(COND
((AND (CONSP |t|) (EQ (CAR |t|) 'DECLARE))
(IDENTITY (RPLACA |t| 'DECLAIM))))))
- (SETQ |bfVar#11| (CDR |bfVar#11|))))
+ (SETQ |bfVar#10| (CDR |bfVar#10|))))
(SETQ |expr'|
(COND
((< 1 (LENGTH |expr'|)) (CONS 'PROGN |expr'|))
@@ -599,8 +595,7 @@
(COND (|export?| |d|) ('T |d|)))
(DEFUN |translateToplevel| (|b| |export?|)
- (PROG (|lhs| |t| |ISTMP#2| |n| |ISTMP#1| |sig| |bfVar#17| |bfVar#16|
- |xs|)
+ (PROG (|lhs| |t| |ISTMP#2| |n| |ISTMP#1| |sig| |xs|)
(DECLARE (SPECIAL |$activeNamespace| |$InteractiveMode|
|$foreignsDefsForCLisp| |$currentModuleName|))
(RETURN
@@ -608,50 +603,48 @@
((ATOM |b|) (LIST |b|))
((AND (CONSP |b|) (EQ (CAR |b|) 'TUPLE)
(PROGN (SETQ |xs| (CDR |b|)) #0='T))
- (LET ((|bfVar#13| NIL) (|bfVar#12| |xs|) (|x| NIL))
+ (LET ((|bfVar#12| NIL) (|bfVar#11| |xs|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#12|)
- (PROGN (SETQ |x| (CAR |bfVar#12|)) NIL))
- (RETURN (NREVERSE |bfVar#13|)))
+ ((OR (ATOM |bfVar#11|)
+ (PROGN (SETQ |x| (CAR |bfVar#11|)) NIL))
+ (RETURN (NREVERSE |bfVar#12|)))
(#1='T
- (SETQ |bfVar#13|
+ (SETQ |bfVar#12|
(CONS (|maybeExportDecl| |x| |export?|)
- |bfVar#13|))))
- (SETQ |bfVar#12| (CDR |bfVar#12|)))))
+ |bfVar#12|))))
+ (SETQ |bfVar#11| (CDR |bfVar#11|)))))
(#2='T
- (PROGN
- (SETQ |bfVar#16| |b|)
- (SETQ |bfVar#17| (CDR |bfVar#16|))
- (CASE (CAR |bfVar#16|)
+ (LET ((|bfVar#15| (CDR |b|)))
+ (CASE (CAR |b|)
(|%Signature|
- (LET ((|op| (CAR |bfVar#17|)) (|t| (CADR |bfVar#17|)))
+ (LET ((|op| (CAR |bfVar#15|)) (|t| (CADR |bfVar#15|)))
(LIST (|maybeExportDecl| (|genDeclaration| |op| |t|)
|export?|))))
(|%Module|
- (LET ((|m| (CAR |bfVar#17|)) (|ds| (CADR |bfVar#17|)))
+ (LET ((|m| (CAR |bfVar#15|)) (|ds| (CADR |bfVar#15|)))
(PROGN
(SETQ |$currentModuleName| |m|)
(SETQ |$foreignsDefsForCLisp| NIL)
(CONS (LIST 'PROVIDE (STRING |m|))
- (LET ((|bfVar#15| NIL) (|bfVar#14| |ds|)
+ (LET ((|bfVar#14| NIL) (|bfVar#13| |ds|)
(|d| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#14|)
+ ((OR (ATOM |bfVar#13|)
(PROGN
- (SETQ |d| (CAR |bfVar#14|))
+ (SETQ |d| (CAR |bfVar#13|))
NIL))
- (RETURN (NREVERSE |bfVar#15|)))
+ (RETURN (NREVERSE |bfVar#14|)))
(#1#
- (SETQ |bfVar#15|
+ (SETQ |bfVar#14|
(CONS
(CAR
(|translateToplevel| |d| T))
- |bfVar#15|))))
- (SETQ |bfVar#14| (CDR |bfVar#14|))))))))
+ |bfVar#14|))))
+ (SETQ |bfVar#13| (CDR |bfVar#13|))))))))
(|%Import|
- (LET ((|m| (CAR |bfVar#17|)))
+ (LET ((|m| (CAR |bfVar#15|)))
(PROGN
(COND
((NOT (EQUAL (|getOptionValue| '|import|)
@@ -659,17 +652,17 @@
(|bootImport| (STRING |m|))))
(LIST (LIST 'IMPORT-MODULE (STRING |m|))))))
(|%ImportSignature|
- (LET ((|x| (CAR |bfVar#17|))
- (|sig| (CADR |bfVar#17|)))
+ (LET ((|x| (CAR |bfVar#15|))
+ (|sig| (CADR |bfVar#15|)))
(|genImportDeclaration| |x| |sig|)))
(|%TypeAlias|
- (LET ((|lhs| (CAR |bfVar#17|))
- (|rhs| (CADR |bfVar#17|)))
+ (LET ((|lhs| (CAR |bfVar#15|))
+ (|rhs| (CADR |bfVar#15|)))
(LIST (|maybeExportDecl|
(|genTypeAlias| |lhs| |rhs|) |export?|))))
(|%ConstantDefinition|
- (LET ((|lhs| (CAR |bfVar#17|))
- (|rhs| (CADR |bfVar#17|)))
+ (LET ((|lhs| (CAR |bfVar#15|))
+ (|rhs| (CADR |bfVar#15|)))
(PROGN
(SETQ |sig| NIL)
(COND
@@ -694,8 +687,8 @@
(LIST 'DEFCONSTANT |lhs| |rhs|)
|export?|)))))
(|%Assignment|
- (LET ((|lhs| (CAR |bfVar#17|))
- (|rhs| (CADR |bfVar#17|)))
+ (LET ((|lhs| (CAR |bfVar#15|))
+ (|rhs| (CADR |bfVar#15|)))
(PROGN
(SETQ |sig| NIL)
(COND
@@ -724,7 +717,7 @@
(LIST 'DEFPARAMETER |lhs| |rhs|)
|export?|)))))))
(|%Namespace|
- (LET ((|n| (CAR |bfVar#17|)))
+ (LET ((|n| (CAR |bfVar#15|)))
(PROGN
(SETQ |$activeNamespace| (STRING |n|))
(LIST (LIST 'IN-PACKAGE (STRING |n|))))))
@@ -824,17 +817,17 @@
(PROGN
(|shoeFileLine| "DEFINED and not USED" |stream|)
(SETQ |a|
- (LET ((|bfVar#19| NIL)
- (|bfVar#18| (HKEYS |$bootDefined|)) (|i| NIL))
+ (LET ((|bfVar#17| NIL)
+ (|bfVar#16| (HKEYS |$bootDefined|)) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#18|)
- (PROGN (SETQ |i| (CAR |bfVar#18|)) NIL))
- (RETURN (NREVERSE |bfVar#19|)))
+ ((OR (ATOM |bfVar#16|)
+ (PROGN (SETQ |i| (CAR |bfVar#16|)) NIL))
+ (RETURN (NREVERSE |bfVar#17|)))
(#0='T
(AND (NOT (GETHASH |i| |$bootUsed|))
- (SETQ |bfVar#19| (CONS |i| |bfVar#19|)))))
- (SETQ |bfVar#18| (CDR |bfVar#18|)))))
+ (SETQ |bfVar#17| (CONS |i| |bfVar#17|)))))
+ (SETQ |bfVar#16| (CDR |bfVar#16|)))))
(|bootOut| (SSORT |a|) |stream|)
(|shoeFileLine| " " |stream|)
(|shoeFileLine| "DEFINED TWICE" |stream|)
@@ -842,29 +835,29 @@
(|shoeFileLine| " " |stream|)
(|shoeFileLine| "USED and not DEFINED" |stream|)
(SETQ |a|
- (LET ((|bfVar#21| NIL) (|bfVar#20| (HKEYS |$bootUsed|))
+ (LET ((|bfVar#19| NIL) (|bfVar#18| (HKEYS |$bootUsed|))
(|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#20|)
- (PROGN (SETQ |i| (CAR |bfVar#20|)) NIL))
- (RETURN (NREVERSE |bfVar#21|)))
+ ((OR (ATOM |bfVar#18|)
+ (PROGN (SETQ |i| (CAR |bfVar#18|)) NIL))
+ (RETURN (NREVERSE |bfVar#19|)))
(#0#
(AND (NOT (GETHASH |i| |$bootDefined|))
- (SETQ |bfVar#21| (CONS |i| |bfVar#21|)))))
- (SETQ |bfVar#20| (CDR |bfVar#20|)))))
- (LET ((|bfVar#22| (SSORT |a|)) (|i| NIL))
+ (SETQ |bfVar#19| (CONS |i| |bfVar#19|)))))
+ (SETQ |bfVar#18| (CDR |bfVar#18|)))))
+ (LET ((|bfVar#20| (SSORT |a|)) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#22|)
- (PROGN (SETQ |i| (CAR |bfVar#22|)) NIL))
+ ((OR (ATOM |bfVar#20|)
+ (PROGN (SETQ |i| (CAR |bfVar#20|)) NIL))
(RETURN NIL))
(#0#
(PROGN
(SETQ |b| (CONCAT (PNAME |i|) " is used in "))
(|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|))
|stream| |b|))))
- (SETQ |bfVar#22| (CDR |bfVar#22|))))))))
+ (SETQ |bfVar#20| (CDR |bfVar#20|))))))))
(DEFUN |shoeDefUse| (|s|)
(LOOP
@@ -960,16 +953,16 @@
(#1# (CONS |nee| |$bootDefinedTwice|)))))
('T (HPUT |$bootDefined| |nee| T)))
(|defuse1| |e| |niens|)
- (LET ((|bfVar#23| |$used|) (|i| NIL))
+ (LET ((|bfVar#21| |$used|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#23|)
- (PROGN (SETQ |i| (CAR |bfVar#23|)) NIL))
+ ((OR (ATOM |bfVar#21|)
+ (PROGN (SETQ |i| (CAR |bfVar#21|)) NIL))
(RETURN NIL))
('T
(HPUT |$bootUsed| |i|
(CONS |nee| (GETHASH |i| |$bootUsed|)))))
- (SETQ |bfVar#23| (CDR |bfVar#23|))))))))
+ (SETQ |bfVar#21| (CDR |bfVar#21|))))))))
(DEFUN |defuse1| (|e| |y|)
(PROG (|ndol| |dol| |LETTMP#1| |b| |a| |ISTMP#1|)
@@ -1007,14 +1000,14 @@
(SETQ |LETTMP#1| (|defSeparate| |a|))
(SETQ |dol| (CAR |LETTMP#1|))
(SETQ |ndol| (CADR |LETTMP#1|))
- (LET ((|bfVar#24| |dol|) (|i| NIL))
+ (LET ((|bfVar#22| |dol|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#24|)
- (PROGN (SETQ |i| (CAR |bfVar#24|)) NIL))
+ ((OR (ATOM |bfVar#22|)
+ (PROGN (SETQ |i| (CAR |bfVar#22|)) NIL))
(RETURN NIL))
(#2='T (HPUT |$bootDefined| |i| T)))
- (SETQ |bfVar#24| (CDR |bfVar#24|))))
+ (SETQ |bfVar#22| (CDR |bfVar#22|))))
(|defuse1| (APPEND |ndol| |e|) |b|)))
((AND (CONSP |y|) (EQ (CAR |y|) 'QUOTE)
(PROGN (SETQ |a| (CDR |y|)) #1#))
@@ -1023,14 +1016,14 @@
(PROGN (SETQ |a| (CDR |y|)) #1#))
NIL)
(#0#
- (LET ((|bfVar#25| |y|) (|i| NIL))
+ (LET ((|bfVar#23| |y|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#25|)
- (PROGN (SETQ |i| (CAR |bfVar#25|)) NIL))
+ ((OR (ATOM |bfVar#23|)
+ (PROGN (SETQ |i| (CAR |bfVar#23|)) NIL))
(RETURN NIL))
(#2# (|defuse1| |e| |i|)))
- (SETQ |bfVar#25| (CDR |bfVar#25|)))))))))
+ (SETQ |bfVar#23| (CDR |bfVar#23|)))))))))
(DEFUN |defSeparate| (|x|)
(PROG (|x2| |x1| |LETTMP#1| |f|)
@@ -1066,13 +1059,13 @@
(GETHASH |x| |$lispWordTable|))
(DEFUN |bootOut| (|l| |outfn|)
- (LET ((|bfVar#26| |l|) (|i| NIL))
+ (LET ((|bfVar#24| |l|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#26|) (PROGN (SETQ |i| (CAR |bfVar#26|)) NIL))
+ ((OR (ATOM |bfVar#24|) (PROGN (SETQ |i| (CAR |bfVar#24|)) NIL))
(RETURN NIL))
('T (|shoeFileLine| (CONCAT " " (PNAME |i|)) |outfn|)))
- (SETQ |bfVar#26| (CDR |bfVar#26|)))))
+ (SETQ |bfVar#24| (CDR |bfVar#24|)))))
(DEFUN CLESSP (|s1| |s2|) (NOT (SHOEGREATERP |s1| |s2|)))
@@ -1123,18 +1116,18 @@
(PROGN
(|shoeFileLine| "USED and where DEFINED" |stream|)
(SETQ |c| (SSORT (HKEYS |$bootUsed|)))
- (LET ((|bfVar#27| |c|) (|i| NIL))
+ (LET ((|bfVar#25| |c|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#27|)
- (PROGN (SETQ |i| (CAR |bfVar#27|)) NIL))
+ ((OR (ATOM |bfVar#25|)
+ (PROGN (SETQ |i| (CAR |bfVar#25|)) NIL))
(RETURN NIL))
('T
(PROGN
(SETQ |a| (CONCAT (PNAME |i|) " is used in "))
(|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|))
|stream| |a|))))
- (SETQ |bfVar#27| (CDR |bfVar#27|))))))))
+ (SETQ |bfVar#25| (CDR |bfVar#25|))))))))
(DEFUN FBO (|name| |fn|) (|shoeGeneralFC| #'BO |name| |fn|))
@@ -1175,16 +1168,16 @@
(SETQ |filename|
(CONCAT "/tmp/" |filename| ".boot"))
(|shoeOpenOutputFile| |stream| |filename|
- (LET ((|bfVar#28| |lines|) (|line| NIL))
+ (LET ((|bfVar#26| |lines|) (|line| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#28|)
+ ((OR (ATOM |bfVar#26|)
(PROGN
- (SETQ |line| (CAR |bfVar#28|))
+ (SETQ |line| (CAR |bfVar#26|))
NIL))
(RETURN NIL))
('T (|shoeFileLine| |line| |stream|)))
- (SETQ |bfVar#28| (CDR |bfVar#28|)))))
+ (SETQ |bfVar#26| (CDR |bfVar#26|)))))
T))
('T NIL))))))
@@ -1199,20 +1192,20 @@
(RETURN
(PROGN
(SETQ |dq| (CAR |str|))
- (CONS (LIST (LET ((|bfVar#30| NIL)
- (|bfVar#29| (|shoeDQlines| |dq|))
+ (CONS (LIST (LET ((|bfVar#28| NIL)
+ (|bfVar#27| (|shoeDQlines| |dq|))
(|line| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#29|)
+ ((OR (ATOM |bfVar#27|)
(PROGN
- (SETQ |line| (CAR |bfVar#29|))
+ (SETQ |line| (CAR |bfVar#27|))
NIL))
- (RETURN (NREVERSE |bfVar#30|)))
+ (RETURN (NREVERSE |bfVar#28|)))
('T
- (SETQ |bfVar#30|
- (CONS (CAR |line|) |bfVar#30|))))
- (SETQ |bfVar#29| (CDR |bfVar#29|)))))
+ (SETQ |bfVar#28|
+ (CONS (CAR |line|) |bfVar#28|))))
+ (SETQ |bfVar#27| (CDR |bfVar#27|)))))
(CDR |str|))))))
(DEFUN |stripm| (|x| |pk| |bt|)