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.lsp19
-rw-r--r--src/algebra/strap/ABELMON.lsp31
-rw-r--r--src/algebra/strap/ABELSG.lsp25
-rw-r--r--src/algebra/strap/ALAGG.lsp61
-rw-r--r--src/algebra/strap/CABMON.lsp28
-rw-r--r--src/algebra/strap/CLAGG.lsp167
-rw-r--r--src/algebra/strap/COMRING.lsp21
-rw-r--r--src/algebra/strap/DIFRING.lsp32
-rw-r--r--src/algebra/strap/DIVRING.lsp30
-rw-r--r--src/algebra/strap/ENTIRER.lsp19
-rw-r--r--src/algebra/strap/EUCDOM.lsp80
-rw-r--r--src/algebra/strap/FFIELDC.lsp90
-rw-r--r--src/algebra/strap/FPS.lsp121
-rw-r--r--src/algebra/strap/GCDDOM.lsp40
-rw-r--r--src/algebra/strap/HOAGG.lsp180
-rw-r--r--src/algebra/strap/INS.lsp115
-rw-r--r--src/algebra/strap/INTDOM.lsp43
-rw-r--r--src/algebra/strap/LNAGG.lsp50
-rw-r--r--src/algebra/strap/LSAGG.lsp51
-rw-r--r--src/algebra/strap/MONOID.lsp28
-rw-r--r--src/algebra/strap/MTSCAT.lsp60
-rw-r--r--src/algebra/strap/OINTDOM.lsp15
-rw-r--r--src/algebra/strap/ORDRING.lsp29
-rw-r--r--src/algebra/strap/POLYCAT.lsp429
-rw-r--r--src/algebra/strap/QFCAT.lsp175
-rw-r--r--src/algebra/strap/RCAGG.lsp113
-rw-r--r--src/algebra/strap/RING.lsp30
-rw-r--r--src/algebra/strap/RNG.lsp10
-rw-r--r--src/algebra/strap/RNS.lsp55
-rw-r--r--src/algebra/strap/SETAGG.lsp84
-rw-r--r--src/algebra/strap/STAGG.lsp59
-rw-r--r--src/algebra/strap/UFD.lsp31
-rw-r--r--src/algebra/strap/URAGG.lsp184
-rw-r--r--src/interp/c-util.boot26
38 files changed, 1152 insertions, 1406 deletions
diff --git a/configure b/configure
index 055ff8e4..0253a983 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-2010-05-01.
+# Generated by GNU Autoconf 2.63 for OpenAxiom 1.4.0-2010-05-04.
#
# 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-2010-05-01'
-PACKAGE_STRING='OpenAxiom 1.4.0-2010-05-01'
+PACKAGE_VERSION='1.4.0-2010-05-04'
+PACKAGE_STRING='OpenAxiom 1.4.0-2010-05-04'
PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net'
ac_unique_file="src/Makefile.pamphlet"
@@ -1511,7 +1511,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-2010-05-01 to adapt to many kinds of systems.
+\`configure' configures OpenAxiom 1.4.0-2010-05-04 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1581,7 +1581,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2010-05-01:";;
+ short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2010-05-04:";;
esac
cat <<\_ACEOF
@@ -1688,7 +1688,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OpenAxiom configure 1.4.0-2010-05-01
+OpenAxiom configure 1.4.0-2010-05-04
generated by GNU Autoconf 2.63
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
@@ -1702,7 +1702,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-2010-05-01, which was
+It was created by OpenAxiom $as_me 1.4.0-2010-05-04, which was
generated by GNU Autoconf 2.63. Invocation command line was
$ $0 $@
@@ -21165,7 +21165,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-2010-05-01, which was
+This file was extended by OpenAxiom $as_me 1.4.0-2010-05-04, which was
generated by GNU Autoconf 2.63. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -21228,7 +21228,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-2010-05-01
+OpenAxiom config.status 1.4.0-2010-05-04
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 d1faac8f..21414a05 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-2010-05-01],
+AC_INIT([OpenAxiom], [1.4.0-2010-05-04],
[open-axiom-bugs@lists.sf.net])
AC_CONFIG_AUX_DIR(config)
diff --git a/configure.ac.pamphlet b/configure.ac.pamphlet
index 78095170..ba8c54a5 100644
--- a/configure.ac.pamphlet
+++ b/configure.ac.pamphlet
@@ -1200,7 +1200,7 @@ information:
<<Autoconf init>>=
sinclude(config/open-axiom.m4)
sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.4.0-2010-05-01],
+AC_INIT([OpenAxiom], [1.4.0-2010-05-04],
[open-axiom-bugs@lists.sf.net])
@
diff --git a/src/ChangeLog b/src/ChangeLog
index 04ec7ba9..ed5115e1 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,10 @@
2010-05-04 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/c-util.boot (backendCompileSPADSLAM): Generate more
+ readable Lisp code.
+
+2010-05-04 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/define.boot (compDefineCategory2): Tidy.
2010-05-03 Gabriel Dos Reis <gdr@cs.tamu.edu>
diff --git a/src/algebra/strap/ABELGRP.lsp b/src/algebra/strap/ABELGRP.lsp
index 76b577bb..35bde847 100644
--- a/src/algebra/strap/ABELGRP.lsp
+++ b/src/algebra/strap/ABELGRP.lsp
@@ -4,22 +4,19 @@
(DEFPARAMETER |AbelianGroup;AL| 'NIL)
(DEFUN |AbelianGroup;| ()
- (PROG (#0=#:G1398)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV| (PAIR '(#1=#:G1397) (LIST '(|Integer|)))
+ (LET ((#0=#:G1398
+ (|sublisV| (PAIR '(#1=#:G1397) (LIST '(|Integer|)))
(|Join| (|CancellationAbelianMonoid|)
(|LeftLinearSet| '#1#)
(|mkCategory| '|domain|
'(((- ($ $)) T) ((- ($ $ $)) T)) NIL
- 'NIL NIL)))
- |AbelianGroup|)
- (|setShellEntry| #0# 0 '(|AbelianGroup|))))))
+ 'NIL NIL)))))
+ (|setShellEntry| #0# 0 '(|AbelianGroup|))
+ #0#))
(DEFUN |AbelianGroup| ()
- (LET ()
- (COND
- (|AbelianGroup;AL|)
- (T (SETQ |AbelianGroup;AL| (|AbelianGroup;|))))))
+ (COND
+ (|AbelianGroup;AL|)
+ (T (SETQ |AbelianGroup;AL| (|AbelianGroup;|)))))
(MAKEPROP '|AbelianGroup| 'NILADIC T)
diff --git a/src/algebra/strap/ABELMON.lsp b/src/algebra/strap/ABELMON.lsp
index 8c7d5627..6a82ed1d 100644
--- a/src/algebra/strap/ABELMON.lsp
+++ b/src/algebra/strap/ABELMON.lsp
@@ -4,25 +4,20 @@
(DEFPARAMETER |AbelianMonoid;AL| 'NIL)
(DEFUN |AbelianMonoid;| ()
- (PROG (#0=#:G1397)
- (RETURN
- (PROG1 (LETT #0#
- (|Join| (|AbelianSemiGroup|)
- (|mkCategory| '|domain|
- '(((|Zero| ($) |constant|) T)
- ((|sample| ($) |constant|) T)
- ((|zero?| ((|Boolean|) $)) T)
- ((* ($ (|NonNegativeInteger|) $)) T))
- NIL
- '((|NonNegativeInteger|) (|Boolean|))
- NIL))
- |AbelianMonoid|)
- (|setShellEntry| #0# 0 '(|AbelianMonoid|))))))
+ (LET ((#0=#:G1397
+ (|Join| (|AbelianSemiGroup|)
+ (|mkCategory| '|domain|
+ '(((|Zero| ($) |constant|) T)
+ ((|sample| ($) |constant|) T)
+ ((|zero?| ((|Boolean|) $)) T)
+ ((* ($ (|NonNegativeInteger|) $)) T))
+ NIL '((|NonNegativeInteger|) (|Boolean|)) NIL))))
+ (|setShellEntry| #0# 0 '(|AbelianMonoid|))
+ #0#))
(DEFUN |AbelianMonoid| ()
- (LET ()
- (COND
- (|AbelianMonoid;AL|)
- (T (SETQ |AbelianMonoid;AL| (|AbelianMonoid;|))))))
+ (COND
+ (|AbelianMonoid;AL|)
+ (T (SETQ |AbelianMonoid;AL| (|AbelianMonoid;|)))))
(MAKEPROP '|AbelianMonoid| 'NILADIC T)
diff --git a/src/algebra/strap/ABELSG.lsp b/src/algebra/strap/ABELSG.lsp
index cd0db00c..ace6b216 100644
--- a/src/algebra/strap/ABELSG.lsp
+++ b/src/algebra/strap/ABELSG.lsp
@@ -4,21 +4,18 @@
(DEFPARAMETER |AbelianSemiGroup;AL| 'NIL)
(DEFUN |AbelianSemiGroup;| ()
- (PROG (#0=#:G1396)
- (RETURN
- (PROG1 (LETT #0#
- (|Join| (|SetCategory|)
- (|mkCategory| '|domain|
- '(((+ ($ $ $)) T)
- ((* ($ (|PositiveInteger|) $)) T))
- NIL '((|PositiveInteger|)) NIL))
- |AbelianSemiGroup|)
- (|setShellEntry| #0# 0 '(|AbelianSemiGroup|))))))
+ (LET ((#0=#:G1396
+ (|Join| (|SetCategory|)
+ (|mkCategory| '|domain|
+ '(((+ ($ $ $)) T)
+ ((* ($ (|PositiveInteger|) $)) T))
+ NIL '((|PositiveInteger|)) NIL))))
+ (|setShellEntry| #0# 0 '(|AbelianSemiGroup|))
+ #0#))
(DEFUN |AbelianSemiGroup| ()
- (LET ()
- (COND
- (|AbelianSemiGroup;AL|)
- (T (SETQ |AbelianSemiGroup;AL| (|AbelianSemiGroup;|))))))
+ (COND
+ (|AbelianSemiGroup;AL|)
+ (T (SETQ |AbelianSemiGroup;AL| (|AbelianSemiGroup;|)))))
(MAKEPROP '|AbelianSemiGroup| 'NILADIC T)
diff --git a/src/algebra/strap/ALAGG.lsp b/src/algebra/strap/ALAGG.lsp
index 79a6854d..330c0726 100644
--- a/src/algebra/strap/ALAGG.lsp
+++ b/src/algebra/strap/ALAGG.lsp
@@ -6,23 +6,19 @@
(DEFPARAMETER |AssociationListAggregate;AL| 'NIL)
(DEFUN |AssociationListAggregate;| (|t#1| |t#2|)
- (PROG (#0=#:G1398)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV|
- (PAIR '(|t#1| |t#2|)
- (LIST (|devaluate| |t#1|)
- (|devaluate| |t#2|)))
- (|sublisV|
- (PAIR '(#1=#:G1397)
- (LIST '(|Record| (|:| |key| |t#1|)
- (|:| |entry| |t#2|))))
- (COND
- (|AssociationListAggregate;CAT|)
- ('T
- (LETT |AssociationListAggregate;CAT|
- (|Join|
- (|TableAggregate| '|t#1| '|t#2|)
+ (LET ((#0=#:G1398
+ (|sublisV|
+ (PAIR '(|t#1| |t#2|)
+ (LIST (|devaluate| |t#1|) (|devaluate| |t#2|)))
+ (|sublisV|
+ (PAIR '(#1=#:G1397)
+ (LIST '(|Record| (|:| |key| |t#1|)
+ (|:| |entry| |t#2|))))
+ (COND
+ (|AssociationListAggregate;CAT|)
+ ('T
+ (LETT |AssociationListAggregate;CAT|
+ (|Join| (|TableAggregate| '|t#1| '|t#2|)
(|ListAggregate| '#1#)
(|mkCategory| '|domain|
'(((|assoc|
@@ -33,23 +29,22 @@
|t#1| $))
T))
NIL 'NIL NIL))
- . #2=(|AssociationListAggregate|)))))) . #2#)
- (|setShellEntry| #0# 0
- (LIST '|AssociationListAggregate| (|devaluate| |t#1|)
- (|devaluate| |t#2|)))))))
+ |AssociationListAggregate|)))))))
+ (|setShellEntry| #0# 0
+ (LIST '|AssociationListAggregate| (|devaluate| |t#1|)
+ (|devaluate| |t#2|)))
+ #0#))
(DEFUN |AssociationListAggregate| (&REST #0=#:G1401 &AUX #1=#:G1399)
(DSETQ #1# #0#)
- (LET (#2=#:G1400)
+ (LET ((#2=#:G1400
+ (|assoc| (|devaluateList| #1#)
+ |AssociationListAggregate;AL|)))
(COND
- ((SETQ #2#
- (|assoc| (|devaluateList| #1#)
- |AssociationListAggregate;AL|))
- (CDR #2#))
- (T (SETQ |AssociationListAggregate;AL|
- (|cons5| (CONS (|devaluateList| #1#)
- (SETQ #2#
- (APPLY
- #'|AssociationListAggregate;| #1#)))
- |AssociationListAggregate;AL|))
- #2#))))
+ (#2# (CDR #2#))
+ (T (PROGN
+ (SETQ #2# (APPLY #'|AssociationListAggregate;| #1#))
+ (SETQ |AssociationListAggregate;AL|
+ (|cons5| (CONS (|devaluateList| #1#) #2#)
+ |AssociationListAggregate;AL|))
+ #2#)))))
diff --git a/src/algebra/strap/CABMON.lsp b/src/algebra/strap/CABMON.lsp
index 7f0c5d45..d007aa1c 100644
--- a/src/algebra/strap/CABMON.lsp
+++ b/src/algebra/strap/CABMON.lsp
@@ -4,23 +4,19 @@
(DEFPARAMETER |CancellationAbelianMonoid;AL| 'NIL)
(DEFUN |CancellationAbelianMonoid;| ()
- (PROG (#0=#:G1396)
- (RETURN
- (PROG1 (LETT #0#
- (|Join| (|AbelianMonoid|)
- (|mkCategory| '|domain|
- '(((|subtractIfCan|
- ((|Union| $ "failed") $ $))
- T))
- NIL 'NIL NIL))
- |CancellationAbelianMonoid|)
- (|setShellEntry| #0# 0 '(|CancellationAbelianMonoid|))))))
+ (LET ((#0=#:G1396
+ (|Join| (|AbelianMonoid|)
+ (|mkCategory| '|domain|
+ '(((|subtractIfCan| ((|Union| $ "failed") $ $))
+ T))
+ NIL 'NIL NIL))))
+ (|setShellEntry| #0# 0 '(|CancellationAbelianMonoid|))
+ #0#))
(DEFUN |CancellationAbelianMonoid| ()
- (LET ()
- (COND
- (|CancellationAbelianMonoid;AL|)
- (T (SETQ |CancellationAbelianMonoid;AL|
- (|CancellationAbelianMonoid;|))))))
+ (COND
+ (|CancellationAbelianMonoid;AL|)
+ (T (SETQ |CancellationAbelianMonoid;AL|
+ (|CancellationAbelianMonoid;|)))))
(MAKEPROP '|CancellationAbelianMonoid| 'NILADIC T)
diff --git a/src/algebra/strap/CLAGG.lsp b/src/algebra/strap/CLAGG.lsp
index ce380a1a..eab9160d 100644
--- a/src/algebra/strap/CLAGG.lsp
+++ b/src/algebra/strap/CLAGG.lsp
@@ -6,100 +6,79 @@
(DEFPARAMETER |Collection;AL| 'NIL)
(DEFUN |Collection;| (|t#1|)
- (PROG (#0=#:G1396)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV|
- (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
- (COND
- (|Collection;CAT|)
- ('T
- (LETT |Collection;CAT|
- (|Join| (|HomogeneousAggregate| '|t#1|)
- (|mkCategory| '|domain|
- '(((|construct|
- ($ (|List| |t#1|)))
- T)
- ((|find|
- ((|Union| |t#1| "failed")
- (|Mapping| (|Boolean|)
- |t#1|)
- $))
- T)
- ((|reduce|
- (|t#1|
- (|Mapping| |t#1| |t#1|
- |t#1|)
- $))
- (|has| $
- (ATTRIBUTE
- |finiteAggregate|)))
- ((|reduce|
- (|t#1|
- (|Mapping| |t#1| |t#1|
- |t#1|)
- $ |t#1|))
- (|has| $
- (ATTRIBUTE
- |finiteAggregate|)))
- ((|remove|
- ($
- (|Mapping| (|Boolean|)
- |t#1|)
- $))
- (|has| $
- (ATTRIBUTE
- |finiteAggregate|)))
- ((|select|
- ($
- (|Mapping| (|Boolean|)
- |t#1|)
- $))
- (|has| $
- (ATTRIBUTE
- |finiteAggregate|)))
- ((|reduce|
- (|t#1|
- (|Mapping| |t#1| |t#1|
- |t#1|)
- $ |t#1| |t#1|))
- (AND
- (|has| |t#1|
- (|SetCategory|))
- (|has| $
- (ATTRIBUTE
- |finiteAggregate|))))
- ((|remove| ($ |t#1| $))
- (AND
- (|has| |t#1|
- (|SetCategory|))
- (|has| $
- (ATTRIBUTE
- |finiteAggregate|))))
- ((|removeDuplicates| ($ $))
- (AND
- (|has| |t#1|
- (|SetCategory|))
- (|has| $
- (ATTRIBUTE
- |finiteAggregate|)))))
- '(((|ConvertibleTo|
- (|InputForm|))
- (|has| |t#1|
- (|ConvertibleTo|
- (|InputForm|)))))
- '((|List| |t#1|)) NIL))
- . #1=(|Collection|))))) . #1#)
- (|setShellEntry| #0# 0
- (LIST '|Collection| (|devaluate| |t#1|)))))))
+ (LET ((#0=#:G1396
+ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
+ (COND
+ (|Collection;CAT|)
+ ('T
+ (LETT |Collection;CAT|
+ (|Join| (|HomogeneousAggregate| '|t#1|)
+ (|mkCategory| '|domain|
+ '(((|construct|
+ ($ (|List| |t#1|)))
+ T)
+ ((|find|
+ ((|Union| |t#1| "failed")
+ (|Mapping| (|Boolean|) |t#1|)
+ $))
+ T)
+ ((|reduce|
+ (|t#1|
+ (|Mapping| |t#1| |t#1| |t#1|)
+ $))
+ (|has| $
+ (ATTRIBUTE |finiteAggregate|)))
+ ((|reduce|
+ (|t#1|
+ (|Mapping| |t#1| |t#1| |t#1|)
+ $ |t#1|))
+ (|has| $
+ (ATTRIBUTE |finiteAggregate|)))
+ ((|remove|
+ ($
+ (|Mapping| (|Boolean|) |t#1|)
+ $))
+ (|has| $
+ (ATTRIBUTE |finiteAggregate|)))
+ ((|select|
+ ($
+ (|Mapping| (|Boolean|) |t#1|)
+ $))
+ (|has| $
+ (ATTRIBUTE |finiteAggregate|)))
+ ((|reduce|
+ (|t#1|
+ (|Mapping| |t#1| |t#1| |t#1|)
+ $ |t#1| |t#1|))
+ (AND
+ (|has| |t#1| (|SetCategory|))
+ (|has| $
+ (ATTRIBUTE |finiteAggregate|))))
+ ((|remove| ($ |t#1| $))
+ (AND
+ (|has| |t#1| (|SetCategory|))
+ (|has| $
+ (ATTRIBUTE |finiteAggregate|))))
+ ((|removeDuplicates| ($ $))
+ (AND
+ (|has| |t#1| (|SetCategory|))
+ (|has| $
+ (ATTRIBUTE |finiteAggregate|)))))
+ '(((|ConvertibleTo| (|InputForm|))
+ (|has| |t#1|
+ (|ConvertibleTo|
+ (|InputForm|)))))
+ '((|List| |t#1|)) NIL))
+ |Collection|))))))
+ (|setShellEntry| #0# 0 (LIST '|Collection| (|devaluate| |t#1|)))
+ #0#))
(DEFUN |Collection| (#0=#:G1397)
- (LET (#1=#:G1398)
+ (LET ((#1=#:G1398 (|assoc| (|devaluate| #0#) |Collection;AL|)))
(COND
- ((SETQ #1# (|assoc| (|devaluate| #0#) |Collection;AL|))
- (CDR #1#))
- (T (SETQ |Collection;AL|
- (|cons5| (CONS (|devaluate| #0#)
- (SETQ #1# (|Collection;| #0#)))
- |Collection;AL|))
- #1#))))
+ (#1# (CDR #1#))
+ (T (PROGN
+ (SETQ #1# (|Collection;| #0#))
+ (SETQ |Collection;AL|
+ (|cons5| (CONS (|devaluate| #0#) #1#) |Collection;AL|))
+ #1#)))))
diff --git a/src/algebra/strap/COMRING.lsp b/src/algebra/strap/COMRING.lsp
index 9857fe0f..0db745eb 100644
--- a/src/algebra/strap/COMRING.lsp
+++ b/src/algebra/strap/COMRING.lsp
@@ -4,19 +4,16 @@
(DEFPARAMETER |CommutativeRing;AL| 'NIL)
(DEFUN |CommutativeRing;| ()
- (PROG (#0=#:G1396)
- (RETURN
- (PROG1 (LETT #0#
- (|Join| (|Ring|) (|BiModule| '$ '$)
- (|mkCategory| '|package| NIL
- '(((|commutative| "*") T)) 'NIL NIL))
- |CommutativeRing|)
- (|setShellEntry| #0# 0 '(|CommutativeRing|))))))
+ (LET ((#0=#:G1396
+ (|Join| (|Ring|) (|BiModule| '$ '$)
+ (|mkCategory| '|package| NIL
+ '(((|commutative| "*") T)) 'NIL NIL))))
+ (|setShellEntry| #0# 0 '(|CommutativeRing|))
+ #0#))
(DEFUN |CommutativeRing| ()
- (LET ()
- (COND
- (|CommutativeRing;AL|)
- (T (SETQ |CommutativeRing;AL| (|CommutativeRing;|))))))
+ (COND
+ (|CommutativeRing;AL|)
+ (T (SETQ |CommutativeRing;AL| (|CommutativeRing;|)))))
(MAKEPROP '|CommutativeRing| 'NILADIC T)
diff --git a/src/algebra/strap/DIFRING.lsp b/src/algebra/strap/DIFRING.lsp
index d3d403d7..c19b4ed8 100644
--- a/src/algebra/strap/DIFRING.lsp
+++ b/src/algebra/strap/DIFRING.lsp
@@ -4,25 +4,21 @@
(DEFPARAMETER |DifferentialRing;AL| 'NIL)
(DEFUN |DifferentialRing;| ()
- (PROG (#0=#:G1396)
- (RETURN
- (PROG1 (LETT #0#
- (|Join| (|Ring|)
- (|mkCategory| '|domain|
- '(((|differentiate| ($ $)) T)
- ((D ($ $)) T)
- ((|differentiate|
- ($ $ (|NonNegativeInteger|)))
- T)
- ((D ($ $ (|NonNegativeInteger|))) T))
- NIL '((|NonNegativeInteger|)) NIL))
- |DifferentialRing|)
- (|setShellEntry| #0# 0 '(|DifferentialRing|))))))
+ (LET ((#0=#:G1396
+ (|Join| (|Ring|)
+ (|mkCategory| '|domain|
+ '(((|differentiate| ($ $)) T) ((D ($ $)) T)
+ ((|differentiate|
+ ($ $ (|NonNegativeInteger|)))
+ T)
+ ((D ($ $ (|NonNegativeInteger|))) T))
+ NIL '((|NonNegativeInteger|)) NIL))))
+ (|setShellEntry| #0# 0 '(|DifferentialRing|))
+ #0#))
(DEFUN |DifferentialRing| ()
- (LET ()
- (COND
- (|DifferentialRing;AL|)
- (T (SETQ |DifferentialRing;AL| (|DifferentialRing;|))))))
+ (COND
+ (|DifferentialRing;AL|)
+ (T (SETQ |DifferentialRing;AL| (|DifferentialRing;|)))))
(MAKEPROP '|DifferentialRing| 'NILADIC T)
diff --git a/src/algebra/strap/DIVRING.lsp b/src/algebra/strap/DIVRING.lsp
index 40a7f53a..89d83592 100644
--- a/src/algebra/strap/DIVRING.lsp
+++ b/src/algebra/strap/DIVRING.lsp
@@ -4,24 +4,20 @@
(DEFPARAMETER |DivisionRing;AL| 'NIL)
(DEFUN |DivisionRing;| ()
- (PROG (#0=#:G1399)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV|
- (PAIR '(#1=#:G1398)
- (LIST '(|Fraction| (|Integer|))))
- (|Join| (|EntireRing|) (|Algebra| '#1#)
- (|mkCategory| '|domain|
- '(((** ($ $ (|Integer|))) T)
- ((|inv| ($ $)) T))
- NIL '((|Integer|)) NIL)))
- |DivisionRing|)
- (|setShellEntry| #0# 0 '(|DivisionRing|))))))
+ (LET ((#0=#:G1399
+ (|sublisV|
+ (PAIR '(#1=#:G1398) (LIST '(|Fraction| (|Integer|))))
+ (|Join| (|EntireRing|) (|Algebra| '#1#)
+ (|mkCategory| '|domain|
+ '(((** ($ $ (|Integer|))) T)
+ ((|inv| ($ $)) T))
+ NIL '((|Integer|)) NIL)))))
+ (|setShellEntry| #0# 0 '(|DivisionRing|))
+ #0#))
(DEFUN |DivisionRing| ()
- (LET ()
- (COND
- (|DivisionRing;AL|)
- (T (SETQ |DivisionRing;AL| (|DivisionRing;|))))))
+ (COND
+ (|DivisionRing;AL|)
+ (T (SETQ |DivisionRing;AL| (|DivisionRing;|)))))
(MAKEPROP '|DivisionRing| 'NILADIC T)
diff --git a/src/algebra/strap/ENTIRER.lsp b/src/algebra/strap/ENTIRER.lsp
index bb905363..0b7c5750 100644
--- a/src/algebra/strap/ENTIRER.lsp
+++ b/src/algebra/strap/ENTIRER.lsp
@@ -4,19 +4,14 @@
(DEFPARAMETER |EntireRing;AL| 'NIL)
(DEFUN |EntireRing;| ()
- (PROG (#0=#:G1396)
- (RETURN
- (PROG1 (LETT #0#
- (|Join| (|Ring|) (|BiModule| '$ '$)
- (|mkCategory| '|package| NIL
- '((|noZeroDivisors| T)) 'NIL NIL))
- |EntireRing|)
- (|setShellEntry| #0# 0 '(|EntireRing|))))))
+ (LET ((#0=#:G1396
+ (|Join| (|Ring|) (|BiModule| '$ '$)
+ (|mkCategory| '|package| NIL
+ '((|noZeroDivisors| T)) 'NIL NIL))))
+ (|setShellEntry| #0# 0 '(|EntireRing|))
+ #0#))
(DEFUN |EntireRing| ()
- (LET ()
- (COND
- (|EntireRing;AL|)
- (T (SETQ |EntireRing;AL| (|EntireRing;|))))))
+ (COND (|EntireRing;AL|) (T (SETQ |EntireRing;AL| (|EntireRing;|)))))
(MAKEPROP '|EntireRing| 'NILADIC T)
diff --git a/src/algebra/strap/EUCDOM.lsp b/src/algebra/strap/EUCDOM.lsp
index b4b66503..ecceaa38 100644
--- a/src/algebra/strap/EUCDOM.lsp
+++ b/src/algebra/strap/EUCDOM.lsp
@@ -4,50 +4,44 @@
(DEFPARAMETER |EuclideanDomain;AL| 'NIL)
(DEFUN |EuclideanDomain;| ()
- (PROG (#0=#:G1413)
- (RETURN
- (PROG1 (LETT #0#
- (|Join| (|PrincipalIdealDomain|)
- (|mkCategory| '|domain|
- '(((|sizeLess?| ((|Boolean|) $ $)) T)
- ((|euclideanSize|
- ((|NonNegativeInteger|) $))
- T)
- ((|divide|
- ((|Record| (|:| |quotient| $)
- (|:| |remainder| $))
- $ $))
- T)
- ((|quo| ($ $ $)) T)
- ((|rem| ($ $ $)) T)
- ((|extendedEuclidean|
- ((|Record| (|:| |coef1| $)
- (|:| |coef2| $)
- (|:| |generator| $))
- $ $))
- T)
- ((|extendedEuclidean|
- ((|Union|
- (|Record| (|:| |coef1| $)
- (|:| |coef2| $))
- "failed")
- $ $ $))
- T)
- ((|multiEuclidean|
- ((|Union| (|List| $) "failed")
- (|List| $) $))
- T))
- NIL
- '((|List| $) (|NonNegativeInteger|)
- (|Boolean|))
- NIL))
- |EuclideanDomain|)
- (|setShellEntry| #0# 0 '(|EuclideanDomain|))))))
+ (LET ((#0=#:G1413
+ (|Join| (|PrincipalIdealDomain|)
+ (|mkCategory| '|domain|
+ '(((|sizeLess?| ((|Boolean|) $ $)) T)
+ ((|euclideanSize| ((|NonNegativeInteger|) $))
+ T)
+ ((|divide|
+ ((|Record| (|:| |quotient| $)
+ (|:| |remainder| $))
+ $ $))
+ T)
+ ((|quo| ($ $ $)) T) ((|rem| ($ $ $)) T)
+ ((|extendedEuclidean|
+ ((|Record| (|:| |coef1| $)
+ (|:| |coef2| $)
+ (|:| |generator| $))
+ $ $))
+ T)
+ ((|extendedEuclidean|
+ ((|Union| (|Record| (|:| |coef1| $)
+ (|:| |coef2| $))
+ "failed")
+ $ $ $))
+ T)
+ ((|multiEuclidean|
+ ((|Union| (|List| $) "failed")
+ (|List| $) $))
+ T))
+ NIL
+ '((|List| $) (|NonNegativeInteger|)
+ (|Boolean|))
+ NIL))))
+ (|setShellEntry| #0# 0 '(|EuclideanDomain|))
+ #0#))
(DEFUN |EuclideanDomain| ()
- (LET ()
- (COND
- (|EuclideanDomain;AL|)
- (T (SETQ |EuclideanDomain;AL| (|EuclideanDomain;|))))))
+ (COND
+ (|EuclideanDomain;AL|)
+ (T (SETQ |EuclideanDomain;AL| (|EuclideanDomain;|)))))
(MAKEPROP '|EuclideanDomain| 'NILADIC T)
diff --git a/src/algebra/strap/FFIELDC.lsp b/src/algebra/strap/FFIELDC.lsp
index 3a31837f..91dc1f86 100644
--- a/src/algebra/strap/FFIELDC.lsp
+++ b/src/algebra/strap/FFIELDC.lsp
@@ -4,57 +4,51 @@
(DEFPARAMETER |FiniteFieldCategory;AL| 'NIL)
(DEFUN |FiniteFieldCategory;| ()
- (PROG (#0=#:G1404)
- (RETURN
- (PROG1 (LETT #0#
- (|Join| (|FieldOfPrimeCharacteristic|) (|Finite|)
- (|StepThrough|) (|DifferentialRing|)
- (|mkCategory| '|domain|
- '(((|charthRoot| ($ $)) T)
- ((|conditionP|
- ((|Union| (|Vector| $) "failed")
- (|Matrix| $)))
- T)
- ((|factorsOfCyclicGroupSize|
- ((|List|
- (|Record|
+ (LET ((#0=#:G1404
+ (|Join| (|FieldOfPrimeCharacteristic|) (|Finite|)
+ (|StepThrough|) (|DifferentialRing|)
+ (|mkCategory| '|domain|
+ '(((|charthRoot| ($ $)) T)
+ ((|conditionP|
+ ((|Union| (|Vector| $) "failed")
+ (|Matrix| $)))
+ T)
+ ((|factorsOfCyclicGroupSize|
+ ((|List| (|Record|
(|:| |factor| (|Integer|))
(|:| |exponent| (|Integer|))))))
- T)
- ((|tableForDiscreteLogarithm|
- ((|Table| (|PositiveInteger|)
- (|NonNegativeInteger|))
- (|Integer|)))
- T)
- ((|createPrimitiveElement| ($)) T)
- ((|primitiveElement| ($)) T)
- ((|primitive?| ((|Boolean|) $)) T)
- ((|discreteLog|
- ((|NonNegativeInteger|) $))
- T)
- ((|order| ((|PositiveInteger|) $)) T)
- ((|representationType|
- ((|Union| "prime" "polynomial"
- "normal" "cyclic")))
- T))
- NIL
- '((|PositiveInteger|)
- (|NonNegativeInteger|) (|Boolean|)
- (|Table| (|PositiveInteger|)
- (|NonNegativeInteger|))
- (|Integer|)
- (|List| (|Record|
- (|:| |factor| (|Integer|))
- (|:| |exponent| (|Integer|))))
- (|Matrix| $))
- NIL))
- |FiniteFieldCategory|)
- (|setShellEntry| #0# 0 '(|FiniteFieldCategory|))))))
+ T)
+ ((|tableForDiscreteLogarithm|
+ ((|Table| (|PositiveInteger|)
+ (|NonNegativeInteger|))
+ (|Integer|)))
+ T)
+ ((|createPrimitiveElement| ($)) T)
+ ((|primitiveElement| ($)) T)
+ ((|primitive?| ((|Boolean|) $)) T)
+ ((|discreteLog| ((|NonNegativeInteger|) $))
+ T)
+ ((|order| ((|PositiveInteger|) $)) T)
+ ((|representationType|
+ ((|Union| "prime" "polynomial" "normal"
+ "cyclic")))
+ T))
+ NIL
+ '((|PositiveInteger|) (|NonNegativeInteger|)
+ (|Boolean|)
+ (|Table| (|PositiveInteger|)
+ (|NonNegativeInteger|))
+ (|Integer|)
+ (|List| (|Record| (|:| |factor| (|Integer|))
+ (|:| |exponent| (|Integer|))))
+ (|Matrix| $))
+ NIL))))
+ (|setShellEntry| #0# 0 '(|FiniteFieldCategory|))
+ #0#))
(DEFUN |FiniteFieldCategory| ()
- (LET ()
- (COND
- (|FiniteFieldCategory;AL|)
- (T (SETQ |FiniteFieldCategory;AL| (|FiniteFieldCategory;|))))))
+ (COND
+ (|FiniteFieldCategory;AL|)
+ (T (SETQ |FiniteFieldCategory;AL| (|FiniteFieldCategory;|)))))
(MAKEPROP '|FiniteFieldCategory| 'NILADIC T)
diff --git a/src/algebra/strap/FPS.lsp b/src/algebra/strap/FPS.lsp
index 36d099b4..3d7e42bb 100644
--- a/src/algebra/strap/FPS.lsp
+++ b/src/algebra/strap/FPS.lsp
@@ -4,78 +4,57 @@
(DEFPARAMETER |FloatingPointSystem;AL| 'NIL)
(DEFUN |FloatingPointSystem;| ()
- (PROG (#0=#:G1396)
- (RETURN
- (PROG1 (LETT #0#
- (|Join| (|RealNumberSystem|)
- (|mkCategory| '|domain|
- '(((|float| ($ (|Integer|) (|Integer|)))
- T)
- ((|float| ($ (|Integer|) (|Integer|)
- (|PositiveInteger|)))
- T)
- ((|order| ((|Integer|) $)) T)
- ((|base| ((|PositiveInteger|))) T)
- ((|exponent| ((|Integer|) $)) T)
- ((|mantissa| ((|Integer|) $)) T)
- ((|bits| ((|PositiveInteger|))) T)
- ((|digits| ((|PositiveInteger|))) T)
- ((|precision| ((|PositiveInteger|)))
- T)
- ((|bits| ((|PositiveInteger|)
- (|PositiveInteger|)))
- (|has| $
- (ATTRIBUTE
- |arbitraryPrecision|)))
- ((|digits|
- ((|PositiveInteger|)
- (|PositiveInteger|)))
- (|has| $
- (ATTRIBUTE
- |arbitraryPrecision|)))
- ((|precision|
- ((|PositiveInteger|)
- (|PositiveInteger|)))
- (|has| $
- (ATTRIBUTE
- |arbitraryPrecision|)))
- ((|increasePrecision|
- ((|PositiveInteger|) (|Integer|)))
- (|has| $
- (ATTRIBUTE
- |arbitraryPrecision|)))
- ((|decreasePrecision|
- ((|PositiveInteger|) (|Integer|)))
- (|has| $
- (ATTRIBUTE
- |arbitraryPrecision|)))
- ((|min| ($))
- (AND (|not|
- (|has| $
- (ATTRIBUTE
- |arbitraryPrecision|)))
- (|not|
- (|has| $
- (ATTRIBUTE
- |arbitraryExponent|)))))
- ((|max| ($))
- (AND (|not|
- (|has| $
- (ATTRIBUTE
- |arbitraryPrecision|)))
- (|not|
- (|has| $
- (ATTRIBUTE
- |arbitraryExponent|))))))
- '((|approximate| T))
- '((|PositiveInteger|) (|Integer|)) NIL))
- |FloatingPointSystem|)
- (|setShellEntry| #0# 0 '(|FloatingPointSystem|))))))
+ (LET ((#0=#:G1396
+ (|Join| (|RealNumberSystem|)
+ (|mkCategory| '|domain|
+ '(((|float| ($ (|Integer|) (|Integer|))) T)
+ ((|float| ($ (|Integer|) (|Integer|)
+ (|PositiveInteger|)))
+ T)
+ ((|order| ((|Integer|) $)) T)
+ ((|base| ((|PositiveInteger|))) T)
+ ((|exponent| ((|Integer|) $)) T)
+ ((|mantissa| ((|Integer|) $)) T)
+ ((|bits| ((|PositiveInteger|))) T)
+ ((|digits| ((|PositiveInteger|))) T)
+ ((|precision| ((|PositiveInteger|))) T)
+ ((|bits| ((|PositiveInteger|)
+ (|PositiveInteger|)))
+ (|has| $ (ATTRIBUTE |arbitraryPrecision|)))
+ ((|digits|
+ ((|PositiveInteger|)
+ (|PositiveInteger|)))
+ (|has| $ (ATTRIBUTE |arbitraryPrecision|)))
+ ((|precision|
+ ((|PositiveInteger|)
+ (|PositiveInteger|)))
+ (|has| $ (ATTRIBUTE |arbitraryPrecision|)))
+ ((|increasePrecision|
+ ((|PositiveInteger|) (|Integer|)))
+ (|has| $ (ATTRIBUTE |arbitraryPrecision|)))
+ ((|decreasePrecision|
+ ((|PositiveInteger|) (|Integer|)))
+ (|has| $ (ATTRIBUTE |arbitraryPrecision|)))
+ ((|min| ($))
+ (AND (|not| (|has| $
+ (ATTRIBUTE
+ |arbitraryPrecision|)))
+ (|not| (|has| $
+ (ATTRIBUTE |arbitraryExponent|)))))
+ ((|max| ($))
+ (AND (|not| (|has| $
+ (ATTRIBUTE
+ |arbitraryPrecision|)))
+ (|not| (|has| $
+ (ATTRIBUTE |arbitraryExponent|))))))
+ '((|approximate| T))
+ '((|PositiveInteger|) (|Integer|)) NIL))))
+ (|setShellEntry| #0# 0 '(|FloatingPointSystem|))
+ #0#))
(DEFUN |FloatingPointSystem| ()
- (LET ()
- (COND
- (|FloatingPointSystem;AL|)
- (T (SETQ |FloatingPointSystem;AL| (|FloatingPointSystem;|))))))
+ (COND
+ (|FloatingPointSystem;AL|)
+ (T (SETQ |FloatingPointSystem;AL| (|FloatingPointSystem;|)))))
(MAKEPROP '|FloatingPointSystem| 'NILADIC T)
diff --git a/src/algebra/strap/GCDDOM.lsp b/src/algebra/strap/GCDDOM.lsp
index f3866954..cf17f4a6 100644
--- a/src/algebra/strap/GCDDOM.lsp
+++ b/src/algebra/strap/GCDDOM.lsp
@@ -4,29 +4,25 @@
(DEFPARAMETER |GcdDomain;AL| 'NIL)
(DEFUN |GcdDomain;| ()
- (PROG (#0=#:G1402)
- (RETURN
- (PROG1 (LETT #0#
- (|Join| (|IntegralDomain|)
- (|mkCategory| '|domain|
- '(((|gcd| ($ $ $)) T)
- ((|gcd| ($ (|List| $))) T)
- ((|lcm| ($ $ $)) T)
- ((|lcm| ($ (|List| $))) T)
- ((|gcdPolynomial|
- ((|SparseUnivariatePolynomial| $)
- (|SparseUnivariatePolynomial| $)
- (|SparseUnivariatePolynomial| $)))
- T))
- NIL
- '((|SparseUnivariatePolynomial| $)
- (|List| $))
- NIL))
- |GcdDomain|)
- (|setShellEntry| #0# 0 '(|GcdDomain|))))))
+ (LET ((#0=#:G1402
+ (|Join| (|IntegralDomain|)
+ (|mkCategory| '|domain|
+ '(((|gcd| ($ $ $)) T)
+ ((|gcd| ($ (|List| $))) T)
+ ((|lcm| ($ $ $)) T)
+ ((|lcm| ($ (|List| $))) T)
+ ((|gcdPolynomial|
+ ((|SparseUnivariatePolynomial| $)
+ (|SparseUnivariatePolynomial| $)
+ (|SparseUnivariatePolynomial| $)))
+ T))
+ NIL
+ '((|SparseUnivariatePolynomial| $) (|List| $))
+ NIL))))
+ (|setShellEntry| #0# 0 '(|GcdDomain|))
+ #0#))
(DEFUN |GcdDomain| ()
- (LET ()
- (COND (|GcdDomain;AL|) (T (SETQ |GcdDomain;AL| (|GcdDomain;|))))))
+ (COND (|GcdDomain;AL|) (T (SETQ |GcdDomain;AL| (|GcdDomain;|)))))
(MAKEPROP '|GcdDomain| 'NILADIC T)
diff --git a/src/algebra/strap/HOAGG.lsp b/src/algebra/strap/HOAGG.lsp
index 97d2ffb6..be929da3 100644
--- a/src/algebra/strap/HOAGG.lsp
+++ b/src/algebra/strap/HOAGG.lsp
@@ -6,107 +6,85 @@
(DEFPARAMETER |HomogeneousAggregate;AL| 'NIL)
(DEFUN |HomogeneousAggregate;| (|t#1|)
- (PROG (#0=#:G1397)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV|
- (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
- (COND
- (|HomogeneousAggregate;CAT|)
- ('T
- (LETT |HomogeneousAggregate;CAT|
- (|Join| (|Aggregate|)
- (|mkCategory| '|domain|
- '(((|map|
- ($ (|Mapping| |t#1| |t#1|)
- $))
- T)
- ((|map!|
- ($ (|Mapping| |t#1| |t#1|)
- $))
- (|has| $
- (ATTRIBUTE
- |shallowlyMutable|)))
- ((|any?|
- ((|Boolean|)
- (|Mapping| (|Boolean|)
- |t#1|)
- $))
- (|has| $
- (ATTRIBUTE
- |finiteAggregate|)))
- ((|every?|
- ((|Boolean|)
- (|Mapping| (|Boolean|)
- |t#1|)
- $))
- (|has| $
- (ATTRIBUTE
- |finiteAggregate|)))
- ((|count|
- ((|NonNegativeInteger|)
- (|Mapping| (|Boolean|)
- |t#1|)
- $))
- (|has| $
- (ATTRIBUTE
- |finiteAggregate|)))
- ((|parts|
- ((|List| |t#1|) $))
- (|has| $
- (ATTRIBUTE
- |finiteAggregate|)))
- ((|members|
- ((|List| |t#1|) $))
- (|has| $
- (ATTRIBUTE
- |finiteAggregate|)))
- ((|count|
- ((|NonNegativeInteger|)
- |t#1| $))
- (AND
- (|has| |t#1|
- (|SetCategory|))
- (|has| $
- (ATTRIBUTE
- |finiteAggregate|))))
- ((|member?|
- ((|Boolean|) |t#1| $))
- (AND
- (|has| |t#1|
- (|SetCategory|))
- (|has| $
- (ATTRIBUTE
- |finiteAggregate|)))))
- '(((|CoercibleTo|
- (|OutputForm|))
- (|has| |t#1|
- (|CoercibleTo|
- (|OutputForm|))))
- ((|SetCategory|)
- (|has| |t#1|
- (|SetCategory|)))
- ((|Evalable| |t#1|)
- (AND
- (|has| |t#1|
- (|Evalable| |t#1|))
- (|has| |t#1|
- (|SetCategory|)))))
- '((|Boolean|)
- (|NonNegativeInteger|)
- (|List| |t#1|))
- NIL))
- . #1=(|HomogeneousAggregate|))))) . #1#)
- (|setShellEntry| #0# 0
- (LIST '|HomogeneousAggregate| (|devaluate| |t#1|)))))))
+ (LET ((#0=#:G1397
+ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
+ (COND
+ (|HomogeneousAggregate;CAT|)
+ ('T
+ (LETT |HomogeneousAggregate;CAT|
+ (|Join| (|Aggregate|)
+ (|mkCategory| '|domain|
+ '(((|map|
+ ($ (|Mapping| |t#1| |t#1|) $))
+ T)
+ ((|map!|
+ ($ (|Mapping| |t#1| |t#1|) $))
+ (|has| $
+ (ATTRIBUTE |shallowlyMutable|)))
+ ((|any?|
+ ((|Boolean|)
+ (|Mapping| (|Boolean|) |t#1|)
+ $))
+ (|has| $
+ (ATTRIBUTE |finiteAggregate|)))
+ ((|every?|
+ ((|Boolean|)
+ (|Mapping| (|Boolean|) |t#1|)
+ $))
+ (|has| $
+ (ATTRIBUTE |finiteAggregate|)))
+ ((|count|
+ ((|NonNegativeInteger|)
+ (|Mapping| (|Boolean|) |t#1|)
+ $))
+ (|has| $
+ (ATTRIBUTE |finiteAggregate|)))
+ ((|parts| ((|List| |t#1|) $))
+ (|has| $
+ (ATTRIBUTE |finiteAggregate|)))
+ ((|members| ((|List| |t#1|) $))
+ (|has| $
+ (ATTRIBUTE |finiteAggregate|)))
+ ((|count|
+ ((|NonNegativeInteger|) |t#1|
+ $))
+ (AND
+ (|has| |t#1| (|SetCategory|))
+ (|has| $
+ (ATTRIBUTE |finiteAggregate|))))
+ ((|member?|
+ ((|Boolean|) |t#1| $))
+ (AND
+ (|has| |t#1| (|SetCategory|))
+ (|has| $
+ (ATTRIBUTE |finiteAggregate|)))))
+ '(((|CoercibleTo| (|OutputForm|))
+ (|has| |t#1|
+ (|CoercibleTo| (|OutputForm|))))
+ ((|SetCategory|)
+ (|has| |t#1| (|SetCategory|)))
+ ((|Evalable| |t#1|)
+ (AND
+ (|has| |t#1|
+ (|Evalable| |t#1|))
+ (|has| |t#1| (|SetCategory|)))))
+ '((|Boolean|)
+ (|NonNegativeInteger|)
+ (|List| |t#1|))
+ NIL))
+ |HomogeneousAggregate|))))))
+ (|setShellEntry| #0# 0
+ (LIST '|HomogeneousAggregate| (|devaluate| |t#1|)))
+ #0#))
(DEFUN |HomogeneousAggregate| (#0=#:G1398)
- (LET (#1=#:G1399)
+ (LET ((#1=#:G1399
+ (|assoc| (|devaluate| #0#) |HomogeneousAggregate;AL|)))
(COND
- ((SETQ #1# (|assoc| (|devaluate| #0#) |HomogeneousAggregate;AL|))
- (CDR #1#))
- (T (SETQ |HomogeneousAggregate;AL|
- (|cons5| (CONS (|devaluate| #0#)
- (SETQ #1# (|HomogeneousAggregate;| #0#)))
- |HomogeneousAggregate;AL|))
- #1#))))
+ (#1# (CDR #1#))
+ (T (PROGN
+ (SETQ #1# (|HomogeneousAggregate;| #0#))
+ (SETQ |HomogeneousAggregate;AL|
+ (|cons5| (CONS (|devaluate| #0#) #1#)
+ |HomogeneousAggregate;AL|))
+ #1#)))))
diff --git a/src/algebra/strap/INS.lsp b/src/algebra/strap/INS.lsp
index ef6261ca..774558d4 100644
--- a/src/algebra/strap/INS.lsp
+++ b/src/algebra/strap/INS.lsp
@@ -4,71 +4,58 @@
(DEFPARAMETER |IntegerNumberSystem;AL| 'NIL)
(DEFUN |IntegerNumberSystem;| ()
- (PROG (#0=#:G1413)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV|
- (PAIR '(#1=#:G1407 #2=#:G1408 #3=#:G1409
- #4=#:G1410 #5=#:G1411 #6=#:G1412)
- (LIST '(|Integer|) '(|Integer|)
- '(|Integer|) '(|InputForm|)
- '(|Pattern| (|Integer|))
- '(|Integer|)))
- (|Join| (|UniqueFactorizationDomain|)
- (|EuclideanDomain|)
- (|OrderedIntegralDomain|)
- (|DifferentialRing|)
- (|ConvertibleTo| '#1#)
- (|RetractableTo| '#2#)
- (|LinearlyExplicitRingOver| '#3#)
- (|ConvertibleTo| '#4#)
- (|ConvertibleTo| '#5#)
- (|PatternMatchable| '#6#)
- (|CombinatorialFunctionCategory|)
- (|RealConstant|) (|CharacteristicZero|)
- (|StepThrough|)
- (|mkCategory| '|domain|
- '(((|odd?| ((|Boolean|) $)) T)
- ((|even?| ((|Boolean|) $)) T)
- ((|base| ($)) T)
- ((|length| ($ $)) T)
- ((|shift| ($ $ $)) T)
- ((|bit?| ((|Boolean|) $ $)) T)
- ((|positiveRemainder| ($ $ $)) T)
- ((|symmetricRemainder| ($ $ $)) T)
- ((|rational?| ((|Boolean|) $)) T)
- ((|rational|
- ((|Fraction| (|Integer|)) $))
- T)
- ((|rationalIfCan|
- ((|Union|
- (|Fraction| (|Integer|))
- "failed")
- $))
- T)
- ((|random| ($)) T)
- ((|random| ($ $)) T)
- ((|copy| ($ $)) T)
- ((|inc| ($ $)) T)
- ((|dec| ($ $)) T)
- ((|mask| ($ $)) T)
- ((|addmod| ($ $ $ $)) T)
- ((|submod| ($ $ $ $)) T)
- ((|mulmod| ($ $ $ $)) T)
- ((|powmod| ($ $ $ $)) T)
- ((|invmod| ($ $ $)) T))
- '((|multiplicativeValuation| T)
- (|canonicalUnitNormal| T))
- '((|Fraction| (|Integer|))
- (|Boolean|))
- NIL)))
- |IntegerNumberSystem|)
- (|setShellEntry| #0# 0 '(|IntegerNumberSystem|))))))
+ (LET ((#0=#:G1413
+ (|sublisV|
+ (PAIR '(#1=#:G1407 #2=#:G1408 #3=#:G1409 #4=#:G1410
+ #5=#:G1411 #6=#:G1412)
+ (LIST '(|Integer|) '(|Integer|) '(|Integer|)
+ '(|InputForm|) '(|Pattern| (|Integer|))
+ '(|Integer|)))
+ (|Join| (|UniqueFactorizationDomain|)
+ (|EuclideanDomain|) (|OrderedIntegralDomain|)
+ (|DifferentialRing|) (|ConvertibleTo| '#1#)
+ (|RetractableTo| '#2#)
+ (|LinearlyExplicitRingOver| '#3#)
+ (|ConvertibleTo| '#4#) (|ConvertibleTo| '#5#)
+ (|PatternMatchable| '#6#)
+ (|CombinatorialFunctionCategory|)
+ (|RealConstant|) (|CharacteristicZero|)
+ (|StepThrough|)
+ (|mkCategory| '|domain|
+ '(((|odd?| ((|Boolean|) $)) T)
+ ((|even?| ((|Boolean|) $)) T)
+ ((|base| ($)) T) ((|length| ($ $)) T)
+ ((|shift| ($ $ $)) T)
+ ((|bit?| ((|Boolean|) $ $)) T)
+ ((|positiveRemainder| ($ $ $)) T)
+ ((|symmetricRemainder| ($ $ $)) T)
+ ((|rational?| ((|Boolean|) $)) T)
+ ((|rational|
+ ((|Fraction| (|Integer|)) $))
+ T)
+ ((|rationalIfCan|
+ ((|Union| (|Fraction| (|Integer|))
+ "failed")
+ $))
+ T)
+ ((|random| ($)) T) ((|random| ($ $)) T)
+ ((|copy| ($ $)) T) ((|inc| ($ $)) T)
+ ((|dec| ($ $)) T) ((|mask| ($ $)) T)
+ ((|addmod| ($ $ $ $)) T)
+ ((|submod| ($ $ $ $)) T)
+ ((|mulmod| ($ $ $ $)) T)
+ ((|powmod| ($ $ $ $)) T)
+ ((|invmod| ($ $ $)) T))
+ '((|multiplicativeValuation| T)
+ (|canonicalUnitNormal| T))
+ '((|Fraction| (|Integer|)) (|Boolean|))
+ NIL)))))
+ (|setShellEntry| #0# 0 '(|IntegerNumberSystem|))
+ #0#))
(DEFUN |IntegerNumberSystem| ()
- (LET ()
- (COND
- (|IntegerNumberSystem;AL|)
- (T (SETQ |IntegerNumberSystem;AL| (|IntegerNumberSystem;|))))))
+ (COND
+ (|IntegerNumberSystem;AL|)
+ (T (SETQ |IntegerNumberSystem;AL| (|IntegerNumberSystem;|)))))
(MAKEPROP '|IntegerNumberSystem| 'NILADIC T)
diff --git a/src/algebra/strap/INTDOM.lsp b/src/algebra/strap/INTDOM.lsp
index 383d7838..82872ee3 100644
--- a/src/algebra/strap/INTDOM.lsp
+++ b/src/algebra/strap/INTDOM.lsp
@@ -4,31 +4,26 @@
(DEFPARAMETER |IntegralDomain;AL| 'NIL)
(DEFUN |IntegralDomain;| ()
- (PROG (#0=#:G1402)
- (RETURN
- (PROG1 (LETT #0#
- (|Join| (|CommutativeRing|) (|Algebra| '$)
- (|EntireRing|)
- (|mkCategory| '|domain|
- '(((|exquo| ((|Union| $ "failed") $ $))
- T)
- ((|unitNormal|
- ((|Record| (|:| |unit| $)
- (|:| |canonical| $)
- (|:| |associate| $))
- $))
- T)
- ((|unitCanonical| ($ $)) T)
- ((|associates?| ((|Boolean|) $ $)) T)
- ((|unit?| ((|Boolean|) $)) T))
- NIL '((|Boolean|)) NIL))
- |IntegralDomain|)
- (|setShellEntry| #0# 0 '(|IntegralDomain|))))))
+ (LET ((#0=#:G1402
+ (|Join| (|CommutativeRing|) (|Algebra| '$) (|EntireRing|)
+ (|mkCategory| '|domain|
+ '(((|exquo| ((|Union| $ "failed") $ $)) T)
+ ((|unitNormal|
+ ((|Record| (|:| |unit| $)
+ (|:| |canonical| $)
+ (|:| |associate| $))
+ $))
+ T)
+ ((|unitCanonical| ($ $)) T)
+ ((|associates?| ((|Boolean|) $ $)) T)
+ ((|unit?| ((|Boolean|) $)) T))
+ NIL '((|Boolean|)) NIL))))
+ (|setShellEntry| #0# 0 '(|IntegralDomain|))
+ #0#))
(DEFUN |IntegralDomain| ()
- (LET ()
- (COND
- (|IntegralDomain;AL|)
- (T (SETQ |IntegralDomain;AL| (|IntegralDomain;|))))))
+ (COND
+ (|IntegralDomain;AL|)
+ (T (SETQ |IntegralDomain;AL| (|IntegralDomain;|)))))
(MAKEPROP '|IntegralDomain| 'NILADIC T)
diff --git a/src/algebra/strap/LNAGG.lsp b/src/algebra/strap/LNAGG.lsp
index ce7cf516..fe5b1777 100644
--- a/src/algebra/strap/LNAGG.lsp
+++ b/src/algebra/strap/LNAGG.lsp
@@ -6,22 +6,17 @@
(DEFPARAMETER |LinearAggregate;AL| 'NIL)
(DEFUN |LinearAggregate;| (|t#1|)
- (PROG (#0=#:G1399)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV|
- (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
- (|sublisV|
- (PAIR '(#1=#:G1397 #2=#:G1398)
- (LIST '(|Integer|)
- '(|UniversalSegment|
- (|Integer|))))
- (COND
- (|LinearAggregate;CAT|)
- ('T
- (LETT |LinearAggregate;CAT|
- (|Join|
- (|IndexedAggregate| '#1# '|t#1|)
+ (LET ((#0=#:G1399
+ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
+ (|sublisV|
+ (PAIR '(#1=#:G1397 #2=#:G1398)
+ (LIST '(|Integer|)
+ '(|UniversalSegment| (|Integer|))))
+ (COND
+ (|LinearAggregate;CAT|)
+ ('T
+ (LETT |LinearAggregate;CAT|
+ (|Join| (|IndexedAggregate| '#1# '|t#1|)
(|Collection| '|t#1|)
(|Eltable| '#2# '$)
(|mkCategory| '|domain|
@@ -65,17 +60,18 @@
(|Integer|) (|List| $)
(|NonNegativeInteger|))
NIL))
- . #3=(|LinearAggregate|)))))) . #3#)
- (|setShellEntry| #0# 0
- (LIST '|LinearAggregate| (|devaluate| |t#1|)))))))
+ |LinearAggregate|)))))))
+ (|setShellEntry| #0# 0
+ (LIST '|LinearAggregate| (|devaluate| |t#1|)))
+ #0#))
(DEFUN |LinearAggregate| (#0=#:G1400)
- (LET (#1=#:G1401)
+ (LET ((#1=#:G1401 (|assoc| (|devaluate| #0#) |LinearAggregate;AL|)))
(COND
- ((SETQ #1# (|assoc| (|devaluate| #0#) |LinearAggregate;AL|))
- (CDR #1#))
- (T (SETQ |LinearAggregate;AL|
- (|cons5| (CONS (|devaluate| #0#)
- (SETQ #1# (|LinearAggregate;| #0#)))
- |LinearAggregate;AL|))
- #1#))))
+ (#1# (CDR #1#))
+ (T (PROGN
+ (SETQ #1# (|LinearAggregate;| #0#))
+ (SETQ |LinearAggregate;AL|
+ (|cons5| (CONS (|devaluate| #0#) #1#)
+ |LinearAggregate;AL|))
+ #1#)))))
diff --git a/src/algebra/strap/LSAGG.lsp b/src/algebra/strap/LSAGG.lsp
index 03de8f30..7a168bdd 100644
--- a/src/algebra/strap/LSAGG.lsp
+++ b/src/algebra/strap/LSAGG.lsp
@@ -6,34 +6,29 @@
(DEFPARAMETER |ListAggregate;AL| 'NIL)
(DEFUN |ListAggregate;| (|t#1|)
- (PROG (#0=#:G1429)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV|
- (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
- (COND
- (|ListAggregate;CAT|)
- ('T
- (LETT |ListAggregate;CAT|
- (|Join| (|StreamAggregate| '|t#1|)
- (|FiniteLinearAggregate|
- '|t#1|)
- (|ExtensibleLinearAggregate|
- '|t#1|)
- (|mkCategory| '|domain|
- '(((|list| ($ |t#1|)) T)) NIL
- 'NIL NIL))
- . #1=(|ListAggregate|))))) . #1#)
- (|setShellEntry| #0# 0
- (LIST '|ListAggregate| (|devaluate| |t#1|)))))))
+ (LET ((#0=#:G1429
+ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
+ (COND
+ (|ListAggregate;CAT|)
+ ('T
+ (LETT |ListAggregate;CAT|
+ (|Join| (|StreamAggregate| '|t#1|)
+ (|FiniteLinearAggregate| '|t#1|)
+ (|ExtensibleLinearAggregate| '|t#1|)
+ (|mkCategory| '|domain|
+ '(((|list| ($ |t#1|)) T)) NIL 'NIL
+ NIL))
+ |ListAggregate|))))))
+ (|setShellEntry| #0# 0 (LIST '|ListAggregate| (|devaluate| |t#1|)))
+ #0#))
(DEFUN |ListAggregate| (#0=#:G1430)
- (LET (#1=#:G1431)
+ (LET ((#1=#:G1431 (|assoc| (|devaluate| #0#) |ListAggregate;AL|)))
(COND
- ((SETQ #1# (|assoc| (|devaluate| #0#) |ListAggregate;AL|))
- (CDR #1#))
- (T (SETQ |ListAggregate;AL|
- (|cons5| (CONS (|devaluate| #0#)
- (SETQ #1# (|ListAggregate;| #0#)))
- |ListAggregate;AL|))
- #1#))))
+ (#1# (CDR #1#))
+ (T (PROGN
+ (SETQ #1# (|ListAggregate;| #0#))
+ (SETQ |ListAggregate;AL|
+ (|cons5| (CONS (|devaluate| #0#) #1#)
+ |ListAggregate;AL|))
+ #1#)))))
diff --git a/src/algebra/strap/MONOID.lsp b/src/algebra/strap/MONOID.lsp
index 538e9b0e..2fc46389 100644
--- a/src/algebra/strap/MONOID.lsp
+++ b/src/algebra/strap/MONOID.lsp
@@ -4,23 +4,19 @@
(DEFPARAMETER |Monoid;AL| 'NIL)
(DEFUN |Monoid;| ()
- (PROG (#0=#:G1398)
- (RETURN
- (PROG1 (LETT #0#
- (|Join| (|SemiGroup|)
- (|mkCategory| '|domain|
- '(((|One| ($) |constant|) T)
- ((|sample| ($) |constant|) T)
- ((|one?| ((|Boolean|) $)) T)
- ((** ($ $ (|NonNegativeInteger|))) T)
- ((|recip| ((|Union| $ "failed") $)) T))
- NIL
- '((|NonNegativeInteger|) (|Boolean|))
- NIL))
- |Monoid|)
- (|setShellEntry| #0# 0 '(|Monoid|))))))
+ (LET ((#0=#:G1398
+ (|Join| (|SemiGroup|)
+ (|mkCategory| '|domain|
+ '(((|One| ($) |constant|) T)
+ ((|sample| ($) |constant|) T)
+ ((|one?| ((|Boolean|) $)) T)
+ ((** ($ $ (|NonNegativeInteger|))) T)
+ ((|recip| ((|Union| $ "failed") $)) T))
+ NIL '((|NonNegativeInteger|) (|Boolean|)) NIL))))
+ (|setShellEntry| #0# 0 '(|Monoid|))
+ #0#))
(DEFUN |Monoid| ()
- (LET () (COND (|Monoid;AL|) (T (SETQ |Monoid;AL| (|Monoid;|))))))
+ (COND (|Monoid;AL|) (T (SETQ |Monoid;AL| (|Monoid;|)))))
(MAKEPROP '|Monoid| 'NILADIC T)
diff --git a/src/algebra/strap/MTSCAT.lsp b/src/algebra/strap/MTSCAT.lsp
index 52c28886..c32aefde 100644
--- a/src/algebra/strap/MTSCAT.lsp
+++ b/src/algebra/strap/MTSCAT.lsp
@@ -6,22 +6,18 @@
(DEFPARAMETER |MultivariateTaylorSeriesCategory;AL| 'NIL)
(DEFUN |MultivariateTaylorSeriesCategory;| (|t#1| |t#2|)
- (PROG (#0=#:G1398)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV|
- (PAIR '(|t#1| |t#2|)
- (LIST (|devaluate| |t#1|)
- (|devaluate| |t#2|)))
- (|sublisV|
- (PAIR '(#1=#:G1397)
- (LIST '(|IndexedExponents| |t#2|)))
- (COND
- (|MultivariateTaylorSeriesCategory;CAT|)
- ('T
- (LETT |MultivariateTaylorSeriesCategory;CAT|
- (|Join|
- (|PartialDifferentialRing| '|t#2|)
+ (LET ((#0=#:G1398
+ (|sublisV|
+ (PAIR '(|t#1| |t#2|)
+ (LIST (|devaluate| |t#1|) (|devaluate| |t#2|)))
+ (|sublisV|
+ (PAIR '(#1=#:G1397)
+ (LIST '(|IndexedExponents| |t#2|)))
+ (COND
+ (|MultivariateTaylorSeriesCategory;CAT|)
+ ('T
+ (LETT |MultivariateTaylorSeriesCategory;CAT|
+ (|Join| (|PartialDifferentialRing| '|t#2|)
(|PowerSeriesCategory| '|t#1| '#1#
'|t#2|)
(|InnerEvalable| '|t#2| '$)
@@ -83,25 +79,23 @@
(|List| |t#2|)
(|List| (|NonNegativeInteger|)))
NIL))
- . #2=(|MultivariateTaylorSeriesCategory|)))))) . #2#)
- (|setShellEntry| #0# 0
- (LIST '|MultivariateTaylorSeriesCategory|
- (|devaluate| |t#1|) (|devaluate| |t#2|)))))))
+ |MultivariateTaylorSeriesCategory|)))))))
+ (|setShellEntry| #0# 0
+ (LIST '|MultivariateTaylorSeriesCategory| (|devaluate| |t#1|)
+ (|devaluate| |t#2|)))
+ #0#))
(DEFUN |MultivariateTaylorSeriesCategory|
(&REST #0=#:G1401 &AUX #1=#:G1399)
(DSETQ #1# #0#)
- (LET (#2=#:G1400)
+ (LET ((#2=#:G1400
+ (|assoc| (|devaluateList| #1#)
+ |MultivariateTaylorSeriesCategory;AL|)))
(COND
- ((SETQ #2#
- (|assoc| (|devaluateList| #1#)
- |MultivariateTaylorSeriesCategory;AL|))
- (CDR #2#))
- (T (SETQ |MultivariateTaylorSeriesCategory;AL|
- (|cons5| (CONS (|devaluateList| #1#)
- (SETQ #2#
- (APPLY
- #'|MultivariateTaylorSeriesCategory;|
- #1#)))
- |MultivariateTaylorSeriesCategory;AL|))
- #2#))))
+ (#2# (CDR #2#))
+ (T (PROGN
+ (SETQ #2# (APPLY #'|MultivariateTaylorSeriesCategory;| #1#))
+ (SETQ |MultivariateTaylorSeriesCategory;AL|
+ (|cons5| (CONS (|devaluateList| #1#) #2#)
+ |MultivariateTaylorSeriesCategory;AL|))
+ #2#)))))
diff --git a/src/algebra/strap/OINTDOM.lsp b/src/algebra/strap/OINTDOM.lsp
index 20250a95..fec16d2e 100644
--- a/src/algebra/strap/OINTDOM.lsp
+++ b/src/algebra/strap/OINTDOM.lsp
@@ -4,16 +4,13 @@
(DEFPARAMETER |OrderedIntegralDomain;AL| 'NIL)
(DEFUN |OrderedIntegralDomain;| ()
- (PROG (#0=#:G1396)
- (RETURN
- (PROG1 (LETT #0# (|Join| (|IntegralDomain|) (|OrderedRing|))
- |OrderedIntegralDomain|)
- (|setShellEntry| #0# 0 '(|OrderedIntegralDomain|))))))
+ (LET ((#0=#:G1396 (|Join| (|IntegralDomain|) (|OrderedRing|))))
+ (|setShellEntry| #0# 0 '(|OrderedIntegralDomain|))
+ #0#))
(DEFUN |OrderedIntegralDomain| ()
- (LET ()
- (COND
- (|OrderedIntegralDomain;AL|)
- (T (SETQ |OrderedIntegralDomain;AL| (|OrderedIntegralDomain;|))))))
+ (COND
+ (|OrderedIntegralDomain;AL|)
+ (T (SETQ |OrderedIntegralDomain;AL| (|OrderedIntegralDomain;|)))))
(MAKEPROP '|OrderedIntegralDomain| 'NILADIC T)
diff --git a/src/algebra/strap/ORDRING.lsp b/src/algebra/strap/ORDRING.lsp
index c5109a0a..e25fce4e 100644
--- a/src/algebra/strap/ORDRING.lsp
+++ b/src/algebra/strap/ORDRING.lsp
@@ -4,23 +4,20 @@
(DEFPARAMETER |OrderedRing;AL| 'NIL)
(DEFUN |OrderedRing;| ()
- (PROG (#0=#:G1402)
- (RETURN
- (PROG1 (LETT #0#
- (|Join| (|OrderedAbelianGroup|) (|Ring|) (|Monoid|)
- (|mkCategory| '|domain|
- '(((|positive?| ((|Boolean|) $)) T)
- ((|negative?| ((|Boolean|) $)) T)
- ((|sign| ((|Integer|) $)) T)
- ((|abs| ($ $)) T))
- NIL '((|Integer|) (|Boolean|)) NIL))
- |OrderedRing|)
- (|setShellEntry| #0# 0 '(|OrderedRing|))))))
+ (LET ((#0=#:G1402
+ (|Join| (|OrderedAbelianGroup|) (|Ring|) (|Monoid|)
+ (|mkCategory| '|domain|
+ '(((|positive?| ((|Boolean|) $)) T)
+ ((|negative?| ((|Boolean|) $)) T)
+ ((|sign| ((|Integer|) $)) T)
+ ((|abs| ($ $)) T))
+ NIL '((|Integer|) (|Boolean|)) NIL))))
+ (|setShellEntry| #0# 0 '(|OrderedRing|))
+ #0#))
(DEFUN |OrderedRing| ()
- (LET ()
- (COND
- (|OrderedRing;AL|)
- (T (SETQ |OrderedRing;AL| (|OrderedRing;|))))))
+ (COND
+ (|OrderedRing;AL|)
+ (T (SETQ |OrderedRing;AL| (|OrderedRing;|)))))
(MAKEPROP '|OrderedRing| 'NILADIC T)
diff --git a/src/algebra/strap/POLYCAT.lsp b/src/algebra/strap/POLYCAT.lsp
index 83429409..51c4e0b2 100644
--- a/src/algebra/strap/POLYCAT.lsp
+++ b/src/algebra/strap/POLYCAT.lsp
@@ -6,230 +6,213 @@
(DEFPARAMETER |PolynomialCategory;AL| 'NIL)
(DEFUN |PolynomialCategory;| (|t#1| |t#2| |t#3|)
- (PROG (#0=#:G1415)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV|
- (PAIR '(|t#1| |t#2| |t#3|)
- (LIST (|devaluate| |t#1|)
- (|devaluate| |t#2|)
- (|devaluate| |t#3|)))
- (COND
- (|PolynomialCategory;CAT|)
- ('T
- (LETT |PolynomialCategory;CAT|
- (|Join| (|PartialDifferentialRing|
- '|t#3|)
- (|FiniteAbelianMonoidRing|
- '|t#1| '|t#2|)
- (|Evalable| '$)
- (|InnerEvalable| '|t#3| '|t#1|)
- (|InnerEvalable| '|t#3| '$)
- (|RetractableTo| '|t#3|)
- (|FullyLinearlyExplicitRingOver|
- '|t#1|)
- (|mkCategory| '|domain|
- '(((|degree|
- ((|NonNegativeInteger|) $
- |t#3|))
- T)
- ((|degree|
- ((|List|
- (|NonNegativeInteger|))
- $ (|List| |t#3|)))
- T)
- ((|coefficient|
- ($ $ |t#3|
- (|NonNegativeInteger|)))
- T)
- ((|coefficient|
- ($ $ (|List| |t#3|)
- (|List|
- (|NonNegativeInteger|))))
- T)
- ((|monomials|
- ((|List| $) $))
- T)
- ((|univariate|
- ((|SparseUnivariatePolynomial|
- $)
- $ |t#3|))
- T)
- ((|univariate|
- ((|SparseUnivariatePolynomial|
- |t#1|)
- $))
- T)
- ((|mainVariable|
- ((|Union| |t#3| "failed")
- $))
- T)
- ((|minimumDegree|
- ((|NonNegativeInteger|) $
- |t#3|))
- T)
- ((|minimumDegree|
- ((|List|
- (|NonNegativeInteger|))
- $ (|List| |t#3|)))
- T)
- ((|monicDivide|
- ((|Record|
- (|:| |quotient| $)
- (|:| |remainder| $))
- $ $ |t#3|))
- T)
- ((|monomial|
- ($ $ |t#3|
- (|NonNegativeInteger|)))
- T)
- ((|monomial|
- ($ $ (|List| |t#3|)
- (|List|
- (|NonNegativeInteger|))))
- T)
- ((|multivariate|
- ($
- (|SparseUnivariatePolynomial|
- |t#1|)
- |t#3|))
- T)
- ((|multivariate|
- ($
- (|SparseUnivariatePolynomial|
- $)
- |t#3|))
- T)
- ((|isPlus|
- ((|Union| (|List| $)
- "failed")
- $))
- T)
- ((|isTimes|
- ((|Union| (|List| $)
- "failed")
- $))
- T)
- ((|isExpt|
- ((|Union|
- (|Record|
- (|:| |var| |t#3|)
- (|:| |exponent|
- (|NonNegativeInteger|)))
- "failed")
- $))
- T)
- ((|totalDegree|
- ((|NonNegativeInteger|) $))
- T)
- ((|totalDegree|
- ((|NonNegativeInteger|) $
- (|List| |t#3|)))
- T)
- ((|variables|
- ((|List| |t#3|) $))
- T)
- ((|primitiveMonomials|
- ((|List| $) $))
- T)
- ((|resultant| ($ $ $ |t#3|))
- (|has| |t#1|
- (|CommutativeRing|)))
- ((|discriminant|
- ($ $ |t#3|))
- (|has| |t#1|
- (|CommutativeRing|)))
- ((|content| ($ $ |t#3|))
- (|has| |t#1| (|GcdDomain|)))
- ((|primitivePart| ($ $))
- (|has| |t#1| (|GcdDomain|)))
- ((|primitivePart|
- ($ $ |t#3|))
- (|has| |t#1| (|GcdDomain|)))
- ((|squareFree|
- ((|Factored| $) $))
- (|has| |t#1| (|GcdDomain|)))
- ((|squareFreePart| ($ $))
- (|has| |t#1| (|GcdDomain|))))
- '(((|ConvertibleTo|
- (|InputForm|))
- (AND
- (|has| |t#3|
- (|ConvertibleTo|
- (|InputForm|)))
- (|has| |t#1|
- (|ConvertibleTo|
- (|InputForm|)))))
- ((|ConvertibleTo|
- (|Pattern| (|Integer|)))
- (AND
- (|has| |t#3|
- (|ConvertibleTo|
- (|Pattern| (|Integer|))))
- (|has| |t#1|
- (|ConvertibleTo|
- (|Pattern| (|Integer|))))))
- ((|ConvertibleTo|
- (|Pattern| (|Float|)))
- (AND
- (|has| |t#3|
- (|ConvertibleTo|
- (|Pattern| (|Float|))))
- (|has| |t#1|
- (|ConvertibleTo|
- (|Pattern| (|Float|))))))
- ((|PatternMatchable|
- (|Integer|))
- (AND
- (|has| |t#3|
- (|PatternMatchable|
- (|Integer|)))
- (|has| |t#1|
- (|PatternMatchable|
- (|Integer|)))))
- ((|PatternMatchable|
- (|Float|))
- (AND
- (|has| |t#3|
- (|PatternMatchable|
- (|Float|)))
- (|has| |t#1|
- (|PatternMatchable|
- (|Float|)))))
- ((|GcdDomain|)
- (|has| |t#1| (|GcdDomain|)))
- (|canonicalUnitNormal|
- (|has| |t#1|
- (ATTRIBUTE
- |canonicalUnitNormal|)))
- ((|PolynomialFactorizationExplicit|)
- (|has| |t#1|
- (|PolynomialFactorizationExplicit|))))
- '((|Factored| $) (|List| $)
- (|List| |t#3|)
- (|NonNegativeInteger|)
- (|SparseUnivariatePolynomial|
- $)
- (|SparseUnivariatePolynomial|
- |t#1|)
- (|List|
- (|NonNegativeInteger|)))
- NIL))
- . #1=(|PolynomialCategory|))))) . #1#)
- (|setShellEntry| #0# 0
- (LIST '|PolynomialCategory| (|devaluate| |t#1|)
- (|devaluate| |t#2|) (|devaluate| |t#3|)))))))
+ (LET ((#0=#:G1415
+ (|sublisV|
+ (PAIR '(|t#1| |t#2| |t#3|)
+ (LIST (|devaluate| |t#1|) (|devaluate| |t#2|)
+ (|devaluate| |t#3|)))
+ (COND
+ (|PolynomialCategory;CAT|)
+ ('T
+ (LETT |PolynomialCategory;CAT|
+ (|Join| (|PartialDifferentialRing| '|t#3|)
+ (|FiniteAbelianMonoidRing| '|t#1|
+ '|t#2|)
+ (|Evalable| '$)
+ (|InnerEvalable| '|t#3| '|t#1|)
+ (|InnerEvalable| '|t#3| '$)
+ (|RetractableTo| '|t#3|)
+ (|FullyLinearlyExplicitRingOver|
+ '|t#1|)
+ (|mkCategory| '|domain|
+ '(((|degree|
+ ((|NonNegativeInteger|) $
+ |t#3|))
+ T)
+ ((|degree|
+ ((|List|
+ (|NonNegativeInteger|))
+ $ (|List| |t#3|)))
+ T)
+ ((|coefficient|
+ ($ $ |t#3|
+ (|NonNegativeInteger|)))
+ T)
+ ((|coefficient|
+ ($ $ (|List| |t#3|)
+ (|List|
+ (|NonNegativeInteger|))))
+ T)
+ ((|monomials| ((|List| $) $)) T)
+ ((|univariate|
+ ((|SparseUnivariatePolynomial|
+ $)
+ $ |t#3|))
+ T)
+ ((|univariate|
+ ((|SparseUnivariatePolynomial|
+ |t#1|)
+ $))
+ T)
+ ((|mainVariable|
+ ((|Union| |t#3| "failed") $))
+ T)
+ ((|minimumDegree|
+ ((|NonNegativeInteger|) $
+ |t#3|))
+ T)
+ ((|minimumDegree|
+ ((|List|
+ (|NonNegativeInteger|))
+ $ (|List| |t#3|)))
+ T)
+ ((|monicDivide|
+ ((|Record| (|:| |quotient| $)
+ (|:| |remainder| $))
+ $ $ |t#3|))
+ T)
+ ((|monomial|
+ ($ $ |t#3|
+ (|NonNegativeInteger|)))
+ T)
+ ((|monomial|
+ ($ $ (|List| |t#3|)
+ (|List|
+ (|NonNegativeInteger|))))
+ T)
+ ((|multivariate|
+ ($
+ (|SparseUnivariatePolynomial|
+ |t#1|)
+ |t#3|))
+ T)
+ ((|multivariate|
+ ($
+ (|SparseUnivariatePolynomial|
+ $)
+ |t#3|))
+ T)
+ ((|isPlus|
+ ((|Union| (|List| $) "failed")
+ $))
+ T)
+ ((|isTimes|
+ ((|Union| (|List| $) "failed")
+ $))
+ T)
+ ((|isExpt|
+ ((|Union|
+ (|Record| (|:| |var| |t#3|)
+ (|:| |exponent|
+ (|NonNegativeInteger|)))
+ "failed")
+ $))
+ T)
+ ((|totalDegree|
+ ((|NonNegativeInteger|) $))
+ T)
+ ((|totalDegree|
+ ((|NonNegativeInteger|) $
+ (|List| |t#3|)))
+ T)
+ ((|variables|
+ ((|List| |t#3|) $))
+ T)
+ ((|primitiveMonomials|
+ ((|List| $) $))
+ T)
+ ((|resultant| ($ $ $ |t#3|))
+ (|has| |t#1|
+ (|CommutativeRing|)))
+ ((|discriminant| ($ $ |t#3|))
+ (|has| |t#1|
+ (|CommutativeRing|)))
+ ((|content| ($ $ |t#3|))
+ (|has| |t#1| (|GcdDomain|)))
+ ((|primitivePart| ($ $))
+ (|has| |t#1| (|GcdDomain|)))
+ ((|primitivePart| ($ $ |t#3|))
+ (|has| |t#1| (|GcdDomain|)))
+ ((|squareFree|
+ ((|Factored| $) $))
+ (|has| |t#1| (|GcdDomain|)))
+ ((|squareFreePart| ($ $))
+ (|has| |t#1| (|GcdDomain|))))
+ '(((|ConvertibleTo| (|InputForm|))
+ (AND
+ (|has| |t#3|
+ (|ConvertibleTo|
+ (|InputForm|)))
+ (|has| |t#1|
+ (|ConvertibleTo|
+ (|InputForm|)))))
+ ((|ConvertibleTo|
+ (|Pattern| (|Integer|)))
+ (AND
+ (|has| |t#3|
+ (|ConvertibleTo|
+ (|Pattern| (|Integer|))))
+ (|has| |t#1|
+ (|ConvertibleTo|
+ (|Pattern| (|Integer|))))))
+ ((|ConvertibleTo|
+ (|Pattern| (|Float|)))
+ (AND
+ (|has| |t#3|
+ (|ConvertibleTo|
+ (|Pattern| (|Float|))))
+ (|has| |t#1|
+ (|ConvertibleTo|
+ (|Pattern| (|Float|))))))
+ ((|PatternMatchable|
+ (|Integer|))
+ (AND
+ (|has| |t#3|
+ (|PatternMatchable|
+ (|Integer|)))
+ (|has| |t#1|
+ (|PatternMatchable|
+ (|Integer|)))))
+ ((|PatternMatchable| (|Float|))
+ (AND
+ (|has| |t#3|
+ (|PatternMatchable|
+ (|Float|)))
+ (|has| |t#1|
+ (|PatternMatchable|
+ (|Float|)))))
+ ((|GcdDomain|)
+ (|has| |t#1| (|GcdDomain|)))
+ (|canonicalUnitNormal|
+ (|has| |t#1|
+ (ATTRIBUTE
+ |canonicalUnitNormal|)))
+ ((|PolynomialFactorizationExplicit|)
+ (|has| |t#1|
+ (|PolynomialFactorizationExplicit|))))
+ '((|Factored| $) (|List| $)
+ (|List| |t#3|)
+ (|NonNegativeInteger|)
+ (|SparseUnivariatePolynomial| $)
+ (|SparseUnivariatePolynomial|
+ |t#1|)
+ (|List| (|NonNegativeInteger|)))
+ NIL))
+ |PolynomialCategory|))))))
+ (|setShellEntry| #0# 0
+ (LIST '|PolynomialCategory| (|devaluate| |t#1|)
+ (|devaluate| |t#2|) (|devaluate| |t#3|)))
+ #0#))
(DEFUN |PolynomialCategory| (&REST #0=#:G1418 &AUX #1=#:G1416)
(DSETQ #1# #0#)
- (LET (#2=#:G1417)
+ (LET ((#2=#:G1417
+ (|assoc| (|devaluateList| #1#) |PolynomialCategory;AL|)))
(COND
- ((SETQ #2#
- (|assoc| (|devaluateList| #1#) |PolynomialCategory;AL|))
- (CDR #2#))
- (T (SETQ |PolynomialCategory;AL|
- (|cons5| (CONS (|devaluateList| #1#)
- (SETQ #2#
- (APPLY #'|PolynomialCategory;| #1#)))
- |PolynomialCategory;AL|))
- #2#))))
+ (#2# (CDR #2#))
+ (T (PROGN
+ (SETQ #2# (APPLY #'|PolynomialCategory;| #1#))
+ (SETQ |PolynomialCategory;AL|
+ (|cons5| (CONS (|devaluateList| #1#) #2#)
+ |PolynomialCategory;AL|))
+ #2#)))))
diff --git a/src/algebra/strap/QFCAT.lsp b/src/algebra/strap/QFCAT.lsp
index ce1aa731..f79694e0 100644
--- a/src/algebra/strap/QFCAT.lsp
+++ b/src/algebra/strap/QFCAT.lsp
@@ -6,100 +6,87 @@
(DEFPARAMETER |QuotientFieldCategory;AL| 'NIL)
(DEFUN |QuotientFieldCategory;| (|t#1|)
- (PROG (#0=#:G1398)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV|
- (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
- (COND
- (|QuotientFieldCategory;CAT|)
- ('T
- (LETT |QuotientFieldCategory;CAT|
- (|Join| (|Field|) (|Algebra| '|t#1|)
- (|RetractableTo| '|t#1|)
- (|FullyEvalableOver| '|t#1|)
- (|DifferentialExtension|
- '|t#1|)
- (|FullyLinearlyExplicitRingOver|
- '|t#1|)
- (|Patternable| '|t#1|)
- (|FullyPatternMatchable|
- '|t#1|)
- (|mkCategory| '|domain|
- '(((/ ($ |t#1| |t#1|)) T)
- ((|numer| (|t#1| $)) T)
- ((|denom| (|t#1| $)) T)
- ((|numerator| ($ $)) T)
- ((|denominator| ($ $)) T)
- ((|wholePart| (|t#1| $))
- (|has| |t#1|
- (|EuclideanDomain|)))
- ((|fractionPart| ($ $))
- (|has| |t#1|
- (|EuclideanDomain|)))
- ((|random| ($))
- (|has| |t#1|
- (|IntegerNumberSystem|)))
- ((|ceiling| (|t#1| $))
- (|has| |t#1|
- (|IntegerNumberSystem|)))
- ((|floor| (|t#1| $))
- (|has| |t#1|
- (|IntegerNumberSystem|))))
- '(((|StepThrough|)
- (|has| |t#1|
- (|StepThrough|)))
- ((|RetractableTo|
- (|Integer|))
- (|has| |t#1|
- (|RetractableTo|
- (|Integer|))))
- ((|RetractableTo|
- (|Fraction| (|Integer|)))
- (|has| |t#1|
- (|RetractableTo|
- (|Integer|))))
- ((|OrderedSet|)
- (|has| |t#1|
- (|OrderedSet|)))
- ((|OrderedIntegralDomain|)
- (|has| |t#1|
- (|OrderedIntegralDomain|)))
- ((|RealConstant|)
- (|has| |t#1|
- (|RealConstant|)))
- ((|ConvertibleTo|
- (|InputForm|))
- (|has| |t#1|
- (|ConvertibleTo|
- (|InputForm|))))
- ((|CharacteristicZero|)
- (|has| |t#1|
- (|CharacteristicZero|)))
- ((|CharacteristicNonZero|)
- (|has| |t#1|
- (|CharacteristicNonZero|)))
- ((|RetractableTo|
- (|Symbol|))
- (|has| |t#1|
- (|RetractableTo|
- (|Symbol|))))
- ((|PolynomialFactorizationExplicit|)
- (|has| |t#1|
- (|PolynomialFactorizationExplicit|))))
- 'NIL NIL))
- . #1=(|QuotientFieldCategory|))))) . #1#)
- (|setShellEntry| #0# 0
- (LIST '|QuotientFieldCategory| (|devaluate| |t#1|)))))))
+ (LET ((#0=#:G1398
+ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
+ (COND
+ (|QuotientFieldCategory;CAT|)
+ ('T
+ (LETT |QuotientFieldCategory;CAT|
+ (|Join| (|Field|) (|Algebra| '|t#1|)
+ (|RetractableTo| '|t#1|)
+ (|FullyEvalableOver| '|t#1|)
+ (|DifferentialExtension| '|t#1|)
+ (|FullyLinearlyExplicitRingOver|
+ '|t#1|)
+ (|Patternable| '|t#1|)
+ (|FullyPatternMatchable| '|t#1|)
+ (|mkCategory| '|domain|
+ '(((/ ($ |t#1| |t#1|)) T)
+ ((|numer| (|t#1| $)) T)
+ ((|denom| (|t#1| $)) T)
+ ((|numerator| ($ $)) T)
+ ((|denominator| ($ $)) T)
+ ((|wholePart| (|t#1| $))
+ (|has| |t#1|
+ (|EuclideanDomain|)))
+ ((|fractionPart| ($ $))
+ (|has| |t#1|
+ (|EuclideanDomain|)))
+ ((|random| ($))
+ (|has| |t#1|
+ (|IntegerNumberSystem|)))
+ ((|ceiling| (|t#1| $))
+ (|has| |t#1|
+ (|IntegerNumberSystem|)))
+ ((|floor| (|t#1| $))
+ (|has| |t#1|
+ (|IntegerNumberSystem|))))
+ '(((|StepThrough|)
+ (|has| |t#1| (|StepThrough|)))
+ ((|RetractableTo| (|Integer|))
+ (|has| |t#1|
+ (|RetractableTo| (|Integer|))))
+ ((|RetractableTo|
+ (|Fraction| (|Integer|)))
+ (|has| |t#1|
+ (|RetractableTo| (|Integer|))))
+ ((|OrderedSet|)
+ (|has| |t#1| (|OrderedSet|)))
+ ((|OrderedIntegralDomain|)
+ (|has| |t#1|
+ (|OrderedIntegralDomain|)))
+ ((|RealConstant|)
+ (|has| |t#1| (|RealConstant|)))
+ ((|ConvertibleTo| (|InputForm|))
+ (|has| |t#1|
+ (|ConvertibleTo|
+ (|InputForm|))))
+ ((|CharacteristicZero|)
+ (|has| |t#1|
+ (|CharacteristicZero|)))
+ ((|CharacteristicNonZero|)
+ (|has| |t#1|
+ (|CharacteristicNonZero|)))
+ ((|RetractableTo| (|Symbol|))
+ (|has| |t#1|
+ (|RetractableTo| (|Symbol|))))
+ ((|PolynomialFactorizationExplicit|)
+ (|has| |t#1|
+ (|PolynomialFactorizationExplicit|))))
+ 'NIL NIL))
+ |QuotientFieldCategory|))))))
+ (|setShellEntry| #0# 0
+ (LIST '|QuotientFieldCategory| (|devaluate| |t#1|)))
+ #0#))
(DEFUN |QuotientFieldCategory| (#0=#:G1399)
- (LET (#1=#:G1400)
+ (LET ((#1=#:G1400
+ (|assoc| (|devaluate| #0#) |QuotientFieldCategory;AL|)))
(COND
- ((SETQ #1#
- (|assoc| (|devaluate| #0#) |QuotientFieldCategory;AL|))
- (CDR #1#))
- (T (SETQ |QuotientFieldCategory;AL|
- (|cons5| (CONS (|devaluate| #0#)
- (SETQ #1# (|QuotientFieldCategory;| #0#)))
- |QuotientFieldCategory;AL|))
- #1#))))
+ (#1# (CDR #1#))
+ (T (PROGN
+ (SETQ #1# (|QuotientFieldCategory;| #0#))
+ (SETQ |QuotientFieldCategory;AL|
+ (|cons5| (CONS (|devaluate| #0#) #1#)
+ |QuotientFieldCategory;AL|))
+ #1#)))))
diff --git a/src/algebra/strap/RCAGG.lsp b/src/algebra/strap/RCAGG.lsp
index 2d2d62e0..fd66583b 100644
--- a/src/algebra/strap/RCAGG.lsp
+++ b/src/algebra/strap/RCAGG.lsp
@@ -6,70 +6,55 @@
(DEFPARAMETER |RecursiveAggregate;AL| 'NIL)
(DEFUN |RecursiveAggregate;| (|t#1|)
- (PROG (#0=#:G1396)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV|
- (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
- (COND
- (|RecursiveAggregate;CAT|)
- ('T
- (LETT |RecursiveAggregate;CAT|
- (|Join| (|HomogeneousAggregate| '|t#1|)
- (|mkCategory| '|domain|
- '(((|children| ((|List| $) $))
- T)
- ((|nodes| ((|List| $) $)) T)
- ((|leaf?| ((|Boolean|) $))
- T)
- ((|value| (|t#1| $)) T)
- ((|elt| (|t#1| $ "value"))
- T)
- ((|cyclic?| ((|Boolean|) $))
- T)
- ((|leaves|
- ((|List| |t#1|) $))
- T)
- ((|distance|
- ((|Integer|) $ $))
- T)
- ((|child?|
- ((|Boolean|) $ $))
- (|has| |t#1|
- (|SetCategory|)))
- ((|node?| ((|Boolean|) $ $))
- (|has| |t#1|
- (|SetCategory|)))
- ((|setchildren!|
- ($ $ (|List| $)))
- (|has| $
- (ATTRIBUTE
- |shallowlyMutable|)))
- ((|setelt|
- (|t#1| $ "value" |t#1|))
- (|has| $
- (ATTRIBUTE
- |shallowlyMutable|)))
- ((|setvalue!|
- (|t#1| $ |t#1|))
- (|has| $
- (ATTRIBUTE
- |shallowlyMutable|))))
- NIL
- '((|List| $) (|Boolean|)
- (|Integer|) (|List| |t#1|))
- NIL))
- . #1=(|RecursiveAggregate|))))) . #1#)
- (|setShellEntry| #0# 0
- (LIST '|RecursiveAggregate| (|devaluate| |t#1|)))))))
+ (LET ((#0=#:G1396
+ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
+ (COND
+ (|RecursiveAggregate;CAT|)
+ ('T
+ (LETT |RecursiveAggregate;CAT|
+ (|Join| (|HomogeneousAggregate| '|t#1|)
+ (|mkCategory| '|domain|
+ '(((|children| ((|List| $) $)) T)
+ ((|nodes| ((|List| $) $)) T)
+ ((|leaf?| ((|Boolean|) $)) T)
+ ((|value| (|t#1| $)) T)
+ ((|elt| (|t#1| $ "value")) T)
+ ((|cyclic?| ((|Boolean|) $)) T)
+ ((|leaves| ((|List| |t#1|) $))
+ T)
+ ((|distance| ((|Integer|) $ $))
+ T)
+ ((|child?| ((|Boolean|) $ $))
+ (|has| |t#1| (|SetCategory|)))
+ ((|node?| ((|Boolean|) $ $))
+ (|has| |t#1| (|SetCategory|)))
+ ((|setchildren!|
+ ($ $ (|List| $)))
+ (|has| $
+ (ATTRIBUTE |shallowlyMutable|)))
+ ((|setelt|
+ (|t#1| $ "value" |t#1|))
+ (|has| $
+ (ATTRIBUTE |shallowlyMutable|)))
+ ((|setvalue!| (|t#1| $ |t#1|))
+ (|has| $
+ (ATTRIBUTE |shallowlyMutable|))))
+ NIL
+ '((|List| $) (|Boolean|)
+ (|Integer|) (|List| |t#1|))
+ NIL))
+ |RecursiveAggregate|))))))
+ (|setShellEntry| #0# 0
+ (LIST '|RecursiveAggregate| (|devaluate| |t#1|)))
+ #0#))
(DEFUN |RecursiveAggregate| (#0=#:G1397)
- (LET (#1=#:G1398)
+ (LET ((#1=#:G1398 (|assoc| (|devaluate| #0#) |RecursiveAggregate;AL|)))
(COND
- ((SETQ #1# (|assoc| (|devaluate| #0#) |RecursiveAggregate;AL|))
- (CDR #1#))
- (T (SETQ |RecursiveAggregate;AL|
- (|cons5| (CONS (|devaluate| #0#)
- (SETQ #1# (|RecursiveAggregate;| #0#)))
- |RecursiveAggregate;AL|))
- #1#))))
+ (#1# (CDR #1#))
+ (T (PROGN
+ (SETQ #1# (|RecursiveAggregate;| #0#))
+ (SETQ |RecursiveAggregate;AL|
+ (|cons5| (CONS (|devaluate| #0#) #1#)
+ |RecursiveAggregate;AL|))
+ #1#)))))
diff --git a/src/algebra/strap/RING.lsp b/src/algebra/strap/RING.lsp
index c2acbb0c..3eb33dcf 100644
--- a/src/algebra/strap/RING.lsp
+++ b/src/algebra/strap/RING.lsp
@@ -4,23 +4,19 @@
(DEFPARAMETER |Ring;AL| 'NIL)
(DEFUN |Ring;| ()
- (PROG (#0=#:G1397)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV| (PAIR '(#1=#:G1396) (LIST '(|Integer|)))
- (|Join| (|Rng|) (|Monoid|) (|LeftModule| '$)
- (|CoercibleFrom| '#1#)
- (|mkCategory| '|package|
- '(((|characteristic|
- ((|NonNegativeInteger|))
- |constant|)
- T))
- '((|unitsKnown| T))
- '((|NonNegativeInteger|)) NIL)))
- |Ring|)
- (|setShellEntry| #0# 0 '(|Ring|))))))
+ (LET ((#0=#:G1397
+ (|sublisV| (PAIR '(#1=#:G1396) (LIST '(|Integer|)))
+ (|Join| (|Rng|) (|Monoid|) (|LeftModule| '$)
+ (|CoercibleFrom| '#1#)
+ (|mkCategory| '|package|
+ '(((|characteristic|
+ ((|NonNegativeInteger|)) |constant|)
+ T))
+ '((|unitsKnown| T))
+ '((|NonNegativeInteger|)) NIL)))))
+ (|setShellEntry| #0# 0 '(|Ring|))
+ #0#))
-(DEFUN |Ring| ()
- (LET () (COND (|Ring;AL|) (T (SETQ |Ring;AL| (|Ring;|))))))
+(DEFUN |Ring| () (COND (|Ring;AL|) (T (SETQ |Ring;AL| (|Ring;|)))))
(MAKEPROP '|Ring| 'NILADIC T)
diff --git a/src/algebra/strap/RNG.lsp b/src/algebra/strap/RNG.lsp
index e4e3fddb..395abb8f 100644
--- a/src/algebra/strap/RNG.lsp
+++ b/src/algebra/strap/RNG.lsp
@@ -4,12 +4,10 @@
(DEFPARAMETER |Rng;AL| 'NIL)
(DEFUN |Rng;| ()
- (PROG (#0=#:G1396)
- (RETURN
- (PROG1 (LETT #0# (|Join| (|AbelianGroup|) (|SemiGroup|)) |Rng|)
- (|setShellEntry| #0# 0 '(|Rng|))))))
+ (LET ((#0=#:G1396 (|Join| (|AbelianGroup|) (|SemiGroup|))))
+ (|setShellEntry| #0# 0 '(|Rng|))
+ #0#))
-(DEFUN |Rng| ()
- (LET () (COND (|Rng;AL|) (T (SETQ |Rng;AL| (|Rng;|))))))
+(DEFUN |Rng| () (COND (|Rng;AL|) (T (SETQ |Rng;AL| (|Rng;|)))))
(MAKEPROP '|Rng| 'NILADIC T)
diff --git a/src/algebra/strap/RNS.lsp b/src/algebra/strap/RNS.lsp
index 6a02c744..baaa933b 100644
--- a/src/algebra/strap/RNS.lsp
+++ b/src/algebra/strap/RNS.lsp
@@ -4,39 +4,30 @@
(DEFPARAMETER |RealNumberSystem;AL| 'NIL)
(DEFUN |RealNumberSystem;| ()
- (PROG (#0=#:G1405)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV|
- (PAIR '(#1=#:G1401 #2=#:G1402 #3=#:G1403
- #4=#:G1404)
- (LIST '(|Integer|)
- '(|Fraction| (|Integer|))
- '(|Pattern| (|Float|)) '(|Float|)))
- (|Join| (|Field|) (|OrderedRing|)
- (|RealConstant|) (|RetractableTo| '#1#)
- (|RetractableTo| '#2#)
- (|RadicalCategory|)
- (|ConvertibleTo| '#3#)
- (|PatternMatchable| '#4#)
- (|CharacteristicZero|)
- (|mkCategory| '|domain|
- '(((|norm| ($ $)) T)
- ((|ceiling| ($ $)) T)
- ((|floor| ($ $)) T)
- ((|wholePart| ((|Integer|) $)) T)
- ((|fractionPart| ($ $)) T)
- ((|truncate| ($ $)) T)
- ((|round| ($ $)) T)
- ((|abs| ($ $)) T))
- NIL '((|Integer|)) NIL)))
- |RealNumberSystem|)
- (|setShellEntry| #0# 0 '(|RealNumberSystem|))))))
+ (LET ((#0=#:G1405
+ (|sublisV|
+ (PAIR '(#1=#:G1401 #2=#:G1402 #3=#:G1403 #4=#:G1404)
+ (LIST '(|Integer|) '(|Fraction| (|Integer|))
+ '(|Pattern| (|Float|)) '(|Float|)))
+ (|Join| (|Field|) (|OrderedRing|) (|RealConstant|)
+ (|RetractableTo| '#1#) (|RetractableTo| '#2#)
+ (|RadicalCategory|) (|ConvertibleTo| '#3#)
+ (|PatternMatchable| '#4#)
+ (|CharacteristicZero|)
+ (|mkCategory| '|domain|
+ '(((|norm| ($ $)) T) ((|ceiling| ($ $)) T)
+ ((|floor| ($ $)) T)
+ ((|wholePart| ((|Integer|) $)) T)
+ ((|fractionPart| ($ $)) T)
+ ((|truncate| ($ $)) T)
+ ((|round| ($ $)) T) ((|abs| ($ $)) T))
+ NIL '((|Integer|)) NIL)))))
+ (|setShellEntry| #0# 0 '(|RealNumberSystem|))
+ #0#))
(DEFUN |RealNumberSystem| ()
- (LET ()
- (COND
- (|RealNumberSystem;AL|)
- (T (SETQ |RealNumberSystem;AL| (|RealNumberSystem;|))))))
+ (COND
+ (|RealNumberSystem;AL|)
+ (T (SETQ |RealNumberSystem;AL| (|RealNumberSystem;|)))))
(MAKEPROP '|RealNumberSystem| 'NILADIC T)
diff --git a/src/algebra/strap/SETAGG.lsp b/src/algebra/strap/SETAGG.lsp
index 88c198b3..c5ededb4 100644
--- a/src/algebra/strap/SETAGG.lsp
+++ b/src/algebra/strap/SETAGG.lsp
@@ -6,54 +6,42 @@
(DEFPARAMETER |SetAggregate;AL| 'NIL)
(DEFUN |SetAggregate;| (|t#1|)
- (PROG (#0=#:G1396)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV|
- (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
- (COND
- (|SetAggregate;CAT|)
- ('T
- (LETT |SetAggregate;CAT|
- (|Join| (|SetCategory|)
- (|Collection| '|t#1|)
- (|mkCategory| '|domain|
- '(((|part?| ((|Boolean|) $ $))
- T)
- ((|brace| ($)) T)
- ((|brace|
- ($ (|List| |t#1|)))
- T)
- ((|set| ($)) T)
- ((|set| ($ (|List| |t#1|)))
- T)
- ((|intersect| ($ $ $)) T)
- ((|difference| ($ $ $)) T)
- ((|difference| ($ $ |t#1|))
- T)
- ((|symmetricDifference|
- ($ $ $))
- T)
- ((|subset?|
- ((|Boolean|) $ $))
- T)
- ((|union| ($ $ $)) T)
- ((|union| ($ $ |t#1|)) T)
- ((|union| ($ |t#1| $)) T))
- '((|partiallyOrderedSet| T))
- '((|Boolean|) (|List| |t#1|))
- NIL))
- . #1=(|SetAggregate|))))) . #1#)
- (|setShellEntry| #0# 0
- (LIST '|SetAggregate| (|devaluate| |t#1|)))))))
+ (LET ((#0=#:G1396
+ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
+ (COND
+ (|SetAggregate;CAT|)
+ ('T
+ (LETT |SetAggregate;CAT|
+ (|Join| (|SetCategory|) (|Collection| '|t#1|)
+ (|mkCategory| '|domain|
+ '(((|part?| ((|Boolean|) $ $)) T)
+ ((|brace| ($)) T)
+ ((|brace| ($ (|List| |t#1|))) T)
+ ((|set| ($)) T)
+ ((|set| ($ (|List| |t#1|))) T)
+ ((|intersect| ($ $ $)) T)
+ ((|difference| ($ $ $)) T)
+ ((|difference| ($ $ |t#1|)) T)
+ ((|symmetricDifference| ($ $ $))
+ T)
+ ((|subset?| ((|Boolean|) $ $))
+ T)
+ ((|union| ($ $ $)) T)
+ ((|union| ($ $ |t#1|)) T)
+ ((|union| ($ |t#1| $)) T))
+ '((|partiallyOrderedSet| T))
+ '((|Boolean|) (|List| |t#1|)) NIL))
+ |SetAggregate|))))))
+ (|setShellEntry| #0# 0 (LIST '|SetAggregate| (|devaluate| |t#1|)))
+ #0#))
(DEFUN |SetAggregate| (#0=#:G1397)
- (LET (#1=#:G1398)
+ (LET ((#1=#:G1398 (|assoc| (|devaluate| #0#) |SetAggregate;AL|)))
(COND
- ((SETQ #1# (|assoc| (|devaluate| #0#) |SetAggregate;AL|))
- (CDR #1#))
- (T (SETQ |SetAggregate;AL|
- (|cons5| (CONS (|devaluate| #0#)
- (SETQ #1# (|SetAggregate;| #0#)))
- |SetAggregate;AL|))
- #1#))))
+ (#1# (CDR #1#))
+ (T (PROGN
+ (SETQ #1# (|SetAggregate;| #0#))
+ (SETQ |SetAggregate;AL|
+ (|cons5| (CONS (|devaluate| #0#) #1#)
+ |SetAggregate;AL|))
+ #1#)))))
diff --git a/src/algebra/strap/STAGG.lsp b/src/algebra/strap/STAGG.lsp
index 2b88ed22..a353f2ef 100644
--- a/src/algebra/strap/STAGG.lsp
+++ b/src/algebra/strap/STAGG.lsp
@@ -6,37 +6,34 @@
(DEFPARAMETER |StreamAggregate;AL| 'NIL)
(DEFUN |StreamAggregate;| (|t#1|)
- (PROG (#0=#:G1403)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV|
- (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
- (COND
- (|StreamAggregate;CAT|)
- ('T
- (LETT |StreamAggregate;CAT|
- (|Join| (|UnaryRecursiveAggregate|
- '|t#1|)
- (|LinearAggregate| '|t#1|)
- (|mkCategory| '|domain|
- '(((|explicitlyFinite?|
- ((|Boolean|) $))
- T)
- ((|possiblyInfinite?|
- ((|Boolean|) $))
- T))
- NIL '((|Boolean|)) NIL))
- . #1=(|StreamAggregate|))))) . #1#)
- (|setShellEntry| #0# 0
- (LIST '|StreamAggregate| (|devaluate| |t#1|)))))))
+ (LET ((#0=#:G1403
+ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
+ (COND
+ (|StreamAggregate;CAT|)
+ ('T
+ (LETT |StreamAggregate;CAT|
+ (|Join| (|UnaryRecursiveAggregate| '|t#1|)
+ (|LinearAggregate| '|t#1|)
+ (|mkCategory| '|domain|
+ '(((|explicitlyFinite?|
+ ((|Boolean|) $))
+ T)
+ ((|possiblyInfinite?|
+ ((|Boolean|) $))
+ T))
+ NIL '((|Boolean|)) NIL))
+ |StreamAggregate|))))))
+ (|setShellEntry| #0# 0
+ (LIST '|StreamAggregate| (|devaluate| |t#1|)))
+ #0#))
(DEFUN |StreamAggregate| (#0=#:G1404)
- (LET (#1=#:G1405)
+ (LET ((#1=#:G1405 (|assoc| (|devaluate| #0#) |StreamAggregate;AL|)))
(COND
- ((SETQ #1# (|assoc| (|devaluate| #0#) |StreamAggregate;AL|))
- (CDR #1#))
- (T (SETQ |StreamAggregate;AL|
- (|cons5| (CONS (|devaluate| #0#)
- (SETQ #1# (|StreamAggregate;| #0#)))
- |StreamAggregate;AL|))
- #1#))))
+ (#1# (CDR #1#))
+ (T (PROGN
+ (SETQ #1# (|StreamAggregate;| #0#))
+ (SETQ |StreamAggregate;AL|
+ (|cons5| (CONS (|devaluate| #0#) #1#)
+ |StreamAggregate;AL|))
+ #1#)))))
diff --git a/src/algebra/strap/UFD.lsp b/src/algebra/strap/UFD.lsp
index 36c60cf4..a0fd01b8 100644
--- a/src/algebra/strap/UFD.lsp
+++ b/src/algebra/strap/UFD.lsp
@@ -4,24 +4,21 @@
(DEFPARAMETER |UniqueFactorizationDomain;AL| 'NIL)
(DEFUN |UniqueFactorizationDomain;| ()
- (PROG (#0=#:G1396)
- (RETURN
- (PROG1 (LETT #0#
- (|Join| (|GcdDomain|)
- (|mkCategory| '|domain|
- '(((|prime?| ((|Boolean|) $)) T)
- ((|squareFree| ((|Factored| $) $)) T)
- ((|squareFreePart| ($ $)) T)
- ((|factor| ((|Factored| $) $)) T))
- NIL '((|Factored| $) (|Boolean|)) NIL))
- |UniqueFactorizationDomain|)
- (|setShellEntry| #0# 0 '(|UniqueFactorizationDomain|))))))
+ (LET ((#0=#:G1396
+ (|Join| (|GcdDomain|)
+ (|mkCategory| '|domain|
+ '(((|prime?| ((|Boolean|) $)) T)
+ ((|squareFree| ((|Factored| $) $)) T)
+ ((|squareFreePart| ($ $)) T)
+ ((|factor| ((|Factored| $) $)) T))
+ NIL '((|Factored| $) (|Boolean|)) NIL))))
+ (|setShellEntry| #0# 0 '(|UniqueFactorizationDomain|))
+ #0#))
(DEFUN |UniqueFactorizationDomain| ()
- (LET ()
- (COND
- (|UniqueFactorizationDomain;AL|)
- (T (SETQ |UniqueFactorizationDomain;AL|
- (|UniqueFactorizationDomain;|))))))
+ (COND
+ (|UniqueFactorizationDomain;AL|)
+ (T (SETQ |UniqueFactorizationDomain;AL|
+ (|UniqueFactorizationDomain;|)))))
(MAKEPROP '|UniqueFactorizationDomain| 'NILADIC T)
diff --git a/src/algebra/strap/URAGG.lsp b/src/algebra/strap/URAGG.lsp
index baa0c9f1..040fec6b 100644
--- a/src/algebra/strap/URAGG.lsp
+++ b/src/algebra/strap/URAGG.lsp
@@ -6,108 +6,88 @@
(DEFPARAMETER |UnaryRecursiveAggregate;AL| 'NIL)
(DEFUN |UnaryRecursiveAggregate;| (|t#1|)
- (PROG (#0=#:G1424)
- (RETURN
- (PROG1 (LETT #0#
- (|sublisV|
- (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
- (COND
- (|UnaryRecursiveAggregate;CAT|)
- ('T
- (LETT |UnaryRecursiveAggregate;CAT|
- (|Join| (|RecursiveAggregate| '|t#1|)
- (|mkCategory| '|domain|
- '(((|concat| ($ $ $)) T)
- ((|concat| ($ |t#1| $)) T)
- ((|first| (|t#1| $)) T)
- ((|elt| (|t#1| $ "first"))
- T)
- ((|first|
- ($ $
- (|NonNegativeInteger|)))
- T)
- ((|rest| ($ $)) T)
- ((|elt| ($ $ "rest")) T)
- ((|rest|
- ($ $
- (|NonNegativeInteger|)))
- T)
- ((|last| (|t#1| $)) T)
- ((|elt| (|t#1| $ "last")) T)
- ((|last|
- ($ $
- (|NonNegativeInteger|)))
- T)
- ((|tail| ($ $)) T)
- ((|second| (|t#1| $)) T)
- ((|third| (|t#1| $)) T)
- ((|cycleEntry| ($ $)) T)
- ((|cycleLength|
- ((|NonNegativeInteger|) $))
- T)
- ((|cycleTail| ($ $)) T)
- ((|concat!| ($ $ $))
- (|has| $
- (ATTRIBUTE
- |shallowlyMutable|)))
- ((|concat!| ($ $ |t#1|))
- (|has| $
- (ATTRIBUTE
- |shallowlyMutable|)))
- ((|cycleSplit!| ($ $))
- (|has| $
- (ATTRIBUTE
- |shallowlyMutable|)))
- ((|setfirst!|
- (|t#1| $ |t#1|))
- (|has| $
- (ATTRIBUTE
- |shallowlyMutable|)))
- ((|setelt|
- (|t#1| $ "first" |t#1|))
- (|has| $
- (ATTRIBUTE
- |shallowlyMutable|)))
- ((|setrest!| ($ $ $))
- (|has| $
- (ATTRIBUTE
- |shallowlyMutable|)))
- ((|setelt| ($ $ "rest" $))
- (|has| $
- (ATTRIBUTE
- |shallowlyMutable|)))
- ((|setlast!|
- (|t#1| $ |t#1|))
- (|has| $
- (ATTRIBUTE
- |shallowlyMutable|)))
- ((|setelt|
- (|t#1| $ "last" |t#1|))
- (|has| $
- (ATTRIBUTE
- |shallowlyMutable|)))
- ((|split!|
- ($ $ (|Integer|)))
- (|has| $
- (ATTRIBUTE
- |shallowlyMutable|))))
- NIL
- '((|Integer|)
- (|NonNegativeInteger|))
- NIL))
- . #1=(|UnaryRecursiveAggregate|))))) . #1#)
- (|setShellEntry| #0# 0
- (LIST '|UnaryRecursiveAggregate| (|devaluate| |t#1|)))))))
+ (LET ((#0=#:G1424
+ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
+ (COND
+ (|UnaryRecursiveAggregate;CAT|)
+ ('T
+ (LETT |UnaryRecursiveAggregate;CAT|
+ (|Join| (|RecursiveAggregate| '|t#1|)
+ (|mkCategory| '|domain|
+ '(((|concat| ($ $ $)) T)
+ ((|concat| ($ |t#1| $)) T)
+ ((|first| (|t#1| $)) T)
+ ((|elt| (|t#1| $ "first")) T)
+ ((|first|
+ ($ $ (|NonNegativeInteger|)))
+ T)
+ ((|rest| ($ $)) T)
+ ((|elt| ($ $ "rest")) T)
+ ((|rest|
+ ($ $ (|NonNegativeInteger|)))
+ T)
+ ((|last| (|t#1| $)) T)
+ ((|elt| (|t#1| $ "last")) T)
+ ((|last|
+ ($ $ (|NonNegativeInteger|)))
+ T)
+ ((|tail| ($ $)) T)
+ ((|second| (|t#1| $)) T)
+ ((|third| (|t#1| $)) T)
+ ((|cycleEntry| ($ $)) T)
+ ((|cycleLength|
+ ((|NonNegativeInteger|) $))
+ T)
+ ((|cycleTail| ($ $)) T)
+ ((|concat!| ($ $ $))
+ (|has| $
+ (ATTRIBUTE |shallowlyMutable|)))
+ ((|concat!| ($ $ |t#1|))
+ (|has| $
+ (ATTRIBUTE |shallowlyMutable|)))
+ ((|cycleSplit!| ($ $))
+ (|has| $
+ (ATTRIBUTE |shallowlyMutable|)))
+ ((|setfirst!| (|t#1| $ |t#1|))
+ (|has| $
+ (ATTRIBUTE |shallowlyMutable|)))
+ ((|setelt|
+ (|t#1| $ "first" |t#1|))
+ (|has| $
+ (ATTRIBUTE |shallowlyMutable|)))
+ ((|setrest!| ($ $ $))
+ (|has| $
+ (ATTRIBUTE |shallowlyMutable|)))
+ ((|setelt| ($ $ "rest" $))
+ (|has| $
+ (ATTRIBUTE |shallowlyMutable|)))
+ ((|setlast!| (|t#1| $ |t#1|))
+ (|has| $
+ (ATTRIBUTE |shallowlyMutable|)))
+ ((|setelt|
+ (|t#1| $ "last" |t#1|))
+ (|has| $
+ (ATTRIBUTE |shallowlyMutable|)))
+ ((|split!| ($ $ (|Integer|)))
+ (|has| $
+ (ATTRIBUTE |shallowlyMutable|))))
+ NIL
+ '((|Integer|)
+ (|NonNegativeInteger|))
+ NIL))
+ |UnaryRecursiveAggregate|))))))
+ (|setShellEntry| #0# 0
+ (LIST '|UnaryRecursiveAggregate| (|devaluate| |t#1|)))
+ #0#))
(DEFUN |UnaryRecursiveAggregate| (#0=#:G1425)
- (LET (#1=#:G1426)
+ (LET ((#1=#:G1426
+ (|assoc| (|devaluate| #0#) |UnaryRecursiveAggregate;AL|)))
(COND
- ((SETQ #1#
- (|assoc| (|devaluate| #0#) |UnaryRecursiveAggregate;AL|))
- (CDR #1#))
- (T (SETQ |UnaryRecursiveAggregate;AL|
- (|cons5| (CONS (|devaluate| #0#)
- (SETQ #1#
- (|UnaryRecursiveAggregate;| #0#)))
- |UnaryRecursiveAggregate;AL|))
- #1#))))
+ (#1# (CDR #1#))
+ (T (PROGN
+ (SETQ #1# (|UnaryRecursiveAggregate;| #0#))
+ (SETQ |UnaryRecursiveAggregate;AL|
+ (|cons5| (CONS (|devaluate| #0#) #1#)
+ |UnaryRecursiveAggregate;AL|))
+ #1#)))))
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index e82cfc23..efe6852a 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1336,7 +1336,7 @@ backendCompileSLAM(name,args,body) ==
COMP370 [u]
name
-++ Same as backendCompileSPADSLAM, except that the cache is a hash
+++ Same as backendCompileSLAM, except that the cache is a hash
++ table. This backend compiler is used to compile constructors.
backendCompileSPADSLAM: (%Symbol,%List,%Code) -> %Symbol
backendCompileSPADSLAM(name,args,body) ==
@@ -1348,20 +1348,18 @@ backendCompileSPADSLAM(name,args,body) ==
null args => [nil,nil,[auxfn]]
null rest args => [[g1],["devaluate",g1],[auxfn,g1]]
[g1,["devaluateList",g1],["APPLY",["FUNCTION",auxfn],g1]]
- arg := first u
+ arg := first u -- parameter list
argtran := second u -- devaluate argument
- app := third u
- codePart1 := -- if value already computed, grab it.
- null args => [al]
- [["SETQ",g2,["assoc",argtran,al]], ["CDR",g2]]
- codePart2 := -- otherwise compute it, and cache it.
- -- Note: at most five values are cached.
- null args => [true,["SETQ",al,app]]
- [true,["SETQ",al,["cons5",["CONS",argtran, ["SETQ",g2,app]],al]],g2]
- decl := -- declare the cache variable.
- null args => nil
- [g2]
- lamex := ["LAM",arg,["LET",decl,["COND",codePart1,codePart2]]]
+ app := third u -- code to compute value
+ code :=
+ args = nil => ["COND",[al],[true,["SETQ",al,app]]]
+ ["LET",[[g2,["assoc",argtran,al]]],
+ ["COND",
+ [g2,["CDR",g2]],
+ [true,
+ ["PROGN",["SETQ",g2,app],
+ ["SETQ",al,["cons5",["CONS",argtran, g2],al]],g2]]]]
+ lamex := ["LAM",arg,code]
SETANDFILE(al,nil) -- define the global cache.
-- compile the worker function first.
u := [auxfn,["LAMBDA",args,:body]]