diff options
| author | dos-reis <gdr@axiomatics.org> | 2008-08-16 06:00:35 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2008-08-16 06:00:35 +0000 |
| commit | 84db9d8c5349cb8b3e7e2d102867e53e610d7ef2 (patch) | |
| tree | 0a2689194fd9e75ce8925550a4e177f3e5520684 | |
| parent | 3372c377eded97a0094f63cddd2e039af7066431 (diff) | |
| download | open-axiom-84db9d8c5349cb8b3e7e2d102867e53e610d7ef2.tar.gz | |
* algebra/strap: New. Sequester cached Lisp translation of
algebra bootstrap domains here.
111 files changed, 19677 insertions, 20833 deletions
@@ -1,3 +1,8 @@ +2008-08-16 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * configure.ac.pamphlet: Don't generate rules for extracting + algebra bootstrap files. + 2008-08-15 Gabriel Dos Reis <gdr@cs.tamu.edu> * configure.ac.pamphlet (oa_standard_linking): New. AC-substitute. @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.60 for OpenAxiom 1.2.0-2008-08-15. +# Generated by GNU Autoconf 2.60 for OpenAxiom 1.2.0-2008-08-16. # # Report bugs to <open-axiom-bugs@lists.sf.net>. # @@ -713,8 +713,8 @@ SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='OpenAxiom' PACKAGE_TARNAME='openaxiom' -PACKAGE_VERSION='1.2.0-2008-08-15' -PACKAGE_STRING='OpenAxiom 1.2.0-2008-08-15' +PACKAGE_VERSION='1.2.0-2008-08-16' +PACKAGE_STRING='OpenAxiom 1.2.0-2008-08-16' PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net' ac_unique_file="src/Makefile.pamphlet" @@ -1405,7 +1405,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.2.0-2008-08-15 to adapt to many kinds of systems. +\`configure' configures OpenAxiom 1.2.0-2008-08-16 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1475,7 +1475,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of OpenAxiom 1.2.0-2008-08-15:";; + short | recursive ) echo "Configuration of OpenAxiom 1.2.0-2008-08-16:";; esac cat <<\_ACEOF @@ -1579,7 +1579,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -OpenAxiom configure 1.2.0-2008-08-15 +OpenAxiom configure 1.2.0-2008-08-16 generated by GNU Autoconf 2.60 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, @@ -1593,7 +1593,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.2.0-2008-08-15, which was +It was created by OpenAxiom $as_me 1.2.0-2008-08-16, which was generated by GNU Autoconf 2.60. Invocation command line was $ $0 $@ @@ -26094,7 +26094,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.2.0-2008-08-15, which was +This file was extended by OpenAxiom $as_me 1.2.0-2008-08-16, which was generated by GNU Autoconf 2.60. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -26143,7 +26143,7 @@ Report bugs to <bug-autoconf@gnu.org>." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ -OpenAxiom config.status 1.2.0-2008-08-15 +OpenAxiom config.status 1.2.0-2008-08-16 configured by $0, generated by GNU Autoconf 2.60, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" @@ -26947,23 +26947,6 @@ if test "$no_create" != yes; then fi -## Generate rules for Algebra bootstrap files. -echo -n "building list of Algebra bootstrap files..." -egrep ".*BOOTSTRAP>>=" $srcdir/src/algebra/*.spad.pamphlet \ - | sort | uniq | \ - while IFS=':' read spad_file chunk_desc; do - chunk_desc=`echo $chunk_desc | sed -e 's,<<,,' -e 's,>>=,,'` - set $chunk_desc; bootstrap_file=$1 - cat >> src/algebra/tmp-extract-lisp-files.mk <<EOF -$bootstrap_file: \$(srcdir)/`basename $spad_file`; \ - \$(EXTRACT_BOOTSTRAP_FILE) -EOF - done -echo done -$srcdir/config/move-if-change \ - src/algebra/tmp-extract-lisp-files.mk \ - src/algebra/extract-lisp-files.mk - ## Generate rules to extrad SPAD type definitions from pamphlets. echo -n "extracting list of SPAD type definitions..." egrep '<<(category|domain|package) .*>>=' \ diff --git a/configure.ac b/configure.ac index ef6b8fda..6bd4af95 100644 --- a/configure.ac +++ b/configure.ac @@ -1,6 +1,6 @@ sinclude(config/open-axiom.m4) sinclude(config/aclocal.m4) -AC_INIT([OpenAxiom], [1.2.0-2008-08-15], +AC_INIT([OpenAxiom], [1.2.0-2008-08-16], [open-axiom-bugs@lists.sf.net]) AC_CONFIG_AUX_DIR(config) @@ -649,23 +649,6 @@ AC_CONFIG_FILES(build/scripts/document:$srcdir/src/scripts/document.in, \ AC_OUTPUT -## Generate rules for Algebra bootstrap files. -echo -n "building list of Algebra bootstrap files..." -egrep ".*BOOTSTRAP>>=" $srcdir/src/algebra/*.spad.pamphlet \ - | sort | uniq | \ - while IFS=':' read spad_file chunk_desc; do - chunk_desc=`echo $chunk_desc | sed -e 's,<<,,' -e 's,>>=,,'` - set $chunk_desc; bootstrap_file=$1 - cat >> src/algebra/tmp-extract-lisp-files.mk <<EOF -$bootstrap_file: \$(srcdir)/`basename $spad_file`; \ - \$(EXTRACT_BOOTSTRAP_FILE) -EOF - done -echo done -$srcdir/config/move-if-change \ - src/algebra/tmp-extract-lisp-files.mk \ - src/algebra/extract-lisp-files.mk - ## Generate rules to extrad SPAD type definitions from pamphlets. echo -n "extracting list of SPAD type definitions..." egrep '<<(category|domain|package) .*>>=' \ diff --git a/configure.ac.pamphlet b/configure.ac.pamphlet index c611ef27..97fcdaf8 100644 --- a/configure.ac.pamphlet +++ b/configure.ac.pamphlet @@ -1122,7 +1122,7 @@ information: <<Autoconf init>>= sinclude(config/open-axiom.m4) sinclude(config/aclocal.m4) -AC_INIT([OpenAxiom], [1.2.0-2008-08-15], +AC_INIT([OpenAxiom], [1.2.0-2008-08-16], [open-axiom-bugs@lists.sf.net]) @ @@ -1204,23 +1204,6 @@ AC_CONFIG_FILES(build/scripts/document:$srcdir/src/scripts/document.in, \ AC_OUTPUT -## Generate rules for Algebra bootstrap files. -echo -n "building list of Algebra bootstrap files..." -egrep ".*BOOTSTRAP>>=" $srcdir/src/algebra/*.spad.pamphlet \ - | sort | uniq | \ - while IFS=':' read spad_file chunk_desc; do - chunk_desc=`echo $chunk_desc | sed -e 's,@<<,,' -e 's,>>=,,'` - set $chunk_desc; bootstrap_file=$1 - cat >> src/algebra/tmp-extract-lisp-files.mk <<EOF -$bootstrap_file: \$(srcdir)/`basename $spad_file`; \ - \$(EXTRACT_BOOTSTRAP_FILE) -EOF - done -echo done -$srcdir/config/move-if-change \ - src/algebra/tmp-extract-lisp-files.mk \ - src/algebra/extract-lisp-files.mk - ## Generate rules to extrad SPAD type definitions from pamphlets. echo -n "extracting list of SPAD type definitions..." egrep '@<<(category|domain|package) .*>>=' \ diff --git a/src/ChangeLog b/src/ChangeLog index 0623b60e..26cf911a 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2008-08-16 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * algebra/strap: New. Sequester cached Lisp translation of + algebra bootstrap domains here. + 2008-08-15 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/define.boot (compDefineCategory2): Use rwriteLispForm. diff --git a/src/algebra/Makefile.in b/src/algebra/Makefile.in index 1586fff7..197ac760 100644 --- a/src/algebra/Makefile.in +++ b/src/algebra/Makefile.in @@ -5,9 +5,6 @@ DOC=$(axiom_target_docdir)/src/algebra OUTSRC=$(axiom_target_srcdir)/algebra INPUT=../input -EXTRACT_BOOTSTRAP_FILE = \ - $(axiom_build_document) --output=$@ --tangle="$@ BOOTSTRAP" $< - ## We use interpsys, built from previous stage, to bootstrap the algebra ## files. In fact, we use interpsys to build everything. COMPILE_LISP = $(INTERPSYS) --compile --output=$@ $< @@ -846,8 +843,6 @@ mkdir-output-directory: everything: check lib db cmd gloss @ echo 4303 invoking make in `pwd` with parms: - @ echo SYS= ${SYS} LSP= ${LSP} - @ echo MNT= ${MNT} LISP=${LISP} BYE=${BYE} check: @ echo 4305 Checking that INTERP.EXPOSED and NRLIBs are consistent @@ -866,7 +861,7 @@ ${OUT}/%.$(FASLEXT): %.NRLIB/code.$(FASLEXT) ${INTERPSYS} --strap=strap --system-algebra --compile $< # Compile bootstrap file to machine object code, and the result # immediately available for AXIOMsys consumption. -strap/%.$(FASLEXT): %.lsp +strap/%.$(FASLEXT): $(srcdir)/strap/%.lsp $(COMPILE_LISP) $(OUTSRC)/%.spad: mk-target-src-algabra-dir @@ -1151,7 +1146,6 @@ clean-local: mostlyclean-local distclean-local: clean-local -include extract-lisp-files.mk include extract-spad.mk .NOTPARALLEL: diff --git a/src/algebra/Makefile.pamphlet b/src/algebra/Makefile.pamphlet index aaf1a1e9..fc95ce65 100644 --- a/src/algebra/Makefile.pamphlet +++ b/src/algebra/Makefile.pamphlet @@ -1306,9 +1306,6 @@ DOC=$(axiom_target_docdir)/src/algebra OUTSRC=$(axiom_target_srcdir)/algebra INPUT=../input -EXTRACT_BOOTSTRAP_FILE = \ - $(axiom_build_document) --output=$@ --tangle="$@ BOOTSTRAP" $< - @ <<environment>>= @@ -1698,9 +1695,7 @@ system is built from scratch. A 5 stanza group for this case performs the following functions: \begin{enumerate} -\item extract the lisp [[BAR.lsp]] from the pamphlet [[foo.spad.pamphlet]] \item compile and copy the bootstrap lisp to the final algebra directory -\item extract the bootstrap [[BAR.lsp]] from the spad file [[foo.spad]] \item compile the extracted [[BAR]] domain \item copy the compiled [[BAR]] to the final algebra directory \end{enumerate} @@ -1804,7 +1799,7 @@ ${OUT}/%.$(FASLEXT): %.NRLIB/code.$(FASLEXT) <<genericBOOTSTRAPfiles>>= # Compile bootstrap file to machine object code, and the result # immediately available for AXIOMsys consumption. -strap/%.$(FASLEXT): %.lsp +strap/%.$(FASLEXT): $(srcdir)/strap/%.lsp $(COMPILE_LISP) @ @@ -1961,38 +1956,6 @@ ${MID}/LEXTRIPK.spad: $(srcdir)/zerodim.spad.pamphlet $(axiom_build_document) --tangle='package LEXTRIPK LexTriangularPackage' --output=$@ $< \end{verbatim} -\subsection{Find the algebra bootstrap code} - -Step 3 works like step 1 above except that we are looking for -chunk names that have the "BOOTSTRAP" string. The output will look like: -\begin{verbatim} -vector.spad.pamphlet:@<<VECTOR.lsp BOOTSTRAP>>= -\end{verbatim} -This output, which can consist of many lines per input file is piped -into [[awk]]. - -The process is the same way as described above except that -there are only two parts to the chunk names -\begin{verbatim} - part[1]=VECTOR.lsp - part[2]=BOOTSTRAP -\end{verbatim} -The [[lspfile]] variable is assigned -\begin{verbatim} -${MID}/VECTOR.lsp -\end{verbatim} -Finally we output two lines: -\begin{verbatim} -${MID}/vector.spad.pamphlet: $(srcdir)/vector.spad.pamphlet - $(axiom_build_document) --tangle='VECTOR.lsp BOOTSTRAP' --output=$@ $< -\end{verbatim} - -The first line is the stanza head and creates a dependence between -the intermediate file, in this case [[int/algebra/VECTOR.lsp]] and -the input file [[src/algebra/vector.spad.pamphlet]] - -The second line calls [[notangle]] to extract the required chunk -from the source file. \section{Stage markers} @@ -2264,8 +2227,6 @@ mkdir-output-directory: everything: check lib db cmd gloss @ echo 4303 invoking make in `pwd` with parms: - @ echo SYS= ${SYS} LSP= ${LSP} - @ echo MNT= ${MNT} LISP=${LISP} BYE=${BYE} check: @ echo 4305 Checking that INTERP.EXPOSED and NRLIBs are consistent @@ -2289,7 +2250,6 @@ clean-local: mostlyclean-local distclean-local: clean-local -include extract-lisp-files.mk include extract-spad.mk .NOTPARALLEL: diff --git a/src/algebra/aggcat.spad.pamphlet b/src/algebra/aggcat.spad.pamphlet index fe95c2e1..8ed6c354 100644 --- a/src/algebra/aggcat.spad.pamphlet +++ b/src/algebra/aggcat.spad.pamphlet @@ -143,428 +143,7 @@ HomogeneousAggregate(S:Type): Category == Aggregate with commaSeparate [a::OutputForm for a in parts x]$List(OutputForm) @ -\section{HOAGG.lsp BOOTSTRAP} -{\bf HOAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf HOAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf HOAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<HOAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |HomogeneousAggregate;CAT| 'NIL) - -(DEFPARAMETER |HomogeneousAggregate;AL| 'NIL) - -(DEFUN |HomogeneousAggregate| (#0=#:G1399) - (LET (#1=#:G1400) - (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#)))) - -(DEFUN |HomogeneousAggregate;| (|t#1|) - (PROG (#0=#:G1398) - (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#) - (SETELT #0# 0 - (LIST '|HomogeneousAggregate| (|devaluate| |t#1|))))))) -@ -\section{HOAGG-.lsp BOOTSTRAP} -{\bf HOAGG-} depends on {\bf HOAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf HOAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf HOAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<HOAGG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |HOAGG-;eval;ALA;1| (|u| |l| $) - (SPADCALL (CONS #'|HOAGG-;eval;ALA;1!0| (VECTOR $ |l|)) |u| - (QREFELT $ 11))) - -(DEFUN |HOAGG-;eval;ALA;1!0| (|#1| $$) - (SPADCALL |#1| (QREFELT $$ 1) (QREFELT (QREFELT $$ 0) 9))) - -(DEFUN |HOAGG-;#;ANni;2| (|c| $) - (LENGTH (SPADCALL |c| (QREFELT $ 14)))) - -(DEFUN |HOAGG-;any?;MAB;3| (|f| |c| $) - (PROG (|x| #0=#:G1409 #1=#:G1406 #2=#:G1404 #3=#:G1405) - (RETURN - (SEQ (PROGN - (LETT #3# NIL |HOAGG-;any?;MAB;3|) - (SEQ (LETT |x| NIL |HOAGG-;any?;MAB;3|) - (LETT #0# (SPADCALL |c| (QREFELT $ 14)) - |HOAGG-;any?;MAB;3|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |x| (CAR #0#) |HOAGG-;any?;MAB;3|) - NIL)) - (GO G191))) - (SEQ (EXIT (PROGN - (LETT #1# (SPADCALL |x| |f|) - |HOAGG-;any?;MAB;3|) - (COND - (#3# (LETT #2# - (COND (#2# 'T) ('T #1#)) - |HOAGG-;any?;MAB;3|)) - ('T - (PROGN - (LETT #2# #1# |HOAGG-;any?;MAB;3|) - (LETT #3# 'T |HOAGG-;any?;MAB;3|))))))) - (LETT #0# (CDR #0#) |HOAGG-;any?;MAB;3|) (GO G190) - G191 (EXIT NIL)) - (COND (#3# #2#) ('T 'NIL))))))) - -(DEFUN |HOAGG-;every?;MAB;4| (|f| |c| $) - (PROG (|x| #0=#:G1414 #1=#:G1412 #2=#:G1410 #3=#:G1411) - (RETURN - (SEQ (PROGN - (LETT #3# NIL |HOAGG-;every?;MAB;4|) - (SEQ (LETT |x| NIL |HOAGG-;every?;MAB;4|) - (LETT #0# (SPADCALL |c| (QREFELT $ 14)) - |HOAGG-;every?;MAB;4|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |x| (CAR #0#) |HOAGG-;every?;MAB;4|) - NIL)) - (GO G191))) - (SEQ (EXIT (PROGN - (LETT #1# (SPADCALL |x| |f|) - |HOAGG-;every?;MAB;4|) - (COND - (#3# (LETT #2# - (COND (#2# #1#) ('T 'NIL)) - |HOAGG-;every?;MAB;4|)) - ('T - (PROGN - (LETT #2# #1# - |HOAGG-;every?;MAB;4|) - (LETT #3# 'T |HOAGG-;every?;MAB;4|))))))) - (LETT #0# (CDR #0#) |HOAGG-;every?;MAB;4|) (GO G190) - G191 (EXIT NIL)) - (COND (#3# #2#) ('T 'T))))))) - -(DEFUN |HOAGG-;count;MANni;5| (|f| |c| $) - (PROG (|x| #0=#:G1419 #1=#:G1417 #2=#:G1415 #3=#:G1416) - (RETURN - (SEQ (PROGN - (LETT #3# NIL |HOAGG-;count;MANni;5|) - (SEQ (LETT |x| NIL |HOAGG-;count;MANni;5|) - (LETT #0# (SPADCALL |c| (QREFELT $ 14)) - |HOAGG-;count;MANni;5|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |x| (CAR #0#) |HOAGG-;count;MANni;5|) - NIL)) - (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL |x| |f|) - (PROGN - (LETT #1# 1 |HOAGG-;count;MANni;5|) - (COND - (#3# - (LETT #2# (+ #2# #1#) - |HOAGG-;count;MANni;5|)) - ('T - (PROGN - (LETT #2# #1# - |HOAGG-;count;MANni;5|) - (LETT #3# 'T - |HOAGG-;count;MANni;5|))))))))) - (LETT #0# (CDR #0#) |HOAGG-;count;MANni;5|) (GO G190) - G191 (EXIT NIL)) - (COND (#3# #2#) ('T 0))))))) - -(DEFUN |HOAGG-;members;AL;6| (|x| $) (SPADCALL |x| (QREFELT $ 14))) - -(DEFUN |HOAGG-;count;SANni;7| (|s| |x| $) - (SPADCALL (CONS #'|HOAGG-;count;SANni;7!0| (VECTOR $ |s|)) |x| - (QREFELT $ 24))) - -(DEFUN |HOAGG-;count;SANni;7!0| (|#1| $$) - (SPADCALL (QREFELT $$ 1) |#1| (QREFELT (QREFELT $$ 0) 23))) - -(DEFUN |HOAGG-;member?;SAB;8| (|e| |c| $) - (SPADCALL (CONS #'|HOAGG-;member?;SAB;8!0| (VECTOR $ |e|)) |c| - (QREFELT $ 26))) - -(DEFUN |HOAGG-;member?;SAB;8!0| (|#1| $$) - (SPADCALL (QREFELT $$ 1) |#1| (QREFELT (QREFELT $$ 0) 23))) - -(DEFUN |HOAGG-;=;2AB;9| (|x| |y| $) - (PROG (|b| #0=#:G1429 |a| #1=#:G1428 #2=#:G1425 #3=#:G1423 - #4=#:G1424) - (RETURN - (SEQ (COND - ((SPADCALL |x| (SPADCALL |y| (QREFELT $ 28)) - (QREFELT $ 29)) - (PROGN - (LETT #4# NIL |HOAGG-;=;2AB;9|) - (SEQ (LETT |b| NIL |HOAGG-;=;2AB;9|) - (LETT #0# (SPADCALL |y| (QREFELT $ 14)) - |HOAGG-;=;2AB;9|) - (LETT |a| NIL |HOAGG-;=;2AB;9|) - (LETT #1# (SPADCALL |x| (QREFELT $ 14)) - |HOAGG-;=;2AB;9|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |a| (CAR #1#) |HOAGG-;=;2AB;9|) - NIL) - (ATOM #0#) - (PROGN - (LETT |b| (CAR #0#) |HOAGG-;=;2AB;9|) - NIL)) - (GO G191))) - (SEQ (EXIT (PROGN - (LETT #2# - (SPADCALL |a| |b| - (QREFELT $ 23)) - |HOAGG-;=;2AB;9|) - (COND - (#4# - (LETT #3# - (COND (#3# #2#) ('T 'NIL)) - |HOAGG-;=;2AB;9|)) - ('T - (PROGN - (LETT #3# #2# |HOAGG-;=;2AB;9|) - (LETT #4# 'T |HOAGG-;=;2AB;9|))))))) - (LETT #1# - (PROG1 (CDR #1#) - (LETT #0# (CDR #0#) |HOAGG-;=;2AB;9|)) - |HOAGG-;=;2AB;9|) - (GO G190) G191 (EXIT NIL)) - (COND (#4# #3#) ('T 'T)))) - ('T 'NIL)))))) - -(DEFUN |HOAGG-;coerce;AOf;10| (|x| $) - (PROG (#0=#:G1433 |a| #1=#:G1434) - (RETURN - (SEQ (SPADCALL - (SPADCALL - (PROGN - (LETT #0# NIL |HOAGG-;coerce;AOf;10|) - (SEQ (LETT |a| NIL |HOAGG-;coerce;AOf;10|) - (LETT #1# (SPADCALL |x| (QREFELT $ 14)) - |HOAGG-;coerce;AOf;10|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |a| (CAR #1#) - |HOAGG-;coerce;AOf;10|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (SPADCALL |a| (QREFELT $ 32)) - #0#) - |HOAGG-;coerce;AOf;10|))) - (LETT #1# (CDR #1#) |HOAGG-;coerce;AOf;10|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - (QREFELT $ 34)) - (QREFELT $ 35)))))) - -(DEFUN |HomogeneousAggregate&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|HomogeneousAggregate&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| - (LIST '|HomogeneousAggregate&| |dv$1| |dv$2|) . #0#) - (LETT $ (GETREFV 38) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasAttribute| |#1| '|finiteAggregate|) - (|HasAttribute| |#1| '|shallowlyMutable|) - (|HasCategory| |#2| - (LIST '|Evalable| (|devaluate| |#2|))) - (|HasCategory| |#2| '(|SetCategory|)) - (|HasCategory| |#2| - '(|CoercibleTo| (|OutputForm|))))) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (QSETREFV $ 7 |#2|) - (COND - ((|testBitVector| |pv$| 3) - (QSETREFV $ 12 - (CONS (|dispatchFunction| |HOAGG-;eval;ALA;1|) $)))) - (COND - ((|testBitVector| |pv$| 1) - (PROGN - (QSETREFV $ 16 - (CONS (|dispatchFunction| |HOAGG-;#;ANni;2|) $)) - (QSETREFV $ 19 - (CONS (|dispatchFunction| |HOAGG-;any?;MAB;3|) $)) - (QSETREFV $ 20 - (CONS (|dispatchFunction| |HOAGG-;every?;MAB;4|) $)) - (QSETREFV $ 21 - (CONS (|dispatchFunction| |HOAGG-;count;MANni;5|) $)) - (QSETREFV $ 22 - (CONS (|dispatchFunction| |HOAGG-;members;AL;6|) $)) - (COND - ((|testBitVector| |pv$| 4) - (PROGN - (QSETREFV $ 25 - (CONS (|dispatchFunction| |HOAGG-;count;SANni;7|) - $)) - (QSETREFV $ 27 - (CONS (|dispatchFunction| |HOAGG-;member?;SAB;8|) - $)) - (QSETREFV $ 30 - (CONS (|dispatchFunction| |HOAGG-;=;2AB;9|) $))))) - (COND - ((|testBitVector| |pv$| 5) - (QSETREFV $ 36 - (CONS (|dispatchFunction| |HOAGG-;coerce;AOf;10|) - $))))))) - $)))) - -(MAKEPROP '|HomogeneousAggregate&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|List| 37) (0 . |eval|) (|Mapping| 7 7) (6 . |map|) - (12 . |eval|) (|List| 7) (18 . |parts|) - (|NonNegativeInteger|) (23 . |#|) (|Boolean|) - (|Mapping| 17 7) (28 . |any?|) (34 . |every?|) - (40 . |count|) (46 . |members|) (51 . =) (57 . |count|) - (63 . |count|) (69 . |any?|) (75 . |member?|) (81 . |#|) - (86 . |size?|) (92 . =) (|OutputForm|) (98 . |coerce|) - (|List| $) (103 . |commaSeparate|) (108 . |bracket|) - (113 . |coerce|) (|Equation| 7)) - '#(|members| 118 |member?| 123 |every?| 129 |eval| 135 - |count| 141 |coerce| 153 |any?| 158 = 164 |#| 170) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 36 - '(2 7 0 0 8 9 2 6 0 10 0 11 2 0 0 0 8 - 12 1 6 13 0 14 1 0 15 0 16 2 0 17 18 - 0 19 2 0 17 18 0 20 2 0 15 18 0 21 1 - 0 13 0 22 2 7 17 0 0 23 2 6 15 18 0 - 24 2 0 15 7 0 25 2 6 17 18 0 26 2 0 - 17 7 0 27 1 6 15 0 28 2 6 17 0 15 29 - 2 0 17 0 0 30 1 7 31 0 32 1 31 0 33 - 34 1 31 0 0 35 1 0 31 0 36 1 0 13 0 - 22 2 0 17 7 0 27 2 0 17 18 0 20 2 0 0 - 0 8 12 2 0 15 7 0 25 2 0 15 18 0 21 1 - 0 31 0 36 2 0 17 18 0 19 2 0 17 0 0 - 30 1 0 15 0 16))))) - '|lookupComplete|)) -@ + \section{category CLAGG Collection} <<category CLAGG Collection>>= )abbrev category CLAGG Collection @@ -649,353 +228,7 @@ Collection(S:Type): Category == HomogeneousAggregate(S) with removeDuplicates(x) == construct removeDuplicates parts x @ -\section{CLAGG.lsp BOOTSTRAP} -{\bf CLAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf CLAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf CLAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<CLAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |Collection;CAT| 'NIL) - -(DEFPARAMETER |Collection;AL| 'NIL) - -(DEFUN |Collection| (#0=#:G1398) - (LET (#1=#:G1399) - (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#)))) - -(DEFUN |Collection;| (|t#1|) - (PROG (#0=#:G1397) - (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#) - (SETELT #0# 0 (LIST '|Collection| (|devaluate| |t#1|))))))) -@ -\section{CLAGG-.lsp BOOTSTRAP} -{\bf CLAGG-} depends on {\bf CLAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf CLAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf CLAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<CLAGG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |CLAGG-;#;ANni;1| (|c| $) - (LENGTH (SPADCALL |c| (QREFELT $ 9)))) - -(DEFUN |CLAGG-;count;MANni;2| (|f| |c| $) - (PROG (|x| #0=#:G1406 #1=#:G1403 #2=#:G1401 #3=#:G1402) - (RETURN - (SEQ (PROGN - (LETT #3# NIL |CLAGG-;count;MANni;2|) - (SEQ (LETT |x| NIL |CLAGG-;count;MANni;2|) - (LETT #0# (SPADCALL |c| (QREFELT $ 9)) - |CLAGG-;count;MANni;2|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |x| (CAR #0#) |CLAGG-;count;MANni;2|) - NIL)) - (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL |x| |f|) - (PROGN - (LETT #1# 1 |CLAGG-;count;MANni;2|) - (COND - (#3# - (LETT #2# (+ #2# #1#) - |CLAGG-;count;MANni;2|)) - ('T - (PROGN - (LETT #2# #1# - |CLAGG-;count;MANni;2|) - (LETT #3# 'T - |CLAGG-;count;MANni;2|))))))))) - (LETT #0# (CDR #0#) |CLAGG-;count;MANni;2|) (GO G190) - G191 (EXIT NIL)) - (COND (#3# #2#) ('T 0))))))) - -(DEFUN |CLAGG-;any?;MAB;3| (|f| |c| $) - (PROG (|x| #0=#:G1411 #1=#:G1409 #2=#:G1407 #3=#:G1408) - (RETURN - (SEQ (PROGN - (LETT #3# NIL |CLAGG-;any?;MAB;3|) - (SEQ (LETT |x| NIL |CLAGG-;any?;MAB;3|) - (LETT #0# (SPADCALL |c| (QREFELT $ 9)) - |CLAGG-;any?;MAB;3|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |x| (CAR #0#) |CLAGG-;any?;MAB;3|) - NIL)) - (GO G191))) - (SEQ (EXIT (PROGN - (LETT #1# (SPADCALL |x| |f|) - |CLAGG-;any?;MAB;3|) - (COND - (#3# (LETT #2# - (COND (#2# 'T) ('T #1#)) - |CLAGG-;any?;MAB;3|)) - ('T - (PROGN - (LETT #2# #1# |CLAGG-;any?;MAB;3|) - (LETT #3# 'T |CLAGG-;any?;MAB;3|))))))) - (LETT #0# (CDR #0#) |CLAGG-;any?;MAB;3|) (GO G190) - G191 (EXIT NIL)) - (COND (#3# #2#) ('T 'NIL))))))) - -(DEFUN |CLAGG-;every?;MAB;4| (|f| |c| $) - (PROG (|x| #0=#:G1416 #1=#:G1414 #2=#:G1412 #3=#:G1413) - (RETURN - (SEQ (PROGN - (LETT #3# NIL |CLAGG-;every?;MAB;4|) - (SEQ (LETT |x| NIL |CLAGG-;every?;MAB;4|) - (LETT #0# (SPADCALL |c| (QREFELT $ 9)) - |CLAGG-;every?;MAB;4|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |x| (CAR #0#) |CLAGG-;every?;MAB;4|) - NIL)) - (GO G191))) - (SEQ (EXIT (PROGN - (LETT #1# (SPADCALL |x| |f|) - |CLAGG-;every?;MAB;4|) - (COND - (#3# (LETT #2# - (COND (#2# #1#) ('T 'NIL)) - |CLAGG-;every?;MAB;4|)) - ('T - (PROGN - (LETT #2# #1# - |CLAGG-;every?;MAB;4|) - (LETT #3# 'T |CLAGG-;every?;MAB;4|))))))) - (LETT #0# (CDR #0#) |CLAGG-;every?;MAB;4|) (GO G190) - G191 (EXIT NIL)) - (COND (#3# #2#) ('T 'T))))))) - -(DEFUN |CLAGG-;find;MAU;5| (|f| |c| $) - (SPADCALL |f| (SPADCALL |c| (QREFELT $ 9)) (QREFELT $ 18))) - -(DEFUN |CLAGG-;reduce;MAS;6| (|f| |x| $) - (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 21))) - -(DEFUN |CLAGG-;reduce;MA2S;7| (|f| |x| |s| $) - (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) |s| (QREFELT $ 23))) - -(DEFUN |CLAGG-;remove;M2A;8| (|f| |x| $) - (SPADCALL (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 25)) - (QREFELT $ 26))) - -(DEFUN |CLAGG-;select;M2A;9| (|f| |x| $) - (SPADCALL (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 28)) - (QREFELT $ 26))) - -(DEFUN |CLAGG-;remove;S2A;10| (|s| |x| $) - (SPADCALL (CONS #'|CLAGG-;remove;S2A;10!0| (VECTOR $ |s|)) |x| - (QREFELT $ 31))) - -(DEFUN |CLAGG-;remove;S2A;10!0| (|#1| $$) - (SPADCALL |#1| (QREFELT $$ 1) (QREFELT (QREFELT $$ 0) 30))) - -(DEFUN |CLAGG-;reduce;MA3S;11| (|f| |x| |s1| |s2| $) - (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) |s1| |s2| (QREFELT $ 33))) - -(DEFUN |CLAGG-;removeDuplicates;2A;12| (|x| $) - (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 35)) - (QREFELT $ 26))) - -(DEFUN |Collection&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|Collection&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| (LIST '|Collection&| |dv$1| |dv$2|) . #0#) - (LETT $ (GETREFV 37) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasCategory| |#2| - '(|ConvertibleTo| (|InputForm|))) - (|HasCategory| |#2| '(|SetCategory|)) - (|HasAttribute| |#1| '|finiteAggregate|))) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (QSETREFV $ 7 |#2|) - (COND - ((|testBitVector| |pv$| 3) - (PROGN - (QSETREFV $ 11 - (CONS (|dispatchFunction| |CLAGG-;#;ANni;1|) $)) - (QSETREFV $ 13 - (CONS (|dispatchFunction| |CLAGG-;count;MANni;2|) $)) - (QSETREFV $ 15 - (CONS (|dispatchFunction| |CLAGG-;any?;MAB;3|) $)) - (QSETREFV $ 16 - (CONS (|dispatchFunction| |CLAGG-;every?;MAB;4|) $)) - (QSETREFV $ 19 - (CONS (|dispatchFunction| |CLAGG-;find;MAU;5|) $)) - (QSETREFV $ 22 - (CONS (|dispatchFunction| |CLAGG-;reduce;MAS;6|) $)) - (QSETREFV $ 24 - (CONS (|dispatchFunction| |CLAGG-;reduce;MA2S;7|) $)) - (QSETREFV $ 27 - (CONS (|dispatchFunction| |CLAGG-;remove;M2A;8|) $)) - (QSETREFV $ 29 - (CONS (|dispatchFunction| |CLAGG-;select;M2A;9|) $)) - (COND - ((|testBitVector| |pv$| 2) - (PROGN - (QSETREFV $ 32 - (CONS (|dispatchFunction| |CLAGG-;remove;S2A;10|) - $)) - (QSETREFV $ 34 - (CONS (|dispatchFunction| - |CLAGG-;reduce;MA3S;11|) - $)) - (QSETREFV $ 36 - (CONS (|dispatchFunction| - |CLAGG-;removeDuplicates;2A;12|) - $)))))))) - $)))) - -(MAKEPROP '|Collection&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|List| 7) (0 . |parts|) (|NonNegativeInteger|) (5 . |#|) - (|Mapping| 14 7) (10 . |count|) (|Boolean|) (16 . |any?|) - (22 . |every?|) (|Union| 7 '"failed") (28 . |find|) - (34 . |find|) (|Mapping| 7 7 7) (40 . |reduce|) - (46 . |reduce|) (52 . |reduce|) (59 . |reduce|) - (66 . |remove|) (72 . |construct|) (77 . |remove|) - (83 . |select|) (89 . |select|) (95 . =) (101 . |remove|) - (107 . |remove|) (113 . |reduce|) (121 . |reduce|) - (129 . |removeDuplicates|) (134 . |removeDuplicates|)) - '#(|select| 139 |removeDuplicates| 145 |remove| 150 |reduce| - 162 |find| 183 |every?| 189 |count| 195 |any?| 201 |#| - 207) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 36 - '(1 6 8 0 9 1 0 10 0 11 2 0 10 12 0 13 - 2 0 14 12 0 15 2 0 14 12 0 16 2 8 17 - 12 0 18 2 0 17 12 0 19 2 8 7 20 0 21 - 2 0 7 20 0 22 3 8 7 20 0 7 23 3 0 7 - 20 0 7 24 2 8 0 12 0 25 1 6 0 8 26 2 - 0 0 12 0 27 2 8 0 12 0 28 2 0 0 12 0 - 29 2 7 14 0 0 30 2 6 0 12 0 31 2 0 0 - 7 0 32 4 8 7 20 0 7 7 33 4 0 7 20 0 7 - 7 34 1 8 0 0 35 1 0 0 0 36 2 0 0 12 0 - 29 1 0 0 0 36 2 0 0 7 0 32 2 0 0 12 0 - 27 4 0 7 20 0 7 7 34 3 0 7 20 0 7 24 - 2 0 7 20 0 22 2 0 17 12 0 19 2 0 14 - 12 0 16 2 0 10 12 0 13 2 0 14 12 0 15 - 1 0 10 0 11))))) - '|lookupComplete|)) -@ + \section{category BGAGG BagAggregate} <<category BGAGG BagAggregate>>= )abbrev category BGAGG BagAggregate @@ -1387,137 +620,6 @@ SetAggregate(S:SetCategory): difference(s:%, x:S) == difference(s, {x}) @ -\section{SETAGG.lsp BOOTSTRAP} -{\bf SETAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf SETAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf SETAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<SETAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |SetAggregate;CAT| 'NIL) - -(DEFPARAMETER |SetAggregate;AL| 'NIL) - -(DEFUN |SetAggregate| (#0=#:G1394) - (LET (#1=#:G1395) - (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#)))) - -(DEFUN |SetAggregate;| (|t#1|) - (PROG (#0=#:G1393) - (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#) - (SETELT #0# 0 (LIST '|SetAggregate| (|devaluate| |t#1|))))))) -@ - -\section{SETAGG-.lsp BOOTSTRAP} -{\bf SETAGG-} depends on {\bf SETAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf SETAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf SETAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<SETAGG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |SETAGG-;symmetricDifference;3A;1| (|x| |y| $) - (SPADCALL (SPADCALL |x| |y| (|getShellEntry| $ 8)) - (SPADCALL |y| |x| (|getShellEntry| $ 8)) (|getShellEntry| $ 9))) - -(DEFUN |SETAGG-;union;ASA;2| (|s| |x| $) - (SPADCALL |s| (SPADCALL (LIST |x|) (|getShellEntry| $ 12)) - (|getShellEntry| $ 9))) - -(DEFUN |SETAGG-;union;S2A;3| (|x| |s| $) - (SPADCALL |s| (SPADCALL (LIST |x|) (|getShellEntry| $ 12)) - (|getShellEntry| $ 9))) - -(DEFUN |SETAGG-;difference;ASA;4| (|s| |x| $) - (SPADCALL |s| (SPADCALL (LIST |x|) (|getShellEntry| $ 12)) - (|getShellEntry| $ 8))) - -(DEFUN |SetAggregate&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|SetAggregate&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| (LIST '|SetAggregate&| |dv$1| |dv$2|) . #0#) - (LETT $ (|newShell| 16) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 |#1|) - (|setShellEntry| $ 7 |#2|) - $)))) - -(MAKEPROP '|SetAggregate&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (0 . |difference|) (6 . |union|) - |SETAGG-;symmetricDifference;3A;1| (|List| 7) - (12 . |brace|) |SETAGG-;union;ASA;2| |SETAGG-;union;S2A;3| - |SETAGG-;difference;ASA;4|) - '#(|union| 17 |symmetricDifference| 29 |difference| 35) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 15 - '(2 6 0 0 0 8 2 6 0 0 0 9 1 6 0 11 12 2 - 0 0 7 0 14 2 0 0 0 7 13 2 0 0 0 0 10 - 2 0 0 0 7 15))))) - '|lookupComplete|)) -@ \section{category FSAGG FiniteSetAggregate} <<category FSAGG FiniteSetAggregate>>= @@ -2049,156 +1151,7 @@ RecursiveAggregate(S:Type): Category == HomogeneousAggregate(S) with child?(x,l) == member?(x,children(l)) @ -\section{RCAGG.lsp BOOTSTRAP} -{\bf RCAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf RCAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf RCAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<RCAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |RecursiveAggregate;CAT| 'NIL) - -(DEFPARAMETER |RecursiveAggregate;AL| 'NIL) - -(DEFUN |RecursiveAggregate| (#0=#:G1398) - (LET (#1=#:G1399) - (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#)))) - -(DEFUN |RecursiveAggregate;| (|t#1|) - (PROG (#0=#:G1397) - (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#) - (SETELT #0# 0 (LIST '|RecursiveAggregate| (|devaluate| |t#1|))))))) -@ -\section{RCAGG-.lsp BOOTSTRAP} -{\bf RCAGG-} depends on {\bf RCAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf RCAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf RCAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<RCAGG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |RCAGG-;elt;AvalueS;1| (|x| T0 $) (SPADCALL |x| (QREFELT $ 8))) - -(DEFUN |RCAGG-;setelt;Avalue2S;2| (|x| T1 |y| $) - (SPADCALL |x| |y| (QREFELT $ 11))) - -(DEFUN |RCAGG-;child?;2AB;3| (|x| |l| $) - (SPADCALL |x| (SPADCALL |l| (QREFELT $ 14)) (QREFELT $ 17))) - -(DEFUN |RecursiveAggregate&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|RecursiveAggregate&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| (LIST '|RecursiveAggregate&| |dv$1| |dv$2|) . #0#) - (LETT $ (GETREFV 19) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasAttribute| |#1| '|shallowlyMutable|) - (|HasCategory| |#2| '(|SetCategory|)))) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (QSETREFV $ 7 |#2|) - (COND - ((|testBitVector| |pv$| 1) - (QSETREFV $ 12 - (CONS (|dispatchFunction| |RCAGG-;setelt;Avalue2S;2|) $)))) - (COND - ((|testBitVector| |pv$| 2) - (QSETREFV $ 18 - (CONS (|dispatchFunction| |RCAGG-;child?;2AB;3|) $)))) - $)))) - -(MAKEPROP '|RecursiveAggregate&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (0 . |value|) '"value" |RCAGG-;elt;AvalueS;1| - (5 . |setvalue!|) (11 . |setelt|) (|List| $) - (18 . |children|) (|Boolean|) (|List| 6) (23 . |member?|) - (29 . |child?|)) - '#(|setelt| 35 |elt| 42 |child?| 48) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 18 - '(1 6 7 0 8 2 6 7 0 7 11 3 0 7 0 9 7 12 - 1 6 13 0 14 2 16 15 6 0 17 2 0 15 0 0 - 18 3 0 7 0 9 7 12 2 0 7 0 9 10 2 0 15 - 0 0 18))))) - '|lookupComplete|)) -@ + \section{category BRAGG BinaryRecursiveAggregate} <<category BRAGG BinaryRecursiveAggregate>>= )abbrev category BRAGG BinaryRecursiveAggregate @@ -2625,753 +1578,7 @@ UnaryRecursiveAggregate(S:Type): Category == RecursiveAggregate S with y @ -\section{URAGG.lsp BOOTSTRAP} -{\bf URAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf URAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf URAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<URAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |UnaryRecursiveAggregate;CAT| 'NIL) - -(DEFPARAMETER |UnaryRecursiveAggregate;AL| 'NIL) - -(DEFUN |UnaryRecursiveAggregate| (#0=#:G1426) - (LET (#1=#:G1427) - (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#)))) - -(DEFUN |UnaryRecursiveAggregate;| (|t#1|) - (PROG (#0=#:G1425) - (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#) - (SETELT #0# 0 - (LIST '|UnaryRecursiveAggregate| (|devaluate| |t#1|))))))) -@ -\section{URAGG-.lsp BOOTSTRAP} -{\bf URAGG-} depends on {\bf URAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf URAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf URAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<URAGG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |URAGG-;elt;AfirstS;1| (|x| T0 $) (SPADCALL |x| (QREFELT $ 8))) - -(DEFUN |URAGG-;elt;AlastS;2| (|x| T1 $) (SPADCALL |x| (QREFELT $ 11))) - -(DEFUN |URAGG-;elt;ArestA;3| (|x| T2 $) (SPADCALL |x| (QREFELT $ 14))) - -(DEFUN |URAGG-;second;AS;4| (|x| $) - (SPADCALL (SPADCALL |x| (QREFELT $ 14)) (QREFELT $ 8))) - -(DEFUN |URAGG-;third;AS;5| (|x| $) - (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT $ 14)) (QREFELT $ 14)) - (QREFELT $ 8))) - -(DEFUN |URAGG-;cyclic?;AB;6| (|x| $) - (COND - ((SPADCALL |x| (QREFELT $ 20)) 'NIL) - ('T - (SPADCALL (SPADCALL (|URAGG-;findCycle| |x| $) (QREFELT $ 20)) - (QREFELT $ 21))))) - -(DEFUN |URAGG-;last;AS;7| (|x| $) - (SPADCALL (SPADCALL |x| (QREFELT $ 23)) (QREFELT $ 8))) - -(DEFUN |URAGG-;nodes;AL;8| (|x| $) - (PROG (|l|) - (RETURN - (SEQ (LETT |l| NIL |URAGG-;nodes;AL;8|) - (SEQ G190 - (COND - ((NULL (SPADCALL (SPADCALL |x| (QREFELT $ 20)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (LETT |l| (CONS |x| |l|) |URAGG-;nodes;AL;8|) - (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;nodes;AL;8|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (NREVERSE |l|)))))) - -(DEFUN |URAGG-;children;AL;9| (|x| $) - (PROG (|l|) - (RETURN - (SEQ (LETT |l| NIL |URAGG-;children;AL;9|) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 20)) |l|) - ('T (CONS (SPADCALL |x| (QREFELT $ 14)) |l|)))))))) - -(DEFUN |URAGG-;leaf?;AB;10| (|x| $) (SPADCALL |x| (QREFELT $ 20))) - -(DEFUN |URAGG-;value;AS;11| (|x| $) - (COND - ((SPADCALL |x| (QREFELT $ 20)) (|error| "value of empty object")) - ('T (SPADCALL |x| (QREFELT $ 8))))) - -(DEFUN |URAGG-;less?;ANniB;12| (|l| |n| $) - (PROG (|i|) - (RETURN - (SEQ (LETT |i| |n| |URAGG-;less?;ANniB;12|) - (SEQ G190 - (COND - ((NULL (COND - ((< 0 |i|) - (SPADCALL (SPADCALL |l| (QREFELT $ 20)) - (QREFELT $ 21))) - ('T 'NIL))) - (GO G191))) - (SEQ (LETT |l| (SPADCALL |l| (QREFELT $ 14)) - |URAGG-;less?;ANniB;12|) - (EXIT (LETT |i| (- |i| 1) |URAGG-;less?;ANniB;12|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (< 0 |i|)))))) - -(DEFUN |URAGG-;more?;ANniB;13| (|l| |n| $) - (PROG (|i|) - (RETURN - (SEQ (LETT |i| |n| |URAGG-;more?;ANniB;13|) - (SEQ G190 - (COND - ((NULL (COND - ((< 0 |i|) - (SPADCALL (SPADCALL |l| (QREFELT $ 20)) - (QREFELT $ 21))) - ('T 'NIL))) - (GO G191))) - (SEQ (LETT |l| (SPADCALL |l| (QREFELT $ 14)) - |URAGG-;more?;ANniB;13|) - (EXIT (LETT |i| (- |i| 1) |URAGG-;more?;ANniB;13|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((ZEROP |i|) - (SPADCALL (SPADCALL |l| (QREFELT $ 20)) - (QREFELT $ 21))) - ('T 'NIL))))))) - -(DEFUN |URAGG-;size?;ANniB;14| (|l| |n| $) - (PROG (|i|) - (RETURN - (SEQ (LETT |i| |n| |URAGG-;size?;ANniB;14|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |l| (QREFELT $ 20)) 'NIL) - ('T (< 0 |i|)))) - (GO G191))) - (SEQ (LETT |l| (SPADCALL |l| (QREFELT $ 14)) - |URAGG-;size?;ANniB;14|) - (EXIT (LETT |i| (- |i| 1) |URAGG-;size?;ANniB;14|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |l| (QREFELT $ 20)) (ZEROP |i|)) - ('T 'NIL))))))) - -(DEFUN |URAGG-;#;ANni;15| (|x| $) - (PROG (|k|) - (RETURN - (SEQ (SEQ (LETT |k| 0 |URAGG-;#;ANni;15|) G190 - (COND - ((NULL (SPADCALL (SPADCALL |x| (QREFELT $ 20)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |x| (QREFELT $ 34)) - (EXIT (|error| "cyclic list")))))) - (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;#;ANni;15|))) - (LETT |k| (QSADD1 |k|) |URAGG-;#;ANni;15|) (GO G190) - G191 (EXIT NIL)) - (EXIT |k|))))) - -(DEFUN |URAGG-;tail;2A;16| (|x| $) - (PROG (|k| |y|) - (RETURN - (SEQ (COND - ((SPADCALL |x| (QREFELT $ 20)) (|error| "empty list")) - ('T - (SEQ (LETT |y| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;tail;2A;16|) - (SEQ (LETT |k| 0 |URAGG-;tail;2A;16|) G190 - (COND - ((NULL (SPADCALL - (SPADCALL |y| (QREFELT $ 20)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |x| (QREFELT $ 34)) - (EXIT (|error| "cyclic list")))))) - (EXIT (LETT |y| - (SPADCALL - (LETT |x| |y| |URAGG-;tail;2A;16|) - (QREFELT $ 14)) - |URAGG-;tail;2A;16|))) - (LETT |k| (QSADD1 |k|) |URAGG-;tail;2A;16|) - (GO G190) G191 (EXIT NIL)) - (EXIT |x|)))))))) - -(DEFUN |URAGG-;findCycle| (|x| $) - (PROG (#0=#:G1475 |y|) - (RETURN - (SEQ (EXIT (SEQ (LETT |y| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;findCycle|) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL |y| (QREFELT $ 20)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (COND - ((SPADCALL |x| |y| (QREFELT $ 37)) - (PROGN - (LETT #0# |x| |URAGG-;findCycle|) - (GO #0#)))) - (LETT |x| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;findCycle|) - (LETT |y| (SPADCALL |y| (QREFELT $ 14)) - |URAGG-;findCycle|) - (COND - ((SPADCALL |y| (QREFELT $ 20)) - (PROGN - (LETT #0# |y| |URAGG-;findCycle|) - (GO #0#)))) - (COND - ((SPADCALL |x| |y| (QREFELT $ 37)) - (PROGN - (LETT #0# |y| |URAGG-;findCycle|) - (GO #0#)))) - (EXIT (LETT |y| - (SPADCALL |y| (QREFELT $ 14)) - |URAGG-;findCycle|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |y|))) - #0# (EXIT #0#))))) - -(DEFUN |URAGG-;cycleTail;2A;18| (|x| $) - (PROG (|y| |z|) - (RETURN - (SEQ (COND - ((SPADCALL - (LETT |y| - (LETT |x| (SPADCALL |x| (QREFELT $ 38)) - |URAGG-;cycleTail;2A;18|) - |URAGG-;cycleTail;2A;18|) - (QREFELT $ 20)) - |x|) - ('T - (SEQ (LETT |z| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;cycleTail;2A;18|) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL |x| |z| (QREFELT $ 37)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (LETT |y| |z| |URAGG-;cycleTail;2A;18|) - (EXIT (LETT |z| - (SPADCALL |z| (QREFELT $ 14)) - |URAGG-;cycleTail;2A;18|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |y|)))))))) - -(DEFUN |URAGG-;cycleEntry;2A;19| (|x| $) - (PROG (|l| |z| |k| |y|) - (RETURN - (SEQ (COND - ((SPADCALL |x| (QREFELT $ 20)) |x|) - ((SPADCALL - (LETT |y| (|URAGG-;findCycle| |x| $) - |URAGG-;cycleEntry;2A;19|) - (QREFELT $ 20)) - |y|) - ('T - (SEQ (LETT |z| (SPADCALL |y| (QREFELT $ 14)) - |URAGG-;cycleEntry;2A;19|) - (SEQ (LETT |l| 1 |URAGG-;cycleEntry;2A;19|) G190 - (COND - ((NULL (SPADCALL - (SPADCALL |y| |z| (QREFELT $ 37)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (EXIT (LETT |z| - (SPADCALL |z| (QREFELT $ 14)) - |URAGG-;cycleEntry;2A;19|))) - (LETT |l| (QSADD1 |l|) - |URAGG-;cycleEntry;2A;19|) - (GO G190) G191 (EXIT NIL)) - (LETT |y| |x| |URAGG-;cycleEntry;2A;19|) - (SEQ (LETT |k| 1 |URAGG-;cycleEntry;2A;19|) G190 - (COND ((QSGREATERP |k| |l|) (GO G191))) - (SEQ (EXIT (LETT |y| - (SPADCALL |y| (QREFELT $ 14)) - |URAGG-;cycleEntry;2A;19|))) - (LETT |k| (QSADD1 |k|) - |URAGG-;cycleEntry;2A;19|) - (GO G190) G191 (EXIT NIL)) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL |x| |y| (QREFELT $ 37)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (LETT |x| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;cycleEntry;2A;19|) - (EXIT (LETT |y| - (SPADCALL |y| (QREFELT $ 14)) - |URAGG-;cycleEntry;2A;19|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |x|)))))))) - -(DEFUN |URAGG-;cycleLength;ANni;20| (|x| $) - (PROG (|k| |y|) - (RETURN - (SEQ (COND - ((OR (SPADCALL |x| (QREFELT $ 20)) - (SPADCALL - (LETT |x| (|URAGG-;findCycle| |x| $) - |URAGG-;cycleLength;ANni;20|) - (QREFELT $ 20))) - 0) - ('T - (SEQ (LETT |y| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;cycleLength;ANni;20|) - (SEQ (LETT |k| 1 |URAGG-;cycleLength;ANni;20|) G190 - (COND - ((NULL (SPADCALL - (SPADCALL |x| |y| (QREFELT $ 37)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (EXIT (LETT |y| - (SPADCALL |y| (QREFELT $ 14)) - |URAGG-;cycleLength;ANni;20|))) - (LETT |k| (QSADD1 |k|) - |URAGG-;cycleLength;ANni;20|) - (GO G190) G191 (EXIT NIL)) - (EXIT |k|)))))))) - -(DEFUN |URAGG-;rest;ANniA;21| (|x| |n| $) - (PROG (|i|) - (RETURN - (SEQ (SEQ (LETT |i| 1 |URAGG-;rest;ANniA;21|) G190 - (COND ((QSGREATERP |i| |n|) (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL |x| (QREFELT $ 20)) - (|error| "Index out of range")) - ('T - (LETT |x| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;rest;ANniA;21|))))) - (LETT |i| (QSADD1 |i|) |URAGG-;rest;ANniA;21|) - (GO G190) G191 (EXIT NIL)) - (EXIT |x|))))) - -(DEFUN |URAGG-;last;ANniA;22| (|x| |n| $) - (PROG (|m| #0=#:G1498) - (RETURN - (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 43)) - |URAGG-;last;ANniA;22|) - (EXIT (COND - ((< |m| |n|) (|error| "index out of range")) - ('T - (SPADCALL - (SPADCALL |x| - (PROG1 (LETT #0# (- |m| |n|) - |URAGG-;last;ANniA;22|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 44)) - (QREFELT $ 45))))))))) - -(DEFUN |URAGG-;=;2AB;23| (|x| |y| $) - (PROG (|k| #0=#:G1508) - (RETURN - (SEQ (EXIT (COND - ((SPADCALL |x| |y| (QREFELT $ 37)) 'T) - ('T - (SEQ (SEQ (LETT |k| 0 |URAGG-;=;2AB;23|) G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 20)) - 'NIL) - ('T - (SPADCALL - (SPADCALL |y| - (QREFELT $ 20)) - (QREFELT $ 21))))) - (GO G191))) - (SEQ (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |x| (QREFELT $ 34)) - (EXIT (|error| "cyclic list")))))) - (COND - ((NULL - (SPADCALL - (SPADCALL |x| (QREFELT $ 8)) - (SPADCALL |y| (QREFELT $ 8)) - (QREFELT $ 47))) - (EXIT - (PROGN - (LETT #0# 'NIL - |URAGG-;=;2AB;23|) - (GO #0#))))) - (LETT |x| - (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;=;2AB;23|) - (EXIT - (LETT |y| - (SPADCALL |y| (QREFELT $ 14)) - |URAGG-;=;2AB;23|))) - (LETT |k| (QSADD1 |k|) |URAGG-;=;2AB;23|) - (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 20)) - (SPADCALL |y| (QREFELT $ 20))) - ('T 'NIL))))))) - #0# (EXIT #0#))))) - -(DEFUN |URAGG-;node?;2AB;24| (|u| |v| $) - (PROG (|k| #0=#:G1513) - (RETURN - (SEQ (EXIT (SEQ (SEQ (LETT |k| 0 |URAGG-;node?;2AB;24|) G190 - (COND - ((NULL (SPADCALL - (SPADCALL |v| (QREFELT $ 20)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL |u| |v| - (QREFELT $ 49)) - (PROGN - (LETT #0# 'T - |URAGG-;node?;2AB;24|) - (GO #0#))) - ('T - (SEQ - (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |v| - (QREFELT $ 34)) - (EXIT - (|error| - "cyclic list")))))) - (EXIT - (LETT |v| - (SPADCALL |v| - (QREFELT $ 14)) - |URAGG-;node?;2AB;24|))))))) - (LETT |k| (QSADD1 |k|) - |URAGG-;node?;2AB;24|) - (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |u| |v| (QREFELT $ 49))))) - #0# (EXIT #0#))))) - -(DEFUN |URAGG-;setelt;Afirst2S;25| (|x| T3 |a| $) - (SPADCALL |x| |a| (QREFELT $ 51))) - -(DEFUN |URAGG-;setelt;Alast2S;26| (|x| T4 |a| $) - (SPADCALL |x| |a| (QREFELT $ 53))) - -(DEFUN |URAGG-;setelt;Arest2A;27| (|x| T5 |a| $) - (SPADCALL |x| |a| (QREFELT $ 55))) - -(DEFUN |URAGG-;concat;3A;28| (|x| |y| $) - (SPADCALL (SPADCALL |x| (QREFELT $ 45)) |y| (QREFELT $ 57))) - -(DEFUN |URAGG-;setlast!;A2S;29| (|x| |s| $) - (SEQ (COND - ((SPADCALL |x| (QREFELT $ 20)) - (|error| "setlast: empty list")) - ('T - (SEQ (SPADCALL (SPADCALL |x| (QREFELT $ 23)) |s| - (QREFELT $ 51)) - (EXIT |s|)))))) - -(DEFUN |URAGG-;setchildren!;ALA;30| (|u| |lv| $) - (COND - ((EQL (LENGTH |lv|) 1) - (SPADCALL |u| (|SPADfirst| |lv|) (QREFELT $ 55))) - ('T (|error| "wrong number of children specified")))) - -(DEFUN |URAGG-;setvalue!;A2S;31| (|u| |s| $) - (SPADCALL |u| |s| (QREFELT $ 51))) - -(DEFUN |URAGG-;split!;AIA;32| (|p| |n| $) - (PROG (#0=#:G1524 |q|) - (RETURN - (SEQ (COND - ((< |n| 1) (|error| "index out of range")) - ('T - (SEQ (LETT |p| - (SPADCALL |p| - (PROG1 (LETT #0# (- |n| 1) - |URAGG-;split!;AIA;32|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 44)) - |URAGG-;split!;AIA;32|) - (LETT |q| (SPADCALL |p| (QREFELT $ 14)) - |URAGG-;split!;AIA;32|) - (SPADCALL |p| (SPADCALL (QREFELT $ 62)) - (QREFELT $ 55)) - (EXIT |q|)))))))) - -(DEFUN |URAGG-;cycleSplit!;2A;33| (|x| $) - (PROG (|y| |z|) - (RETURN - (SEQ (COND - ((OR (SPADCALL - (LETT |y| (SPADCALL |x| (QREFELT $ 38)) - |URAGG-;cycleSplit!;2A;33|) - (QREFELT $ 20)) - (SPADCALL |x| |y| (QREFELT $ 37))) - |y|) - ('T - (SEQ (LETT |z| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;cycleSplit!;2A;33|) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL |z| |y| (QREFELT $ 37)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (LETT |x| |z| |URAGG-;cycleSplit!;2A;33|) - (EXIT (LETT |z| - (SPADCALL |z| (QREFELT $ 14)) - |URAGG-;cycleSplit!;2A;33|))) - NIL (GO G190) G191 (EXIT NIL)) - (SPADCALL |x| (SPADCALL (QREFELT $ 62)) - (QREFELT $ 55)) - (EXIT |y|)))))))) - -(DEFUN |UnaryRecursiveAggregate&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) - . #0=(|UnaryRecursiveAggregate&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| - (LIST '|UnaryRecursiveAggregate&| |dv$1| |dv$2|) . #0#) - (LETT $ (GETREFV 67) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasAttribute| |#1| '|shallowlyMutable|))) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (QSETREFV $ 7 |#2|) - (COND - ((|HasAttribute| |#1| '|finiteAggregate|) - (QSETREFV $ 46 - (CONS (|dispatchFunction| |URAGG-;last;ANniA;22|) $)))) - (COND - ((|HasCategory| |#2| '(|SetCategory|)) - (PROGN - (QSETREFV $ 48 - (CONS (|dispatchFunction| |URAGG-;=;2AB;23|) $)) - (QSETREFV $ 50 - (CONS (|dispatchFunction| |URAGG-;node?;2AB;24|) $))))) - (COND - ((|testBitVector| |pv$| 1) - (PROGN - (QSETREFV $ 52 - (CONS (|dispatchFunction| |URAGG-;setelt;Afirst2S;25|) - $)) - (QSETREFV $ 54 - (CONS (|dispatchFunction| |URAGG-;setelt;Alast2S;26|) - $)) - (QSETREFV $ 56 - (CONS (|dispatchFunction| |URAGG-;setelt;Arest2A;27|) - $)) - (QSETREFV $ 58 - (CONS (|dispatchFunction| |URAGG-;concat;3A;28|) $)) - (QSETREFV $ 59 - (CONS (|dispatchFunction| |URAGG-;setlast!;A2S;29|) $)) - (QSETREFV $ 60 - (CONS (|dispatchFunction| - |URAGG-;setchildren!;ALA;30|) - $)) - (QSETREFV $ 61 - (CONS (|dispatchFunction| |URAGG-;setvalue!;A2S;31|) - $)) - (QSETREFV $ 64 - (CONS (|dispatchFunction| |URAGG-;split!;AIA;32|) $)) - (QSETREFV $ 65 - (CONS (|dispatchFunction| |URAGG-;cycleSplit!;2A;33|) - $))))) - $)))) - -(MAKEPROP '|UnaryRecursiveAggregate&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (0 . |first|) '"first" |URAGG-;elt;AfirstS;1| (5 . |last|) - '"last" |URAGG-;elt;AlastS;2| (10 . |rest|) '"rest" - |URAGG-;elt;ArestA;3| |URAGG-;second;AS;4| - |URAGG-;third;AS;5| (|Boolean|) (15 . |empty?|) - (20 . |not|) |URAGG-;cyclic?;AB;6| (25 . |tail|) - |URAGG-;last;AS;7| (|List| $) |URAGG-;nodes;AL;8| - |URAGG-;children;AL;9| |URAGG-;leaf?;AB;10| - |URAGG-;value;AS;11| (|NonNegativeInteger|) - |URAGG-;less?;ANniB;12| |URAGG-;more?;ANniB;13| - |URAGG-;size?;ANniB;14| (30 . |cyclic?|) - |URAGG-;#;ANni;15| |URAGG-;tail;2A;16| (35 . |eq?|) - (41 . |cycleEntry|) |URAGG-;cycleTail;2A;18| - |URAGG-;cycleEntry;2A;19| |URAGG-;cycleLength;ANni;20| - |URAGG-;rest;ANniA;21| (46 . |#|) (51 . |rest|) - (57 . |copy|) (62 . |last|) (68 . =) (74 . =) (80 . =) - (86 . |node?|) (92 . |setfirst!|) (98 . |setelt|) - (105 . |setlast!|) (111 . |setelt|) (118 . |setrest!|) - (124 . |setelt|) (131 . |concat!|) (137 . |concat|) - (143 . |setlast!|) (149 . |setchildren!|) - (155 . |setvalue!|) (161 . |empty|) (|Integer|) - (165 . |split!|) (171 . |cycleSplit!|) '"value") - '#(|value| 176 |third| 181 |tail| 186 |split!| 191 |size?| - 197 |setvalue!| 203 |setlast!| 209 |setelt| 215 - |setchildren!| 236 |second| 242 |rest| 247 |nodes| 253 - |node?| 258 |more?| 264 |less?| 270 |leaf?| 276 |last| 281 - |elt| 292 |cyclic?| 310 |cycleTail| 315 |cycleSplit!| 320 - |cycleLength| 325 |cycleEntry| 330 |concat| 335 |children| - 341 = 346 |#| 352) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 65 - '(1 6 7 0 8 1 6 7 0 11 1 6 0 0 14 1 6 - 19 0 20 1 19 0 0 21 1 6 0 0 23 1 6 19 - 0 34 2 6 19 0 0 37 1 6 0 0 38 1 6 30 - 0 43 2 6 0 0 30 44 1 6 0 0 45 2 0 0 0 - 30 46 2 7 19 0 0 47 2 0 19 0 0 48 2 6 - 19 0 0 49 2 0 19 0 0 50 2 6 7 0 7 51 - 3 0 7 0 9 7 52 2 6 7 0 7 53 3 0 7 0 - 12 7 54 2 6 0 0 0 55 3 0 0 0 15 0 56 - 2 6 0 0 0 57 2 0 0 0 0 58 2 0 7 0 7 - 59 2 0 0 0 25 60 2 0 7 0 7 61 0 6 0 - 62 2 0 0 0 63 64 1 0 0 0 65 1 0 7 0 - 29 1 0 7 0 18 1 0 0 0 36 2 0 0 0 63 - 64 2 0 19 0 30 33 2 0 7 0 7 61 2 0 7 - 0 7 59 3 0 7 0 12 7 54 3 0 0 0 15 0 - 56 3 0 7 0 9 7 52 2 0 0 0 25 60 1 0 7 - 0 17 2 0 0 0 30 42 1 0 25 0 26 2 0 19 - 0 0 50 2 0 19 0 30 32 2 0 19 0 30 31 - 1 0 19 0 28 2 0 0 0 30 46 1 0 7 0 24 - 2 0 7 0 12 13 2 0 0 0 15 16 2 0 7 0 9 - 10 1 0 19 0 22 1 0 0 0 39 1 0 0 0 65 - 1 0 30 0 41 1 0 0 0 40 2 0 0 0 0 58 1 - 0 25 0 27 2 0 19 0 0 48 1 0 30 0 35))))) - '|lookupComplete|)) -@ + \section{category STAGG StreamAggregate} <<category STAGG StreamAggregate>>= )abbrev category STAGG StreamAggregate @@ -3463,366 +1670,7 @@ StreamAggregate(S:Type): Category == x @ -\section{STAGG.lsp BOOTSTRAP} -{\bf STAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf STAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf STAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<STAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |StreamAggregate;CAT| 'NIL) - -(DEFPARAMETER |StreamAggregate;AL| 'NIL) - -(DEFUN |StreamAggregate| (#0=#:G1405) - (LET (#1=#:G1406) - (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#)))) - -(DEFUN |StreamAggregate;| (|t#1|) - (PROG (#0=#:G1404) - (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#) - (SETELT #0# 0 (LIST '|StreamAggregate| (|devaluate| |t#1|))))))) -@ -\section{STAGG-.lsp BOOTSTRAP} -{\bf STAGG-} depends on {\bf STAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf STAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf STAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<STAGG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |STAGG-;explicitlyFinite?;AB;1| (|x| $) - (SPADCALL (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 10))) - -(DEFUN |STAGG-;possiblyInfinite?;AB;2| (|x| $) - (SPADCALL |x| (QREFELT $ 9))) - -(DEFUN |STAGG-;first;ANniA;3| (|x| |n| $) - (PROG (#0=#:G1411 |i|) - (RETURN - (SEQ (SPADCALL - (PROGN - (LETT #0# NIL |STAGG-;first;ANniA;3|) - (SEQ (LETT |i| 1 |STAGG-;first;ANniA;3|) G190 - (COND ((QSGREATERP |i| |n|) (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (|STAGG-;c2| |x| - (LETT |x| - (SPADCALL |x| (QREFELT $ 13)) - |STAGG-;first;ANniA;3|) - $) - #0#) - |STAGG-;first;ANniA;3|))) - (LETT |i| (QSADD1 |i|) |STAGG-;first;ANniA;3|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - (QREFELT $ 15)))))) - -(DEFUN |STAGG-;c2| (|x| |r| $) - (COND - ((SPADCALL |x| (QREFELT $ 18)) (|error| "Index out of range")) - ('T (SPADCALL |x| (QREFELT $ 19))))) - -(DEFUN |STAGG-;elt;AIS;5| (|x| |i| $) - (PROG (#0=#:G1414) - (RETURN - (SEQ (LETT |i| (- |i| (SPADCALL |x| (QREFELT $ 21))) - |STAGG-;elt;AIS;5|) - (COND - ((OR (< |i| 0) - (SPADCALL - (LETT |x| - (SPADCALL |x| - (PROG1 (LETT #0# |i| - |STAGG-;elt;AIS;5|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 22)) - |STAGG-;elt;AIS;5|) - (QREFELT $ 18))) - (EXIT (|error| "index out of range")))) - (EXIT (SPADCALL |x| (QREFELT $ 19))))))) - -(DEFUN |STAGG-;elt;AUsA;6| (|x| |i| $) - (PROG (|l| #0=#:G1418 |h| #1=#:G1420 #2=#:G1421) - (RETURN - (SEQ (LETT |l| - (- (SPADCALL |i| (QREFELT $ 25)) - (SPADCALL |x| (QREFELT $ 21))) - |STAGG-;elt;AUsA;6|) - (EXIT (COND - ((< |l| 0) (|error| "index out of range")) - ((NULL (SPADCALL |i| (QREFELT $ 26))) - (SPADCALL - (SPADCALL |x| - (PROG1 (LETT #0# |l| |STAGG-;elt;AUsA;6|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 22)) - (QREFELT $ 27))) - ('T - (SEQ (LETT |h| - (- (SPADCALL |i| (QREFELT $ 28)) - (SPADCALL |x| (QREFELT $ 21))) - |STAGG-;elt;AUsA;6|) - (EXIT (COND - ((< |h| |l|) - (SPADCALL (QREFELT $ 29))) - ('T - (SPADCALL - (SPADCALL |x| - (PROG1 - (LETT #1# |l| - |STAGG-;elt;AUsA;6|) - (|check-subtype| (>= #1# 0) - '(|NonNegativeInteger|) #1#)) - (QREFELT $ 22)) - (PROG1 - (LETT #2# (+ (- |h| |l|) 1) - |STAGG-;elt;AUsA;6|) - (|check-subtype| (>= #2# 0) - '(|NonNegativeInteger|) #2#)) - (QREFELT $ 30))))))))))))) - -(DEFUN |STAGG-;concat;3A;7| (|x| |y| $) - (SPADCALL (SPADCALL |x| (QREFELT $ 27)) |y| (QREFELT $ 32))) - -(DEFUN |STAGG-;concat;LA;8| (|l| $) - (COND - ((NULL |l|) (SPADCALL (QREFELT $ 29))) - ('T - (SPADCALL (SPADCALL (|SPADfirst| |l|) (QREFELT $ 27)) - (SPADCALL (CDR |l|) (QREFELT $ 35)) (QREFELT $ 32))))) - -(DEFUN |STAGG-;map!;M2A;9| (|f| |l| $) - (PROG (|y|) - (RETURN - (SEQ (LETT |y| |l| |STAGG-;map!;M2A;9|) - (SEQ G190 - (COND - ((NULL (SPADCALL (SPADCALL |l| (QREFELT $ 18)) - (QREFELT $ 10))) - (GO G191))) - (SEQ (SPADCALL |l| - (SPADCALL (SPADCALL |l| (QREFELT $ 19)) |f|) - (QREFELT $ 37)) - (EXIT (LETT |l| (SPADCALL |l| (QREFELT $ 13)) - |STAGG-;map!;M2A;9|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |y|))))) - -(DEFUN |STAGG-;fill!;ASA;10| (|x| |s| $) - (PROG (|y|) - (RETURN - (SEQ (LETT |y| |x| |STAGG-;fill!;ASA;10|) - (SEQ G190 - (COND - ((NULL (SPADCALL (SPADCALL |y| (QREFELT $ 18)) - (QREFELT $ 10))) - (GO G191))) - (SEQ (SPADCALL |y| |s| (QREFELT $ 37)) - (EXIT (LETT |y| (SPADCALL |y| (QREFELT $ 13)) - |STAGG-;fill!;ASA;10|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |x|))))) - -(DEFUN |STAGG-;setelt;AI2S;11| (|x| |i| |s| $) - (PROG (#0=#:G1437) - (RETURN - (SEQ (LETT |i| (- |i| (SPADCALL |x| (QREFELT $ 21))) - |STAGG-;setelt;AI2S;11|) - (COND - ((OR (< |i| 0) - (SPADCALL - (LETT |x| - (SPADCALL |x| - (PROG1 (LETT #0# |i| - |STAGG-;setelt;AI2S;11|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 22)) - |STAGG-;setelt;AI2S;11|) - (QREFELT $ 18))) - (EXIT (|error| "index out of range")))) - (EXIT (SPADCALL |x| |s| (QREFELT $ 37))))))) - -(DEFUN |STAGG-;setelt;AUs2S;12| (|x| |i| |s| $) - (PROG (|l| |h| #0=#:G1442 #1=#:G1443 |z| |y|) - (RETURN - (SEQ (LETT |l| - (- (SPADCALL |i| (QREFELT $ 25)) - (SPADCALL |x| (QREFELT $ 21))) - |STAGG-;setelt;AUs2S;12|) - (EXIT (COND - ((< |l| 0) (|error| "index out of range")) - ('T - (SEQ (LETT |h| - (COND - ((SPADCALL |i| (QREFELT $ 26)) - (- (SPADCALL |i| (QREFELT $ 28)) - (SPADCALL |x| (QREFELT $ 21)))) - ('T (SPADCALL |x| (QREFELT $ 42)))) - |STAGG-;setelt;AUs2S;12|) - (EXIT (COND - ((< |h| |l|) |s|) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (PROG1 - (LETT #0# |l| - |STAGG-;setelt;AUs2S;12|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) - #0#)) - (QREFELT $ 22)) - |STAGG-;setelt;AUs2S;12|) - (LETT |z| - (SPADCALL |y| - (PROG1 - (LETT #1# (+ (- |h| |l|) 1) - |STAGG-;setelt;AUs2S;12|) - (|check-subtype| (>= #1# 0) - '(|NonNegativeInteger|) - #1#)) - (QREFELT $ 22)) - |STAGG-;setelt;AUs2S;12|) - (SEQ G190 - (COND - ((NULL - (SPADCALL - (SPADCALL |y| |z| - (QREFELT $ 43)) - (QREFELT $ 10))) - (GO G191))) - (SEQ - (SPADCALL |y| |s| - (QREFELT $ 37)) - (EXIT - (LETT |y| - (SPADCALL |y| - (QREFELT $ 13)) - |STAGG-;setelt;AUs2S;12|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |s|))))))))))))) - -(DEFUN |STAGG-;concat!;3A;13| (|x| |y| $) - (SEQ (COND - ((SPADCALL |x| (QREFELT $ 18)) |y|) - ('T - (SEQ (SPADCALL (SPADCALL |x| (QREFELT $ 45)) |y| - (QREFELT $ 46)) - (EXIT |x|)))))) - -(DEFUN |StreamAggregate&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|StreamAggregate&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| (LIST '|StreamAggregate&| |dv$1| |dv$2|) . #0#) - (LETT $ (GETREFV 52) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (QSETREFV $ 7 |#2|) - (COND - ((|HasAttribute| |#1| '|shallowlyMutable|) - (PROGN - (QSETREFV $ 33 - (CONS (|dispatchFunction| |STAGG-;concat;3A;7|) $)) - (QSETREFV $ 36 - (CONS (|dispatchFunction| |STAGG-;concat;LA;8|) $)) - (QSETREFV $ 39 - (CONS (|dispatchFunction| |STAGG-;map!;M2A;9|) $)) - (QSETREFV $ 40 - (CONS (|dispatchFunction| |STAGG-;fill!;ASA;10|) $)) - (QSETREFV $ 41 - (CONS (|dispatchFunction| |STAGG-;setelt;AI2S;11|) $)) - (QSETREFV $ 44 - (CONS (|dispatchFunction| |STAGG-;setelt;AUs2S;12|) $)) - (QSETREFV $ 47 - (CONS (|dispatchFunction| |STAGG-;concat!;3A;13|) $))))) - $)))) - -(MAKEPROP '|StreamAggregate&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|Boolean|) (0 . |cyclic?|) (5 . |not|) - |STAGG-;explicitlyFinite?;AB;1| - |STAGG-;possiblyInfinite?;AB;2| (10 . |rest|) (|List| 7) - (15 . |construct|) (|NonNegativeInteger|) - |STAGG-;first;ANniA;3| (20 . |empty?|) (25 . |first|) - (|Integer|) (30 . |minIndex|) (35 . |rest|) - |STAGG-;elt;AIS;5| (|UniversalSegment| 20) (41 . |lo|) - (46 . |hasHi|) (51 . |copy|) (56 . |hi|) (61 . |empty|) - (65 . |first|) |STAGG-;elt;AUsA;6| (71 . |concat!|) - (77 . |concat|) (|List| $) (83 . |concat|) (88 . |concat|) - (93 . |setfirst!|) (|Mapping| 7 7) (99 . |map!|) - (105 . |fill!|) (111 . |setelt|) (118 . |maxIndex|) - (123 . |eq?|) (129 . |setelt|) (136 . |tail|) - (141 . |setrest!|) (147 . |concat!|) '"rest" '"last" - '"first" '"value") - '#(|setelt| 153 |possiblyInfinite?| 167 |map!| 172 |first| - 178 |fill!| 184 |explicitlyFinite?| 190 |elt| 195 - |concat!| 207 |concat| 213) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 47 - '(1 6 8 0 9 1 8 0 0 10 1 6 0 0 13 1 6 0 - 14 15 1 6 8 0 18 1 6 7 0 19 1 6 20 0 - 21 2 6 0 0 16 22 1 24 20 0 25 1 24 8 - 0 26 1 6 0 0 27 1 24 20 0 28 0 6 0 29 - 2 6 0 0 16 30 2 6 0 0 0 32 2 0 0 0 0 - 33 1 6 0 34 35 1 0 0 34 36 2 6 7 0 7 - 37 2 0 0 38 0 39 2 0 0 0 7 40 3 0 7 0 - 20 7 41 1 6 20 0 42 2 6 8 0 0 43 3 0 - 7 0 24 7 44 1 6 0 0 45 2 6 0 0 0 46 2 - 0 0 0 0 47 3 0 7 0 20 7 41 3 0 7 0 24 - 7 44 1 0 8 0 12 2 0 0 38 0 39 2 0 0 0 - 16 17 2 0 0 0 7 40 1 0 8 0 11 2 0 7 0 - 20 23 2 0 0 0 24 31 2 0 0 0 0 47 1 0 - 0 34 36 2 0 0 0 0 33))))) - '|lookupComplete|)) -@ + \section{category LNAGG LinearAggregate} <<category LNAGG LinearAggregate>>= )abbrev category LNAGG LinearAggregate @@ -3908,189 +1756,7 @@ LinearAggregate(S:Type): Category == --if % has shallowlyMutable then new(n, s) == fill_!(new n, s) @ -\section{LNAGG.lsp BOOTSTRAP} -{\bf LNAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf LNAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf LNAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<LNAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |LinearAggregate;CAT| 'NIL) - -(DEFPARAMETER |LinearAggregate;AL| 'NIL) - -(DEFUN |LinearAggregate| (#0=#:G1400) - (LET (#1=#:G1401) - (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#)))) - -(DEFUN |LinearAggregate;| (|t#1|) - (PROG (#0=#:G1399) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (|sublisV| - (PAIR '(#1=#:G1398) (LIST '(|Integer|))) - (COND - (|LinearAggregate;CAT|) - ('T - (LETT |LinearAggregate;CAT| - (|Join| - (|IndexedAggregate| '#1# '|t#1|) - (|Collection| '|t#1|) - (|mkCategory| '|domain| - '(((|new| - ($ (|NonNegativeInteger|) - |t#1|)) - T) - ((|concat| ($ $ |t#1|)) T) - ((|concat| ($ |t#1| $)) T) - ((|concat| ($ $ $)) T) - ((|concat| ($ (|List| $))) T) - ((|map| - ($ - (|Mapping| |t#1| |t#1| - |t#1|) - $ $)) - T) - ((|elt| - ($ $ - (|UniversalSegment| - (|Integer|)))) - T) - ((|delete| ($ $ (|Integer|))) - T) - ((|delete| - ($ $ - (|UniversalSegment| - (|Integer|)))) - T) - ((|insert| - ($ |t#1| $ (|Integer|))) - T) - ((|insert| ($ $ $ (|Integer|))) - T) - ((|setelt| - (|t#1| $ - (|UniversalSegment| - (|Integer|)) - |t#1|)) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|)))) - NIL - '((|UniversalSegment| - (|Integer|)) - (|Integer|) (|List| $) - (|NonNegativeInteger|)) - NIL)) - . #2=(|LinearAggregate|)))))) . #2#) - (SETELT #0# 0 (LIST '|LinearAggregate| (|devaluate| |t#1|))))))) -@ -\section{LNAGG-.lsp BOOTSTRAP} -{\bf LNAGG-} depends on {\bf LNAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf LNAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf LNAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<LNAGG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |LNAGG-;indices;AL;1| (|a| $) - (PROG (#0=#:G1404 |i| #1=#:G1405) - (RETURN - (SEQ (PROGN - (LETT #0# NIL |LNAGG-;indices;AL;1|) - (SEQ (LETT |i| (SPADCALL |a| (QREFELT $ 9)) - |LNAGG-;indices;AL;1|) - (LETT #1# (SPADCALL |a| (QREFELT $ 10)) - |LNAGG-;indices;AL;1|) - G190 (COND ((> |i| #1#) (GO G191))) - (SEQ (EXIT (LETT #0# (CONS |i| #0#) - |LNAGG-;indices;AL;1|))) - (LETT |i| (+ |i| 1) |LNAGG-;indices;AL;1|) (GO G190) - G191 (EXIT (NREVERSE0 #0#)))))))) - -(DEFUN |LNAGG-;index?;IAB;2| (|i| |a| $) - (COND - ((< |i| (SPADCALL |a| (QREFELT $ 9))) 'NIL) - ('T - (SPADCALL (< (SPADCALL |a| (QREFELT $ 10)) |i|) (QREFELT $ 14))))) - -(DEFUN |LNAGG-;concat;ASA;3| (|a| |x| $) - (SPADCALL |a| (SPADCALL 1 |x| (QREFELT $ 17)) (QREFELT $ 18))) - -(DEFUN |LNAGG-;concat;S2A;4| (|x| |y| $) - (SPADCALL (SPADCALL 1 |x| (QREFELT $ 17)) |y| (QREFELT $ 18))) - -(DEFUN |LNAGG-;insert;SAIA;5| (|x| |a| |i| $) - (SPADCALL (SPADCALL 1 |x| (QREFELT $ 17)) |a| |i| (QREFELT $ 21))) - -(DEFUN |LNAGG-;maxIndex;AI;6| (|l| $) - (+ (- (SPADCALL |l| (QREFELT $ 23)) 1) (SPADCALL |l| (QREFELT $ 9)))) - -(DEFUN |LinearAggregate&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|LinearAggregate&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| (LIST '|LinearAggregate&| |dv$1| |dv$2|) . #0#) - (LETT $ (GETREFV 26) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasAttribute| |#1| '|shallowlyMutable|))) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (QSETREFV $ 7 |#2|) - (COND - ((|HasAttribute| |#1| '|finiteAggregate|) - (QSETREFV $ 24 - (CONS (|dispatchFunction| |LNAGG-;maxIndex;AI;6|) $)))) - $)))) - -(MAKEPROP '|LinearAggregate&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|Integer|) (0 . |minIndex|) (5 . |maxIndex|) (|List| 8) - |LNAGG-;indices;AL;1| (|Boolean|) (10 . |not|) - |LNAGG-;index?;IAB;2| (|NonNegativeInteger|) (15 . |new|) - (21 . |concat|) |LNAGG-;concat;ASA;3| - |LNAGG-;concat;S2A;4| (27 . |insert|) - |LNAGG-;insert;SAIA;5| (34 . |#|) (39 . |maxIndex|) - (|List| $)) - '#(|maxIndex| 44 |insert| 49 |indices| 56 |index?| 61 - |concat| 67) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 24 - '(1 6 8 0 9 1 6 8 0 10 1 13 0 0 14 2 6 - 0 16 7 17 2 6 0 0 0 18 3 6 0 0 0 8 21 - 1 6 16 0 23 1 0 8 0 24 1 0 8 0 24 3 0 - 0 7 0 8 22 1 0 11 0 12 2 0 13 8 0 15 - 2 0 0 0 7 19 2 0 0 7 0 20))))) - '|lookupComplete|)) -@ + \section{category FLAGG FiniteLinearAggregate} <<category FLAGG FiniteLinearAggregate>>= )abbrev category FLAGG FiniteLinearAggregate @@ -4717,860 +2383,7 @@ ListAggregate(S:Type): Category == Join(StreamAggregate S, false @ -\section{LSAGG.lsp BOOTSTRAP} -{\bf LSAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf LSAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf LSAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<LSAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |ListAggregate;CAT| 'NIL) - -(DEFPARAMETER |ListAggregate;AL| 'NIL) - -(DEFUN |ListAggregate| (#0=#:G1431) - (LET (#1=#:G1432) - (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#)))) - -(DEFUN |ListAggregate;| (|t#1|) - (PROG (#0=#:G1430) - (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#) - (SETELT #0# 0 (LIST '|ListAggregate| (|devaluate| |t#1|))))))) -@ -\section{LSAGG-.lsp BOOTSTRAP} -{\bf LSAGG-} depends on {\bf LSAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf LSAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf LSAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<LSAGG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |LSAGG-;sort!;M2A;1| (|f| |l| $) - (|LSAGG-;mergeSort| |f| |l| (SPADCALL |l| (QREFELT $ 9)) $)) - -(DEFUN |LSAGG-;list;SA;2| (|x| $) - (SPADCALL |x| (SPADCALL (QREFELT $ 12)) (QREFELT $ 13))) - -(DEFUN |LSAGG-;reduce;MAS;3| (|f| |x| $) - (COND - ((SPADCALL |x| (QREFELT $ 16)) - (|error| "reducing over an empty list needs the 3 argument form")) - ('T - (SPADCALL |f| (SPADCALL |x| (QREFELT $ 17)) - (SPADCALL |x| (QREFELT $ 18)) (QREFELT $ 20))))) - -(DEFUN |LSAGG-;merge;M3A;4| (|f| |p| |q| $) - (SPADCALL |f| (SPADCALL |p| (QREFELT $ 22)) - (SPADCALL |q| (QREFELT $ 22)) (QREFELT $ 23))) - -(DEFUN |LSAGG-;select!;M2A;5| (|f| |x| $) - (PROG (|y| |z|) - (RETURN - (SEQ (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 16)) 'NIL) - ('T - (SPADCALL - (SPADCALL (SPADCALL |x| (QREFELT $ 18)) - |f|) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;select!;M2A;5|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 16)) |x|) - ('T - (SEQ (LETT |y| |x| |LSAGG-;select!;M2A;5|) - (LETT |z| (SPADCALL |y| (QREFELT $ 17)) - |LSAGG-;select!;M2A;5|) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL |z| (QREFELT $ 16)) - (QREFELT $ 25))) - (GO G191))) - (SEQ (EXIT - (COND - ((SPADCALL - (SPADCALL |z| (QREFELT $ 18)) - |f|) - (SEQ - (LETT |y| |z| - |LSAGG-;select!;M2A;5|) - (EXIT - (LETT |z| - (SPADCALL |z| (QREFELT $ 17)) - |LSAGG-;select!;M2A;5|)))) - ('T - (SEQ - (LETT |z| - (SPADCALL |z| (QREFELT $ 17)) - |LSAGG-;select!;M2A;5|) - (EXIT - (SPADCALL |y| |z| - (QREFELT $ 26)))))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |x|))))))))) - -(DEFUN |LSAGG-;merge!;M3A;6| (|f| |p| |q| $) - (PROG (|r| |t|) - (RETURN - (SEQ (COND - ((SPADCALL |p| (QREFELT $ 16)) |q|) - ((SPADCALL |q| (QREFELT $ 16)) |p|) - ((SPADCALL |p| |q| (QREFELT $ 29)) - (|error| "cannot merge a list into itself")) - ('T - (SEQ (COND - ((SPADCALL (SPADCALL |p| (QREFELT $ 18)) - (SPADCALL |q| (QREFELT $ 18)) |f|) - (SEQ (LETT |r| - (LETT |t| |p| |LSAGG-;merge!;M3A;6|) - |LSAGG-;merge!;M3A;6|) - (EXIT (LETT |p| - (SPADCALL |p| (QREFELT $ 17)) - |LSAGG-;merge!;M3A;6|)))) - ('T - (SEQ (LETT |r| - (LETT |t| |q| |LSAGG-;merge!;M3A;6|) - |LSAGG-;merge!;M3A;6|) - (EXIT (LETT |q| - (SPADCALL |q| (QREFELT $ 17)) - |LSAGG-;merge!;M3A;6|))))) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |p| (QREFELT $ 16)) 'NIL) - ('T - (SPADCALL - (SPADCALL |q| (QREFELT $ 16)) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL - (SPADCALL |p| (QREFELT $ 18)) - (SPADCALL |q| (QREFELT $ 18)) - |f|) - (SEQ - (SPADCALL |t| |p| - (QREFELT $ 26)) - (LETT |t| |p| - |LSAGG-;merge!;M3A;6|) - (EXIT - (LETT |p| - (SPADCALL |p| (QREFELT $ 17)) - |LSAGG-;merge!;M3A;6|)))) - ('T - (SEQ - (SPADCALL |t| |q| - (QREFELT $ 26)) - (LETT |t| |q| - |LSAGG-;merge!;M3A;6|) - (EXIT - (LETT |q| - (SPADCALL |q| (QREFELT $ 17)) - |LSAGG-;merge!;M3A;6|))))))) - NIL (GO G190) G191 (EXIT NIL)) - (SPADCALL |t| - (COND - ((SPADCALL |p| (QREFELT $ 16)) |q|) - ('T |p|)) - (QREFELT $ 26)) - (EXIT |r|)))))))) - -(DEFUN |LSAGG-;insert!;SAIA;7| (|s| |x| |i| $) - (PROG (|m| #0=#:G1464 |y| |z|) - (RETURN - (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 32)) - |LSAGG-;insert!;SAIA;7|) - (EXIT (COND - ((< |i| |m|) (|error| "index out of range")) - ((EQL |i| |m|) (SPADCALL |s| |x| (QREFELT $ 13))) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (PROG1 - (LETT #0# (- (- |i| 1) |m|) - |LSAGG-;insert!;SAIA;7|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 33)) - |LSAGG-;insert!;SAIA;7|) - (LETT |z| (SPADCALL |y| (QREFELT $ 17)) - |LSAGG-;insert!;SAIA;7|) - (SPADCALL |y| - (SPADCALL |s| |z| (QREFELT $ 13)) - (QREFELT $ 26)) - (EXIT |x|))))))))) - -(DEFUN |LSAGG-;insert!;2AIA;8| (|w| |x| |i| $) - (PROG (|m| #0=#:G1468 |y| |z|) - (RETURN - (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 32)) - |LSAGG-;insert!;2AIA;8|) - (EXIT (COND - ((< |i| |m|) (|error| "index out of range")) - ((EQL |i| |m|) (SPADCALL |w| |x| (QREFELT $ 35))) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (PROG1 - (LETT #0# (- (- |i| 1) |m|) - |LSAGG-;insert!;2AIA;8|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 33)) - |LSAGG-;insert!;2AIA;8|) - (LETT |z| (SPADCALL |y| (QREFELT $ 17)) - |LSAGG-;insert!;2AIA;8|) - (SPADCALL |y| |w| (QREFELT $ 26)) - (SPADCALL |y| |z| (QREFELT $ 35)) (EXIT |x|))))))))) - -(DEFUN |LSAGG-;remove!;M2A;9| (|f| |x| $) - (PROG (|p| |q|) - (RETURN - (SEQ (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 16)) 'NIL) - ('T - (SPADCALL (SPADCALL |x| (QREFELT $ 18)) - |f|)))) - (GO G191))) - (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;remove!;M2A;9|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 16)) |x|) - ('T - (SEQ (LETT |p| |x| |LSAGG-;remove!;M2A;9|) - (LETT |q| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;remove!;M2A;9|) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL |q| (QREFELT $ 16)) - (QREFELT $ 25))) - (GO G191))) - (SEQ (EXIT - (COND - ((SPADCALL - (SPADCALL |q| (QREFELT $ 18)) - |f|) - (LETT |q| - (SPADCALL |p| - (SPADCALL |q| (QREFELT $ 17)) - (QREFELT $ 26)) - |LSAGG-;remove!;M2A;9|)) - ('T - (SEQ - (LETT |p| |q| - |LSAGG-;remove!;M2A;9|) - (EXIT - (LETT |q| - (SPADCALL |q| (QREFELT $ 17)) - |LSAGG-;remove!;M2A;9|))))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |x|))))))))) - -(DEFUN |LSAGG-;delete!;AIA;10| (|x| |i| $) - (PROG (|m| #0=#:G1480 |y|) - (RETURN - (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 32)) - |LSAGG-;delete!;AIA;10|) - (EXIT (COND - ((< |i| |m|) (|error| "index out of range")) - ((EQL |i| |m|) (SPADCALL |x| (QREFELT $ 17))) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (PROG1 - (LETT #0# (- (- |i| 1) |m|) - |LSAGG-;delete!;AIA;10|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 33)) - |LSAGG-;delete!;AIA;10|) - (SPADCALL |y| (SPADCALL |y| 2 (QREFELT $ 33)) - (QREFELT $ 26)) - (EXIT |x|))))))))) - -(DEFUN |LSAGG-;delete!;AUsA;11| (|x| |i| $) - (PROG (|l| |m| |h| #0=#:G1485 #1=#:G1486 |t| #2=#:G1487) - (RETURN - (SEQ (LETT |l| (SPADCALL |i| (QREFELT $ 40)) - |LSAGG-;delete!;AUsA;11|) - (LETT |m| (SPADCALL |x| (QREFELT $ 32)) - |LSAGG-;delete!;AUsA;11|) - (EXIT (COND - ((< |l| |m|) (|error| "index out of range")) - ('T - (SEQ (LETT |h| - (COND - ((SPADCALL |i| (QREFELT $ 41)) - (SPADCALL |i| (QREFELT $ 42))) - ('T (SPADCALL |x| (QREFELT $ 43)))) - |LSAGG-;delete!;AUsA;11|) - (EXIT (COND - ((< |h| |l|) |x|) - ((EQL |l| |m|) - (SPADCALL |x| - (PROG1 - (LETT #0# (- (+ |h| 1) |m|) - |LSAGG-;delete!;AUsA;11|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 33))) - ('T - (SEQ (LETT |t| - (SPADCALL |x| - (PROG1 - (LETT #1# (- (- |l| 1) |m|) - |LSAGG-;delete!;AUsA;11|) - (|check-subtype| (>= #1# 0) - '(|NonNegativeInteger|) - #1#)) - (QREFELT $ 33)) - |LSAGG-;delete!;AUsA;11|) - (SPADCALL |t| - (SPADCALL |t| - (PROG1 - (LETT #2# (+ (- |h| |l|) 2) - |LSAGG-;delete!;AUsA;11|) - (|check-subtype| (>= #2# 0) - '(|NonNegativeInteger|) - #2#)) - (QREFELT $ 33)) - (QREFELT $ 26)) - (EXIT |x|))))))))))))) - -(DEFUN |LSAGG-;find;MAU;12| (|f| |x| $) - (SEQ (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 16)) 'NIL) - ('T - (SPADCALL - (SPADCALL (SPADCALL |x| (QREFELT $ 18)) - |f|) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;find;MAU;12|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 16)) (CONS 1 "failed")) - ('T (CONS 0 (SPADCALL |x| (QREFELT $ 18)))))))) - -(DEFUN |LSAGG-;position;MAI;13| (|f| |x| $) - (PROG (|k|) - (RETURN - (SEQ (SEQ (LETT |k| (SPADCALL |x| (QREFELT $ 32)) - |LSAGG-;position;MAI;13|) - G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 16)) 'NIL) - ('T - (SPADCALL - (SPADCALL (SPADCALL |x| (QREFELT $ 18)) - |f|) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;position;MAI;13|))) - (LETT |k| (+ |k| 1) |LSAGG-;position;MAI;13|) (GO G190) - G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 16)) - (- (SPADCALL |x| (QREFELT $ 32)) 1)) - ('T |k|))))))) - -(DEFUN |LSAGG-;mergeSort| (|f| |p| |n| $) - (PROG (#0=#:G1507 |l| |q|) - (RETURN - (SEQ (COND - ((EQL |n| 2) - (COND - ((SPADCALL - (SPADCALL (SPADCALL |p| (QREFELT $ 17)) - (QREFELT $ 18)) - (SPADCALL |p| (QREFELT $ 18)) |f|) - (LETT |p| (SPADCALL |p| (QREFELT $ 48)) - |LSAGG-;mergeSort|))))) - (EXIT (COND - ((< |n| 3) |p|) - ('T - (SEQ (LETT |l| - (PROG1 (LETT #0# (QUOTIENT2 |n| 2) - |LSAGG-;mergeSort|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - |LSAGG-;mergeSort|) - (LETT |q| (SPADCALL |p| |l| (QREFELT $ 49)) - |LSAGG-;mergeSort|) - (LETT |p| (|LSAGG-;mergeSort| |f| |p| |l| $) - |LSAGG-;mergeSort|) - (LETT |q| - (|LSAGG-;mergeSort| |f| |q| (- |n| |l|) - $) - |LSAGG-;mergeSort|) - (EXIT (SPADCALL |f| |p| |q| (QREFELT $ 23))))))))))) - -(DEFUN |LSAGG-;sorted?;MAB;15| (|f| |l| $) - (PROG (#0=#:G1516 |p|) - (RETURN - (SEQ (EXIT (COND - ((SPADCALL |l| (QREFELT $ 16)) 'T) - ('T - (SEQ (LETT |p| (SPADCALL |l| (QREFELT $ 17)) - |LSAGG-;sorted?;MAB;15|) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL |p| (QREFELT $ 16)) - (QREFELT $ 25))) - (GO G191))) - (SEQ (EXIT - (COND - ((NULL - (SPADCALL - (SPADCALL |l| (QREFELT $ 18)) - (SPADCALL |p| (QREFELT $ 18)) - |f|)) - (PROGN - (LETT #0# 'NIL - |LSAGG-;sorted?;MAB;15|) - (GO #0#))) - ('T - (LETT |p| - (SPADCALL - (LETT |l| |p| - |LSAGG-;sorted?;MAB;15|) - (QREFELT $ 17)) - |LSAGG-;sorted?;MAB;15|))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT 'T))))) - #0# (EXIT #0#))))) - -(DEFUN |LSAGG-;reduce;MA2S;16| (|f| |x| |i| $) - (PROG (|r|) - (RETURN - (SEQ (LETT |r| |i| |LSAGG-;reduce;MA2S;16|) - (SEQ G190 - (COND - ((NULL (SPADCALL (SPADCALL |x| (QREFELT $ 16)) - (QREFELT $ 25))) - (GO G191))) - (SEQ (LETT |r| - (SPADCALL |r| (SPADCALL |x| (QREFELT $ 18)) - |f|) - |LSAGG-;reduce;MA2S;16|) - (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;reduce;MA2S;16|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |r|))))) - -(DEFUN |LSAGG-;reduce;MA3S;17| (|f| |x| |i| |a| $) - (PROG (|r|) - (RETURN - (SEQ (LETT |r| |i| |LSAGG-;reduce;MA3S;17|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 16)) 'NIL) - ('T - (SPADCALL (SPADCALL |r| |a| (QREFELT $ 52)) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (LETT |r| - (SPADCALL |r| (SPADCALL |x| (QREFELT $ 18)) - |f|) - |LSAGG-;reduce;MA3S;17|) - (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;reduce;MA3S;17|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |r|))))) - -(DEFUN |LSAGG-;new;NniSA;18| (|n| |s| $) - (PROG (|k| |l|) - (RETURN - (SEQ (LETT |l| (SPADCALL (QREFELT $ 12)) |LSAGG-;new;NniSA;18|) - (SEQ (LETT |k| 1 |LSAGG-;new;NniSA;18|) G190 - (COND ((QSGREATERP |k| |n|) (GO G191))) - (SEQ (EXIT (LETT |l| (SPADCALL |s| |l| (QREFELT $ 13)) - |LSAGG-;new;NniSA;18|))) - (LETT |k| (QSADD1 |k|) |LSAGG-;new;NniSA;18|) (GO G190) - G191 (EXIT NIL)) - (EXIT |l|))))) - -(DEFUN |LSAGG-;map;M3A;19| (|f| |x| |y| $) - (PROG (|z|) - (RETURN - (SEQ (LETT |z| (SPADCALL (QREFELT $ 12)) |LSAGG-;map;M3A;19|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 16)) 'NIL) - ('T - (SPADCALL (SPADCALL |y| (QREFELT $ 16)) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (LETT |z| - (SPADCALL - (SPADCALL (SPADCALL |x| (QREFELT $ 18)) - (SPADCALL |y| (QREFELT $ 18)) |f|) - |z| (QREFELT $ 13)) - |LSAGG-;map;M3A;19|) - (LETT |x| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;map;M3A;19|) - (EXIT (LETT |y| (SPADCALL |y| (QREFELT $ 17)) - |LSAGG-;map;M3A;19|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |z| (QREFELT $ 48))))))) - -(DEFUN |LSAGG-;reverse!;2A;20| (|x| $) - (PROG (|z| |y|) - (RETURN - (SEQ (COND - ((OR (SPADCALL |x| (QREFELT $ 16)) - (SPADCALL - (LETT |y| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;reverse!;2A;20|) - (QREFELT $ 16))) - |x|) - ('T - (SEQ (SPADCALL |x| (SPADCALL (QREFELT $ 12)) - (QREFELT $ 26)) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL |y| (QREFELT $ 16)) - (QREFELT $ 25))) - (GO G191))) - (SEQ (LETT |z| (SPADCALL |y| (QREFELT $ 17)) - |LSAGG-;reverse!;2A;20|) - (SPADCALL |y| |x| (QREFELT $ 26)) - (LETT |x| |y| |LSAGG-;reverse!;2A;20|) - (EXIT (LETT |y| |z| - |LSAGG-;reverse!;2A;20|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |x|)))))))) - -(DEFUN |LSAGG-;copy;2A;21| (|x| $) - (PROG (|k| |y|) - (RETURN - (SEQ (LETT |y| (SPADCALL (QREFELT $ 12)) |LSAGG-;copy;2A;21|) - (SEQ (LETT |k| 0 |LSAGG-;copy;2A;21|) G190 - (COND - ((NULL (SPADCALL (SPADCALL |x| (QREFELT $ 16)) - (QREFELT $ 25))) - (GO G191))) - (SEQ (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |x| (QREFELT $ 57)) - (EXIT (|error| "cyclic list")))))) - (LETT |y| - (SPADCALL (SPADCALL |x| (QREFELT $ 18)) |y| - (QREFELT $ 13)) - |LSAGG-;copy;2A;21|) - (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;copy;2A;21|))) - (LETT |k| (QSADD1 |k|) |LSAGG-;copy;2A;21|) (GO G190) - G191 (EXIT NIL)) - (EXIT (SPADCALL |y| (QREFELT $ 48))))))) - -(DEFUN |LSAGG-;copyInto!;2AIA;22| (|y| |x| |s| $) - (PROG (|m| #0=#:G1545 |z|) - (RETURN - (SEQ (LETT |m| (SPADCALL |y| (QREFELT $ 32)) - |LSAGG-;copyInto!;2AIA;22|) - (EXIT (COND - ((< |s| |m|) (|error| "index out of range")) - ('T - (SEQ (LETT |z| - (SPADCALL |y| - (PROG1 - (LETT #0# (- |s| |m|) - |LSAGG-;copyInto!;2AIA;22|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 33)) - |LSAGG-;copyInto!;2AIA;22|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |z| (QREFELT $ 16)) - 'NIL) - ('T - (SPADCALL - (SPADCALL |x| - (QREFELT $ 16)) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (SPADCALL |z| - (SPADCALL |x| (QREFELT $ 18)) - (QREFELT $ 59)) - (LETT |x| - (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;copyInto!;2AIA;22|) - (EXIT - (LETT |z| - (SPADCALL |z| (QREFELT $ 17)) - |LSAGG-;copyInto!;2AIA;22|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |y|))))))))) - -(DEFUN |LSAGG-;position;SA2I;23| (|w| |x| |s| $) - (PROG (|m| #0=#:G1552 |k|) - (RETURN - (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 32)) - |LSAGG-;position;SA2I;23|) - (EXIT (COND - ((< |s| |m|) (|error| "index out of range")) - ('T - (SEQ (LETT |x| - (SPADCALL |x| - (PROG1 - (LETT #0# (- |s| |m|) - |LSAGG-;position;SA2I;23|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 33)) - |LSAGG-;position;SA2I;23|) - (SEQ (LETT |k| |s| |LSAGG-;position;SA2I;23|) - G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 16)) - 'NIL) - ('T - (SPADCALL - (SPADCALL |w| - (SPADCALL |x| - (QREFELT $ 18)) - (QREFELT $ 52)) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (EXIT - (LETT |x| - (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;position;SA2I;23|))) - (LETT |k| (+ |k| 1) - |LSAGG-;position;SA2I;23|) - (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 16)) - (- (SPADCALL |x| (QREFELT $ 32)) 1)) - ('T |k|))))))))))) - -(DEFUN |LSAGG-;removeDuplicates!;2A;24| (|l| $) - (PROG (|p|) - (RETURN - (SEQ (LETT |p| |l| |LSAGG-;removeDuplicates!;2A;24|) - (SEQ G190 - (COND - ((NULL (SPADCALL (SPADCALL |p| (QREFELT $ 16)) - (QREFELT $ 25))) - (GO G191))) - (SEQ (EXIT (LETT |p| - (SPADCALL |p| - (SPADCALL - (CONS - #'|LSAGG-;removeDuplicates!;2A;24!0| - (VECTOR $ |p|)) - (SPADCALL |p| (QREFELT $ 17)) - (QREFELT $ 62)) - (QREFELT $ 26)) - |LSAGG-;removeDuplicates!;2A;24|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |l|))))) - -(DEFUN |LSAGG-;removeDuplicates!;2A;24!0| (|#1| $$) - (PROG ($) - (LETT $ (QREFELT $$ 0) |LSAGG-;removeDuplicates!;2A;24|) - (RETURN - (PROGN - (SPADCALL |#1| (SPADCALL (QREFELT $$ 1) (QREFELT $ 18)) - (QREFELT $ 52)))))) - -(DEFUN |LSAGG-;<;2AB;25| (|x| |y| $) - (PROG (#0=#:G1566) - (RETURN - (SEQ (EXIT (SEQ (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 16)) - 'NIL) - ('T - (SPADCALL - (SPADCALL |y| (QREFELT $ 16)) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (EXIT (COND - ((NULL - (SPADCALL - (SPADCALL |x| - (QREFELT $ 18)) - (SPADCALL |y| - (QREFELT $ 18)) - (QREFELT $ 52))) - (PROGN - (LETT #0# - (SPADCALL - (SPADCALL |x| - (QREFELT $ 18)) - (SPADCALL |y| - (QREFELT $ 18)) - (QREFELT $ 64)) - |LSAGG-;<;2AB;25|) - (GO #0#))) - ('T - (SEQ - (LETT |x| - (SPADCALL |x| - (QREFELT $ 17)) - |LSAGG-;<;2AB;25|) - (EXIT - (LETT |y| - (SPADCALL |y| - (QREFELT $ 17)) - |LSAGG-;<;2AB;25|))))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 16)) - (SPADCALL (SPADCALL |y| (QREFELT $ 16)) - (QREFELT $ 25))) - ('T 'NIL))))) - #0# (EXIT #0#))))) - -(DEFUN |ListAggregate&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|ListAggregate&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| (LIST '|ListAggregate&| |dv$1| |dv$2|) . #0#) - (LETT $ (GETREFV 67) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (QSETREFV $ 7 |#2|) - (COND - ((|HasCategory| |#2| '(|SetCategory|)) - (QSETREFV $ 53 - (CONS (|dispatchFunction| |LSAGG-;reduce;MA3S;17|) $)))) - (COND - ((|HasCategory| |#2| '(|SetCategory|)) - (PROGN - (QSETREFV $ 61 - (CONS (|dispatchFunction| |LSAGG-;position;SA2I;23|) - $)) - (QSETREFV $ 63 - (CONS (|dispatchFunction| - |LSAGG-;removeDuplicates!;2A;24|) - $))))) - (COND - ((|HasCategory| |#2| '(|OrderedSet|)) - (QSETREFV $ 65 - (CONS (|dispatchFunction| |LSAGG-;<;2AB;25|) $)))) - $)))) - -(MAKEPROP '|ListAggregate&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|NonNegativeInteger|) (0 . |#|) (|Mapping| 15 7 7) - |LSAGG-;sort!;M2A;1| (5 . |empty|) (9 . |concat|) - |LSAGG-;list;SA;2| (|Boolean|) (15 . |empty?|) - (20 . |rest|) (25 . |first|) (|Mapping| 7 7 7) - (30 . |reduce|) |LSAGG-;reduce;MAS;3| (37 . |copy|) - (42 . |merge!|) |LSAGG-;merge;M3A;4| (49 . |not|) - (54 . |setrest!|) (|Mapping| 15 7) |LSAGG-;select!;M2A;5| - (60 . |eq?|) |LSAGG-;merge!;M3A;6| (|Integer|) - (66 . |minIndex|) (71 . |rest|) |LSAGG-;insert!;SAIA;7| - (77 . |concat!|) |LSAGG-;insert!;2AIA;8| - |LSAGG-;remove!;M2A;9| |LSAGG-;delete!;AIA;10| - (|UniversalSegment| 31) (83 . |lo|) (88 . |hasHi|) - (93 . |hi|) (98 . |maxIndex|) |LSAGG-;delete!;AUsA;11| - (|Union| 7 '"failed") |LSAGG-;find;MAU;12| - |LSAGG-;position;MAI;13| (103 . |reverse!|) - (108 . |split!|) |LSAGG-;sorted?;MAB;15| - |LSAGG-;reduce;MA2S;16| (114 . =) (120 . |reduce|) - |LSAGG-;new;NniSA;18| |LSAGG-;map;M3A;19| - |LSAGG-;reverse!;2A;20| (128 . |cyclic?|) - |LSAGG-;copy;2A;21| (133 . |setfirst!|) - |LSAGG-;copyInto!;2AIA;22| (139 . |position|) - (146 . |remove!|) (152 . |removeDuplicates!|) (157 . <) - (163 . <) (|Mapping| 7 7)) - '#(|sorted?| 169 |sort!| 175 |select!| 181 |reverse!| 187 - |removeDuplicates!| 192 |remove!| 197 |reduce| 203 - |position| 224 |new| 237 |merge!| 243 |merge| 250 |map| - 257 |list| 264 |insert!| 269 |find| 283 |delete!| 289 - |copyInto!| 301 |copy| 308 < 313) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 65 - '(1 6 8 0 9 0 6 0 12 2 6 0 7 0 13 1 6 - 15 0 16 1 6 0 0 17 1 6 7 0 18 3 6 7 - 19 0 7 20 1 6 0 0 22 3 6 0 10 0 0 23 - 1 15 0 0 25 2 6 0 0 0 26 2 6 15 0 0 - 29 1 6 31 0 32 2 6 0 0 8 33 2 6 0 0 0 - 35 1 39 31 0 40 1 39 15 0 41 1 39 31 - 0 42 1 6 31 0 43 1 6 0 0 48 2 6 0 0 - 31 49 2 7 15 0 0 52 4 0 7 19 0 7 7 53 - 1 6 15 0 57 2 6 7 0 7 59 3 0 31 7 0 - 31 61 2 6 0 27 0 62 1 0 0 0 63 2 7 15 - 0 0 64 2 0 15 0 0 65 2 0 15 10 0 50 2 - 0 0 10 0 11 2 0 0 27 0 28 1 0 0 0 56 - 1 0 0 0 63 2 0 0 27 0 37 3 0 7 19 0 7 - 51 4 0 7 19 0 7 7 53 2 0 7 19 0 21 2 - 0 31 27 0 47 3 0 31 7 0 31 61 2 0 0 8 - 7 54 3 0 0 10 0 0 30 3 0 0 10 0 0 24 - 3 0 0 19 0 0 55 1 0 0 7 14 3 0 0 7 0 - 31 34 3 0 0 0 0 31 36 2 0 45 27 0 46 - 2 0 0 0 39 44 2 0 0 0 31 38 3 0 0 0 0 - 31 60 1 0 0 0 58 2 0 15 0 0 65))))) - '|lookupComplete|)) -@ + \section{category ALAGG AssociationListAggregate} <<category ALAGG AssociationListAggregate>>= )abbrev category ALAGG AssociationListAggregate @@ -5594,72 +2407,7 @@ AssociationListAggregate(Key:SetCategory,Entry:SetCategory): Category == ++ with key k, or "failed" if u has no key k. @ -\section{ALAGG.lsp BOOTSTRAP} -{\bf ALAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ALAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ALAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<ALAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |AssociationListAggregate;CAT| 'NIL) - -(DEFPARAMETER |AssociationListAggregate;AL| 'NIL) - -(DEFUN |AssociationListAggregate| (&REST #0=#:G1397 &AUX #1=#:G1395) - (DSETQ #1# #0#) - (LET (#2=#:G1396) - (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#)))) - -(DEFUN |AssociationListAggregate;| (|t#1| |t#2|) - (PROG (#0=#:G1394) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(|t#1| |t#2|) - (LIST (|devaluate| |t#1|) - (|devaluate| |t#2|))) - (|sublisV| - (PAIR '(#1=#:G1393) - (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| - ((|Union| - (|Record| (|:| |key| |t#1|) - (|:| |entry| |t#2|)) - "failed") - |t#1| $)) - T)) - NIL 'NIL NIL)) - . #2=(|AssociationListAggregate|)))))) . #2#) - (SETELT #0# 0 - (LIST '|AssociationListAggregate| (|devaluate| |t#1|) - (|devaluate| |t#2|))))))) -@ + \section{category SRAGG StringAggregate} <<category SRAGG StringAggregate>>= )abbrev category SRAGG StringAggregate diff --git a/src/algebra/array1.spad.pamphlet b/src/algebra/array1.spad.pamphlet index f5591e0b..74039ad1 100644 --- a/src/algebra/array1.spad.pamphlet +++ b/src/algebra/array1.spad.pamphlet @@ -46,211 +46,6 @@ PrimitiveArray(S:Type): OneDimensionalArrayAggregate S == add @ -\section{PRIMARR.lsp BOOTSTRAP} -{\bf PRIMARR} depends on itself. -We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf PRIMARR} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf PRIMARR.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<PRIMARR.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(PUT '|PRIMARR;#;$Nni;1| '|SPADreplace| '|sizeOfSimpleArray|) - -(DEFUN |PRIMARR;#;$Nni;1| (|x| $) (|sizeOfSimpleArray| |x|)) - -(PUT '|PRIMARR;minIndex;$I;2| '|SPADreplace| '(XLAM (|x|) 0)) - -(DEFUN |PRIMARR;minIndex;$I;2| (|x| $) 0) - -(DEFUN |PRIMARR;empty;$;3| ($) - (|makeSimpleArray| (|getVMType| (|getShellEntry| $ 6)) 0)) - -(DEFUN |PRIMARR;new;NniS$;4| (|n| |x| $) - (|makeFilledSimpleArray| (|getVMType| (|getShellEntry| $ 6)) |n| |x|)) - -(PUT '|PRIMARR;qelt;$IS;5| '|SPADreplace| '|getSimpleArrayEntry|) - -(DEFUN |PRIMARR;qelt;$IS;5| (|x| |i| $) - (|getSimpleArrayEntry| |x| |i|)) - -(PUT '|PRIMARR;elt;$IS;6| '|SPADreplace| '|getSimpleArrayEntry|) - -(DEFUN |PRIMARR;elt;$IS;6| (|x| |i| $) - (|getSimpleArrayEntry| |x| |i|)) - -(PUT '|PRIMARR;qsetelt!;$I2S;7| '|SPADreplace| '|setSimpleArrayEntry|) - -(DEFUN |PRIMARR;qsetelt!;$I2S;7| (|x| |i| |s| $) - (|setSimpleArrayEntry| |x| |i| |s|)) - -(PUT '|PRIMARR;setelt;$I2S;8| '|SPADreplace| '|setSimpleArrayEntry|) - -(DEFUN |PRIMARR;setelt;$I2S;8| (|x| |i| |s| $) - (|setSimpleArrayEntry| |x| |i| |s|)) - -(DEFUN |PRIMARR;fill!;$S$;9| (|x| |s| $) - (PROG (|i| #0=#:G1403) - (RETURN - (SEQ (SEQ (LETT |i| 0 |PRIMARR;fill!;$S$;9|) - (LETT #0# (|maxIndexOfSimpleArray| |x|) - |PRIMARR;fill!;$S$;9|) - G190 (COND ((QSGREATERP |i| #0#) (GO G191))) - (SEQ (EXIT (|setSimpleArrayEntry| |x| |i| |s|))) - (LETT |i| (QSADD1 |i|) |PRIMARR;fill!;$S$;9|) (GO G190) - G191 (EXIT NIL)) - (EXIT |x|))))) - -(DEFUN |PrimitiveArray| (#0=#:G1411) - (PROG () - (RETURN - (PROG (#1=#:G1412) - (RETURN - (COND - ((LETT #1# - (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) - (HGET |$ConstructorCache| '|PrimitiveArray|) - '|domainEqualList|) - |PrimitiveArray|) - (|CDRwithIncrement| #1#)) - ('T - (UNWIND-PROTECT - (PROG1 (|PrimitiveArray;| #0#) - (LETT #1# T |PrimitiveArray|)) - (COND - ((NOT #1#) - (HREM |$ConstructorCache| '|PrimitiveArray|))))))))))) - -(DEFUN |PrimitiveArray;| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|PrimitiveArray|)) - (LETT |dv$| (LIST '|PrimitiveArray| |dv$1|) . #0#) - (LETT $ (|newShell| 35) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (OR (AND (|HasCategory| |#1| - '(|OrderedSet|)) - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|)))) - (AND (|HasCategory| |#1| - '(|SetCategory|)) - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|))))) - (OR (AND (|HasCategory| |#1| - '(|SetCategory|)) - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|)))) - (|HasCategory| |#1| - '(|CoercibleTo| (|OutputForm|)))) - (|HasCategory| |#1| - '(|ConvertibleTo| (|InputForm|))) - (OR (|HasCategory| |#1| '(|OrderedSet|)) - (|HasCategory| |#1| '(|SetCategory|))) - (|HasCategory| |#1| '(|OrderedSet|)) - (|HasCategory| (|Integer|) '(|OrderedSet|)) - (|HasCategory| |#1| '(|SetCategory|)) - (AND (|HasCategory| |#1| '(|SetCategory|)) - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|)))) - (|HasCategory| |#1| - '(|CoercibleTo| (|OutputForm|))))) . #0#)) - (|haddProp| |$ConstructorCache| '|PrimitiveArray| (LIST |dv$1|) - (CONS 1 $)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 |#1|) - $)))) - -(MAKEPROP '|PrimitiveArray| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) - (|NonNegativeInteger|) |PRIMARR;#;$Nni;1| (|Integer|) - |PRIMARR;minIndex;$I;2| |PRIMARR;empty;$;3| - |PRIMARR;new;NniS$;4| |PRIMARR;qelt;$IS;5| - |PRIMARR;elt;$IS;6| |PRIMARR;qsetelt!;$I2S;7| - |PRIMARR;setelt;$I2S;8| |PRIMARR;fill!;$S$;9| - (|Mapping| 6 6 6) (|Boolean|) (|List| 6) (|Equation| 6) - (|List| 21) (|Mapping| 19 6) (|Mapping| 19 6 6) - (|UniversalSegment| 9) (|Void|) (|Mapping| 6 6) - (|OutputForm|) (|InputForm|) (|String|) (|SingleInteger|) - (|List| $) (|Union| 6 '"failed") (|List| 9)) - '#(~= 0 |swap!| 6 |sorted?| 13 |sort!| 24 |sort| 35 |size?| - 46 |setelt| 52 |select| 66 |sample| 72 |reverse!| 76 - |reverse| 81 |removeDuplicates| 86 |remove| 91 |reduce| - 103 |qsetelt!| 124 |qelt| 131 |position| 137 |parts| 156 - |new| 161 |more?| 167 |minIndex| 173 |min| 178 |merge| 184 - |members| 197 |member?| 202 |maxIndex| 208 |max| 213 - |map!| 219 |map| 225 |less?| 238 |latex| 244 |insert| 249 - |indices| 263 |index?| 268 |hash| 274 |first| 279 |find| - 284 |fill!| 290 |every?| 296 |eval| 302 |eq?| 328 |entry?| - 334 |entries| 340 |empty?| 345 |empty| 350 |elt| 354 - |delete| 373 |count| 385 |copyInto!| 397 |copy| 404 - |convert| 409 |construct| 414 |concat| 419 |coerce| 442 - |any?| 447 >= 453 > 459 = 465 <= 471 < 477 |#| 483) - '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) - (CONS (|makeByteWordVec2| 5 - '(0 0 0 0 0 0 5 0 0 1 4 0 0 1 2 3 4)) - (CONS '#(|OneDimensionalArrayAggregate&| - |FiniteLinearAggregate&| |LinearAggregate&| - |IndexedAggregate&| |Collection&| - |HomogeneousAggregate&| |OrderedSet&| - |Aggregate&| |EltableAggregate&| |Evalable&| - |SetCategory&| NIL NIL |InnerEvalable&| NIL - NIL |BasicType&|) - (CONS '#((|OneDimensionalArrayAggregate| 6) - (|FiniteLinearAggregate| 6) - (|LinearAggregate| 6) - (|IndexedAggregate| 9 6) - (|Collection| 6) - (|HomogeneousAggregate| 6) - (|OrderedSet|) (|Aggregate|) - (|EltableAggregate| 9 6) (|Evalable| 6) - (|SetCategory|) (|Type|) (|Eltable| 9 6) - (|InnerEvalable| 6 6) (|CoercibleTo| 28) - (|ConvertibleTo| 29) (|BasicType|)) - (|makeByteWordVec2| 34 - '(2 7 19 0 0 1 3 0 26 0 9 9 1 1 5 19 0 - 1 2 0 19 24 0 1 1 5 0 0 1 2 0 0 24 0 - 1 1 5 0 0 1 2 0 0 24 0 1 2 0 19 0 7 1 - 3 0 6 0 25 6 1 3 0 6 0 9 6 16 2 0 0 - 23 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 - 7 0 0 1 2 7 0 6 0 1 2 0 0 23 0 1 4 7 - 6 18 0 6 6 1 3 0 6 18 0 6 1 2 0 6 18 - 0 1 3 0 6 0 9 6 15 2 0 6 0 9 13 2 7 9 - 6 0 1 3 7 9 6 0 9 1 2 0 9 23 0 1 1 0 - 20 0 1 2 0 0 7 6 12 2 0 19 0 7 1 1 6 - 9 0 10 2 5 0 0 0 1 2 5 0 0 0 1 3 0 0 - 24 0 0 1 1 0 20 0 1 2 7 19 6 0 1 1 6 - 9 0 1 2 5 0 0 0 1 2 0 0 27 0 1 3 0 0 - 18 0 0 1 2 0 0 27 0 1 2 0 19 0 7 1 1 - 7 30 0 1 3 0 0 0 0 9 1 3 0 0 6 0 9 1 - 1 0 34 0 1 2 0 19 9 0 1 1 7 31 0 1 1 - 6 6 0 1 2 0 33 23 0 1 2 0 0 0 6 17 2 - 0 19 23 0 1 3 8 0 0 20 20 1 2 8 0 0 - 21 1 3 8 0 0 6 6 1 2 8 0 0 22 1 2 0 - 19 0 0 1 2 7 19 6 0 1 1 0 20 0 1 1 0 - 19 0 1 0 0 0 11 2 0 0 0 25 1 2 0 6 0 - 9 14 3 0 6 0 9 6 1 2 0 0 0 9 1 2 0 0 - 0 25 1 2 7 7 6 0 1 2 0 7 23 0 1 3 0 0 - 0 0 9 1 1 0 0 0 1 1 3 29 0 1 1 0 0 20 - 1 1 0 0 32 1 2 0 0 6 0 1 2 0 0 0 0 1 - 2 0 0 0 6 1 1 9 28 0 1 2 0 19 23 0 1 - 2 5 19 0 0 1 2 5 19 0 0 1 2 7 19 0 0 - 1 2 5 19 0 0 1 2 5 19 0 0 1 1 0 7 0 - 8))))) - '|lookupComplete|)) -@ \section{package PRIMARR2 PrimitiveArrayFunctions2} diff --git a/src/algebra/boolean.spad.pamphlet b/src/algebra/boolean.spad.pamphlet index 5ebd188d..11a8dd35 100644 --- a/src/algebra/boolean.spad.pamphlet +++ b/src/algebra/boolean.spad.pamphlet @@ -323,110 +323,6 @@ Reference(S:Type): Type with prefix(message("ref"@String), [p.value::OutputForm]) @ -\section{REF.lsp BOOTSTRAP} -{\bf REF} depends on a chain of -files. We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf REF} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf REF.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<REF.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(PUT '|REF;=;2$B;1| '|SPADreplace| 'EQ) - -(DEFUN |REF;=;2$B;1| (|p| |q| $) (EQ |p| |q|)) - -(PUT '|REF;ref;S$;2| '|SPADreplace| 'LIST) - -(DEFUN |REF;ref;S$;2| (|v| $) (LIST |v|)) - -(PUT '|REF;elt;$S;3| '|SPADreplace| 'QCAR) - -(DEFUN |REF;elt;$S;3| (|p| $) (QCAR |p|)) - -(DEFUN |REF;setelt;$2S;4| (|p| |v| $) - (PROGN (RPLACA |p| |v|) (QCAR |p|))) - -(PUT '|REF;deref;$S;5| '|SPADreplace| 'QCAR) - -(DEFUN |REF;deref;$S;5| (|p| $) (QCAR |p|)) - -(DEFUN |REF;setref;$2S;6| (|p| |v| $) - (PROGN (RPLACA |p| |v|) (QCAR |p|))) - -(DEFUN |REF;coerce;$Of;7| (|p| $) - (SPADCALL (SPADCALL "ref" (|getShellEntry| $ 17)) - (LIST (SPADCALL (QCAR |p|) (|getShellEntry| $ 18))) - (|getShellEntry| $ 20))) - -(DEFUN |Reference| (#0=#:G1401) - (PROG () - (RETURN - (PROG (#1=#:G1402) - (RETURN - (COND - ((LETT #1# - (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) - (HGET |$ConstructorCache| '|Reference|) - '|domainEqualList|) - |Reference|) - (|CDRwithIncrement| #1#)) - ('T - (UNWIND-PROTECT - (PROG1 (|Reference;| #0#) (LETT #1# T |Reference|)) - (COND - ((NOT #1#) (HREM |$ConstructorCache| '|Reference|))))))))))) - -(DEFUN |Reference;| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|Reference|)) - (LETT |dv$| (LIST '|Reference| |dv$1|) . #0#) - (LETT $ (|newShell| 23) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasCategory| |#1| '(|SetCategory|)))) . #0#)) - (|haddProp| |$ConstructorCache| '|Reference| (LIST |dv$1|) - (CONS 1 $)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 |#1|) - (|setShellEntry| $ 7 (|Record| (|:| |value| |#1|))) - (COND - ((|testBitVector| |pv$| 1) - (|setShellEntry| $ 21 - (CONS (|dispatchFunction| |REF;coerce;$Of;7|) $)))) - $)))) - -(MAKEPROP '|Reference| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) '|Rep| (|Boolean|) - |REF;=;2$B;1| |REF;ref;S$;2| |REF;elt;$S;3| - |REF;setelt;$2S;4| |REF;deref;$S;5| |REF;setref;$2S;6| - (|String|) (|OutputForm|) (0 . |message|) (5 . |coerce|) - (|List| $) (10 . |prefix|) (16 . |coerce|) - (|SingleInteger|)) - '#(~= 21 |setref| 27 |setelt| 33 |ref| 39 |latex| 44 |hash| - 49 |elt| 54 |deref| 59 |coerce| 64 = 69) - 'NIL - (CONS (|makeByteWordVec2| 1 '(1 0 1 1)) - (CONS '#(|SetCategory&| NIL |BasicType&| NIL) - (CONS '#((|SetCategory|) (|Type|) (|BasicType|) - (|CoercibleTo| 16)) - (|makeByteWordVec2| 22 - '(1 16 0 15 17 1 6 16 0 18 2 16 0 0 19 - 20 1 0 16 0 21 2 1 8 0 0 1 2 0 6 0 6 - 14 2 0 6 0 6 12 1 0 0 6 10 1 1 15 0 1 - 1 1 22 0 1 1 0 6 0 11 1 0 6 0 13 1 1 - 16 0 21 2 0 8 0 0 9))))) - '|lookupComplete|)) -@ \section{category LOGIC Logic} @@ -526,174 +422,7 @@ Boolean(): Join(OrderedSet, Finite, Logic, PropositionalLogic, ConvertibleTo Inp message "false" @ -\section{BOOLEAN.lsp} -{\bf BOOLEAN} depends on -{\bf ORDSET} which depends on -{\bf SETCAT} which depends on -{\bf BASTYPE} which depends on -{\bf BOOLEAN}. We need to break this cycle to build the algebra. -So we keep a cached copy of the translated BOOLEAN domain which -we can write into the {\bf MID} directory. We compile the lisp -code and copy the {\bf BOOLEAN.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. -<<BOOLEAN.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(PUT '|BOOLEAN;test;2$;1| '|SPADreplace| '(XLAM (|a|) |a|)) - -(DEFUN |BOOLEAN;test;2$;1| (|a| $) |a|) - -(DEFUN |BOOLEAN;nt| (|b| $) (COND (|b| 'NIL) ('T 'T))) - -(PUT '|BOOLEAN;true;$;3| '|SPADreplace| '(XLAM NIL 'T)) - -(DEFUN |BOOLEAN;true;$;3| ($) 'T) - -(PUT '|BOOLEAN;false;$;4| '|SPADreplace| '(XLAM NIL NIL)) -(DEFUN |BOOLEAN;false;$;4| ($) NIL) - -(DEFUN |BOOLEAN;not;2$;5| (|b| $) (COND (|b| 'NIL) ('T 'T))) - -(DEFUN |BOOLEAN;^;2$;6| (|b| $) (COND (|b| 'NIL) ('T 'T))) - -(DEFUN |BOOLEAN;~;2$;7| (|b| $) (COND (|b| 'NIL) ('T 'T))) - -(DEFUN |BOOLEAN;and;3$;8| (|a| |b| $) (COND (|a| |b|) ('T 'NIL))) - -(DEFUN |BOOLEAN;/\\;3$;9| (|a| |b| $) (COND (|a| |b|) ('T 'NIL))) - -(DEFUN |BOOLEAN;or;3$;10| (|a| |b| $) (COND (|a| 'T) ('T |b|))) - -(DEFUN |BOOLEAN;\\/;3$;11| (|a| |b| $) (COND (|a| 'T) ('T |b|))) - -(DEFUN |BOOLEAN;xor;3$;12| (|a| |b| $) - (COND (|a| (|BOOLEAN;nt| |b| $)) ('T |b|))) - -(DEFUN |BOOLEAN;nor;3$;13| (|a| |b| $) - (COND (|a| 'NIL) ('T (|BOOLEAN;nt| |b| $)))) - -(DEFUN |BOOLEAN;nand;3$;14| (|a| |b| $) - (COND (|a| (|BOOLEAN;nt| |b| $)) ('T 'T))) - -(PUT '|BOOLEAN;=;2$B;15| '|SPADreplace| 'EQ) - -(DEFUN |BOOLEAN;=;2$B;15| (|a| |b| $) (EQ |a| |b|)) - -(DEFUN |BOOLEAN;implies;3$;16| (|a| |b| $) (COND (|a| |b|) ('T 'T))) - -(PUT '|BOOLEAN;equiv;3$;17| '|SPADreplace| 'EQ) - -(DEFUN |BOOLEAN;equiv;3$;17| (|a| |b| $) (EQ |a| |b|)) - -(DEFUN |BOOLEAN;<;2$B;18| (|a| |b| $) - (COND (|b| (|BOOLEAN;nt| |a| $)) ('T 'NIL))) - -(PUT '|BOOLEAN;size;Nni;19| '|SPADreplace| '(XLAM NIL 2)) - -(DEFUN |BOOLEAN;size;Nni;19| ($) 2) - -(DEFUN |BOOLEAN;index;Pi$;20| (|i| $) - (COND ((SPADCALL |i| (|getShellEntry| $ 27)) 'NIL) ('T 'T))) - -(DEFUN |BOOLEAN;lookup;$Pi;21| (|a| $) (COND (|a| 1) ('T 2))) - -(DEFUN |BOOLEAN;random;$;22| ($) - (COND ((SPADCALL (|random|) (|getShellEntry| $ 27)) 'NIL) ('T 'T))) - -(DEFUN |BOOLEAN;convert;$If;23| (|x| $) - (COND - (|x| (SPADCALL (SPADCALL "true" (|getShellEntry| $ 34)) - (|getShellEntry| $ 36))) - ('T - (SPADCALL (SPADCALL "false" (|getShellEntry| $ 34)) - (|getShellEntry| $ 36))))) - -(DEFUN |BOOLEAN;coerce;$Of;24| (|x| $) - (COND - (|x| (SPADCALL "true" (|getShellEntry| $ 39))) - ('T (SPADCALL "false" (|getShellEntry| $ 39))))) - -(DEFUN |Boolean| () - (PROG () - (RETURN - (PROG (#0=#:G1421) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|Boolean|) |Boolean|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Boolean| - (LIST - (CONS NIL (CONS 1 (|Boolean;|)))))) - (LETT #0# T |Boolean|)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|Boolean|))))))))))) - -(DEFUN |Boolean;| () - (PROG (|dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$| '(|Boolean|) . #0=(|Boolean|)) - (LETT $ (|newShell| 42) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|haddProp| |$ConstructorCache| '|Boolean| NIL (CONS 1 $)) - (|stuffDomainSlots| $) - $)))) - -(MAKEPROP '|Boolean| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL |BOOLEAN;test;2$;1| - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |BOOLEAN;true;$;3|) $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |BOOLEAN;false;$;4|) $)) - |BOOLEAN;not;2$;5| |BOOLEAN;^;2$;6| |BOOLEAN;~;2$;7| - |BOOLEAN;and;3$;8| |BOOLEAN;/\\;3$;9| |BOOLEAN;or;3$;10| - |BOOLEAN;\\/;3$;11| |BOOLEAN;xor;3$;12| - |BOOLEAN;nor;3$;13| |BOOLEAN;nand;3$;14| (|Boolean|) - |BOOLEAN;=;2$B;15| |BOOLEAN;implies;3$;16| - |BOOLEAN;equiv;3$;17| |BOOLEAN;<;2$B;18| - (|NonNegativeInteger|) |BOOLEAN;size;Nni;19| (|Integer|) - (0 . |even?|) (|PositiveInteger|) |BOOLEAN;index;Pi$;20| - |BOOLEAN;lookup;$Pi;21| |BOOLEAN;random;$;22| (|String|) - (|Symbol|) (5 . |coerce|) (|InputForm|) (10 . |convert|) - |BOOLEAN;convert;$If;23| (|OutputForm|) (15 . |message|) - |BOOLEAN;coerce;$Of;24| (|SingleInteger|)) - '#(~= 20 ~ 26 |xor| 31 |true| 37 |test| 41 |size| 46 |random| - 50 |or| 54 |not| 60 |nor| 65 |nand| 71 |min| 77 |max| 83 - |lookup| 89 |latex| 94 |index| 99 |implies| 104 |hash| 110 - |false| 115 |equiv| 119 |convert| 125 |coerce| 130 |and| - 135 ^ 141 |\\/| 146 >= 152 > 158 = 164 <= 170 < 176 |/\\| - 182) - 'NIL - (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0 0 0)) - (CONS '#(|OrderedSet&| NIL |Logic&| |SetCategory&| NIL - NIL |BasicType&| NIL) - (CONS '#((|OrderedSet|) (|Finite|) (|Logic|) - (|SetCategory|) (|ConvertibleTo| 35) - (|PropositionalLogic|) (|BasicType|) - (|CoercibleTo| 38)) - (|makeByteWordVec2| 41 - '(1 26 19 0 27 1 33 0 32 34 1 35 0 33 - 36 1 38 0 32 39 2 0 19 0 0 1 1 0 0 0 - 11 2 0 0 0 0 16 0 0 0 7 1 0 0 0 6 0 0 - 24 25 0 0 0 31 2 0 0 0 0 14 1 0 0 0 9 - 2 0 0 0 0 17 2 0 0 0 0 18 2 0 0 0 0 1 - 2 0 0 0 0 1 1 0 28 0 30 1 0 32 0 1 1 - 0 0 28 29 2 0 0 0 0 21 1 0 41 0 1 0 0 - 0 8 2 0 0 0 0 22 1 0 35 0 37 1 0 38 0 - 40 2 0 0 0 0 12 1 0 0 0 10 2 0 0 0 0 - 15 2 0 19 0 0 1 2 0 19 0 0 1 2 0 19 0 - 0 20 2 0 19 0 0 1 2 0 19 0 0 23 2 0 0 - 0 0 13))))) - '|lookupComplete|)) - -(MAKEPROP '|Boolean| 'NILADIC T) -@ \section{domain IBITS IndexedBits} <<domain IBITS IndexedBits>>= )abbrev domain IBITS IndexedBits diff --git a/src/algebra/catdef.spad.pamphlet b/src/algebra/catdef.spad.pamphlet index 75c43cae..628130a2 100644 --- a/src/algebra/catdef.spad.pamphlet +++ b/src/algebra/catdef.spad.pamphlet @@ -48,107 +48,7 @@ AbelianGroup(): Category == CancellationAbelianMonoid with double((-n) pretend PositiveInteger,-x) @ -\section{ABELGRP.lsp BOOTSTRAP} -{\bf ABELGRP} depends on a chain of -files. We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf ABELGRP} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf ABELGRP.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. -Note that this code is not included in the generated catdef.spad file. - -<<ABELGRP.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |AbelianGroup;AL| 'NIL) - -(DEFUN |AbelianGroup| () - (LET (#:G1388) - (COND - (|AbelianGroup;AL|) - (T (SETQ |AbelianGroup;AL| (|AbelianGroup;|)))))) - -(DEFUN |AbelianGroup;| () - (PROG (#0=#:G1386) - (RETURN - (PROG1 (LETT #0# - (|Join| (|CancellationAbelianMonoid|) - (|mkCategory| '|domain| - '(((- ($ $)) T) ((- ($ $ $)) T) - ((* ($ (|Integer|) $)) T)) - NIL '((|Integer|)) NIL)) - |AbelianGroup|) - (SETELT #0# 0 '(|AbelianGroup|)))))) - -(MAKEPROP '|AbelianGroup| 'NILADIC T) -@ -\section{ABELGRP-.lsp BOOTSTRAP} -{\bf ABELGRP-} depends on a chain of files. -We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ABELGRP-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ABELGRP-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<ABELGRP-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |ABELGRP-;-;3S;1| (|x| |y| $) - (SPADCALL |x| (SPADCALL |y| (QREFELT $ 7)) (QREFELT $ 8))) - -(DEFUN |ABELGRP-;subtractIfCan;2SU;2| (|x| |y| $) - (CONS 0 (SPADCALL |x| |y| (QREFELT $ 10)))) - -(DEFUN |ABELGRP-;*;Nni2S;3| (|n| |x| $) - (SPADCALL |n| |x| (QREFELT $ 14))) - -(DEFUN |ABELGRP-;*;I2S;4| (|n| |x| $) - (COND - ((ZEROP |n|) (|spadConstant| $ 17)) - ((< 0 |n|) (SPADCALL |n| |x| (QREFELT $ 20))) - ('T (SPADCALL (- |n|) (SPADCALL |x| (QREFELT $ 7)) (QREFELT $ 20))))) - -(DEFUN |AbelianGroup&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|AbelianGroup&|)) - (LETT |dv$| (LIST '|AbelianGroup&| |dv$1|) . #0#) - (LETT $ (GETREFV 22) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (COND - ((|HasCategory| |#1| '(|Ring|))) - ('T - (QSETREFV $ 21 - (CONS (|dispatchFunction| |ABELGRP-;*;I2S;4|) $)))) - $)))) - -(MAKEPROP '|AbelianGroup&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . -) (5 . +) - |ABELGRP-;-;3S;1| (11 . -) (|Union| $ '"failed") - |ABELGRP-;subtractIfCan;2SU;2| (|Integer|) (17 . *) - (|NonNegativeInteger|) |ABELGRP-;*;Nni2S;3| (23 . |Zero|) - (|PositiveInteger|) (|RepeatedDoubling| 6) (27 . |double|) - (33 . *)) - '#(|subtractIfCan| 39 - 45 * 51) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 21 - '(1 6 0 0 7 2 6 0 0 0 8 2 6 0 0 0 10 2 - 6 0 13 0 14 0 6 0 17 2 19 6 18 6 20 2 - 0 0 13 0 21 2 0 11 0 0 12 2 0 0 0 0 9 - 2 0 0 13 0 21 2 0 0 15 0 16))))) - '|lookupComplete|)) -@ \section{category ABELMON AbelianMonoid} <<category ABELMON AbelianMonoid>>= )abbrev category ABELMON AbelianMonoid @@ -191,131 +91,8 @@ AbelianMonoid(): Category == AbelianSemiGroup with double(n pretend PositiveInteger,x) @ -\section{ABELMON.lsp BOOTSTRAP} -{\bf ABELMON} which needs -{\bf ABELSG} which needs -{\bf SETCAT} which needs -{\bf SINT} which needs -{\bf UFD} which needs -{\bf GCDDOM} which needs -{\bf COMRING} which needs -{\bf RING} which needs -{\bf RNG} which needs -{\bf ABELGRP} which needs -{\bf CABMON} which needs -{\bf ABELMON}. -We break this chain with {\bf ABELMON.lsp} which we -cache here. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ABELMON} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ABELMON.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. -Note that this code is not included in the generated catdef.spad file. -<<ABELMON.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |AbelianMonoid;AL| 'NIL) - -(DEFUN |AbelianMonoid| () - (LET (#:G1388) - (COND - (|AbelianMonoid;AL|) - (T (SETQ |AbelianMonoid;AL| (|AbelianMonoid;|)))))) - -(DEFUN |AbelianMonoid;| () - (PROG (#0=#:G1386) - (RETURN - (PROG1 (LETT #0# - (|Join| (|AbelianSemiGroup|) - (|mkCategory| '|domain| - '(((|Zero| ($) |constant|) T) - ((|sample| ($) |constant|) T) - ((|zero?| ((|Boolean|) $)) T) - ((* ($ (|NonNegativeInteger|) $)) T)) - NIL - '((|NonNegativeInteger|) (|Boolean|)) - NIL)) - |AbelianMonoid|) - (SETELT #0# 0 '(|AbelianMonoid|)))))) - -(MAKEPROP '|AbelianMonoid| 'NILADIC T) -@ -\section{ABELMON-.lsp BOOTSTRAP} -{\bf ABELMON-} which needs -{\bf ABELSG} which needs -{\bf SETCAT} which needs -{\bf SINT} which needs -{\bf UFD} which needs -{\bf GCDDOM} which needs -{\bf COMRING} which needs -{\bf RING} which needs -{\bf RNG} which needs -{\bf ABELGRP} which needs -{\bf CABMON} which needs -{\bf ABELMON-}. -We break this chain with {\bf ABELMON-.lsp} which we -cache here. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ABELMON-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ABELMON-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<ABELMON-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |ABELMON-;zero?;SB;1| (|x| $) - (SPADCALL |x| (|spadConstant| $ 7) (QREFELT $ 9))) - -(DEFUN |ABELMON-;*;Pi2S;2| (|n| |x| $) - (SPADCALL |n| |x| (QREFELT $ 12))) - -(DEFUN |ABELMON-;sample;S;3| ($) (|spadConstant| $ 7)) - -(DEFUN |ABELMON-;*;Nni2S;4| (|n| |x| $) - (COND - ((ZEROP |n|) (|spadConstant| $ 7)) - ('T (SPADCALL |n| |x| (QREFELT $ 17))))) - -(DEFUN |AbelianMonoid&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|AbelianMonoid&|)) - (LETT |dv$| (LIST '|AbelianMonoid&| |dv$1|) . #0#) - (LETT $ (GETREFV 19) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (COND - ((|HasCategory| |#1| '(|Ring|))) - ('T - (QSETREFV $ 18 - (CONS (|dispatchFunction| |ABELMON-;*;Nni2S;4|) $)))) - $)))) - -(MAKEPROP '|AbelianMonoid&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|) - (|Boolean|) (4 . =) |ABELMON-;zero?;SB;1| - (|NonNegativeInteger|) (10 . *) (|PositiveInteger|) - |ABELMON-;*;Pi2S;2| |ABELMON-;sample;S;3| - (|RepeatedDoubling| 6) (16 . |double|) (22 . *)) - '#(|zero?| 28 |sample| 33 * 37) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 18 - '(0 6 0 7 2 6 8 0 0 9 2 6 0 11 0 12 2 - 16 6 13 6 17 2 0 0 11 0 18 1 0 8 0 10 - 0 0 0 15 2 0 0 11 0 18 2 0 0 13 0 14))))) - '|lookupComplete|)) -@ \section{category ABELSG AbelianSemiGroup} <<category ABELSG AbelianSemiGroup>>= )abbrev category ABELSG AbelianSemiGroup @@ -347,113 +124,7 @@ AbelianSemiGroup(): Category == SetCategory with n:PositiveInteger * x:% == double(n,x) @ -\section{ABELSG.lsp BOOTSTRAP} -{\bf ABELSG} needs -{\bf SETCAT} which needs -{\bf SINT} which needs -{\bf UFD} which needs -{\bf GCDDOM} which needs -{\bf COMRING} which needs -{\bf RING} which needs -{\bf RNG} which needs -{\bf ABELGRP} which needs -{\bf CABMON} which needs -{\bf ABELMON} which needs -{\bf ABELSG}. -We break this chain with {\bf ABELSG.lsp} which we -cache here. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ABELSG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ABELSG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. -Note that this code is not included in the generated catdef.spad file. - -<<ABELSG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |AbelianSemiGroup;AL| 'NIL) - -(DEFUN |AbelianSemiGroup| () - (LET (#:G1387) - (COND - (|AbelianSemiGroup;AL|) - (T (SETQ |AbelianSemiGroup;AL| (|AbelianSemiGroup;|)))))) - -(DEFUN |AbelianSemiGroup;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# - (|Join| (|SetCategory|) - (|mkCategory| '|domain| - '(((+ ($ $ $)) T) - ((* ($ (|PositiveInteger|) $)) T)) - NIL '((|PositiveInteger|)) NIL)) - |AbelianSemiGroup|) - (SETELT #0# 0 '(|AbelianSemiGroup|)))))) - -(MAKEPROP '|AbelianSemiGroup| 'NILADIC T) -@ -\section{ABELSG-.lsp BOOTSTRAP} -{\bf ABELSG-} needs -{\bf SETCAT} which needs -{\bf SINT} which needs -{\bf UFD} which needs -{\bf GCDDOM} which needs -{\bf COMRING} which needs -{\bf RING} which needs -{\bf RNG} which needs -{\bf ABELGRP} which needs -{\bf CABMON} which needs -{\bf ABELMON} which needs -{\bf ABELSG-}. -We break this chain with {\bf ABELSG-.lsp} which we -cache here. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ABELSG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ABELSG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<ABELSG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |ABELSG-;*;Pi2S;1| (|n| |x| $) - (SPADCALL |n| |x| (QREFELT $ 9))) - -(DEFUN |AbelianSemiGroup&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|AbelianSemiGroup&|)) - (LETT |dv$| (LIST '|AbelianSemiGroup&| |dv$1|) . #0#) - (LETT $ (GETREFV 11) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (COND - ((|HasCategory| |#1| '(|Ring|))) - ('T - (QSETREFV $ 10 - (CONS (|dispatchFunction| |ABELSG-;*;Pi2S;1|) $)))) - $)))) - -(MAKEPROP '|AbelianSemiGroup&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|PositiveInteger|) - (|RepeatedDoubling| 6) (0 . |double|) (6 . *)) - '#(* 12) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 10 - '(2 8 6 7 6 9 2 0 0 7 0 10 2 0 0 7 0 - 10))))) - '|lookupComplete|)) -@ \section{category ALGEBRA Algebra} <<category ALGEBRA Algebra>>= )abbrev category ALGEBRA Algebra @@ -558,56 +229,7 @@ CancellationAbelianMonoid(): Category == AbelianMonoid with ++ or "failed" if no such element exists. @ -\section{CABMON.lsp BOOTSTRAP} -{\bf CABMON} which needs -{\bf ABELMON} which needs -{\bf ABELSG} which needs -{\bf SETCAT} which needs -{\bf SINT} which needs -{\bf UFD} which needs -{\bf GCDDOM} which needs -{\bf COMRING} which needs -{\bf RING} which needs -{\bf RNG} which needs -{\bf ABELGRP} which needs -{\bf CABMON}. -We break this chain with {\bf CABMON.lsp} which we -cache here. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf CABMON} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf CABMON.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<CABMON.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) -(DEFPARAMETER |CancellationAbelianMonoid;AL| 'NIL) - -(DEFUN |CancellationAbelianMonoid| () - (LET (#:G1387) - (COND - (|CancellationAbelianMonoid;AL|) - (T (SETQ |CancellationAbelianMonoid;AL| - (|CancellationAbelianMonoid;|)))))) - -(DEFUN |CancellationAbelianMonoid;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# - (|Join| (|AbelianMonoid|) - (|mkCategory| '|domain| - '(((|subtractIfCan| - ((|Union| $ "failed") $ $)) - T)) - NIL 'NIL NIL)) - |CancellationAbelianMonoid|) - (SETELT #0# 0 '(|CancellationAbelianMonoid|)))))) - -(MAKEPROP '|CancellationAbelianMonoid| 'NILADIC T) -@ \section{category CHARNZ CharacteristicNonZero} <<category CHARNZ CharacteristicNonZero>>= )abbrev category CHARNZ CharacteristicNonZero @@ -666,39 +288,7 @@ CommutativeRing():Category == Join(Ring,BiModule(%,%)) with commutative("*") ++ multiplication is commutative. @ -\section{COMRING.lsp BOOTSTRAP} -{\bf COMRING} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf COMRING} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf COMRING.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<COMRING.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |CommutativeRing;AL| 'NIL) -(DEFUN |CommutativeRing| () - (LET (#:G1387) - (COND - (|CommutativeRing;AL|) - (T (SETQ |CommutativeRing;AL| (|CommutativeRing;|)))))) - -(DEFUN |CommutativeRing;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# - (|Join| (|Ring|) (|BiModule| '$ '$) - (|mkCategory| '|package| NIL - '(((|commutative| "*") T)) 'NIL NIL)) - |CommutativeRing|) - (SETELT #0# 0 '(|CommutativeRing|)))))) - -(MAKEPROP '|CommutativeRing| 'NILADIC T) -@ \section{category DIFRING DifferentialRing} <<category DIFRING DifferentialRing>>= )abbrev category DIFRING DifferentialRing @@ -740,104 +330,7 @@ DifferentialRing(): Category == Ring with D(r,n) == differentiate(r,n) @ -\section{DIFRING.lsp BOOTSTRAP} -{\bf DIFRING} needs {\bf INT} which needs {\bf DIFRING}. -We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf DIFRING} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf DIFRING.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<DIFRING.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |DifferentialRing;AL| 'NIL) - -(DEFUN |DifferentialRing| () - (LET (#:G1387) - (COND - (|DifferentialRing;AL|) - (T (SETQ |DifferentialRing;AL| (|DifferentialRing;|)))))) - -(DEFUN |DifferentialRing;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# - (|Join| (|Ring|) - (|mkCategory| '|domain| - '(((|differentiate| ($ $)) T) - ((D ($ $)) T) - ((|differentiate| - ($ $ (|NonNegativeInteger|))) - T) - ((D ($ $ (|NonNegativeInteger|))) T)) - NIL '((|NonNegativeInteger|)) NIL)) - |DifferentialRing|) - (SETELT #0# 0 '(|DifferentialRing|)))))) - -(MAKEPROP '|DifferentialRing| 'NILADIC T) -@ -\section{DIFRING-.lsp BOOTSTRAP} -{\bf DIFRING-} needs {\bf DIFRING}. -We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf DIFRING-} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf DIFRING-.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<DIFRING-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |DIFRING-;D;2S;1| (|r| $) (SPADCALL |r| (QREFELT $ 7))) - -(DEFUN |DIFRING-;differentiate;SNniS;2| (|r| |n| $) - (PROG (|i|) - (RETURN - (SEQ (SEQ (LETT |i| 1 |DIFRING-;differentiate;SNniS;2|) G190 - (COND ((QSGREATERP |i| |n|) (GO G191))) - (SEQ (EXIT (LETT |r| (SPADCALL |r| (QREFELT $ 7)) - |DIFRING-;differentiate;SNniS;2|))) - (LETT |i| (QSADD1 |i|) - |DIFRING-;differentiate;SNniS;2|) - (GO G190) G191 (EXIT NIL)) - (EXIT |r|))))) - -(DEFUN |DIFRING-;D;SNniS;3| (|r| |n| $) - (SPADCALL |r| |n| (QREFELT $ 11))) -(DEFUN |DifferentialRing&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|DifferentialRing&|)) - (LETT |dv$| (LIST '|DifferentialRing&| |dv$1|) . #0#) - (LETT $ (GETREFV 13) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) - -(MAKEPROP '|DifferentialRing&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) - (0 . |differentiate|) |DIFRING-;D;2S;1| - (|NonNegativeInteger|) |DIFRING-;differentiate;SNniS;2| - (5 . |differentiate|) |DIFRING-;D;SNniS;3|) - '#(|differentiate| 11 D 17) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 12 - '(1 6 0 0 7 2 6 0 0 9 11 2 0 0 0 9 10 2 - 0 0 0 9 12 1 0 0 0 8))))) - '|lookupComplete|)) -@ \section{category DIFEXT DifferentialExtension} <<category DIFEXT DifferentialExtension>>= )abbrev category DIFEXT DifferentialExtension @@ -933,113 +426,7 @@ DivisionRing(): Category == q:Fraction(Integer) * x:% == numer(q) * inv(denom(q)::%) * x @ -\section{DIVRING.lsp BOOTSTRAP} -{\bf DIVRING} depends on {\bf QFCAT} which eventually depends on -{\bf DIVRING}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf DIVRING} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf DIVRING.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<DIVRING.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |DivisionRing;AL| 'NIL) - -(DEFUN |DivisionRing| () - (LET (#:G1390) - (COND - (|DivisionRing;AL|) - (T (SETQ |DivisionRing;AL| (|DivisionRing;|)))))) - -(DEFUN |DivisionRing;| () - (PROG (#0=#:G1388) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(#1=#:G1387) - (LIST '(|Fraction| (|Integer|)))) - (|Join| (|EntireRing|) (|Algebra| '#1#) - (|mkCategory| '|domain| - '(((** ($ $ (|Integer|))) T) - ((^ ($ $ (|Integer|))) T) - ((|inv| ($ $)) T)) - NIL '((|Integer|)) NIL))) - |DivisionRing|) - (SETELT #0# 0 '(|DivisionRing|)))))) -(MAKEPROP '|DivisionRing| 'NILADIC T) -@ -\section{DIVRING-.lsp BOOTSTRAP} -{\bf DIVRING-} depends on {\bf DIVRING}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf DIVRING-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf DIVRING-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<DIVRING-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |DIVRING-;^;SIS;1| (|x| |n| $) - (SPADCALL |x| |n| (QREFELT $ 8))) - -(DEFUN |DIVRING-;**;SIS;2| (|x| |n| $) - (COND - ((ZEROP |n|) (|spadConstant| $ 10)) - ((SPADCALL |x| (QREFELT $ 12)) - (COND ((< |n| 0) (|error| "division by zero")) ('T |x|))) - ((< |n| 0) - (SPADCALL (SPADCALL |x| (QREFELT $ 14)) (- |n|) (QREFELT $ 17))) - ('T (SPADCALL |x| |n| (QREFELT $ 17))))) - -(DEFUN |DIVRING-;*;F2S;3| (|q| |x| $) - (SPADCALL - (SPADCALL (SPADCALL |q| (QREFELT $ 20)) - (SPADCALL - (SPADCALL (SPADCALL |q| (QREFELT $ 21)) (QREFELT $ 22)) - (QREFELT $ 14)) - (QREFELT $ 23)) - |x| (QREFELT $ 24))) - -(DEFUN |DivisionRing&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|DivisionRing&|)) - (LETT |dv$| (LIST '|DivisionRing&| |dv$1|) . #0#) - (LETT $ (GETREFV 27) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) - -(MAKEPROP '|DivisionRing&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Integer|) - (0 . **) |DIVRING-;^;SIS;1| (6 . |One|) (|Boolean|) - (10 . |zero?|) (15 . |Zero|) (19 . |inv|) - (|PositiveInteger|) (|RepeatedSquaring| 6) (24 . |expt|) - |DIVRING-;**;SIS;2| (|Fraction| 7) (30 . |numer|) - (35 . |denom|) (40 . |coerce|) (45 . *) (51 . *) - |DIVRING-;*;F2S;3| (|NonNegativeInteger|)) - '#(^ 57 ** 63 * 69) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 25 - '(2 6 0 0 7 8 0 6 0 10 1 6 11 0 12 0 6 - 0 13 1 6 0 0 14 2 16 6 6 15 17 1 19 7 - 0 20 1 19 7 0 21 1 6 0 7 22 2 6 0 7 0 - 23 2 6 0 0 0 24 2 0 0 0 7 9 2 0 0 0 7 - 18 2 0 0 19 0 25))))) - '|lookupComplete|)) -@ \section{category ENTIRER EntireRing} <<category ENTIRER EntireRing>>= )abbrev category ENTIRER EntireRing @@ -1065,39 +452,7 @@ EntireRing():Category == Join(Ring,BiModule(%,%)) with ++ must be zero. @ -\section{ENTIRER.lsp BOOTSTRAP} -{\bf ENTIRER} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ENTIRER} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ENTIRER.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<ENTIRER.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |EntireRing;AL| 'NIL) - -(DEFUN |EntireRing| () - (LET (#:G1387) - (COND - (|EntireRing;AL|) - (T (SETQ |EntireRing;AL| (|EntireRing;|)))))) - -(DEFUN |EntireRing;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# - (|Join| (|Ring|) (|BiModule| '$ '$) - (|mkCategory| '|package| NIL - '((|noZeroDivisors| T)) 'NIL NIL)) - |EntireRing|) - (SETELT #0# 0 '(|EntireRing|)))))) -(MAKEPROP '|EntireRing| 'NILADIC T) -@ \section{category EUCDOM EuclideanDomain} <<category EUCDOM EuclideanDomain>>= )abbrev category EUCDOM EuclideanDomain @@ -1250,656 +605,6 @@ EuclideanDomain(): Category == PrincipalIdealDomain with concat(v1,v2) @ -\section{EUCDOM.lsp BOOTSTRAP} -{\bf EUCDOM} depends on {\bf INT} which depends on {\bf EUCDOM}. -We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf EUCDOM} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf EUCDOM.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -\subsection{The Lisp Implementation} -\subsubsection{EUCDOM;VersionCheck} -This implements the bootstrap code for {\bf EuclideanDomain}. -The call to {\bf VERSIONCHECK} is a legacy check to ensure that -we did not load algebra code from a previous system version (which -would not run due to major surgical changes in the system) without -recompiling. -<<EUCDOM;VersionCheck>>= -(|/VERSIONCHECK| 2) - -@ -\subsubsection{The Domain Cache Variable} -We create a variable which is formed by concatenating the string -``{\bf ;AL}'' to the domain name forming, in this case, -``{\bf EuclideanDomain;AL}''. The variable has the initial value -at load time of a list of one element, {\bf NIL}. This list is -a data structure that will be modified to hold an executable -function. This function is created the first time the domain is -used which it replaces the {\bf NIL}. -<<EuclideanDomain;AL>>= -(DEFPARAMETER |EuclideanDomain;AL| (QUOTE NIL)) - -@ -\subsubsection{The Domain Function} -When you call a domain the code is pretty simple at the top -level. This code will check to see if this domain has ever been -used. It does this by checking the value of the cached domain -variable (which is the domain name {\bf EuclideanDomain} concatenated -with the string ``{\bf ;AL}'' to form the cache variable name which -is {\bf EuclideanDomain;AL}). - -If this value is NIL we have never executed this function -before. If it is not NIL we have executed this function before and -we need only return the cached function which was stored in the -cache variable. - -If this is the first time this function is called, the cache -variable is NIL and we execute the other branch of the conditional. -This calls a function which -\begin{enumerate} -\item creates a procedure -\item returns the procedure as a value. -\end{enumerate} -This procedure replaces the cached variable {\bf EuclideanDomain;AL} -value so it will be non-NIL the second time this domain is used. -Thus the work of building the domain only happens once. - -If this function has never been called before we call the -<<EuclideanDomain>>= -(DEFUN |EuclideanDomain| NIL - (LET (#:G83585) - (COND - (|EuclideanDomain;AL|) - (T (SETQ |EuclideanDomain;AL| (|EuclideanDomain;|)))))) - -@ -\subsubsection{The First Call Domain Function} -<<EuclideanDomain;>>= -(DEFUN |EuclideanDomain;| NIL - (PROG (#1=#:G83583) - (RETURN - (PROG1 - (LETT #1# - (|Join| - (|PrincipalIdealDomain|) - (|mkCategory| - (QUOTE |domain|) - (QUOTE ( - ((|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 - (QUOTE ((|List| |$|) (|NonNegativeInteger|) (|Boolean|))) - NIL)) - |EuclideanDomain|) - (SETELT #1# 0 (QUOTE (|EuclideanDomain|))))))) - -@ -\subsubsection{EUCDOM;MAKEPROP} -<<EUCDOM;MAKEPROP>>= -(MAKEPROP (QUOTE |EuclideanDomain|) (QUOTE NILADIC) T) - -@ -<<EUCDOM.lsp BOOTSTRAP>>= -<<EUCDOM;VersionCheck>> -<<EuclideanDomain;AL>> -<<EuclideanDomain>> -<<EuclideanDomain;>> -<<EUCDOM;MAKEPROP>> -@ -\section{EUCDOM-.lsp BOOTSTRAP} -{\bf EUCDOM-} depends on {\bf EUCDOM}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf EUCDOM-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf EUCDOM-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -<<EUCDOM-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |EUCDOM-;sizeLess?;2SB;1| (|x| |y| $) - (COND - ((SPADCALL |y| (|getShellEntry| $ 8)) 'NIL) - ((SPADCALL |x| (|getShellEntry| $ 8)) 'T) - ('T - (< (SPADCALL |x| (|getShellEntry| $ 10)) - (SPADCALL |y| (|getShellEntry| $ 10)))))) - -(DEFUN |EUCDOM-;quo;3S;2| (|x| |y| $) - (QCAR (SPADCALL |x| |y| (|getShellEntry| $ 13)))) - -(DEFUN |EUCDOM-;rem;3S;3| (|x| |y| $) - (QCDR (SPADCALL |x| |y| (|getShellEntry| $ 13)))) - -(DEFUN |EUCDOM-;exquo;2SU;4| (|x| |y| $) - (PROG (|qr|) - (RETURN - (SEQ (COND - ((SPADCALL |y| (|getShellEntry| $ 8)) (CONS 1 "failed")) - ('T - (SEQ (LETT |qr| (SPADCALL |x| |y| (|getShellEntry| $ 13)) - |EUCDOM-;exquo;2SU;4|) - (EXIT (COND - ((SPADCALL (QCDR |qr|) - (|getShellEntry| $ 8)) - (CONS 0 (QCAR |qr|))) - ('T (CONS 1 "failed"))))))))))) - -(DEFUN |EUCDOM-;gcd;3S;5| (|x| |y| $) - (PROG (|#G13| |#G14|) - (RETURN - (SEQ (LETT |x| (SPADCALL |x| (|getShellEntry| $ 18)) - |EUCDOM-;gcd;3S;5|) - (LETT |y| (SPADCALL |y| (|getShellEntry| $ 18)) - |EUCDOM-;gcd;3S;5|) - (SEQ G190 - (COND - ((NULL (SPADCALL (SPADCALL |y| (|getShellEntry| $ 8)) - (|getShellEntry| $ 19))) - (GO G191))) - (SEQ (PROGN - (LETT |#G13| |y| |EUCDOM-;gcd;3S;5|) - (LETT |#G14| - (SPADCALL |x| |y| (|getShellEntry| $ 20)) - |EUCDOM-;gcd;3S;5|) - (LETT |x| |#G13| |EUCDOM-;gcd;3S;5|) - (LETT |y| |#G14| |EUCDOM-;gcd;3S;5|)) - (EXIT (LETT |y| - (SPADCALL |y| (|getShellEntry| $ 18)) - |EUCDOM-;gcd;3S;5|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |x|))))) - -(DEFUN |EUCDOM-;unitNormalizeIdealElt| (|s| $) - (PROG (|#G16| |u| |c| |a|) - (RETURN - (SEQ (PROGN - (LETT |#G16| - (SPADCALL (QVELT |s| 2) (|getShellEntry| $ 23)) - |EUCDOM-;unitNormalizeIdealElt|) - (LETT |u| (QVELT |#G16| 0) - |EUCDOM-;unitNormalizeIdealElt|) - (LETT |c| (QVELT |#G16| 1) - |EUCDOM-;unitNormalizeIdealElt|) - (LETT |a| (QVELT |#G16| 2) - |EUCDOM-;unitNormalizeIdealElt|) - |#G16|) - (EXIT (COND - ((SPADCALL |a| (|spadConstant| $ 24) - (|getShellEntry| $ 25)) - |s|) - ('T - (VECTOR (SPADCALL |a| (QVELT |s| 0) - (|getShellEntry| $ 26)) - (SPADCALL |a| (QVELT |s| 1) - (|getShellEntry| $ 26)) - |c|)))))))) - -(DEFUN |EUCDOM-;extendedEuclidean;2SR;7| (|x| |y| $) - (PROG (|s3| |s2| |qr| |s1|) - (RETURN - (SEQ (LETT |s1| - (|EUCDOM-;unitNormalizeIdealElt| - (VECTOR (|spadConstant| $ 24) - (|spadConstant| $ 27) |x|) - $) - |EUCDOM-;extendedEuclidean;2SR;7|) - (LETT |s2| - (|EUCDOM-;unitNormalizeIdealElt| - (VECTOR (|spadConstant| $ 27) - (|spadConstant| $ 24) |y|) - $) - |EUCDOM-;extendedEuclidean;2SR;7|) - (EXIT (COND - ((SPADCALL |y| (|getShellEntry| $ 8)) |s1|) - ((SPADCALL |x| (|getShellEntry| $ 8)) |s2|) - ('T - (SEQ (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL (QVELT |s2| 2) - (|getShellEntry| $ 8)) - (|getShellEntry| $ 19))) - (GO G191))) - (SEQ (LETT |qr| - (SPADCALL (QVELT |s1| 2) - (QVELT |s2| 2) - (|getShellEntry| $ 13)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (LETT |s3| - (VECTOR - (SPADCALL (QVELT |s1| 0) - (SPADCALL (QCAR |qr|) - (QVELT |s2| 0) - (|getShellEntry| $ 26)) - (|getShellEntry| $ 28)) - (SPADCALL (QVELT |s1| 1) - (SPADCALL (QCAR |qr|) - (QVELT |s2| 1) - (|getShellEntry| $ 26)) - (|getShellEntry| $ 28)) - (QCDR |qr|)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (LETT |s1| |s2| - |EUCDOM-;extendedEuclidean;2SR;7|) - (EXIT - (LETT |s2| - (|EUCDOM-;unitNormalizeIdealElt| - |s3| $) - |EUCDOM-;extendedEuclidean;2SR;7|))) - NIL (GO G190) G191 (EXIT NIL)) - (COND - ((NULL (SPADCALL (QVELT |s1| 0) - (|getShellEntry| $ 8))) - (COND - ((NULL (SPADCALL (QVELT |s1| 0) |y| - (|getShellEntry| $ 29))) - (SEQ (LETT |qr| - (SPADCALL (QVELT |s1| 0) |y| - (|getShellEntry| $ 13)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (QSETVELT |s1| 0 (QCDR |qr|)) - (QSETVELT |s1| 1 - (SPADCALL (QVELT |s1| 1) - (SPADCALL (QCAR |qr|) |x| - (|getShellEntry| $ 26)) - (|getShellEntry| $ 30))) - (EXIT - (LETT |s1| - (|EUCDOM-;unitNormalizeIdealElt| - |s1| $) - |EUCDOM-;extendedEuclidean;2SR;7|))))))) - (EXIT |s1|))))))))) - -(DEFUN |EUCDOM-;extendedEuclidean;3SU;8| (|x| |y| |z| $) - (PROG (|s| |w| |qr|) - (RETURN - (SEQ (COND - ((SPADCALL |z| (|getShellEntry| $ 8)) - (CONS 0 - (CONS (|spadConstant| $ 27) (|spadConstant| $ 27)))) - ('T - (SEQ (LETT |s| (SPADCALL |x| |y| (|getShellEntry| $ 33)) - |EUCDOM-;extendedEuclidean;3SU;8|) - (LETT |w| - (SPADCALL |z| (QVELT |s| 2) - (|getShellEntry| $ 34)) - |EUCDOM-;extendedEuclidean;3SU;8|) - (EXIT (COND - ((QEQCAR |w| 1) (CONS 1 "failed")) - ((SPADCALL |y| (|getShellEntry| $ 8)) - (CONS 0 - (CONS (SPADCALL (QVELT |s| 0) - (QCDR |w|) - (|getShellEntry| $ 26)) - (SPADCALL (QVELT |s| 1) - (QCDR |w|) - (|getShellEntry| $ 26))))) - ('T - (SEQ (LETT |qr| - (SPADCALL - (SPADCALL (QVELT |s| 0) - (QCDR |w|) - (|getShellEntry| $ 26)) - |y| (|getShellEntry| $ 13)) - |EUCDOM-;extendedEuclidean;3SU;8|) - (EXIT (CONS 0 - (CONS (QCDR |qr|) - (SPADCALL - (SPADCALL (QVELT |s| 1) - (QCDR |w|) - (|getShellEntry| $ 26)) - (SPADCALL (QCAR |qr|) |x| - (|getShellEntry| $ 26)) - (|getShellEntry| $ 30)))))))))))))))) - -(DEFUN |EUCDOM-;principalIdeal;LR;9| (|l| $) - (PROG (|uca| |v| |u| #0=#:G1478 |vv| #1=#:G1479) - (RETURN - (SEQ (COND - ((SPADCALL |l| NIL (|getShellEntry| $ 39)) - (|error| "empty list passed to principalIdeal")) - ((SPADCALL (CDR |l|) NIL (|getShellEntry| $ 39)) - (SEQ (LETT |uca| - (SPADCALL (|SPADfirst| |l|) - (|getShellEntry| $ 23)) - |EUCDOM-;principalIdeal;LR;9|) - (EXIT (CONS (LIST (QVELT |uca| 0)) (QVELT |uca| 1))))) - ((SPADCALL (CDR (CDR |l|)) NIL (|getShellEntry| $ 39)) - (SEQ (LETT |u| - (SPADCALL (|SPADfirst| |l|) - (SPADCALL |l| (|getShellEntry| $ 40)) - (|getShellEntry| $ 33)) - |EUCDOM-;principalIdeal;LR;9|) - (EXIT (CONS (LIST (QVELT |u| 0) (QVELT |u| 1)) - (QVELT |u| 2))))) - ('T - (SEQ (LETT |v| - (SPADCALL (CDR |l|) (|getShellEntry| $ 43)) - |EUCDOM-;principalIdeal;LR;9|) - (LETT |u| - (SPADCALL (|SPADfirst| |l|) (QCDR |v|) - (|getShellEntry| $ 33)) - |EUCDOM-;principalIdeal;LR;9|) - (EXIT (CONS (CONS (QVELT |u| 0) - (PROGN - (LETT #0# NIL - |EUCDOM-;principalIdeal;LR;9|) - (SEQ - (LETT |vv| NIL - |EUCDOM-;principalIdeal;LR;9|) - (LETT #1# (QCAR |v|) - |EUCDOM-;principalIdeal;LR;9|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |vv| (CAR #1#) - |EUCDOM-;principalIdeal;LR;9|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (LETT #0# - (CONS - (SPADCALL (QVELT |u| 1) - |vv| - (|getShellEntry| $ 26)) - #0#) - |EUCDOM-;principalIdeal;LR;9|))) - (LETT #1# (CDR #1#) - |EUCDOM-;principalIdeal;LR;9|) - (GO G190) G191 - (EXIT (NREVERSE0 #0#))))) - (QVELT |u| 2)))))))))) - -(DEFUN |EUCDOM-;expressIdealMember;LSU;10| (|l| |z| $) - (PROG (#0=#:G1494 #1=#:G1495 |pid| |q| #2=#:G1496 |v| #3=#:G1497) - (RETURN - (SEQ (COND - ((SPADCALL |z| (|spadConstant| $ 27) - (|getShellEntry| $ 25)) - (CONS 0 - (PROGN - (LETT #0# NIL - |EUCDOM-;expressIdealMember;LSU;10|) - (SEQ (LETT |v| NIL - |EUCDOM-;expressIdealMember;LSU;10|) - (LETT #1# |l| - |EUCDOM-;expressIdealMember;LSU;10|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |v| (CAR #1#) - |EUCDOM-;expressIdealMember;LSU;10|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS (|spadConstant| $ 27) #0#) - |EUCDOM-;expressIdealMember;LSU;10|))) - (LETT #1# (CDR #1#) - |EUCDOM-;expressIdealMember;LSU;10|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))))) - ('T - (SEQ (LETT |pid| (SPADCALL |l| (|getShellEntry| $ 43)) - |EUCDOM-;expressIdealMember;LSU;10|) - (LETT |q| - (SPADCALL |z| (QCDR |pid|) - (|getShellEntry| $ 34)) - |EUCDOM-;expressIdealMember;LSU;10|) - (EXIT (COND - ((QEQCAR |q| 1) (CONS 1 "failed")) - ('T - (CONS 0 - (PROGN - (LETT #2# NIL - |EUCDOM-;expressIdealMember;LSU;10|) - (SEQ - (LETT |v| NIL - |EUCDOM-;expressIdealMember;LSU;10|) - (LETT #3# (QCAR |pid|) - |EUCDOM-;expressIdealMember;LSU;10|) - G190 - (COND - ((OR (ATOM #3#) - (PROGN - (LETT |v| (CAR #3#) - |EUCDOM-;expressIdealMember;LSU;10|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (LETT #2# - (CONS - (SPADCALL (QCDR |q|) |v| - (|getShellEntry| $ 26)) - #2#) - |EUCDOM-;expressIdealMember;LSU;10|))) - (LETT #3# (CDR #3#) - |EUCDOM-;expressIdealMember;LSU;10|) - (GO G190) G191 - (EXIT (NREVERSE0 #2#))))))))))))))) - -(DEFUN |EUCDOM-;multiEuclidean;LSU;11| (|l| |z| $) - (PROG (|n| |l1| |l2| #0=#:G1392 #1=#:G1516 #2=#:G1503 #3=#:G1501 - #4=#:G1502 #5=#:G1393 #6=#:G1517 #7=#:G1506 #8=#:G1504 - #9=#:G1505 |u| |v1| |v2|) - (RETURN - (SEQ (LETT |n| (LENGTH |l|) |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT (COND - ((ZEROP |n|) - (|error| "empty list passed to multiEuclidean")) - ((EQL |n| 1) (CONS 0 (LIST |z|))) - ('T - (SEQ (LETT |l1| - (SPADCALL |l| (|getShellEntry| $ 47)) - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT |l2| - (SPADCALL |l1| (QUOTIENT2 |n| 2) - (|getShellEntry| $ 49)) - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT |u| - (SPADCALL - (PROGN - (LETT #4# NIL - |EUCDOM-;multiEuclidean;LSU;11|) - (SEQ - (LETT #0# NIL - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT #1# |l1| - |EUCDOM-;multiEuclidean;LSU;11|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT #0# (CAR #1#) - |EUCDOM-;multiEuclidean;LSU;11|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (PROGN - (LETT #2# #0# - |EUCDOM-;multiEuclidean;LSU;11|) - (COND - (#4# - (LETT #3# - (SPADCALL #3# #2# - (|getShellEntry| $ 26)) - |EUCDOM-;multiEuclidean;LSU;11|)) - ('T - (PROGN - (LETT #3# #2# - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT #4# 'T - |EUCDOM-;multiEuclidean;LSU;11|))))))) - (LETT #1# (CDR #1#) - |EUCDOM-;multiEuclidean;LSU;11|) - (GO G190) G191 (EXIT NIL)) - (COND - (#4# #3#) - ('T (|spadConstant| $ 24)))) - (PROGN - (LETT #9# NIL - |EUCDOM-;multiEuclidean;LSU;11|) - (SEQ - (LETT #5# NIL - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT #6# |l2| - |EUCDOM-;multiEuclidean;LSU;11|) - G190 - (COND - ((OR (ATOM #6#) - (PROGN - (LETT #5# (CAR #6#) - |EUCDOM-;multiEuclidean;LSU;11|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (PROGN - (LETT #7# #5# - |EUCDOM-;multiEuclidean;LSU;11|) - (COND - (#9# - (LETT #8# - (SPADCALL #8# #7# - (|getShellEntry| $ 26)) - |EUCDOM-;multiEuclidean;LSU;11|)) - ('T - (PROGN - (LETT #8# #7# - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT #9# 'T - |EUCDOM-;multiEuclidean;LSU;11|))))))) - (LETT #6# (CDR #6#) - |EUCDOM-;multiEuclidean;LSU;11|) - (GO G190) G191 (EXIT NIL)) - (COND - (#9# #8#) - ('T (|spadConstant| $ 24)))) - |z| (|getShellEntry| $ 50)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT (COND - ((QEQCAR |u| 1) (CONS 1 "failed")) - ('T - (SEQ (LETT |v1| - (SPADCALL |l1| - (QCDR (QCDR |u|)) - (|getShellEntry| $ 51)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT - (COND - ((QEQCAR |v1| 1) - (CONS 1 "failed")) - ('T - (SEQ - (LETT |v2| - (SPADCALL |l2| - (QCAR (QCDR |u|)) - (|getShellEntry| $ 51)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT - (COND - ((QEQCAR |v2| 1) - (CONS 1 "failed")) - ('T - (CONS 0 - (SPADCALL (QCDR |v1|) - (QCDR |v2|) - (|getShellEntry| $ - 52)))))))))))))))))))))) - -(DEFUN |EuclideanDomain&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|EuclideanDomain&|)) - (LETT |dv$| (LIST '|EuclideanDomain&| |dv$1|) . #0#) - (LETT $ (|newShell| 54) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 |#1|) - $)))) - -(MAKEPROP '|EuclideanDomain&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Boolean|) - (0 . |zero?|) (|NonNegativeInteger|) (5 . |euclideanSize|) - |EUCDOM-;sizeLess?;2SB;1| - (|Record| (|:| |quotient| $) (|:| |remainder| $)) - (10 . |divide|) |EUCDOM-;quo;3S;2| |EUCDOM-;rem;3S;3| - (|Union| $ '"failed") |EUCDOM-;exquo;2SU;4| - (16 . |unitCanonical|) (21 . |not|) (26 . |rem|) - |EUCDOM-;gcd;3S;5| - (|Record| (|:| |unit| $) (|:| |canonical| $) - (|:| |associate| $)) - (32 . |unitNormal|) (37 . |One|) (41 . =) (47 . *) - (53 . |Zero|) (57 . -) (63 . |sizeLess?|) (69 . +) - (|Record| (|:| |coef1| $) (|:| |coef2| $) - (|:| |generator| $)) - |EUCDOM-;extendedEuclidean;2SR;7| - (75 . |extendedEuclidean|) (81 . |exquo|) - (|Record| (|:| |coef1| $) (|:| |coef2| $)) - (|Union| 35 '"failed") |EUCDOM-;extendedEuclidean;3SU;8| - (|List| 6) (87 . =) (93 . |second|) (|List| $) - (|Record| (|:| |coef| 41) (|:| |generator| $)) - (98 . |principalIdeal|) |EUCDOM-;principalIdeal;LR;9| - (|Union| 41 '"failed") |EUCDOM-;expressIdealMember;LSU;10| - (103 . |copy|) (|Integer|) (108 . |split!|) - (114 . |extendedEuclidean|) (121 . |multiEuclidean|) - (127 . |concat|) |EUCDOM-;multiEuclidean;LSU;11|) - '#(|sizeLess?| 133 |rem| 139 |quo| 145 |principalIdeal| 151 - |multiEuclidean| 156 |gcd| 162 |extendedEuclidean| 168 - |exquo| 181 |expressIdealMember| 187) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 53 - '(1 6 7 0 8 1 6 9 0 10 2 6 12 0 0 13 1 - 6 0 0 18 1 7 0 0 19 2 6 0 0 0 20 1 6 - 22 0 23 0 6 0 24 2 6 7 0 0 25 2 6 0 0 - 0 26 0 6 0 27 2 6 0 0 0 28 2 6 7 0 0 - 29 2 6 0 0 0 30 2 6 31 0 0 33 2 6 16 - 0 0 34 2 38 7 0 0 39 1 38 6 0 40 1 6 - 42 41 43 1 38 0 0 47 2 38 0 0 48 49 3 - 6 36 0 0 0 50 2 6 45 41 0 51 2 38 0 0 - 0 52 2 0 7 0 0 11 2 0 0 0 0 15 2 0 0 - 0 0 14 1 0 42 41 44 2 0 45 41 0 53 2 - 0 0 0 0 21 3 0 36 0 0 0 37 2 0 31 0 0 - 32 2 0 16 0 0 17 2 0 45 41 0 46))))) - '|lookupComplete|)) -@ - \section{category FIELD Field} @@ -2087,283 +792,7 @@ GcdDomain(): Category == IntegralDomain with monomial(1,e1)*p1 @ -\section{GCDDOM.lsp BOOTSTRAP} -{\bf GCDDOM} needs -{\bf COMRING} which needs -{\bf RING} which needs -{\bf RNG} which needs -{\bf ABELGRP} which needs -{\bf CABMON} which needs -{\bf ABELMON} which needs -{\bf ABELSG} which needs -{\bf SETCAT} which needs -{\bf SINT} which needs -{\bf UFD} which needs -{\bf GCDDOM}. -We break this chain with {\bf GCDDOM.lsp} which we -cache here. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf GCDDOM} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf GCDDOM.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<GCDDOM.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |GcdDomain;AL| 'NIL) - -(DEFUN |GcdDomain| () - (LET (#:G1393) - (COND (|GcdDomain;AL|) (T (SETQ |GcdDomain;AL| (|GcdDomain;|)))))) - -(DEFUN |GcdDomain;| () - (PROG (#0=#:G1391) - (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|) - (SETELT #0# 0 '(|GcdDomain|)))))) - -(MAKEPROP '|GcdDomain| 'NILADIC T) -@ -\section{GCDDOM-.lsp BOOTSTRAP} -{\bf GCDDOM-} depends on {\bf GCDDOM}. -We break this chain with {\bf GCDDOM-.lsp} which we -cache here. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf GCDDOM-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf GCDDOM-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<GCDDOM-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |GCDDOM-;lcm;3S;1| (|x| |y| $) - (PROG (LCM) - (RETURN - (SEQ (COND - ((OR (SPADCALL |y| (|spadConstant| $ 7) (QREFELT $ 9)) - (SPADCALL |x| (|spadConstant| $ 7) (QREFELT $ 9))) - (|spadConstant| $ 7)) - ('T - (SEQ (LETT LCM - (SPADCALL |y| - (SPADCALL |x| |y| (QREFELT $ 10)) - (QREFELT $ 12)) - |GCDDOM-;lcm;3S;1|) - (EXIT (COND - ((QEQCAR LCM 0) - (SPADCALL |x| (QCDR LCM) (QREFELT $ 13))) - ('T (|error| "bad gcd in lcm computation"))))))))))) - -(DEFUN |GCDDOM-;lcm;LS;2| (|l| $) - (SPADCALL (ELT $ 15) |l| (|spadConstant| $ 16) (|spadConstant| $ 7) - (QREFELT $ 19))) - -(DEFUN |GCDDOM-;gcd;LS;3| (|l| $) - (SPADCALL (ELT $ 10) |l| (|spadConstant| $ 7) (|spadConstant| $ 16) - (QREFELT $ 19))) - -(DEFUN |GCDDOM-;gcdPolynomial;3Sup;4| (|p1| |p2| $) - (PROG (|e2| |e1| |c1| |p| |c2| #0=#:G1406) - (RETURN - (SEQ (COND - ((SPADCALL |p1| (QREFELT $ 24)) - (SPADCALL |p2| (QREFELT $ 25))) - ((SPADCALL |p2| (QREFELT $ 24)) - (SPADCALL |p1| (QREFELT $ 25))) - ('T - (SEQ (LETT |c1| (SPADCALL |p1| (QREFELT $ 26)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (LETT |c2| (SPADCALL |p2| (QREFELT $ 26)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (LETT |p1| - (PROG2 (LETT #0# - (SPADCALL |p1| |c1| - (QREFELT $ 27)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|SparseUnivariatePolynomial| - (QREFELT $ 6)) - #0#)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (LETT |p2| - (PROG2 (LETT #0# - (SPADCALL |p2| |c2| - (QREFELT $ 27)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|SparseUnivariatePolynomial| - (QREFELT $ 6)) - #0#)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (SEQ (LETT |e1| (SPADCALL |p1| (QREFELT $ 29)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((< 0 |e1|) - (LETT |p1| - (PROG2 - (LETT #0# - (SPADCALL |p1| - (SPADCALL - (|spadConstant| $ 16) |e1| - (QREFELT $ 32)) - (QREFELT $ 33)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|SparseUnivariatePolynomial| - (QREFELT $ 6)) - #0#)) - |GCDDOM-;gcdPolynomial;3Sup;4|))))) - (SEQ (LETT |e2| (SPADCALL |p2| (QREFELT $ 29)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((< 0 |e2|) - (LETT |p2| - (PROG2 - (LETT #0# - (SPADCALL |p2| - (SPADCALL - (|spadConstant| $ 16) |e2| - (QREFELT $ 32)) - (QREFELT $ 33)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|SparseUnivariatePolynomial| - (QREFELT $ 6)) - #0#)) - |GCDDOM-;gcdPolynomial;3Sup;4|))))) - (LETT |e1| (MIN |e1| |e2|) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (LETT |c1| (SPADCALL |c1| |c2| (QREFELT $ 10)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (LETT |p1| - (COND - ((OR (EQL (SPADCALL |p1| (QREFELT $ 34)) 0) - (EQL (SPADCALL |p2| (QREFELT $ 34)) 0)) - (SPADCALL |c1| 0 (QREFELT $ 32))) - ('T - (SEQ (LETT |p| - (SPADCALL |p1| |p2| - (QREFELT $ 35)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((EQL - (SPADCALL |p| - (QREFELT $ 34)) - 0) - (SPADCALL |c1| 0 - (QREFELT $ 32))) - ('T - (SEQ - (LETT |c2| - (SPADCALL - (SPADCALL |p1| - (QREFELT $ 36)) - (SPADCALL |p2| - (QREFELT $ 36)) - (QREFELT $ 10)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT - (SPADCALL - (SPADCALL |c1| - (SPADCALL - (PROG2 - (LETT #0# - (SPADCALL - (SPADCALL |c2| |p| - (QREFELT $ 37)) - (SPADCALL |p| - (QREFELT $ 36)) - (QREFELT $ 27)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (QCDR #0#) - (|check-union| - (QEQCAR #0# 0) - (|SparseUnivariatePolynomial| - (QREFELT $ 6)) - #0#)) - (QREFELT $ 38)) - (QREFELT $ 37)) - (QREFELT $ 25)))))))))) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((ZEROP |e1|) |p1|) - ('T - (SPADCALL - (SPADCALL (|spadConstant| $ 16) |e1| - (QREFELT $ 32)) - |p1| (QREFELT $ 39)))))))))))) - -(DEFUN |GcdDomain&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|GcdDomain&|)) - (LETT |dv$| (LIST '|GcdDomain&| |dv$1|) . #0#) - (LETT $ (GETREFV 42) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) -(MAKEPROP '|GcdDomain&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|) - (|Boolean|) (4 . =) (10 . |gcd|) (|Union| $ '"failed") - (16 . |exquo|) (22 . *) |GCDDOM-;lcm;3S;1| (28 . |lcm|) - (34 . |One|) (|Mapping| 6 6 6) (|List| 6) (38 . |reduce|) - (|List| $) |GCDDOM-;lcm;LS;2| |GCDDOM-;gcd;LS;3| - (|SparseUnivariatePolynomial| 6) (46 . |zero?|) - (51 . |unitCanonical|) (56 . |content|) (61 . |exquo|) - (|NonNegativeInteger|) (67 . |minimumDegree|) - (72 . |Zero|) (76 . |One|) (80 . |monomial|) - (86 . |exquo|) (92 . |degree|) (97 . |subResultantGcd|) - (103 . |leadingCoefficient|) (108 . *) - (114 . |primitivePart|) (119 . *) - (|SparseUnivariatePolynomial| $) - |GCDDOM-;gcdPolynomial;3Sup;4|) - '#(|lcm| 125 |gcdPolynomial| 136 |gcd| 142) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 41 - '(0 6 0 7 2 6 8 0 0 9 2 6 0 0 0 10 2 6 - 11 0 0 12 2 6 0 0 0 13 2 6 0 0 0 15 0 - 6 0 16 4 18 6 17 0 6 6 19 1 23 8 0 24 - 1 23 0 0 25 1 23 6 0 26 2 23 11 0 6 - 27 1 23 28 0 29 0 23 0 30 0 23 0 31 2 - 23 0 6 28 32 2 23 11 0 0 33 1 23 28 0 - 34 2 23 0 0 0 35 1 23 6 0 36 2 23 0 6 - 0 37 1 23 0 0 38 2 23 0 0 0 39 1 0 0 - 20 21 2 0 0 0 0 14 2 0 40 40 40 41 1 - 0 0 20 22))))) - '|lookupComplete|)) -@ \section{category GROUP Group} <<category GROUP Group>>= )abbrev category GROUP Group @@ -2472,141 +901,8 @@ IntegralDomain(): Category == true @ -\section{INTDOM.lsp BOOTSTRAP} -{\bf INTDOM} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf INTDOM} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf INTDOM.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<INTDOM.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |IntegralDomain;AL| 'NIL) - -(DEFUN |IntegralDomain| () - (LET (#:G1393) - (COND - (|IntegralDomain;AL|) - (T (SETQ |IntegralDomain;AL| (|IntegralDomain;|)))))) - -(DEFUN |IntegralDomain;| () - (PROG (#0=#:G1391) - (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|) - (SETELT #0# 0 '(|IntegralDomain|)))))) - -(MAKEPROP '|IntegralDomain| 'NILADIC T) -@ -\section{INTDOM-.lsp BOOTSTRAP} -{\bf INTDOM-} depends on {\bf INTDOM}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf INTDOM-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf INTDOM-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<INTDOM-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |INTDOM-;unitNormal;SR;1| (|x| $) - (VECTOR (|spadConstant| $ 7) |x| (|spadConstant| $ 7))) - -(DEFUN |INTDOM-;unitCanonical;2S;2| (|x| $) - (QVELT (SPADCALL |x| (QREFELT $ 10)) 1)) - -(DEFUN |INTDOM-;recip;SU;3| (|x| $) - (COND - ((SPADCALL |x| (QREFELT $ 13)) (CONS 1 "failed")) - ('T (SPADCALL (|spadConstant| $ 7) |x| (QREFELT $ 15))))) - -(DEFUN |INTDOM-;unit?;SB;4| (|x| $) - (COND ((QEQCAR (SPADCALL |x| (QREFELT $ 17)) 1) 'NIL) ('T 'T))) -(DEFUN |INTDOM-;associates?;2SB;5| (|x| |y| $) - (SPADCALL (QVELT (SPADCALL |x| (QREFELT $ 10)) 1) - (QVELT (SPADCALL |y| (QREFELT $ 10)) 1) (QREFELT $ 19))) -(DEFUN |INTDOM-;associates?;2SB;6| (|x| |y| $) - (COND - ((SPADCALL |x| (QREFELT $ 13)) (SPADCALL |y| (QREFELT $ 13))) - ((OR (SPADCALL |y| (QREFELT $ 13)) - (OR (QEQCAR (SPADCALL |x| |y| (QREFELT $ 15)) 1) - (QEQCAR (SPADCALL |y| |x| (QREFELT $ 15)) 1))) - 'NIL) - ('T 'T))) - -(DEFUN |IntegralDomain&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|IntegralDomain&|)) - (LETT |dv$| (LIST '|IntegralDomain&| |dv$1|) . #0#) - (LETT $ (GETREFV 21) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (COND - ((|HasCategory| |#1| '(|Field|))) - ('T - (QSETREFV $ 9 - (CONS (|dispatchFunction| |INTDOM-;unitNormal;SR;1|) $)))) - (COND - ((|HasAttribute| |#1| '|canonicalUnitNormal|) - (QSETREFV $ 20 - (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;5|) - $))) - ('T - (QSETREFV $ 20 - (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;6|) - $)))) - $)))) - -(MAKEPROP '|IntegralDomain&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |One|) - (|Record| (|:| |unit| $) (|:| |canonical| $) - (|:| |associate| $)) - (4 . |unitNormal|) (9 . |unitNormal|) - |INTDOM-;unitCanonical;2S;2| (|Boolean|) (14 . |zero?|) - (|Union| $ '"failed") (19 . |exquo|) |INTDOM-;recip;SU;3| - (25 . |recip|) |INTDOM-;unit?;SB;4| (30 . =) - (36 . |associates?|)) - '#(|unitNormal| 42 |unitCanonical| 47 |unit?| 52 |recip| 57 - |associates?| 62) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 20 - '(0 6 0 7 1 0 8 0 9 1 6 8 0 10 1 6 12 0 - 13 2 6 14 0 0 15 1 6 14 0 17 2 6 12 0 - 0 19 2 0 12 0 0 20 1 0 8 0 9 1 0 0 0 - 11 1 0 12 0 18 1 0 14 0 16 2 0 12 0 0 - 20))))) - '|lookupComplete|)) -@ \section{category LMODULE LeftModule} <<category LMODULE LeftModule>>= )abbrev category LMODULE LeftModule @@ -2730,106 +1026,7 @@ Monoid(): Category == SemiGroup with expt(x,n pretend PositiveInteger) @ -\section{MONOID.lsp BOOTSTRAP} -{\bf MONOID} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf MONOID} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf MONOID.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<MONOID.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |Monoid;AL| 'NIL) - -(DEFUN |Monoid| () - (LET (#:G1388) - (COND (|Monoid;AL|) (T (SETQ |Monoid;AL| (|Monoid;|)))))) - -(DEFUN |Monoid;| () - (PROG (#0=#:G1386) - (RETURN - (PROG1 (LETT #0# - (|Join| (|SemiGroup|) - (|mkCategory| '|domain| - '(((|One| ($) |constant|) T) - ((|sample| ($) |constant|) T) - ((|one?| ((|Boolean|) $)) T) - ((** ($ $ (|NonNegativeInteger|))) T) - ((^ ($ $ (|NonNegativeInteger|))) T) - ((|recip| ((|Union| $ "failed") $)) T)) - NIL - '((|NonNegativeInteger|) (|Boolean|)) - NIL)) - |Monoid|) - (SETELT #0# 0 '(|Monoid|)))))) - -(MAKEPROP '|Monoid| 'NILADIC T) -@ -\section{MONOID-.lsp BOOTSTRAP} -{\bf MONOID-} depends on {\bf MONOID}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf MONOID-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf MONOID-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<MONOID-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |MONOID-;^;SNniS;1| (|x| |n| $) - (SPADCALL |x| |n| (QREFELT $ 8))) - -(DEFUN |MONOID-;one?;SB;2| (|x| $) - (SPADCALL |x| (|spadConstant| $ 10) (QREFELT $ 12))) - -(DEFUN |MONOID-;sample;S;3| ($) (|spadConstant| $ 10)) -(DEFUN |MONOID-;recip;SU;4| (|x| $) - (COND - ((SPADCALL |x| (|spadConstant| $ 10) (QREFELT $ 12)) (CONS 0 |x|)) - ('T (CONS 1 "failed")))) - -(DEFUN |MONOID-;**;SNniS;5| (|x| |n| $) - (COND - ((ZEROP |n|) (|spadConstant| $ 10)) - ('T (SPADCALL |x| |n| (QREFELT $ 19))))) - -(DEFUN |Monoid&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|Monoid&|)) - (LETT |dv$| (LIST '|Monoid&| |dv$1|) . #0#) - (LETT $ (GETREFV 21) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) - -(MAKEPROP '|Monoid&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) - (|NonNegativeInteger|) (0 . **) |MONOID-;^;SNniS;1| - (6 . |One|) (|Boolean|) (10 . =) |MONOID-;one?;SB;2| - |MONOID-;sample;S;3| (|Union| $ '"failed") - |MONOID-;recip;SU;4| (|PositiveInteger|) - (|RepeatedSquaring| 6) (16 . |expt|) |MONOID-;**;SNniS;5|) - '#(|sample| 22 |recip| 26 |one?| 31 ^ 36 ** 42) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 20 - '(2 6 0 0 7 8 0 6 0 10 2 6 11 0 0 12 2 - 18 6 6 17 19 0 0 0 14 1 0 15 0 16 1 0 - 11 0 13 2 0 0 0 7 9 2 0 0 0 7 20))))) - '|lookupComplete|)) -@ \section{category OAGROUP OrderedAbelianGroup} <<category OAGROUP OrderedAbelianGroup>>= )abbrev category OAGROUP OrderedAbelianGroup @@ -2989,36 +1186,7 @@ OrderedIntegralDomain(): Category == Join(IntegralDomain, OrderedRing) @ -\section{OINTDOM.lsp BOOTSTRAP} -{\bf OINTDOM} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf OINTDOM} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf OINTDOM.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<OINTDOM.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |OrderedIntegralDomain;AL| 'NIL) -(DEFUN |OrderedIntegralDomain| () - (LET (#:G1387) - (COND - (|OrderedIntegralDomain;AL|) - (T (SETQ |OrderedIntegralDomain;AL| (|OrderedIntegralDomain;|)))))) - -(DEFUN |OrderedIntegralDomain;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# (|Join| (|IntegralDomain|) (|OrderedRing|)) - |OrderedIntegralDomain|) - (SETELT #0# 0 '(|OrderedIntegralDomain|)))))) - -(MAKEPROP '|OrderedIntegralDomain| 'NILADIC T) -@ \section{category ORDMON OrderedMonoid} <<category ORDMON OrderedMonoid>>= )abbrev category ORDMON OrderedMonoid @@ -3085,111 +1253,7 @@ OrderedRing(): Category == Join(OrderedAbelianGroup,Ring,Monoid) with error "x satisfies neither positive?, negative? or zero?" @ -\section{ORDRING.lsp BOOTSTRAP} -{\bf ORDRING} depends on {\bf INT}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ORDRING} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ORDRING.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Technically I can't justify this bootstrap stanza based on the lattice -since {\bf INT} is already bootstrapped. However using {\bf INT} naked -generates a "value stack overflow" error suggesting an infinite recursive -loop. This code is here to experiment with breaking that loop. - -Note that this code is not included in the generated catdef.spad file. - -<<ORDRING.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |OrderedRing;AL| 'NIL) - -(DEFUN |OrderedRing| () - (LET (#:G1393) - (COND - (|OrderedRing;AL|) - (T (SETQ |OrderedRing;AL| (|OrderedRing;|)))))) - -(DEFUN |OrderedRing;| () - (PROG (#0=#:G1391) - (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|) - (SETELT #0# 0 '(|OrderedRing|)))))) - -(MAKEPROP '|OrderedRing| 'NILADIC T) -@ -\section{ORDRING-.lsp BOOTSTRAP} -{\bf ORDRING-} depends on {\bf ORDRING}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ORDRING-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ORDRING-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<ORDRING-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |ORDRING-;positive?;SB;1| (|x| $) - (SPADCALL (|spadConstant| $ 7) |x| (QREFELT $ 9))) - -(DEFUN |ORDRING-;negative?;SB;2| (|x| $) - (SPADCALL |x| (|spadConstant| $ 7) (QREFELT $ 9))) -(DEFUN |ORDRING-;sign;SI;3| (|x| $) - (COND - ((SPADCALL |x| (QREFELT $ 12)) 1) - ((SPADCALL |x| (QREFELT $ 13)) -1) - ((SPADCALL |x| (QREFELT $ 15)) 0) - ('T (|error| "x satisfies neither positive?, negative? or zero?")))) - -(DEFUN |ORDRING-;abs;2S;4| (|x| $) - (COND - ((SPADCALL |x| (QREFELT $ 12)) |x|) - ((SPADCALL |x| (QREFELT $ 13)) (SPADCALL |x| (QREFELT $ 18))) - ((SPADCALL |x| (QREFELT $ 15)) (|spadConstant| $ 7)) - ('T (|error| "x satisfies neither positive?, negative? or zero?")))) - -(DEFUN |OrderedRing&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|OrderedRing&|)) - (LETT |dv$| (LIST '|OrderedRing&| |dv$1|) . #0#) - (LETT $ (GETREFV 20) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) - -(MAKEPROP '|OrderedRing&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|) - (|Boolean|) (4 . <) |ORDRING-;positive?;SB;1| - |ORDRING-;negative?;SB;2| (10 . |positive?|) - (15 . |negative?|) (20 . |One|) (24 . |zero?|) (|Integer|) - |ORDRING-;sign;SI;3| (29 . -) |ORDRING-;abs;2S;4|) - '#(|sign| 34 |positive?| 39 |negative?| 44 |abs| 49) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 19 - '(0 6 0 7 2 6 8 0 0 9 1 6 8 0 12 1 6 8 - 0 13 0 6 0 14 1 6 8 0 15 1 6 0 0 18 1 - 0 16 0 17 1 0 8 0 10 1 0 8 0 11 1 0 0 - 0 19))))) - '|lookupComplete|)) -@ \section{category ORDSET OrderedSet} <<category ORDSET OrderedSet>>= )abbrev category ORDSET OrderedSet @@ -3484,82 +1548,8 @@ Ring(): Category == Join(Rng,Monoid,LeftModule(%)) with coerce(n) == n * 1$% @ -\section{RING.lsp BOOTSTRAP} -{\bf RING} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf RING} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf RING.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<RING.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |Ring;AL| 'NIL) -(DEFUN |Ring| () - (LET (#:G1387) (COND (|Ring;AL|) (T (SETQ |Ring;AL| (|Ring;|)))))) -(DEFUN |Ring;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# - (|Join| (|Rng|) (|Monoid|) (|LeftModule| '$) - (|mkCategory| '|domain| - '(((|characteristic| - ((|NonNegativeInteger|))) - T) - ((|coerce| ($ (|Integer|))) T)) - '((|unitsKnown| T)) - '((|Integer|) (|NonNegativeInteger|)) - NIL)) - |Ring|) - (SETELT #0# 0 '(|Ring|)))))) - -(MAKEPROP '|Ring| 'NILADIC T) -@ -\section{RING-.lsp BOOTSTRAP} -{\bf RING-} depends on {\bf RING}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf RING-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf RING-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<RING-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |RING-;coerce;IS;1| (|n| $) - (SPADCALL |n| (|spadConstant| $ 7) (QREFELT $ 9))) - -(DEFUN |Ring&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|Ring&|)) - (LETT |dv$| (LIST '|Ring&| |dv$1|) . #0#) - (LETT $ (GETREFV 12) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) - -(MAKEPROP '|Ring&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |One|) - (|Integer|) (4 . *) |RING-;coerce;IS;1| (|OutputForm|)) - '#(|coerce| 10) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 10 - '(0 6 0 7 2 6 0 8 0 9 1 0 0 8 10))))) - '|lookupComplete|)) -@ \section{category RNG Rng} <<category RNG Rng>>= )abbrev category RNG Rng @@ -3586,33 +1576,7 @@ Note that this code is not included in the generated catdef.spad file. Rng(): Category == Join(AbelianGroup,SemiGroup) @ -\section{RNG.lsp BOOTSTRAP} -{\bf RNG} depends on a chain of -files. We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf RNG} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf RNG.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<RNG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) -(DEFPARAMETER |Rng;AL| 'NIL) - -(DEFUN |Rng| () - (LET (#:G1387) (COND (|Rng;AL|) (T (SETQ |Rng;AL| (|Rng;|)))))) - -(DEFUN |Rng;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# (|Join| (|AbelianGroup|) (|SemiGroup|)) |Rng|) - (SETELT #0# 0 '(|Rng|)))))) - -(MAKEPROP '|Rng| 'NILADIC T) -@ \section{category SGROUP SemiGroup} <<category SGROUP SemiGroup>>= )abbrev category SGROUP SemiGroup @@ -3676,102 +1640,7 @@ SetCategory(): Category == Join(BasicType,CoercibleTo OutputForm) with latex(s : %): String == "\mbox{\bf Unimplemented}" @ -\section{SETCAT.lsp BOOTSTRAP} -{\bf SETCAT} needs -{\bf SINT} which needs -{\bf UFD} which needs -{\bf GCDDOM} which needs -{\bf COMRING} which needs -{\bf RING} which needs -{\bf RNG} which needs -{\bf ABELGRP} which needs -{\bf CABMON} which needs -{\bf ABELMON} which needs -{\bf ABELSG} which needs -{\bf SETCAT}. We break this chain with {\bf SETCAT.lsp} which we -cache here. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf SETCAT} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf SETCAT.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. -Note that this code is not included in the generated catdef.spad file. - -<<SETCAT.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |SetCategory;AL| 'NIL) - -(DEFUN |SetCategory| () - (LET (#:G1388) - (COND - (|SetCategory;AL|) - (T (SETQ |SetCategory;AL| (|SetCategory;|)))))) - -(DEFUN |SetCategory;| () - (PROG (#0=#:G1386) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(#1=#:G1385) (LIST '(|OutputForm|))) - (|Join| (|BasicType|) (|CoercibleTo| '#1#) - (|mkCategory| '|domain| - '(((|hash| ((|SingleInteger|) $)) T) - ((|latex| ((|String|) $)) T)) - NIL '((|String|) (|SingleInteger|)) - NIL))) - |SetCategory|) - (SETELT #0# 0 '(|SetCategory|)))))) - -(MAKEPROP '|SetCategory| 'NILADIC T) -@ -\section{SETCAT-.lsp BOOTSTRAP} -{\bf SETCAT-} is the implementation of the operations exported -by {\bf SETCAT}. It comes into existance whenever {\bf SETCAT} -gets compiled by Axiom. However this will not happen at the -lisp level so we also cache this information here. See the -explanation under the {\bf SETCAT.lsp} section for more details. - -Note that this code is not included in the generated catdef.spad file. - -<<SETCAT-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(PUT '|SETCAT-;hash;SSi;1| '|SPADreplace| '(XLAM (|s|) 0)) - -(DEFUN |SETCAT-;hash;SSi;1| (|s| $) 0) - -(PUT '|SETCAT-;latex;SS;2| '|SPADreplace| - '(XLAM (|s|) "\\mbox{\\bf Unimplemented}")) - -(DEFUN |SETCAT-;latex;SS;2| (|s| $) "\\mbox{\\bf Unimplemented}") - -(DEFUN |SetCategory&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|SetCategory&|)) - (LETT |dv$| (LIST '|SetCategory&| |dv$1|) . #0#) - (LETT $ (GETREFV 11) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) - -(MAKEPROP '|SetCategory&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|SingleInteger|) - |SETCAT-;hash;SSi;1| (|String|) |SETCAT-;latex;SS;2|) - '#(|latex| 0 |hash| 5) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 10 - '(1 0 9 0 10 1 0 7 0 8))))) - '|lookupComplete|)) -@ \section{category STEP StepThrough} <<category STEP StepThrough>>= )abbrev category STEP StepThrough @@ -3843,151 +1712,6 @@ UniqueFactorizationDomain(): Category == GcdDomain with prime? x == # factorList factor x = 1 @ -\section{UFD.lsp BOOTSTRAP} -{\bf UFD} needs -{\bf GCDDOM} which needs -{\bf COMRING} which needs -{\bf RING} which needs -{\bf RNG} which needs -{\bf ABELGRP} which needs -{\bf CABMON} which needs -{\bf ABELMON} which needs -{\bf ABELSG} which needs -{\bf SETCAT} which needs -{\bf SINT} which needs -{\bf UFD}. -We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf UFD} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf UFD.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<UFD.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |UniqueFactorizationDomain;AL| 'NIL) - -(DEFUN |UniqueFactorizationDomain| () - (LET (#:G1387) - (COND - (|UniqueFactorizationDomain;AL|) - (T (SETQ |UniqueFactorizationDomain;AL| - (|UniqueFactorizationDomain;|)))))) - -(DEFUN |UniqueFactorizationDomain;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# - (|Join| (|GcdDomain|) - (|mkCategory| '|domain| - '(((|prime?| ((|Boolean|) $)) T) - ((|squareFree| ((|Factored| $) $)) T) - ((|squareFreePart| ($ $)) T) - ((|factor| ((|Factored| $) $)) T)) - NIL '((|Factored| $) (|Boolean|)) NIL)) - |UniqueFactorizationDomain|) - (SETELT #0# 0 '(|UniqueFactorizationDomain|)))))) - -(MAKEPROP '|UniqueFactorizationDomain| 'NILADIC T) -@ -\section{UFD-.lsp BOOTSTRAP} -{\bf UFD-} needs {\bf UFD}. -We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf UFD-} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf UFD-.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<UFD-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |UFD-;squareFreePart;2S;1| (|x| $) - (PROG (|s| |f| #0=#:G1403 #1=#:G1401 #2=#:G1399 #3=#:G1400) - (RETURN - (SEQ (SPADCALL - (SPADCALL - (LETT |s| (SPADCALL |x| (|getShellEntry| $ 8)) - |UFD-;squareFreePart;2S;1|) - (|getShellEntry| $ 10)) - (PROGN - (LETT #3# NIL |UFD-;squareFreePart;2S;1|) - (SEQ (LETT |f| NIL |UFD-;squareFreePart;2S;1|) - (LETT #0# (SPADCALL |s| (|getShellEntry| $ 14)) - |UFD-;squareFreePart;2S;1|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |f| (CAR #0#) - |UFD-;squareFreePart;2S;1|) - NIL)) - (GO G191))) - (SEQ (EXIT (PROGN - (LETT #1# (QCAR |f|) - |UFD-;squareFreePart;2S;1|) - (COND - (#3# - (LETT #2# - (SPADCALL #2# #1# - (|getShellEntry| $ 15)) - |UFD-;squareFreePart;2S;1|)) - ('T - (PROGN - (LETT #2# #1# - |UFD-;squareFreePart;2S;1|) - (LETT #3# 'T - |UFD-;squareFreePart;2S;1|))))))) - (LETT #0# (CDR #0#) |UFD-;squareFreePart;2S;1|) - (GO G190) G191 (EXIT NIL)) - (COND (#3# #2#) ('T (|spadConstant| $ 16)))) - (|getShellEntry| $ 15)))))) - -(DEFUN |UFD-;prime?;SB;2| (|x| $) - (EQL (LENGTH (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18)) - (|getShellEntry| $ 22))) - 1)) - -(DEFUN |UniqueFactorizationDomain&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) - . #0=(|UniqueFactorizationDomain&|)) - (LETT |dv$| (LIST '|UniqueFactorizationDomain&| |dv$1|) . #0#) - (LETT $ (|newShell| 25) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 |#1|) - $)))) - -(MAKEPROP '|UniqueFactorizationDomain&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Factored| $) - (0 . |squareFree|) (|Factored| 6) (5 . |unit|) (|Integer|) - (|Record| (|:| |factor| 6) (|:| |exponent| 11)) - (|List| 12) (10 . |factors|) (15 . *) (21 . |One|) - |UFD-;squareFreePart;2S;1| (25 . |factor|) - (|Union| '"nil" '"sqfr" '"irred" '"prime") - (|Record| (|:| |flg| 19) (|:| |fctr| 6) (|:| |xpnt| 11)) - (|List| 20) (30 . |factorList|) (|Boolean|) - |UFD-;prime?;SB;2|) - '#(|squareFreePart| 35 |prime?| 40) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 24 - '(1 6 7 0 8 1 9 6 0 10 1 9 13 0 14 2 6 - 0 0 0 15 0 6 0 16 1 6 7 0 18 1 9 21 0 - 22 1 0 0 0 17 1 0 23 0 24))))) - '|lookupComplete|)) -@ \section{category VSPACE VectorSpace} diff --git a/src/algebra/ffcat.spad.pamphlet b/src/algebra/ffcat.spad.pamphlet index fea2d28a..c87c4c12 100644 --- a/src/algebra/ffcat.spad.pamphlet +++ b/src/algebra/ffcat.spad.pamphlet @@ -704,703 +704,7 @@ generated by first argument")$OutputForm gcd(f,g)$EuclideanDomain_&(FP) @ -\section{FFIELDC.lsp BOOTSTRAP} -{\bf FFIELDC} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf FFIELDC} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf FFIELDC.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. -Note that this code is not included in the generated catdef.spad file. - -<<FFIELDC.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |FiniteFieldCategory;AL| 'NIL) - -(DEFUN |FiniteFieldCategory| () - (LET (#:G1395) - (COND - (|FiniteFieldCategory;AL|) - (T (SETQ |FiniteFieldCategory;AL| (|FiniteFieldCategory;|)))))) - -(DEFUN |FiniteFieldCategory;| () - (PROG (#0=#:G1393) - (RETURN - (PROG1 (LETT #0# - (|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|) - (SETELT #0# 0 '(|FiniteFieldCategory|)))))) - -(MAKEPROP '|FiniteFieldCategory| 'NILADIC T) -@ -\section{FFIELDC-.lsp BOOTSTRAP} -{\bf FFIELDC-} depends on {\bf FFIELDC}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf FFIELDC-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf FFIELDC-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<FFIELDC-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |FFIELDC-;differentiate;2S;1| (|x| $) (|spadConstant| $ 7)) - -(DEFUN |FFIELDC-;init;S;2| ($) (|spadConstant| $ 7)) - -(DEFUN |FFIELDC-;nextItem;SU;3| (|a| $) - (COND - ((SPADCALL - (LETT |a| - (SPADCALL (+ (SPADCALL |a| (|getShellEntry| $ 11)) 1) - (|getShellEntry| $ 12)) - |FFIELDC-;nextItem;SU;3|) - (|getShellEntry| $ 14)) - (CONS 1 "failed")) - ('T (CONS 0 |a|)))) - -(DEFUN |FFIELDC-;order;SOpc;4| (|e| $) - (SPADCALL (SPADCALL |e| (|getShellEntry| $ 17)) - (|getShellEntry| $ 20))) - -(DEFUN |FFIELDC-;conditionP;MU;5| (|mat| $) - (PROG (|l|) - (RETURN - (SEQ (LETT |l| (SPADCALL |mat| (|getShellEntry| $ 25)) - |FFIELDC-;conditionP;MU;5|) - (COND - ((OR (NULL |l|) - (SPADCALL (ELT $ 14) (|SPADfirst| |l|) - (|getShellEntry| $ 27))) - (EXIT (CONS 1 "failed")))) - (EXIT (CONS 0 - (SPADCALL (ELT $ 28) (|SPADfirst| |l|) - (|getShellEntry| $ 30)))))))) - -(DEFUN |FFIELDC-;charthRoot;2S;6| (|x| $) - (SPADCALL |x| - (QUOTIENT2 (SPADCALL (|getShellEntry| $ 36)) - (SPADCALL (|getShellEntry| $ 37))) - (|getShellEntry| $ 38))) - -(DEFUN |FFIELDC-;charthRoot;SU;7| (|x| $) - (CONS 0 (SPADCALL |x| (|getShellEntry| $ 28)))) - -(DEFUN |FFIELDC-;createPrimitiveElement;S;8| ($) - (PROG (|sm1| |start| |i| #0=#:G1441 |e| |found|) - (RETURN - (SEQ (LETT |sm1| (- (SPADCALL (|getShellEntry| $ 36)) 1) - |FFIELDC-;createPrimitiveElement;S;8|) - (LETT |start| - (COND - ((SPADCALL (SPADCALL (|getShellEntry| $ 43)) - (CONS 1 "polynomial") (|getShellEntry| $ 44)) - (SPADCALL (|getShellEntry| $ 37))) - ('T 1)) - |FFIELDC-;createPrimitiveElement;S;8|) - (LETT |found| 'NIL |FFIELDC-;createPrimitiveElement;S;8|) - (SEQ (LETT |i| |start| - |FFIELDC-;createPrimitiveElement;S;8|) - G190 - (COND - ((NULL (SPADCALL |found| (|getShellEntry| $ 45))) - (GO G191))) - (SEQ (LETT |e| - (SPADCALL - (PROG1 (LETT #0# |i| - |FFIELDC-;createPrimitiveElement;S;8|) - (|check-subtype| (> #0# 0) - '(|PositiveInteger|) #0#)) - (|getShellEntry| $ 12)) - |FFIELDC-;createPrimitiveElement;S;8|) - (EXIT (LETT |found| - (EQL (SPADCALL |e| - (|getShellEntry| $ 17)) - |sm1|) - |FFIELDC-;createPrimitiveElement;S;8|))) - (LETT |i| (+ |i| 1) - |FFIELDC-;createPrimitiveElement;S;8|) - (GO G190) G191 (EXIT NIL)) - (EXIT |e|))))) - -(DEFUN |FFIELDC-;primitive?;SB;9| (|a| $) - (PROG (|explist| |q| |exp| #0=#:G1453 |equalone|) - (RETURN - (SEQ (COND - ((SPADCALL |a| (|getShellEntry| $ 14)) 'NIL) - ('T - (SEQ (LETT |explist| (SPADCALL (|getShellEntry| $ 49)) - |FFIELDC-;primitive?;SB;9|) - (LETT |q| (- (SPADCALL (|getShellEntry| $ 36)) 1) - |FFIELDC-;primitive?;SB;9|) - (LETT |equalone| 'NIL |FFIELDC-;primitive?;SB;9|) - (SEQ (LETT |exp| NIL |FFIELDC-;primitive?;SB;9|) - (LETT #0# |explist| |FFIELDC-;primitive?;SB;9|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |exp| (CAR #0#) - |FFIELDC-;primitive?;SB;9|) - NIL) - (NULL (SPADCALL |equalone| - (|getShellEntry| $ 45)))) - (GO G191))) - (SEQ (EXIT (LETT |equalone| - (SPADCALL - (SPADCALL |a| - (QUOTIENT2 |q| (QCAR |exp|)) - (|getShellEntry| $ 50)) - (|spadConstant| $ 41) - (|getShellEntry| $ 51)) - |FFIELDC-;primitive?;SB;9|))) - (LETT #0# (CDR #0#) |FFIELDC-;primitive?;SB;9|) - (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |equalone| (|getShellEntry| $ 45)))))))))) - -(DEFUN |FFIELDC-;order;SPi;10| (|e| $) - (PROG (|lof| |rec| #0=#:G1461 |primeDivisor| |j| #1=#:G1462 |a| - |goon| |ord|) - (RETURN - (SEQ (COND - ((SPADCALL |e| (|spadConstant| $ 7) - (|getShellEntry| $ 51)) - (|error| "order(0) is not defined ")) - ('T - (SEQ (LETT |ord| (- (SPADCALL (|getShellEntry| $ 36)) 1) - |FFIELDC-;order;SPi;10|) - (LETT |a| 0 |FFIELDC-;order;SPi;10|) - (LETT |lof| (SPADCALL (|getShellEntry| $ 49)) - |FFIELDC-;order;SPi;10|) - (SEQ (LETT |rec| NIL |FFIELDC-;order;SPi;10|) - (LETT #0# |lof| |FFIELDC-;order;SPi;10|) G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |rec| (CAR #0#) - |FFIELDC-;order;SPi;10|) - NIL)) - (GO G191))) - (SEQ (LETT |a| - (QUOTIENT2 |ord| - (LETT |primeDivisor| (QCAR |rec|) - |FFIELDC-;order;SPi;10|)) - |FFIELDC-;order;SPi;10|) - (LETT |goon| - (SPADCALL - (SPADCALL |e| |a| - (|getShellEntry| $ 50)) - (|spadConstant| $ 41) - (|getShellEntry| $ 51)) - |FFIELDC-;order;SPi;10|) - (SEQ (LETT |j| 0 |FFIELDC-;order;SPi;10|) - (LETT #1# (- (QCDR |rec|) 2) - |FFIELDC-;order;SPi;10|) - G190 - (COND - ((OR (QSGREATERP |j| #1#) - (NULL |goon|)) - (GO G191))) - (SEQ (LETT |ord| |a| - |FFIELDC-;order;SPi;10|) - (LETT |a| - (QUOTIENT2 |ord| - |primeDivisor|) - |FFIELDC-;order;SPi;10|) - (EXIT - (LETT |goon| - (SPADCALL - (SPADCALL |e| |a| - (|getShellEntry| $ 50)) - (|spadConstant| $ 41) - (|getShellEntry| $ 51)) - |FFIELDC-;order;SPi;10|))) - (LETT |j| (QSADD1 |j|) - |FFIELDC-;order;SPi;10|) - (GO G190) G191 (EXIT NIL)) - (EXIT (COND - (|goon| - (LETT |ord| |a| - |FFIELDC-;order;SPi;10|))))) - (LETT #0# (CDR #0#) |FFIELDC-;order;SPi;10|) - (GO G190) G191 (EXIT NIL)) - (EXIT |ord|)))))))) - -(DEFUN |FFIELDC-;discreteLog;SNni;11| (|b| $) - (PROG (|faclist| |gen| |groupord| |f| #0=#:G1482 |fac| |t| #1=#:G1483 - |exp| |exptable| |n| |end| |i| |rho| |found| |disc1| |c| - |mult| |disclog| |a|) - (RETURN - (SEQ (COND - ((SPADCALL |b| (|getShellEntry| $ 14)) - (|error| "discreteLog: logarithm of zero")) - ('T - (SEQ (LETT |faclist| (SPADCALL (|getShellEntry| $ 49)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |a| |b| |FFIELDC-;discreteLog;SNni;11|) - (LETT |gen| (SPADCALL (|getShellEntry| $ 54)) - |FFIELDC-;discreteLog;SNni;11|) - (EXIT (COND - ((SPADCALL |b| |gen| (|getShellEntry| $ 51)) - 1) - ('T - (SEQ (LETT |disclog| 0 - |FFIELDC-;discreteLog;SNni;11|) - (LETT |mult| 1 - |FFIELDC-;discreteLog;SNni;11|) - (LETT |groupord| - (- - (SPADCALL - (|getShellEntry| $ 36)) - 1) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |exp| |groupord| - |FFIELDC-;discreteLog;SNni;11|) - (SEQ (LETT |f| NIL - |FFIELDC-;discreteLog;SNni;11|) - (LETT #0# |faclist| - |FFIELDC-;discreteLog;SNni;11|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |f| (CAR #0#) - |FFIELDC-;discreteLog;SNni;11|) - NIL)) - (GO G191))) - (SEQ - (LETT |fac| (QCAR |f|) - |FFIELDC-;discreteLog;SNni;11|) - (EXIT - (SEQ - (LETT |t| 0 - |FFIELDC-;discreteLog;SNni;11|) - (LETT #1# (- (QCDR |f|) 1) - |FFIELDC-;discreteLog;SNni;11|) - G190 - (COND - ((QSGREATERP |t| #1#) - (GO G191))) - (SEQ - (LETT |exp| - (QUOTIENT2 |exp| |fac|) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |exptable| - (SPADCALL |fac| - (|getShellEntry| $ 56)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |n| - (SPADCALL |exptable| - (|getShellEntry| $ 57)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |c| - (SPADCALL |a| |exp| - (|getShellEntry| $ 50)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |end| - (QUOTIENT2 (- |fac| 1) |n|) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |found| 'NIL - |FFIELDC-;discreteLog;SNni;11|) - (LETT |disc1| 0 - |FFIELDC-;discreteLog;SNni;11|) - (SEQ - (LETT |i| 0 - |FFIELDC-;discreteLog;SNni;11|) - G190 - (COND - ((OR - (QSGREATERP |i| |end|) - (NULL - (SPADCALL |found| - (|getShellEntry| $ 45)))) - (GO G191))) - (SEQ - (LETT |rho| - (SPADCALL - (SPADCALL |c| - (|getShellEntry| $ 11)) - |exptable| - (|getShellEntry| $ 59)) - |FFIELDC-;discreteLog;SNni;11|) - (EXIT - (COND - ((QEQCAR |rho| 0) - (SEQ - (LETT |found| 'T - |FFIELDC-;discreteLog;SNni;11|) - (EXIT - (LETT |disc1| - (* - (+ (* |n| |i|) - (QCDR |rho|)) - |mult|) - |FFIELDC-;discreteLog;SNni;11|)))) - ('T - (LETT |c| - (SPADCALL |c| - (SPADCALL |gen| - (* - (QUOTIENT2 - |groupord| |fac|) - (- |n|)) - (|getShellEntry| $ - 50)) - (|getShellEntry| $ - 60)) - |FFIELDC-;discreteLog;SNni;11|))))) - (LETT |i| (QSADD1 |i|) - |FFIELDC-;discreteLog;SNni;11|) - (GO G190) G191 (EXIT NIL)) - (EXIT - (COND - (|found| - (SEQ - (LETT |mult| - (* |mult| |fac|) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |disclog| - (+ |disclog| |disc1|) - |FFIELDC-;discreteLog;SNni;11|) - (EXIT - (LETT |a| - (SPADCALL |a| - (SPADCALL |gen| - (- |disc1|) - (|getShellEntry| $ - 50)) - (|getShellEntry| $ - 60)) - |FFIELDC-;discreteLog;SNni;11|)))) - ('T - (|error| - "discreteLog: ?? discrete logarithm"))))) - (LETT |t| (QSADD1 |t|) - |FFIELDC-;discreteLog;SNni;11|) - (GO G190) G191 (EXIT NIL)))) - (LETT #0# (CDR #0#) - |FFIELDC-;discreteLog;SNni;11|) - (GO G190) G191 (EXIT NIL)) - (EXIT |disclog|)))))))))))) - -(DEFUN |FFIELDC-;discreteLog;2SU;12| (|logbase| |b| $) - (PROG (|groupord| |faclist| |f| #0=#:G1501 |fac| |primroot| |t| - #1=#:G1502 |exp| |rhoHelp| #2=#:G1500 |rho| |disclog| - |mult| |a|) - (RETURN - (SEQ (EXIT (COND - ((SPADCALL |b| (|getShellEntry| $ 14)) - (SEQ (SPADCALL "discreteLog: logarithm of zero" - (|getShellEntry| $ 65)) - (EXIT (CONS 1 "failed")))) - ((SPADCALL |logbase| (|getShellEntry| $ 14)) - (SEQ (SPADCALL - "discreteLog: logarithm to base zero" - (|getShellEntry| $ 65)) - (EXIT (CONS 1 "failed")))) - ((SPADCALL |b| |logbase| (|getShellEntry| $ 51)) - (CONS 0 1)) - ('T - (COND - ((NULL (ZEROP (REMAINDER2 - (LETT |groupord| - (SPADCALL |logbase| - (|getShellEntry| $ 17)) - |FFIELDC-;discreteLog;2SU;12|) - (SPADCALL |b| - (|getShellEntry| $ 17))))) - (SEQ (SPADCALL - "discreteLog: second argument not in cyclic group generated by first argument" - (|getShellEntry| $ 65)) - (EXIT (CONS 1 "failed")))) - ('T - (SEQ (LETT |faclist| - (SPADCALL - (SPADCALL |groupord| - (|getShellEntry| $ 67)) - (|getShellEntry| $ 69)) - |FFIELDC-;discreteLog;2SU;12|) - (LETT |a| |b| - |FFIELDC-;discreteLog;2SU;12|) - (LETT |disclog| 0 - |FFIELDC-;discreteLog;2SU;12|) - (LETT |mult| 1 - |FFIELDC-;discreteLog;2SU;12|) - (LETT |exp| |groupord| - |FFIELDC-;discreteLog;2SU;12|) - (SEQ (LETT |f| NIL - |FFIELDC-;discreteLog;2SU;12|) - (LETT #0# |faclist| - |FFIELDC-;discreteLog;2SU;12|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |f| (CAR #0#) - |FFIELDC-;discreteLog;2SU;12|) - NIL)) - (GO G191))) - (SEQ (LETT |fac| (QCAR |f|) - |FFIELDC-;discreteLog;2SU;12|) - (LETT |primroot| - (SPADCALL |logbase| - (QUOTIENT2 |groupord| |fac|) - (|getShellEntry| $ 50)) - |FFIELDC-;discreteLog;2SU;12|) - (EXIT - (SEQ - (LETT |t| 0 - |FFIELDC-;discreteLog;2SU;12|) - (LETT #1# (- (QCDR |f|) 1) - |FFIELDC-;discreteLog;2SU;12|) - G190 - (COND - ((QSGREATERP |t| #1#) - (GO G191))) - (SEQ - (LETT |exp| - (QUOTIENT2 |exp| |fac|) - |FFIELDC-;discreteLog;2SU;12|) - (LETT |rhoHelp| - (SPADCALL |primroot| - (SPADCALL |a| |exp| - (|getShellEntry| $ 50)) - |fac| - (|getShellEntry| $ 71)) - |FFIELDC-;discreteLog;2SU;12|) - (EXIT - (COND - ((QEQCAR |rhoHelp| 1) - (PROGN - (LETT #2# - (CONS 1 "failed") - |FFIELDC-;discreteLog;2SU;12|) - (GO #2#))) - ('T - (SEQ - (LETT |rho| - (* (QCDR |rhoHelp|) - |mult|) - |FFIELDC-;discreteLog;2SU;12|) - (LETT |disclog| - (+ |disclog| |rho|) - |FFIELDC-;discreteLog;2SU;12|) - (LETT |mult| - (* |mult| |fac|) - |FFIELDC-;discreteLog;2SU;12|) - (EXIT - (LETT |a| - (SPADCALL |a| - (SPADCALL |logbase| - (- |rho|) - (|getShellEntry| $ - 50)) - (|getShellEntry| $ 60)) - |FFIELDC-;discreteLog;2SU;12|))))))) - (LETT |t| (QSADD1 |t|) - |FFIELDC-;discreteLog;2SU;12|) - (GO G190) G191 (EXIT NIL)))) - (LETT #0# (CDR #0#) - |FFIELDC-;discreteLog;2SU;12|) - (GO G190) G191 (EXIT NIL)) - (EXIT (CONS 0 |disclog|)))))))) - #2# (EXIT #2#))))) - -(DEFUN |FFIELDC-;squareFreePolynomial| (|f| $) - (SPADCALL |f| (|getShellEntry| $ 76))) - -(DEFUN |FFIELDC-;factorPolynomial| (|f| $) - (SPADCALL |f| (|getShellEntry| $ 78))) - -(DEFUN |FFIELDC-;factorSquareFreePolynomial| (|f| $) - (PROG (|flist| |u| #0=#:G1515 #1=#:G1512 #2=#:G1510 #3=#:G1511) - (RETURN - (SEQ (COND - ((SPADCALL |f| (|spadConstant| $ 79) - (|getShellEntry| $ 80)) - (|spadConstant| $ 81)) - ('T - (SEQ (LETT |flist| - (SPADCALL |f| 'T (|getShellEntry| $ 85)) - |FFIELDC-;factorSquareFreePolynomial|) - (EXIT (SPADCALL - (SPADCALL (QCAR |flist|) - (|getShellEntry| $ 86)) - (PROGN - (LETT #3# NIL - |FFIELDC-;factorSquareFreePolynomial|) - (SEQ (LETT |u| NIL - |FFIELDC-;factorSquareFreePolynomial|) - (LETT #0# (QCDR |flist|) - |FFIELDC-;factorSquareFreePolynomial|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |u| (CAR #0#) - |FFIELDC-;factorSquareFreePolynomial|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (PROGN - (LETT #1# - (SPADCALL (QCAR |u|) - (QCDR |u|) - (|getShellEntry| $ 87)) - |FFIELDC-;factorSquareFreePolynomial|) - (COND - (#3# - (LETT #2# - (SPADCALL #2# #1# - (|getShellEntry| $ 88)) - |FFIELDC-;factorSquareFreePolynomial|)) - ('T - (PROGN - (LETT #2# #1# - |FFIELDC-;factorSquareFreePolynomial|) - (LETT #3# 'T - |FFIELDC-;factorSquareFreePolynomial|))))))) - (LETT #0# (CDR #0#) - |FFIELDC-;factorSquareFreePolynomial|) - (GO G190) G191 (EXIT NIL)) - (COND - (#3# #2#) - ('T (|spadConstant| $ 89)))) - (|getShellEntry| $ 90)))))))))) - -(DEFUN |FFIELDC-;gcdPolynomial;3Sup;16| (|f| |g| $) - (SPADCALL |f| |g| (|getShellEntry| $ 92))) - -(DEFUN |FiniteFieldCategory&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|FiniteFieldCategory&|)) - (LETT |dv$| (LIST '|FiniteFieldCategory&| |dv$1|) . #0#) - (LETT $ (|newShell| 95) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 |#1|) - $)))) - -(MAKEPROP '|FiniteFieldCategory&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|) - |FFIELDC-;differentiate;2S;1| |FFIELDC-;init;S;2| - (|PositiveInteger|) (4 . |lookup|) (9 . |index|) - (|Boolean|) (14 . |zero?|) (|Union| $ '"failed") - |FFIELDC-;nextItem;SU;3| (19 . |order|) (|Integer|) - (|OnePointCompletion| 10) (24 . |coerce|) - |FFIELDC-;order;SOpc;4| (|Vector| 6) (|List| 22) - (|Matrix| 6) (29 . |nullSpace|) (|Mapping| 13 6) - (34 . |every?|) (40 . |charthRoot|) (|Mapping| 6 6) - (45 . |map|) (|Vector| $) (|Union| 31 '"failed") - (|Matrix| $) |FFIELDC-;conditionP;MU;5| - (|NonNegativeInteger|) (51 . |size|) - (55 . |characteristic|) (59 . **) - |FFIELDC-;charthRoot;2S;6| |FFIELDC-;charthRoot;SU;7| - (65 . |One|) - (|Union| '"prime" '"polynomial" '"normal" '"cyclic") - (69 . |representationType|) (73 . =) (79 . |not|) - |FFIELDC-;createPrimitiveElement;S;8| - (|Record| (|:| |factor| 18) (|:| |exponent| 18)) - (|List| 47) (84 . |factorsOfCyclicGroupSize|) (88 . **) - (94 . =) |FFIELDC-;primitive?;SB;9| - |FFIELDC-;order;SPi;10| (100 . |primitiveElement|) - (|Table| 10 35) (104 . |tableForDiscreteLogarithm|) - (109 . |#|) (|Union| 35 '"failed") (114 . |search|) - (120 . *) |FFIELDC-;discreteLog;SNni;11| (|Void|) - (|String|) (|OutputForm|) (126 . |messagePrint|) - (|Factored| $) (131 . |factor|) (|Factored| 18) - (136 . |factors|) (|DiscreteLogarithmPackage| 6) - (141 . |shanksDiscLogAlgorithm|) - |FFIELDC-;discreteLog;2SU;12| - (|SparseUnivariatePolynomial| 6) (|Factored| 73) - (|UnivariatePolynomialSquareFree| 6 73) - (148 . |squareFree|) (|DistinctDegreeFactorize| 6 73) - (153 . |factor|) (158 . |Zero|) (162 . =) (168 . |Zero|) - (|Record| (|:| |irr| 73) (|:| |pow| 18)) (|List| 82) - (|Record| (|:| |cont| 6) (|:| |factors| 83)) - (172 . |distdfact|) (178 . |coerce|) (183 . |primeFactor|) - (189 . *) (195 . |One|) (199 . *) (|EuclideanDomain&| 73) - (205 . |gcd|) (|SparseUnivariatePolynomial| $) - |FFIELDC-;gcdPolynomial;3Sup;16|) - '#(|primitive?| 211 |order| 216 |nextItem| 226 |init| 231 - |gcdPolynomial| 235 |discreteLog| 241 |differentiate| 252 - |createPrimitiveElement| 257 |conditionP| 261 |charthRoot| - 266) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 94 - '(0 6 0 7 1 6 10 0 11 1 6 0 10 12 1 6 - 13 0 14 1 6 10 0 17 1 19 0 18 20 1 24 - 23 0 25 2 22 13 26 0 27 1 6 0 0 28 2 - 22 0 29 0 30 0 6 35 36 0 6 35 37 2 6 - 0 0 35 38 0 6 0 41 0 6 42 43 2 42 13 - 0 0 44 1 13 0 0 45 0 6 48 49 2 6 0 0 - 18 50 2 6 13 0 0 51 0 6 0 54 1 6 55 - 18 56 1 55 35 0 57 2 55 58 10 0 59 2 - 6 0 0 0 60 1 64 62 63 65 1 18 66 0 67 - 1 68 48 0 69 3 70 58 6 6 35 71 1 75 - 74 73 76 1 77 74 73 78 0 73 0 79 2 73 - 13 0 0 80 0 74 0 81 2 77 84 73 13 85 - 1 73 0 6 86 2 74 0 73 18 87 2 74 0 0 - 0 88 0 74 0 89 2 74 0 73 0 90 2 91 0 - 0 0 92 1 0 13 0 52 1 0 10 0 53 1 0 19 - 0 21 1 0 15 0 16 0 0 0 9 2 0 93 93 93 - 94 1 0 35 0 61 2 0 58 0 0 72 1 0 0 0 - 8 0 0 0 46 1 0 32 33 34 1 0 0 0 39 1 - 0 15 0 40))))) - '|lookupComplete|)) -@ \section{package FFSLPE FiniteFieldSolveLinearPolynomialEquation} <<package FFSLPE FiniteFieldSolveLinearPolynomialEquation>>= )abbrev package FFSLPE FiniteFieldSolveLinearPolynomialEquation diff --git a/src/algebra/fraction.spad.pamphlet b/src/algebra/fraction.spad.pamphlet index bb9fbee4..6fd77e97 100644 --- a/src/algebra/fraction.spad.pamphlet +++ b/src/algebra/fraction.spad.pamphlet @@ -263,573 +263,7 @@ QuotientFieldCategory(S: IntegralDomain): Category == maxColIndex n), column(n, minColIndex n)] @ -\section{QFCAT.lsp BOOTSTRAP} -{\bf QFCAT} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf QFCAT} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf QFCAT.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<QFCAT.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |QuotientFieldCategory;CAT| 'NIL) - -(DEFPARAMETER |QuotientFieldCategory;AL| 'NIL) - -(DEFUN |QuotientFieldCategory| (#0=#:G1388) - (LET (#1=#:G1389) - (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#)))) - -(DEFUN |QuotientFieldCategory;| (|t#1|) - (PROG (#0=#:G1387) - (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#) - (SETELT #0# 0 - (LIST '|QuotientFieldCategory| (|devaluate| |t#1|))))))) -@ -\section{QFCAT-.lsp BOOTSTRAP} -{\bf QFCAT-} depends on {\bf QFCAT}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf QFCAT-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf QFCAT-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<QFCAT-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |QFCAT-;numerator;2A;1| (|x| $) - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) (|getShellEntry| $ 9))) - -(DEFUN |QFCAT-;denominator;2A;2| (|x| $) - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) - (|getShellEntry| $ 9))) - -(DEFUN |QFCAT-;init;A;3| ($) - (SPADCALL (|spadConstant| $ 13) (|spadConstant| $ 14) - (|getShellEntry| $ 15))) - -(DEFUN |QFCAT-;nextItem;AU;4| (|n| $) - (PROG (|m|) - (RETURN - (SEQ (LETT |m| - (SPADCALL (SPADCALL |n| (|getShellEntry| $ 8)) - (|getShellEntry| $ 18)) - |QFCAT-;nextItem;AU;4|) - (EXIT (COND - ((QEQCAR |m| 1) - (|error| "We seem to have a Fraction of a finite object")) - ('T - (CONS 0 - (SPADCALL (QCDR |m|) (|spadConstant| $ 14) - (|getShellEntry| $ 15)))))))))) - -(DEFUN |QFCAT-;map;M2A;5| (|fn| |x| $) - (SPADCALL (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) |fn|) - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) |fn|) - (|getShellEntry| $ 15))) - -(DEFUN |QFCAT-;reducedSystem;MM;6| (|m| $) - (SPADCALL |m| (|getShellEntry| $ 26))) - -(DEFUN |QFCAT-;characteristic;Nni;7| ($) - (SPADCALL (|getShellEntry| $ 30))) - -(DEFUN |QFCAT-;differentiate;AMA;8| (|x| |deriv| $) - (PROG (|n| |d|) - (RETURN - (SEQ (LETT |n| (SPADCALL |x| (|getShellEntry| $ 8)) - |QFCAT-;differentiate;AMA;8|) - (LETT |d| (SPADCALL |x| (|getShellEntry| $ 11)) - |QFCAT-;differentiate;AMA;8|) - (EXIT (SPADCALL - (SPADCALL - (SPADCALL (SPADCALL |n| |deriv|) |d| - (|getShellEntry| $ 32)) - (SPADCALL |n| (SPADCALL |d| |deriv|) - (|getShellEntry| $ 32)) - (|getShellEntry| $ 33)) - (SPADCALL |d| 2 (|getShellEntry| $ 35)) - (|getShellEntry| $ 15))))))) - -(DEFUN |QFCAT-;convert;AIf;9| (|x| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) - (|getShellEntry| $ 38)) - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) - (|getShellEntry| $ 38)) - (|getShellEntry| $ 39))) - -(DEFUN |QFCAT-;convert;AF;10| (|x| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) - (|getShellEntry| $ 42)) - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) - (|getShellEntry| $ 42)) - (|getShellEntry| $ 43))) - -(DEFUN |QFCAT-;convert;ADf;11| (|x| $) - (/ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) - (|getShellEntry| $ 46)) - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) - (|getShellEntry| $ 46)))) - -(DEFUN |QFCAT-;<;2AB;12| (|x| |y| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) - (SPADCALL |y| (|getShellEntry| $ 11)) (|getShellEntry| $ 32)) - (SPADCALL (SPADCALL |y| (|getShellEntry| $ 8)) - (SPADCALL |x| (|getShellEntry| $ 11)) (|getShellEntry| $ 32)) - (|getShellEntry| $ 49))) - -(DEFUN |QFCAT-;<;2AB;13| (|x| |y| $) - (PROG (|#G19| |#G20| |#G21| |#G22|) - (RETURN - (SEQ (COND - ((SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) - (|spadConstant| $ 51) (|getShellEntry| $ 49)) - (PROGN - (LETT |#G19| |y| |QFCAT-;<;2AB;13|) - (LETT |#G20| |x| |QFCAT-;<;2AB;13|) - (LETT |x| |#G19| |QFCAT-;<;2AB;13|) - (LETT |y| |#G20| |QFCAT-;<;2AB;13|)))) - (COND - ((SPADCALL (SPADCALL |y| (|getShellEntry| $ 11)) - (|spadConstant| $ 51) (|getShellEntry| $ 49)) - (PROGN - (LETT |#G21| |y| |QFCAT-;<;2AB;13|) - (LETT |#G22| |x| |QFCAT-;<;2AB;13|) - (LETT |x| |#G21| |QFCAT-;<;2AB;13|) - (LETT |y| |#G22| |QFCAT-;<;2AB;13|)))) - (EXIT (SPADCALL - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) - (SPADCALL |y| (|getShellEntry| $ 11)) - (|getShellEntry| $ 32)) - (SPADCALL (SPADCALL |y| (|getShellEntry| $ 8)) - (SPADCALL |x| (|getShellEntry| $ 11)) - (|getShellEntry| $ 32)) - (|getShellEntry| $ 49))))))) - -(DEFUN |QFCAT-;<;2AB;14| (|x| |y| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) - (SPADCALL |y| (|getShellEntry| $ 11)) (|getShellEntry| $ 32)) - (SPADCALL (SPADCALL |y| (|getShellEntry| $ 8)) - (SPADCALL |x| (|getShellEntry| $ 11)) (|getShellEntry| $ 32)) - (|getShellEntry| $ 49))) - -(DEFUN |QFCAT-;fractionPart;2A;15| (|x| $) - (SPADCALL |x| - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 52)) - (|getShellEntry| $ 9)) - (|getShellEntry| $ 53))) - -(DEFUN |QFCAT-;coerce;SA;16| (|s| $) - (SPADCALL (SPADCALL |s| (|getShellEntry| $ 56)) - (|getShellEntry| $ 9))) - -(DEFUN |QFCAT-;retract;AS;17| (|x| $) - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 58)) - (|getShellEntry| $ 59))) - -(DEFUN |QFCAT-;retractIfCan;AU;18| (|x| $) - (PROG (|r|) - (RETURN - (SEQ (LETT |r| (SPADCALL |x| (|getShellEntry| $ 62)) - |QFCAT-;retractIfCan;AU;18|) - (EXIT (COND - ((QEQCAR |r| 1) (CONS 1 "failed")) - ('T (SPADCALL (QCDR |r|) (|getShellEntry| $ 64))))))))) - -(DEFUN |QFCAT-;convert;AP;19| (|x| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) - (|getShellEntry| $ 68)) - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) - (|getShellEntry| $ 68)) - (|getShellEntry| $ 69))) - -(DEFUN |QFCAT-;patternMatch;AP2Pmr;20| (|x| |p| |l| $) - (SPADCALL |x| |p| |l| (|getShellEntry| $ 73))) - -(DEFUN |QFCAT-;convert;AP;21| (|x| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) - (|getShellEntry| $ 77)) - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) - (|getShellEntry| $ 77)) - (|getShellEntry| $ 78))) - -(DEFUN |QFCAT-;patternMatch;AP2Pmr;22| (|x| |p| |l| $) - (SPADCALL |x| |p| |l| (|getShellEntry| $ 82))) - -(DEFUN |QFCAT-;coerce;FA;23| (|x| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 86)) - (|getShellEntry| $ 87)) - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 88)) - (|getShellEntry| $ 87)) - (|getShellEntry| $ 89))) - -(DEFUN |QFCAT-;retract;AI;24| (|x| $) - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 58)) - (|getShellEntry| $ 91))) - -(DEFUN |QFCAT-;retractIfCan;AU;25| (|x| $) - (PROG (|u|) - (RETURN - (SEQ (LETT |u| (SPADCALL |x| (|getShellEntry| $ 62)) - |QFCAT-;retractIfCan;AU;25|) - (EXIT (COND - ((QEQCAR |u| 1) (CONS 1 "failed")) - ('T (SPADCALL (QCDR |u|) (|getShellEntry| $ 94))))))))) - -(DEFUN |QFCAT-;random;A;26| ($) - (PROG (|d|) - (RETURN - (SEQ (SEQ G190 - (COND - ((NULL (SPADCALL - (LETT |d| - (SPADCALL (|getShellEntry| $ 96)) - |QFCAT-;random;A;26|) - (|getShellEntry| $ 97))) - (GO G191))) - (SEQ (EXIT |d|)) NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL (SPADCALL (|getShellEntry| $ 96)) |d| - (|getShellEntry| $ 15))))))) - -(DEFUN |QFCAT-;reducedSystem;MVR;27| (|m| |v| $) - (PROG (|n|) - (RETURN - (SEQ (LETT |n| - (SPADCALL - (SPADCALL (SPADCALL |v| (|getShellEntry| $ 100)) - |m| (|getShellEntry| $ 101)) - (|getShellEntry| $ 102)) - |QFCAT-;reducedSystem;MVR;27|) - (EXIT (CONS (SPADCALL |n| - (SPADCALL |n| (|getShellEntry| $ 103)) - (SPADCALL |n| (|getShellEntry| $ 104)) - (+ 1 (SPADCALL |n| (|getShellEntry| $ 105))) - (SPADCALL |n| (|getShellEntry| $ 106)) - (|getShellEntry| $ 107)) - (SPADCALL |n| - (SPADCALL |n| (|getShellEntry| $ 105)) - (|getShellEntry| $ 109)))))))) - -(DEFUN |QuotientFieldCategory&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) - . #0=(|QuotientFieldCategory&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| - (LIST '|QuotientFieldCategory&| |dv$1| |dv$2|) . #0#) - (LETT $ (|newShell| 120) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasCategory| |#2| - '(|PolynomialFactorizationExplicit|)) - (|HasCategory| |#2| - '(|IntegerNumberSystem|)) - (|HasCategory| |#2| '(|EuclideanDomain|)) - (|HasCategory| |#2| - '(|RetractableTo| (|Symbol|))) - (|HasCategory| |#2| - '(|CharacteristicNonZero|)) - (|HasCategory| |#2| - '(|CharacteristicZero|)) - (|HasCategory| |#2| - '(|ConvertibleTo| (|InputForm|))) - (|HasCategory| |#2| '(|RealConstant|)) - (|HasCategory| |#2| - '(|OrderedIntegralDomain|)) - (|HasCategory| |#2| '(|OrderedSet|)) - (|HasCategory| |#2| - '(|RetractableTo| (|Integer|))) - (|HasCategory| |#2| '(|StepThrough|)))) . #0#)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 |#1|) - (|setShellEntry| $ 7 |#2|) - (COND - ((|testBitVector| |pv$| 12) - (PROGN - (|setShellEntry| $ 16 - (CONS (|dispatchFunction| |QFCAT-;init;A;3|) $)) - (|setShellEntry| $ 20 - (CONS (|dispatchFunction| |QFCAT-;nextItem;AU;4|) $))))) - (COND - ((|testBitVector| |pv$| 7) - (|setShellEntry| $ 40 - (CONS (|dispatchFunction| |QFCAT-;convert;AIf;9|) $)))) - (COND - ((|testBitVector| |pv$| 8) - (PROGN - (|setShellEntry| $ 44 - (CONS (|dispatchFunction| |QFCAT-;convert;AF;10|) $)) - (|setShellEntry| $ 47 - (CONS (|dispatchFunction| |QFCAT-;convert;ADf;11|) $))))) - (COND - ((|testBitVector| |pv$| 9) - (COND - ((|HasAttribute| |#2| '|canonicalUnitNormal|) - (|setShellEntry| $ 50 - (CONS (|dispatchFunction| |QFCAT-;<;2AB;12|) $))) - ('T - (|setShellEntry| $ 50 - (CONS (|dispatchFunction| |QFCAT-;<;2AB;13|) $))))) - ((|testBitVector| |pv$| 10) - (|setShellEntry| $ 50 - (CONS (|dispatchFunction| |QFCAT-;<;2AB;14|) $)))) - (COND - ((|testBitVector| |pv$| 3) - (|setShellEntry| $ 54 - (CONS (|dispatchFunction| |QFCAT-;fractionPart;2A;15|) - $)))) - (COND - ((|testBitVector| |pv$| 4) - (PROGN - (|setShellEntry| $ 57 - (CONS (|dispatchFunction| |QFCAT-;coerce;SA;16|) $)) - (|setShellEntry| $ 60 - (CONS (|dispatchFunction| |QFCAT-;retract;AS;17|) $)) - (|setShellEntry| $ 65 - (CONS (|dispatchFunction| |QFCAT-;retractIfCan;AU;18|) - $))))) - (COND - ((|HasCategory| |#2| - '(|ConvertibleTo| (|Pattern| (|Integer|)))) - (PROGN - (|setShellEntry| $ 70 - (CONS (|dispatchFunction| |QFCAT-;convert;AP;19|) $)) - (COND - ((|HasCategory| |#2| '(|PatternMatchable| (|Integer|))) - (|setShellEntry| $ 75 - (CONS (|dispatchFunction| - |QFCAT-;patternMatch;AP2Pmr;20|) - $))))))) - (COND - ((|HasCategory| |#2| - '(|ConvertibleTo| (|Pattern| (|Float|)))) - (PROGN - (|setShellEntry| $ 79 - (CONS (|dispatchFunction| |QFCAT-;convert;AP;21|) $)) - (COND - ((|HasCategory| |#2| '(|PatternMatchable| (|Float|))) - (|setShellEntry| $ 84 - (CONS (|dispatchFunction| - |QFCAT-;patternMatch;AP2Pmr;22|) - $))))))) - (COND - ((|testBitVector| |pv$| 11) - (PROGN - (|setShellEntry| $ 90 - (CONS (|dispatchFunction| |QFCAT-;coerce;FA;23|) $)) - (COND - ((|domainEqual| |#2| (|Integer|))) - ('T - (PROGN - (|setShellEntry| $ 92 - (CONS (|dispatchFunction| |QFCAT-;retract;AI;24|) - $)) - (|setShellEntry| $ 95 - (CONS (|dispatchFunction| - |QFCAT-;retractIfCan;AU;25|) - $)))))))) - (COND - ((|testBitVector| |pv$| 2) - (|setShellEntry| $ 98 - (CONS (|dispatchFunction| |QFCAT-;random;A;26|) $)))) - $)))) - -(MAKEPROP '|QuotientFieldCategory&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (0 . |numer|) (5 . |coerce|) |QFCAT-;numerator;2A;1| - (10 . |denom|) |QFCAT-;denominator;2A;2| (15 . |init|) - (19 . |One|) (23 . /) (29 . |init|) (|Union| $ '"failed") - (33 . |nextItem|) (38 . |One|) (42 . |nextItem|) - (|Mapping| 7 7) |QFCAT-;map;M2A;5| (|Matrix| 7) - (|Matrix| 6) (|MatrixCommonDenominator| 7 6) - (47 . |clearDenominator|) (|Matrix| $) - |QFCAT-;reducedSystem;MM;6| (|NonNegativeInteger|) - (52 . |characteristic|) |QFCAT-;characteristic;Nni;7| - (56 . *) (62 . -) (|PositiveInteger|) (68 . **) - |QFCAT-;differentiate;AMA;8| (|InputForm|) - (74 . |convert|) (79 . /) (85 . |convert|) (|Float|) - (90 . |convert|) (95 . /) (101 . |convert|) - (|DoubleFloat|) (106 . |convert|) (111 . |convert|) - (|Boolean|) (116 . <) (122 . <) (128 . |Zero|) - (132 . |wholePart|) (137 . -) (143 . |fractionPart|) - (|Symbol|) (148 . |coerce|) (153 . |coerce|) - (158 . |retract|) (163 . |retract|) (168 . |retract|) - (|Union| 7 '"failed") (173 . |retractIfCan|) - (|Union| 55 '"failed") (178 . |retractIfCan|) - (183 . |retractIfCan|) (|Integer|) (|Pattern| 66) - (188 . |convert|) (193 . /) (199 . |convert|) - (|PatternMatchResult| 66 6) - (|PatternMatchQuotientFieldCategory| 66 7 6) - (204 . |patternMatch|) (|PatternMatchResult| 66 $) - (211 . |patternMatch|) (|Pattern| 41) (218 . |convert|) - (223 . /) (229 . |convert|) (|PatternMatchResult| 41 6) - (|PatternMatchQuotientFieldCategory| 41 7 6) - (234 . |patternMatch|) (|PatternMatchResult| 41 $) - (241 . |patternMatch|) (|Fraction| 66) (248 . |numer|) - (253 . |coerce|) (258 . |denom|) (263 . /) - (269 . |coerce|) (274 . |retract|) (279 . |retract|) - (|Union| 66 '"failed") (284 . |retractIfCan|) - (289 . |retractIfCan|) (294 . |random|) (298 . |zero?|) - (303 . |random|) (|Vector| 6) (307 . |coerce|) - (312 . |horizConcat|) (318 . |reducedSystem|) - (323 . |minRowIndex|) (328 . |maxRowIndex|) - (333 . |minColIndex|) (338 . |maxColIndex|) - (343 . |subMatrix|) (|Vector| 7) (352 . |column|) - (|Record| (|:| |mat| 23) (|:| |vec| 108)) (|Vector| $) - |QFCAT-;reducedSystem;MVR;27| (|Union| 85 '"failed") - (|Matrix| 66) (|Vector| 66) - (|Record| (|:| |mat| 114) (|:| |vec| 115)) (|List| 55) - (|List| 29) (|OutputForm|)) - '#(|retractIfCan| 358 |retract| 368 |reducedSystem| 378 - |random| 389 |patternMatch| 393 |numerator| 407 |nextItem| - 412 |map| 417 |init| 423 |fractionPart| 427 - |differentiate| 432 |denominator| 438 |convert| 443 - |coerce| 468 |characteristic| 478 < 482) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 112 - '(1 6 7 0 8 1 6 0 7 9 1 6 7 0 11 0 7 0 - 13 0 7 0 14 2 6 0 7 7 15 0 0 0 16 1 7 - 17 0 18 0 6 0 19 1 0 17 0 20 1 25 23 - 24 26 0 7 29 30 2 7 0 0 0 32 2 7 0 0 - 0 33 2 7 0 0 34 35 1 7 37 0 38 2 37 0 - 0 0 39 1 0 37 0 40 1 7 41 0 42 2 41 0 - 0 0 43 1 0 41 0 44 1 7 45 0 46 1 0 45 - 0 47 2 7 48 0 0 49 2 0 48 0 0 50 0 7 - 0 51 1 6 7 0 52 2 6 0 0 0 53 1 0 0 0 - 54 1 7 0 55 56 1 0 0 55 57 1 6 7 0 58 - 1 7 55 0 59 1 0 55 0 60 1 6 61 0 62 1 - 7 63 0 64 1 0 63 0 65 1 7 67 0 68 2 - 67 0 0 0 69 1 0 67 0 70 3 72 71 6 67 - 71 73 3 0 74 0 67 74 75 1 7 76 0 77 2 - 76 0 0 0 78 1 0 76 0 79 3 81 80 6 76 - 80 82 3 0 83 0 76 83 84 1 85 66 0 86 - 1 6 0 66 87 1 85 66 0 88 2 6 0 0 0 89 - 1 0 0 85 90 1 7 66 0 91 1 0 66 0 92 1 - 7 93 0 94 1 0 93 0 95 0 7 0 96 1 7 48 - 0 97 0 0 0 98 1 24 0 99 100 2 24 0 0 - 0 101 1 6 23 27 102 1 23 66 0 103 1 - 23 66 0 104 1 23 66 0 105 1 23 66 0 - 106 5 23 0 0 66 66 66 66 107 2 23 108 - 0 66 109 1 0 93 0 95 1 0 63 0 65 1 0 - 66 0 92 1 0 55 0 60 2 0 110 27 111 - 112 1 0 23 27 28 0 0 0 98 3 0 83 0 76 - 83 84 3 0 74 0 67 74 75 1 0 0 0 10 1 - 0 17 0 20 2 0 0 21 0 22 0 0 0 16 1 0 - 0 0 54 2 0 0 0 21 36 1 0 0 0 12 1 0 - 45 0 47 1 0 37 0 40 1 0 41 0 44 1 0 - 67 0 70 1 0 76 0 79 1 0 0 55 57 1 0 0 - 85 90 0 0 29 31 2 0 48 0 0 50))))) - '|lookupComplete|)) -@ + \section{package QFCAT2 QuotientFieldCategoryFunctions2} diff --git a/src/algebra/fspace.spad.pamphlet b/src/algebra/fspace.spad.pamphlet index cec12f80..b5c57214 100644 --- a/src/algebra/fspace.spad.pamphlet +++ b/src/algebra/fspace.spad.pamphlet @@ -323,979 +323,7 @@ ExpressionSpace(): Category == Defn where and pred?(u::Integer) @ -\section{ES.lsp BOOTSTRAP} -{\bf ES} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ES} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ES.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<ES.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |ExpressionSpace;AL| 'NIL) - -(DEFUN |ExpressionSpace| () - (LET (#:G1400) - (COND - (|ExpressionSpace;AL|) - (T (SETQ |ExpressionSpace;AL| (|ExpressionSpace;|)))))) - -(DEFUN |ExpressionSpace;| () - (PROG (#0=#:G1398) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(#1=#:G1396 #2=#:G1397) - (LIST '(|Kernel| $) '(|Kernel| $))) - (|Join| (|OrderedSet|) (|RetractableTo| '#1#) - (|InnerEvalable| '#2# '$) - (|Evalable| '$) - (|mkCategory| '|domain| - '(((|elt| ($ (|BasicOperator|) $)) - T) - ((|elt| ($ (|BasicOperator|) $ $)) - T) - ((|elt| - ($ (|BasicOperator|) $ $ $)) - T) - ((|elt| - ($ (|BasicOperator|) $ $ $ $)) - T) - ((|elt| - ($ (|BasicOperator|) (|List| $))) - T) - ((|subst| ($ $ (|Equation| $))) T) - ((|subst| - ($ $ (|List| (|Equation| $)))) - T) - ((|subst| - ($ $ (|List| (|Kernel| $)) - (|List| $))) - T) - ((|box| ($ $)) T) - ((|box| ($ (|List| $))) T) - ((|paren| ($ $)) T) - ((|paren| ($ (|List| $))) T) - ((|distribute| ($ $)) T) - ((|distribute| ($ $ $)) T) - ((|height| - ((|NonNegativeInteger|) $)) - T) - ((|mainKernel| - ((|Union| (|Kernel| $) "failed") - $)) - T) - ((|kernels| - ((|List| (|Kernel| $)) $)) - T) - ((|tower| - ((|List| (|Kernel| $)) $)) - T) - ((|operators| - ((|List| (|BasicOperator|)) $)) - T) - ((|operator| - ((|BasicOperator|) - (|BasicOperator|))) - T) - ((|belong?| - ((|Boolean|) (|BasicOperator|))) - T) - ((|is?| - ((|Boolean|) $ - (|BasicOperator|))) - T) - ((|is?| - ((|Boolean|) $ (|Symbol|))) - T) - ((|kernel| - ($ (|BasicOperator|) $)) - T) - ((|kernel| - ($ (|BasicOperator|) (|List| $))) - T) - ((|map| - ($ (|Mapping| $ $) (|Kernel| $))) - T) - ((|freeOf?| ((|Boolean|) $ $)) T) - ((|freeOf?| - ((|Boolean|) $ (|Symbol|))) - T) - ((|eval| - ($ $ (|List| (|Symbol|)) - (|List| (|Mapping| $ $)))) - T) - ((|eval| - ($ $ (|List| (|Symbol|)) - (|List| - (|Mapping| $ (|List| $))))) - T) - ((|eval| - ($ $ (|Symbol|) - (|Mapping| $ (|List| $)))) - T) - ((|eval| - ($ $ (|Symbol|) (|Mapping| $ $))) - T) - ((|eval| - ($ $ (|List| (|BasicOperator|)) - (|List| (|Mapping| $ $)))) - T) - ((|eval| - ($ $ (|List| (|BasicOperator|)) - (|List| - (|Mapping| $ (|List| $))))) - T) - ((|eval| - ($ $ (|BasicOperator|) - (|Mapping| $ (|List| $)))) - T) - ((|eval| - ($ $ (|BasicOperator|) - (|Mapping| $ $))) - T) - ((|minPoly| - ((|SparseUnivariatePolynomial| - $) - (|Kernel| $))) - (|has| $ (|Ring|))) - ((|definingPolynomial| ($ $)) - (|has| $ (|Ring|))) - ((|even?| ((|Boolean|) $)) - (|has| $ - (|RetractableTo| (|Integer|)))) - ((|odd?| ((|Boolean|) $)) - (|has| $ - (|RetractableTo| (|Integer|))))) - NIL - '((|Boolean|) - (|SparseUnivariatePolynomial| $) - (|Kernel| $) (|BasicOperator|) - (|List| (|BasicOperator|)) - (|List| (|Mapping| $ (|List| $))) - (|List| (|Mapping| $ $)) - (|Symbol|) (|List| (|Symbol|)) - (|List| $) (|List| (|Kernel| $)) - (|NonNegativeInteger|) - (|List| (|Equation| $)) - (|Equation| $)) - NIL))) - |ExpressionSpace|) - (SETELT #0# 0 '(|ExpressionSpace|)))))) - -(MAKEPROP '|ExpressionSpace| 'NILADIC T) -@ -\section{ES-.lsp BOOTSTRAP} -{\bf ES-} depends on {\bf ES}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ES-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ES-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<ES-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |ES-;box;2S;1| (|x| $) - (SPADCALL (LIST |x|) (|getShellEntry| $ 16))) - -(DEFUN |ES-;paren;2S;2| (|x| $) - (SPADCALL (LIST |x|) (|getShellEntry| $ 18))) - -(DEFUN |ES-;belong?;BoB;3| (|op| $) - (COND - ((SPADCALL |op| (|getShellEntry| $ 13) (|getShellEntry| $ 21)) 'T) - ('T (SPADCALL |op| (|getShellEntry| $ 14) (|getShellEntry| $ 21))))) - -(DEFUN |ES-;listk| (|f| $) - (SPADCALL (|ES-;allKernels| |f| $) (|getShellEntry| $ 26))) - -(DEFUN |ES-;tower;SL;5| (|f| $) - (SPADCALL (|ES-;listk| |f| $) (|getShellEntry| $ 27))) - -(DEFUN |ES-;allk| (|l| $) - (PROG (#0=#:G1419 |f| #1=#:G1420) - (RETURN - (SEQ (SPADCALL (ELT $ 32) - (PROGN - (LETT #0# NIL |ES-;allk|) - (SEQ (LETT |f| NIL |ES-;allk|) - (LETT #1# |l| |ES-;allk|) G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |f| (CAR #1#) |ES-;allk|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS (|ES-;allKernels| |f| $) - #0#) - |ES-;allk|))) - (LETT #1# (CDR #1#) |ES-;allk|) (GO G190) G191 - (EXIT (NREVERSE0 #0#)))) - (SPADCALL NIL (|getShellEntry| $ 31)) - (|getShellEntry| $ 35)))))) - -(DEFUN |ES-;operators;SL;7| (|f| $) - (PROG (#0=#:G1423 |k| #1=#:G1424) - (RETURN - (SEQ (PROGN - (LETT #0# NIL |ES-;operators;SL;7|) - (SEQ (LETT |k| NIL |ES-;operators;SL;7|) - (LETT #1# (|ES-;listk| |f| $) |ES-;operators;SL;7|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |k| (CAR #1#) |ES-;operators;SL;7|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (SPADCALL |k| - (|getShellEntry| $ 36)) - #0#) - |ES-;operators;SL;7|))) - (LETT #1# (CDR #1#) |ES-;operators;SL;7|) (GO G190) - G191 (EXIT (NREVERSE0 #0#)))))))) - -(DEFUN |ES-;height;SNni;8| (|f| $) - (PROG (#0=#:G1429 |k| #1=#:G1430) - (RETURN - (SEQ (SPADCALL (ELT $ 42) - (PROGN - (LETT #0# NIL |ES-;height;SNni;8|) - (SEQ (LETT |k| NIL |ES-;height;SNni;8|) - (LETT #1# (SPADCALL |f| (|getShellEntry| $ 39)) - |ES-;height;SNni;8|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |k| (CAR #1#) |ES-;height;SNni;8|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (SPADCALL |k| - (|getShellEntry| $ 41)) - #0#) - |ES-;height;SNni;8|))) - (LETT #1# (CDR #1#) |ES-;height;SNni;8|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - 0 (|getShellEntry| $ 45)))))) - -(DEFUN |ES-;freeOf?;SSB;9| (|x| |s| $) - (PROG (#0=#:G1434 |k| #1=#:G1435) - (RETURN - (SEQ (SPADCALL - (SPADCALL |s| - (PROGN - (LETT #0# NIL |ES-;freeOf?;SSB;9|) - (SEQ (LETT |k| NIL |ES-;freeOf?;SSB;9|) - (LETT #1# (|ES-;listk| |x| $) - |ES-;freeOf?;SSB;9|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |k| (CAR #1#) - |ES-;freeOf?;SSB;9|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (SPADCALL |k| - (|getShellEntry| $ 47)) - #0#) - |ES-;freeOf?;SSB;9|))) - (LETT #1# (CDR #1#) |ES-;freeOf?;SSB;9|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - (|getShellEntry| $ 49)) - (|getShellEntry| $ 50)))))) - -(DEFUN |ES-;distribute;2S;10| (|x| $) - (PROG (#0=#:G1438 |k| #1=#:G1439) - (RETURN - (SEQ (|ES-;unwrap| - (PROGN - (LETT #0# NIL |ES-;distribute;2S;10|) - (SEQ (LETT |k| NIL |ES-;distribute;2S;10|) - (LETT #1# (|ES-;listk| |x| $) - |ES-;distribute;2S;10|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |k| (CAR #1#) - |ES-;distribute;2S;10|) - NIL)) - (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL |k| - (|getShellEntry| $ 13) - (|getShellEntry| $ 52)) - (LETT #0# (CONS |k| #0#) - |ES-;distribute;2S;10|))))) - (LETT #1# (CDR #1#) |ES-;distribute;2S;10|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - |x| $))))) - -(DEFUN |ES-;box;LS;11| (|l| $) - (SPADCALL (|getShellEntry| $ 14) |l| (|getShellEntry| $ 54))) - -(DEFUN |ES-;paren;LS;12| (|l| $) - (SPADCALL (|getShellEntry| $ 13) |l| (|getShellEntry| $ 54))) - -(DEFUN |ES-;freeOf?;2SB;13| (|x| |k| $) - (SPADCALL - (SPADCALL (SPADCALL |k| (|getShellEntry| $ 57)) - (|ES-;listk| |x| $) (|getShellEntry| $ 58)) - (|getShellEntry| $ 50))) - -(DEFUN |ES-;kernel;Bo2S;14| (|op| |arg| $) - (SPADCALL |op| (LIST |arg|) (|getShellEntry| $ 60))) - -(DEFUN |ES-;elt;Bo2S;15| (|op| |x| $) - (SPADCALL |op| (LIST |x|) (|getShellEntry| $ 54))) - -(DEFUN |ES-;elt;Bo3S;16| (|op| |x| |y| $) - (SPADCALL |op| (LIST |x| |y|) (|getShellEntry| $ 54))) - -(DEFUN |ES-;elt;Bo4S;17| (|op| |x| |y| |z| $) - (SPADCALL |op| (LIST |x| |y| |z|) (|getShellEntry| $ 54))) - -(DEFUN |ES-;elt;Bo5S;18| (|op| |x| |y| |z| |t| $) - (SPADCALL |op| (LIST |x| |y| |z| |t|) (|getShellEntry| $ 54))) - -(DEFUN |ES-;eval;SSMS;19| (|x| |s| |f| $) - (SPADCALL |x| (LIST |s|) (LIST |f|) (|getShellEntry| $ 68))) - -(DEFUN |ES-;eval;SBoMS;20| (|x| |s| |f| $) - (SPADCALL |x| (LIST (SPADCALL |s| (|getShellEntry| $ 70))) (LIST |f|) - (|getShellEntry| $ 68))) - -(DEFUN |ES-;eval;SSMS;21| (|x| |s| |f| $) - (SPADCALL |x| (LIST |s|) - (LIST (CONS #'|ES-;eval;SSMS;21!0| (VECTOR |f| $))) - (|getShellEntry| $ 68))) - -(DEFUN |ES-;eval;SSMS;21!0| (|#1| $$) - (SPADCALL (SPADCALL |#1| (|getShellEntry| (|getShellEntry| $$ 1) 73)) - (|getShellEntry| $$ 0))) - -(DEFUN |ES-;eval;SBoMS;22| (|x| |s| |f| $) - (SPADCALL |x| (LIST |s|) - (LIST (CONS #'|ES-;eval;SBoMS;22!0| (VECTOR |f| $))) - (|getShellEntry| $ 76))) - -(DEFUN |ES-;eval;SBoMS;22!0| (|#1| $$) - (SPADCALL (SPADCALL |#1| (|getShellEntry| (|getShellEntry| $$ 1) 73)) - (|getShellEntry| $$ 0))) - -(DEFUN |ES-;subst;SES;23| (|x| |e| $) - (SPADCALL |x| (LIST |e|) (|getShellEntry| $ 80))) - -(DEFUN |ES-;eval;SLLS;24| (|x| |ls| |lf| $) - (PROG (#0=#:G1459 |f| #1=#:G1460) - (RETURN - (SEQ (SPADCALL |x| |ls| - (PROGN - (LETT #0# NIL |ES-;eval;SLLS;24|) - (SEQ (LETT |f| NIL |ES-;eval;SLLS;24|) - (LETT #1# |lf| |ES-;eval;SLLS;24|) G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |f| (CAR #1#) |ES-;eval;SLLS;24|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (CONS #'|ES-;eval;SLLS;24!0| - (VECTOR |f| $)) - #0#) - |ES-;eval;SLLS;24|))) - (LETT #1# (CDR #1#) |ES-;eval;SLLS;24|) (GO G190) - G191 (EXIT (NREVERSE0 #0#)))) - (|getShellEntry| $ 76)))))) - -(DEFUN |ES-;eval;SLLS;24!0| (|#1| $$) - (SPADCALL (SPADCALL |#1| (|getShellEntry| (|getShellEntry| $$ 1) 73)) - (|getShellEntry| $$ 0))) - -(DEFUN |ES-;eval;SLLS;25| (|x| |ls| |lf| $) - (PROG (#0=#:G1463 |f| #1=#:G1464) - (RETURN - (SEQ (SPADCALL |x| |ls| - (PROGN - (LETT #0# NIL |ES-;eval;SLLS;25|) - (SEQ (LETT |f| NIL |ES-;eval;SLLS;25|) - (LETT #1# |lf| |ES-;eval;SLLS;25|) G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |f| (CAR #1#) |ES-;eval;SLLS;25|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (CONS #'|ES-;eval;SLLS;25!0| - (VECTOR |f| $)) - #0#) - |ES-;eval;SLLS;25|))) - (LETT #1# (CDR #1#) |ES-;eval;SLLS;25|) (GO G190) - G191 (EXIT (NREVERSE0 #0#)))) - (|getShellEntry| $ 68)))))) - -(DEFUN |ES-;eval;SLLS;25!0| (|#1| $$) - (SPADCALL (SPADCALL |#1| (|getShellEntry| (|getShellEntry| $$ 1) 73)) - (|getShellEntry| $$ 0))) - -(DEFUN |ES-;eval;SLLS;26| (|x| |ls| |lf| $) - (PROG (#0=#:G1468 |s| #1=#:G1469) - (RETURN - (SEQ (SPADCALL |x| - (PROGN - (LETT #0# NIL |ES-;eval;SLLS;26|) - (SEQ (LETT |s| NIL |ES-;eval;SLLS;26|) - (LETT #1# |ls| |ES-;eval;SLLS;26|) G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |s| (CAR #1#) |ES-;eval;SLLS;26|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (SPADCALL |s| - (|getShellEntry| $ 70)) - #0#) - |ES-;eval;SLLS;26|))) - (LETT #1# (CDR #1#) |ES-;eval;SLLS;26|) (GO G190) - G191 (EXIT (NREVERSE0 #0#)))) - |lf| (|getShellEntry| $ 68)))))) - -(DEFUN |ES-;map;MKS;27| (|fn| |k| $) - (PROG (#0=#:G1484 |x| #1=#:G1485 |l|) - (RETURN - (SEQ (COND - ((SPADCALL - (LETT |l| - (PROGN - (LETT #0# NIL |ES-;map;MKS;27|) - (SEQ (LETT |x| NIL |ES-;map;MKS;27|) - (LETT #1# - (SPADCALL |k| - (|getShellEntry| $ 86)) - |ES-;map;MKS;27|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |x| (CAR #1#) - |ES-;map;MKS;27|) - NIL)) - (GO G191))) - (SEQ (EXIT - (LETT #0# - (CONS (SPADCALL |x| |fn|) #0#) - |ES-;map;MKS;27|))) - (LETT #1# (CDR #1#) |ES-;map;MKS;27|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - |ES-;map;MKS;27|) - (SPADCALL |k| (|getShellEntry| $ 86)) - (|getShellEntry| $ 87)) - (SPADCALL |k| (|getShellEntry| $ 88))) - ('T - (SPADCALL (SPADCALL |k| (|getShellEntry| $ 36)) |l| - (|getShellEntry| $ 54)))))))) - -(DEFUN |ES-;operator;2Bo;28| (|op| $) - (COND - ((SPADCALL |op| (SPADCALL "%paren" (|getShellEntry| $ 9)) - (|getShellEntry| $ 90)) - (|getShellEntry| $ 13)) - ((SPADCALL |op| (SPADCALL "%box" (|getShellEntry| $ 9)) - (|getShellEntry| $ 90)) - (|getShellEntry| $ 14)) - ('T (|error| "Unknown operator")))) - -(DEFUN |ES-;mainKernel;SU;29| (|x| $) - (PROG (|l| |kk| #0=#:G1501 |n| |k|) - (RETURN - (SEQ (COND - ((NULL (LETT |l| (SPADCALL |x| (|getShellEntry| $ 39)) - |ES-;mainKernel;SU;29|)) - (CONS 1 "failed")) - ('T - (SEQ (LETT |n| - (SPADCALL - (LETT |k| (|SPADfirst| |l|) - |ES-;mainKernel;SU;29|) - (|getShellEntry| $ 41)) - |ES-;mainKernel;SU;29|) - (SEQ (LETT |kk| NIL |ES-;mainKernel;SU;29|) - (LETT #0# (CDR |l|) |ES-;mainKernel;SU;29|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |kk| (CAR #0#) - |ES-;mainKernel;SU;29|) - NIL)) - (GO G191))) - (SEQ (EXIT (COND - ((< |n| - (SPADCALL |kk| - (|getShellEntry| $ 41))) - (SEQ - (LETT |n| - (SPADCALL |kk| - (|getShellEntry| $ 41)) - |ES-;mainKernel;SU;29|) - (EXIT - (LETT |k| |kk| - |ES-;mainKernel;SU;29|))))))) - (LETT #0# (CDR #0#) |ES-;mainKernel;SU;29|) - (GO G190) G191 (EXIT NIL)) - (EXIT (CONS 0 |k|))))))))) - -(DEFUN |ES-;allKernels| (|f| $) - (PROG (|l| |k| #0=#:G1514 |u| |s0| |n| |arg| |t| |s|) - (RETURN - (SEQ (LETT |s| - (SPADCALL - (LETT |l| (SPADCALL |f| (|getShellEntry| $ 39)) - |ES-;allKernels|) - (|getShellEntry| $ 31)) - |ES-;allKernels|) - (SEQ (LETT |k| NIL |ES-;allKernels|) - (LETT #0# |l| |ES-;allKernels|) G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |k| (CAR #0#) |ES-;allKernels|) - NIL)) - (GO G191))) - (SEQ (LETT |t| - (SEQ (LETT |u| - (SPADCALL - (SPADCALL |k| - (|getShellEntry| $ 36)) - "%dummyVar" - (|getShellEntry| $ 96)) - |ES-;allKernels|) - (EXIT (COND - ((QEQCAR |u| 0) - (SEQ - (LETT |arg| - (SPADCALL |k| - (|getShellEntry| $ 86)) - |ES-;allKernels|) - (LETT |s0| - (SPADCALL - (SPADCALL - (SPADCALL |arg| - (|getShellEntry| $ 97)) - (|getShellEntry| $ 57)) - (|ES-;allKernels| - (|SPADfirst| |arg|) $) - (|getShellEntry| $ 98)) - |ES-;allKernels|) - (LETT |arg| (CDR (CDR |arg|)) - |ES-;allKernels|) - (LETT |n| (QCDR |u|) - |ES-;allKernels|) - (COND - ((< 1 |n|) - (LETT |arg| (CDR |arg|) - |ES-;allKernels|))) - (EXIT - (SPADCALL |s0| - (|ES-;allk| |arg| $) - (|getShellEntry| $ 32))))) - ('T - (|ES-;allk| - (SPADCALL |k| - (|getShellEntry| $ 86)) - $))))) - |ES-;allKernels|) - (EXIT (LETT |s| - (SPADCALL |s| |t| - (|getShellEntry| $ 32)) - |ES-;allKernels|))) - (LETT #0# (CDR #0#) |ES-;allKernels|) (GO G190) G191 - (EXIT NIL)) - (EXIT |s|))))) - -(DEFUN |ES-;kernel;BoLS;31| (|op| |args| $) - (COND - ((NULL (SPADCALL |op| (|getShellEntry| $ 99))) - (|error| "Unknown operator")) - ('T (|ES-;okkernel| |op| |args| $)))) - -(DEFUN |ES-;okkernel| (|op| |l| $) - (PROG (#0=#:G1521 |f| #1=#:G1522) - (RETURN - (SEQ (SPADCALL - (SPADCALL |op| |l| - (+ 1 - (SPADCALL (ELT $ 42) - (PROGN - (LETT #0# NIL |ES-;okkernel|) - (SEQ (LETT |f| NIL |ES-;okkernel|) - (LETT #1# |l| |ES-;okkernel|) G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |f| (CAR #1#) - |ES-;okkernel|) - NIL)) - (GO G191))) - (SEQ (EXIT - (LETT #0# - (CONS - (SPADCALL |f| - (|getShellEntry| $ 101)) - #0#) - |ES-;okkernel|))) - (LETT #1# (CDR #1#) |ES-;okkernel|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - 0 (|getShellEntry| $ 45))) - (|getShellEntry| $ 102)) - (|getShellEntry| $ 88)))))) - -(DEFUN |ES-;elt;BoLS;33| (|op| |args| $) - (PROG (|u| #0=#:G1538 |v|) - (RETURN - (SEQ (EXIT (COND - ((NULL (SPADCALL |op| (|getShellEntry| $ 99))) - (|error| "Unknown operator")) - ('T - (SEQ (SEQ (LETT |u| - (SPADCALL |op| - (|getShellEntry| $ 104)) - |ES-;elt;BoLS;33|) - (EXIT (COND - ((QEQCAR |u| 0) - (COND - ((SPADCALL (LENGTH |args|) - (QCDR |u|) - (|getShellEntry| $ 105)) - (PROGN - (LETT #0# - (|error| - "Wrong number of arguments") - |ES-;elt;BoLS;33|) - (GO #0#)))))))) - (LETT |v| - (SPADCALL |op| |args| - (|getShellEntry| $ 108)) - |ES-;elt;BoLS;33|) - (EXIT (COND - ((QEQCAR |v| 0) (QCDR |v|)) - ('T (|ES-;okkernel| |op| |args| $)))))))) - #0# (EXIT #0#))))) - -(DEFUN |ES-;retract;SK;34| (|f| $) - (PROG (|k|) - (RETURN - (SEQ (LETT |k| (SPADCALL |f| (|getShellEntry| $ 110)) - |ES-;retract;SK;34|) - (EXIT (COND - ((OR (QEQCAR |k| 1) - (SPADCALL - (SPADCALL (QCDR |k|) - (|getShellEntry| $ 88)) - |f| (|getShellEntry| $ 111))) - (|error| "not a kernel")) - ('T (QCDR |k|)))))))) - -(DEFUN |ES-;retractIfCan;SU;35| (|f| $) - (PROG (|k|) - (RETURN - (SEQ (LETT |k| (SPADCALL |f| (|getShellEntry| $ 110)) - |ES-;retractIfCan;SU;35|) - (EXIT (COND - ((OR (QEQCAR |k| 1) - (SPADCALL - (SPADCALL (QCDR |k|) - (|getShellEntry| $ 88)) - |f| (|getShellEntry| $ 111))) - (CONS 1 "failed")) - ('T |k|))))))) - -(DEFUN |ES-;is?;SSB;36| (|f| |s| $) - (PROG (|k|) - (RETURN - (SEQ (LETT |k| (SPADCALL |f| (|getShellEntry| $ 114)) - |ES-;is?;SSB;36|) - (EXIT (COND - ((QEQCAR |k| 1) 'NIL) - ('T - (SPADCALL (QCDR |k|) |s| (|getShellEntry| $ 115))))))))) - -(DEFUN |ES-;is?;SBoB;37| (|f| |op| $) - (PROG (|k|) - (RETURN - (SEQ (LETT |k| (SPADCALL |f| (|getShellEntry| $ 114)) - |ES-;is?;SBoB;37|) - (EXIT (COND - ((QEQCAR |k| 1) 'NIL) - ('T - (SPADCALL (QCDR |k|) |op| (|getShellEntry| $ 52))))))))) - -(DEFUN |ES-;unwrap| (|l| |x| $) - (PROG (|k| #0=#:G1565) - (RETURN - (SEQ (SEQ (LETT |k| NIL |ES-;unwrap|) - (LETT #0# (NREVERSE |l|) |ES-;unwrap|) G190 - (COND - ((OR (ATOM #0#) - (PROGN (LETT |k| (CAR #0#) |ES-;unwrap|) NIL)) - (GO G191))) - (SEQ (EXIT (LETT |x| - (SPADCALL |x| |k| - (|SPADfirst| - (SPADCALL |k| - (|getShellEntry| $ 86))) - (|getShellEntry| $ 118)) - |ES-;unwrap|))) - (LETT #0# (CDR #0#) |ES-;unwrap|) (GO G190) G191 - (EXIT NIL)) - (EXIT |x|))))) - -(DEFUN |ES-;distribute;3S;39| (|x| |y| $) - (PROG (|ky| #0=#:G1570 |k| #1=#:G1571) - (RETURN - (SEQ (LETT |ky| (SPADCALL |y| (|getShellEntry| $ 57)) - |ES-;distribute;3S;39|) - (EXIT (|ES-;unwrap| - (PROGN - (LETT #0# NIL |ES-;distribute;3S;39|) - (SEQ (LETT |k| NIL |ES-;distribute;3S;39|) - (LETT #1# (|ES-;listk| |x| $) - |ES-;distribute;3S;39|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |k| (CAR #1#) - |ES-;distribute;3S;39|) - NIL)) - (GO G191))) - (SEQ (EXIT (COND - ((COND - ((SPADCALL |k| - (SPADCALL "%paren" - (|getShellEntry| $ 9)) - (|getShellEntry| $ 115)) - (SPADCALL |ky| - (|ES-;listk| - (SPADCALL |k| - (|getShellEntry| $ 88)) - $) - (|getShellEntry| $ 58))) - ('T 'NIL)) - (LETT #0# (CONS |k| #0#) - |ES-;distribute;3S;39|))))) - (LETT #1# (CDR #1#) |ES-;distribute;3S;39|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - |x| $)))))) - -(DEFUN |ES-;eval;SLS;40| (|f| |leq| $) - (PROG (|rec|) - (RETURN - (SEQ (LETT |rec| (|ES-;mkKerLists| |leq| $) |ES-;eval;SLS;40|) - (EXIT (SPADCALL |f| (QCAR |rec|) (QCDR |rec|) - (|getShellEntry| $ 120))))))) - -(DEFUN |ES-;subst;SLS;41| (|f| |leq| $) - (PROG (|rec|) - (RETURN - (SEQ (LETT |rec| (|ES-;mkKerLists| |leq| $) |ES-;subst;SLS;41|) - (EXIT (SPADCALL |f| (QCAR |rec|) (QCDR |rec|) - (|getShellEntry| $ 122))))))) - -(DEFUN |ES-;mkKerLists| (|leq| $) - (PROG (|eq| #0=#:G1588 |k| |lk| |lv|) - (RETURN - (SEQ (LETT |lk| NIL |ES-;mkKerLists|) - (LETT |lv| NIL |ES-;mkKerLists|) - (SEQ (LETT |eq| NIL |ES-;mkKerLists|) - (LETT #0# |leq| |ES-;mkKerLists|) G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |eq| (CAR #0#) |ES-;mkKerLists|) - NIL)) - (GO G191))) - (SEQ (LETT |k| - (SPADCALL - (SPADCALL |eq| (|getShellEntry| $ 125)) - (|getShellEntry| $ 114)) - |ES-;mkKerLists|) - (EXIT (COND - ((QEQCAR |k| 1) - (|error| "left hand side must be a single kernel")) - ((NULL (SPADCALL (QCDR |k|) |lk| - (|getShellEntry| $ 58))) - (SEQ (LETT |lk| (CONS (QCDR |k|) |lk|) - |ES-;mkKerLists|) - (EXIT - (LETT |lv| - (CONS - (SPADCALL |eq| - (|getShellEntry| $ 126)) - |lv|) - |ES-;mkKerLists|))))))) - (LETT #0# (CDR #0#) |ES-;mkKerLists|) (GO G190) G191 - (EXIT NIL)) - (EXIT (CONS |lk| |lv|)))))) - -(DEFUN |ES-;even?;SB;43| (|x| $) (|ES-;intpred?| |x| (ELT $ 128) $)) - -(DEFUN |ES-;odd?;SB;44| (|x| $) (|ES-;intpred?| |x| (ELT $ 130) $)) - -(DEFUN |ES-;intpred?| (|x| |pred?| $) - (PROG (|u|) - (RETURN - (SEQ (LETT |u| (SPADCALL |x| (|getShellEntry| $ 133)) - |ES-;intpred?|) - (EXIT (COND - ((QEQCAR |u| 0) (SPADCALL (QCDR |u|) |pred?|)) - ('T 'NIL))))))) - -(DEFUN |ExpressionSpace&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|ExpressionSpace&|)) - (LETT |dv$| (LIST '|ExpressionSpace&| |dv$1|) . #0#) - (LETT $ (|newShell| 134) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasCategory| |#1| - '(|RetractableTo| (|Integer|))) - (|HasCategory| |#1| '(|Ring|)))) . #0#)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 |#1|) - (|setShellEntry| $ 13 - (SPADCALL (SPADCALL "%paren" (|getShellEntry| $ 9)) - (|getShellEntry| $ 12))) - (|setShellEntry| $ 14 - (SPADCALL (SPADCALL "%box" (|getShellEntry| $ 9)) - (|getShellEntry| $ 12))) - (COND - ((|testBitVector| |pv$| 1) - (PROGN - (|setShellEntry| $ 129 - (CONS (|dispatchFunction| |ES-;even?;SB;43|) $)) - (|setShellEntry| $ 131 - (CONS (|dispatchFunction| |ES-;odd?;SB;44|) $))))) - $)))) - -(MAKEPROP '|ExpressionSpace&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|String|) - (|Symbol|) (0 . |coerce|) (|BasicOperator|) - (|CommonOperators|) (5 . |operator|) '|oppren| '|opbox| - (|List| $) (10 . |box|) |ES-;box;2S;1| (15 . |paren|) - |ES-;paren;2S;2| (|Boolean|) (20 . =) |ES-;belong?;BoB;3| - (|Kernel| 6) (|List| 23) (|Set| 23) (26 . |parts|) - (31 . |sort!|) (|Kernel| $) (|List| 28) |ES-;tower;SL;5| - (36 . |brace|) (41 . |union|) (|Mapping| 25 25 25) - (|List| 25) (47 . |reduce|) (54 . |operator|) (|List| 10) - |ES-;operators;SL;7| (59 . |kernels|) - (|NonNegativeInteger|) (64 . |height|) (69 . |max|) - (|Mapping| 40 40 40) (|List| 40) (75 . |reduce|) - |ES-;height;SNni;8| (82 . |name|) (|List| 8) - (87 . |member?|) (93 . |not|) |ES-;freeOf?;SSB;9| - (98 . |is?|) |ES-;distribute;2S;10| (104 . |elt|) - |ES-;box;LS;11| |ES-;paren;LS;12| (110 . |retract|) - (115 . |member?|) |ES-;freeOf?;2SB;13| (121 . |kernel|) - |ES-;kernel;Bo2S;14| |ES-;elt;Bo2S;15| |ES-;elt;Bo3S;16| - |ES-;elt;Bo4S;17| |ES-;elt;Bo5S;18| (|Mapping| $ 15) - (|List| 66) (127 . |eval|) |ES-;eval;SSMS;19| - (134 . |name|) |ES-;eval;SBoMS;20| (|List| 6) - (139 . |first|) (|Mapping| $ $) |ES-;eval;SSMS;21| - (144 . |eval|) |ES-;eval;SBoMS;22| (|Equation| $) - (|List| 78) (151 . |subst|) |ES-;subst;SES;23| (|List| 74) - |ES-;eval;SLLS;24| |ES-;eval;SLLS;25| |ES-;eval;SLLS;26| - (157 . |argument|) (162 . =) (168 . |coerce|) - |ES-;map;MKS;27| (173 . |is?|) |ES-;operator;2Bo;28| - (|Union| 28 '"failed") |ES-;mainKernel;SU;29| (|None|) - (|Union| 94 '"failed") (179 . |property|) (185 . |second|) - (190 . |remove!|) (196 . |belong?|) |ES-;kernel;BoLS;31| - (201 . |height|) (206 . |kernel|) (|Union| 40 '"failed") - (213 . |arity|) (218 . ~=) (|Union| 6 '"failed") - (|BasicOperatorFunctions1| 6) (224 . |evaluate|) - |ES-;elt;BoLS;33| (230 . |mainKernel|) (235 . ~=) - |ES-;retract;SK;34| |ES-;retractIfCan;SU;35| - (241 . |retractIfCan|) (246 . |is?|) |ES-;is?;SSB;36| - |ES-;is?;SBoB;37| (252 . |eval|) |ES-;distribute;3S;39| - (259 . |eval|) |ES-;eval;SLS;40| (266 . |subst|) - |ES-;subst;SLS;41| (|Equation| 6) (273 . |lhs|) - (278 . |rhs|) (|Integer|) (283 . |even?|) (288 . |even?|) - (293 . |odd?|) (298 . |odd?|) (|Union| 127 '"failed") - (303 . |retractIfCan|)) - '#(|tower| 308 |subst| 313 |retractIfCan| 325 |retract| 330 - |paren| 335 |operators| 345 |operator| 350 |odd?| 355 - |map| 360 |mainKernel| 366 |kernel| 371 |is?| 383 |height| - 395 |freeOf?| 400 |even?| 412 |eval| 417 |elt| 472 - |distribute| 508 |box| 519 |belong?| 529) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 133 - '(1 8 0 7 9 1 11 10 8 12 1 6 0 15 16 1 - 6 0 15 18 2 10 20 0 0 21 1 25 24 0 26 - 1 24 0 0 27 1 25 0 24 31 2 25 0 0 0 - 32 3 34 25 33 0 25 35 1 23 10 0 36 1 - 6 29 0 39 1 23 40 0 41 2 40 0 0 0 42 - 3 44 40 43 0 40 45 1 23 8 0 47 2 48 - 20 8 0 49 1 20 0 0 50 2 23 20 0 10 52 - 2 6 0 10 15 54 1 6 28 0 57 2 24 20 23 - 0 58 2 6 0 10 15 60 3 6 0 0 48 67 68 - 1 10 8 0 70 1 72 6 0 73 3 6 0 0 37 67 - 76 2 6 0 0 79 80 1 23 72 0 86 2 72 20 - 0 0 87 1 6 0 28 88 2 10 20 0 8 90 2 - 10 95 0 7 96 1 72 6 0 97 2 25 0 23 0 - 98 1 6 20 10 99 1 6 40 0 101 3 23 0 - 10 72 40 102 1 10 103 0 104 2 40 20 0 - 0 105 2 107 106 10 72 108 1 6 92 0 - 110 2 6 20 0 0 111 1 6 92 0 114 2 23 - 20 0 8 115 3 6 0 0 28 0 118 3 6 0 0 - 29 15 120 3 6 0 0 29 15 122 1 124 6 0 - 125 1 124 6 0 126 1 127 20 0 128 1 0 - 20 0 129 1 127 20 0 130 1 0 20 0 131 - 1 6 132 0 133 1 0 29 0 30 2 0 0 0 79 - 123 2 0 0 0 78 81 1 0 92 0 113 1 0 28 - 0 112 1 0 0 0 19 1 0 0 15 56 1 0 37 0 - 38 1 0 10 10 91 1 0 20 0 131 2 0 0 74 - 28 89 1 0 92 0 93 2 0 0 10 15 100 2 0 - 0 10 0 61 2 0 20 0 8 116 2 0 20 0 10 - 117 1 0 40 0 46 2 0 20 0 8 51 2 0 20 - 0 0 59 1 0 20 0 129 3 0 0 0 10 74 77 - 3 0 0 0 37 67 85 3 0 0 0 10 66 71 3 0 - 0 0 37 82 83 3 0 0 0 8 66 69 3 0 0 0 - 8 74 75 3 0 0 0 48 82 84 2 0 0 0 79 - 121 2 0 0 10 15 109 5 0 0 10 0 0 0 0 - 65 3 0 0 10 0 0 63 4 0 0 10 0 0 0 64 - 2 0 0 10 0 62 2 0 0 0 0 119 1 0 0 0 - 53 1 0 0 15 55 1 0 0 0 17 1 0 20 10 - 22))))) - '|lookupComplete|)) -@ + \section{package ES1 ExpressionSpaceFunctions1} <<package ES1 ExpressionSpaceFunctions1>>= )abbrev package ES1 ExpressionSpaceFunctions1 diff --git a/src/algebra/integer.spad.pamphlet b/src/algebra/integer.spad.pamphlet index 4b912159..899a2b70 100644 --- a/src/algebra/integer.spad.pamphlet +++ b/src/algebra/integer.spad.pamphlet @@ -240,547 +240,7 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with -- gcdPolynomial(p,q) == modularGcd(p,q)$TT @ -\section{INT.lsp BOOTSTRAP} -{\bf INT} depends on {\bf OINTDOM} which depends on {\bf ORDRING} -which depends on {\bf INT}. -We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf INT} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf INT.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. -Note that this code is not included in the generated catdef.spad file. - -<<INT.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |INT;writeOMInt| (|dev| |x| $) - (SEQ (COND - ((< |x| 0) - (SEQ (SPADCALL |dev| (|getShellEntry| $ 8)) - (SPADCALL |dev| "arith1" "unary_minus" - (|getShellEntry| $ 10)) - (SPADCALL |dev| (- |x|) (|getShellEntry| $ 12)) - (EXIT (SPADCALL |dev| (|getShellEntry| $ 13))))) - ('T (SPADCALL |dev| |x| (|getShellEntry| $ 12)))))) - -(DEFUN |INT;OMwrite;$S;2| (|x| $) - (PROG (|sp| |dev| |s|) - (RETURN - (SEQ (LETT |s| "" |INT;OMwrite;$S;2|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |INT;OMwrite;$S;2|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 15)) - (|getShellEntry| $ 16)) - |INT;OMwrite;$S;2|) - (SPADCALL |dev| (|getShellEntry| $ 17)) - (|INT;writeOMInt| |dev| |x| $) - (SPADCALL |dev| (|getShellEntry| $ 18)) - (SPADCALL |dev| (|getShellEntry| $ 19)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |INT;OMwrite;$S;2|) - (EXIT |s|))))) - -(DEFUN |INT;OMwrite;$BS;3| (|x| |wholeObj| $) - (PROG (|sp| |dev| |s|) - (RETURN - (SEQ (LETT |s| "" |INT;OMwrite;$BS;3|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |INT;OMwrite;$BS;3|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 15)) - (|getShellEntry| $ 16)) - |INT;OMwrite;$BS;3|) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 17)))) - (|INT;writeOMInt| |dev| |x| $) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 18)))) - (SPADCALL |dev| (|getShellEntry| $ 19)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |INT;OMwrite;$BS;3|) - (EXIT |s|))))) - -(DEFUN |INT;OMwrite;Omd$V;4| (|dev| |x| $) - (SEQ (SPADCALL |dev| (|getShellEntry| $ 17)) - (|INT;writeOMInt| |dev| |x| $) - (EXIT (SPADCALL |dev| (|getShellEntry| $ 18))))) - -(DEFUN |INT;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 17)))) - (|INT;writeOMInt| |dev| |x| $) - (EXIT (COND - (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 18))))))) - -(PUT '|INT;zero?;$B;6| '|SPADreplace| 'ZEROP) - -(DEFUN |INT;zero?;$B;6| (|x| $) (ZEROP |x|)) - -(PUT '|INT;one?;$B;7| '|SPADreplace| '(XLAM (|x|) (EQL |x| 1))) - -(DEFUN |INT;one?;$B;7| (|x| $) (EQL |x| 1)) - -(PUT '|INT;Zero;$;8| '|SPADreplace| '(XLAM NIL 0)) - -(DEFUN |INT;Zero;$;8| ($) 0) - -(PUT '|INT;One;$;9| '|SPADreplace| '(XLAM NIL 1)) - -(DEFUN |INT;One;$;9| ($) 1) - -(PUT '|INT;base;$;10| '|SPADreplace| '(XLAM NIL 2)) - -(DEFUN |INT;base;$;10| ($) 2) - -(PUT '|INT;copy;2$;11| '|SPADreplace| '(XLAM (|x|) |x|)) - -(DEFUN |INT;copy;2$;11| (|x| $) |x|) - -(PUT '|INT;inc;2$;12| '|SPADreplace| '(XLAM (|x|) (+ |x| 1))) - -(DEFUN |INT;inc;2$;12| (|x| $) (+ |x| 1)) - -(PUT '|INT;dec;2$;13| '|SPADreplace| '(XLAM (|x|) (- |x| 1))) - -(DEFUN |INT;dec;2$;13| (|x| $) (- |x| 1)) - -(PUT '|INT;hash;2$;14| '|SPADreplace| 'SXHASH) - -(DEFUN |INT;hash;2$;14| (|x| $) (SXHASH |x|)) - -(PUT '|INT;negative?;$B;15| '|SPADreplace| 'MINUSP) - -(DEFUN |INT;negative?;$B;15| (|x| $) (MINUSP |x|)) - -(DEFUN |INT;coerce;$Of;16| (|x| $) - (SPADCALL |x| (|getShellEntry| $ 36))) - -(PUT '|INT;coerce;I$;17| '|SPADreplace| '(XLAM (|m|) |m|)) - -(DEFUN |INT;coerce;I$;17| (|m| $) |m|) - -(PUT '|INT;convert;$I;18| '|SPADreplace| '(XLAM (|x|) |x|)) - -(DEFUN |INT;convert;$I;18| (|x| $) |x|) - -(PUT '|INT;length;2$;19| '|SPADreplace| 'INTEGER-LENGTH) - -(DEFUN |INT;length;2$;19| (|a| $) (INTEGER-LENGTH |a|)) - -(DEFUN |INT;addmod;4$;20| (|a| |b| |p| $) - (PROG (|c| #0=#:G1427) - (RETURN - (SEQ (EXIT (SEQ (SEQ (LETT |c| (+ |a| |b|) |INT;addmod;4$;20|) - (EXIT (COND - ((NULL (< |c| |p|)) - (PROGN - (LETT #0# (- |c| |p|) - |INT;addmod;4$;20|) - (GO #0#)))))) - (EXIT |c|))) - #0# (EXIT #0#))))) - -(DEFUN |INT;submod;4$;21| (|a| |b| |p| $) - (PROG (|c|) - (RETURN - (SEQ (LETT |c| (- |a| |b|) |INT;submod;4$;21|) - (EXIT (COND ((< |c| 0) (+ |c| |p|)) ('T |c|))))))) - -(DEFUN |INT;mulmod;4$;22| (|a| |b| |p| $) - (REMAINDER2 (* |a| |b|) |p|)) - -(DEFUN |INT;convert;$F;23| (|x| $) - (SPADCALL |x| (|getShellEntry| $ 45))) - -(PUT '|INT;convert;$Df;24| '|SPADreplace| - '(XLAM (|x|) (FLOAT |x| MOST-POSITIVE-LONG-FLOAT))) - -(DEFUN |INT;convert;$Df;24| (|x| $) - (FLOAT |x| MOST-POSITIVE-LONG-FLOAT)) - -(DEFUN |INT;convert;$If;25| (|x| $) - (SPADCALL |x| (|getShellEntry| $ 50))) - -(PUT '|INT;convert;$S;26| '|SPADreplace| 'STRINGIMAGE) - -(DEFUN |INT;convert;$S;26| (|x| $) (STRINGIMAGE |x|)) - -(DEFUN |INT;latex;$S;27| (|x| $) - (PROG (|s|) - (RETURN - (SEQ (LETT |s| (STRINGIMAGE |x|) |INT;latex;$S;27|) - (COND ((< -1 |x|) (COND ((< |x| 10) (EXIT |s|))))) - (EXIT (STRCONC "{" (STRCONC |s| "}"))))))) - -(DEFUN |INT;positiveRemainder;3$;28| (|a| |b| $) - (PROG (|r|) - (RETURN - (COND - ((MINUSP (LETT |r| (REMAINDER2 |a| |b|) - |INT;positiveRemainder;3$;28|)) - (COND ((MINUSP |b|) (- |r| |b|)) ('T (+ |r| |b|)))) - ('T |r|))))) - -(PUT '|INT;reducedSystem;MM;29| '|SPADreplace| '(XLAM (|m|) |m|)) - -(DEFUN |INT;reducedSystem;MM;29| (|m| $) |m|) - -(DEFUN |INT;reducedSystem;MVR;30| (|m| |v| $) (CONS |m| '|vec|)) - -(PUT '|INT;abs;2$;31| '|SPADreplace| 'ABS) - -(DEFUN |INT;abs;2$;31| (|x| $) (ABS |x|)) - -(PUT '|INT;random;$;32| '|SPADreplace| '|random|) - -(DEFUN |INT;random;$;32| ($) (|random|)) - -(PUT '|INT;random;2$;33| '|SPADreplace| 'RANDOM) - -(DEFUN |INT;random;2$;33| (|x| $) (RANDOM |x|)) - -(PUT '|INT;=;2$B;34| '|SPADreplace| 'EQL) - -(DEFUN |INT;=;2$B;34| (|x| |y| $) (EQL |x| |y|)) - -(PUT '|INT;<;2$B;35| '|SPADreplace| '<) - -(DEFUN |INT;<;2$B;35| (|x| |y| $) (< |x| |y|)) - -(PUT '|INT;-;2$;36| '|SPADreplace| '-) - -(DEFUN |INT;-;2$;36| (|x| $) (- |x|)) - -(PUT '|INT;+;3$;37| '|SPADreplace| '+) - -(DEFUN |INT;+;3$;37| (|x| |y| $) (+ |x| |y|)) - -(PUT '|INT;-;3$;38| '|SPADreplace| '-) - -(DEFUN |INT;-;3$;38| (|x| |y| $) (- |x| |y|)) - -(PUT '|INT;*;3$;39| '|SPADreplace| '*) - -(DEFUN |INT;*;3$;39| (|x| |y| $) (* |x| |y|)) - -(PUT '|INT;*;I2$;40| '|SPADreplace| '*) - -(DEFUN |INT;*;I2$;40| (|m| |y| $) (* |m| |y|)) - -(PUT '|INT;**;$Nni$;41| '|SPADreplace| 'EXPT) - -(DEFUN |INT;**;$Nni$;41| (|x| |n| $) (EXPT |x| |n|)) - -(PUT '|INT;odd?;$B;42| '|SPADreplace| 'ODDP) - -(DEFUN |INT;odd?;$B;42| (|x| $) (ODDP |x|)) - -(PUT '|INT;max;3$;43| '|SPADreplace| 'MAX) - -(DEFUN |INT;max;3$;43| (|x| |y| $) (MAX |x| |y|)) - -(PUT '|INT;min;3$;44| '|SPADreplace| 'MIN) - -(DEFUN |INT;min;3$;44| (|x| |y| $) (MIN |x| |y|)) - -(PUT '|INT;divide;2$R;45| '|SPADreplace| 'DIVIDE2) - -(DEFUN |INT;divide;2$R;45| (|x| |y| $) (DIVIDE2 |x| |y|)) - -(PUT '|INT;quo;3$;46| '|SPADreplace| 'QUOTIENT2) - -(DEFUN |INT;quo;3$;46| (|x| |y| $) (QUOTIENT2 |x| |y|)) - -(PUT '|INT;rem;3$;47| '|SPADreplace| 'REMAINDER2) - -(DEFUN |INT;rem;3$;47| (|x| |y| $) (REMAINDER2 |x| |y|)) - -(PUT '|INT;shift;3$;48| '|SPADreplace| 'ASH) - -(DEFUN |INT;shift;3$;48| (|x| |y| $) (ASH |x| |y|)) - -(DEFUN |INT;exquo;2$U;49| (|x| |y| $) - (COND - ((OR (ZEROP |y|) (NULL (ZEROP (REMAINDER2 |x| |y|)))) - (CONS 1 "failed")) - ('T (CONS 0 (QUOTIENT2 |x| |y|))))) - -(DEFUN |INT;recip;$U;50| (|x| $) - (COND - ((OR (EQL |x| 1) (EQL |x| -1)) (CONS 0 |x|)) - ('T (CONS 1 "failed")))) - -(PUT '|INT;gcd;3$;51| '|SPADreplace| 'GCD) - -(DEFUN |INT;gcd;3$;51| (|x| |y| $) (GCD |x| |y|)) - -(DEFUN |INT;unitNormal;$R;52| (|x| $) - (COND ((< |x| 0) (VECTOR -1 (- |x|) -1)) ('T (VECTOR 1 |x| 1)))) - -(PUT '|INT;unitCanonical;2$;53| '|SPADreplace| 'ABS) - -(DEFUN |INT;unitCanonical;2$;53| (|x| $) (ABS |x|)) - -(DEFUN |INT;solveLinearPolynomialEquation| (|lp| |p| $) - (SPADCALL |lp| |p| (|getShellEntry| $ 93))) - -(DEFUN |INT;squareFreePolynomial| (|p| $) - (SPADCALL |p| (|getShellEntry| $ 97))) - -(DEFUN |INT;factorPolynomial| (|p| $) - (PROG (|pp| #0=#:G1498) - (RETURN - (SEQ (LETT |pp| (SPADCALL |p| (|getShellEntry| $ 98)) - |INT;factorPolynomial|) - (EXIT (COND - ((EQL (SPADCALL |pp| (|getShellEntry| $ 99)) - (SPADCALL |p| (|getShellEntry| $ 99))) - (SPADCALL |p| (|getShellEntry| $ 101))) - ('T - (SPADCALL (SPADCALL |pp| (|getShellEntry| $ 101)) - (SPADCALL (CONS #'|INT;factorPolynomial!0| $) - (SPADCALL - (PROG2 (LETT #0# - (SPADCALL - (SPADCALL |p| - (|getShellEntry| $ 99)) - (SPADCALL |pp| - (|getShellEntry| $ 99)) - (|getShellEntry| $ 83)) - |INT;factorPolynomial|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) $ #0#)) - (|getShellEntry| $ 104)) - (|getShellEntry| $ 108)) - (|getShellEntry| $ 110))))))))) - -(DEFUN |INT;factorPolynomial!0| (|#1| $) - (SPADCALL |#1| (|getShellEntry| $ 102))) - -(DEFUN |INT;factorSquareFreePolynomial| (|p| $) - (SPADCALL |p| (|getShellEntry| $ 111))) - -(DEFUN |INT;gcdPolynomial;3Sup;58| (|p| |q| $) - (COND - ((SPADCALL |p| (|getShellEntry| $ 112)) - (SPADCALL |q| (|getShellEntry| $ 113))) - ((SPADCALL |q| (|getShellEntry| $ 112)) - (SPADCALL |p| (|getShellEntry| $ 113))) - ('T (SPADCALL (LIST |p| |q|) (|getShellEntry| $ 116))))) - -(DEFUN |Integer| () - (PROG () - (RETURN - (PROG (#0=#:G1523) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|Integer|) |Integer|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Integer| - (LIST - (CONS NIL (CONS 1 (|Integer;|)))))) - (LETT #0# T |Integer|)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|Integer|))))))))))) - -(DEFUN |Integer;| () - (PROG (|dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$| '(|Integer|) . #0=(|Integer|)) - (LETT $ (|newShell| 132) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|haddProp| |$ConstructorCache| '|Integer| NIL (CONS 1 $)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 71 - (|setShellEntry| $ 70 - (CONS (|dispatchFunction| |INT;*;I2$;40|) $))) - $)))) - -(MAKEPROP '|Integer| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|Void|) (|OpenMathDevice|) - (0 . |OMputApp|) (|String|) (5 . |OMputSymbol|) - (|Integer|) (12 . |OMputInteger|) (18 . |OMputEndApp|) - (|OpenMathEncoding|) (23 . |OMencodingXML|) - (27 . |OMopenString|) (33 . |OMputObject|) - (38 . |OMputEndObject|) (43 . |OMclose|) - |INT;OMwrite;$S;2| (|Boolean|) |INT;OMwrite;$BS;3| - |INT;OMwrite;Omd$V;4| |INT;OMwrite;Omd$BV;5| - |INT;zero?;$B;6| |INT;one?;$B;7| - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |INT;Zero;$;8|) $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |INT;One;$;9|) $)) - |INT;base;$;10| |INT;copy;2$;11| |INT;inc;2$;12| - |INT;dec;2$;13| |INT;hash;2$;14| |INT;negative?;$B;15| - (|OutputForm|) (48 . |outputForm|) |INT;coerce;$Of;16| - |INT;coerce;I$;17| |INT;convert;$I;18| |INT;length;2$;19| - |INT;addmod;4$;20| |INT;submod;4$;21| |INT;mulmod;4$;22| - (|Float|) (53 . |coerce|) |INT;convert;$F;23| - (|DoubleFloat|) |INT;convert;$Df;24| (|InputForm|) - (58 . |convert|) |INT;convert;$If;25| |INT;convert;$S;26| - |INT;latex;$S;27| |INT;positiveRemainder;3$;28| - (|Matrix| 11) (|Matrix| $) |INT;reducedSystem;MM;29| - (|Vector| 11) (|Record| (|:| |mat| 55) (|:| |vec| 58)) - (|Vector| $) |INT;reducedSystem;MVR;30| |INT;abs;2$;31| - |INT;random;$;32| |INT;random;2$;33| |INT;=;2$B;34| - |INT;<;2$B;35| |INT;-;2$;36| |INT;+;3$;37| |INT;-;3$;38| - NIL NIL (|NonNegativeInteger|) |INT;**;$Nni$;41| - |INT;odd?;$B;42| |INT;max;3$;43| |INT;min;3$;44| - (|Record| (|:| |quotient| $) (|:| |remainder| $)) - |INT;divide;2$R;45| |INT;quo;3$;46| |INT;rem;3$;47| - |INT;shift;3$;48| (|Union| $ '"failed") |INT;exquo;2$U;49| - |INT;recip;$U;50| |INT;gcd;3$;51| - (|Record| (|:| |unit| $) (|:| |canonical| $) - (|:| |associate| $)) - |INT;unitNormal;$R;52| |INT;unitCanonical;2$;53| - (|SparseUnivariatePolynomial| 11) (|List| 89) - (|Union| 90 '"failed") - (|IntegerSolveLinearPolynomialEquation|) - (63 . |solveLinearPolynomialEquation|) - (|SparseUnivariatePolynomial| $$) (|Factored| 94) - (|UnivariatePolynomialSquareFree| $$ 94) - (69 . |squareFree|) (74 . |primitivePart|) - (79 . |leadingCoefficient|) (|GaloisGroupFactorizer| 94) - (84 . |factor|) (89 . |coerce|) (|Factored| $) - (94 . |factor|) (|Mapping| 94 $$) (|Factored| $$) - (|FactoredFunctions2| $$ 94) (99 . |map|) - (|FactoredFunctionUtilities| 94) (105 . |mergeFactors|) - (111 . |factorSquareFree|) (116 . |zero?|) - (121 . |unitCanonical|) (|List| 94) (|HeuGcd| 94) - (126 . |gcd|) (|SparseUnivariatePolynomial| $) - |INT;gcdPolynomial;3Sup;58| (|Fraction| 11) - (|Union| 119 '"failed") (|PatternMatchResult| 11 $) - (|Pattern| 11) (|Union| 11 '"failed") (|List| $) - (|Union| 124 '"failed") - (|Record| (|:| |coef| 124) (|:| |generator| $)) - (|Record| (|:| |coef1| $) (|:| |coef2| $)) - (|Union| 127 '"failed") - (|Record| (|:| |coef1| $) (|:| |coef2| $) - (|:| |generator| $)) - (|PositiveInteger|) (|SingleInteger|)) - '#(~= 131 |zero?| 137 |unitNormal| 142 |unitCanonical| 147 - |unit?| 152 |symmetricRemainder| 157 |subtractIfCan| 163 - |submod| 169 |squareFreePart| 176 |squareFree| 181 - |sizeLess?| 186 |sign| 192 |shift| 197 |sample| 203 - |retractIfCan| 207 |retract| 212 |rem| 217 |reducedSystem| - 223 |recip| 234 |rationalIfCan| 239 |rational?| 244 - |rational| 249 |random| 254 |quo| 263 |principalIdeal| 269 - |prime?| 274 |powmod| 279 |positiveRemainder| 286 - |positive?| 292 |permutation| 297 |patternMatch| 303 - |one?| 310 |odd?| 315 |nextItem| 320 |negative?| 325 - |multiEuclidean| 330 |mulmod| 336 |min| 343 |max| 349 - |mask| 355 |length| 360 |lcm| 365 |latex| 376 |invmod| 381 - |init| 387 |inc| 391 |hash| 396 |gcdPolynomial| 406 |gcd| - 412 |factorial| 423 |factor| 428 |extendedEuclidean| 433 - |exquo| 446 |expressIdealMember| 452 |even?| 458 - |euclideanSize| 463 |divide| 468 |differentiate| 474 |dec| - 485 |copy| 490 |convert| 495 |coerce| 525 |characteristic| - 545 |bit?| 549 |binomial| 555 |base| 561 |associates?| 565 - |addmod| 571 |abs| 578 ^ 583 |Zero| 595 |One| 599 - |OMwrite| 603 D 627 >= 638 > 644 = 650 <= 656 < 662 - 668 - + 679 ** 685 * 697) - '((|infinite| . 0) (|noetherian| . 0) - (|canonicalsClosed| . 0) (|canonical| . 0) - (|canonicalUnitNormal| . 0) (|multiplicativeValuation| . 0) - (|noZeroDivisors| . 0) ((|commutative| "*") . 0) - (|rightUnitary| . 0) (|leftUnitary| . 0) - (|unitsKnown| . 0)) - (CONS (|makeByteWordVec2| 1 - '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)) - (CONS '#(|IntegerNumberSystem&| |EuclideanDomain&| - |UniqueFactorizationDomain&| NIL NIL - |GcdDomain&| |IntegralDomain&| |Algebra&| NIL - NIL |DifferentialRing&| |OrderedRing&| NIL NIL - |Module&| NIL NIL |Ring&| NIL NIL NIL NIL NIL - |AbelianGroup&| NIL NIL |AbelianMonoid&| - |Monoid&| NIL NIL |OrderedSet&| - |AbelianSemiGroup&| |SemiGroup&| NIL - |SetCategory&| NIL NIL NIL NIL NIL NIL NIL - |RetractableTo&| NIL |BasicType&| NIL) - (CONS '#((|IntegerNumberSystem|) - (|EuclideanDomain|) - (|UniqueFactorizationDomain|) - (|PrincipalIdealDomain|) - (|OrderedIntegralDomain|) (|GcdDomain|) - (|IntegralDomain|) (|Algebra| $$) - (|CharacteristicZero|) - (|LinearlyExplicitRingOver| 11) - (|DifferentialRing|) (|OrderedRing|) - (|CommutativeRing|) (|EntireRing|) - (|Module| $$) (|OrderedAbelianGroup|) - (|BiModule| $$ $$) (|Ring|) - (|OrderedCancellationAbelianMonoid|) - (|LeftModule| $$) (|Rng|) - (|RightModule| $$) - (|OrderedAbelianMonoid|) - (|AbelianGroup|) - (|OrderedAbelianSemiGroup|) - (|CancellationAbelianMonoid|) - (|AbelianMonoid|) (|Monoid|) - (|StepThrough|) (|PatternMatchable| 11) - (|OrderedSet|) (|AbelianSemiGroup|) - (|SemiGroup|) (|RealConstant|) - (|SetCategory|) (|OpenMath|) - (|ConvertibleTo| 9) (|ConvertibleTo| 44) - (|ConvertibleTo| 47) - (|CombinatorialFunctionCategory|) - (|ConvertibleTo| 122) - (|ConvertibleTo| 49) - (|RetractableTo| 11) - (|ConvertibleTo| 11) (|BasicType|) - (|CoercibleTo| 35)) - (|makeByteWordVec2| 131 - '(1 7 6 0 8 3 7 6 0 9 9 10 2 7 6 0 11 - 12 1 7 6 0 13 0 14 0 15 2 7 0 9 14 16 - 1 7 6 0 17 1 7 6 0 18 1 7 6 0 19 1 35 - 0 11 36 1 44 0 11 45 1 49 0 11 50 2 - 92 91 90 89 93 1 96 95 94 97 1 94 0 0 - 98 1 94 2 0 99 1 100 95 94 101 1 94 0 - 2 102 1 0 103 0 104 2 107 95 105 106 - 108 2 109 95 95 95 110 1 100 95 94 - 111 1 94 21 0 112 1 94 0 0 113 1 115 - 94 114 116 2 0 21 0 0 1 1 0 21 0 25 1 - 0 86 0 87 1 0 0 0 88 1 0 21 0 1 2 0 0 - 0 0 1 2 0 82 0 0 1 3 0 0 0 0 0 42 1 0 - 0 0 1 1 0 103 0 1 2 0 21 0 0 1 1 0 11 - 0 1 2 0 0 0 0 81 0 0 0 1 1 0 123 0 1 - 1 0 11 0 1 2 0 0 0 0 80 2 0 59 56 60 - 61 1 0 55 56 57 1 0 82 0 84 1 0 120 0 - 1 1 0 21 0 1 1 0 119 0 1 1 0 0 0 64 0 - 0 0 63 2 0 0 0 0 79 1 0 126 124 1 1 0 - 21 0 1 3 0 0 0 0 0 1 2 0 0 0 0 54 1 0 - 21 0 1 2 0 0 0 0 1 3 0 121 0 122 121 - 1 1 0 21 0 26 1 0 21 0 74 1 0 82 0 1 - 1 0 21 0 34 2 0 125 124 0 1 3 0 0 0 0 - 0 43 2 0 0 0 0 76 2 0 0 0 0 75 1 0 0 - 0 1 1 0 0 0 40 1 0 0 124 1 2 0 0 0 0 - 1 1 0 9 0 53 2 0 0 0 0 1 0 0 0 1 1 0 - 0 0 31 1 0 0 0 33 1 0 131 0 1 2 0 117 - 117 117 118 2 0 0 0 0 85 1 0 0 124 1 - 1 0 0 0 1 1 0 103 0 104 3 0 128 0 0 0 - 1 2 0 129 0 0 1 2 0 82 0 0 83 2 0 125 - 124 0 1 1 0 21 0 1 1 0 72 0 1 2 0 77 - 0 0 78 1 0 0 0 1 2 0 0 0 72 1 1 0 0 0 - 32 1 0 0 0 30 1 0 9 0 52 1 0 47 0 48 - 1 0 44 0 46 1 0 49 0 51 1 0 122 0 1 1 - 0 11 0 39 1 0 0 11 38 1 0 0 11 38 1 0 - 0 0 1 1 0 35 0 37 0 0 72 1 2 0 21 0 0 - 1 2 0 0 0 0 1 0 0 0 29 2 0 21 0 0 1 3 - 0 0 0 0 0 41 1 0 0 0 62 2 0 0 0 72 1 - 2 0 0 0 130 1 0 0 0 27 0 0 0 28 3 0 6 - 7 0 21 24 2 0 9 0 21 22 2 0 6 7 0 23 - 1 0 9 0 20 1 0 0 0 1 2 0 0 0 72 1 2 0 - 21 0 0 1 2 0 21 0 0 1 2 0 21 0 0 65 2 - 0 21 0 0 1 2 0 21 0 0 66 2 0 0 0 0 69 - 1 0 0 0 67 2 0 0 0 0 68 2 0 0 0 72 73 - 2 0 0 0 130 1 2 0 0 0 0 70 2 0 0 11 0 - 71 2 0 0 72 0 1 2 0 0 130 0 1))))) - '|lookupComplete|)) - -(MAKEPROP '|Integer| 'NILADIC T) -@ \section{domain NNI NonNegativeInteger} @@ -826,165 +286,7 @@ NonNegativeInteger: Join(OrderedAbelianMonoidSup,Monoid) with c pretend % @ -\section{NNI.lsp BOOTSTRAP} -{\bf NNI} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf NNI} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf NNI.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<NNI.lsp BOOTSTRAP>>= - -(|/VERSIONCHECK| 2) - -(SETQ |$CategoryFrame| - (|put| - #1=(QUOTE |NonNegativeInteger|) - (QUOTE |SuperDomain|) - #2=(QUOTE (|Integer|)) - (|put| - #2# - #3=(QUOTE |SubDomain|) - (CONS - (QUOTE - (|NonNegativeInteger| - COND ((|<| |#1| 0) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) - (DELASC #1# (|get| #2# #3# |$CategoryFrame|))) - |$CategoryFrame|))) - -(PUT - (QUOTE |NNI;sup;3$;1|) - (QUOTE |SPADreplace|) - (QUOTE MAX)) - -(DEFUN |NNI;sup;3$;1| (|x| |y| |$|) (MAX |x| |y|)) -(PUT - (QUOTE |NNI;shift;$I$;2|) - (QUOTE |SPADreplace|) - (QUOTE ASH)) - -(DEFUN |NNI;shift;$I$;2| (|x| |n| |$|) (ASH |x| |n|)) - -(DEFUN |NNI;subtractIfCan;2$U;3| (|x| |y| |$|) - (PROG (|c|) - (RETURN - (SEQ - (LETT |c| (|-| |x| |y|) |NNI;subtractIfCan;2$U;3|) - (EXIT - (COND - ((|<| |c| 0) (CONS 1 "failed")) - ((QUOTE T) (CONS 0 |c|)))))))) - -(DEFUN |NonNegativeInteger| NIL - (PROG NIL - (RETURN - (PROG (#1=#:G96708) - (RETURN - (COND - ((LETT #1# - (HGET |$ConstructorCache| (QUOTE |NonNegativeInteger|)) - |NonNegativeInteger|) - (|CDRwithIncrement| (CDAR #1#))) - ((QUOTE T) - (|UNWIND-PROTECT| - (PROG1 - (CDDAR - (HPUT - |$ConstructorCache| - (QUOTE |NonNegativeInteger|) - (LIST (CONS NIL (CONS 1 (|NonNegativeInteger;|)))))) - (LETT #1# T |NonNegativeInteger|)) - (COND - ((NOT #1#) - (HREM - |$ConstructorCache| - (QUOTE |NonNegativeInteger|)))))))))))) - -(DEFUN |NonNegativeInteger;| NIL - (PROG (|dv$| |$| |pv$|) - (RETURN - (PROGN - (LETT |dv$| (QUOTE (|NonNegativeInteger|)) . #1=(|NonNegativeInteger|)) - (LETT |$| (GETREFV 17) . #1#) - (QSETREFV |$| 0 |dv$|) - (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) - (|haddProp| - |$ConstructorCache| - (QUOTE |NonNegativeInteger|) - NIL - (CONS 1 |$|)) - (|stuffDomainSlots| |$|) |$|)))) - -(MAKEPROP - (QUOTE |NonNegativeInteger|) - (QUOTE |infovec|) - (LIST - (QUOTE - #(NIL NIL NIL NIL NIL - (|Integer|) - |NNI;sup;3$;1| - |NNI;shift;$I$;2| - (|Union| |$| (QUOTE "failed")) - |NNI;subtractIfCan;2$U;3| - (|Record| (|:| |quotient| |$|) (|:| |remainder| |$|)) - (|PositiveInteger|) - (|Boolean|) - (|NonNegativeInteger|) - (|SingleInteger|) - (|String|) - (|OutputForm|))) - (QUOTE - #(|~=| 0 |zero?| 6 |sup| 11 |subtractIfCan| 17 |shift| 23 |sample| 29 - |rem| 33 |recip| 39 |random| 44 |quo| 49 |one?| 55 |min| 60 |max| 66 - |latex| 72 |hash| 77 |gcd| 82 |exquo| 88 |divide| 94 |coerce| 100 - |^| 105 |Zero| 117 |One| 121 |>=| 125 |>| 131 |=| 137 |<=| 143 - |<| 149 |+| 155 |**| 161 |*| 173)) - (QUOTE (((|commutative| "*") . 0))) - (CONS - (|makeByteWordVec2| 1 (QUOTE (0 0 0 0 0 0 0 0 0 0 0 0 0))) - (CONS - (QUOTE - #(NIL NIL NIL NIL NIL - |Monoid&| - |AbelianMonoid&| - |OrderedSet&| - |SemiGroup&| - |AbelianSemiGroup&| - |SetCategory&| - |BasicType&| - NIL)) - (CONS - (QUOTE - #((|OrderedAbelianMonoidSup|) - (|OrderedCancellationAbelianMonoid|) - (|OrderedAbelianMonoid|) - (|OrderedAbelianSemiGroup|) - (|CancellationAbelianMonoid|) - (|Monoid|) - (|AbelianMonoid|) - (|OrderedSet|) - (|SemiGroup|) - (|AbelianSemiGroup|) - (|SetCategory|) - (|BasicType|) - (|CoercibleTo| 16))) - (|makeByteWordVec2| 16 - (QUOTE - (2 0 12 0 0 1 1 0 12 0 1 2 0 0 0 0 6 2 0 8 0 0 9 2 0 0 0 5 7 0 0 - 0 1 2 0 0 0 0 1 1 0 8 0 1 1 0 0 0 1 2 0 0 0 0 1 1 0 12 0 1 2 0 - 0 0 0 1 2 0 0 0 0 1 1 0 15 0 1 1 0 14 0 1 2 0 0 0 0 1 2 0 8 0 0 - 1 2 0 10 0 0 1 1 0 16 0 1 2 0 0 0 11 1 2 0 0 0 13 1 0 0 0 1 0 0 - 0 1 2 0 12 0 0 1 2 0 12 0 0 1 2 0 12 0 0 1 2 0 12 0 0 1 2 0 12 - 0 0 1 2 0 0 0 0 1 2 0 0 0 11 1 2 0 0 0 13 1 2 0 0 0 0 1 2 0 0 - 11 0 1 2 0 0 13 0 1)))))) - (QUOTE |lookupComplete|))) - -(MAKEPROP (QUOTE |NonNegativeInteger|) (QUOTE NILADIC) T) - -@ \section{domain PI PositiveInteger} <<domain PI PositiveInteger>>= )abbrev domain PI PositiveInteger @@ -1007,92 +309,8 @@ PositiveInteger: Join(OrderedAbelianSemiGroup,Monoid) with y:% @ -\section{PI.lsp BOOTSTRAP} -{\bf PI} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf PI} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf PI.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. -Note that this code is not included in the generated catdef.spad file. -<<PI.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(SETQ |$CategoryFrame| - (|put| #0='|PositiveInteger| '|SuperDomain| - #1='(|NonNegativeInteger|) - (|put| #1# '|SubDomain| - (CONS '(|PositiveInteger| < 0 |#1|) - (DELASC #0# - (|get| #1# '|SubDomain| - |$CategoryFrame|))) - |$CategoryFrame|))) - -(DEFUN |PositiveInteger| () - (PROG () - (RETURN - (PROG (#0=#:G1396) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|PositiveInteger|) - |PositiveInteger|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| - '|PositiveInteger| - (LIST - (CONS NIL - (CONS 1 (|PositiveInteger;|)))))) - (LETT #0# T |PositiveInteger|)) - (COND - ((NOT #0#) - (HREM |$ConstructorCache| '|PositiveInteger|))))))))))) - -(DEFUN |PositiveInteger;| () - (PROG (|dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$| '(|PositiveInteger|) . #0=(|PositiveInteger|)) - (LETT $ (|newShell| 12) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|haddProp| |$ConstructorCache| '|PositiveInteger| NIL - (CONS 1 $)) - (|stuffDomainSlots| $) - $)))) - -(MAKEPROP '|PositiveInteger| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL (|NonNegativeInteger|) - (|PositiveInteger|) (|Boolean|) (|Union| $ '"failed") - (|SingleInteger|) (|String|) (|OutputForm|)) - '#(~= 0 |sample| 6 |recip| 10 |one?| 15 |min| 20 |max| 26 - |latex| 32 |hash| 37 |gcd| 42 |coerce| 48 ^ 53 |One| 65 >= - 69 > 75 = 81 <= 87 < 93 + 99 ** 105 * 117) - '(((|commutative| "*") . 0)) - (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0 0 0)) - (CONS '#(NIL |Monoid&| |OrderedSet&| |SemiGroup&| - |AbelianSemiGroup&| |SetCategory&| - |BasicType&| NIL) - (CONS '#((|OrderedAbelianSemiGroup|) (|Monoid|) - (|OrderedSet|) (|SemiGroup|) - (|AbelianSemiGroup|) (|SetCategory|) - (|BasicType|) (|CoercibleTo| 11)) - (|makeByteWordVec2| 11 - '(2 0 7 0 0 1 0 0 0 1 1 0 8 0 1 1 0 7 0 - 1 2 0 0 0 0 1 2 0 0 0 0 1 1 0 10 0 1 - 1 0 9 0 1 2 0 0 0 0 1 1 0 11 0 1 2 0 - 0 0 6 1 2 0 0 0 5 1 0 0 0 1 2 0 7 0 0 - 1 2 0 7 0 0 1 2 0 7 0 0 1 2 0 7 0 0 1 - 2 0 7 0 0 1 2 0 0 0 0 1 2 0 0 0 6 1 2 - 0 0 0 5 1 2 0 0 0 0 1 2 0 0 6 0 1))))) - '|lookupComplete|)) - -(MAKEPROP '|PositiveInteger| 'NILADIC T) -@ \section{domain ROMAN RomanNumeral} <<domain ROMAN RomanNumeral>>= )abbrev domain ROMAN RomanNumeral diff --git a/src/algebra/list.spad.pamphlet b/src/algebra/list.spad.pamphlet index e702f8f1..3db78db6 100644 --- a/src/algebra/list.spad.pamphlet +++ b/src/algebra/list.spad.pamphlet @@ -201,639 +201,7 @@ IndexedList(S:Type, mn:Integer): Exports == Implementation where merge_!(f, p, q) @ -\section{ILIST.lsp BOOTSTRAP} -{\bf ILIST} depends on a chain of -files. We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf ILIST} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf ILIST.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. -Note that this code is not included in the generated catdef.spad file. - -<<ILIST.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(PUT '|ILIST;#;$Nni;1| '|SPADreplace| 'LENGTH) - -(DEFUN |ILIST;#;$Nni;1| (|x| $) (LENGTH |x|)) - -(PUT '|ILIST;concat;S2$;2| '|SPADreplace| 'CONS) - -(DEFUN |ILIST;concat;S2$;2| (|s| |x| $) (CONS |s| |x|)) - -(PUT '|ILIST;eq?;2$B;3| '|SPADreplace| 'EQ) - -(DEFUN |ILIST;eq?;2$B;3| (|x| |y| $) (EQ |x| |y|)) - -(PUT '|ILIST;first;$S;4| '|SPADreplace| '|SPADfirst|) - -(DEFUN |ILIST;first;$S;4| (|x| $) (|SPADfirst| |x|)) - -(PUT '|ILIST;elt;$firstS;5| '|SPADreplace| - '(XLAM (|x| "first") (|SPADfirst| |x|))) - -(DEFUN |ILIST;elt;$firstS;5| (|x| T0 $) (|SPADfirst| |x|)) - -(PUT '|ILIST;empty;$;6| '|SPADreplace| '(XLAM NIL NIL)) - -(DEFUN |ILIST;empty;$;6| ($) NIL) - -(PUT '|ILIST;empty?;$B;7| '|SPADreplace| 'NULL) - -(DEFUN |ILIST;empty?;$B;7| (|x| $) (NULL |x|)) - -(PUT '|ILIST;rest;2$;8| '|SPADreplace| 'CDR) - -(DEFUN |ILIST;rest;2$;8| (|x| $) (CDR |x|)) - -(PUT '|ILIST;elt;$rest$;9| '|SPADreplace| - '(XLAM (|x| "rest") (CDR |x|))) - -(DEFUN |ILIST;elt;$rest$;9| (|x| T1 $) (CDR |x|)) - -(DEFUN |ILIST;setfirst!;$2S;10| (|x| |s| $) - (COND - ((SPADCALL |x| (QREFELT $ 17)) - (|error| "Cannot update an empty list")) - ('T (QCAR (RPLACA |x| |s|))))) - -(DEFUN |ILIST;setelt;$first2S;11| (|x| T2 |s| $) - (COND - ((SPADCALL |x| (QREFELT $ 17)) - (|error| "Cannot update an empty list")) - ('T (QCAR (RPLACA |x| |s|))))) - -(DEFUN |ILIST;setrest!;3$;12| (|x| |y| $) - (COND - ((SPADCALL |x| (QREFELT $ 17)) - (|error| "Cannot update an empty list")) - ('T (QCDR (RPLACD |x| |y|))))) - -(DEFUN |ILIST;setelt;$rest2$;13| (|x| T3 |y| $) - (COND - ((SPADCALL |x| (QREFELT $ 17)) - (|error| "Cannot update an empty list")) - ('T (QCDR (RPLACD |x| |y|))))) - -(PUT '|ILIST;construct;L$;14| '|SPADreplace| '(XLAM (|l|) |l|)) - -(DEFUN |ILIST;construct;L$;14| (|l| $) |l|) - -(PUT '|ILIST;parts;$L;15| '|SPADreplace| '(XLAM (|s|) |s|)) - -(DEFUN |ILIST;parts;$L;15| (|s| $) |s|) - -(PUT '|ILIST;reverse!;2$;16| '|SPADreplace| 'NREVERSE) - -(DEFUN |ILIST;reverse!;2$;16| (|x| $) (NREVERSE |x|)) - -(PUT '|ILIST;reverse;2$;17| '|SPADreplace| 'REVERSE) - -(DEFUN |ILIST;reverse;2$;17| (|x| $) (REVERSE |x|)) - -(DEFUN |ILIST;minIndex;$I;18| (|x| $) (QREFELT $ 7)) - -(DEFUN |ILIST;rest;$Nni$;19| (|x| |n| $) - (PROG (|i|) - (RETURN - (SEQ (SEQ (LETT |i| 1 |ILIST;rest;$Nni$;19|) G190 - (COND ((QSGREATERP |i| |n|) (GO G191))) - (SEQ (COND - ((NULL |x|) (|error| "index out of range"))) - (EXIT (LETT |x| (QCDR |x|) |ILIST;rest;$Nni$;19|))) - (LETT |i| (QSADD1 |i|) |ILIST;rest;$Nni$;19|) (GO G190) - G191 (EXIT NIL)) - (EXIT |x|))))) - -(DEFUN |ILIST;copy;2$;20| (|x| $) - (PROG (|i| |y|) - (RETURN - (SEQ (LETT |y| (SPADCALL (QREFELT $ 16)) |ILIST;copy;2$;20|) - (SEQ (LETT |i| 0 |ILIST;copy;2$;20|) G190 - (COND - ((NULL (SPADCALL (NULL |x|) (QREFELT $ 33))) - (GO G191))) - (SEQ (COND - ((EQ |i| 1000) - (COND - ((SPADCALL |x| (QREFELT $ 34)) - (|error| "cyclic list"))))) - (LETT |y| (CONS (QCAR |x|) |y|) - |ILIST;copy;2$;20|) - (EXIT (LETT |x| (QCDR |x|) |ILIST;copy;2$;20|))) - (LETT |i| (QSADD1 |i|) |ILIST;copy;2$;20|) (GO G190) - G191 (EXIT NIL)) - (EXIT (NREVERSE |y|)))))) - -(DEFUN |ILIST;coerce;$Of;21| (|x| $) - (PROG (|s| |y| |z|) - (RETURN - (SEQ (LETT |y| NIL |ILIST;coerce;$Of;21|) - (LETT |s| (SPADCALL |x| (QREFELT $ 36)) - |ILIST;coerce;$Of;21|) - (SEQ G190 (COND ((NULL (NEQ |x| |s|)) (GO G191))) - (SEQ (LETT |y| - (CONS (SPADCALL - (SPADCALL |x| (QREFELT $ 13)) - (QREFELT $ 38)) - |y|) - |ILIST;coerce;$Of;21|) - (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 18)) - |ILIST;coerce;$Of;21|))) - NIL (GO G190) G191 (EXIT NIL)) - (LETT |y| (NREVERSE |y|) |ILIST;coerce;$Of;21|) - (EXIT (COND - ((SPADCALL |s| (QREFELT $ 17)) - (SPADCALL |y| (QREFELT $ 40))) - ('T - (SEQ (LETT |z| - (SPADCALL - (SPADCALL - (SPADCALL |x| (QREFELT $ 13)) - (QREFELT $ 38)) - (QREFELT $ 42)) - |ILIST;coerce;$Of;21|) - (SEQ G190 - (COND - ((NULL (NEQ |s| - (SPADCALL |x| (QREFELT $ 18)))) - (GO G191))) - (SEQ (LETT |x| - (SPADCALL |x| (QREFELT $ 18)) - |ILIST;coerce;$Of;21|) - (EXIT - (LETT |z| - (CONS - (SPADCALL - (SPADCALL |x| (QREFELT $ 13)) - (QREFELT $ 38)) - |z|) - |ILIST;coerce;$Of;21|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL - (SPADCALL |y| - (SPADCALL - (SPADCALL (NREVERSE |z|) - (QREFELT $ 43)) - (QREFELT $ 44)) - (QREFELT $ 45)) - (QREFELT $ 40))))))))))) - -(DEFUN |ILIST;=;2$B;22| (|x| |y| $) - (PROG (#0=#:G1469) - (RETURN - (SEQ (EXIT (COND - ((EQ |x| |y|) 'T) - ('T - (SEQ (SEQ G190 - (COND - ((NULL (COND - ((NULL |x|) 'NIL) - ('T - (SPADCALL (NULL |y|) - (QREFELT $ 33))))) - (GO G191))) - (SEQ (EXIT - (COND - ((NULL - (SPADCALL (QCAR |x|) (QCAR |y|) - (QREFELT $ 47))) - (PROGN - (LETT #0# 'NIL - |ILIST;=;2$B;22|) - (GO #0#))) - ('T - (SEQ - (LETT |x| (QCDR |x|) - |ILIST;=;2$B;22|) - (EXIT - (LETT |y| (QCDR |y|) - |ILIST;=;2$B;22|))))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((NULL |x|) (NULL |y|)) - ('T 'NIL))))))) - #0# (EXIT #0#))))) - -(DEFUN |ILIST;latex;$S;23| (|x| $) - (PROG (|s|) - (RETURN - (SEQ (LETT |s| "\\left[" |ILIST;latex;$S;23|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |x|) (QREFELT $ 33))) - (GO G191))) - (SEQ (LETT |s| - (STRCONC |s| - (SPADCALL (QCAR |x|) - (QREFELT $ 50))) - |ILIST;latex;$S;23|) - (LETT |x| (QCDR |x|) |ILIST;latex;$S;23|) - (EXIT (COND - ((NULL (NULL |x|)) - (LETT |s| (STRCONC |s| ", ") - |ILIST;latex;$S;23|))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (STRCONC |s| " \\right]")))))) - -(DEFUN |ILIST;member?;S$B;24| (|s| |x| $) - (PROG (#0=#:G1477) - (RETURN - (SEQ (EXIT (SEQ (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |x|) - (QREFELT $ 33))) - (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL |s| (QCAR |x|) - (QREFELT $ 47)) - (PROGN - (LETT #0# 'T - |ILIST;member?;S$B;24|) - (GO #0#))) - ('T - (LETT |x| (QCDR |x|) - |ILIST;member?;S$B;24|))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT 'NIL))) - #0# (EXIT #0#))))) - -(DEFUN |ILIST;concat!;3$;25| (|x| |y| $) - (PROG (|z|) - (RETURN - (SEQ (COND - ((NULL |x|) - (COND - ((NULL |y|) |x|) - ('T - (SEQ (PUSH (SPADCALL |y| (QREFELT $ 13)) |x|) - (QRPLACD |x| (SPADCALL |y| (QREFELT $ 18))) - (EXIT |x|))))) - ('T - (SEQ (LETT |z| |x| |ILIST;concat!;3$;25|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL (QCDR |z|)) - (QREFELT $ 33))) - (GO G191))) - (SEQ (EXIT (LETT |z| (QCDR |z|) - |ILIST;concat!;3$;25|))) - NIL (GO G190) G191 (EXIT NIL)) - (QRPLACD |z| |y|) (EXIT |x|)))))))) - -(DEFUN |ILIST;removeDuplicates!;2$;26| (|l| $) - (PROG (|f| |p| |pr| |pp|) - (RETURN - (SEQ (LETT |p| |l| |ILIST;removeDuplicates!;2$;26|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |p|) (QREFELT $ 33))) - (GO G191))) - (SEQ (LETT |pp| |p| |ILIST;removeDuplicates!;2$;26|) - (LETT |f| (QCAR |p|) - |ILIST;removeDuplicates!;2$;26|) - (LETT |p| (QCDR |p|) - |ILIST;removeDuplicates!;2$;26|) - (EXIT (SEQ G190 - (COND - ((NULL - (SPADCALL - (NULL - (LETT |pr| (QCDR |pp|) - |ILIST;removeDuplicates!;2$;26|)) - (QREFELT $ 33))) - (GO G191))) - (SEQ (EXIT - (COND - ((SPADCALL (QCAR |pr|) |f| - (QREFELT $ 47)) - (QRPLACD |pp| (QCDR |pr|))) - ('T - (LETT |pp| |pr| - |ILIST;removeDuplicates!;2$;26|))))) - NIL (GO G190) G191 (EXIT NIL)))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |l|))))) - -(DEFUN |ILIST;sort!;M2$;27| (|f| |l| $) - (|ILIST;mergeSort| |f| |l| (SPADCALL |l| (QREFELT $ 9)) $)) - -(DEFUN |ILIST;merge!;M3$;28| (|f| |p| |q| $) - (PROG (|r| |t|) - (RETURN - (SEQ (COND - ((NULL |p|) |q|) - ((NULL |q|) |p|) - ((EQ |p| |q|) (|error| "cannot merge a list into itself")) - ('T - (SEQ (COND - ((SPADCALL (QCAR |p|) (QCAR |q|) |f|) - (SEQ (LETT |r| - (LETT |t| |p| |ILIST;merge!;M3$;28|) - |ILIST;merge!;M3$;28|) - (EXIT (LETT |p| (QCDR |p|) - |ILIST;merge!;M3$;28|)))) - ('T - (SEQ (LETT |r| - (LETT |t| |q| |ILIST;merge!;M3$;28|) - |ILIST;merge!;M3$;28|) - (EXIT (LETT |q| (QCDR |q|) - |ILIST;merge!;M3$;28|))))) - (SEQ G190 - (COND - ((NULL (COND - ((NULL |p|) 'NIL) - ('T - (SPADCALL (NULL |q|) - (QREFELT $ 33))))) - (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL (QCAR |p|) (QCAR |q|) - |f|) - (SEQ (QRPLACD |t| |p|) - (LETT |t| |p| - |ILIST;merge!;M3$;28|) - (EXIT - (LETT |p| (QCDR |p|) - |ILIST;merge!;M3$;28|)))) - ('T - (SEQ (QRPLACD |t| |q|) - (LETT |t| |q| - |ILIST;merge!;M3$;28|) - (EXIT - (LETT |q| (QCDR |q|) - |ILIST;merge!;M3$;28|))))))) - NIL (GO G190) G191 (EXIT NIL)) - (QRPLACD |t| (COND ((NULL |p|) |q|) ('T |p|))) - (EXIT |r|)))))))) - -(DEFUN |ILIST;split!;$I$;29| (|p| |n| $) - (PROG (#0=#:G1506 |q|) - (RETURN - (SEQ (COND - ((< |n| 1) (|error| "index out of range")) - ('T - (SEQ (LETT |p| - (SPADCALL |p| - (PROG1 (LETT #0# (- |n| 1) - |ILIST;split!;$I$;29|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 32)) - |ILIST;split!;$I$;29|) - (LETT |q| (QCDR |p|) |ILIST;split!;$I$;29|) - (QRPLACD |p| NIL) (EXIT |q|)))))))) - -(DEFUN |ILIST;mergeSort| (|f| |p| |n| $) - (PROG (#0=#:G1510 |l| |q|) - (RETURN - (SEQ (COND - ((EQL |n| 2) - (COND - ((SPADCALL - (SPADCALL (SPADCALL |p| (QREFELT $ 18)) - (QREFELT $ 13)) - (SPADCALL |p| (QREFELT $ 13)) |f|) - (LETT |p| (SPADCALL |p| (QREFELT $ 28)) - |ILIST;mergeSort|))))) - (EXIT (COND - ((< |n| 3) |p|) - ('T - (SEQ (LETT |l| - (PROG1 (LETT #0# (QUOTIENT2 |n| 2) - |ILIST;mergeSort|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - |ILIST;mergeSort|) - (LETT |q| (SPADCALL |p| |l| (QREFELT $ 58)) - |ILIST;mergeSort|) - (LETT |p| (|ILIST;mergeSort| |f| |p| |l| $) - |ILIST;mergeSort|) - (LETT |q| - (|ILIST;mergeSort| |f| |q| (- |n| |l|) - $) - |ILIST;mergeSort|) - (EXIT (SPADCALL |f| |p| |q| (QREFELT $ 57))))))))))) - -(DEFUN |IndexedList| (&REST #0=#:G1525 &AUX #1=#:G1523) - (DSETQ #1# #0#) - (PROG () - (RETURN - (PROG (#2=#:G1524) - (RETURN - (COND - ((LETT #2# - (|lassocShiftWithFunction| (|devaluateList| #1#) - (HGET |$ConstructorCache| '|IndexedList|) - '|domainEqualList|) - |IndexedList|) - (|CDRwithIncrement| #2#)) - ('T - (UNWIND-PROTECT - (PROG1 (APPLY (|function| |IndexedList;|) #1#) - (LETT #2# T |IndexedList|)) - (COND - ((NOT #2#) (HREM |$ConstructorCache| '|IndexedList|))))))))))) - -(DEFUN |IndexedList;| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ #0=#:G1522 #1=#:G1520 |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #2=(|IndexedList|)) - (LETT |dv$2| (|devaluate| |#2|) . #2#) - (LETT |dv$| (LIST '|IndexedList| |dv$1| |dv$2|) . #2#) - (LETT $ (GETREFV 72) . #2#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasCategory| |#1| - '(|ConvertibleTo| (|InputForm|))) - (|HasCategory| |#1| '(|OrderedSet|)) - (|HasCategory| (|Integer|) '(|OrderedSet|)) - (LETT #0# - (|HasCategory| |#1| '(|SetCategory|)) . #2#) - (OR (|HasCategory| |#1| '(|OrderedSet|)) - #0#) - (AND #0# - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|)))) - (OR (AND (|HasCategory| |#1| - '(|OrderedSet|)) - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|)))) - (AND #0# - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|))))) - (LETT #1# - (|HasCategory| |#1| - '(|CoercibleTo| (|OutputForm|))) . #2#) - (OR (AND #0# - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|)))) - #1#))) . #2#)) - (|haddProp| |$ConstructorCache| '|IndexedList| - (LIST |dv$1| |dv$2|) (CONS 1 $)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (QSETREFV $ 7 |#2|) - (COND - ((|testBitVector| |pv$| 8) - (QSETREFV $ 46 - (CONS (|dispatchFunction| |ILIST;coerce;$Of;21|) $)))) - (COND - ((|testBitVector| |pv$| 4) - (PROGN - (QSETREFV $ 48 - (CONS (|dispatchFunction| |ILIST;=;2$B;22|) $)) - (QSETREFV $ 51 - (CONS (|dispatchFunction| |ILIST;latex;$S;23|) $)) - (QSETREFV $ 52 - (CONS (|dispatchFunction| |ILIST;member?;S$B;24|) $))))) - (COND - ((|testBitVector| |pv$| 4) - (QSETREFV $ 54 - (CONS (|dispatchFunction| - |ILIST;removeDuplicates!;2$;26|) - $)))) - $)))) - -(MAKEPROP '|IndexedList| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|NonNegativeInteger|) |ILIST;#;$Nni;1| - |ILIST;concat;S2$;2| (|Boolean|) |ILIST;eq?;2$B;3| - |ILIST;first;$S;4| '"first" |ILIST;elt;$firstS;5| - |ILIST;empty;$;6| |ILIST;empty?;$B;7| |ILIST;rest;2$;8| - '"rest" |ILIST;elt;$rest$;9| |ILIST;setfirst!;$2S;10| - |ILIST;setelt;$first2S;11| |ILIST;setrest!;3$;12| - |ILIST;setelt;$rest2$;13| (|List| 6) - |ILIST;construct;L$;14| |ILIST;parts;$L;15| - |ILIST;reverse!;2$;16| |ILIST;reverse;2$;17| (|Integer|) - |ILIST;minIndex;$I;18| |ILIST;rest;$Nni$;19| (0 . |not|) - (5 . |cyclic?|) |ILIST;copy;2$;20| (10 . |cycleEntry|) - (|OutputForm|) (15 . |coerce|) (|List| $) (20 . |bracket|) - (|List| 37) (25 . |list|) (30 . |commaSeparate|) - (35 . |overbar|) (40 . |concat!|) (46 . |coerce|) (51 . =) - (57 . =) (|String|) (63 . |latex|) (68 . |latex|) - (73 . |member?|) |ILIST;concat!;3$;25| - (79 . |removeDuplicates!|) (|Mapping| 11 6 6) - |ILIST;sort!;M2$;27| |ILIST;merge!;M3$;28| - |ILIST;split!;$I$;29| (|Mapping| 6 6 6) (|Equation| 6) - (|List| 60) (|Mapping| 11 6) (|Void|) - (|UniversalSegment| 30) '"last" '"value" (|Mapping| 6 6) - (|InputForm|) (|SingleInteger|) (|List| 30) - (|Union| 6 '"failed")) - '#(~= 84 |value| 90 |third| 95 |tail| 100 |swap!| 105 - |split!| 112 |sorted?| 118 |sort!| 129 |sort| 140 |size?| - 151 |setvalue!| 157 |setrest!| 163 |setlast!| 169 - |setfirst!| 175 |setelt| 181 |setchildren!| 223 |select!| - 229 |select| 235 |second| 241 |sample| 246 |reverse!| 250 - |reverse| 255 |rest| 260 |removeDuplicates!| 271 - |removeDuplicates| 276 |remove!| 281 |remove| 293 |reduce| - 305 |qsetelt!| 326 |qelt| 333 |possiblyInfinite?| 339 - |position| 344 |parts| 363 |nodes| 368 |node?| 373 |new| - 379 |more?| 385 |minIndex| 391 |min| 396 |merge!| 402 - |merge| 415 |members| 428 |member?| 433 |maxIndex| 439 - |max| 444 |map!| 450 |map| 456 |list| 469 |less?| 474 - |leaves| 480 |leaf?| 485 |latex| 490 |last| 495 |insert!| - 506 |insert| 520 |indices| 534 |index?| 539 |hash| 545 - |first| 550 |find| 561 |fill!| 567 |explicitlyFinite?| 573 - |every?| 578 |eval| 584 |eq?| 610 |entry?| 616 |entries| - 622 |empty?| 627 |empty| 632 |elt| 636 |distance| 679 - |delete!| 685 |delete| 697 |cyclic?| 709 |cycleTail| 714 - |cycleSplit!| 719 |cycleLength| 724 |cycleEntry| 729 - |count| 734 |copyInto!| 746 |copy| 753 |convert| 758 - |construct| 763 |concat!| 768 |concat| 780 |coerce| 803 - |children| 808 |child?| 813 |any?| 819 >= 825 > 831 = 837 - <= 843 < 849 |#| 855) - '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) - (CONS (|makeByteWordVec2| 9 - '(0 0 0 0 0 0 0 0 0 0 2 0 0 7 5 0 0 7 9 1 5)) - (CONS '#(|ListAggregate&| |StreamAggregate&| - |ExtensibleLinearAggregate&| - |FiniteLinearAggregate&| - |UnaryRecursiveAggregate&| |LinearAggregate&| - |RecursiveAggregate&| |IndexedAggregate&| - |Collection&| |HomogeneousAggregate&| - |OrderedSet&| |Aggregate&| |EltableAggregate&| - |Evalable&| |SetCategory&| NIL NIL - |InnerEvalable&| NIL NIL |BasicType&|) - (CONS '#((|ListAggregate| 6) - (|StreamAggregate| 6) - (|ExtensibleLinearAggregate| 6) - (|FiniteLinearAggregate| 6) - (|UnaryRecursiveAggregate| 6) - (|LinearAggregate| 6) - (|RecursiveAggregate| 6) - (|IndexedAggregate| 30 6) - (|Collection| 6) - (|HomogeneousAggregate| 6) - (|OrderedSet|) (|Aggregate|) - (|EltableAggregate| 30 6) (|Evalable| 6) - (|SetCategory|) (|Type|) - (|Eltable| 30 6) (|InnerEvalable| 6 6) - (|CoercibleTo| 37) (|ConvertibleTo| 68) - (|BasicType|)) - (|makeByteWordVec2| 71 - '(1 11 0 0 33 1 0 11 0 34 1 0 0 0 36 1 - 6 37 0 38 1 37 0 39 40 1 41 0 37 42 1 - 37 0 39 43 1 37 0 0 44 2 41 0 0 37 45 - 1 0 37 0 46 2 6 11 0 0 47 2 0 11 0 0 - 48 1 6 49 0 50 1 0 49 0 51 2 0 11 6 0 - 52 1 0 0 0 54 2 4 11 0 0 1 1 0 6 0 1 - 1 0 6 0 1 1 0 0 0 1 3 0 63 0 30 30 1 - 2 0 0 0 30 58 1 2 11 0 1 2 0 11 55 0 - 1 1 2 0 0 1 2 0 0 55 0 56 1 2 0 0 1 2 - 0 0 55 0 1 2 0 11 0 8 1 2 0 6 0 6 1 2 - 0 0 0 0 23 2 0 6 0 6 1 2 0 6 0 6 21 3 - 0 6 0 30 6 1 3 0 6 0 64 6 1 3 0 6 0 - 65 6 1 3 0 0 0 19 0 24 3 0 6 0 14 6 - 22 3 0 6 0 66 6 1 2 0 0 0 39 1 2 0 0 - 62 0 1 2 0 0 62 0 1 1 0 6 0 1 0 0 0 1 - 1 0 0 0 28 1 0 0 0 29 2 0 0 0 8 32 1 - 0 0 0 18 1 4 0 0 54 1 4 0 0 1 2 4 0 6 - 0 1 2 0 0 62 0 1 2 4 0 6 0 1 2 0 0 62 - 0 1 4 4 6 59 0 6 6 1 2 0 6 59 0 1 3 0 - 6 59 0 6 1 3 0 6 0 30 6 1 2 0 6 0 30 - 1 1 0 11 0 1 2 4 30 6 0 1 3 4 30 6 0 - 30 1 2 0 30 62 0 1 1 0 25 0 27 1 0 39 - 0 1 2 4 11 0 0 1 2 0 0 8 6 1 2 0 11 0 - 8 1 1 3 30 0 31 2 2 0 0 0 1 2 2 0 0 0 - 1 3 0 0 55 0 0 57 2 2 0 0 0 1 3 0 0 - 55 0 0 1 1 0 25 0 1 2 4 11 6 0 52 1 3 - 30 0 1 2 2 0 0 0 1 2 0 0 67 0 1 3 0 0 - 59 0 0 1 2 0 0 67 0 1 1 0 0 6 1 2 0 - 11 0 8 1 1 0 25 0 1 1 0 11 0 1 1 4 49 - 0 51 2 0 0 0 8 1 1 0 6 0 1 3 0 0 6 0 - 30 1 3 0 0 0 0 30 1 3 0 0 0 0 30 1 3 - 0 0 6 0 30 1 1 0 70 0 1 2 0 11 30 0 1 - 1 4 69 0 1 2 0 0 0 8 1 1 0 6 0 13 2 0 - 71 62 0 1 2 0 0 0 6 1 1 0 11 0 1 2 0 - 11 62 0 1 3 6 0 0 6 6 1 3 6 0 0 25 25 - 1 2 6 0 0 60 1 2 6 0 0 61 1 2 0 11 0 - 0 12 2 4 11 6 0 1 1 0 25 0 1 1 0 11 0 - 17 0 0 0 16 2 0 6 0 30 1 3 0 6 0 30 6 - 1 2 0 0 0 64 1 2 0 6 0 65 1 2 0 0 0 - 19 20 2 0 6 0 14 15 2 0 6 0 66 1 2 0 - 30 0 0 1 2 0 0 0 64 1 2 0 0 0 30 1 2 - 0 0 0 64 1 2 0 0 0 30 1 1 0 11 0 34 1 - 0 0 0 1 1 0 0 0 1 1 0 8 0 1 1 0 0 0 - 36 2 4 8 6 0 1 2 0 8 62 0 1 3 0 0 0 0 - 30 1 1 0 0 0 35 1 1 68 0 1 1 0 0 25 - 26 2 0 0 0 0 53 2 0 0 0 6 1 1 0 0 39 - 1 2 0 0 0 6 1 2 0 0 6 0 10 2 0 0 0 0 - 1 1 8 37 0 46 1 0 39 0 1 2 4 11 0 0 1 - 2 0 11 62 0 1 2 2 11 0 0 1 2 2 11 0 0 - 1 2 4 11 0 0 48 2 2 11 0 0 1 2 2 11 0 - 0 1 1 0 8 0 9))))) - '|lookupComplete|)) -@ \section{domain LIST List} <<domain LIST List>>= )abbrev domain LIST List @@ -970,320 +338,7 @@ List(S:Type): Exports == Implementation where [convert a for a in (x pretend List S)]$List(InputForm)) @ -\section{LIST.lsp BOOTSTRAP} -{\bf LIST} depends on a chain of -files. We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf LIST} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf LIST.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<LIST.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(PUT '|LIST;nil;$;1| '|SPADreplace| '(XLAM NIL NIL)) - -(DEFUN |LIST;nil;$;1| ($) NIL) -(PUT '|LIST;null;$B;2| '|SPADreplace| 'NULL) - -(DEFUN |LIST;null;$B;2| (|l| $) (NULL |l|)) - -(PUT '|LIST;cons;S2$;3| '|SPADreplace| 'CONS) - -(DEFUN |LIST;cons;S2$;3| (|s| |l| $) (CONS |s| |l|)) - -(PUT '|LIST;append;3$;4| '|SPADreplace| 'APPEND) - -(DEFUN |LIST;append;3$;4| (|l| |t| $) (APPEND |l| |t|)) - -(DEFUN |LIST;writeOMList| (|dev| |x| $) - (SEQ (SPADCALL |dev| (QREFELT $ 14)) - (SPADCALL |dev| "list1" "list" (QREFELT $ 16)) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |x|) (QREFELT $ 17))) (GO G191))) - (SEQ (SPADCALL |dev| (|SPADfirst| |x|) 'NIL (QREFELT $ 18)) - (EXIT (LETT |x| (CDR |x|) |LIST;writeOMList|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |dev| (QREFELT $ 19))))) - -(DEFUN |LIST;OMwrite;$S;6| (|x| $) - (PROG (|sp| |dev| |s|) - (RETURN - (SEQ (LETT |s| "" |LIST;OMwrite;$S;6|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |LIST;OMwrite;$S;6|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (QREFELT $ 21)) - (QREFELT $ 22)) - |LIST;OMwrite;$S;6|) - (SPADCALL |dev| (QREFELT $ 23)) - (|LIST;writeOMList| |dev| |x| $) - (SPADCALL |dev| (QREFELT $ 24)) - (SPADCALL |dev| (QREFELT $ 25)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |LIST;OMwrite;$S;6|) - (EXIT |s|))))) - -(DEFUN |LIST;OMwrite;$BS;7| (|x| |wholeObj| $) - (PROG (|sp| |dev| |s|) - (RETURN - (SEQ (LETT |s| "" |LIST;OMwrite;$BS;7|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |LIST;OMwrite;$BS;7|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (QREFELT $ 21)) - (QREFELT $ 22)) - |LIST;OMwrite;$BS;7|) - (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 23)))) - (|LIST;writeOMList| |dev| |x| $) - (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 24)))) - (SPADCALL |dev| (QREFELT $ 25)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |LIST;OMwrite;$BS;7|) - (EXIT |s|))))) - -(DEFUN |LIST;OMwrite;Omd$V;8| (|dev| |x| $) - (SEQ (SPADCALL |dev| (QREFELT $ 23)) (|LIST;writeOMList| |dev| |x| $) - (EXIT (SPADCALL |dev| (QREFELT $ 24))))) - -(DEFUN |LIST;OMwrite;Omd$BV;9| (|dev| |x| |wholeObj| $) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 23)))) - (|LIST;writeOMList| |dev| |x| $) - (EXIT (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 24))))))) - -(DEFUN |LIST;setUnion;3$;10| (|l1| |l2| $) - (SPADCALL (SPADCALL |l1| |l2| (QREFELT $ 30)) (QREFELT $ 31))) - -(DEFUN |LIST;setIntersection;3$;11| (|l1| |l2| $) - (PROG (|u|) - (RETURN - (SEQ (LETT |u| NIL |LIST;setIntersection;3$;11|) - (LETT |l1| (SPADCALL |l1| (QREFELT $ 31)) - |LIST;setIntersection;3$;11|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |l1|) (QREFELT $ 17))) - (GO G191))) - (SEQ (COND - ((SPADCALL (|SPADfirst| |l1|) |l2| - (QREFELT $ 33)) - (LETT |u| (CONS (|SPADfirst| |l1|) |u|) - |LIST;setIntersection;3$;11|))) - (EXIT (LETT |l1| (CDR |l1|) - |LIST;setIntersection;3$;11|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |u|))))) - -(DEFUN |LIST;setDifference;3$;12| (|l1| |l2| $) - (PROG (|l11| |lu|) - (RETURN - (SEQ (LETT |l1| (SPADCALL |l1| (QREFELT $ 31)) - |LIST;setDifference;3$;12|) - (LETT |lu| NIL |LIST;setDifference;3$;12|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |l1|) (QREFELT $ 17))) - (GO G191))) - (SEQ (LETT |l11| (SPADCALL |l1| 1 (QREFELT $ 36)) - |LIST;setDifference;3$;12|) - (COND - ((NULL (SPADCALL |l11| |l2| (QREFELT $ 33))) - (LETT |lu| (CONS |l11| |lu|) - |LIST;setDifference;3$;12|))) - (EXIT (LETT |l1| (CDR |l1|) - |LIST;setDifference;3$;12|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |lu|))))) - -(DEFUN |LIST;convert;$If;13| (|x| $) - (PROG (#0=#:G1440 |a| #1=#:G1441) - (RETURN - (SEQ (SPADCALL - (CONS (SPADCALL (SPADCALL "construct" (QREFELT $ 39)) - (QREFELT $ 41)) - (PROGN - (LETT #0# NIL |LIST;convert;$If;13|) - (SEQ (LETT |a| NIL |LIST;convert;$If;13|) - (LETT #1# |x| |LIST;convert;$If;13|) G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |a| (CAR #1#) - |LIST;convert;$If;13|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (SPADCALL |a| (QREFELT $ 42)) - #0#) - |LIST;convert;$If;13|))) - (LETT #1# (CDR #1#) |LIST;convert;$If;13|) - (GO G190) G191 (EXIT (NREVERSE0 #0#))))) - (QREFELT $ 44)))))) - -(DEFUN |List| (#0=#:G1452) - (PROG () - (RETURN - (PROG (#1=#:G1453) - (RETURN - (COND - ((LETT #1# - (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) - (HGET |$ConstructorCache| '|List|) - '|domainEqualList|) - |List|) - (|CDRwithIncrement| #1#)) - ('T - (UNWIND-PROTECT - (PROG1 (|List;| #0#) (LETT #1# T |List|)) - (COND ((NOT #1#) (HREM |$ConstructorCache| '|List|))))))))))) - -(DEFUN |List;| (|#1|) - (PROG (|dv$1| |dv$| $ #0=#:G1451 #1=#:G1449 |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #2=(|List|)) - (LETT |dv$| (LIST '|List| |dv$1|) . #2#) - (LETT $ (GETREFV 63) . #2#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasCategory| |#1| - '(|ConvertibleTo| (|InputForm|))) - (|HasCategory| |#1| '(|OrderedSet|)) - (|HasCategory| |#1| '(|OpenMath|)) - (|HasCategory| (|Integer|) '(|OrderedSet|)) - (LETT #0# - (|HasCategory| |#1| '(|SetCategory|)) . #2#) - (OR (|HasCategory| |#1| '(|OrderedSet|)) - #0#) - (AND #0# - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|)))) - (OR (AND (|HasCategory| |#1| - '(|OrderedSet|)) - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|)))) - (AND #0# - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|))))) - (LETT #1# - (|HasCategory| |#1| - '(|CoercibleTo| (|OutputForm|))) . #2#) - (OR (AND #0# - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|)))) - #1#))) . #2#)) - (|haddProp| |$ConstructorCache| '|List| (LIST |dv$1|) - (CONS 1 $)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (COND - ((|testBitVector| |pv$| 3) - (PROGN - (QSETREFV $ 26 - (CONS (|dispatchFunction| |LIST;OMwrite;$S;6|) $)) - (QSETREFV $ 27 - (CONS (|dispatchFunction| |LIST;OMwrite;$BS;7|) $)) - (QSETREFV $ 28 - (CONS (|dispatchFunction| |LIST;OMwrite;Omd$V;8|) $)) - (QSETREFV $ 29 - (CONS (|dispatchFunction| |LIST;OMwrite;Omd$BV;9|) $))))) - (COND - ((|testBitVector| |pv$| 5) - (PROGN - (QSETREFV $ 32 - (CONS (|dispatchFunction| |LIST;setUnion;3$;10|) $)) - (QSETREFV $ 34 - (CONS (|dispatchFunction| - |LIST;setIntersection;3$;11|) - $)) - (QSETREFV $ 37 - (CONS (|dispatchFunction| |LIST;setDifference;3$;12|) - $))))) - (COND - ((|testBitVector| |pv$| 1) - (QSETREFV $ 45 - (CONS (|dispatchFunction| |LIST;convert;$If;13|) $)))) - $)))) - -(MAKEPROP '|List| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL (|IndexedList| 6 (NRTEVAL 1)) - (|local| |#1|) |LIST;nil;$;1| (|Boolean|) |LIST;null;$B;2| - |LIST;cons;S2$;3| |LIST;append;3$;4| (|Void|) - (|OpenMathDevice|) (0 . |OMputApp|) (|String|) - (5 . |OMputSymbol|) (12 . |not|) (17 . |OMwrite|) - (24 . |OMputEndApp|) (|OpenMathEncoding|) - (29 . |OMencodingXML|) (33 . |OMopenString|) - (39 . |OMputObject|) (44 . |OMputEndObject|) - (49 . |OMclose|) (54 . |OMwrite|) (59 . |OMwrite|) - (65 . |OMwrite|) (71 . |OMwrite|) (78 . |concat|) - (84 . |removeDuplicates|) (89 . |setUnion|) - (95 . |member?|) (101 . |setIntersection|) (|Integer|) - (107 . |elt|) (113 . |setDifference|) (|Symbol|) - (119 . |coerce|) (|InputForm|) (124 . |convert|) - (129 . |convert|) (|List| $) (134 . |convert|) - (139 . |convert|) (|Mapping| 6 6 6) (|NonNegativeInteger|) - (|List| 6) (|List| 50) (|Equation| 6) (|Mapping| 8 6) - (|Mapping| 8 6 6) (|UniversalSegment| 35) '"last" '"rest" - '"first" '"value" (|Mapping| 6 6) (|OutputForm|) - (|SingleInteger|) (|List| 35) (|Union| 6 '"failed")) - '#(|setUnion| 144 |setIntersection| 150 |setDifference| 156 - |removeDuplicates| 162 |null| 167 |nil| 172 |member?| 176 - |elt| 182 |convert| 188 |cons| 193 |concat| 199 |append| - 205 |OMwrite| 211) - '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) - (CONS (|makeByteWordVec2| 10 - '(0 0 0 0 0 0 0 0 0 0 2 0 0 8 6 0 0 8 10 1 6 3)) - (CONS '#(|ListAggregate&| |StreamAggregate&| - |ExtensibleLinearAggregate&| - |FiniteLinearAggregate&| - |UnaryRecursiveAggregate&| |LinearAggregate&| - |RecursiveAggregate&| |IndexedAggregate&| - |Collection&| |HomogeneousAggregate&| - |OrderedSet&| |Aggregate&| |EltableAggregate&| - |Evalable&| |SetCategory&| NIL NIL - |InnerEvalable&| NIL NIL |BasicType&| NIL) - (CONS '#((|ListAggregate| 6) - (|StreamAggregate| 6) - (|ExtensibleLinearAggregate| 6) - (|FiniteLinearAggregate| 6) - (|UnaryRecursiveAggregate| 6) - (|LinearAggregate| 6) - (|RecursiveAggregate| 6) - (|IndexedAggregate| 35 6) - (|Collection| 6) - (|HomogeneousAggregate| 6) - (|OrderedSet|) (|Aggregate|) - (|EltableAggregate| 35 6) (|Evalable| 6) - (|SetCategory|) (|Type|) - (|Eltable| 35 6) (|InnerEvalable| 6 6) - (|CoercibleTo| 59) (|ConvertibleTo| 40) - (|BasicType|) (|OpenMath|)) - (|makeByteWordVec2| 45 - '(1 13 12 0 14 3 13 12 0 15 15 16 1 8 0 - 0 17 3 6 12 13 0 8 18 1 13 12 0 19 0 - 20 0 21 2 13 0 15 20 22 1 13 12 0 23 - 1 13 12 0 24 1 13 12 0 25 1 0 15 0 26 - 2 0 15 0 8 27 2 0 12 13 0 28 3 0 12 - 13 0 8 29 2 0 0 0 0 30 1 0 0 0 31 2 0 - 0 0 0 32 2 0 8 6 0 33 2 0 0 0 0 34 2 - 0 6 0 35 36 2 0 0 0 0 37 1 38 0 15 39 - 1 40 0 38 41 1 6 40 0 42 1 40 0 43 44 - 1 0 40 0 45 2 5 0 0 0 32 2 5 0 0 0 34 - 2 5 0 0 0 37 1 5 0 0 31 1 0 8 0 9 0 0 - 0 7 2 5 8 6 0 33 2 0 6 0 35 36 1 1 40 - 0 45 2 0 0 6 0 10 2 0 0 0 0 30 2 0 0 - 0 0 11 3 3 12 13 0 8 29 2 3 12 13 0 - 28 1 3 15 0 26 2 3 15 0 8 27))))) - '|lookupIncomplete|)) -@ \section{package LIST2 ListFunctions2} <<package LIST2 ListFunctions2>>= )abbrev package LIST2 ListFunctions2 diff --git a/src/algebra/outform.spad.pamphlet b/src/algebra/outform.spad.pamphlet index 8fd70793..3f5c2aaf 100644 --- a/src/algebra/outform.spad.pamphlet +++ b/src/algebra/outform.spad.pamphlet @@ -656,644 +656,7 @@ OutputForm(): SetCategory with int(a,b,c) == [eform INTSIGN,b, c, a] @ -\section{OUTFORM.lsp BOOTSTRAP} -{\bf OUTFORM} depends on itself. -We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf OUTFORM} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf OUTFORM.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. -Note that this code is not included in the generated catdef.spad file. - -<<OUTFORM.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(PUT '|OUTFORM;print;$V;1| '|SPADreplace| '|mathprint|) - -(DEFUN |OUTFORM;print;$V;1| (|x| $) (|mathprint| |x|)) - -(DEFUN |OUTFORM;message;S$;2| (|s| $) - (COND - ((SPADCALL |s| (QREFELT $ 11)) (SPADCALL (QREFELT $ 12))) - ('T |s|))) - -(DEFUN |OUTFORM;messagePrint;SV;3| (|s| $) - (SPADCALL (SPADCALL |s| (QREFELT $ 13)) (QREFELT $ 8))) - -(PUT '|OUTFORM;=;2$B;4| '|SPADreplace| 'EQUAL) - -(DEFUN |OUTFORM;=;2$B;4| (|a| |b| $) (EQUAL |a| |b|)) - -(DEFUN |OUTFORM;=;3$;5| (|a| |b| $) - (LIST (|OUTFORM;sform| "=" $) |a| |b|)) - -(PUT '|OUTFORM;coerce;$Of;6| '|SPADreplace| '(XLAM (|a|) |a|)) - -(DEFUN |OUTFORM;coerce;$Of;6| (|a| $) |a|) - -(PUT '|OUTFORM;outputForm;I$;7| '|SPADreplace| '(XLAM (|n|) |n|)) - -(DEFUN |OUTFORM;outputForm;I$;7| (|n| $) |n|) - -(PUT '|OUTFORM;outputForm;S$;8| '|SPADreplace| '(XLAM (|e|) |e|)) - -(DEFUN |OUTFORM;outputForm;S$;8| (|e| $) |e|) - -(PUT '|OUTFORM;outputForm;Df$;9| '|SPADreplace| '(XLAM (|f|) |f|)) - -(DEFUN |OUTFORM;outputForm;Df$;9| (|f| $) |f|) - -(PUT '|OUTFORM;sform| '|SPADreplace| '(XLAM (|s|) |s|)) - -(DEFUN |OUTFORM;sform| (|s| $) |s|) - -(PUT '|OUTFORM;eform| '|SPADreplace| '(XLAM (|e|) |e|)) - -(DEFUN |OUTFORM;eform| (|e| $) |e|) - -(PUT '|OUTFORM;iform| '|SPADreplace| '(XLAM (|n|) |n|)) - -(DEFUN |OUTFORM;iform| (|n| $) |n|) - -(DEFUN |OUTFORM;outputForm;S$;13| (|s| $) - (|OUTFORM;sform| - (SPADCALL (SPADCALL (QREFELT $ 26)) - (SPADCALL |s| (SPADCALL (QREFELT $ 26)) (QREFELT $ 27)) - (QREFELT $ 28)) - $)) - -(PUT '|OUTFORM;width;$I;14| '|SPADreplace| '|outformWidth|) - -(DEFUN |OUTFORM;width;$I;14| (|a| $) (|outformWidth| |a|)) - -(PUT '|OUTFORM;height;$I;15| '|SPADreplace| '|height|) - -(DEFUN |OUTFORM;height;$I;15| (|a| $) (|height| |a|)) - -(PUT '|OUTFORM;subHeight;$I;16| '|SPADreplace| '|subspan|) - -(DEFUN |OUTFORM;subHeight;$I;16| (|a| $) (|subspan| |a|)) - -(PUT '|OUTFORM;superHeight;$I;17| '|SPADreplace| '|superspan|) - -(DEFUN |OUTFORM;superHeight;$I;17| (|a| $) (|superspan| |a|)) - -(PUT '|OUTFORM;height;I;18| '|SPADreplace| '(XLAM NIL 20)) - -(DEFUN |OUTFORM;height;I;18| ($) 20) - -(PUT '|OUTFORM;width;I;19| '|SPADreplace| '(XLAM NIL 66)) - -(DEFUN |OUTFORM;width;I;19| ($) 66) - -(DEFUN |OUTFORM;center;$I$;20| (|a| |w| $) - (SPADCALL - (SPADCALL (QUOTIENT2 (- |w| (SPADCALL |a| (QREFELT $ 30))) 2) - (QREFELT $ 36)) - |a| (QREFELT $ 37))) - -(DEFUN |OUTFORM;left;$I$;21| (|a| |w| $) - (SPADCALL |a| - (SPADCALL (- |w| (SPADCALL |a| (QREFELT $ 30))) (QREFELT $ 36)) - (QREFELT $ 37))) - -(DEFUN |OUTFORM;right;$I$;22| (|a| |w| $) - (SPADCALL - (SPADCALL (- |w| (SPADCALL |a| (QREFELT $ 30))) (QREFELT $ 36)) - |a| (QREFELT $ 37))) - -(DEFUN |OUTFORM;center;2$;23| (|a| $) - (SPADCALL |a| (SPADCALL (QREFELT $ 35)) (QREFELT $ 38))) - -(DEFUN |OUTFORM;left;2$;24| (|a| $) - (SPADCALL |a| (SPADCALL (QREFELT $ 35)) (QREFELT $ 39))) - -(DEFUN |OUTFORM;right;2$;25| (|a| $) - (SPADCALL |a| (SPADCALL (QREFELT $ 35)) (QREFELT $ 40))) - -(DEFUN |OUTFORM;vspace;I$;26| (|n| $) - (COND - ((EQL |n| 0) (SPADCALL (QREFELT $ 12))) - ('T - (SPADCALL (|OUTFORM;sform| " " $) - (SPADCALL (- |n| 1) (QREFELT $ 44)) (QREFELT $ 45))))) - -(DEFUN |OUTFORM;hspace;I$;27| (|n| $) - (COND - ((EQL |n| 0) (SPADCALL (QREFELT $ 12))) - ('T (|OUTFORM;sform| (|fillerSpaces| |n|) $)))) - -(DEFUN |OUTFORM;rspace;2I$;28| (|n| |m| $) - (COND - ((OR (EQL |n| 0) (EQL |m| 0)) (SPADCALL (QREFELT $ 12))) - ('T - (SPADCALL (SPADCALL |n| (QREFELT $ 36)) - (SPADCALL |n| (- |m| 1) (QREFELT $ 46)) (QREFELT $ 45))))) - -(DEFUN |OUTFORM;matrix;L$;29| (|ll| $) - (PROG (#0=#:G1437 |l| #1=#:G1438 |lv|) - (RETURN - (SEQ (LETT |lv| - (PROGN - (LETT #0# NIL |OUTFORM;matrix;L$;29|) - (SEQ (LETT |l| NIL |OUTFORM;matrix;L$;29|) - (LETT #1# |ll| |OUTFORM;matrix;L$;29|) G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |l| (CAR #1#) - |OUTFORM;matrix;L$;29|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# (CONS (LIST2VEC |l|) #0#) - |OUTFORM;matrix;L$;29|))) - (LETT #1# (CDR #1#) |OUTFORM;matrix;L$;29|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - |OUTFORM;matrix;L$;29|) - (EXIT (CONS (|OUTFORM;eform| 'MATRIX $) (LIST2VEC |lv|))))))) - -(DEFUN |OUTFORM;pile;L$;30| (|l| $) - (CONS (|OUTFORM;eform| 'SC $) |l|)) - -(DEFUN |OUTFORM;commaSeparate;L$;31| (|l| $) - (CONS (|OUTFORM;eform| 'AGGLST $) |l|)) - -(DEFUN |OUTFORM;semicolonSeparate;L$;32| (|l| $) - (CONS (|OUTFORM;eform| 'AGGSET $) |l|)) - -(DEFUN |OUTFORM;blankSeparate;L$;33| (|l| $) - (PROG (|c| |u| #0=#:G1446 |l1|) - (RETURN - (SEQ (LETT |c| (|OUTFORM;eform| 'CONCATB $) - |OUTFORM;blankSeparate;L$;33|) - (LETT |l1| NIL |OUTFORM;blankSeparate;L$;33|) - (SEQ (LETT |u| NIL |OUTFORM;blankSeparate;L$;33|) - (LETT #0# (SPADCALL |l| (QREFELT $ 53)) - |OUTFORM;blankSeparate;L$;33|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |u| (CAR #0#) - |OUTFORM;blankSeparate;L$;33|) - NIL)) - (GO G191))) - (SEQ (EXIT (COND - ((EQCAR |u| |c|) - (LETT |l1| - (SPADCALL (CDR |u|) |l1| - (QREFELT $ 54)) - |OUTFORM;blankSeparate;L$;33|)) - ('T - (LETT |l1| (CONS |u| |l1|) - |OUTFORM;blankSeparate;L$;33|))))) - (LETT #0# (CDR #0#) |OUTFORM;blankSeparate;L$;33|) - (GO G190) G191 (EXIT NIL)) - (EXIT (CONS |c| |l1|)))))) - -(DEFUN |OUTFORM;brace;2$;34| (|a| $) - (LIST (|OUTFORM;eform| 'BRACE $) |a|)) - -(DEFUN |OUTFORM;brace;L$;35| (|l| $) - (SPADCALL (SPADCALL |l| (QREFELT $ 51)) (QREFELT $ 56))) - -(DEFUN |OUTFORM;bracket;2$;36| (|a| $) - (LIST (|OUTFORM;eform| 'BRACKET $) |a|)) - -(DEFUN |OUTFORM;bracket;L$;37| (|l| $) - (SPADCALL (SPADCALL |l| (QREFELT $ 51)) (QREFELT $ 58))) - -(DEFUN |OUTFORM;paren;2$;38| (|a| $) - (LIST (|OUTFORM;eform| 'PAREN $) |a|)) - -(DEFUN |OUTFORM;paren;L$;39| (|l| $) - (SPADCALL (SPADCALL |l| (QREFELT $ 51)) (QREFELT $ 60))) - -(DEFUN |OUTFORM;sub;3$;40| (|a| |b| $) - (LIST (|OUTFORM;eform| 'SUB $) |a| |b|)) - -(DEFUN |OUTFORM;super;3$;41| (|a| |b| $) - (LIST (|OUTFORM;eform| 'SUPERSUB $) |a| (|OUTFORM;sform| " " $) |b|)) - -(DEFUN |OUTFORM;presub;3$;42| (|a| |b| $) - (LIST (|OUTFORM;eform| 'SUPERSUB $) |a| (|OUTFORM;sform| " " $) - (|OUTFORM;sform| " " $) (|OUTFORM;sform| " " $) |b|)) - -(DEFUN |OUTFORM;presuper;3$;43| (|a| |b| $) - (LIST (|OUTFORM;eform| 'SUPERSUB $) |a| (|OUTFORM;sform| " " $) - (|OUTFORM;sform| " " $) |b|)) - -(DEFUN |OUTFORM;scripts;$L$;44| (|a| |l| $) - (COND - ((SPADCALL |l| (QREFELT $ 66)) |a|) - ((SPADCALL (SPADCALL |l| (QREFELT $ 67)) (QREFELT $ 66)) - (SPADCALL |a| (SPADCALL |l| (QREFELT $ 68)) (QREFELT $ 62))) - ('T (CONS (|OUTFORM;eform| 'SUPERSUB $) (CONS |a| |l|))))) - -(DEFUN |OUTFORM;supersub;$L$;45| (|a| |l| $) - (SEQ (COND - ((ODDP (SPADCALL |l| (QREFELT $ 71))) - (LETT |l| - (SPADCALL |l| (LIST (SPADCALL (QREFELT $ 12))) - (QREFELT $ 73)) - |OUTFORM;supersub;$L$;45|))) - (EXIT (CONS (|OUTFORM;eform| 'ALTSUPERSUB $) (CONS |a| |l|))))) - -(DEFUN |OUTFORM;hconcat;3$;46| (|a| |b| $) - (LIST (|OUTFORM;eform| 'CONCAT $) |a| |b|)) - -(DEFUN |OUTFORM;hconcat;L$;47| (|l| $) - (CONS (|OUTFORM;eform| 'CONCAT $) |l|)) - -(DEFUN |OUTFORM;vconcat;3$;48| (|a| |b| $) - (LIST (|OUTFORM;eform| 'VCONCAT $) |a| |b|)) - -(DEFUN |OUTFORM;vconcat;L$;49| (|l| $) - (CONS (|OUTFORM;eform| 'VCONCAT $) |l|)) - -(DEFUN |OUTFORM;~=;3$;50| (|a| |b| $) - (LIST (|OUTFORM;sform| "~=" $) |a| |b|)) - -(DEFUN |OUTFORM;<;3$;51| (|a| |b| $) - (LIST (|OUTFORM;sform| "<" $) |a| |b|)) - -(DEFUN |OUTFORM;>;3$;52| (|a| |b| $) - (LIST (|OUTFORM;sform| ">" $) |a| |b|)) - -(DEFUN |OUTFORM;<=;3$;53| (|a| |b| $) - (LIST (|OUTFORM;sform| "<=" $) |a| |b|)) - -(DEFUN |OUTFORM;>=;3$;54| (|a| |b| $) - (LIST (|OUTFORM;sform| ">=" $) |a| |b|)) - -(DEFUN |OUTFORM;+;3$;55| (|a| |b| $) - (LIST (|OUTFORM;sform| "+" $) |a| |b|)) - -(DEFUN |OUTFORM;-;3$;56| (|a| |b| $) - (LIST (|OUTFORM;sform| "-" $) |a| |b|)) - -(DEFUN |OUTFORM;-;2$;57| (|a| $) (LIST (|OUTFORM;sform| "-" $) |a|)) - -(DEFUN |OUTFORM;*;3$;58| (|a| |b| $) - (LIST (|OUTFORM;sform| "*" $) |a| |b|)) - -(DEFUN |OUTFORM;/;3$;59| (|a| |b| $) - (LIST (|OUTFORM;sform| "/" $) |a| |b|)) - -(DEFUN |OUTFORM;**;3$;60| (|a| |b| $) - (LIST (|OUTFORM;sform| "**" $) |a| |b|)) - -(DEFUN |OUTFORM;div;3$;61| (|a| |b| $) - (LIST (|OUTFORM;sform| "div" $) |a| |b|)) - -(DEFUN |OUTFORM;rem;3$;62| (|a| |b| $) - (LIST (|OUTFORM;sform| "rem" $) |a| |b|)) - -(DEFUN |OUTFORM;quo;3$;63| (|a| |b| $) - (LIST (|OUTFORM;sform| "quo" $) |a| |b|)) - -(DEFUN |OUTFORM;exquo;3$;64| (|a| |b| $) - (LIST (|OUTFORM;sform| "exquo" $) |a| |b|)) - -(DEFUN |OUTFORM;and;3$;65| (|a| |b| $) - (LIST (|OUTFORM;sform| "and" $) |a| |b|)) - -(DEFUN |OUTFORM;or;3$;66| (|a| |b| $) - (LIST (|OUTFORM;sform| "or" $) |a| |b|)) - -(DEFUN |OUTFORM;not;2$;67| (|a| $) - (LIST (|OUTFORM;sform| "not" $) |a|)) - -(DEFUN |OUTFORM;SEGMENT;3$;68| (|a| |b| $) - (LIST (|OUTFORM;eform| 'SEGMENT $) |a| |b|)) - -(DEFUN |OUTFORM;SEGMENT;2$;69| (|a| $) - (LIST (|OUTFORM;eform| 'SEGMENT $) |a|)) - -(DEFUN |OUTFORM;binomial;3$;70| (|a| |b| $) - (LIST (|OUTFORM;eform| 'BINOMIAL $) |a| |b|)) - -(DEFUN |OUTFORM;empty;$;71| ($) (LIST (|OUTFORM;eform| 'NOTHING $))) - -(DEFUN |OUTFORM;infix?;$B;72| (|a| $) - (PROG (#0=#:G1491 |e|) - (RETURN - (SEQ (EXIT (SEQ (LETT |e| - (COND - ((IDENTP |a|) |a|) - ((STRINGP |a|) (INTERN |a|)) - ('T - (PROGN - (LETT #0# 'NIL |OUTFORM;infix?;$B;72|) - (GO #0#)))) - |OUTFORM;infix?;$B;72|) - (EXIT (COND ((GET |e| 'INFIXOP) 'T) ('T 'NIL))))) - #0# (EXIT #0#))))) - -(PUT '|OUTFORM;elt;$L$;73| '|SPADreplace| 'CONS) - -(DEFUN |OUTFORM;elt;$L$;73| (|a| |l| $) (CONS |a| |l|)) - -(DEFUN |OUTFORM;prefix;$L$;74| (|a| |l| $) - (COND - ((NULL (SPADCALL |a| (QREFELT $ 98))) (CONS |a| |l|)) - ('T - (SPADCALL |a| - (SPADCALL (SPADCALL |l| (QREFELT $ 51)) (QREFELT $ 60)) - (QREFELT $ 37))))) - -(DEFUN |OUTFORM;infix;$L$;75| (|a| |l| $) - (COND - ((SPADCALL |l| (QREFELT $ 66)) (SPADCALL (QREFELT $ 12))) - ((SPADCALL (SPADCALL |l| (QREFELT $ 67)) (QREFELT $ 66)) - (SPADCALL |l| (QREFELT $ 68))) - ((SPADCALL |a| (QREFELT $ 98)) (CONS |a| |l|)) - ('T - (SPADCALL - (LIST (SPADCALL |l| (QREFELT $ 68)) |a| - (SPADCALL |a| (SPADCALL |l| (QREFELT $ 101)) - (QREFELT $ 102))) - (QREFELT $ 75))))) - -(DEFUN |OUTFORM;infix;4$;76| (|a| |b| |c| $) - (COND - ((SPADCALL |a| (QREFELT $ 98)) (LIST |a| |b| |c|)) - ('T (SPADCALL (LIST |b| |a| |c|) (QREFELT $ 75))))) - -(DEFUN |OUTFORM;postfix;3$;77| (|a| |b| $) - (SPADCALL |b| |a| (QREFELT $ 37))) - -(DEFUN |OUTFORM;string;2$;78| (|a| $) - (LIST (|OUTFORM;eform| 'STRING $) |a|)) - -(DEFUN |OUTFORM;quote;2$;79| (|a| $) - (LIST (|OUTFORM;eform| 'QUOTE $) |a|)) - -(DEFUN |OUTFORM;overbar;2$;80| (|a| $) - (LIST (|OUTFORM;eform| 'OVERBAR $) |a|)) - -(DEFUN |OUTFORM;dot;2$;81| (|a| $) - (SPADCALL |a| (|OUTFORM;sform| "." $) (QREFELT $ 63))) - -(DEFUN |OUTFORM;prime;2$;82| (|a| $) - (SPADCALL |a| (|OUTFORM;sform| "," $) (QREFELT $ 63))) - -(DEFUN |OUTFORM;dot;$Nni$;83| (|a| |nn| $) - (PROG (|s|) - (RETURN - (SEQ (LETT |s| - (MAKE-FULL-CVEC |nn| (SPADCALL "." (QREFELT $ 110))) - |OUTFORM;dot;$Nni$;83|) - (EXIT (SPADCALL |a| (|OUTFORM;sform| |s| $) (QREFELT $ 63))))))) - -(DEFUN |OUTFORM;prime;$Nni$;84| (|a| |nn| $) - (PROG (|s|) - (RETURN - (SEQ (LETT |s| - (MAKE-FULL-CVEC |nn| (SPADCALL "," (QREFELT $ 110))) - |OUTFORM;prime;$Nni$;84|) - (EXIT (SPADCALL |a| (|OUTFORM;sform| |s| $) (QREFELT $ 63))))))) - -(DEFUN |OUTFORM;overlabel;3$;85| (|a| |b| $) - (LIST (|OUTFORM;eform| 'OVERLABEL $) |a| |b|)) - -(DEFUN |OUTFORM;box;2$;86| (|a| $) - (LIST (|OUTFORM;eform| 'BOX $) |a|)) - -(DEFUN |OUTFORM;zag;3$;87| (|a| |b| $) - (LIST (|OUTFORM;eform| 'ZAG $) |a| |b|)) - -(DEFUN |OUTFORM;root;2$;88| (|a| $) - (LIST (|OUTFORM;eform| 'ROOT $) |a|)) - -(DEFUN |OUTFORM;root;3$;89| (|a| |b| $) - (LIST (|OUTFORM;eform| 'ROOT $) |a| |b|)) - -(DEFUN |OUTFORM;over;3$;90| (|a| |b| $) - (LIST (|OUTFORM;eform| 'OVER $) |a| |b|)) - -(DEFUN |OUTFORM;slash;3$;91| (|a| |b| $) - (LIST (|OUTFORM;eform| 'SLASH $) |a| |b|)) - -(DEFUN |OUTFORM;assign;3$;92| (|a| |b| $) - (LIST (|OUTFORM;eform| 'LET $) |a| |b|)) - -(DEFUN |OUTFORM;label;3$;93| (|a| |b| $) - (LIST (|OUTFORM;eform| 'EQUATNUM $) |a| |b|)) - -(DEFUN |OUTFORM;rarrow;3$;94| (|a| |b| $) - (LIST (|OUTFORM;eform| 'TAG $) |a| |b|)) - -(DEFUN |OUTFORM;differentiate;$Nni$;95| (|a| |nn| $) - (PROG (#0=#:G1521 |r| |s|) - (RETURN - (SEQ (COND - ((ZEROP |nn|) |a|) - ((< |nn| 4) (SPADCALL |a| |nn| (QREFELT $ 112))) - ('T - (SEQ (LETT |r| - (SPADCALL - (PROG1 (LETT #0# |nn| - |OUTFORM;differentiate;$Nni$;95|) - (|check-subtype| (> #0# 0) - '(|PositiveInteger|) #0#)) - (QREFELT $ 125)) - |OUTFORM;differentiate;$Nni$;95|) - (LETT |s| (SPADCALL |r| (QREFELT $ 126)) - |OUTFORM;differentiate;$Nni$;95|) - (EXIT (SPADCALL |a| - (SPADCALL (|OUTFORM;sform| |s| $) - (QREFELT $ 60)) - (QREFELT $ 63)))))))))) - -(DEFUN |OUTFORM;sum;2$;96| (|a| $) - (LIST (|OUTFORM;eform| 'SIGMA $) (SPADCALL (QREFELT $ 12)) |a|)) - -(DEFUN |OUTFORM;sum;3$;97| (|a| |b| $) - (LIST (|OUTFORM;eform| 'SIGMA $) |b| |a|)) - -(DEFUN |OUTFORM;sum;4$;98| (|a| |b| |c| $) - (LIST (|OUTFORM;eform| 'SIGMA2 $) |b| |c| |a|)) - -(DEFUN |OUTFORM;prod;2$;99| (|a| $) - (LIST (|OUTFORM;eform| 'PI $) (SPADCALL (QREFELT $ 12)) |a|)) - -(DEFUN |OUTFORM;prod;3$;100| (|a| |b| $) - (LIST (|OUTFORM;eform| 'PI $) |b| |a|)) - -(DEFUN |OUTFORM;prod;4$;101| (|a| |b| |c| $) - (LIST (|OUTFORM;eform| 'PI2 $) |b| |c| |a|)) - -(DEFUN |OUTFORM;int;2$;102| (|a| $) - (LIST (|OUTFORM;eform| 'INTSIGN $) (SPADCALL (QREFELT $ 12)) - (SPADCALL (QREFELT $ 12)) |a|)) - -(DEFUN |OUTFORM;int;3$;103| (|a| |b| $) - (LIST (|OUTFORM;eform| 'INTSIGN $) |b| (SPADCALL (QREFELT $ 12)) |a|)) - -(DEFUN |OUTFORM;int;4$;104| (|a| |b| |c| $) - (LIST (|OUTFORM;eform| 'INTSIGN $) |b| |c| |a|)) - -(DEFUN |OutputForm| () - (PROG () - (RETURN - (PROG (#0=#:G1535) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|OutputForm|) - |OutputForm|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|OutputForm| - (LIST - (CONS NIL (CONS 1 (|OutputForm;|)))))) - (LETT #0# T |OutputForm|)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|OutputForm|))))))))))) - -(DEFUN |OutputForm;| () - (PROG (|dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$| '(|OutputForm|) . #0=(|OutputForm|)) - (LETT $ (|newShell| 138) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|haddProp| |$ConstructorCache| '|OutputForm| NIL (CONS 1 $)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 (|List| $)) - $)))) - -(MAKEPROP '|OutputForm| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL '|Rep| (|Void|) - |OUTFORM;print;$V;1| (|Boolean|) (|String|) (0 . |empty?|) - |OUTFORM;empty;$;71| |OUTFORM;message;S$;2| - |OUTFORM;messagePrint;SV;3| |OUTFORM;=;2$B;4| - |OUTFORM;=;3$;5| (|OutputForm|) |OUTFORM;coerce;$Of;6| - (|Integer|) |OUTFORM;outputForm;I$;7| (|Symbol|) - |OUTFORM;outputForm;S$;8| (|DoubleFloat|) - |OUTFORM;outputForm;Df$;9| (|Character|) (5 . |quote|) - (9 . |concat|) (15 . |concat|) |OUTFORM;outputForm;S$;13| - |OUTFORM;width;$I;14| |OUTFORM;height;$I;15| - |OUTFORM;subHeight;$I;16| |OUTFORM;superHeight;$I;17| - |OUTFORM;height;I;18| |OUTFORM;width;I;19| - |OUTFORM;hspace;I$;27| |OUTFORM;hconcat;3$;46| - |OUTFORM;center;$I$;20| |OUTFORM;left;$I$;21| - |OUTFORM;right;$I$;22| |OUTFORM;center;2$;23| - |OUTFORM;left;2$;24| |OUTFORM;right;2$;25| - |OUTFORM;vspace;I$;26| |OUTFORM;vconcat;3$;48| - |OUTFORM;rspace;2I$;28| (|List| 49) |OUTFORM;matrix;L$;29| - (|List| $) |OUTFORM;pile;L$;30| - |OUTFORM;commaSeparate;L$;31| - |OUTFORM;semicolonSeparate;L$;32| (21 . |reverse|) - (26 . |append|) |OUTFORM;blankSeparate;L$;33| - |OUTFORM;brace;2$;34| |OUTFORM;brace;L$;35| - |OUTFORM;bracket;2$;36| |OUTFORM;bracket;L$;37| - |OUTFORM;paren;2$;38| |OUTFORM;paren;L$;39| - |OUTFORM;sub;3$;40| |OUTFORM;super;3$;41| - |OUTFORM;presub;3$;42| |OUTFORM;presuper;3$;43| - (32 . |null|) (37 . |rest|) (42 . |first|) - |OUTFORM;scripts;$L$;44| (|NonNegativeInteger|) (47 . |#|) - (|List| $$) (52 . |append|) |OUTFORM;supersub;$L$;45| - |OUTFORM;hconcat;L$;47| |OUTFORM;vconcat;L$;49| - |OUTFORM;~=;3$;50| |OUTFORM;<;3$;51| |OUTFORM;>;3$;52| - |OUTFORM;<=;3$;53| |OUTFORM;>=;3$;54| |OUTFORM;+;3$;55| - |OUTFORM;-;3$;56| |OUTFORM;-;2$;57| |OUTFORM;*;3$;58| - |OUTFORM;/;3$;59| |OUTFORM;**;3$;60| |OUTFORM;div;3$;61| - |OUTFORM;rem;3$;62| |OUTFORM;quo;3$;63| - |OUTFORM;exquo;3$;64| |OUTFORM;and;3$;65| - |OUTFORM;or;3$;66| |OUTFORM;not;2$;67| - |OUTFORM;SEGMENT;3$;68| |OUTFORM;SEGMENT;2$;69| - |OUTFORM;binomial;3$;70| |OUTFORM;infix?;$B;72| - |OUTFORM;elt;$L$;73| |OUTFORM;prefix;$L$;74| (58 . |rest|) - |OUTFORM;infix;$L$;75| |OUTFORM;infix;4$;76| - |OUTFORM;postfix;3$;77| |OUTFORM;string;2$;78| - |OUTFORM;quote;2$;79| |OUTFORM;overbar;2$;80| - |OUTFORM;dot;2$;81| |OUTFORM;prime;2$;82| (63 . |char|) - |OUTFORM;dot;$Nni$;83| |OUTFORM;prime;$Nni$;84| - |OUTFORM;overlabel;3$;85| |OUTFORM;box;2$;86| - |OUTFORM;zag;3$;87| |OUTFORM;root;2$;88| - |OUTFORM;root;3$;89| |OUTFORM;over;3$;90| - |OUTFORM;slash;3$;91| |OUTFORM;assign;3$;92| - |OUTFORM;label;3$;93| |OUTFORM;rarrow;3$;94| - (|PositiveInteger|) (|NumberFormats|) (68 . |FormatRoman|) - (73 . |lowerCase|) |OUTFORM;differentiate;$Nni$;95| - |OUTFORM;sum;2$;96| |OUTFORM;sum;3$;97| - |OUTFORM;sum;4$;98| |OUTFORM;prod;2$;99| - |OUTFORM;prod;3$;100| |OUTFORM;prod;4$;101| - |OUTFORM;int;2$;102| |OUTFORM;int;3$;103| - |OUTFORM;int;4$;104| (|SingleInteger|)) - '#(~= 78 |zag| 90 |width| 96 |vspace| 105 |vconcat| 110 - |supersub| 121 |superHeight| 127 |super| 132 |sum| 138 - |subHeight| 156 |sub| 161 |string| 167 |slash| 172 - |semicolonSeparate| 178 |scripts| 183 |rspace| 189 |root| - 195 |right| 206 |rem| 217 |rarrow| 223 |quote| 229 |quo| - 234 |prod| 240 |print| 258 |prime| 263 |presuper| 274 - |presub| 280 |prefix| 286 |postfix| 292 |pile| 298 |paren| - 303 |overlabel| 313 |overbar| 319 |over| 324 |outputForm| - 330 |or| 350 |not| 356 |messagePrint| 361 |message| 366 - |matrix| 371 |left| 376 |latex| 387 |label| 392 |int| 398 - |infix?| 416 |infix| 421 |hspace| 434 |height| 439 - |hconcat| 448 |hash| 459 |exquo| 464 |empty| 470 |elt| 474 - |dot| 480 |div| 491 |differentiate| 497 |commaSeparate| - 503 |coerce| 508 |center| 513 |bracket| 524 |brace| 534 - |box| 544 |blankSeparate| 549 |binomial| 554 |assign| 560 - |and| 566 SEGMENT 572 >= 583 > 589 = 595 <= 607 < 613 / - 619 - 625 + 636 ** 642 * 648) - 'NIL - (CONS (|makeByteWordVec2| 1 '(0 0 0)) - (CONS '#(|SetCategory&| |BasicType&| NIL) - (CONS '#((|SetCategory|) (|BasicType|) - (|CoercibleTo| 17)) - (|makeByteWordVec2| 137 - '(1 10 9 0 11 0 25 0 26 2 10 0 0 25 27 - 2 10 0 25 0 28 1 6 0 0 53 2 6 0 0 0 - 54 1 6 9 0 66 1 6 0 0 67 1 6 2 0 68 1 - 6 70 0 71 2 72 0 0 0 73 1 72 0 0 101 - 1 25 0 10 110 1 124 10 123 125 1 10 0 - 0 126 2 0 0 0 0 77 2 0 9 0 0 1 2 0 0 - 0 0 115 0 0 19 35 1 0 19 0 30 1 0 0 - 19 44 1 0 0 49 76 2 0 0 0 0 45 2 0 0 - 0 49 74 1 0 19 0 33 2 0 0 0 0 63 2 0 - 0 0 0 129 3 0 0 0 0 0 130 1 0 0 0 128 - 1 0 19 0 32 2 0 0 0 0 62 1 0 0 0 105 - 2 0 0 0 0 119 1 0 0 49 52 2 0 0 0 49 - 69 2 0 0 19 19 46 1 0 0 0 116 2 0 0 0 - 0 117 1 0 0 0 43 2 0 0 0 19 40 2 0 0 - 0 0 89 2 0 0 0 0 122 1 0 0 0 106 2 0 - 0 0 0 90 3 0 0 0 0 0 133 1 0 0 0 131 - 2 0 0 0 0 132 1 0 7 0 8 2 0 0 0 70 - 112 1 0 0 0 109 2 0 0 0 0 65 2 0 0 0 - 0 64 2 0 0 0 49 100 2 0 0 0 0 104 1 0 - 0 49 50 1 0 0 49 61 1 0 0 0 60 2 0 0 - 0 0 113 1 0 0 0 107 2 0 0 0 0 118 1 0 - 0 10 29 1 0 0 23 24 1 0 0 21 22 1 0 0 - 19 20 2 0 0 0 0 93 1 0 0 0 94 1 0 7 - 10 14 1 0 0 10 13 1 0 0 47 48 1 0 0 0 - 42 2 0 0 0 19 39 1 0 10 0 1 2 0 0 0 0 - 121 3 0 0 0 0 0 136 2 0 0 0 0 135 1 0 - 0 0 134 1 0 9 0 98 2 0 0 0 49 102 3 0 - 0 0 0 0 103 1 0 0 19 36 0 0 19 34 1 0 - 19 0 31 1 0 0 49 75 2 0 0 0 0 37 1 0 - 137 0 1 2 0 0 0 0 91 0 0 0 12 2 0 0 0 - 49 99 2 0 0 0 70 111 1 0 0 0 108 2 0 - 0 0 0 88 2 0 0 0 70 127 1 0 0 49 51 1 - 0 17 0 18 1 0 0 0 41 2 0 0 0 19 38 1 - 0 0 0 58 1 0 0 49 59 1 0 0 49 57 1 0 - 0 0 56 1 0 0 0 114 1 0 0 49 55 2 0 0 - 0 0 97 2 0 0 0 0 120 2 0 0 0 0 92 1 0 - 0 0 96 2 0 0 0 0 95 2 0 0 0 0 81 2 0 - 0 0 0 79 2 0 0 0 0 16 2 0 9 0 0 15 2 - 0 0 0 0 80 2 0 0 0 0 78 2 0 0 0 0 86 - 1 0 0 0 84 2 0 0 0 0 83 2 0 0 0 0 82 - 2 0 0 0 0 87 2 0 0 0 0 85))))) - '|lookupComplete|)) - -(MAKEPROP '|OutputForm| 'NILADIC T) -@ \section{License} <<license>>= --Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. diff --git a/src/algebra/polset.spad.pamphlet b/src/algebra/polset.spad.pamphlet index 08e3cb05..eaee8dc6 100644 --- a/src/algebra/polset.spad.pamphlet +++ b/src/algebra/polset.spad.pamphlet @@ -351,1036 +351,6 @@ PolynomialSetCategory(R:Ring, E:OrderedAbelianMonoidSup,_ removeDuplicates rs @ -\section{PSETCAT.lsp BOOTSTRAP} -{\bf PSETCAT} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf PSETCAT} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf PSETCAT.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<PSETCAT.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |PolynomialSetCategory;CAT| 'NIL) - -(DEFPARAMETER |PolynomialSetCategory;AL| 'NIL) - -(DEFUN |PolynomialSetCategory| (&REST #0=#:G1422 &AUX #1=#:G1420) - (DSETQ #1# #0#) - (LET (#2=#:G1421) - (COND - ((SETQ #2# - (|assoc| (|devaluateList| #1#) |PolynomialSetCategory;AL|)) - (CDR #2#)) - (T (SETQ |PolynomialSetCategory;AL| - (|cons5| (CONS (|devaluateList| #1#) - (SETQ #2# - (APPLY #'|PolynomialSetCategory;| - #1#))) - |PolynomialSetCategory;AL|)) - #2#)))) - -(DEFUN |PolynomialSetCategory;| (|t#1| |t#2| |t#3| |t#4|) - (PROG (#0=#:G1419) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(|t#1| |t#2| |t#3| |t#4|) - (LIST (|devaluate| |t#1|) - (|devaluate| |t#2|) - (|devaluate| |t#3|) - (|devaluate| |t#4|))) - (|sublisV| - (PAIR '(#1=#:G1418) (LIST '(|List| |t#4|))) - (COND - (|PolynomialSetCategory;CAT|) - ('T - (LETT |PolynomialSetCategory;CAT| - (|Join| (|SetCategory|) - (|Collection| '|t#4|) - (|CoercibleTo| '#1#) - (|mkCategory| '|domain| - '(((|retractIfCan| - ((|Union| $ "failed") - (|List| |t#4|))) - T) - ((|retract| ($ (|List| |t#4|))) - T) - ((|mvar| (|t#3| $)) T) - ((|variables| - ((|List| |t#3|) $)) - T) - ((|mainVariables| - ((|List| |t#3|) $)) - T) - ((|mainVariable?| - ((|Boolean|) |t#3| $)) - T) - ((|collectUnder| ($ $ |t#3|)) - T) - ((|collect| ($ $ |t#3|)) T) - ((|collectUpper| ($ $ |t#3|)) - T) - ((|sort| - ((|Record| (|:| |under| $) - (|:| |floor| $) - (|:| |upper| $)) - $ |t#3|)) - T) - ((|trivialIdeal?| - ((|Boolean|) $)) - T) - ((|roughBase?| ((|Boolean|) $)) - (|has| |t#1| - (|IntegralDomain|))) - ((|roughSubIdeal?| - ((|Boolean|) $ $)) - (|has| |t#1| - (|IntegralDomain|))) - ((|roughEqualIdeals?| - ((|Boolean|) $ $)) - (|has| |t#1| - (|IntegralDomain|))) - ((|roughUnitIdeal?| - ((|Boolean|) $)) - (|has| |t#1| - (|IntegralDomain|))) - ((|headRemainder| - ((|Record| (|:| |num| |t#4|) - (|:| |den| |t#1|)) - |t#4| $)) - (|has| |t#1| - (|IntegralDomain|))) - ((|remainder| - ((|Record| (|:| |rnum| |t#1|) - (|:| |polnum| |t#4|) - (|:| |den| |t#1|)) - |t#4| $)) - (|has| |t#1| - (|IntegralDomain|))) - ((|rewriteIdealWithHeadRemainder| - ((|List| |t#4|) - (|List| |t#4|) $)) - (|has| |t#1| - (|IntegralDomain|))) - ((|rewriteIdealWithRemainder| - ((|List| |t#4|) - (|List| |t#4|) $)) - (|has| |t#1| - (|IntegralDomain|))) - ((|triangular?| - ((|Boolean|) $)) - (|has| |t#1| - (|IntegralDomain|)))) - '((|finiteAggregate| T)) - '((|Boolean|) (|List| |t#4|) - (|List| |t#3|)) - NIL)) - . #2=(|PolynomialSetCategory|)))))) . #2#) - (SETELT #0# 0 - (LIST '|PolynomialSetCategory| (|devaluate| |t#1|) - (|devaluate| |t#2|) (|devaluate| |t#3|) - (|devaluate| |t#4|))))))) -@ -\section{PSETCAT-.lsp BOOTSTRAP} -{\bf PSETCAT-} depends on {\bf PSETCAT}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf PSETCAT-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf PSETCAT-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<PSETCAT-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |PSETCAT-;elements| (|ps| $) - (PROG (|lp|) - (RETURN - (LETT |lp| (SPADCALL |ps| (|getShellEntry| $ 12)) - |PSETCAT-;elements|)))) - -(DEFUN |PSETCAT-;variables1| (|lp| $) - (PROG (#0=#:G1435 |p| #1=#:G1436 |lvars|) - (RETURN - (SEQ (LETT |lvars| - (PROGN - (LETT #0# NIL |PSETCAT-;variables1|) - (SEQ (LETT |p| NIL |PSETCAT-;variables1|) - (LETT #1# |lp| |PSETCAT-;variables1|) G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |p| (CAR #1#) - |PSETCAT-;variables1|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (SPADCALL |p| - (|getShellEntry| $ 14)) - #0#) - |PSETCAT-;variables1|))) - (LETT #1# (CDR #1#) |PSETCAT-;variables1|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - |PSETCAT-;variables1|) - (EXIT (SPADCALL (CONS #'|PSETCAT-;variables1!0| $) - (SPADCALL - (SPADCALL |lvars| (|getShellEntry| $ 18)) - (|getShellEntry| $ 19)) - (|getShellEntry| $ 21))))))) - -(DEFUN |PSETCAT-;variables1!0| (|#1| |#2| $) - (SPADCALL |#2| |#1| (|getShellEntry| $ 16))) - -(DEFUN |PSETCAT-;variables2| (|lp| $) - (PROG (#0=#:G1440 |p| #1=#:G1441 |lvars|) - (RETURN - (SEQ (LETT |lvars| - (PROGN - (LETT #0# NIL |PSETCAT-;variables2|) - (SEQ (LETT |p| NIL |PSETCAT-;variables2|) - (LETT #1# |lp| |PSETCAT-;variables2|) G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |p| (CAR #1#) - |PSETCAT-;variables2|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (SPADCALL |p| - (|getShellEntry| $ 22)) - #0#) - |PSETCAT-;variables2|))) - (LETT #1# (CDR #1#) |PSETCAT-;variables2|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - |PSETCAT-;variables2|) - (EXIT (SPADCALL (CONS #'|PSETCAT-;variables2!0| $) - (SPADCALL |lvars| (|getShellEntry| $ 19)) - (|getShellEntry| $ 21))))))) - -(DEFUN |PSETCAT-;variables2!0| (|#1| |#2| $) - (SPADCALL |#2| |#1| (|getShellEntry| $ 16))) - -(DEFUN |PSETCAT-;variables;SL;4| (|ps| $) - (|PSETCAT-;variables1| (|PSETCAT-;elements| |ps| $) $)) - -(DEFUN |PSETCAT-;mainVariables;SL;5| (|ps| $) - (|PSETCAT-;variables2| - (SPADCALL (ELT $ 24) (|PSETCAT-;elements| |ps| $) - (|getShellEntry| $ 26)) - $)) - -(DEFUN |PSETCAT-;mainVariable?;VarSetSB;6| (|v| |ps| $) - (PROG (|lp|) - (RETURN - (SEQ (LETT |lp| - (SPADCALL (ELT $ 24) (|PSETCAT-;elements| |ps| $) - (|getShellEntry| $ 26)) - |PSETCAT-;mainVariable?;VarSetSB;6|) - (SEQ G190 - (COND - ((NULL (COND - ((NULL |lp|) 'NIL) - ('T - (SPADCALL - (SPADCALL - (SPADCALL (|SPADfirst| |lp|) - (|getShellEntry| $ 22)) - |v| (|getShellEntry| $ 28)) - (|getShellEntry| $ 29))))) - (GO G191))) - (SEQ (EXIT (LETT |lp| (CDR |lp|) - |PSETCAT-;mainVariable?;VarSetSB;6|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL (NULL |lp|) (|getShellEntry| $ 29))))))) - -(DEFUN |PSETCAT-;collectUnder;SVarSetS;7| (|ps| |v| $) - (PROG (|p| |lp| |lq|) - (RETURN - (SEQ (LETT |lp| (|PSETCAT-;elements| |ps| $) - |PSETCAT-;collectUnder;SVarSetS;7|) - (LETT |lq| NIL |PSETCAT-;collectUnder;SVarSetS;7|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |lp|) (|getShellEntry| $ 29))) - (GO G191))) - (SEQ (LETT |p| (|SPADfirst| |lp|) - |PSETCAT-;collectUnder;SVarSetS;7|) - (LETT |lp| (CDR |lp|) - |PSETCAT-;collectUnder;SVarSetS;7|) - (EXIT (COND - ((OR (SPADCALL |p| (|getShellEntry| $ 24)) - (SPADCALL - (SPADCALL |p| - (|getShellEntry| $ 22)) - |v| (|getShellEntry| $ 16))) - (LETT |lq| (CONS |p| |lq|) - |PSETCAT-;collectUnder;SVarSetS;7|))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |lq| (|getShellEntry| $ 31))))))) - -(DEFUN |PSETCAT-;collectUpper;SVarSetS;8| (|ps| |v| $) - (PROG (|p| |lp| |lq|) - (RETURN - (SEQ (LETT |lp| (|PSETCAT-;elements| |ps| $) - |PSETCAT-;collectUpper;SVarSetS;8|) - (LETT |lq| NIL |PSETCAT-;collectUpper;SVarSetS;8|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |lp|) (|getShellEntry| $ 29))) - (GO G191))) - (SEQ (LETT |p| (|SPADfirst| |lp|) - |PSETCAT-;collectUpper;SVarSetS;8|) - (LETT |lp| (CDR |lp|) - |PSETCAT-;collectUpper;SVarSetS;8|) - (EXIT (COND - ((NULL (SPADCALL |p| - (|getShellEntry| $ 24))) - (COND - ((SPADCALL |v| - (SPADCALL |p| - (|getShellEntry| $ 22)) - (|getShellEntry| $ 16)) - (LETT |lq| (CONS |p| |lq|) - |PSETCAT-;collectUpper;SVarSetS;8|))))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |lq| (|getShellEntry| $ 31))))))) - -(DEFUN |PSETCAT-;collect;SVarSetS;9| (|ps| |v| $) - (PROG (|p| |lp| |lq|) - (RETURN - (SEQ (LETT |lp| (|PSETCAT-;elements| |ps| $) - |PSETCAT-;collect;SVarSetS;9|) - (LETT |lq| NIL |PSETCAT-;collect;SVarSetS;9|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |lp|) (|getShellEntry| $ 29))) - (GO G191))) - (SEQ (LETT |p| (|SPADfirst| |lp|) - |PSETCAT-;collect;SVarSetS;9|) - (LETT |lp| (CDR |lp|) - |PSETCAT-;collect;SVarSetS;9|) - (EXIT (COND - ((NULL (SPADCALL |p| - (|getShellEntry| $ 24))) - (COND - ((SPADCALL - (SPADCALL |p| - (|getShellEntry| $ 22)) - |v| (|getShellEntry| $ 28)) - (LETT |lq| (CONS |p| |lq|) - |PSETCAT-;collect;SVarSetS;9|))))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |lq| (|getShellEntry| $ 31))))))) - -(DEFUN |PSETCAT-;sort;SVarSetR;10| (|ps| |v| $) - (PROG (|p| |lp| |us| |vs| |ws|) - (RETURN - (SEQ (LETT |lp| (|PSETCAT-;elements| |ps| $) - |PSETCAT-;sort;SVarSetR;10|) - (LETT |us| NIL |PSETCAT-;sort;SVarSetR;10|) - (LETT |vs| NIL |PSETCAT-;sort;SVarSetR;10|) - (LETT |ws| NIL |PSETCAT-;sort;SVarSetR;10|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |lp|) (|getShellEntry| $ 29))) - (GO G191))) - (SEQ (LETT |p| (|SPADfirst| |lp|) - |PSETCAT-;sort;SVarSetR;10|) - (LETT |lp| (CDR |lp|) |PSETCAT-;sort;SVarSetR;10|) - (EXIT (COND - ((OR (SPADCALL |p| (|getShellEntry| $ 24)) - (SPADCALL - (SPADCALL |p| - (|getShellEntry| $ 22)) - |v| (|getShellEntry| $ 16))) - (LETT |us| (CONS |p| |us|) - |PSETCAT-;sort;SVarSetR;10|)) - ((SPADCALL - (SPADCALL |p| (|getShellEntry| $ 22)) - |v| (|getShellEntry| $ 28)) - (LETT |vs| (CONS |p| |vs|) - |PSETCAT-;sort;SVarSetR;10|)) - ('T - (LETT |ws| (CONS |p| |ws|) - |PSETCAT-;sort;SVarSetR;10|))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (VECTOR (SPADCALL |us| (|getShellEntry| $ 31)) - (SPADCALL |vs| (|getShellEntry| $ 31)) - (SPADCALL |ws| (|getShellEntry| $ 31)))))))) - -(DEFUN |PSETCAT-;=;2SB;11| (|ps1| |ps2| $) - (PROG (#0=#:G1475 #1=#:G1476 #2=#:G1477 |p| #3=#:G1478) - (RETURN - (SEQ (SPADCALL - (SPADCALL - (PROGN - (LETT #0# NIL |PSETCAT-;=;2SB;11|) - (SEQ (LETT |p| NIL |PSETCAT-;=;2SB;11|) - (LETT #1# (|PSETCAT-;elements| |ps1| $) - |PSETCAT-;=;2SB;11|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |p| (CAR #1#) - |PSETCAT-;=;2SB;11|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# (CONS |p| #0#) - |PSETCAT-;=;2SB;11|))) - (LETT #1# (CDR #1#) |PSETCAT-;=;2SB;11|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - (|getShellEntry| $ 38)) - (SPADCALL - (PROGN - (LETT #2# NIL |PSETCAT-;=;2SB;11|) - (SEQ (LETT |p| NIL |PSETCAT-;=;2SB;11|) - (LETT #3# (|PSETCAT-;elements| |ps2| $) - |PSETCAT-;=;2SB;11|) - G190 - (COND - ((OR (ATOM #3#) - (PROGN - (LETT |p| (CAR #3#) - |PSETCAT-;=;2SB;11|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #2# (CONS |p| #2#) - |PSETCAT-;=;2SB;11|))) - (LETT #3# (CDR #3#) |PSETCAT-;=;2SB;11|) - (GO G190) G191 (EXIT (NREVERSE0 #2#)))) - (|getShellEntry| $ 38)) - (|getShellEntry| $ 39)))))) - -(DEFUN |PSETCAT-;localInf?| (|p| |q| $) - (SPADCALL (SPADCALL |p| (|getShellEntry| $ 41)) - (SPADCALL |q| (|getShellEntry| $ 41)) (|getShellEntry| $ 42))) - -(DEFUN |PSETCAT-;localTriangular?| (|lp| $) - (PROG (|q| |p|) - (RETURN - (SEQ (LETT |lp| (SPADCALL (ELT $ 43) |lp| (|getShellEntry| $ 26)) - |PSETCAT-;localTriangular?|) - (EXIT (COND - ((NULL |lp|) 'T) - ((SPADCALL (ELT $ 24) |lp| (|getShellEntry| $ 44)) - 'NIL) - ('T - (SEQ (LETT |lp| - (SPADCALL - (CONS - #'|PSETCAT-;localTriangular?!0| $) - |lp| (|getShellEntry| $ 46)) - |PSETCAT-;localTriangular?|) - (LETT |p| (|SPADfirst| |lp|) - |PSETCAT-;localTriangular?|) - (LETT |lp| (CDR |lp|) - |PSETCAT-;localTriangular?|) - (SEQ G190 - (COND - ((NULL (COND - ((NULL |lp|) 'NIL) - ('T - (SPADCALL - (SPADCALL - (LETT |q| - (|SPADfirst| |lp|) - |PSETCAT-;localTriangular?|) - (|getShellEntry| $ 22)) - (SPADCALL |p| - (|getShellEntry| $ 22)) - (|getShellEntry| $ 16))))) - (GO G191))) - (SEQ (LETT |p| |q| - |PSETCAT-;localTriangular?|) - (EXIT - (LETT |lp| (CDR |lp|) - |PSETCAT-;localTriangular?|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (NULL |lp|)))))))))) - -(DEFUN |PSETCAT-;localTriangular?!0| (|#1| |#2| $) - (SPADCALL (SPADCALL |#2| (|getShellEntry| $ 22)) - (SPADCALL |#1| (|getShellEntry| $ 22)) (|getShellEntry| $ 16))) - -(DEFUN |PSETCAT-;triangular?;SB;14| (|ps| $) - (|PSETCAT-;localTriangular?| (|PSETCAT-;elements| |ps| $) $)) - -(DEFUN |PSETCAT-;trivialIdeal?;SB;15| (|ps| $) - (NULL (SPADCALL (ELT $ 43) (|PSETCAT-;elements| |ps| $) - (|getShellEntry| $ 26)))) - -(DEFUN |PSETCAT-;roughUnitIdeal?;SB;16| (|ps| $) - (SPADCALL (ELT $ 24) - (SPADCALL (ELT $ 43) (|PSETCAT-;elements| |ps| $) - (|getShellEntry| $ 26)) - (|getShellEntry| $ 44))) - -(DEFUN |PSETCAT-;relativelyPrimeLeadingMonomials?| (|p| |q| $) - (PROG (|dp| |dq|) - (RETURN - (SEQ (LETT |dp| (SPADCALL |p| (|getShellEntry| $ 41)) - |PSETCAT-;relativelyPrimeLeadingMonomials?|) - (LETT |dq| (SPADCALL |q| (|getShellEntry| $ 41)) - |PSETCAT-;relativelyPrimeLeadingMonomials?|) - (EXIT (SPADCALL (SPADCALL |dp| |dq| (|getShellEntry| $ 50)) - (SPADCALL |dp| |dq| (|getShellEntry| $ 51)) - (|getShellEntry| $ 52))))))) - -(DEFUN |PSETCAT-;roughBase?;SB;18| (|ps| $) - (PROG (|p| |lp| |rB?| |copylp|) - (RETURN - (SEQ (LETT |lp| - (SPADCALL (ELT $ 43) (|PSETCAT-;elements| |ps| $) - (|getShellEntry| $ 26)) - |PSETCAT-;roughBase?;SB;18|) - (EXIT (COND - ((NULL |lp|) 'T) - ('T - (SEQ (LETT |rB?| 'T |PSETCAT-;roughBase?;SB;18|) - (SEQ G190 - (COND - ((NULL (COND - ((NULL |lp|) 'NIL) - ('T |rB?|))) - (GO G191))) - (SEQ (LETT |p| (|SPADfirst| |lp|) - |PSETCAT-;roughBase?;SB;18|) - (LETT |lp| (CDR |lp|) - |PSETCAT-;roughBase?;SB;18|) - (LETT |copylp| |lp| - |PSETCAT-;roughBase?;SB;18|) - (EXIT - (SEQ G190 - (COND - ((NULL - (COND - ((NULL |copylp|) 'NIL) - ('T |rB?|))) - (GO G191))) - (SEQ - (LETT |rB?| - (|PSETCAT-;relativelyPrimeLeadingMonomials?| - |p| (|SPADfirst| |copylp|) $) - |PSETCAT-;roughBase?;SB;18|) - (EXIT - (LETT |copylp| (CDR |copylp|) - |PSETCAT-;roughBase?;SB;18|))) - NIL (GO G190) G191 (EXIT NIL)))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |rB?|))))))))) - -(DEFUN |PSETCAT-;roughSubIdeal?;2SB;19| (|ps1| |ps2| $) - (PROG (|lp|) - (RETURN - (SEQ (LETT |lp| - (SPADCALL (|PSETCAT-;elements| |ps1| $) |ps2| - (|getShellEntry| $ 54)) - |PSETCAT-;roughSubIdeal?;2SB;19|) - (EXIT (NULL (SPADCALL (ELT $ 43) |lp| - (|getShellEntry| $ 26)))))))) - -(DEFUN |PSETCAT-;roughEqualIdeals?;2SB;20| (|ps1| |ps2| $) - (COND - ((SPADCALL |ps1| |ps2| (|getShellEntry| $ 56)) 'T) - ((SPADCALL |ps1| |ps2| (|getShellEntry| $ 57)) - (SPADCALL |ps2| |ps1| (|getShellEntry| $ 57))) - ('T 'NIL))) - -(DEFUN |PSETCAT-;exactQuo| (|r| |s| $) - (PROG (#0=#:G1510) - (RETURN - (COND - ((|HasCategory| (|getShellEntry| $ 7) '(|EuclideanDomain|)) - (SPADCALL |r| |s| (|getShellEntry| $ 59))) - ('T - (PROG2 (LETT #0# (SPADCALL |r| |s| (|getShellEntry| $ 61)) - |PSETCAT-;exactQuo|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 7) #0#))))))) - -(DEFUN |PSETCAT-;headRemainder;PSR;22| (|a| |ps| $) - (PROG (|lp1| |p| |e| |g| |#G45| |#G46| |lca| |lcp| |r| |lp2|) - (RETURN - (SEQ (LETT |lp1| - (SPADCALL (ELT $ 43) (|PSETCAT-;elements| |ps| $) - (|getShellEntry| $ 26)) - |PSETCAT-;headRemainder;PSR;22|) - (EXIT (COND - ((NULL |lp1|) (CONS |a| (|spadConstant| $ 62))) - ((SPADCALL (ELT $ 24) |lp1| (|getShellEntry| $ 44)) - (CONS (SPADCALL |a| (|getShellEntry| $ 63)) - (|spadConstant| $ 62))) - ('T - (SEQ (LETT |r| (|spadConstant| $ 62) - |PSETCAT-;headRemainder;PSR;22|) - (LETT |lp1| - (SPADCALL - (CONS - (|function| |PSETCAT-;localInf?|) - $) - (REVERSE - (|PSETCAT-;elements| |ps| $)) - (|getShellEntry| $ 46)) - |PSETCAT-;headRemainder;PSR;22|) - (LETT |lp2| |lp1| - |PSETCAT-;headRemainder;PSR;22|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |a| - (|getShellEntry| $ 43)) - 'NIL) - ('T - (SPADCALL (NULL |lp2|) - (|getShellEntry| $ 29))))) - (GO G191))) - (SEQ (LETT |p| (|SPADfirst| |lp2|) - |PSETCAT-;headRemainder;PSR;22|) - (LETT |e| - (SPADCALL - (SPADCALL |a| - (|getShellEntry| $ 41)) - (SPADCALL |p| - (|getShellEntry| $ 41)) - (|getShellEntry| $ 64)) - |PSETCAT-;headRemainder;PSR;22|) - (EXIT - (COND - ((QEQCAR |e| 0) - (SEQ - (LETT |g| - (SPADCALL - (LETT |lca| - (SPADCALL |a| - (|getShellEntry| $ 65)) - |PSETCAT-;headRemainder;PSR;22|) - (LETT |lcp| - (SPADCALL |p| - (|getShellEntry| $ 65)) - |PSETCAT-;headRemainder;PSR;22|) - (|getShellEntry| $ 66)) - |PSETCAT-;headRemainder;PSR;22|) - (PROGN - (LETT |#G45| - (|PSETCAT-;exactQuo| |lca| - |g| $) - |PSETCAT-;headRemainder;PSR;22|) - (LETT |#G46| - (|PSETCAT-;exactQuo| |lcp| - |g| $) - |PSETCAT-;headRemainder;PSR;22|) - (LETT |lca| |#G45| - |PSETCAT-;headRemainder;PSR;22|) - (LETT |lcp| |#G46| - |PSETCAT-;headRemainder;PSR;22|)) - (LETT |a| - (SPADCALL - (SPADCALL |lcp| - (SPADCALL |a| - (|getShellEntry| $ 63)) - (|getShellEntry| $ 67)) - (SPADCALL - (SPADCALL |lca| (QCDR |e|) - (|getShellEntry| $ 68)) - (SPADCALL |p| - (|getShellEntry| $ 63)) - (|getShellEntry| $ 69)) - (|getShellEntry| $ 70)) - |PSETCAT-;headRemainder;PSR;22|) - (LETT |r| - (SPADCALL |r| |lcp| - (|getShellEntry| $ 71)) - |PSETCAT-;headRemainder;PSR;22|) - (EXIT - (LETT |lp2| |lp1| - |PSETCAT-;headRemainder;PSR;22|)))) - ('T - (LETT |lp2| (CDR |lp2|) - |PSETCAT-;headRemainder;PSR;22|))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (CONS |a| |r|)))))))))) - -(DEFUN |PSETCAT-;makeIrreducible!| (|frac| $) - (PROG (|g|) - (RETURN - (SEQ (LETT |g| - (SPADCALL (QCDR |frac|) (QCAR |frac|) - (|getShellEntry| $ 74)) - |PSETCAT-;makeIrreducible!|) - (EXIT (COND - ((SPADCALL |g| (|spadConstant| $ 62) - (|getShellEntry| $ 76)) - |frac|) - ('T - (SEQ (PROGN - (RPLACA |frac| - (SPADCALL (QCAR |frac|) |g| - (|getShellEntry| $ 77))) - (QCAR |frac|)) - (PROGN - (RPLACD |frac| - (|PSETCAT-;exactQuo| (QCDR |frac|) - |g| $)) - (QCDR |frac|)) - (EXIT |frac|))))))))) - -(DEFUN |PSETCAT-;remainder;PSR;24| (|a| |ps| $) - (PROG (|hRa| |r| |lca| |g| |b| |c|) - (RETURN - (SEQ (LETT |hRa| - (|PSETCAT-;makeIrreducible!| - (SPADCALL |a| |ps| (|getShellEntry| $ 78)) $) - |PSETCAT-;remainder;PSR;24|) - (LETT |a| (QCAR |hRa|) |PSETCAT-;remainder;PSR;24|) - (LETT |r| (QCDR |hRa|) |PSETCAT-;remainder;PSR;24|) - (EXIT (COND - ((SPADCALL |a| (|getShellEntry| $ 43)) - (VECTOR (|spadConstant| $ 62) |a| |r|)) - ('T - (SEQ (LETT |b| - (SPADCALL (|spadConstant| $ 62) - (SPADCALL |a| - (|getShellEntry| $ 41)) - (|getShellEntry| $ 68)) - |PSETCAT-;remainder;PSR;24|) - (LETT |c| - (SPADCALL |a| (|getShellEntry| $ 65)) - |PSETCAT-;remainder;PSR;24|) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL - (LETT |a| - (SPADCALL |a| - (|getShellEntry| $ 63)) - |PSETCAT-;remainder;PSR;24|) - (|getShellEntry| $ 43)) - (|getShellEntry| $ 29))) - (GO G191))) - (SEQ (LETT |hRa| - (|PSETCAT-;makeIrreducible!| - (SPADCALL |a| |ps| - (|getShellEntry| $ 78)) - $) - |PSETCAT-;remainder;PSR;24|) - (LETT |a| (QCAR |hRa|) - |PSETCAT-;remainder;PSR;24|) - (LETT |r| - (SPADCALL |r| (QCDR |hRa|) - (|getShellEntry| $ 71)) - |PSETCAT-;remainder;PSR;24|) - (LETT |g| - (SPADCALL |c| - (LETT |lca| - (SPADCALL |a| - (|getShellEntry| $ 65)) - |PSETCAT-;remainder;PSR;24|) - (|getShellEntry| $ 66)) - |PSETCAT-;remainder;PSR;24|) - (LETT |b| - (SPADCALL - (SPADCALL - (SPADCALL (QCDR |hRa|) - (|PSETCAT-;exactQuo| |c| |g| $) - (|getShellEntry| $ 71)) - |b| (|getShellEntry| $ 67)) - (SPADCALL - (|PSETCAT-;exactQuo| |lca| |g| $) - (SPADCALL |a| - (|getShellEntry| $ 41)) - (|getShellEntry| $ 68)) - (|getShellEntry| $ 79)) - |PSETCAT-;remainder;PSR;24|) - (EXIT - (LETT |c| |g| - |PSETCAT-;remainder;PSR;24|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (VECTOR |c| |b| |r|)))))))))) - -(DEFUN |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25| (|ps| |cs| $) - (PROG (|p| |rs|) - (RETURN - (SEQ (COND - ((SPADCALL |cs| (|getShellEntry| $ 82)) |ps|) - ((SPADCALL |cs| (|getShellEntry| $ 83)) - (LIST (|spadConstant| $ 84))) - ('T - (SEQ (LETT |ps| - (SPADCALL (ELT $ 43) |ps| - (|getShellEntry| $ 26)) - |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) - (EXIT (COND - ((NULL |ps|) |ps|) - ((SPADCALL (ELT $ 24) |ps| - (|getShellEntry| $ 44)) - (LIST (|spadConstant| $ 75))) - ('T - (SEQ (LETT |rs| NIL - |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) - (SEQ G190 - (COND - ((NULL - (SPADCALL (NULL |ps|) - (|getShellEntry| $ 29))) - (GO G191))) - (SEQ - (LETT |p| (|SPADfirst| |ps|) - |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) - (LETT |ps| (CDR |ps|) - |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) - (LETT |p| - (QCAR - (SPADCALL |p| |cs| - (|getShellEntry| $ 78))) - |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) - (EXIT - (COND - ((NULL - (SPADCALL |p| - (|getShellEntry| $ 43))) - (COND - ((SPADCALL |p| - (|getShellEntry| $ 24)) - (SEQ - (LETT |ps| NIL - |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) - (EXIT - (LETT |rs| - (LIST - (|spadConstant| $ 75)) - |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|)))) - ('T - (SEQ - (SPADCALL |p| - (|getShellEntry| $ 85)) - (EXIT - (LETT |rs| - (CONS |p| |rs|) - |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|))))))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |rs| - (|getShellEntry| $ 86)))))))))))))) - -(DEFUN |PSETCAT-;rewriteIdealWithRemainder;LSL;26| (|ps| |cs| $) - (PROG (|p| |rs|) - (RETURN - (SEQ (COND - ((SPADCALL |cs| (|getShellEntry| $ 82)) |ps|) - ((SPADCALL |cs| (|getShellEntry| $ 83)) - (LIST (|spadConstant| $ 84))) - ('T - (SEQ (LETT |ps| - (SPADCALL (ELT $ 43) |ps| - (|getShellEntry| $ 26)) - |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) - (EXIT (COND - ((NULL |ps|) |ps|) - ((SPADCALL (ELT $ 24) |ps| - (|getShellEntry| $ 44)) - (LIST (|spadConstant| $ 75))) - ('T - (SEQ (LETT |rs| NIL - |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) - (SEQ G190 - (COND - ((NULL - (SPADCALL (NULL |ps|) - (|getShellEntry| $ 29))) - (GO G191))) - (SEQ - (LETT |p| (|SPADfirst| |ps|) - |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) - (LETT |ps| (CDR |ps|) - |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) - (LETT |p| - (QVELT - (SPADCALL |p| |cs| - (|getShellEntry| $ 88)) - 1) - |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) - (EXIT - (COND - ((NULL - (SPADCALL |p| - (|getShellEntry| $ 43))) - (COND - ((SPADCALL |p| - (|getShellEntry| $ 24)) - (SEQ - (LETT |ps| NIL - |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) - (EXIT - (LETT |rs| - (LIST - (|spadConstant| $ 75)) - |PSETCAT-;rewriteIdealWithRemainder;LSL;26|)))) - ('T - (LETT |rs| - (CONS - (SPADCALL |p| - (|getShellEntry| $ 89)) - |rs|) - |PSETCAT-;rewriteIdealWithRemainder;LSL;26|))))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |rs| - (|getShellEntry| $ 86)))))))))))))) - -(DEFUN |PolynomialSetCategory&| (|#1| |#2| |#3| |#4| |#5|) - (PROG (|dv$1| |dv$2| |dv$3| |dv$4| |dv$5| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) - . #0=(|PolynomialSetCategory&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$3| (|devaluate| |#3|) . #0#) - (LETT |dv$4| (|devaluate| |#4|) . #0#) - (LETT |dv$5| (|devaluate| |#5|) . #0#) - (LETT |dv$| - (LIST '|PolynomialSetCategory&| |dv$1| |dv$2| |dv$3| - |dv$4| |dv$5|) . #0#) - (LETT $ (|newShell| 91) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasCategory| |#2| '(|IntegralDomain|)))) . #0#)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 |#1|) - (|setShellEntry| $ 7 |#2|) - (|setShellEntry| $ 8 |#3|) - (|setShellEntry| $ 9 |#4|) - (|setShellEntry| $ 10 |#5|) - (COND - ((|testBitVector| |pv$| 1) - (PROGN - (|setShellEntry| $ 49 - (CONS (|dispatchFunction| - |PSETCAT-;roughUnitIdeal?;SB;16|) - $)) - (|setShellEntry| $ 53 - (CONS (|dispatchFunction| |PSETCAT-;roughBase?;SB;18|) - $)) - (|setShellEntry| $ 55 - (CONS (|dispatchFunction| - |PSETCAT-;roughSubIdeal?;2SB;19|) - $)) - (|setShellEntry| $ 58 - (CONS (|dispatchFunction| - |PSETCAT-;roughEqualIdeals?;2SB;20|) - $))))) - (COND - ((|HasCategory| |#2| '(|GcdDomain|)) - (COND - ((|HasCategory| |#4| '(|ConvertibleTo| (|Symbol|))) - (PROGN - (|setShellEntry| $ 73 - (CONS (|dispatchFunction| - |PSETCAT-;headRemainder;PSR;22|) - $)) - (|setShellEntry| $ 81 - (CONS (|dispatchFunction| - |PSETCAT-;remainder;PSR;24|) - $)) - (|setShellEntry| $ 87 - (CONS (|dispatchFunction| - |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) - $)) - (|setShellEntry| $ 90 - (CONS (|dispatchFunction| - |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) - $))))))) - $)))) - -(MAKEPROP '|PolynomialSetCategory&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|local| |#3|) (|local| |#4|) (|local| |#5|) (|List| 10) - (0 . |members|) (|List| 9) (5 . |variables|) (|Boolean|) - (10 . <) (|List| $) (16 . |concat|) - (21 . |removeDuplicates|) (|Mapping| 15 9 9) (26 . |sort|) - (32 . |mvar|) |PSETCAT-;variables;SL;4| (37 . |ground?|) - (|Mapping| 15 10) (42 . |remove|) - |PSETCAT-;mainVariables;SL;5| (48 . =) (54 . |not|) - |PSETCAT-;mainVariable?;VarSetSB;6| (59 . |construct|) - |PSETCAT-;collectUnder;SVarSetS;7| - |PSETCAT-;collectUpper;SVarSetS;8| - |PSETCAT-;collect;SVarSetS;9| - (|Record| (|:| |under| $) (|:| |floor| $) (|:| |upper| $)) - |PSETCAT-;sort;SVarSetR;10| (|Set| 10) (64 . |brace|) - (69 . =) |PSETCAT-;=;2SB;11| (75 . |degree|) (80 . <) - (86 . |zero?|) (91 . |any?|) (|Mapping| 15 10 10) - (97 . |sort|) |PSETCAT-;triangular?;SB;14| - |PSETCAT-;trivialIdeal?;SB;15| (103 . |roughUnitIdeal?|) - (108 . |sup|) (114 . +) (120 . =) (126 . |roughBase?|) - (131 . |rewriteIdealWithRemainder|) - (137 . |roughSubIdeal?|) (143 . =) - (149 . |roughSubIdeal?|) (155 . |roughEqualIdeals?|) - (161 . |quo|) (|Union| $ '"failed") (167 . |exquo|) - (173 . |One|) (177 . |reductum|) (182 . |subtractIfCan|) - (188 . |leadingCoefficient|) (193 . |gcd|) (199 . *) - (205 . |monomial|) (211 . *) (217 . -) (223 . *) - (|Record| (|:| |num| 10) (|:| |den| 7)) - (229 . |headRemainder|) (235 . |gcd|) (241 . |One|) - (245 . =) (251 . |exactQuotient!|) (257 . |headRemainder|) - (263 . +) - (|Record| (|:| |rnum| 7) (|:| |polnum| 10) (|:| |den| 7)) - (269 . |remainder|) (275 . |trivialIdeal?|) - (280 . |roughUnitIdeal?|) (285 . |Zero|) - (289 . |primitivePart!|) (294 . |removeDuplicates|) - (299 . |rewriteIdealWithHeadRemainder|) - (305 . |remainder|) (311 . |unitCanonical|) - (316 . |rewriteIdealWithRemainder|)) - '#(|variables| 322 |trivialIdeal?| 327 |triangular?| 332 - |sort| 337 |roughUnitIdeal?| 343 |roughSubIdeal?| 348 - |roughEqualIdeals?| 354 |roughBase?| 360 - |rewriteIdealWithRemainder| 365 - |rewriteIdealWithHeadRemainder| 371 |remainder| 377 - |mainVariables| 383 |mainVariable?| 388 |headRemainder| - 394 |collectUpper| 400 |collectUnder| 406 |collect| 412 = - 418) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 90 - '(1 6 11 0 12 1 10 13 0 14 2 9 15 0 0 - 16 1 13 0 17 18 1 13 0 0 19 2 13 0 20 - 0 21 1 10 9 0 22 1 10 15 0 24 2 11 0 - 25 0 26 2 9 15 0 0 28 1 15 0 0 29 1 6 - 0 11 31 1 37 0 11 38 2 37 15 0 0 39 1 - 10 8 0 41 2 8 15 0 0 42 1 10 15 0 43 - 2 11 15 25 0 44 2 11 0 45 0 46 1 0 15 - 0 49 2 8 0 0 0 50 2 8 0 0 0 51 2 8 15 - 0 0 52 1 0 15 0 53 2 6 11 11 0 54 2 0 - 15 0 0 55 2 6 15 0 0 56 2 6 15 0 0 57 - 2 0 15 0 0 58 2 7 0 0 0 59 2 7 60 0 0 - 61 0 7 0 62 1 10 0 0 63 2 8 60 0 0 64 - 1 10 7 0 65 2 7 0 0 0 66 2 10 0 7 0 - 67 2 10 0 7 8 68 2 10 0 0 0 69 2 10 0 - 0 0 70 2 7 0 0 0 71 2 0 72 10 0 73 2 - 10 7 7 0 74 0 10 0 75 2 7 15 0 0 76 2 - 10 0 0 7 77 2 6 72 10 0 78 2 10 0 0 0 - 79 2 0 80 10 0 81 1 6 15 0 82 1 6 15 - 0 83 0 10 0 84 1 10 0 0 85 1 11 0 0 - 86 2 0 11 11 0 87 2 6 80 10 0 88 1 10 - 0 0 89 2 0 11 11 0 90 1 0 13 0 23 1 0 - 15 0 48 1 0 15 0 47 2 0 35 0 9 36 1 0 - 15 0 49 2 0 15 0 0 55 2 0 15 0 0 58 1 - 0 15 0 53 2 0 11 11 0 90 2 0 11 11 0 - 87 2 0 80 10 0 81 1 0 13 0 27 2 0 15 - 9 0 30 2 0 72 10 0 73 2 0 0 0 9 33 2 - 0 0 0 9 32 2 0 0 0 9 34 2 0 15 0 0 - 40))))) - '|lookupComplete|)) -@ \section{domain GPOLSET GeneralPolynomialSet} diff --git a/src/algebra/polycat.spad.pamphlet b/src/algebra/polycat.spad.pamphlet index a3232055..4cdd3572 100644 --- a/src/algebra/polycat.spad.pamphlet +++ b/src/algebra/polycat.spad.pamphlet @@ -607,2023 +607,6 @@ PolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, VarSet:OrderedSet): p)$PolynomialCategoryLifting(E,VarSet,R,%,InputForm) @ -\section{POLYCAT.lsp BOOTSTRAP} -{\bf POLYCAT} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf POLYCAT} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf POLYCAT.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<POLYCAT.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |PolynomialCategory;CAT| 'NIL) - -(DEFPARAMETER |PolynomialCategory;AL| 'NIL) - -(DEFUN |PolynomialCategory| (&REST #0=#:G1406 &AUX #1=#:G1404) - (DSETQ #1# #0#) - (LET (#2=#:G1405) - (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#)))) - -(DEFUN |PolynomialCategory;| (|t#1| |t#2| |t#3|) - (PROG (#0=#:G1403) - (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|)))) - '(((|OrderedSet|) - (|has| |t#1| - (|OrderedSet|))) - ((|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#) - (SETELT #0# 0 - (LIST '|PolynomialCategory| (|devaluate| |t#1|) - (|devaluate| |t#2|) (|devaluate| |t#3|))))))) -@ -\section{POLYCAT-.lsp BOOTSTRAP} -{\bf POLYCAT-} depends on {\bf POLYCAT}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf POLYCAT-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf POLYCAT-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<POLYCAT-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |POLYCAT-;eval;SLS;1| (|p| |l| $) - (PROG (#0=#:G1427 #1=#:G1421 #2=#:G1428 #3=#:G1429 |lvar| #4=#:G1430 - |e| #5=#:G1431) - (RETURN - (SEQ (COND - ((NULL |l|) |p|) - ('T - (SEQ (SEQ (EXIT (SEQ (LETT |e| NIL |POLYCAT-;eval;SLS;1|) - (LETT #0# |l| |POLYCAT-;eval;SLS;1|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |e| (CAR #0#) - |POLYCAT-;eval;SLS;1|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (COND - ((QEQCAR - (SPADCALL - (SPADCALL |e| - (|getShellEntry| $ 11)) - (|getShellEntry| $ 13)) - 1) - (PROGN - (LETT #1# - (|error| - "cannot find a variable to evaluate") - |POLYCAT-;eval;SLS;1|) - (GO #1#)))))) - (LETT #0# (CDR #0#) - |POLYCAT-;eval;SLS;1|) - (GO G190) G191 (EXIT NIL))) - #1# (EXIT #1#)) - (LETT |lvar| - (PROGN - (LETT #2# NIL |POLYCAT-;eval;SLS;1|) - (SEQ (LETT |e| NIL |POLYCAT-;eval;SLS;1|) - (LETT #3# |l| |POLYCAT-;eval;SLS;1|) - G190 - (COND - ((OR (ATOM #3#) - (PROGN - (LETT |e| (CAR #3#) - |POLYCAT-;eval;SLS;1|) - NIL)) - (GO G191))) - (SEQ (EXIT - (LETT #2# - (CONS - (SPADCALL - (SPADCALL |e| - (|getShellEntry| $ 11)) - (|getShellEntry| $ 14)) - #2#) - |POLYCAT-;eval;SLS;1|))) - (LETT #3# (CDR #3#) - |POLYCAT-;eval;SLS;1|) - (GO G190) G191 (EXIT (NREVERSE0 #2#)))) - |POLYCAT-;eval;SLS;1|) - (EXIT (SPADCALL |p| |lvar| - (PROGN - (LETT #4# NIL |POLYCAT-;eval;SLS;1|) - (SEQ (LETT |e| NIL - |POLYCAT-;eval;SLS;1|) - (LETT #5# |l| - |POLYCAT-;eval;SLS;1|) - G190 - (COND - ((OR (ATOM #5#) - (PROGN - (LETT |e| (CAR #5#) - |POLYCAT-;eval;SLS;1|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (LETT #4# - (CONS - (SPADCALL |e| - (|getShellEntry| $ 15)) - #4#) - |POLYCAT-;eval;SLS;1|))) - (LETT #5# (CDR #5#) - |POLYCAT-;eval;SLS;1|) - (GO G190) G191 - (EXIT (NREVERSE0 #4#)))) - (|getShellEntry| $ 18)))))))))) - -(DEFUN |POLYCAT-;monomials;SL;2| (|p| $) - (PROG (|ml|) - (RETURN - (SEQ (LETT |ml| NIL |POLYCAT-;monomials;SL;2|) - (SEQ G190 - (COND - ((NULL (SPADCALL |p| (|spadConstant| $ 22) - (|getShellEntry| $ 25))) - (GO G191))) - (SEQ (LETT |ml| - (CONS (SPADCALL |p| (|getShellEntry| $ 26)) - |ml|) - |POLYCAT-;monomials;SL;2|) - (EXIT (LETT |p| - (SPADCALL |p| (|getShellEntry| $ 27)) - |POLYCAT-;monomials;SL;2|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (REVERSE |ml|)))))) - -(DEFUN |POLYCAT-;isPlus;SU;3| (|p| $) - (PROG (|l|) - (RETURN - (COND - ((NULL (CDR (LETT |l| (SPADCALL |p| (|getShellEntry| $ 29)) - |POLYCAT-;isPlus;SU;3|))) - (CONS 1 "failed")) - ('T (CONS 0 |l|)))))) - -(DEFUN |POLYCAT-;isTimes;SU;4| (|p| $) - (PROG (|lv| #0=#:G1453 |v| #1=#:G1454 |l| |r|) - (RETURN - (SEQ (COND - ((OR (NULL (LETT |lv| - (SPADCALL |p| (|getShellEntry| $ 32)) - |POLYCAT-;isTimes;SU;4|)) - (NULL (SPADCALL |p| (|getShellEntry| $ 33)))) - (CONS 1 "failed")) - ('T - (SEQ (LETT |l| - (PROGN - (LETT #0# NIL |POLYCAT-;isTimes;SU;4|) - (SEQ (LETT |v| NIL |POLYCAT-;isTimes;SU;4|) - (LETT #1# |lv| |POLYCAT-;isTimes;SU;4|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |v| (CAR #1#) - |POLYCAT-;isTimes;SU;4|) - NIL)) - (GO G191))) - (SEQ (EXIT - (LETT #0# - (CONS - (SPADCALL (|spadConstant| $ 34) - |v| - (SPADCALL |p| |v| - (|getShellEntry| $ 37)) - (|getShellEntry| $ 38)) - #0#) - |POLYCAT-;isTimes;SU;4|))) - (LETT #1# (CDR #1#) - |POLYCAT-;isTimes;SU;4|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - |POLYCAT-;isTimes;SU;4|) - (LETT |r| (SPADCALL |p| (|getShellEntry| $ 39)) - |POLYCAT-;isTimes;SU;4|) - (EXIT (COND - ((SPADCALL |r| (|spadConstant| $ 35) - (|getShellEntry| $ 40)) - (COND - ((NULL (CDR |lv|)) (CONS 1 "failed")) - ('T (CONS 0 |l|)))) - ('T - (CONS 0 - (CONS (SPADCALL |r| - (|getShellEntry| $ 41)) - |l|)))))))))))) - -(DEFUN |POLYCAT-;isExpt;SU;5| (|p| $) - (PROG (|u| |d|) - (RETURN - (SEQ (LETT |u| (SPADCALL |p| (|getShellEntry| $ 43)) - |POLYCAT-;isExpt;SU;5|) - (EXIT (COND - ((OR (QEQCAR |u| 1) - (NULL (SPADCALL |p| - (SPADCALL (|spadConstant| $ 34) - (QCDR |u|) - (LETT |d| - (SPADCALL |p| (QCDR |u|) - (|getShellEntry| $ 37)) - |POLYCAT-;isExpt;SU;5|) - (|getShellEntry| $ 38)) - (|getShellEntry| $ 44)))) - (CONS 1 "failed")) - ('T (CONS 0 (CONS (QCDR |u|) |d|))))))))) - -(DEFUN |POLYCAT-;coefficient;SVarSetNniS;6| (|p| |v| |n| $) - (SPADCALL (SPADCALL |p| |v| (|getShellEntry| $ 49)) |n| - (|getShellEntry| $ 51))) - -(DEFUN |POLYCAT-;coefficient;SLLS;7| (|p| |lv| |ln| $) - (COND - ((NULL |lv|) - (COND - ((NULL |ln|) |p|) - ('T (|error| "mismatched lists in coefficient")))) - ((NULL |ln|) (|error| "mismatched lists in coefficient")) - ('T - (SPADCALL - (SPADCALL - (SPADCALL |p| (|SPADfirst| |lv|) (|getShellEntry| $ 49)) - (|SPADfirst| |ln|) (|getShellEntry| $ 51)) - (CDR |lv|) (CDR |ln|) (|getShellEntry| $ 54))))) - -(DEFUN |POLYCAT-;monomial;SLLS;8| (|p| |lv| |ln| $) - (COND - ((NULL |lv|) - (COND - ((NULL |ln|) |p|) - ('T (|error| "mismatched lists in monomial")))) - ((NULL |ln|) (|error| "mismatched lists in monomial")) - ('T - (SPADCALL - (SPADCALL |p| (|SPADfirst| |lv|) (|SPADfirst| |ln|) - (|getShellEntry| $ 38)) - (CDR |lv|) (CDR |ln|) (|getShellEntry| $ 56))))) - -(DEFUN |POLYCAT-;retract;SVarSet;9| (|p| $) - (PROG (#0=#:G1479 |q|) - (RETURN - (SEQ (LETT |q| - (PROG2 (LETT #0# (SPADCALL |p| (|getShellEntry| $ 43)) - |POLYCAT-;retract;SVarSet;9|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 9) - #0#)) - |POLYCAT-;retract;SVarSet;9|) - (EXIT (COND - ((SPADCALL (SPADCALL |q| (|getShellEntry| $ 58)) |p| - (|getShellEntry| $ 44)) - |q|) - ('T (|error| "Polynomial is not a single variable")))))))) - -(DEFUN |POLYCAT-;retractIfCan;SU;10| (|p| $) - (PROG (|q| #0=#:G1487) - (RETURN - (SEQ (EXIT (SEQ (SEQ (LETT |q| - (SPADCALL |p| (|getShellEntry| $ 43)) - |POLYCAT-;retractIfCan;SU;10|) - (EXIT (COND - ((QEQCAR |q| 0) - (COND - ((SPADCALL - (SPADCALL (QCDR |q|) - (|getShellEntry| $ 58)) - |p| (|getShellEntry| $ 44)) - (PROGN - (LETT #0# |q| - |POLYCAT-;retractIfCan;SU;10|) - (GO #0#)))))))) - (EXIT (CONS 1 "failed")))) - #0# (EXIT #0#))))) - -(DEFUN |POLYCAT-;mkPrim| (|p| $) - (SPADCALL (|spadConstant| $ 35) (SPADCALL |p| (|getShellEntry| $ 61)) - (|getShellEntry| $ 62))) - -(DEFUN |POLYCAT-;primitiveMonomials;SL;12| (|p| $) - (PROG (#0=#:G1492 |q| #1=#:G1493) - (RETURN - (SEQ (PROGN - (LETT #0# NIL |POLYCAT-;primitiveMonomials;SL;12|) - (SEQ (LETT |q| NIL |POLYCAT-;primitiveMonomials;SL;12|) - (LETT #1# (SPADCALL |p| (|getShellEntry| $ 29)) - |POLYCAT-;primitiveMonomials;SL;12|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |q| (CAR #1#) - |POLYCAT-;primitiveMonomials;SL;12|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS (|POLYCAT-;mkPrim| |q| $) #0#) - |POLYCAT-;primitiveMonomials;SL;12|))) - (LETT #1# (CDR #1#) - |POLYCAT-;primitiveMonomials;SL;12|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))))))) - -(DEFUN |POLYCAT-;totalDegree;SNni;13| (|p| $) - (PROG (#0=#:G1495 |d| |u|) - (RETURN - (SEQ (COND - ((SPADCALL |p| (|getShellEntry| $ 64)) 0) - ('T - (SEQ (LETT |u| - (SPADCALL |p| - (PROG2 (LETT #0# - (SPADCALL |p| - (|getShellEntry| $ 43)) - |POLYCAT-;totalDegree;SNni;13|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|getShellEntry| $ 9) #0#)) - (|getShellEntry| $ 49)) - |POLYCAT-;totalDegree;SNni;13|) - (LETT |d| 0 |POLYCAT-;totalDegree;SNni;13|) - (SEQ G190 - (COND - ((NULL (SPADCALL |u| (|spadConstant| $ 65) - (|getShellEntry| $ 66))) - (GO G191))) - (SEQ (LETT |d| - (MAX |d| - (+ - (SPADCALL |u| - (|getShellEntry| $ 67)) - (SPADCALL - (SPADCALL |u| - (|getShellEntry| $ 68)) - (|getShellEntry| $ 69)))) - |POLYCAT-;totalDegree;SNni;13|) - (EXIT (LETT |u| - (SPADCALL |u| - (|getShellEntry| $ 70)) - |POLYCAT-;totalDegree;SNni;13|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |d|)))))))) - -(DEFUN |POLYCAT-;totalDegree;SLNni;14| (|p| |lv| $) - (PROG (#0=#:G1503 |v| |w| |d| |u|) - (RETURN - (SEQ (COND - ((SPADCALL |p| (|getShellEntry| $ 64)) 0) - ('T - (SEQ (LETT |u| - (SPADCALL |p| - (LETT |v| - (PROG2 - (LETT #0# - (SPADCALL |p| - (|getShellEntry| $ 43)) - |POLYCAT-;totalDegree;SLNni;14|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|getShellEntry| $ 9) #0#)) - |POLYCAT-;totalDegree;SLNni;14|) - (|getShellEntry| $ 49)) - |POLYCAT-;totalDegree;SLNni;14|) - (LETT |d| 0 |POLYCAT-;totalDegree;SLNni;14|) - (LETT |w| 0 |POLYCAT-;totalDegree;SLNni;14|) - (COND - ((SPADCALL |v| |lv| (|getShellEntry| $ 72)) - (LETT |w| 1 |POLYCAT-;totalDegree;SLNni;14|))) - (SEQ G190 - (COND - ((NULL (SPADCALL |u| (|spadConstant| $ 65) - (|getShellEntry| $ 66))) - (GO G191))) - (SEQ (LETT |d| - (MAX |d| - (+ - (* |w| - (SPADCALL |u| - (|getShellEntry| $ 67))) - (SPADCALL - (SPADCALL |u| - (|getShellEntry| $ 68)) - |lv| (|getShellEntry| $ 73)))) - |POLYCAT-;totalDegree;SLNni;14|) - (EXIT (LETT |u| - (SPADCALL |u| - (|getShellEntry| $ 70)) - |POLYCAT-;totalDegree;SLNni;14|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |d|)))))))) - -(DEFUN |POLYCAT-;resultant;2SVarSetS;15| (|p1| |p2| |mvar| $) - (SPADCALL (SPADCALL |p1| |mvar| (|getShellEntry| $ 49)) - (SPADCALL |p2| |mvar| (|getShellEntry| $ 49)) - (|getShellEntry| $ 75))) - -(DEFUN |POLYCAT-;discriminant;SVarSetS;16| (|p| |var| $) - (SPADCALL (SPADCALL |p| |var| (|getShellEntry| $ 49)) - (|getShellEntry| $ 77))) - -(DEFUN |POLYCAT-;allMonoms| (|l| $) - (PROG (#0=#:G1515 |p| #1=#:G1516) - (RETURN - (SEQ (SPADCALL - (SPADCALL - (PROGN - (LETT #0# NIL |POLYCAT-;allMonoms|) - (SEQ (LETT |p| NIL |POLYCAT-;allMonoms|) - (LETT #1# |l| |POLYCAT-;allMonoms|) G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |p| (CAR #1#) - |POLYCAT-;allMonoms|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (SPADCALL |p| - (|getShellEntry| $ 79)) - #0#) - |POLYCAT-;allMonoms|))) - (LETT #1# (CDR #1#) |POLYCAT-;allMonoms|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - (|getShellEntry| $ 81)) - (|getShellEntry| $ 82)))))) - -(DEFUN |POLYCAT-;P2R| (|p| |b| |n| $) - (PROG (|w| |bj| #0=#:G1521 |i| #1=#:G1520) - (RETURN - (SEQ (LETT |w| - (SPADCALL |n| (|spadConstant| $ 23) - (|getShellEntry| $ 84)) - |POLYCAT-;P2R|) - (SEQ (LETT |bj| NIL |POLYCAT-;P2R|) - (LETT #0# |b| |POLYCAT-;P2R|) - (LETT |i| (SPADCALL |w| (|getShellEntry| $ 86)) - |POLYCAT-;P2R|) - (LETT #1# (QVSIZE |w|) |POLYCAT-;P2R|) G190 - (COND - ((OR (> |i| #1#) (ATOM #0#) - (PROGN - (LETT |bj| (CAR #0#) |POLYCAT-;P2R|) - NIL)) - (GO G191))) - (SEQ (EXIT (SPADCALL |w| |i| - (SPADCALL |p| |bj| - (|getShellEntry| $ 87)) - (|getShellEntry| $ 88)))) - (LETT |i| - (PROG1 (+ |i| 1) - (LETT #0# (CDR #0#) |POLYCAT-;P2R|)) - |POLYCAT-;P2R|) - (GO G190) G191 (EXIT NIL)) - (EXIT |w|))))) - -(DEFUN |POLYCAT-;eq2R| (|l| |b| $) - (PROG (#0=#:G1525 |bj| #1=#:G1526 #2=#:G1527 |p| #3=#:G1528) - (RETURN - (SEQ (SPADCALL - (PROGN - (LETT #0# NIL |POLYCAT-;eq2R|) - (SEQ (LETT |bj| NIL |POLYCAT-;eq2R|) - (LETT #1# |b| |POLYCAT-;eq2R|) G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |bj| (CAR #1#) |POLYCAT-;eq2R|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (PROGN - (LETT #2# NIL - |POLYCAT-;eq2R|) - (SEQ - (LETT |p| NIL - |POLYCAT-;eq2R|) - (LETT #3# |l| - |POLYCAT-;eq2R|) - G190 - (COND - ((OR (ATOM #3#) - (PROGN - (LETT |p| (CAR #3#) - |POLYCAT-;eq2R|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (LETT #2# - (CONS - (SPADCALL |p| |bj| - (|getShellEntry| $ 87)) - #2#) - |POLYCAT-;eq2R|))) - (LETT #3# (CDR #3#) - |POLYCAT-;eq2R|) - (GO G190) G191 - (EXIT (NREVERSE0 #2#)))) - #0#) - |POLYCAT-;eq2R|))) - (LETT #1# (CDR #1#) |POLYCAT-;eq2R|) (GO G190) - G191 (EXIT (NREVERSE0 #0#)))) - (|getShellEntry| $ 92)))))) - -(DEFUN |POLYCAT-;reducedSystem;MM;20| (|m| $) - (PROG (#0=#:G1537 |r| #1=#:G1538 |b| #2=#:G1539 |bj| #3=#:G1540 |d| - |mm| |l|) - (RETURN - (SEQ (LETT |l| (SPADCALL |m| (|getShellEntry| $ 95)) - |POLYCAT-;reducedSystem;MM;20|) - (LETT |b| - (SPADCALL - (SPADCALL - (PROGN - (LETT #0# NIL - |POLYCAT-;reducedSystem;MM;20|) - (SEQ (LETT |r| NIL - |POLYCAT-;reducedSystem;MM;20|) - (LETT #1# |l| - |POLYCAT-;reducedSystem;MM;20|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |r| (CAR #1#) - |POLYCAT-;reducedSystem;MM;20|) - NIL)) - (GO G191))) - (SEQ (EXIT - (LETT #0# - (CONS - (|POLYCAT-;allMonoms| |r| $) - #0#) - |POLYCAT-;reducedSystem;MM;20|))) - (LETT #1# (CDR #1#) - |POLYCAT-;reducedSystem;MM;20|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - (|getShellEntry| $ 81)) - (|getShellEntry| $ 82)) - |POLYCAT-;reducedSystem;MM;20|) - (LETT |d| - (PROGN - (LETT #2# NIL |POLYCAT-;reducedSystem;MM;20|) - (SEQ (LETT |bj| NIL |POLYCAT-;reducedSystem;MM;20|) - (LETT #3# |b| |POLYCAT-;reducedSystem;MM;20|) - G190 - (COND - ((OR (ATOM #3#) - (PROGN - (LETT |bj| (CAR #3#) - |POLYCAT-;reducedSystem;MM;20|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #2# - (CONS - (SPADCALL |bj| - (|getShellEntry| $ 61)) - #2#) - |POLYCAT-;reducedSystem;MM;20|))) - (LETT #3# (CDR #3#) - |POLYCAT-;reducedSystem;MM;20|) - (GO G190) G191 (EXIT (NREVERSE0 #2#)))) - |POLYCAT-;reducedSystem;MM;20|) - (LETT |mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $) - |POLYCAT-;reducedSystem;MM;20|) - (LETT |l| (CDR |l|) |POLYCAT-;reducedSystem;MM;20|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |l|) (|getShellEntry| $ 96))) - (GO G191))) - (SEQ (LETT |mm| - (SPADCALL |mm| - (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| - $) - (|getShellEntry| $ 97)) - |POLYCAT-;reducedSystem;MM;20|) - (EXIT (LETT |l| (CDR |l|) - |POLYCAT-;reducedSystem;MM;20|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |mm|))))) - -(DEFUN |POLYCAT-;reducedSystem;MVR;21| (|m| |v| $) - (PROG (#0=#:G1551 |s| #1=#:G1552 |b| #2=#:G1553 |bj| #3=#:G1554 |d| - |n| |mm| |w| |l| |r|) - (RETURN - (SEQ (LETT |l| (SPADCALL |m| (|getShellEntry| $ 95)) - |POLYCAT-;reducedSystem;MVR;21|) - (LETT |r| (SPADCALL |v| (|getShellEntry| $ 101)) - |POLYCAT-;reducedSystem;MVR;21|) - (LETT |b| - (SPADCALL - (SPADCALL (|POLYCAT-;allMonoms| |r| $) - (SPADCALL - (PROGN - (LETT #0# NIL - |POLYCAT-;reducedSystem;MVR;21|) - (SEQ (LETT |s| NIL - |POLYCAT-;reducedSystem;MVR;21|) - (LETT #1# |l| - |POLYCAT-;reducedSystem;MVR;21|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |s| (CAR #1#) - |POLYCAT-;reducedSystem;MVR;21|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (LETT #0# - (CONS - (|POLYCAT-;allMonoms| |s| $) - #0#) - |POLYCAT-;reducedSystem;MVR;21|))) - (LETT #1# (CDR #1#) - |POLYCAT-;reducedSystem;MVR;21|) - (GO G190) G191 - (EXIT (NREVERSE0 #0#)))) - (|getShellEntry| $ 81)) - (|getShellEntry| $ 102)) - (|getShellEntry| $ 82)) - |POLYCAT-;reducedSystem;MVR;21|) - (LETT |d| - (PROGN - (LETT #2# NIL |POLYCAT-;reducedSystem;MVR;21|) - (SEQ (LETT |bj| NIL |POLYCAT-;reducedSystem;MVR;21|) - (LETT #3# |b| |POLYCAT-;reducedSystem;MVR;21|) - G190 - (COND - ((OR (ATOM #3#) - (PROGN - (LETT |bj| (CAR #3#) - |POLYCAT-;reducedSystem;MVR;21|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #2# - (CONS - (SPADCALL |bj| - (|getShellEntry| $ 61)) - #2#) - |POLYCAT-;reducedSystem;MVR;21|))) - (LETT #3# (CDR #3#) - |POLYCAT-;reducedSystem;MVR;21|) - (GO G190) G191 (EXIT (NREVERSE0 #2#)))) - |POLYCAT-;reducedSystem;MVR;21|) - (LETT |n| (LENGTH |d|) |POLYCAT-;reducedSystem;MVR;21|) - (LETT |mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $) - |POLYCAT-;reducedSystem;MVR;21|) - (LETT |w| (|POLYCAT-;P2R| (|SPADfirst| |r|) |d| |n| $) - |POLYCAT-;reducedSystem;MVR;21|) - (LETT |l| (CDR |l|) |POLYCAT-;reducedSystem;MVR;21|) - (LETT |r| (CDR |r|) |POLYCAT-;reducedSystem;MVR;21|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |l|) (|getShellEntry| $ 96))) - (GO G191))) - (SEQ (LETT |mm| - (SPADCALL |mm| - (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| - $) - (|getShellEntry| $ 97)) - |POLYCAT-;reducedSystem;MVR;21|) - (LETT |w| - (SPADCALL |w| - (|POLYCAT-;P2R| (|SPADfirst| |r|) |d| - |n| $) - (|getShellEntry| $ 103)) - |POLYCAT-;reducedSystem;MVR;21|) - (LETT |l| (CDR |l|) - |POLYCAT-;reducedSystem;MVR;21|) - (EXIT (LETT |r| (CDR |r|) - |POLYCAT-;reducedSystem;MVR;21|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (CONS |mm| |w|)))))) - -(DEFUN |POLYCAT-;gcdPolynomial;3Sup;22| (|pp| |qq| $) - (SPADCALL |pp| |qq| (|getShellEntry| $ 108))) - -(DEFUN |POLYCAT-;solveLinearPolynomialEquation;LSupU;23| (|lpp| |pp| $) - (SPADCALL |lpp| |pp| (|getShellEntry| $ 113))) - -(DEFUN |POLYCAT-;factorPolynomial;SupF;24| (|pp| $) - (SPADCALL |pp| (|getShellEntry| $ 118))) - -(DEFUN |POLYCAT-;factorSquareFreePolynomial;SupF;25| (|pp| $) - (SPADCALL |pp| (|getShellEntry| $ 121))) - -(DEFUN |POLYCAT-;factor;SF;26| (|p| $) - (PROG (|v| |ansR| #0=#:G1596 |w| #1=#:G1597 |up| |ansSUP| #2=#:G1598 - |ww| #3=#:G1599) - (RETURN - (SEQ (LETT |v| (SPADCALL |p| (|getShellEntry| $ 43)) - |POLYCAT-;factor;SF;26|) - (EXIT (COND - ((QEQCAR |v| 1) - (SEQ (LETT |ansR| - (SPADCALL - (SPADCALL |p| - (|getShellEntry| $ 39)) - (|getShellEntry| $ 124)) - |POLYCAT-;factor;SF;26|) - (EXIT (SPADCALL - (SPADCALL - (SPADCALL |ansR| - (|getShellEntry| $ 126)) - (|getShellEntry| $ 41)) - (PROGN - (LETT #0# NIL - |POLYCAT-;factor;SF;26|) - (SEQ - (LETT |w| NIL - |POLYCAT-;factor;SF;26|) - (LETT #1# - (SPADCALL |ansR| - (|getShellEntry| $ 130)) - |POLYCAT-;factor;SF;26|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |w| (CAR #1#) - |POLYCAT-;factor;SF;26|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (LETT #0# - (CONS - (VECTOR (QVELT |w| 0) - (SPADCALL (QVELT |w| 1) - (|getShellEntry| $ 41)) - (QVELT |w| 2)) - #0#) - |POLYCAT-;factor;SF;26|))) - (LETT #1# (CDR #1#) - |POLYCAT-;factor;SF;26|) - (GO G190) G191 - (EXIT (NREVERSE0 #0#)))) - (|getShellEntry| $ 134))))) - ('T - (SEQ (LETT |up| - (SPADCALL |p| (QCDR |v|) - (|getShellEntry| $ 49)) - |POLYCAT-;factor;SF;26|) - (LETT |ansSUP| - (SPADCALL |up| (|getShellEntry| $ 118)) - |POLYCAT-;factor;SF;26|) - (EXIT (SPADCALL - (SPADCALL - (SPADCALL |ansSUP| - (|getShellEntry| $ 135)) - (QCDR |v|) (|getShellEntry| $ 136)) - (PROGN - (LETT #2# NIL - |POLYCAT-;factor;SF;26|) - (SEQ - (LETT |ww| NIL - |POLYCAT-;factor;SF;26|) - (LETT #3# - (SPADCALL |ansSUP| - (|getShellEntry| $ 139)) - |POLYCAT-;factor;SF;26|) - G190 - (COND - ((OR (ATOM #3#) - (PROGN - (LETT |ww| (CAR #3#) - |POLYCAT-;factor;SF;26|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (LETT #2# - (CONS - (VECTOR (QVELT |ww| 0) - (SPADCALL (QVELT |ww| 1) - (QCDR |v|) - (|getShellEntry| $ 136)) - (QVELT |ww| 2)) - #2#) - |POLYCAT-;factor;SF;26|))) - (LETT #3# (CDR #3#) - |POLYCAT-;factor;SF;26|) - (GO G190) G191 - (EXIT (NREVERSE0 #2#)))) - (|getShellEntry| $ 134))))))))))) - -(DEFUN |POLYCAT-;conditionP;MU;27| (|mat| $) - (PROG (|ll| #0=#:G1634 |z| #1=#:G1635 |ch| |l| #2=#:G1636 #3=#:G1637 - #4=#:G1606 #5=#:G1604 #6=#:G1605 #7=#:G1638 |vars| |degs| - #8=#:G1639 |d| #9=#:G1640 |nd| #10=#:G1633 #11=#:G1613 - |deg1| |redmons| #12=#:G1641 |v| #13=#:G1643 |u| - #14=#:G1642 |llR| |monslist| |ans| #15=#:G1644 - #16=#:G1645 |mons| #17=#:G1646 |m| #18=#:G1647 |i| - #19=#:G1629 #20=#:G1627 #21=#:G1628) - (RETURN - (SEQ (EXIT (SEQ (LETT |ll| - (SPADCALL - (SPADCALL |mat| - (|getShellEntry| $ 141)) - (|getShellEntry| $ 95)) - |POLYCAT-;conditionP;MU;27|) - (LETT |llR| - (PROGN - (LETT #0# NIL - |POLYCAT-;conditionP;MU;27|) - (SEQ (LETT |z| NIL - |POLYCAT-;conditionP;MU;27|) - (LETT #1# (|SPADfirst| |ll|) - |POLYCAT-;conditionP;MU;27|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |z| (CAR #1#) - |POLYCAT-;conditionP;MU;27|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (LETT #0# (CONS NIL #0#) - |POLYCAT-;conditionP;MU;27|))) - (LETT #1# (CDR #1#) - |POLYCAT-;conditionP;MU;27|) - (GO G190) G191 - (EXIT (NREVERSE0 #0#)))) - |POLYCAT-;conditionP;MU;27|) - (LETT |monslist| NIL |POLYCAT-;conditionP;MU;27|) - (LETT |ch| (SPADCALL (|getShellEntry| $ 142)) - |POLYCAT-;conditionP;MU;27|) - (SEQ (LETT |l| NIL |POLYCAT-;conditionP;MU;27|) - (LETT #2# |ll| |POLYCAT-;conditionP;MU;27|) - G190 - (COND - ((OR (ATOM #2#) - (PROGN - (LETT |l| (CAR #2#) - |POLYCAT-;conditionP;MU;27|) - NIL)) - (GO G191))) - (SEQ (LETT |mons| - (PROGN - (LETT #6# NIL - |POLYCAT-;conditionP;MU;27|) - (SEQ - (LETT |u| NIL - |POLYCAT-;conditionP;MU;27|) - (LETT #3# |l| - |POLYCAT-;conditionP;MU;27|) - G190 - (COND - ((OR (ATOM #3#) - (PROGN - (LETT |u| (CAR #3#) - |POLYCAT-;conditionP;MU;27|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (PROGN - (LETT #4# - (SPADCALL |u| - (|getShellEntry| $ 79)) - |POLYCAT-;conditionP;MU;27|) - (COND - (#6# - (LETT #5# - (SPADCALL #5# #4# - (|getShellEntry| $ - 143)) - |POLYCAT-;conditionP;MU;27|)) - ('T - (PROGN - (LETT #5# #4# - |POLYCAT-;conditionP;MU;27|) - (LETT #6# 'T - |POLYCAT-;conditionP;MU;27|))))))) - (LETT #3# (CDR #3#) - |POLYCAT-;conditionP;MU;27|) - (GO G190) G191 (EXIT NIL)) - (COND - (#6# #5#) - ('T - (|IdentityError| - '|setUnion|)))) - |POLYCAT-;conditionP;MU;27|) - (LETT |redmons| NIL - |POLYCAT-;conditionP;MU;27|) - (SEQ (LETT |m| NIL - |POLYCAT-;conditionP;MU;27|) - (LETT #7# |mons| - |POLYCAT-;conditionP;MU;27|) - G190 - (COND - ((OR (ATOM #7#) - (PROGN - (LETT |m| (CAR #7#) - |POLYCAT-;conditionP;MU;27|) - NIL)) - (GO G191))) - (SEQ - (LETT |vars| - (SPADCALL |m| - (|getShellEntry| $ 32)) - |POLYCAT-;conditionP;MU;27|) - (LETT |degs| - (SPADCALL |m| |vars| - (|getShellEntry| $ 144)) - |POLYCAT-;conditionP;MU;27|) - (LETT |deg1| - (PROGN - (LETT #8# NIL - |POLYCAT-;conditionP;MU;27|) - (SEQ - (LETT |d| NIL - |POLYCAT-;conditionP;MU;27|) - (LETT #9# |degs| - |POLYCAT-;conditionP;MU;27|) - G190 - (COND - ((OR (ATOM #9#) - (PROGN - (LETT |d| (CAR #9#) - |POLYCAT-;conditionP;MU;27|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (LETT #8# - (CONS - (SEQ - (LETT |nd| - (SPADCALL |d| |ch| - (|getShellEntry| $ - 146)) - |POLYCAT-;conditionP;MU;27|) - (EXIT - (COND - ((QEQCAR |nd| 1) - (PROGN - (LETT #10# - (CONS 1 "failed") - |POLYCAT-;conditionP;MU;27|) - (GO #10#))) - ('T - (PROG1 - (LETT #11# - (QCDR |nd|) - |POLYCAT-;conditionP;MU;27|) - (|check-subtype| - (>= #11# 0) - '(|NonNegativeInteger|) - #11#)))))) - #8#) - |POLYCAT-;conditionP;MU;27|))) - (LETT #9# (CDR #9#) - |POLYCAT-;conditionP;MU;27|) - (GO G190) G191 - (EXIT (NREVERSE0 #8#)))) - |POLYCAT-;conditionP;MU;27|) - (LETT |redmons| - (CONS - (SPADCALL (|spadConstant| $ 34) - |vars| |deg1| - (|getShellEntry| $ 56)) - |redmons|) - |POLYCAT-;conditionP;MU;27|) - (EXIT - (LETT |llR| - (PROGN - (LETT #12# NIL - |POLYCAT-;conditionP;MU;27|) - (SEQ - (LETT |v| NIL - |POLYCAT-;conditionP;MU;27|) - (LETT #13# |llR| - |POLYCAT-;conditionP;MU;27|) - (LETT |u| NIL - |POLYCAT-;conditionP;MU;27|) - (LETT #14# |l| - |POLYCAT-;conditionP;MU;27|) - G190 - (COND - ((OR (ATOM #14#) - (PROGN - (LETT |u| (CAR #14#) - |POLYCAT-;conditionP;MU;27|) - NIL) - (ATOM #13#) - (PROGN - (LETT |v| (CAR #13#) - |POLYCAT-;conditionP;MU;27|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (LETT #12# - (CONS - (CONS - (SPADCALL - (SPADCALL |u| |vars| - |degs| - (|getShellEntry| $ - 54)) - (|getShellEntry| $ - 147)) - |v|) - #12#) - |POLYCAT-;conditionP;MU;27|))) - (LETT #14# - (PROG1 (CDR #14#) - (LETT #13# (CDR #13#) - |POLYCAT-;conditionP;MU;27|)) - |POLYCAT-;conditionP;MU;27|) - (GO G190) G191 - (EXIT (NREVERSE0 #12#)))) - |POLYCAT-;conditionP;MU;27|))) - (LETT #7# (CDR #7#) - |POLYCAT-;conditionP;MU;27|) - (GO G190) G191 (EXIT NIL)) - (EXIT (LETT |monslist| - (CONS |redmons| |monslist|) - |POLYCAT-;conditionP;MU;27|))) - (LETT #2# (CDR #2#) - |POLYCAT-;conditionP;MU;27|) - (GO G190) G191 (EXIT NIL)) - (LETT |ans| - (SPADCALL - (SPADCALL - (SPADCALL |llR| - (|getShellEntry| $ 92)) - (|getShellEntry| $ 148)) - (|getShellEntry| $ 150)) - |POLYCAT-;conditionP;MU;27|) - (EXIT (COND - ((QEQCAR |ans| 1) (CONS 1 "failed")) - ('T - (SEQ (LETT |i| 0 - |POLYCAT-;conditionP;MU;27|) - (EXIT - (CONS 0 - (PRIMVEC2ARR - (PROGN - (LETT #15# - (GETREFV (SIZE |monslist|)) - |POLYCAT-;conditionP;MU;27|) - (SEQ - (LETT #16# 0 - |POLYCAT-;conditionP;MU;27|) - (LETT |mons| NIL - |POLYCAT-;conditionP;MU;27|) - (LETT #17# |monslist| - |POLYCAT-;conditionP;MU;27|) - G190 - (COND - ((OR (ATOM #17#) - (PROGN - (LETT |mons| (CAR #17#) - |POLYCAT-;conditionP;MU;27|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (SETELT #15# #16# - (PROGN - (LETT #21# NIL - |POLYCAT-;conditionP;MU;27|) - (SEQ - (LETT |m| NIL - |POLYCAT-;conditionP;MU;27|) - (LETT #18# |mons| - |POLYCAT-;conditionP;MU;27|) - G190 - (COND - ((OR (ATOM #18#) - (PROGN - (LETT |m| - (CAR #18#) - |POLYCAT-;conditionP;MU;27|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (PROGN - (LETT #19# - (SPADCALL |m| - (SPADCALL - (SPADCALL - (QCDR |ans|) - (LETT |i| - (+ |i| 1) - |POLYCAT-;conditionP;MU;27|) - (|getShellEntry| - $ 151)) - (|getShellEntry| - $ 41)) - (|getShellEntry| - $ 152)) - |POLYCAT-;conditionP;MU;27|) - (COND - (#21# - (LETT #20# - (SPADCALL #20# - #19# - (|getShellEntry| - $ 153)) - |POLYCAT-;conditionP;MU;27|)) - ('T - (PROGN - (LETT #20# - #19# - |POLYCAT-;conditionP;MU;27|) - (LETT #21# 'T - |POLYCAT-;conditionP;MU;27|))))))) - (LETT #18# (CDR #18#) - |POLYCAT-;conditionP;MU;27|) - (GO G190) G191 - (EXIT NIL)) - (COND - (#21# #20#) - ('T - (|spadConstant| $ 22))))))) - (LETT #17# - (PROG1 (CDR #17#) - (LETT #16# (QSADD1 #16#) - |POLYCAT-;conditionP;MU;27|)) - |POLYCAT-;conditionP;MU;27|) - (GO G190) G191 (EXIT NIL)) - #15#)))))))))) - #10# (EXIT #10#))))) - -(DEFUN |POLYCAT-;charthRoot;SU;28| (|p| $) - (PROG (|vars| |ans| |ch|) - (RETURN - (SEQ (LETT |vars| (SPADCALL |p| (|getShellEntry| $ 32)) - |POLYCAT-;charthRoot;SU;28|) - (EXIT (COND - ((NULL |vars|) - (SEQ (LETT |ans| - (SPADCALL - (SPADCALL |p| - (|getShellEntry| $ 147)) - (|getShellEntry| $ 155)) - |POLYCAT-;charthRoot;SU;28|) - (EXIT (COND - ((QEQCAR |ans| 1) (CONS 1 "failed")) - ('T - (CONS 0 - (SPADCALL (QCDR |ans|) - (|getShellEntry| $ 41)))))))) - ('T - (SEQ (LETT |ch| (SPADCALL (|getShellEntry| $ 142)) - |POLYCAT-;charthRoot;SU;28|) - (EXIT (|POLYCAT-;charthRootlv| |p| |vars| |ch| - $)))))))))) - -(DEFUN |POLYCAT-;charthRootlv| (|p| |vars| |ch| $) - (PROG (|v| |dd| |cp| |d| #0=#:G1668 |ans| |ansx| #1=#:G1675) - (RETURN - (SEQ (EXIT (COND - ((NULL |vars|) - (SEQ (LETT |ans| - (SPADCALL - (SPADCALL |p| - (|getShellEntry| $ 147)) - (|getShellEntry| $ 155)) - |POLYCAT-;charthRootlv|) - (EXIT (COND - ((QEQCAR |ans| 1) (CONS 1 "failed")) - ('T - (CONS 0 - (SPADCALL (QCDR |ans|) - (|getShellEntry| $ 41)))))))) - ('T - (SEQ (LETT |v| (|SPADfirst| |vars|) - |POLYCAT-;charthRootlv|) - (LETT |vars| (CDR |vars|) - |POLYCAT-;charthRootlv|) - (LETT |d| - (SPADCALL |p| |v| - (|getShellEntry| $ 37)) - |POLYCAT-;charthRootlv|) - (LETT |ans| (|spadConstant| $ 22) - |POLYCAT-;charthRootlv|) - (SEQ G190 (COND ((NULL (< 0 |d|)) (GO G191))) - (SEQ (LETT |dd| - (SPADCALL |d| |ch| - (|getShellEntry| $ 146)) - |POLYCAT-;charthRootlv|) - (EXIT - (COND - ((QEQCAR |dd| 1) - (PROGN - (LETT #1# (CONS 1 "failed") - |POLYCAT-;charthRootlv|) - (GO #1#))) - ('T - (SEQ - (LETT |cp| - (SPADCALL |p| |v| |d| - (|getShellEntry| $ 158)) - |POLYCAT-;charthRootlv|) - (LETT |p| - (SPADCALL |p| - (SPADCALL |cp| |v| |d| - (|getShellEntry| $ 38)) - (|getShellEntry| $ 159)) - |POLYCAT-;charthRootlv|) - (LETT |ansx| - (|POLYCAT-;charthRootlv| |cp| - |vars| |ch| $) - |POLYCAT-;charthRootlv|) - (EXIT - (COND - ((QEQCAR |ansx| 1) - (PROGN - (LETT #1# - (CONS 1 "failed") - |POLYCAT-;charthRootlv|) - (GO #1#))) - ('T - (SEQ - (LETT |d| - (SPADCALL |p| |v| - (|getShellEntry| $ 37)) - |POLYCAT-;charthRootlv|) - (EXIT - (LETT |ans| - (SPADCALL |ans| - (SPADCALL (QCDR |ansx|) - |v| - (PROG1 - (LETT #0# (QCDR |dd|) - |POLYCAT-;charthRootlv|) - (|check-subtype| - (>= #0# 0) - '(|NonNegativeInteger|) - #0#)) - (|getShellEntry| $ 38)) - (|getShellEntry| $ 153)) - |POLYCAT-;charthRootlv|))))))))))) - NIL (GO G190) G191 (EXIT NIL)) - (LETT |ansx| - (|POLYCAT-;charthRootlv| |p| |vars| |ch| - $) - |POLYCAT-;charthRootlv|) - (EXIT (COND - ((QEQCAR |ansx| 1) - (PROGN - (LETT #1# (CONS 1 "failed") - |POLYCAT-;charthRootlv|) - (GO #1#))) - ('T - (PROGN - (LETT #1# - (CONS 0 - (SPADCALL |ans| (QCDR |ansx|) - (|getShellEntry| $ 153))) - |POLYCAT-;charthRootlv|) - (GO #1#))))))))) - #1# (EXIT #1#))))) - -(DEFUN |POLYCAT-;monicDivide;2SVarSetR;30| (|p1| |p2| |mvar| $) - (PROG (|result|) - (RETURN - (SEQ (LETT |result| - (SPADCALL - (SPADCALL |p1| |mvar| (|getShellEntry| $ 49)) - (SPADCALL |p2| |mvar| (|getShellEntry| $ 49)) - (|getShellEntry| $ 161)) - |POLYCAT-;monicDivide;2SVarSetR;30|) - (EXIT (CONS (SPADCALL (QCAR |result|) |mvar| - (|getShellEntry| $ 136)) - (SPADCALL (QCDR |result|) |mvar| - (|getShellEntry| $ 136)))))))) - -(DEFUN |POLYCAT-;squareFree;SF;31| (|p| $) - (SPADCALL |p| (|getShellEntry| $ 164))) - -(DEFUN |POLYCAT-;squareFree;SF;32| (|p| $) - (SPADCALL |p| (|getShellEntry| $ 167))) - -(DEFUN |POLYCAT-;squareFree;SF;33| (|p| $) - (SPADCALL |p| (|getShellEntry| $ 167))) - -(DEFUN |POLYCAT-;squareFreePart;2S;34| (|p| $) - (PROG (|s| |f| #0=#:G1691 #1=#:G1689 #2=#:G1687 #3=#:G1688) - (RETURN - (SEQ (SPADCALL - (SPADCALL - (LETT |s| (SPADCALL |p| (|getShellEntry| $ 168)) - |POLYCAT-;squareFreePart;2S;34|) - (|getShellEntry| $ 169)) - (PROGN - (LETT #3# NIL |POLYCAT-;squareFreePart;2S;34|) - (SEQ (LETT |f| NIL |POLYCAT-;squareFreePart;2S;34|) - (LETT #0# (SPADCALL |s| (|getShellEntry| $ 172)) - |POLYCAT-;squareFreePart;2S;34|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |f| (CAR #0#) - |POLYCAT-;squareFreePart;2S;34|) - NIL)) - (GO G191))) - (SEQ (EXIT (PROGN - (LETT #1# (QCAR |f|) - |POLYCAT-;squareFreePart;2S;34|) - (COND - (#3# - (LETT #2# - (SPADCALL #2# #1# - (|getShellEntry| $ 152)) - |POLYCAT-;squareFreePart;2S;34|)) - ('T - (PROGN - (LETT #2# #1# - |POLYCAT-;squareFreePart;2S;34|) - (LETT #3# 'T - |POLYCAT-;squareFreePart;2S;34|))))))) - (LETT #0# (CDR #0#) - |POLYCAT-;squareFreePart;2S;34|) - (GO G190) G191 (EXIT NIL)) - (COND (#3# #2#) ('T (|spadConstant| $ 34)))) - (|getShellEntry| $ 152)))))) - -(DEFUN |POLYCAT-;content;SVarSetS;35| (|p| |v| $) - (SPADCALL (SPADCALL |p| |v| (|getShellEntry| $ 49)) - (|getShellEntry| $ 174))) - -(DEFUN |POLYCAT-;primitivePart;2S;36| (|p| $) - (PROG (#0=#:G1694) - (RETURN - (QVELT (SPADCALL - (PROG2 (LETT #0# - (SPADCALL |p| - (SPADCALL |p| - (|getShellEntry| $ 176)) - (|getShellEntry| $ 177)) - |POLYCAT-;primitivePart;2S;36|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 6) - #0#)) - (|getShellEntry| $ 179)) - 1)))) - -(DEFUN |POLYCAT-;primitivePart;SVarSetS;37| (|p| |v| $) - (PROG (#0=#:G1700) - (RETURN - (QVELT (SPADCALL - (PROG2 (LETT #0# - (SPADCALL |p| - (SPADCALL |p| |v| - (|getShellEntry| $ 181)) - (|getShellEntry| $ 182)) - |POLYCAT-;primitivePart;SVarSetS;37|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 6) - #0#)) - (|getShellEntry| $ 179)) - 1)))) - -(DEFUN |POLYCAT-;<;2SB;38| (|p| |q| $) - (PROG (|dp| |dq|) - (RETURN - (SEQ (LETT |dp| (SPADCALL |p| (|getShellEntry| $ 61)) - |POLYCAT-;<;2SB;38|) - (LETT |dq| (SPADCALL |q| (|getShellEntry| $ 61)) - |POLYCAT-;<;2SB;38|) - (EXIT (COND - ((SPADCALL |dp| |dq| (|getShellEntry| $ 184)) - (SPADCALL (|spadConstant| $ 23) - (SPADCALL |q| (|getShellEntry| $ 39)) - (|getShellEntry| $ 185))) - ((SPADCALL |dq| |dp| (|getShellEntry| $ 184)) - (SPADCALL (SPADCALL |p| (|getShellEntry| $ 39)) - (|spadConstant| $ 23) (|getShellEntry| $ 185))) - ('T - (SPADCALL - (SPADCALL (SPADCALL |p| |q| - (|getShellEntry| $ 159)) - (|getShellEntry| $ 39)) - (|spadConstant| $ 23) (|getShellEntry| $ 185))))))))) - -(DEFUN |POLYCAT-;patternMatch;SP2Pmr;39| (|p| |pat| |l| $) - (SPADCALL |p| |pat| |l| (|getShellEntry| $ 190))) - -(DEFUN |POLYCAT-;patternMatch;SP2Pmr;40| (|p| |pat| |l| $) - (SPADCALL |p| |pat| |l| (|getShellEntry| $ 197))) - -(DEFUN |POLYCAT-;convert;SP;41| (|x| $) - (SPADCALL (ELT $ 200) (ELT $ 201) |x| (|getShellEntry| $ 205))) - -(DEFUN |POLYCAT-;convert;SP;42| (|x| $) - (SPADCALL (ELT $ 207) (ELT $ 208) |x| (|getShellEntry| $ 212))) - -(DEFUN |POLYCAT-;convert;SIf;43| (|p| $) - (SPADCALL (ELT $ 215) (ELT $ 216) |p| (|getShellEntry| $ 220))) - -(DEFUN |PolynomialCategory&| (|#1| |#2| |#3| |#4|) - (PROG (|dv$1| |dv$2| |dv$3| |dv$4| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|PolynomialCategory&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$3| (|devaluate| |#3|) . #0#) - (LETT |dv$4| (|devaluate| |#4|) . #0#) - (LETT |dv$| - (LIST '|PolynomialCategory&| |dv$1| |dv$2| |dv$3| |dv$4|) . #0#) - (LETT $ (|newShell| 229) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasCategory| |#2| - '(|PolynomialFactorizationExplicit|)) - (|HasAttribute| |#2| - '|canonicalUnitNormal|) - (|HasCategory| |#2| '(|GcdDomain|)) - (|HasCategory| |#2| '(|CommutativeRing|)) - (|HasCategory| |#4| - '(|PatternMatchable| (|Float|))) - (|HasCategory| |#2| - '(|PatternMatchable| (|Float|))) - (|HasCategory| |#4| - '(|PatternMatchable| (|Integer|))) - (|HasCategory| |#2| - '(|PatternMatchable| (|Integer|))) - (|HasCategory| |#4| - '(|ConvertibleTo| - (|Pattern| (|Float|)))) - (|HasCategory| |#2| - '(|ConvertibleTo| - (|Pattern| (|Float|)))) - (|HasCategory| |#4| - '(|ConvertibleTo| - (|Pattern| (|Integer|)))) - (|HasCategory| |#2| - '(|ConvertibleTo| - (|Pattern| (|Integer|)))) - (|HasCategory| |#4| - '(|ConvertibleTo| (|InputForm|))) - (|HasCategory| |#2| - '(|ConvertibleTo| (|InputForm|))) - (|HasCategory| |#2| '(|OrderedSet|)))) . #0#)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 |#1|) - (|setShellEntry| $ 7 |#2|) - (|setShellEntry| $ 8 |#3|) - (|setShellEntry| $ 9 |#4|) - (COND - ((|testBitVector| |pv$| 4) - (PROGN - (|setShellEntry| $ 76 - (CONS (|dispatchFunction| - |POLYCAT-;resultant;2SVarSetS;15|) - $)) - (|setShellEntry| $ 78 - (CONS (|dispatchFunction| - |POLYCAT-;discriminant;SVarSetS;16|) - $))))) - (COND - ((|HasCategory| |#2| '(|IntegralDomain|)) - (PROGN - (|setShellEntry| $ 99 - (CONS (|dispatchFunction| - |POLYCAT-;reducedSystem;MM;20|) - $)) - (|setShellEntry| $ 106 - (CONS (|dispatchFunction| - |POLYCAT-;reducedSystem;MVR;21|) - $))))) - (COND - ((|testBitVector| |pv$| 1) - (PROGN - (|setShellEntry| $ 109 - (CONS (|dispatchFunction| - |POLYCAT-;gcdPolynomial;3Sup;22|) - $)) - (|setShellEntry| $ 116 - (CONS (|dispatchFunction| - |POLYCAT-;solveLinearPolynomialEquation;LSupU;23|) - $)) - (|setShellEntry| $ 120 - (CONS (|dispatchFunction| - |POLYCAT-;factorPolynomial;SupF;24|) - $)) - (|setShellEntry| $ 122 - (CONS (|dispatchFunction| - |POLYCAT-;factorSquareFreePolynomial;SupF;25|) - $)) - (|setShellEntry| $ 140 - (CONS (|dispatchFunction| |POLYCAT-;factor;SF;26|) $)) - (COND - ((|HasCategory| |#2| '(|CharacteristicNonZero|)) - (PROGN - (|setShellEntry| $ 154 - (CONS (|dispatchFunction| - |POLYCAT-;conditionP;MU;27|) - $)))))))) - (COND - ((|HasCategory| |#2| '(|CharacteristicNonZero|)) - (PROGN - (|setShellEntry| $ 156 - (CONS (|dispatchFunction| |POLYCAT-;charthRoot;SU;28|) - $))))) - (COND - ((|testBitVector| |pv$| 3) - (PROGN - (COND - ((|HasCategory| |#2| '(|EuclideanDomain|)) - (COND - ((|HasCategory| |#2| '(|CharacteristicZero|)) - (|setShellEntry| $ 165 - (CONS (|dispatchFunction| - |POLYCAT-;squareFree;SF;31|) - $))) - ('T - (|setShellEntry| $ 165 - (CONS (|dispatchFunction| - |POLYCAT-;squareFree;SF;32|) - $))))) - ('T - (|setShellEntry| $ 165 - (CONS (|dispatchFunction| - |POLYCAT-;squareFree;SF;33|) - $)))) - (|setShellEntry| $ 173 - (CONS (|dispatchFunction| - |POLYCAT-;squareFreePart;2S;34|) - $)) - (|setShellEntry| $ 175 - (CONS (|dispatchFunction| - |POLYCAT-;content;SVarSetS;35|) - $)) - (|setShellEntry| $ 180 - (CONS (|dispatchFunction| - |POLYCAT-;primitivePart;2S;36|) - $)) - (|setShellEntry| $ 183 - (CONS (|dispatchFunction| - |POLYCAT-;primitivePart;SVarSetS;37|) - $))))) - (COND - ((|testBitVector| |pv$| 15) - (PROGN - (|setShellEntry| $ 186 - (CONS (|dispatchFunction| |POLYCAT-;<;2SB;38|) $)) - (COND - ((|testBitVector| |pv$| 8) - (COND - ((|testBitVector| |pv$| 7) - (|setShellEntry| $ 192 - (CONS (|dispatchFunction| - |POLYCAT-;patternMatch;SP2Pmr;39|) - $)))))) - (COND - ((|testBitVector| |pv$| 6) - (COND - ((|testBitVector| |pv$| 5) - (|setShellEntry| $ 199 - (CONS (|dispatchFunction| - |POLYCAT-;patternMatch;SP2Pmr;40|) - $))))))))) - (COND - ((|testBitVector| |pv$| 12) - (COND - ((|testBitVector| |pv$| 11) - (|setShellEntry| $ 206 - (CONS (|dispatchFunction| |POLYCAT-;convert;SP;41|) - $)))))) - (COND - ((|testBitVector| |pv$| 10) - (COND - ((|testBitVector| |pv$| 9) - (|setShellEntry| $ 213 - (CONS (|dispatchFunction| |POLYCAT-;convert;SP;42|) - $)))))) - (COND - ((|testBitVector| |pv$| 14) - (COND - ((|testBitVector| |pv$| 13) - (|setShellEntry| $ 221 - (CONS (|dispatchFunction| |POLYCAT-;convert;SIf;43|) - $)))))) - $)))) - -(MAKEPROP '|PolynomialCategory&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|local| |#3|) (|local| |#4|) (|Equation| 6) (0 . |lhs|) - (|Union| 9 '"failed") (5 . |retractIfCan|) - (10 . |retract|) (15 . |rhs|) (|List| 9) (|List| $) - (20 . |eval|) (|Equation| $) (|List| 19) - |POLYCAT-;eval;SLS;1| (27 . |Zero|) (31 . |Zero|) - (|Boolean|) (35 . ~=) (41 . |leadingMonomial|) - (46 . |reductum|) |POLYCAT-;monomials;SL;2| - (51 . |monomials|) (|Union| 17 '"failed") - |POLYCAT-;isPlus;SU;3| (56 . |variables|) - (61 . |monomial?|) (66 . |One|) (70 . |One|) - (|NonNegativeInteger|) (74 . |degree|) (80 . |monomial|) - (87 . |leadingCoefficient|) (92 . =) (98 . |coerce|) - |POLYCAT-;isTimes;SU;4| (103 . |mainVariable|) (108 . =) - (|Record| (|:| |var| 9) (|:| |exponent| 36)) - (|Union| 45 '"failed") |POLYCAT-;isExpt;SU;5| - (|SparseUnivariatePolynomial| $) (114 . |univariate|) - (|SparseUnivariatePolynomial| 6) (120 . |coefficient|) - |POLYCAT-;coefficient;SVarSetNniS;6| (|List| 36) - (126 . |coefficient|) |POLYCAT-;coefficient;SLLS;7| - (133 . |monomial|) |POLYCAT-;monomial;SLLS;8| - (140 . |coerce|) |POLYCAT-;retract;SVarSet;9| - |POLYCAT-;retractIfCan;SU;10| (145 . |degree|) - (150 . |monomial|) |POLYCAT-;primitiveMonomials;SL;12| - (156 . |ground?|) (161 . |Zero|) (165 . ~=) - (171 . |degree|) (176 . |leadingCoefficient|) - (181 . |totalDegree|) (186 . |reductum|) - |POLYCAT-;totalDegree;SNni;13| (191 . |member?|) - (197 . |totalDegree|) |POLYCAT-;totalDegree;SLNni;14| - (203 . |resultant|) (209 . |resultant|) - (216 . |discriminant|) (221 . |discriminant|) - (227 . |primitiveMonomials|) (|List| 6) (232 . |concat|) - (237 . |removeDuplicates!|) (|Vector| 7) (242 . |new|) - (|Integer|) (248 . |minIndex|) (253 . |coefficient|) - (259 . |qsetelt!|) (|List| 7) (|List| 89) (|Matrix| 7) - (266 . |matrix|) (|List| 80) (|Matrix| 6) - (271 . |listOfLists|) (276 . |not|) (281 . |vertConcat|) - (|Matrix| $) (287 . |reducedSystem|) (|Vector| 6) - (292 . |entries|) (297 . |concat|) (303 . |concat|) - (|Record| (|:| |mat| 91) (|:| |vec| 83)) (|Vector| $) - (309 . |reducedSystem|) - (|GeneralPolynomialGcdPackage| 8 9 7 6) - (315 . |gcdPolynomial|) (321 . |gcdPolynomial|) - (|List| 50) (|Union| 110 '"failed") - (|PolynomialFactorizationByRecursion| 7 8 9 6) - (327 . |solveLinearPolynomialEquationByRecursion|) - (|List| 48) (|Union| 114 '"failed") - (333 . |solveLinearPolynomialEquation|) (|Factored| 50) - (339 . |factorByRecursion|) (|Factored| 48) - (344 . |factorPolynomial|) - (349 . |factorSquareFreeByRecursion|) - (354 . |factorSquareFreePolynomial|) (|Factored| $) - (359 . |factor|) (|Factored| 7) (364 . |unit|) - (|Union| '"nil" '"sqfr" '"irred" '"prime") - (|Record| (|:| |flg| 127) (|:| |fctr| 7) (|:| |xpnt| 85)) - (|List| 128) (369 . |factorList|) - (|Record| (|:| |flg| 127) (|:| |fctr| 6) (|:| |xpnt| 85)) - (|List| 131) (|Factored| 6) (374 . |makeFR|) - (380 . |unit|) (385 . |multivariate|) - (|Record| (|:| |flg| 127) (|:| |fctr| 50) (|:| |xpnt| 85)) - (|List| 137) (391 . |factorList|) (396 . |factor|) - (401 . |transpose|) (406 . |characteristic|) - (410 . |setUnion|) (416 . |degree|) (|Union| $ '"failed") - (422 . |exquo|) (428 . |ground|) (433 . |transpose|) - (|Union| 105 '"failed") (438 . |conditionP|) (443 . |elt|) - (449 . *) (455 . +) (461 . |conditionP|) - (466 . |charthRoot|) (471 . |charthRoot|) (476 . |Zero|) - (480 . |coefficient|) (487 . -) - (|Record| (|:| |quotient| $) (|:| |remainder| $)) - (493 . |monicDivide|) |POLYCAT-;monicDivide;2SVarSetR;30| - (|MultivariateSquareFree| 8 9 7 6) (499 . |squareFree|) - (504 . |squareFree|) (|PolynomialSquareFree| 9 8 7 6) - (509 . |squareFree|) (514 . |squareFree|) (519 . |unit|) - (|Record| (|:| |factor| 6) (|:| |exponent| 85)) - (|List| 170) (524 . |factors|) (529 . |squareFreePart|) - (534 . |content|) (539 . |content|) (545 . |content|) - (550 . |exquo|) - (|Record| (|:| |unit| $) (|:| |canonical| $) - (|:| |associate| $)) - (556 . |unitNormal|) (561 . |primitivePart|) - (566 . |content|) (572 . |exquo|) (578 . |primitivePart|) - (584 . <) (590 . <) (596 . <) (|PatternMatchResult| 85 6) - (|Pattern| 85) - (|PatternMatchPolynomialCategory| 85 8 9 7 6) - (602 . |patternMatch|) (|PatternMatchResult| 85 $) - (609 . |patternMatch|) (|Float|) - (|PatternMatchResult| 193 6) (|Pattern| 193) - (|PatternMatchPolynomialCategory| 193 8 9 7 6) - (616 . |patternMatch|) (|PatternMatchResult| 193 $) - (623 . |patternMatch|) (630 . |convert|) (635 . |convert|) - (|Mapping| 188 9) (|Mapping| 188 7) - (|PolynomialCategoryLifting| 8 9 7 6 188) (640 . |map|) - (647 . |convert|) (652 . |convert|) (657 . |convert|) - (|Mapping| 195 9) (|Mapping| 195 7) - (|PolynomialCategoryLifting| 8 9 7 6 195) (662 . |map|) - (669 . |convert|) (|InputForm|) (674 . |convert|) - (679 . |convert|) (|Mapping| 214 9) (|Mapping| 214 7) - (|PolynomialCategoryLifting| 8 9 7 6 214) (684 . |map|) - (691 . |convert|) (|Matrix| 85) (|Vector| 85) - (|Record| (|:| |mat| 222) (|:| |vec| 223)) - (|Union| 85 '"failed") (|Fraction| 85) - (|Union| 226 '"failed") (|Union| 7 '"failed")) - '#(|totalDegree| 696 |squareFreePart| 707 |squareFree| 712 - |solveLinearPolynomialEquation| 717 |retractIfCan| 723 - |retract| 728 |resultant| 733 |reducedSystem| 740 - |primitivePart| 751 |primitiveMonomials| 762 - |patternMatch| 767 |monomials| 781 |monomial| 786 - |monicDivide| 793 |isTimes| 800 |isPlus| 805 |isExpt| 810 - |gcdPolynomial| 815 |factorSquareFreePolynomial| 821 - |factorPolynomial| 826 |factor| 831 |eval| 836 - |discriminant| 842 |convert| 848 |content| 863 - |conditionP| 869 |coefficient| 874 |charthRoot| 888 < 893) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 221 - '(1 10 6 0 11 1 6 12 0 13 1 6 9 0 14 1 - 10 6 0 15 3 6 0 0 16 17 18 0 6 0 22 0 - 7 0 23 2 6 24 0 0 25 1 6 0 0 26 1 6 0 - 0 27 1 6 17 0 29 1 6 16 0 32 1 6 24 0 - 33 0 6 0 34 0 7 0 35 2 6 36 0 9 37 3 - 6 0 0 9 36 38 1 6 7 0 39 2 7 24 0 0 - 40 1 6 0 7 41 1 6 12 0 43 2 6 24 0 0 - 44 2 6 48 0 9 49 2 50 6 0 36 51 3 6 0 - 0 16 53 54 3 6 0 0 16 53 56 1 6 0 9 - 58 1 6 8 0 61 2 6 0 7 8 62 1 6 24 0 - 64 0 50 0 65 2 50 24 0 0 66 1 50 36 0 - 67 1 50 6 0 68 1 6 36 0 69 1 50 0 0 - 70 2 16 24 9 0 72 2 6 36 0 16 73 2 50 - 6 0 0 75 3 0 0 0 0 9 76 1 50 6 0 77 2 - 0 0 0 9 78 1 6 17 0 79 1 80 0 17 81 1 - 80 0 0 82 2 83 0 36 7 84 1 83 85 0 86 - 2 6 7 0 8 87 3 83 7 0 85 7 88 1 91 0 - 90 92 1 94 93 0 95 1 24 0 0 96 2 91 0 - 0 0 97 1 0 91 98 99 1 100 80 0 101 2 - 80 0 0 0 102 2 83 0 0 0 103 2 0 104 - 98 105 106 2 107 50 50 50 108 2 0 48 - 48 48 109 2 112 111 110 50 113 2 0 - 115 114 48 116 1 112 117 50 118 1 0 - 119 48 120 1 112 117 50 121 1 0 119 - 48 122 1 7 123 0 124 1 125 7 0 126 1 - 125 129 0 130 2 133 0 6 132 134 1 117 - 50 0 135 2 6 0 48 9 136 1 117 138 0 - 139 1 0 123 0 140 1 94 0 0 141 0 6 36 - 142 2 80 0 0 0 143 2 6 53 0 16 144 2 - 85 145 0 0 146 1 6 7 0 147 1 91 0 0 - 148 1 7 149 98 150 2 83 7 0 85 151 2 - 6 0 0 0 152 2 6 0 0 0 153 1 0 149 98 - 154 1 7 145 0 155 1 0 145 0 156 0 8 0 - 157 3 6 0 0 9 36 158 2 6 0 0 0 159 2 - 50 160 0 0 161 1 163 133 6 164 1 0 - 123 0 165 1 166 133 6 167 1 6 123 0 - 168 1 133 6 0 169 1 133 171 0 172 1 0 - 0 0 173 1 50 6 0 174 2 0 0 0 9 175 1 - 6 7 0 176 2 6 145 0 7 177 1 6 178 0 - 179 1 0 0 0 180 2 6 0 0 9 181 2 6 145 - 0 0 182 2 0 0 0 9 183 2 8 24 0 0 184 - 2 7 24 0 0 185 2 0 24 0 0 186 3 189 - 187 6 188 187 190 3 0 191 0 188 191 - 192 3 196 194 6 195 194 197 3 0 198 0 - 195 198 199 1 9 188 0 200 1 7 188 0 - 201 3 204 188 202 203 6 205 1 0 188 0 - 206 1 9 195 0 207 1 7 195 0 208 3 211 - 195 209 210 6 212 1 0 195 0 213 1 9 - 214 0 215 1 7 214 0 216 3 219 214 217 - 218 6 220 1 0 214 0 221 2 0 36 0 16 - 74 1 0 36 0 71 1 0 0 0 173 1 0 123 0 - 165 2 0 115 114 48 116 1 0 12 0 60 1 - 0 9 0 59 3 0 0 0 0 9 76 1 0 91 98 99 - 2 0 104 98 105 106 2 0 0 0 9 183 1 0 - 0 0 180 1 0 17 0 63 3 0 191 0 188 191 - 192 3 0 198 0 195 198 199 1 0 17 0 28 - 3 0 0 0 16 53 57 3 0 160 0 0 9 162 1 - 0 30 0 42 1 0 30 0 31 1 0 46 0 47 2 0 - 48 48 48 109 1 0 119 48 122 1 0 119 - 48 120 1 0 123 0 140 2 0 0 0 20 21 2 - 0 0 0 9 78 1 0 214 0 221 1 0 188 0 - 206 1 0 195 0 213 2 0 0 0 9 175 1 0 - 149 98 154 3 0 0 0 16 53 55 3 0 0 0 9 - 36 52 1 0 145 0 156 2 0 24 0 0 186))))) - '|lookupComplete|)) -@ \section{package POLYLIFT PolynomialCategoryLifting} @@ -3024,1417 +1007,6 @@ UnivariatePolynomialCategory(R:Ring): Category == ans @ -\section{UPOLYC.lsp BOOTSTRAP} -{\bf UPOLYC} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf UPOLYC} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf UPOLYC.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<UPOLYC.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |UnivariatePolynomialCategory;CAT| 'NIL) - -(DEFPARAMETER |UnivariatePolynomialCategory;AL| 'NIL) - -(DEFUN |UnivariatePolynomialCategory| (#0=#:G1424) - (LET (#1=#:G1425) - (COND - ((SETQ #1# - (|assoc| (|devaluate| #0#) - |UnivariatePolynomialCategory;AL|)) - (CDR #1#)) - (T (SETQ |UnivariatePolynomialCategory;AL| - (|cons5| (CONS (|devaluate| #0#) - (SETQ #1# - (|UnivariatePolynomialCategory;| - #0#))) - |UnivariatePolynomialCategory;AL|)) - #1#)))) - -(DEFUN |UnivariatePolynomialCategory;| (|t#1|) - (PROG (#0=#:G1423) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (|sublisV| - (PAIR '(#1=#:G1421 #2=#:G1422) - (LIST '(|NonNegativeInteger|) - '(|SingletonAsOrderedSet|))) - (COND - (|UnivariatePolynomialCategory;CAT|) - ('T - (LETT |UnivariatePolynomialCategory;CAT| - (|Join| - (|PolynomialCategory| '|t#1| '#1# - '#2#) - (|Eltable| '|t#1| '|t#1|) - (|Eltable| '$ '$) - (|DifferentialRing|) - (|DifferentialExtension| '|t#1|) - (|mkCategory| '|domain| - '(((|vectorise| - ((|Vector| |t#1|) $ - (|NonNegativeInteger|))) - T) - ((|makeSUP| - ((|SparseUnivariatePolynomial| - |t#1|) - $)) - T) - ((|unmakeSUP| - ($ - (|SparseUnivariatePolynomial| - |t#1|))) - T) - ((|multiplyExponents| - ($ $ (|NonNegativeInteger|))) - T) - ((|divideExponents| - ((|Union| $ "failed") $ - (|NonNegativeInteger|))) - T) - ((|monicDivide| - ((|Record| (|:| |quotient| $) - (|:| |remainder| $)) - $ $)) - T) - ((|karatsubaDivide| - ((|Record| (|:| |quotient| $) - (|:| |remainder| $)) - $ (|NonNegativeInteger|))) - T) - ((|shiftRight| - ($ $ (|NonNegativeInteger|))) - T) - ((|shiftLeft| - ($ $ (|NonNegativeInteger|))) - T) - ((|pseudoRemainder| ($ $ $)) T) - ((|differentiate| - ($ $ (|Mapping| |t#1| |t#1|) - $)) - T) - ((|discriminant| (|t#1| $)) - (|has| |t#1| - (|CommutativeRing|))) - ((|resultant| (|t#1| $ $)) - (|has| |t#1| - (|CommutativeRing|))) - ((|elt| - ((|Fraction| $) - (|Fraction| $) - (|Fraction| $))) - (|has| |t#1| - (|IntegralDomain|))) - ((|order| - ((|NonNegativeInteger|) $ $)) - (|has| |t#1| - (|IntegralDomain|))) - ((|subResultantGcd| ($ $ $)) - (|has| |t#1| - (|IntegralDomain|))) - ((|composite| - ((|Union| $ "failed") $ $)) - (|has| |t#1| - (|IntegralDomain|))) - ((|composite| - ((|Union| (|Fraction| $) - "failed") - (|Fraction| $) $)) - (|has| |t#1| - (|IntegralDomain|))) - ((|pseudoQuotient| ($ $ $)) - (|has| |t#1| - (|IntegralDomain|))) - ((|pseudoDivide| - ((|Record| (|:| |coef| |t#1|) - (|:| |quotient| $) - (|:| |remainder| $)) - $ $)) - (|has| |t#1| - (|IntegralDomain|))) - ((|separate| - ((|Record| - (|:| |primePart| $) - (|:| |commonPart| $)) - $ $)) - (|has| |t#1| (|GcdDomain|))) - ((|elt| - (|t#1| (|Fraction| $) |t#1|)) - (|has| |t#1| (|Field|))) - ((|integrate| ($ $)) - (|has| |t#1| - (|Algebra| - (|Fraction| (|Integer|)))))) - '(((|StepThrough|) - (|has| |t#1| (|StepThrough|))) - ((|Eltable| (|Fraction| $) - (|Fraction| $)) - (|has| |t#1| - (|IntegralDomain|))) - ((|EuclideanDomain|) - (|has| |t#1| (|Field|))) - (|additiveValuation| - (|has| |t#1| (|Field|)))) - '((|Fraction| $) - (|NonNegativeInteger|) - (|SparseUnivariatePolynomial| - |t#1|) - (|Vector| |t#1|)) - NIL)) - . #3=(|UnivariatePolynomialCategory|)))))) . #3#) - (SETELT #0# 0 - (LIST '|UnivariatePolynomialCategory| - (|devaluate| |t#1|))))))) -@ -\section{UPOLYC-.lsp BOOTSTRAP} -{\bf UPOLYC-} depends on {\bf UPOLYC}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf UPOLYC-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf UPOLYC-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<UPOLYC-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |UPOLYC-;variables;SL;1| (|p| $) - (COND - ((OR (SPADCALL |p| (|getShellEntry| $ 9)) - (ZEROP (SPADCALL |p| (|getShellEntry| $ 11)))) - NIL) - ('T (LIST (SPADCALL (|getShellEntry| $ 13)))))) - -(DEFUN |UPOLYC-;degree;SSaosNni;2| (|p| |v| $) - (SPADCALL |p| (|getShellEntry| $ 11))) - -(DEFUN |UPOLYC-;totalDegree;SLNni;3| (|p| |lv| $) - (COND ((NULL |lv|) 0) ('T (SPADCALL |p| (|getShellEntry| $ 17))))) - -(DEFUN |UPOLYC-;degree;SLL;4| (|p| |lv| $) - (COND - ((NULL |lv|) NIL) - ('T (LIST (SPADCALL |p| (|getShellEntry| $ 11)))))) - -(DEFUN |UPOLYC-;eval;SLLS;5| (|p| |lv| |lq| $) - (COND - ((NULL |lv|) |p|) - ((NULL (NULL (CDR |lv|))) - (|error| "can only eval a univariate polynomial once")) - ('T - (SPADCALL |p| (|SPADfirst| |lv|) (|SPADfirst| |lq|) - (|getShellEntry| $ 21))))) - -(DEFUN |UPOLYC-;eval;SSaos2S;6| (|p| |v| |q| $) - (SPADCALL |p| |q| (|getShellEntry| $ 24))) - -(DEFUN |UPOLYC-;eval;SLLS;7| (|p| |lv| |lr| $) - (COND - ((NULL |lv|) |p|) - ((NULL (NULL (CDR |lv|))) - (|error| "can only eval a univariate polynomial once")) - ('T - (SPADCALL |p| (|SPADfirst| |lv|) (|SPADfirst| |lr|) - (|getShellEntry| $ 26))))) - -(DEFUN |UPOLYC-;eval;SSaosRS;8| (|p| |v| |r| $) - (SPADCALL (SPADCALL |p| |r| (|getShellEntry| $ 29)) - (|getShellEntry| $ 30))) - -(DEFUN |UPOLYC-;eval;SLS;9| (|p| |le| $) - (COND - ((NULL |le|) |p|) - ((NULL (NULL (CDR |le|))) - (|error| "can only eval a univariate polynomial once")) - ('T - (COND - ((QEQCAR (SPADCALL - (SPADCALL (|SPADfirst| |le|) - (|getShellEntry| $ 33)) - (|getShellEntry| $ 35)) - 1) - |p|) - ('T - (SPADCALL |p| - (SPADCALL (|SPADfirst| |le|) (|getShellEntry| $ 36)) - (|getShellEntry| $ 24))))))) - -(DEFUN |UPOLYC-;mainVariable;SU;10| (|p| $) - (COND - ((ZEROP (SPADCALL |p| (|getShellEntry| $ 11))) (CONS 1 "failed")) - ('T (CONS 0 (SPADCALL (|getShellEntry| $ 13)))))) - -(DEFUN |UPOLYC-;minimumDegree;SSaosNni;11| (|p| |v| $) - (SPADCALL |p| (|getShellEntry| $ 41))) - -(DEFUN |UPOLYC-;minimumDegree;SLL;12| (|p| |lv| $) - (COND - ((NULL |lv|) NIL) - ('T (LIST (SPADCALL |p| (|getShellEntry| $ 41)))))) - -(DEFUN |UPOLYC-;monomial;SSaosNniS;13| (|p| |v| |n| $) - (SPADCALL (CONS #'|UPOLYC-;monomial;SSaosNniS;13!0| (VECTOR $ |n|)) - |p| (|getShellEntry| $ 46))) - -(DEFUN |UPOLYC-;monomial;SSaosNniS;13!0| (|#1| $$) - (SPADCALL |#1| (|getShellEntry| $$ 1) - (|getShellEntry| (|getShellEntry| $$ 0) 44))) - -(DEFUN |UPOLYC-;coerce;SaosS;14| (|v| $) - (SPADCALL (|spadConstant| $ 49) 1 (|getShellEntry| $ 50))) - -(DEFUN |UPOLYC-;makeSUP;SSup;15| (|p| $) - (COND - ((SPADCALL |p| (|getShellEntry| $ 9)) (|spadConstant| $ 53)) - ('T - (SPADCALL - (SPADCALL (SPADCALL |p| (|getShellEntry| $ 54)) - (SPADCALL |p| (|getShellEntry| $ 11)) - (|getShellEntry| $ 55)) - (SPADCALL (SPADCALL |p| (|getShellEntry| $ 56)) - (|getShellEntry| $ 57)) - (|getShellEntry| $ 58))))) - -(DEFUN |UPOLYC-;unmakeSUP;SupS;16| (|sp| $) - (COND - ((SPADCALL |sp| (|getShellEntry| $ 60)) (|spadConstant| $ 61)) - ('T - (SPADCALL - (SPADCALL (SPADCALL |sp| (|getShellEntry| $ 62)) - (SPADCALL |sp| (|getShellEntry| $ 63)) - (|getShellEntry| $ 50)) - (SPADCALL (SPADCALL |sp| (|getShellEntry| $ 64)) - (|getShellEntry| $ 65)) - (|getShellEntry| $ 66))))) - -(DEFUN |UPOLYC-;karatsubaDivide;SNniR;17| (|p| |n| $) - (SPADCALL |p| - (SPADCALL (|spadConstant| $ 49) |n| (|getShellEntry| $ 50)) - (|getShellEntry| $ 69))) - -(DEFUN |UPOLYC-;shiftRight;SNniS;18| (|p| |n| $) - (QCAR (SPADCALL |p| - (SPADCALL (|spadConstant| $ 49) |n| (|getShellEntry| $ 50)) - (|getShellEntry| $ 69)))) - -(DEFUN |UPOLYC-;shiftLeft;SNniS;19| (|p| |n| $) - (SPADCALL |p| - (SPADCALL (|spadConstant| $ 49) |n| (|getShellEntry| $ 50)) - (|getShellEntry| $ 72))) - -(DEFUN |UPOLYC-;solveLinearPolynomialEquation;LSupU;20| (|lpp| |pp| $) - (SPADCALL |lpp| |pp| (|getShellEntry| $ 78))) - -(DEFUN |UPOLYC-;factorPolynomial;SupF;21| (|pp| $) - (SPADCALL |pp| (|getShellEntry| $ 84))) - -(DEFUN |UPOLYC-;factorSquareFreePolynomial;SupF;22| (|pp| $) - (SPADCALL |pp| (|getShellEntry| $ 87))) - -(DEFUN |UPOLYC-;factor;SF;23| (|p| $) - (PROG (|ansR| #0=#:G1516 |w| #1=#:G1517) - (RETURN - (SEQ (COND - ((ZEROP (SPADCALL |p| (|getShellEntry| $ 11))) - (SEQ (LETT |ansR| - (SPADCALL - (SPADCALL |p| (|getShellEntry| $ 54)) - (|getShellEntry| $ 90)) - |UPOLYC-;factor;SF;23|) - (EXIT (SPADCALL - (SPADCALL - (SPADCALL |ansR| - (|getShellEntry| $ 92)) - (|getShellEntry| $ 30)) - (PROGN - (LETT #0# NIL |UPOLYC-;factor;SF;23|) - (SEQ (LETT |w| NIL - |UPOLYC-;factor;SF;23|) - (LETT #1# - (SPADCALL |ansR| - (|getShellEntry| $ 97)) - |UPOLYC-;factor;SF;23|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |w| (CAR #1#) - |UPOLYC-;factor;SF;23|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (LETT #0# - (CONS - (VECTOR (QVELT |w| 0) - (SPADCALL (QVELT |w| 1) - (|getShellEntry| $ 30)) - (QVELT |w| 2)) - #0#) - |UPOLYC-;factor;SF;23|))) - (LETT #1# (CDR #1#) - |UPOLYC-;factor;SF;23|) - (GO G190) G191 - (EXIT (NREVERSE0 #0#)))) - (|getShellEntry| $ 101))))) - ('T - (SPADCALL (ELT $ 65) - (SPADCALL (SPADCALL |p| (|getShellEntry| $ 57)) - (|getShellEntry| $ 102)) - (|getShellEntry| $ 106)))))))) - -(DEFUN |UPOLYC-;vectorise;SNniV;24| (|p| |n| $) - (PROG (|v| |m| |i| #0=#:G1522 #1=#:G1518) - (RETURN - (SEQ (LETT |m| - (SPADCALL - (LETT |v| - (SPADCALL |n| (|spadConstant| $ 108) - (|getShellEntry| $ 110)) - |UPOLYC-;vectorise;SNniV;24|) - (|getShellEntry| $ 111)) - |UPOLYC-;vectorise;SNniV;24|) - (SEQ (LETT |i| (SPADCALL |v| (|getShellEntry| $ 111)) - |UPOLYC-;vectorise;SNniV;24|) - (LETT #0# (QVSIZE |v|) |UPOLYC-;vectorise;SNniV;24|) - G190 (COND ((> |i| #0#) (GO G191))) - (SEQ (EXIT (SPADCALL |v| |i| - (SPADCALL |p| - (PROG1 - (LETT #1# (- |i| |m|) - |UPOLYC-;vectorise;SNniV;24|) - (|check-subtype| (>= #1# 0) - '(|NonNegativeInteger|) - #1#)) - (|getShellEntry| $ 112)) - (|getShellEntry| $ 113)))) - (LETT |i| (+ |i| 1) |UPOLYC-;vectorise;SNniV;24|) - (GO G190) G191 (EXIT NIL)) - (EXIT |v|))))) - -(DEFUN |UPOLYC-;retract;SR;25| (|p| $) - (COND - ((SPADCALL |p| (|getShellEntry| $ 9)) (|spadConstant| $ 108)) - ((ZEROP (SPADCALL |p| (|getShellEntry| $ 11))) - (SPADCALL |p| (|getShellEntry| $ 54))) - ('T (|error| "Polynomial is not of degree 0")))) - -(DEFUN |UPOLYC-;retractIfCan;SU;26| (|p| $) - (COND - ((SPADCALL |p| (|getShellEntry| $ 9)) - (CONS 0 (|spadConstant| $ 108))) - ((ZEROP (SPADCALL |p| (|getShellEntry| $ 11))) - (CONS 0 (SPADCALL |p| (|getShellEntry| $ 54)))) - ('T (CONS 1 "failed")))) - -(DEFUN |UPOLYC-;init;S;27| ($) - (SPADCALL (|spadConstant| $ 118) (|getShellEntry| $ 30))) - -(DEFUN |UPOLYC-;nextItemInner| (|n| $) - (PROG (|nn| |n1| |n2| #0=#:G1543 |n3|) - (RETURN - (SEQ (COND - ((SPADCALL |n| (|getShellEntry| $ 9)) - (CONS 0 - (SPADCALL - (PROG2 (LETT #0# - (SPADCALL (|spadConstant| $ 108) - (|getShellEntry| $ 121)) - |UPOLYC-;nextItemInner|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|getShellEntry| $ 7) #0#)) - (|getShellEntry| $ 30)))) - ((ZEROP (SPADCALL |n| (|getShellEntry| $ 11))) - (SEQ (LETT |nn| - (SPADCALL - (SPADCALL |n| (|getShellEntry| $ 54)) - (|getShellEntry| $ 121)) - |UPOLYC-;nextItemInner|) - (EXIT (COND - ((QEQCAR |nn| 1) (CONS 1 "failed")) - ('T - (CONS 0 - (SPADCALL (QCDR |nn|) - (|getShellEntry| $ 30)))))))) - ('T - (SEQ (LETT |n1| (SPADCALL |n| (|getShellEntry| $ 56)) - |UPOLYC-;nextItemInner|) - (LETT |n2| (|UPOLYC-;nextItemInner| |n1| $) - |UPOLYC-;nextItemInner|) - (EXIT (COND - ((QEQCAR |n2| 0) - (CONS 0 - (SPADCALL - (SPADCALL - (SPADCALL |n| - (|getShellEntry| $ 54)) - (SPADCALL |n| - (|getShellEntry| $ 11)) - (|getShellEntry| $ 50)) - (QCDR |n2|) - (|getShellEntry| $ 66)))) - ((< (+ 1 - (SPADCALL |n1| - (|getShellEntry| $ 11))) - (SPADCALL |n| (|getShellEntry| $ 11))) - (CONS 0 - (SPADCALL - (SPADCALL - (SPADCALL |n| - (|getShellEntry| $ 54)) - (SPADCALL |n| - (|getShellEntry| $ 11)) - (|getShellEntry| $ 50)) - (SPADCALL - (PROG2 - (LETT #0# - (SPADCALL - (|spadConstant| $ 118) - (|getShellEntry| $ 121)) - |UPOLYC-;nextItemInner|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|getShellEntry| $ 7) #0#)) - (+ 1 - (SPADCALL |n1| - (|getShellEntry| $ 11))) - (|getShellEntry| $ 50)) - (|getShellEntry| $ 66)))) - ('T - (SEQ (LETT |n3| - (SPADCALL - (SPADCALL |n| - (|getShellEntry| $ 54)) - (|getShellEntry| $ 121)) - |UPOLYC-;nextItemInner|) - (EXIT (COND - ((QEQCAR |n3| 1) - (CONS 1 "failed")) - ('T - (CONS 0 - (SPADCALL (QCDR |n3|) - (SPADCALL |n| - (|getShellEntry| $ 11)) - (|getShellEntry| $ 50))))))))))))))))) - -(DEFUN |UPOLYC-;nextItem;SU;29| (|n| $) - (PROG (|n1| #0=#:G1556) - (RETURN - (SEQ (LETT |n1| (|UPOLYC-;nextItemInner| |n| $) - |UPOLYC-;nextItem;SU;29|) - (EXIT (COND - ((QEQCAR |n1| 1) - (CONS 0 - (SPADCALL - (PROG2 (LETT #0# - (SPADCALL (|spadConstant| $ 118) - (|getShellEntry| $ 121)) - |UPOLYC-;nextItem;SU;29|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|getShellEntry| $ 7) #0#)) - (+ 1 - (SPADCALL |n| (|getShellEntry| $ 11))) - (|getShellEntry| $ 50)))) - ('T |n1|))))))) - -(DEFUN |UPOLYC-;content;SSaosS;30| (|p| |v| $) - (SPADCALL (SPADCALL |p| (|getShellEntry| $ 124)) - (|getShellEntry| $ 30))) - -(DEFUN |UPOLYC-;primeFactor| (|p| |q| $) - (PROG (#0=#:G1562 |p1|) - (RETURN - (SEQ (LETT |p1| - (PROG2 (LETT #0# - (SPADCALL |p| - (SPADCALL |p| |q| - (|getShellEntry| $ 126)) - (|getShellEntry| $ 127)) - |UPOLYC-;primeFactor|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 6) - #0#)) - |UPOLYC-;primeFactor|) - (EXIT (COND - ((SPADCALL |p1| |p| (|getShellEntry| $ 128)) |p|) - ('T (|UPOLYC-;primeFactor| |p1| |q| $)))))))) - -(DEFUN |UPOLYC-;separate;2SR;32| (|p| |q| $) - (PROG (|a| #0=#:G1568) - (RETURN - (SEQ (LETT |a| (|UPOLYC-;primeFactor| |p| |q| $) - |UPOLYC-;separate;2SR;32|) - (EXIT (CONS |a| - (PROG2 (LETT #0# - (SPADCALL |p| |a| - (|getShellEntry| $ 127)) - |UPOLYC-;separate;2SR;32|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|getShellEntry| $ 6) #0#)))))))) - -(DEFUN |UPOLYC-;differentiate;SM2S;33| (|x| |deriv| |x'| $) - (PROG (|dg| |lc| #0=#:G1573 |d|) - (RETURN - (SEQ (LETT |d| (|spadConstant| $ 61) - |UPOLYC-;differentiate;SM2S;33|) - (SEQ G190 - (COND - ((NULL (< 0 - (LETT |dg| - (SPADCALL |x| (|getShellEntry| $ 11)) - |UPOLYC-;differentiate;SM2S;33|))) - (GO G191))) - (SEQ (LETT |lc| (SPADCALL |x| (|getShellEntry| $ 54)) - |UPOLYC-;differentiate;SM2S;33|) - (LETT |d| - (SPADCALL - (SPADCALL |d| - (SPADCALL |x'| - (SPADCALL - (SPADCALL |dg| |lc| - (|getShellEntry| $ 132)) - (PROG1 - (LETT #0# (- |dg| 1) - |UPOLYC-;differentiate;SM2S;33|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 50)) - (|getShellEntry| $ 72)) - (|getShellEntry| $ 66)) - (SPADCALL (SPADCALL |lc| |deriv|) |dg| - (|getShellEntry| $ 50)) - (|getShellEntry| $ 66)) - |UPOLYC-;differentiate;SM2S;33|) - (EXIT (LETT |x| - (SPADCALL |x| (|getShellEntry| $ 56)) - |UPOLYC-;differentiate;SM2S;33|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |d| - (SPADCALL - (SPADCALL - (SPADCALL |x| (|getShellEntry| $ 54)) - |deriv|) - (|getShellEntry| $ 30)) - (|getShellEntry| $ 66))))))) - -(DEFUN |UPOLYC-;ncdiff| (|n| |x'| $) - (PROG (#0=#:G1591 |n1|) - (RETURN - (COND - ((ZEROP |n|) (|spadConstant| $ 61)) - ((ZEROP (LETT |n1| - (PROG1 (LETT #0# (- |n| 1) |UPOLYC-;ncdiff|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - |UPOLYC-;ncdiff|)) - |x'|) - ('T - (SPADCALL - (SPADCALL |x'| - (SPADCALL (|spadConstant| $ 49) |n1| - (|getShellEntry| $ 50)) - (|getShellEntry| $ 72)) - (SPADCALL - (SPADCALL (|spadConstant| $ 49) 1 - (|getShellEntry| $ 50)) - (|UPOLYC-;ncdiff| |n1| |x'| $) (|getShellEntry| $ 72)) - (|getShellEntry| $ 66))))))) - -(DEFUN |UPOLYC-;differentiate;SM2S;35| (|x| |deriv| |x'| $) - (PROG (|dg| |lc| |d|) - (RETURN - (SEQ (LETT |d| (|spadConstant| $ 61) - |UPOLYC-;differentiate;SM2S;35|) - (SEQ G190 - (COND - ((NULL (< 0 - (LETT |dg| - (SPADCALL |x| (|getShellEntry| $ 11)) - |UPOLYC-;differentiate;SM2S;35|))) - (GO G191))) - (SEQ (LETT |lc| (SPADCALL |x| (|getShellEntry| $ 54)) - |UPOLYC-;differentiate;SM2S;35|) - (LETT |d| - (SPADCALL - (SPADCALL |d| - (SPADCALL (SPADCALL |lc| |deriv|) - |dg| (|getShellEntry| $ 50)) - (|getShellEntry| $ 66)) - (SPADCALL |lc| - (|UPOLYC-;ncdiff| |dg| |x'| $) - (|getShellEntry| $ 135)) - (|getShellEntry| $ 66)) - |UPOLYC-;differentiate;SM2S;35|) - (EXIT (LETT |x| - (SPADCALL |x| (|getShellEntry| $ 56)) - |UPOLYC-;differentiate;SM2S;35|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |d| - (SPADCALL - (SPADCALL - (SPADCALL |x| (|getShellEntry| $ 54)) - |deriv|) - (|getShellEntry| $ 30)) - (|getShellEntry| $ 66))))))) - -(DEFUN |UPOLYC-;differentiate;SMS;36| (|x| |deriv| $) - (SPADCALL |x| |deriv| (|spadConstant| $ 48) (|getShellEntry| $ 136))) - -(DEFUN |UPOLYC-;differentiate;2S;37| (|x| $) - (PROG (|dg| #0=#:G1600 |d|) - (RETURN - (SEQ (LETT |d| (|spadConstant| $ 61) - |UPOLYC-;differentiate;2S;37|) - (SEQ G190 - (COND - ((NULL (< 0 - (LETT |dg| - (SPADCALL |x| (|getShellEntry| $ 11)) - |UPOLYC-;differentiate;2S;37|))) - (GO G191))) - (SEQ (LETT |d| - (SPADCALL |d| - (SPADCALL - (SPADCALL |dg| - (SPADCALL |x| - (|getShellEntry| $ 54)) - (|getShellEntry| $ 132)) - (PROG1 - (LETT #0# (- |dg| 1) - |UPOLYC-;differentiate;2S;37|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 50)) - (|getShellEntry| $ 66)) - |UPOLYC-;differentiate;2S;37|) - (EXIT (LETT |x| - (SPADCALL |x| (|getShellEntry| $ 56)) - |UPOLYC-;differentiate;2S;37|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |d|))))) - -(DEFUN |UPOLYC-;differentiate;SSaosS;38| (|x| |v| $) - (SPADCALL |x| (|getShellEntry| $ 139))) - -(DEFUN |UPOLYC-;elt;3F;39| (|g| |f| $) - (SPADCALL - (SPADCALL (SPADCALL |g| (|getShellEntry| $ 142)) |f| - (|getShellEntry| $ 144)) - (SPADCALL (SPADCALL |g| (|getShellEntry| $ 145)) |f| - (|getShellEntry| $ 144)) - (|getShellEntry| $ 146))) - -(DEFUN |UPOLYC-;pseudoQuotient;3S;40| (|p| |q| $) - (PROG (|n| #0=#:G1646 #1=#:G1648) - (RETURN - (SEQ (LETT |n| - (+ (- (SPADCALL |p| (|getShellEntry| $ 11)) - (SPADCALL |q| (|getShellEntry| $ 11))) - 1) - |UPOLYC-;pseudoQuotient;3S;40|) - (EXIT (COND - ((< |n| 1) (|spadConstant| $ 61)) - ('T - (PROG2 (LETT #1# - (SPADCALL - (SPADCALL - (SPADCALL - (SPADCALL - (SPADCALL |q| - (|getShellEntry| $ 54)) - (PROG1 - (LETT #0# |n| - |UPOLYC-;pseudoQuotient;3S;40|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 148)) - |p| (|getShellEntry| $ 135)) - (SPADCALL |p| |q| - (|getShellEntry| $ 149)) - (|getShellEntry| $ 150)) - |q| (|getShellEntry| $ 127)) - |UPOLYC-;pseudoQuotient;3S;40|) - (QCDR #1#) - (|check-union| (QEQCAR #1# 0) - (|getShellEntry| $ 6) #1#))))))))) - -(DEFUN |UPOLYC-;pseudoDivide;2SR;41| (|p| |q| $) - (PROG (|n| |prem| #0=#:G1654 |lc| #1=#:G1656) - (RETURN - (SEQ (LETT |n| - (+ (- (SPADCALL |p| (|getShellEntry| $ 11)) - (SPADCALL |q| (|getShellEntry| $ 11))) - 1) - |UPOLYC-;pseudoDivide;2SR;41|) - (EXIT (COND - ((< |n| 1) - (VECTOR (|spadConstant| $ 49) (|spadConstant| $ 61) - |p|)) - ('T - (SEQ (LETT |prem| - (SPADCALL |p| |q| - (|getShellEntry| $ 149)) - |UPOLYC-;pseudoDivide;2SR;41|) - (LETT |lc| - (SPADCALL - (SPADCALL |q| - (|getShellEntry| $ 54)) - (PROG1 - (LETT #0# |n| - |UPOLYC-;pseudoDivide;2SR;41|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 148)) - |UPOLYC-;pseudoDivide;2SR;41|) - (EXIT (VECTOR |lc| - (PROG2 - (LETT #1# - (SPADCALL - (SPADCALL - (SPADCALL |lc| |p| - (|getShellEntry| $ 135)) - |prem| - (|getShellEntry| $ 150)) - |q| (|getShellEntry| $ 127)) - |UPOLYC-;pseudoDivide;2SR;41|) - (QCDR #1#) - (|check-union| (QEQCAR #1# 0) - (|getShellEntry| $ 6) #1#)) - |prem|)))))))))) - -(DEFUN |UPOLYC-;composite;FSU;42| (|f| |q| $) - (PROG (|n| |d|) - (RETURN - (SEQ (LETT |n| - (SPADCALL (SPADCALL |f| (|getShellEntry| $ 142)) |q| - (|getShellEntry| $ 154)) - |UPOLYC-;composite;FSU;42|) - (EXIT (COND - ((QEQCAR |n| 1) (CONS 1 "failed")) - ('T - (SEQ (LETT |d| - (SPADCALL - (SPADCALL |f| - (|getShellEntry| $ 145)) - |q| (|getShellEntry| $ 154)) - |UPOLYC-;composite;FSU;42|) - (EXIT (COND - ((QEQCAR |d| 1) (CONS 1 "failed")) - ('T - (CONS 0 - (SPADCALL (QCDR |n|) (QCDR |d|) - (|getShellEntry| $ 155)))))))))))))) - -(DEFUN |UPOLYC-;composite;2SU;43| (|p| |q| $) - (PROG (|cqr| |v| |u| |w| #0=#:G1682) - (RETURN - (SEQ (COND - ((SPADCALL |p| (|getShellEntry| $ 158)) (CONS 0 |p|)) - ('T - (SEQ (EXIT (SEQ (LETT |cqr| - (SPADCALL |p| |q| - (|getShellEntry| $ 159)) - |UPOLYC-;composite;2SU;43|) - (COND - ((SPADCALL (QVELT |cqr| 2) - (|getShellEntry| $ 158)) - (SEQ (LETT |v| - (SPADCALL (QVELT |cqr| 2) - (QVELT |cqr| 0) - (|getShellEntry| $ 160)) - |UPOLYC-;composite;2SU;43|) - (EXIT - (COND - ((QEQCAR |v| 0) - (SEQ - (LETT |u| - (SPADCALL (QVELT |cqr| 1) - |q| - (|getShellEntry| $ 154)) - |UPOLYC-;composite;2SU;43|) - (EXIT - (COND - ((QEQCAR |u| 0) - (SEQ - (LETT |w| - (SPADCALL (QCDR |u|) - (QVELT |cqr| 0) - (|getShellEntry| $ - 160)) - |UPOLYC-;composite;2SU;43|) - (EXIT - (COND - ((QEQCAR |w| 0) - (PROGN - (LETT #0# - (CONS 0 - (SPADCALL - (QCDR |v|) - (SPADCALL - (SPADCALL - (|spadConstant| - $ 49) - 1 - (|getShellEntry| - $ 50)) - (QCDR |w|) - (|getShellEntry| - $ 72)) - (|getShellEntry| - $ 66))) - |UPOLYC-;composite;2SU;43|) - (GO #0#)))))))))))))))) - (EXIT (CONS 1 "failed")))) - #0# (EXIT #0#)))))))) - -(DEFUN |UPOLYC-;elt;S2F;44| (|p| |f| $) - (PROG (|n| #0=#:G1688 |ans|) - (RETURN - (SEQ (COND - ((SPADCALL |p| (|getShellEntry| $ 9)) - (|spadConstant| $ 162)) - ('T - (SEQ (LETT |ans| - (SPADCALL - (SPADCALL - (SPADCALL |p| (|getShellEntry| $ 54)) - (|getShellEntry| $ 30)) - (|getShellEntry| $ 163)) - |UPOLYC-;elt;S2F;44|) - (LETT |n| (SPADCALL |p| (|getShellEntry| $ 11)) - |UPOLYC-;elt;S2F;44|) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL - (LETT |p| - (SPADCALL |p| - (|getShellEntry| $ 56)) - |UPOLYC-;elt;S2F;44|) - (|getShellEntry| $ 9)) - (|getShellEntry| $ 164))) - (GO G191))) - (SEQ (EXIT (LETT |ans| - (SPADCALL - (SPADCALL |ans| - (SPADCALL |f| - (PROG1 - (LETT #0# - (- |n| - (LETT |n| - (SPADCALL |p| - (|getShellEntry| $ 11)) - |UPOLYC-;elt;S2F;44|)) - |UPOLYC-;elt;S2F;44|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 165)) - (|getShellEntry| $ 166)) - (SPADCALL - (SPADCALL - (SPADCALL |p| - (|getShellEntry| $ 54)) - (|getShellEntry| $ 30)) - (|getShellEntry| $ 163)) - (|getShellEntry| $ 167)) - |UPOLYC-;elt;S2F;44|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((ZEROP |n|) |ans|) - ('T - (SPADCALL |ans| - (SPADCALL |f| |n| - (|getShellEntry| $ 168)) - (|getShellEntry| $ 166)))))))))))) - -(DEFUN |UPOLYC-;order;2SNni;45| (|p| |q| $) - (PROG (|u| #0=#:G1702 |ans|) - (RETURN - (SEQ (EXIT (COND - ((SPADCALL |p| (|getShellEntry| $ 9)) - (|error| "order: arguments must be nonzero")) - ((< (SPADCALL |q| (|getShellEntry| $ 11)) 1) - (|error| "order: place must be non-trivial")) - ('T - (SEQ (LETT |ans| 0 |UPOLYC-;order;2SNni;45|) - (EXIT (SEQ G190 NIL - (SEQ - (LETT |u| - (SPADCALL |p| |q| - (|getShellEntry| $ 127)) - |UPOLYC-;order;2SNni;45|) - (EXIT - (COND - ((QEQCAR |u| 1) - (PROGN - (LETT #0# |ans| - |UPOLYC-;order;2SNni;45|) - (GO #0#))) - ('T - (SEQ - (LETT |p| (QCDR |u|) - |UPOLYC-;order;2SNni;45|) - (EXIT - (LETT |ans| (+ |ans| 1) - |UPOLYC-;order;2SNni;45|))))))) - NIL (GO G190) G191 (EXIT NIL))))))) - #0# (EXIT #0#))))) - -(DEFUN |UPOLYC-;squareFree;SF;46| (|p| $) - (SPADCALL |p| (|getShellEntry| $ 172))) - -(DEFUN |UPOLYC-;squareFreePart;2S;47| (|p| $) - (SPADCALL |p| (|getShellEntry| $ 174))) - -(DEFUN |UPOLYC-;gcdPolynomial;3Sup;48| (|pp| |qq| $) - (COND - ((SPADCALL |pp| (|getShellEntry| $ 176)) - (SPADCALL |qq| (|getShellEntry| $ 177))) - ((SPADCALL |qq| (|getShellEntry| $ 176)) - (SPADCALL |pp| (|getShellEntry| $ 177))) - ('T - (SPADCALL - (SPADCALL - (SPADCALL (SPADCALL |pp| (|getShellEntry| $ 178)) - (SPADCALL |qq| (|getShellEntry| $ 178)) - (|getShellEntry| $ 126)) - (SPADCALL - (SPADCALL (SPADCALL |pp| (|getShellEntry| $ 179)) - (SPADCALL |qq| (|getShellEntry| $ 179)) - (|getShellEntry| $ 180)) - (|getShellEntry| $ 179)) - (|getShellEntry| $ 181)) - (|getShellEntry| $ 177))))) - -(DEFUN |UPOLYC-;squareFreePolynomial;SupF;49| (|pp| $) - (SPADCALL |pp| (|getShellEntry| $ 184))) - -(DEFUN |UPOLYC-;elt;F2R;50| (|f| |r| $) - (SPADCALL - (SPADCALL (SPADCALL |f| (|getShellEntry| $ 142)) |r| - (|getShellEntry| $ 29)) - (SPADCALL (SPADCALL |f| (|getShellEntry| $ 145)) |r| - (|getShellEntry| $ 29)) - (|getShellEntry| $ 186))) - -(DEFUN |UPOLYC-;euclideanSize;SNni;51| (|x| $) - (COND - ((SPADCALL |x| (|getShellEntry| $ 9)) - (|error| "euclideanSize called on 0 in Univariate Polynomial")) - ('T (SPADCALL |x| (|getShellEntry| $ 11))))) - -(DEFUN |UPOLYC-;divide;2SR;52| (|x| |y| $) - (PROG (|lc| |f| #0=#:G1714 |n| |quot|) - (RETURN - (SEQ (COND - ((SPADCALL |y| (|getShellEntry| $ 9)) - (|error| "division by 0 in Univariate Polynomials")) - ('T - (SEQ (LETT |quot| (|spadConstant| $ 61) - |UPOLYC-;divide;2SR;52|) - (LETT |lc| - (SPADCALL - (SPADCALL |y| (|getShellEntry| $ 54)) - (|getShellEntry| $ 189)) - |UPOLYC-;divide;2SR;52|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| - (|getShellEntry| $ 9)) - 'NIL) - ('T - (SPADCALL - (< - (SPADCALL |x| - (|getShellEntry| $ 11)) - (SPADCALL |y| - (|getShellEntry| $ 11))) - (|getShellEntry| $ 164))))) - (GO G191))) - (SEQ (LETT |f| - (SPADCALL |lc| - (SPADCALL |x| - (|getShellEntry| $ 54)) - (|getShellEntry| $ 190)) - |UPOLYC-;divide;2SR;52|) - (LETT |n| - (PROG1 - (LETT #0# - (- - (SPADCALL |x| - (|getShellEntry| $ 11)) - (SPADCALL |y| - (|getShellEntry| $ 11))) - |UPOLYC-;divide;2SR;52|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - |UPOLYC-;divide;2SR;52|) - (LETT |quot| - (SPADCALL |quot| - (SPADCALL |f| |n| - (|getShellEntry| $ 50)) - (|getShellEntry| $ 66)) - |UPOLYC-;divide;2SR;52|) - (EXIT (LETT |x| - (SPADCALL |x| - (SPADCALL - (SPADCALL |f| |n| - (|getShellEntry| $ 50)) - |y| (|getShellEntry| $ 72)) - (|getShellEntry| $ 150)) - |UPOLYC-;divide;2SR;52|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (CONS |quot| |x|))))))))) - -(DEFUN |UPOLYC-;integrate;2S;53| (|p| $) - (PROG (|l| |d| |ans|) - (RETURN - (SEQ (LETT |ans| (|spadConstant| $ 61) |UPOLYC-;integrate;2S;53|) - (SEQ G190 - (COND - ((NULL (SPADCALL |p| (|spadConstant| $ 61) - (|getShellEntry| $ 192))) - (GO G191))) - (SEQ (LETT |l| (SPADCALL |p| (|getShellEntry| $ 54)) - |UPOLYC-;integrate;2S;53|) - (LETT |d| - (+ 1 (SPADCALL |p| (|getShellEntry| $ 11))) - |UPOLYC-;integrate;2S;53|) - (LETT |ans| - (SPADCALL |ans| - (SPADCALL - (SPADCALL - (SPADCALL |d| - (|getShellEntry| $ 194)) - (|getShellEntry| $ 195)) - (SPADCALL |l| |d| - (|getShellEntry| $ 50)) - (|getShellEntry| $ 196)) - (|getShellEntry| $ 66)) - |UPOLYC-;integrate;2S;53|) - (EXIT (LETT |p| - (SPADCALL |p| (|getShellEntry| $ 56)) - |UPOLYC-;integrate;2S;53|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |ans|))))) - -(DEFUN |UnivariatePolynomialCategory&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) - . #0=(|UnivariatePolynomialCategory&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| - (LIST '|UnivariatePolynomialCategory&| |dv$1| |dv$2|) . #0#) - (LETT $ (|newShell| 203) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasCategory| |#2| - '(|Algebra| (|Fraction| (|Integer|)))) - (|HasCategory| |#2| '(|Field|)) - (|HasCategory| |#2| '(|GcdDomain|)) - (|HasCategory| |#2| '(|IntegralDomain|)) - (|HasCategory| |#2| '(|CommutativeRing|)) - (|HasCategory| |#2| '(|StepThrough|)))) . #0#)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 |#1|) - (|setShellEntry| $ 7 |#2|) - (COND - ((|HasCategory| |#2| '(|PolynomialFactorizationExplicit|)) - (PROGN - (|setShellEntry| $ 82 - (CONS (|dispatchFunction| - |UPOLYC-;solveLinearPolynomialEquation;LSupU;20|) - $)) - (|setShellEntry| $ 86 - (CONS (|dispatchFunction| - |UPOLYC-;factorPolynomial;SupF;21|) - $)) - (|setShellEntry| $ 88 - (CONS (|dispatchFunction| - |UPOLYC-;factorSquareFreePolynomial;SupF;22|) - $)) - (|setShellEntry| $ 107 - (CONS (|dispatchFunction| |UPOLYC-;factor;SF;23|) $))))) - (COND - ((|testBitVector| |pv$| 6) - (PROGN - (|setShellEntry| $ 119 - (CONS (|dispatchFunction| |UPOLYC-;init;S;27|) $)) - NIL - (|setShellEntry| $ 123 - (CONS (|dispatchFunction| |UPOLYC-;nextItem;SU;29|) $))))) - (COND - ((|testBitVector| |pv$| 3) - (PROGN - (|setShellEntry| $ 125 - (CONS (|dispatchFunction| |UPOLYC-;content;SSaosS;30|) - $)) - NIL - (|setShellEntry| $ 130 - (CONS (|dispatchFunction| |UPOLYC-;separate;2SR;32|) - $))))) - (COND - ((|testBitVector| |pv$| 5) - (|setShellEntry| $ 134 - (CONS (|dispatchFunction| - |UPOLYC-;differentiate;SM2S;33|) - $))) - ('T - (PROGN - (|setShellEntry| $ 134 - (CONS (|dispatchFunction| - |UPOLYC-;differentiate;SM2S;35|) - $))))) - (COND - ((|testBitVector| |pv$| 4) - (PROGN - (|setShellEntry| $ 147 - (CONS (|dispatchFunction| |UPOLYC-;elt;3F;39|) $)) - (|setShellEntry| $ 151 - (CONS (|dispatchFunction| - |UPOLYC-;pseudoQuotient;3S;40|) - $)) - (|setShellEntry| $ 153 - (CONS (|dispatchFunction| - |UPOLYC-;pseudoDivide;2SR;41|) - $)) - (|setShellEntry| $ 157 - (CONS (|dispatchFunction| |UPOLYC-;composite;FSU;42|) - $)) - (|setShellEntry| $ 161 - (CONS (|dispatchFunction| |UPOLYC-;composite;2SU;43|) - $)) - (|setShellEntry| $ 169 - (CONS (|dispatchFunction| |UPOLYC-;elt;S2F;44|) $)) - (|setShellEntry| $ 170 - (CONS (|dispatchFunction| |UPOLYC-;order;2SNni;45|) $))))) - (COND - ((|testBitVector| |pv$| 3) - (PROGN - (|setShellEntry| $ 173 - (CONS (|dispatchFunction| |UPOLYC-;squareFree;SF;46|) - $)) - (|setShellEntry| $ 175 - (CONS (|dispatchFunction| - |UPOLYC-;squareFreePart;2S;47|) - $))))) - (COND - ((|HasCategory| |#2| '(|PolynomialFactorizationExplicit|)) - (PROGN - (|setShellEntry| $ 182 - (CONS (|dispatchFunction| - |UPOLYC-;gcdPolynomial;3Sup;48|) - $)) - (|setShellEntry| $ 185 - (CONS (|dispatchFunction| - |UPOLYC-;squareFreePolynomial;SupF;49|) - $))))) - (COND - ((|testBitVector| |pv$| 2) - (PROGN - (|setShellEntry| $ 187 - (CONS (|dispatchFunction| |UPOLYC-;elt;F2R;50|) $)) - (|setShellEntry| $ 188 - (CONS (|dispatchFunction| - |UPOLYC-;euclideanSize;SNni;51|) - $)) - (|setShellEntry| $ 191 - (CONS (|dispatchFunction| |UPOLYC-;divide;2SR;52|) $))))) - (COND - ((|testBitVector| |pv$| 1) - (|setShellEntry| $ 197 - (CONS (|dispatchFunction| |UPOLYC-;integrate;2S;53|) $)))) - $)))) - -(MAKEPROP '|UnivariatePolynomialCategory&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|Boolean|) (0 . |zero?|) (|NonNegativeInteger|) - (5 . |degree|) (|SingletonAsOrderedSet|) (10 . |create|) - (|List| 12) |UPOLYC-;variables;SL;1| - |UPOLYC-;degree;SSaosNni;2| (14 . |totalDegree|) - |UPOLYC-;totalDegree;SLNni;3| (|List| 10) - |UPOLYC-;degree;SLL;4| (19 . |eval|) (|List| $) - |UPOLYC-;eval;SLLS;5| (26 . |elt|) - |UPOLYC-;eval;SSaos2S;6| (32 . |eval|) (|List| 7) - |UPOLYC-;eval;SLLS;7| (39 . |elt|) (45 . |coerce|) - |UPOLYC-;eval;SSaosRS;8| (|Equation| 6) (50 . |lhs|) - (|Union| 12 '"failed") (55 . |mainVariable|) (60 . |rhs|) - (|Equation| $) (|List| 37) |UPOLYC-;eval;SLS;9| - |UPOLYC-;mainVariable;SU;10| (65 . |minimumDegree|) - |UPOLYC-;minimumDegree;SSaosNni;11| - |UPOLYC-;minimumDegree;SLL;12| (70 . +) (|Mapping| 10 10) - (76 . |mapExponents|) |UPOLYC-;monomial;SSaosNniS;13| - (82 . |One|) (86 . |One|) (90 . |monomial|) - |UPOLYC-;coerce;SaosS;14| (|SparseUnivariatePolynomial| 7) - (96 . |Zero|) (100 . |leadingCoefficient|) - (105 . |monomial|) (111 . |reductum|) (116 . |makeSUP|) - (121 . +) |UPOLYC-;makeSUP;SSup;15| (127 . |zero?|) - (132 . |Zero|) (136 . |leadingCoefficient|) - (141 . |degree|) (146 . |reductum|) (151 . |unmakeSUP|) - (156 . +) |UPOLYC-;unmakeSUP;SupS;16| - (|Record| (|:| |quotient| $) (|:| |remainder| $)) - (162 . |monicDivide|) |UPOLYC-;karatsubaDivide;SNniR;17| - |UPOLYC-;shiftRight;SNniS;18| (168 . *) - |UPOLYC-;shiftLeft;SNniS;19| - (|SparseUnivariatePolynomial| 6) (|List| 74) - (|Union| 75 '"failed") - (|PolynomialFactorizationByRecursionUnivariate| 7 6) - (174 . |solveLinearPolynomialEquationByRecursion|) - (|SparseUnivariatePolynomial| $) (|List| 79) - (|Union| 80 '"failed") - (180 . |solveLinearPolynomialEquation|) (|Factored| 74) - (186 . |factorByRecursion|) (|Factored| 79) - (191 . |factorPolynomial|) - (196 . |factorSquareFreeByRecursion|) - (201 . |factorSquareFreePolynomial|) (|Factored| $) - (206 . |factor|) (|Factored| 7) (211 . |unit|) - (|Union| '"nil" '"sqfr" '"irred" '"prime") (|Integer|) - (|Record| (|:| |flg| 93) (|:| |fctr| 7) (|:| |xpnt| 94)) - (|List| 95) (216 . |factorList|) - (|Record| (|:| |flg| 93) (|:| |fctr| 6) (|:| |xpnt| 94)) - (|List| 98) (|Factored| 6) (221 . |makeFR|) - (227 . |factorPolynomial|) (|Mapping| 6 52) - (|Factored| 52) (|FactoredFunctions2| 52 6) (232 . |map|) - (238 . |factor|) (243 . |Zero|) (|Vector| 7) (247 . |new|) - (253 . |minIndex|) (258 . |coefficient|) - (264 . |qsetelt!|) |UPOLYC-;vectorise;SNniV;24| - |UPOLYC-;retract;SR;25| (|Union| 7 '"failed") - |UPOLYC-;retractIfCan;SU;26| (271 . |init|) (275 . |init|) - (|Union| $ '"failed") (279 . |nextItem|) (284 . |One|) - (288 . |nextItem|) (293 . |content|) (298 . |content|) - (304 . |gcd|) (310 . |exquo|) (316 . =) - (|Record| (|:| |primePart| $) (|:| |commonPart| $)) - (322 . |separate|) (328 . |Zero|) (332 . *) - (|Mapping| 7 7) (338 . |differentiate|) (345 . *) - (351 . |differentiate|) |UPOLYC-;differentiate;SMS;36| - |UPOLYC-;differentiate;2S;37| (358 . |differentiate|) - |UPOLYC-;differentiate;SSaosS;38| (|Fraction| 6) - (363 . |numer|) (|Fraction| $) (368 . |elt|) - (374 . |denom|) (379 . /) (385 . |elt|) (391 . **) - (397 . |pseudoRemainder|) (403 . -) - (409 . |pseudoQuotient|) - (|Record| (|:| |coef| 7) (|:| |quotient| $) - (|:| |remainder| $)) - (415 . |pseudoDivide|) (421 . |composite|) (427 . /) - (|Union| 143 '"failed") (433 . |composite|) - (439 . |ground?|) (444 . |pseudoDivide|) (450 . |exquo|) - (456 . |composite|) (462 . |Zero|) (466 . |coerce|) - (471 . |not|) (476 . **) (482 . *) (488 . +) (494 . **) - (500 . |elt|) (506 . |order|) - (|UnivariatePolynomialSquareFree| 7 6) - (512 . |squareFree|) (517 . |squareFree|) - (522 . |squareFreePart|) (527 . |squareFreePart|) - (532 . |zero?|) (537 . |unitCanonical|) (542 . |content|) - (547 . |primitivePart|) (552 . |subResultantGcd|) - (558 . *) (564 . |gcdPolynomial|) - (|UnivariatePolynomialSquareFree| 6 74) - (570 . |squareFree|) (575 . |squareFreePolynomial|) - (580 . /) (586 . |elt|) (592 . |euclideanSize|) - (597 . |inv|) (602 . *) (608 . |divide|) (614 . ~=) - (|Fraction| 94) (620 . |coerce|) (625 . |inv|) (630 . *) - (636 . |integrate|) (|Symbol|) (|List| 198) - (|Union| 94 '"failed") (|Union| 193 '"failed") - (|OutputForm|)) - '#(|vectorise| 641 |variables| 647 |unmakeSUP| 652 - |totalDegree| 657 |squareFreePolynomial| 663 - |squareFreePart| 668 |squareFree| 673 - |solveLinearPolynomialEquation| 678 |shiftRight| 684 - |shiftLeft| 690 |separate| 696 |retractIfCan| 702 - |retract| 707 |pseudoQuotient| 712 |pseudoDivide| 718 - |order| 724 |nextItem| 730 |monomial| 735 |minimumDegree| - 742 |makeSUP| 754 |mainVariable| 759 |karatsubaDivide| 764 - |integrate| 770 |init| 775 |gcdPolynomial| 779 - |factorSquareFreePolynomial| 785 |factorPolynomial| 790 - |factor| 795 |eval| 800 |euclideanSize| 834 |elt| 839 - |divide| 857 |differentiate| 863 |degree| 887 |content| - 899 |composite| 905 |coerce| 917) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 197 - '(1 6 8 0 9 1 6 10 0 11 0 12 0 13 1 6 - 10 0 17 3 6 0 0 12 0 21 2 6 0 0 0 24 - 3 6 0 0 12 7 26 2 6 7 0 7 29 1 6 0 7 - 30 1 32 6 0 33 1 6 34 0 35 1 32 6 0 - 36 1 6 10 0 41 2 10 0 0 0 44 2 6 0 45 - 0 46 0 6 0 48 0 7 0 49 2 6 0 7 10 50 - 0 52 0 53 1 6 7 0 54 2 52 0 7 10 55 1 - 6 0 0 56 1 6 52 0 57 2 52 0 0 0 58 1 - 52 8 0 60 0 6 0 61 1 52 7 0 62 1 52 - 10 0 63 1 52 0 0 64 1 6 0 52 65 2 6 0 - 0 0 66 2 6 68 0 0 69 2 6 0 0 0 72 2 - 77 76 75 74 78 2 0 81 80 79 82 1 77 - 83 74 84 1 0 85 79 86 1 77 83 74 87 1 - 0 85 79 88 1 7 89 0 90 1 91 7 0 92 1 - 91 96 0 97 2 100 0 6 99 101 1 7 85 79 - 102 2 105 100 103 104 106 1 0 89 0 - 107 0 7 0 108 2 109 0 10 7 110 1 109 - 94 0 111 2 6 7 0 10 112 3 109 7 0 94 - 7 113 0 7 0 118 0 0 0 119 1 7 120 0 - 121 0 74 0 122 1 0 120 0 123 1 6 7 0 - 124 2 0 0 0 12 125 2 6 0 0 0 126 2 6 - 120 0 0 127 2 6 8 0 0 128 2 0 129 0 0 - 130 0 74 0 131 2 7 0 10 0 132 3 0 0 0 - 133 0 134 2 6 0 7 0 135 3 6 0 0 133 0 - 136 1 6 0 0 139 1 141 6 0 142 2 6 143 - 0 143 144 1 141 6 0 145 2 141 0 0 0 - 146 2 0 143 143 143 147 2 7 0 0 10 - 148 2 6 0 0 0 149 2 6 0 0 0 150 2 0 0 - 0 0 151 2 0 152 0 0 153 2 6 120 0 0 - 154 2 141 0 6 6 155 2 0 156 143 0 157 - 1 6 8 0 158 2 6 152 0 0 159 2 6 120 0 - 7 160 2 0 120 0 0 161 0 141 0 162 1 - 141 0 6 163 1 8 0 0 164 2 141 0 0 94 - 165 2 141 0 0 0 166 2 141 0 0 0 167 2 - 141 0 0 10 168 2 0 143 0 143 169 2 0 - 10 0 0 170 1 171 100 6 172 1 0 89 0 - 173 1 171 6 6 174 1 0 0 0 175 1 74 8 - 0 176 1 74 0 0 177 1 74 6 0 178 1 74 - 0 0 179 2 74 0 0 0 180 2 74 0 6 0 181 - 2 0 79 79 79 182 1 183 83 74 184 1 0 - 85 79 185 2 7 0 0 0 186 2 0 7 143 7 - 187 1 0 10 0 188 1 7 0 0 189 2 7 0 0 - 0 190 2 0 68 0 0 191 2 6 8 0 0 192 1 - 193 0 94 194 1 193 0 0 195 2 6 0 193 - 0 196 1 0 0 0 197 2 0 109 0 10 114 1 - 0 14 0 15 1 0 0 52 67 2 0 10 0 14 18 - 1 0 85 79 185 1 0 0 0 175 1 0 89 0 - 173 2 0 81 80 79 82 2 0 0 0 10 71 2 0 - 0 0 10 73 2 0 129 0 0 130 1 0 116 0 - 117 1 0 7 0 115 2 0 0 0 0 151 2 0 152 - 0 0 153 2 0 10 0 0 170 1 0 120 0 123 - 3 0 0 0 12 10 47 2 0 19 0 14 43 2 0 - 10 0 12 42 1 0 52 0 59 1 0 34 0 40 2 - 0 68 0 10 70 1 0 0 0 197 0 0 0 119 2 - 0 79 79 79 182 1 0 85 79 88 1 0 85 79 - 86 1 0 89 0 107 3 0 0 0 12 0 25 3 0 0 - 0 14 22 23 3 0 0 0 14 27 28 3 0 0 0 - 12 7 31 2 0 0 0 38 39 1 0 10 0 188 2 - 0 143 0 143 169 2 0 7 143 7 187 2 0 - 143 143 143 147 2 0 68 0 0 191 3 0 0 - 0 133 0 134 2 0 0 0 133 137 1 0 0 0 - 138 2 0 0 0 12 140 2 0 10 0 12 16 2 0 - 19 0 14 20 2 0 0 0 12 125 2 0 120 0 0 - 161 2 0 156 143 0 157 1 0 0 12 51))))) - '|lookupComplete|)) -@ \section{package UPOLYC2 UnivariatePolynomialCategoryFunctions2} diff --git a/src/algebra/pscat.spad.pamphlet b/src/algebra/pscat.spad.pamphlet index 58d549c6..ffa92a3f 100644 --- a/src/algebra/pscat.spad.pamphlet +++ b/src/algebra/pscat.spad.pamphlet @@ -474,130 +474,7 @@ UnivariateLaurentSeriesCategory(Coef): Category == Definition where --++ In fact, K((x)) is the quotient field of K[[x]]. @ -\section{ULSCAT.lsp BOOTSTRAP} -{\bf ULSCAT} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ULSCAT} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ULSCAT.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<ULSCAT.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |UnivariateLaurentSeriesCategory;CAT| 'NIL) - -(DEFPARAMETER |UnivariateLaurentSeriesCategory;AL| 'NIL) - -(DEFUN |UnivariateLaurentSeriesCategory| (#0=#:G1388) - (LET (#1=#:G1389) - (COND - ((SETQ #1# - (|assoc| (|devaluate| #0#) - |UnivariateLaurentSeriesCategory;AL|)) - (CDR #1#)) - (T (SETQ |UnivariateLaurentSeriesCategory;AL| - (|cons5| (CONS (|devaluate| #0#) - (SETQ #1# - (|UnivariateLaurentSeriesCategory;| - #0#))) - |UnivariateLaurentSeriesCategory;AL|)) - #1#)))) - -(DEFUN |UnivariateLaurentSeriesCategory;| (|t#1|) - (PROG (#0=#:G1387) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (|sublisV| - (PAIR '(#1=#:G1386) (LIST '(|Integer|))) - (COND - (|UnivariateLaurentSeriesCategory;CAT|) - ('T - (LETT |UnivariateLaurentSeriesCategory;CAT| - (|Join| - (|UnivariatePowerSeriesCategory| - '|t#1| '#1#) - (|mkCategory| '|domain| - '(((|series| - ($ - (|Stream| - (|Record| - (|:| |k| (|Integer|)) - (|:| |c| |t#1|))))) - T) - ((|multiplyCoefficients| - ($ - (|Mapping| |t#1| - (|Integer|)) - $)) - T) - ((|rationalFunction| - ((|Fraction| - (|Polynomial| |t#1|)) - $ (|Integer|))) - (|has| |t#1| - (|IntegralDomain|))) - ((|rationalFunction| - ((|Fraction| - (|Polynomial| |t#1|)) - $ (|Integer|) (|Integer|))) - (|has| |t#1| - (|IntegralDomain|))) - ((|integrate| ($ $)) - (|has| |t#1| - (|Algebra| - (|Fraction| (|Integer|))))) - ((|integrate| ($ $ (|Symbol|))) - (AND - (|has| |t#1| - (SIGNATURE |variables| - ((|List| (|Symbol|)) |t#1|))) - (|has| |t#1| - (SIGNATURE |integrate| - (|t#1| |t#1| (|Symbol|)))) - (|has| |t#1| - (|Algebra| - (|Fraction| (|Integer|)))))) - ((|integrate| ($ $ (|Symbol|))) - (AND - (|has| |t#1| - (|AlgebraicallyClosedFunctionSpace| - (|Integer|))) - (|has| |t#1| - (|PrimitiveFunctionCategory|)) - (|has| |t#1| - (|TranscendentalFunctionCategory|)) - (|has| |t#1| - (|Algebra| - (|Fraction| (|Integer|))))))) - '(((|RadicalCategory|) - (|has| |t#1| - (|Algebra| - (|Fraction| (|Integer|))))) - ((|TranscendentalFunctionCategory|) - (|has| |t#1| - (|Algebra| - (|Fraction| (|Integer|))))) - ((|Field|) - (|has| |t#1| (|Field|)))) - '((|Symbol|) - (|Fraction| - (|Polynomial| |t#1|)) - (|Integer|) - (|Stream| - (|Record| - (|:| |k| (|Integer|)) - (|:| |c| |t#1|)))) - NIL)) - . #2=(|UnivariateLaurentSeriesCategory|)))))) . #2#) - (SETELT #0# 0 - (LIST '|UnivariateLaurentSeriesCategory| - (|devaluate| |t#1|))))))) -@ + \section{category UPXSCAT UnivariatePuiseuxSeriesCategory} <<category UPXSCAT UnivariatePuiseuxSeriesCategory>>= )abbrev category UPXSCAT UnivariatePuiseuxSeriesCategory @@ -723,124 +600,7 @@ MultivariateTaylorSeriesCategory(Coef,Var): Category == Definition where --++ coefficients by integers. @ -\section{MTSCAT.lsp BOOTSTRAP} -{\bf MTSCAT} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf MTSCAT} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf MTSCAT.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<MTSCAT.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |MultivariateTaylorSeriesCategory;CAT| 'NIL) - -(DEFPARAMETER |MultivariateTaylorSeriesCategory;AL| 'NIL) - -(DEFUN |MultivariateTaylorSeriesCategory| - (&REST #0=#:G1390 &AUX #1=#:G1388) - (DSETQ #1# #0#) - (LET (#2=#:G1389) - (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#)))) - -(DEFUN |MultivariateTaylorSeriesCategory;| (|t#1| |t#2|) - (PROG (#0=#:G1387) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(|t#1| |t#2|) - (LIST (|devaluate| |t#1|) - (|devaluate| |t#2|))) - (|sublisV| - (PAIR '(#1=#:G1386) - (LIST '(|IndexedExponents| |t#2|))) - (COND - (|MultivariateTaylorSeriesCategory;CAT|) - ('T - (LETT |MultivariateTaylorSeriesCategory;CAT| - (|Join| - (|PartialDifferentialRing| '|t#2|) - (|PowerSeriesCategory| '|t#1| '#1# - '|t#2|) - (|InnerEvalable| '|t#2| '$) - (|Evalable| '$) - (|mkCategory| '|domain| - '(((|coefficient| - ($ $ |t#2| - (|NonNegativeInteger|))) - T) - ((|coefficient| - ($ $ (|List| |t#2|) - (|List| - (|NonNegativeInteger|)))) - T) - ((|extend| - ($ $ (|NonNegativeInteger|))) - T) - ((|monomial| - ($ $ |t#2| - (|NonNegativeInteger|))) - T) - ((|monomial| - ($ $ (|List| |t#2|) - (|List| - (|NonNegativeInteger|)))) - T) - ((|order| - ((|NonNegativeInteger|) $ - |t#2|)) - T) - ((|order| - ((|NonNegativeInteger|) $ - |t#2| - (|NonNegativeInteger|))) - T) - ((|polynomial| - ((|Polynomial| |t#1|) $ - (|NonNegativeInteger|))) - T) - ((|polynomial| - ((|Polynomial| |t#1|) $ - (|NonNegativeInteger|) - (|NonNegativeInteger|))) - T) - ((|integrate| ($ $ |t#2|)) - (|has| |t#1| - (|Algebra| - (|Fraction| (|Integer|)))))) - '(((|RadicalCategory|) - (|has| |t#1| - (|Algebra| - (|Fraction| (|Integer|))))) - ((|TranscendentalFunctionCategory|) - (|has| |t#1| - (|Algebra| - (|Fraction| (|Integer|)))))) - '((|Polynomial| |t#1|) - (|NonNegativeInteger|) - (|List| |t#2|) - (|List| (|NonNegativeInteger|))) - NIL)) - . #2=(|MultivariateTaylorSeriesCategory|)))))) . #2#) - (SETELT #0# 0 - (LIST '|MultivariateTaylorSeriesCategory| - (|devaluate| |t#1|) (|devaluate| |t#2|))))))) -@ + \section{License} <<license>>= --Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. diff --git a/src/algebra/sf.spad.pamphlet b/src/algebra/sf.spad.pamphlet index b8ad8334..66714b07 100644 --- a/src/algebra/sf.spad.pamphlet +++ b/src/algebra/sf.spad.pamphlet @@ -117,216 +117,7 @@ RealNumberSystem(): Category == failed() @ -\section{RNS.lsp BOOTSTRAP} -{\bf RNS} depends on a chain of -files. We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf RNS} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf RNS.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. -Note that this code is not included in the generated catdef.spad file. - -<<RNS.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |RealNumberSystem;AL| 'NIL) - -(DEFUN |RealNumberSystem| () - (LET (#:G1396) - (COND - (|RealNumberSystem;AL|) - (T (SETQ |RealNumberSystem;AL| (|RealNumberSystem;|)))))) - -(DEFUN |RealNumberSystem;| () - (PROG (#0=#:G1394) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(#1=#:G1390 #2=#:G1391 #3=#:G1392 - #4=#:G1393) - (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|) - (SETELT #0# 0 '(|RealNumberSystem|)))))) - -(MAKEPROP '|RealNumberSystem| 'NILADIC T) -@ -\section{RNS-.lsp BOOTSTRAP} -{\bf RNS-} depends {\bf RNS}. -We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf RNS-} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf RNS.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<RNS-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(PUT '|RNS-;characteristic;Nni;1| '|SPADreplace| '(XLAM NIL 0)) - -(DEFUN |RNS-;characteristic;Nni;1| ($) 0) - -(DEFUN |RNS-;fractionPart;2S;2| (|x| $) - (SPADCALL |x| (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 10))) - -(DEFUN |RNS-;truncate;2S;3| (|x| $) - (COND - ((SPADCALL |x| (QREFELT $ 13)) - (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT $ 14)) (QREFELT $ 15)) - (QREFELT $ 14))) - ('T (SPADCALL |x| (QREFELT $ 15))))) - -(DEFUN |RNS-;round;2S;4| (|x| $) - (COND - ((SPADCALL |x| (QREFELT $ 13)) - (SPADCALL - (SPADCALL |x| - (SPADCALL (|spadConstant| $ 17) - (SPADCALL 2 (QREFELT $ 19)) (QREFELT $ 20)) - (QREFELT $ 10)) - (QREFELT $ 9))) - ('T - (SPADCALL - (SPADCALL |x| - (SPADCALL (|spadConstant| $ 17) - (SPADCALL 2 (QREFELT $ 19)) (QREFELT $ 20)) - (QREFELT $ 21)) - (QREFELT $ 9))))) - -(DEFUN |RNS-;norm;2S;5| (|x| $) (SPADCALL |x| (QREFELT $ 23))) - -(DEFUN |RNS-;coerce;FS;6| (|x| $) - (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT $ 26)) (QREFELT $ 19)) - (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 19)) - (QREFELT $ 20))) - -(DEFUN |RNS-;convert;SP;7| (|x| $) - (SPADCALL (SPADCALL |x| (QREFELT $ 30)) (QREFELT $ 32))) - -(DEFUN |RNS-;floor;2S;8| (|x| $) - (PROG (|x1|) - (RETURN - (SEQ (LETT |x1| - (SPADCALL (SPADCALL |x| (QREFELT $ 34)) - (QREFELT $ 19)) - |RNS-;floor;2S;8|) - (EXIT (COND - ((SPADCALL |x| |x1| (QREFELT $ 35)) |x|) - ((SPADCALL |x| (|spadConstant| $ 36) (QREFELT $ 37)) - (SPADCALL |x1| (|spadConstant| $ 17) - (QREFELT $ 10))) - ('T |x1|))))))) - -(DEFUN |RNS-;ceiling;2S;9| (|x| $) - (PROG (|x1|) - (RETURN - (SEQ (LETT |x1| - (SPADCALL (SPADCALL |x| (QREFELT $ 34)) - (QREFELT $ 19)) - |RNS-;ceiling;2S;9|) - (EXIT (COND - ((SPADCALL |x| |x1| (QREFELT $ 35)) |x|) - ((SPADCALL |x| (|spadConstant| $ 36) (QREFELT $ 37)) - |x1|) - ('T - (SPADCALL |x1| (|spadConstant| $ 17) - (QREFELT $ 21))))))))) - -(DEFUN |RNS-;patternMatch;SP2Pmr;10| (|x| |p| |l| $) - (PROG (|r|) - (RETURN - (SEQ (COND - ((SPADCALL |p| (QREFELT $ 40)) - (SPADCALL |p| |x| |l| (QREFELT $ 42))) - ((SPADCALL |p| (QREFELT $ 43)) - (SEQ (LETT |r| (SPADCALL |p| (QREFELT $ 45)) - |RNS-;patternMatch;SP2Pmr;10|) - (EXIT (COND - ((QEQCAR |r| 0) - (COND - ((SPADCALL (SPADCALL |x| (QREFELT $ 30)) - (QCDR |r|) (QREFELT $ 46)) - |l|) - ('T (SPADCALL (QREFELT $ 47))))) - ('T (SPADCALL (QREFELT $ 47))))))) - ('T (SPADCALL (QREFELT $ 47)))))))) - -(DEFUN |RealNumberSystem&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|RealNumberSystem&|)) - (LETT |dv$| (LIST '|RealNumberSystem&| |dv$1|) . #0#) - (LETT $ (GETREFV 52) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) - -(MAKEPROP '|RealNumberSystem&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) - (|NonNegativeInteger|) |RNS-;characteristic;Nni;1| - (0 . |truncate|) (5 . -) |RNS-;fractionPart;2S;2| - (|Boolean|) (11 . |negative?|) (16 . -) (21 . |floor|) - |RNS-;truncate;2S;3| (26 . |One|) (|Integer|) - (30 . |coerce|) (35 . /) (41 . +) |RNS-;round;2S;4| - (47 . |abs|) |RNS-;norm;2S;5| (|Fraction| 18) - (52 . |numer|) (57 . |denom|) |RNS-;coerce;FS;6| (|Float|) - (62 . |convert|) (|Pattern| 29) (67 . |coerce|) - |RNS-;convert;SP;7| (72 . |wholePart|) (77 . =) - (83 . |Zero|) (87 . <) |RNS-;floor;2S;8| - |RNS-;ceiling;2S;9| (93 . |generic?|) - (|PatternMatchResult| 29 6) (98 . |addMatch|) - (105 . |constant?|) (|Union| 29 '"failed") - (110 . |retractIfCan|) (115 . =) (121 . |failed|) - (|PatternMatchResult| 29 $) |RNS-;patternMatch;SP2Pmr;10| - (|DoubleFloat|) (|OutputForm|)) - '#(|truncate| 125 |round| 130 |patternMatch| 135 |norm| 142 - |fractionPart| 147 |floor| 152 |convert| 157 |coerce| 162 - |characteristic| 172 |ceiling| 176) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 49 - '(1 6 0 0 9 2 6 0 0 0 10 1 6 12 0 13 1 - 6 0 0 14 1 6 0 0 15 0 6 0 17 1 6 0 18 - 19 2 6 0 0 0 20 2 6 0 0 0 21 1 6 0 0 - 23 1 25 18 0 26 1 25 18 0 27 1 6 29 0 - 30 1 31 0 29 32 1 6 18 0 34 2 6 12 0 - 0 35 0 6 0 36 2 6 12 0 0 37 1 31 12 0 - 40 3 41 0 31 6 0 42 1 31 12 0 43 1 31 - 44 0 45 2 29 12 0 0 46 0 41 0 47 1 0 - 0 0 16 1 0 0 0 22 3 0 48 0 31 48 49 1 - 0 0 0 24 1 0 0 0 11 1 0 0 0 38 1 0 31 - 0 33 1 0 0 25 28 1 0 0 25 28 0 0 7 8 - 1 0 0 0 39))))) - '|lookupComplete|)) -@ \section{category FPS FloatingPointSystem} <<category FPS FloatingPointSystem>>= )abbrev category FPS FloatingPointSystem @@ -411,161 +202,7 @@ FloatingPointSystem(): Category == RealNumberSystem() with digits() == max(1,4004 * (bits()-1) quo 13301)::PositiveInteger @ -\section{FPS.lsp BOOTSTRAP} -{\bf FPS} depends on a chain of -files. We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf FPS} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf FPS.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<FPS.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |FloatingPointSystem;AL| 'NIL) - -(DEFUN |FloatingPointSystem| () - (LET (#:G1387) - (COND - (|FloatingPointSystem;AL|) - (T (SETQ |FloatingPointSystem;AL| (|FloatingPointSystem;|)))))) - -(DEFUN |FloatingPointSystem;| () - (PROG (#0=#:G1385) - (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|) - (SETELT #0# 0 '(|FloatingPointSystem|)))))) - -(MAKEPROP '|FloatingPointSystem| 'NILADIC T) -@ -\section{FPS-.lsp BOOTSTRAP} -{\bf FPS-} depends {\bf FPS}. -We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf FPS-} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf FPS-.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. -<<FPS-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |FPS-;float;2IS;1| (|ma| |ex| $) - (SPADCALL |ma| |ex| (SPADCALL (QREFELT $ 8)) (QREFELT $ 10))) - -(DEFUN |FPS-;digits;Pi;2| ($) - (PROG (#0=#:G1389) - (RETURN - (PROG1 (LETT #0# - (MAX 1 - (QUOTIENT2 - (SPADCALL 4004 - (- (SPADCALL (QREFELT $ 13)) 1) - (QREFELT $ 14)) - 13301)) - |FPS-;digits;Pi;2|) - (|check-subtype| (> #0# 0) '(|PositiveInteger|) #0#))))) - -(DEFUN |FloatingPointSystem&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|FloatingPointSystem&|)) - (LETT |dv$| (LIST '|FloatingPointSystem&| |dv$1|) . #0#) - (LETT $ (GETREFV 17) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasAttribute| |#1| '|arbitraryExponent|) - (|HasAttribute| |#1| '|arbitraryPrecision|))) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) - -(MAKEPROP '|FloatingPointSystem&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|PositiveInteger|) - (0 . |base|) (|Integer|) (4 . |float|) |FPS-;float;2IS;1| - (11 . |One|) (15 . |bits|) (19 . *) (25 . |max|) - |FPS-;digits;Pi;2|) - '#(|float| 29 |digits| 35) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 16 - '(0 6 7 8 3 6 0 9 9 7 10 0 6 0 12 0 6 7 - 13 2 9 0 7 0 14 0 6 0 15 2 0 0 9 9 11 - 0 0 7 16))))) - '|lookupComplete|)) -@ \section{domain DFLOAT DoubleFloat} Greg Vanuxem has added some functionality to allow the user to modify the printed format of floating point numbers. The format of the numbers @@ -1012,890 +649,7 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath, x ** (n::% / d::%) @ -\section{DFLOAT.lsp BOOTSTRAP} -{\bf DFLOAT} depends on itself. -We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf DFLOAT} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf DFLOAT.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<DFLOAT.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |DFLOAT;doubleFloatFormat;2S;1| (|s| $) - (PROG (|ss|) - (RETURN - (SEQ (LETT |ss| (|getShellEntry| $ 6) - |DFLOAT;doubleFloatFormat;2S;1|) - (SETELT $ 6 |s|) (EXIT |ss|))))) - -(DEFUN |DFLOAT;OMwrite;$S;2| (|x| $) - (PROG (|sp| |dev| |s|) - (RETURN - (SEQ (LETT |s| "" |DFLOAT;OMwrite;$S;2|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |DFLOAT;OMwrite;$S;2|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 10)) - (|getShellEntry| $ 12)) - |DFLOAT;OMwrite;$S;2|) - (SPADCALL |dev| (|getShellEntry| $ 14)) - (SPADCALL |dev| |x| (|getShellEntry| $ 16)) - (SPADCALL |dev| (|getShellEntry| $ 17)) - (SPADCALL |dev| (|getShellEntry| $ 18)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |DFLOAT;OMwrite;$S;2|) - (EXIT |s|))))) - -(DEFUN |DFLOAT;OMwrite;$BS;3| (|x| |wholeObj| $) - (PROG (|sp| |dev| |s|) - (RETURN - (SEQ (LETT |s| "" |DFLOAT;OMwrite;$BS;3|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) - |DFLOAT;OMwrite;$BS;3|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 10)) - (|getShellEntry| $ 12)) - |DFLOAT;OMwrite;$BS;3|) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 14)))) - (SPADCALL |dev| |x| (|getShellEntry| $ 16)) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 17)))) - (SPADCALL |dev| (|getShellEntry| $ 18)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) - |DFLOAT;OMwrite;$BS;3|) - (EXIT |s|))))) - -(DEFUN |DFLOAT;OMwrite;Omd$V;4| (|dev| |x| $) - (SEQ (SPADCALL |dev| (|getShellEntry| $ 14)) - (SPADCALL |dev| |x| (|getShellEntry| $ 16)) - (EXIT (SPADCALL |dev| (|getShellEntry| $ 17))))) - -(DEFUN |DFLOAT;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 14)))) - (SPADCALL |dev| |x| (|getShellEntry| $ 16)) - (EXIT (COND - (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 17))))))) - -(PUT '|DFLOAT;checkComplex| '|SPADreplace| 'C-TO-R) - -(DEFUN |DFLOAT;checkComplex| (|x| $) (C-TO-R |x|)) - -(PUT '|DFLOAT;base;Pi;7| '|SPADreplace| '(XLAM NIL (FLOAT-RADIX 0.0))) - -(DEFUN |DFLOAT;base;Pi;7| ($) (FLOAT-RADIX 0.0)) - -(DEFUN |DFLOAT;mantissa;$I;8| (|x| $) (QCAR (|DFLOAT;manexp| |x| $))) - -(DEFUN |DFLOAT;exponent;$I;9| (|x| $) (QCDR (|DFLOAT;manexp| |x| $))) - -(PUT '|DFLOAT;precision;Pi;10| '|SPADreplace| - '(XLAM NIL (FLOAT-DIGITS 0.0))) - -(DEFUN |DFLOAT;precision;Pi;10| ($) (FLOAT-DIGITS 0.0)) - -(DEFUN |DFLOAT;bits;Pi;11| ($) - (PROG (#0=#:G1419) - (RETURN - (COND - ((EQL (FLOAT-RADIX 0.0) 2) (FLOAT-DIGITS 0.0)) - ((EQL (FLOAT-RADIX 0.0) 16) (* 4 (FLOAT-DIGITS 0.0))) - ('T - (PROG1 (LETT #0# - (FIX (SPADCALL (FLOAT-DIGITS 0.0) - (SPADCALL - (FLOAT (FLOAT-RADIX 0.0) - MOST-POSITIVE-LONG-FLOAT) - (|getShellEntry| $ 30)) - (|getShellEntry| $ 31))) - |DFLOAT;bits;Pi;11|) - (|check-subtype| (> #0# 0) '(|PositiveInteger|) #0#))))))) - -(PUT '|DFLOAT;max;$;12| '|SPADreplace| - '(XLAM NIL MOST-POSITIVE-LONG-FLOAT)) - -(DEFUN |DFLOAT;max;$;12| ($) MOST-POSITIVE-LONG-FLOAT) - -(PUT '|DFLOAT;min;$;13| '|SPADreplace| - '(XLAM NIL MOST-NEGATIVE-LONG-FLOAT)) - -(DEFUN |DFLOAT;min;$;13| ($) MOST-NEGATIVE-LONG-FLOAT) - -(DEFUN |DFLOAT;order;$I;14| (|a| $) - (- (+ (FLOAT-DIGITS 0.0) (SPADCALL |a| (|getShellEntry| $ 28))) 1)) - -(PUT '|DFLOAT;Zero;$;15| '|SPADreplace| - '(XLAM NIL (FLOAT 0 MOST-POSITIVE-LONG-FLOAT))) - -(DEFUN |DFLOAT;Zero;$;15| ($) (FLOAT 0 MOST-POSITIVE-LONG-FLOAT)) - -(PUT '|DFLOAT;One;$;16| '|SPADreplace| - '(XLAM NIL (FLOAT 1 MOST-POSITIVE-LONG-FLOAT))) - -(DEFUN |DFLOAT;One;$;16| ($) (FLOAT 1 MOST-POSITIVE-LONG-FLOAT)) - -(DEFUN |DFLOAT;exp1;$;17| ($) - (/ (FLOAT 534625820200 MOST-POSITIVE-LONG-FLOAT) - (FLOAT 196677847971 MOST-POSITIVE-LONG-FLOAT))) - -(PUT '|DFLOAT;pi;$;18| '|SPADreplace| '(XLAM NIL PI)) - -(DEFUN |DFLOAT;pi;$;18| ($) PI) - -(DEFUN |DFLOAT;coerce;$Of;19| (|x| $) - (SPADCALL (FORMAT NIL (|getShellEntry| $ 6) |x|) - (|getShellEntry| $ 41))) - -(DEFUN |DFLOAT;convert;$If;20| (|x| $) - (SPADCALL |x| (|getShellEntry| $ 44))) - -(PUT '|DFLOAT;<;2$B;21| '|SPADreplace| '<) - -(DEFUN |DFLOAT;<;2$B;21| (|x| |y| $) (< |x| |y|)) - -(PUT '|DFLOAT;-;2$;22| '|SPADreplace| '-) - -(DEFUN |DFLOAT;-;2$;22| (|x| $) (- |x|)) - -(PUT '|DFLOAT;+;3$;23| '|SPADreplace| '+) - -(DEFUN |DFLOAT;+;3$;23| (|x| |y| $) (+ |x| |y|)) - -(PUT '|DFLOAT;-;3$;24| '|SPADreplace| '-) - -(DEFUN |DFLOAT;-;3$;24| (|x| |y| $) (- |x| |y|)) - -(PUT '|DFLOAT;*;3$;25| '|SPADreplace| '*) - -(DEFUN |DFLOAT;*;3$;25| (|x| |y| $) (* |x| |y|)) - -(PUT '|DFLOAT;*;I2$;26| '|SPADreplace| '*) - -(DEFUN |DFLOAT;*;I2$;26| (|i| |x| $) (* |i| |x|)) - -(PUT '|DFLOAT;max;3$;27| '|SPADreplace| 'MAX) - -(DEFUN |DFLOAT;max;3$;27| (|x| |y| $) (MAX |x| |y|)) - -(PUT '|DFLOAT;min;3$;28| '|SPADreplace| 'MIN) - -(DEFUN |DFLOAT;min;3$;28| (|x| |y| $) (MIN |x| |y|)) - -(PUT '|DFLOAT;=;2$B;29| '|SPADreplace| '=) - -(DEFUN |DFLOAT;=;2$B;29| (|x| |y| $) (= |x| |y|)) -(PUT '|DFLOAT;/;$I$;30| '|SPADreplace| '/) - -(DEFUN |DFLOAT;/;$I$;30| (|x| |i| $) (/ |x| |i|)) - -(DEFUN |DFLOAT;sqrt;2$;31| (|x| $) - (|DFLOAT;checkComplex| (SQRT |x|) $)) - -(DEFUN |DFLOAT;log10;2$;32| (|x| $) - (|DFLOAT;checkComplex| (|log| |x|) $)) - -(PUT '|DFLOAT;**;$I$;33| '|SPADreplace| 'EXPT) - -(DEFUN |DFLOAT;**;$I$;33| (|x| |i| $) (EXPT |x| |i|)) - -(DEFUN |DFLOAT;**;3$;34| (|x| |y| $) - (|DFLOAT;checkComplex| (EXPT |x| |y|) $)) - -(PUT '|DFLOAT;coerce;I$;35| '|SPADreplace| - '(XLAM (|i|) (FLOAT |i| MOST-POSITIVE-LONG-FLOAT))) - -(DEFUN |DFLOAT;coerce;I$;35| (|i| $) - (FLOAT |i| MOST-POSITIVE-LONG-FLOAT)) - -(PUT '|DFLOAT;exp;2$;36| '|SPADreplace| 'EXP) - -(DEFUN |DFLOAT;exp;2$;36| (|x| $) (EXP |x|)) - -(DEFUN |DFLOAT;log;2$;37| (|x| $) (|DFLOAT;checkComplex| (LN |x|) $)) - -(DEFUN |DFLOAT;log2;2$;38| (|x| $) - (|DFLOAT;checkComplex| (LOG2 |x|) $)) - -(PUT '|DFLOAT;sin;2$;39| '|SPADreplace| 'SIN) - -(DEFUN |DFLOAT;sin;2$;39| (|x| $) (SIN |x|)) - -(PUT '|DFLOAT;cos;2$;40| '|SPADreplace| 'COS) - -(DEFUN |DFLOAT;cos;2$;40| (|x| $) (COS |x|)) - -(PUT '|DFLOAT;tan;2$;41| '|SPADreplace| 'TAN) - -(DEFUN |DFLOAT;tan;2$;41| (|x| $) (TAN |x|)) - -(PUT '|DFLOAT;cot;2$;42| '|SPADreplace| 'COT) - -(DEFUN |DFLOAT;cot;2$;42| (|x| $) (COT |x|)) - -(PUT '|DFLOAT;sec;2$;43| '|SPADreplace| 'SEC) - -(DEFUN |DFLOAT;sec;2$;43| (|x| $) (SEC |x|)) - -(PUT '|DFLOAT;csc;2$;44| '|SPADreplace| 'CSC) - -(DEFUN |DFLOAT;csc;2$;44| (|x| $) (CSC |x|)) - -(DEFUN |DFLOAT;asin;2$;45| (|x| $) - (|DFLOAT;checkComplex| (ASIN |x|) $)) - -(DEFUN |DFLOAT;acos;2$;46| (|x| $) - (|DFLOAT;checkComplex| (ACOS |x|) $)) - -(PUT '|DFLOAT;atan;2$;47| '|SPADreplace| 'ATAN) - -(DEFUN |DFLOAT;atan;2$;47| (|x| $) (ATAN |x|)) - -(DEFUN |DFLOAT;acsc;2$;48| (|x| $) - (|DFLOAT;checkComplex| (ACSC |x|) $)) - -(PUT '|DFLOAT;acot;2$;49| '|SPADreplace| 'ACOT) - -(DEFUN |DFLOAT;acot;2$;49| (|x| $) (ACOT |x|)) - -(DEFUN |DFLOAT;asec;2$;50| (|x| $) - (|DFLOAT;checkComplex| (ASEC |x|) $)) - -(PUT '|DFLOAT;sinh;2$;51| '|SPADreplace| 'SINH) - -(DEFUN |DFLOAT;sinh;2$;51| (|x| $) (SINH |x|)) - -(PUT '|DFLOAT;cosh;2$;52| '|SPADreplace| 'COSH) - -(DEFUN |DFLOAT;cosh;2$;52| (|x| $) (COSH |x|)) - -(PUT '|DFLOAT;tanh;2$;53| '|SPADreplace| 'TANH) - -(DEFUN |DFLOAT;tanh;2$;53| (|x| $) (TANH |x|)) - -(PUT '|DFLOAT;csch;2$;54| '|SPADreplace| 'CSCH) - -(DEFUN |DFLOAT;csch;2$;54| (|x| $) (CSCH |x|)) - -(PUT '|DFLOAT;coth;2$;55| '|SPADreplace| 'COTH) - -(DEFUN |DFLOAT;coth;2$;55| (|x| $) (COTH |x|)) - -(PUT '|DFLOAT;sech;2$;56| '|SPADreplace| 'SECH) - -(DEFUN |DFLOAT;sech;2$;56| (|x| $) (SECH |x|)) - -(PUT '|DFLOAT;asinh;2$;57| '|SPADreplace| 'ASINH) - -(DEFUN |DFLOAT;asinh;2$;57| (|x| $) (ASINH |x|)) - -(DEFUN |DFLOAT;acosh;2$;58| (|x| $) - (|DFLOAT;checkComplex| (ACOSH |x|) $)) - -(DEFUN |DFLOAT;atanh;2$;59| (|x| $) - (|DFLOAT;checkComplex| (ATANH |x|) $)) - -(PUT '|DFLOAT;acsch;2$;60| '|SPADreplace| 'ACSCH) - -(DEFUN |DFLOAT;acsch;2$;60| (|x| $) (ACSCH |x|)) - -(DEFUN |DFLOAT;acoth;2$;61| (|x| $) - (|DFLOAT;checkComplex| (ACOTH |x|) $)) - -(DEFUN |DFLOAT;asech;2$;62| (|x| $) - (|DFLOAT;checkComplex| (ASECH |x|) $)) - -(PUT '|DFLOAT;/;3$;63| '|SPADreplace| '/) - -(DEFUN |DFLOAT;/;3$;63| (|x| |y| $) (/ |x| |y|)) - -(PUT '|DFLOAT;negative?;$B;64| '|SPADreplace| 'MINUSP) - -(DEFUN |DFLOAT;negative?;$B;64| (|x| $) (MINUSP |x|)) - -(PUT '|DFLOAT;zero?;$B;65| '|SPADreplace| 'ZEROP) - -(DEFUN |DFLOAT;zero?;$B;65| (|x| $) (ZEROP |x|)) - -(PUT '|DFLOAT;hash;$I;66| '|SPADreplace| 'HASHEQ) - -(DEFUN |DFLOAT;hash;$I;66| (|x| $) (HASHEQ |x|)) - -(DEFUN |DFLOAT;recip;$U;67| (|x| $) - (COND ((ZEROP |x|) (CONS 1 "failed")) ('T (CONS 0 (/ 1.0 |x|))))) - -(PUT '|DFLOAT;differentiate;2$;68| '|SPADreplace| '(XLAM (|x|) 0.0)) - -(DEFUN |DFLOAT;differentiate;2$;68| (|x| $) 0.0) - -(DEFUN |DFLOAT;Gamma;2$;69| (|x| $) - (SPADCALL |x| (|getShellEntry| $ 95))) - -(DEFUN |DFLOAT;Beta;3$;70| (|x| |y| $) - (SPADCALL |x| |y| (|getShellEntry| $ 97))) - -(PUT '|DFLOAT;wholePart;$I;71| '|SPADreplace| 'FIX) - -(DEFUN |DFLOAT;wholePart;$I;71| (|x| $) (FIX |x|)) - -(DEFUN |DFLOAT;float;2IPi$;72| (|ma| |ex| |b| $) - (* |ma| (EXPT (FLOAT |b| MOST-POSITIVE-LONG-FLOAT) |ex|))) - -(PUT '|DFLOAT;convert;$Df;73| '|SPADreplace| '(XLAM (|x|) |x|)) - -(DEFUN |DFLOAT;convert;$Df;73| (|x| $) |x|) - -(DEFUN |DFLOAT;convert;$F;74| (|x| $) - (SPADCALL |x| (|getShellEntry| $ 103))) - -(DEFUN |DFLOAT;rationalApproximation;$NniF;75| (|x| |d| $) - (SPADCALL |x| |d| 10 (|getShellEntry| $ 107))) - -(DEFUN |DFLOAT;atan;3$;76| (|x| |y| $) - (PROG (|theta|) - (RETURN - (SEQ (COND - ((= |x| 0.0) - (COND - ((< 0.0 |y|) (/ PI 2)) - ((< |y| 0.0) (- (/ PI 2))) - ('T 0.0))) - ('T - (SEQ (LETT |theta| (ATAN (FLOAT-SIGN 1.0 (/ |y| |x|))) - |DFLOAT;atan;3$;76|) - (COND - ((< |x| 0.0) - (LETT |theta| (- PI |theta|) |DFLOAT;atan;3$;76|))) - (COND - ((< |y| 0.0) - (LETT |theta| (- |theta|) |DFLOAT;atan;3$;76|))) - (EXIT |theta|)))))))) - -(DEFUN |DFLOAT;retract;$F;77| (|x| $) - (PROG (#0=#:G1494) - (RETURN - (SPADCALL |x| - (PROG1 (LETT #0# (- (FLOAT-DIGITS 0.0) 1) - |DFLOAT;retract;$F;77|) - (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)) - (FLOAT-RADIX 0.0) (|getShellEntry| $ 107))))) - -(DEFUN |DFLOAT;retractIfCan;$U;78| (|x| $) - (PROG (#0=#:G1499) - (RETURN - (CONS 0 - (SPADCALL |x| - (PROG1 (LETT #0# (- (FLOAT-DIGITS 0.0) 1) - |DFLOAT;retractIfCan;$U;78|) - (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) - #0#)) - (FLOAT-RADIX 0.0) (|getShellEntry| $ 107)))))) - -(DEFUN |DFLOAT;retract;$I;79| (|x| $) - (PROG (|n|) - (RETURN - (SEQ (LETT |n| (FIX |x|) |DFLOAT;retract;$I;79|) - (EXIT (COND - ((= |x| (FLOAT |n| MOST-POSITIVE-LONG-FLOAT)) |n|) - ('T (|error| "Not an integer")))))))) - -(DEFUN |DFLOAT;retractIfCan;$U;80| (|x| $) - (PROG (|n|) - (RETURN - (SEQ (LETT |n| (FIX |x|) |DFLOAT;retractIfCan;$U;80|) - (EXIT (COND - ((= |x| (FLOAT |n| MOST-POSITIVE-LONG-FLOAT)) - (CONS 0 |n|)) - ('T (CONS 1 "failed")))))))) - -(DEFUN |DFLOAT;sign;$I;81| (|x| $) - (SPADCALL (FLOAT-SIGN |x| 1.0) (|getShellEntry| $ 113))) - -(PUT '|DFLOAT;abs;2$;82| '|SPADreplace| - '(XLAM (|x|) (FLOAT-SIGN 1.0 |x|))) - -(DEFUN |DFLOAT;abs;2$;82| (|x| $) (FLOAT-SIGN 1.0 |x|)) - -(DEFUN |DFLOAT;manexp| (|x| $) - (PROG (|s| #0=#:G1520 |me| |two53|) - (RETURN - (SEQ (EXIT (COND - ((ZEROP |x|) (CONS 0 0)) - ('T - (SEQ (LETT |s| - (SPADCALL |x| (|getShellEntry| $ 116)) - |DFLOAT;manexp|) - (LETT |x| (FLOAT-SIGN 1.0 |x|) - |DFLOAT;manexp|) - (COND - ((< MOST-POSITIVE-LONG-FLOAT |x|) - (PROGN - (LETT #0# - (CONS - (+ - (* |s| - (SPADCALL - MOST-POSITIVE-LONG-FLOAT - (|getShellEntry| $ 27))) - 1) - (SPADCALL MOST-POSITIVE-LONG-FLOAT - (|getShellEntry| $ 28))) - |DFLOAT;manexp|) - (GO #0#)))) - (LETT |me| (MANEXP |x|) |DFLOAT;manexp|) - (LETT |two53| - (EXPT (FLOAT-RADIX 0.0) - (FLOAT-DIGITS 0.0)) - |DFLOAT;manexp|) - (EXIT (CONS (* |s| - (FIX (* |two53| (QCAR |me|)))) - (- (QCDR |me|) (FLOAT-DIGITS 0.0)))))))) - #0# (EXIT #0#))))) - -(DEFUN |DFLOAT;rationalApproximation;$2NniF;84| (|f| |d| |b| $) - (PROG (|#G103| |nu| |ex| BASE #0=#:G1523 |de| |tol| |#G104| |q| |r| - |p2| |q2| #1=#:G1541 |#G105| |#G106| |p0| |p1| |#G107| - |#G108| |q0| |q1| |#G109| |#G110| |s| |t| #2=#:G1539) - (RETURN - (SEQ (EXIT (SEQ (PROGN - (LETT |#G103| (|DFLOAT;manexp| |f| $) - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |nu| (QCAR |#G103|) - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |ex| (QCDR |#G103|) - |DFLOAT;rationalApproximation;$2NniF;84|) - |#G103|) - (LETT BASE (FLOAT-RADIX 0.0) - |DFLOAT;rationalApproximation;$2NniF;84|) - (EXIT (COND - ((< |ex| 0) - (SEQ (LETT |de| - (EXPT BASE - (PROG1 - (LETT #0# (- |ex|) - |DFLOAT;rationalApproximation;$2NniF;84|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#))) - |DFLOAT;rationalApproximation;$2NniF;84|) - (EXIT - (COND - ((< |b| 2) - (|error| "base must be > 1")) - ('T - (SEQ - (LETT |tol| (EXPT |b| |d|) - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |s| |nu| - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |t| |de| - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |p0| 0 - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |p1| 1 - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |q0| 1 - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |q1| 0 - |DFLOAT;rationalApproximation;$2NniF;84|) - (EXIT - (SEQ G190 NIL - (SEQ - (PROGN - (LETT |#G104| - (DIVIDE2 |s| |t|) - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |q| (QCAR |#G104|) - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |r| (QCDR |#G104|) - |DFLOAT;rationalApproximation;$2NniF;84|) - |#G104|) - (LETT |p2| - (+ (* |q| |p1|) |p0|) - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |q2| - (+ (* |q| |q1|) |q0|) - |DFLOAT;rationalApproximation;$2NniF;84|) - (COND - ((OR (EQL |r| 0) - (< - (SPADCALL |tol| - (ABS - (- (* |nu| |q2|) - (* |de| |p2|))) - (|getShellEntry| $ - 120)) - (* |de| (ABS |p2|)))) - (EXIT - (PROGN - (LETT #1# - (SPADCALL |p2| |q2| - (|getShellEntry| $ - 119)) - |DFLOAT;rationalApproximation;$2NniF;84|) - (GO #1#))))) - (PROGN - (LETT |#G105| |p1| - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |#G106| |p2| - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |p0| |#G105| - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |p1| |#G106| - |DFLOAT;rationalApproximation;$2NniF;84|)) - (PROGN - (LETT |#G107| |q1| - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |#G108| |q2| - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |q0| |#G107| - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |q1| |#G108| - |DFLOAT;rationalApproximation;$2NniF;84|)) - (EXIT - (PROGN - (LETT |#G109| |t| - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |#G110| |r| - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |s| |#G109| - |DFLOAT;rationalApproximation;$2NniF;84|) - (LETT |t| |#G110| - |DFLOAT;rationalApproximation;$2NniF;84|)))) - NIL (GO G190) G191 - (EXIT NIL))))))))) - ('T - (SPADCALL - (* |nu| - (EXPT BASE - (PROG1 - (LETT #2# |ex| - |DFLOAT;rationalApproximation;$2NniF;84|) - (|check-subtype| (>= #2# 0) - '(|NonNegativeInteger|) #2#)))) - (|getShellEntry| $ 121))))))) - #1# (EXIT #1#))))) - -(DEFUN |DFLOAT;**;$F$;85| (|x| |r| $) - (PROG (|n| |d| #0=#:G1550) - (RETURN - (SEQ (EXIT (COND - ((ZEROP |x|) - (COND - ((SPADCALL |r| (|getShellEntry| $ 122)) - (|error| "0**0 is undefined")) - ((SPADCALL |r| (|getShellEntry| $ 123)) - (|error| "division by 0")) - ('T 0.0))) - ((OR (SPADCALL |r| (|getShellEntry| $ 122)) - (= |x| 1.0)) - 1.0) - ('T - (COND - ((SPADCALL |r| (|spadConstant| $ 124) - (|getShellEntry| $ 125)) - |x|) - ('T - (SEQ (LETT |n| - (SPADCALL |r| - (|getShellEntry| $ 126)) - |DFLOAT;**;$F$;85|) - (LETT |d| - (SPADCALL |r| - (|getShellEntry| $ 127)) - |DFLOAT;**;$F$;85|) - (EXIT (COND - ((MINUSP |x|) - (COND - ((ODDP |d|) - (COND - ((ODDP |n|) - (PROGN - (LETT #0# - (- - (SPADCALL (- |x|) |r| - (|getShellEntry| $ 128))) - |DFLOAT;**;$F$;85|) - (GO #0#))) - ('T - (PROGN - (LETT #0# - (SPADCALL (- |x|) |r| - (|getShellEntry| $ 128)) - |DFLOAT;**;$F$;85|) - (GO #0#))))) - ('T (|error| "negative root")))) - ((EQL |d| 2) - (EXPT - (SPADCALL |x| - (|getShellEntry| $ 56)) - |n|)) - ('T - (SPADCALL |x| - (/ - (FLOAT |n| - MOST-POSITIVE-LONG-FLOAT) - (FLOAT |d| - MOST-POSITIVE-LONG-FLOAT)) - (|getShellEntry| $ 59))))))))))) - #0# (EXIT #0#))))) - -(DEFUN |DoubleFloat| () - (PROG () - (RETURN - (PROG (#0=#:G1563) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|DoubleFloat|) - |DoubleFloat|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|DoubleFloat| - (LIST - (CONS NIL - (CONS 1 (|DoubleFloat;|)))))) - (LETT #0# T |DoubleFloat|)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|DoubleFloat|))))))))))) - -(DEFUN |DoubleFloat;| () - (PROG (|dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$| '(|DoubleFloat|) . #0=(|DoubleFloat|)) - (LETT $ (|newShell| 142) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|haddProp| |$ConstructorCache| '|DoubleFloat| NIL (CONS 1 $)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 "~G") - $)))) - -(MAKEPROP '|DoubleFloat| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL '|format| (|String|) - |DFLOAT;doubleFloatFormat;2S;1| (|OpenMathEncoding|) - (0 . |OMencodingXML|) (|OpenMathDevice|) - (4 . |OMopenString|) (|Void|) (10 . |OMputObject|) - (|DoubleFloat|) (15 . |OMputFloat|) - (21 . |OMputEndObject|) (26 . |OMclose|) - |DFLOAT;OMwrite;$S;2| (|Boolean|) |DFLOAT;OMwrite;$BS;3| - |DFLOAT;OMwrite;Omd$V;4| |DFLOAT;OMwrite;Omd$BV;5| - (|PositiveInteger|) |DFLOAT;base;Pi;7| (|Integer|) - |DFLOAT;mantissa;$I;8| |DFLOAT;exponent;$I;9| - |DFLOAT;precision;Pi;10| |DFLOAT;log2;2$;38| (31 . *) - |DFLOAT;bits;Pi;11| |DFLOAT;max;$;12| |DFLOAT;min;$;13| - |DFLOAT;order;$I;14| - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |DFLOAT;Zero;$;15|) $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |DFLOAT;One;$;16|) $)) - |DFLOAT;exp1;$;17| |DFLOAT;pi;$;18| (|OutputForm|) - (37 . |outputForm|) |DFLOAT;coerce;$Of;19| (|InputForm|) - (42 . |convert|) |DFLOAT;convert;$If;20| |DFLOAT;<;2$B;21| - |DFLOAT;-;2$;22| |DFLOAT;+;3$;23| |DFLOAT;-;3$;24| - |DFLOAT;*;3$;25| |DFLOAT;*;I2$;26| |DFLOAT;max;3$;27| - |DFLOAT;min;3$;28| |DFLOAT;=;2$B;29| |DFLOAT;/;$I$;30| - |DFLOAT;sqrt;2$;31| |DFLOAT;log10;2$;32| - |DFLOAT;**;$I$;33| |DFLOAT;**;3$;34| |DFLOAT;coerce;I$;35| - |DFLOAT;exp;2$;36| |DFLOAT;log;2$;37| |DFLOAT;sin;2$;39| - |DFLOAT;cos;2$;40| |DFLOAT;tan;2$;41| |DFLOAT;cot;2$;42| - |DFLOAT;sec;2$;43| |DFLOAT;csc;2$;44| |DFLOAT;asin;2$;45| - |DFLOAT;acos;2$;46| |DFLOAT;atan;2$;47| - |DFLOAT;acsc;2$;48| |DFLOAT;acot;2$;49| - |DFLOAT;asec;2$;50| |DFLOAT;sinh;2$;51| - |DFLOAT;cosh;2$;52| |DFLOAT;tanh;2$;53| - |DFLOAT;csch;2$;54| |DFLOAT;coth;2$;55| - |DFLOAT;sech;2$;56| |DFLOAT;asinh;2$;57| - |DFLOAT;acosh;2$;58| |DFLOAT;atanh;2$;59| - |DFLOAT;acsch;2$;60| |DFLOAT;acoth;2$;61| - |DFLOAT;asech;2$;62| |DFLOAT;/;3$;63| - |DFLOAT;negative?;$B;64| |DFLOAT;zero?;$B;65| - |DFLOAT;hash;$I;66| (|Union| $ '"failed") - |DFLOAT;recip;$U;67| |DFLOAT;differentiate;2$;68| - (|DoubleFloatSpecialFunctions|) (47 . |Gamma|) - |DFLOAT;Gamma;2$;69| (52 . |Beta|) |DFLOAT;Beta;3$;70| - |DFLOAT;wholePart;$I;71| |DFLOAT;float;2IPi$;72| - |DFLOAT;convert;$Df;73| (|Float|) (58 . |convert|) - |DFLOAT;convert;$F;74| (|Fraction| 26) - (|NonNegativeInteger|) - |DFLOAT;rationalApproximation;$2NniF;84| - |DFLOAT;rationalApproximation;$NniF;75| - |DFLOAT;atan;3$;76| |DFLOAT;retract;$F;77| - (|Union| 105 '"failed") |DFLOAT;retractIfCan;$U;78| - |DFLOAT;retract;$I;79| (|Union| 26 '"failed") - |DFLOAT;retractIfCan;$U;80| |DFLOAT;sign;$I;81| - |DFLOAT;abs;2$;82| (63 . |Zero|) (67 . /) (73 . *) - (79 . |coerce|) (84 . |zero?|) (89 . |negative?|) - (94 . |One|) (98 . =) (104 . |numer|) (109 . |denom|) - |DFLOAT;**;$F$;85| (|PatternMatchResult| 102 $) - (|Pattern| 102) (|Factored| $) (|List| $) - (|Union| 132 '"failed") - (|Record| (|:| |coef1| $) (|:| |coef2| $) - (|:| |generator| $)) - (|Record| (|:| |coef1| $) (|:| |coef2| $)) - (|Union| 135 '"failed") - (|Record| (|:| |quotient| $) (|:| |remainder| $)) - (|Record| (|:| |coef| 132) (|:| |generator| $)) - (|SparseUnivariatePolynomial| $) - (|Record| (|:| |unit| $) (|:| |canonical| $) - (|:| |associate| $)) - (|SingleInteger|)) - '#(~= 114 |zero?| 120 |wholePart| 125 |unitNormal| 130 - |unitCanonical| 135 |unit?| 140 |truncate| 145 |tanh| 150 - |tan| 155 |subtractIfCan| 160 |squareFreePart| 166 - |squareFree| 171 |sqrt| 176 |sizeLess?| 181 |sinh| 187 - |sin| 192 |sign| 197 |sech| 202 |sec| 207 |sample| 212 - |round| 216 |retractIfCan| 221 |retract| 231 |rem| 241 - |recip| 247 |rationalApproximation| 252 |quo| 265 - |principalIdeal| 271 |prime?| 276 |precision| 281 - |positive?| 285 |pi| 290 |patternMatch| 294 |order| 301 - |one?| 306 |nthRoot| 311 |norm| 317 |negative?| 322 - |multiEuclidean| 327 |min| 333 |max| 343 |mantissa| 353 - |log2| 358 |log10| 363 |log| 368 |lcm| 373 |latex| 384 - |inv| 389 |hash| 394 |gcdPolynomial| 404 |gcd| 410 - |fractionPart| 421 |floor| 426 |float| 431 |factor| 444 - |extendedEuclidean| 449 |exquo| 462 |expressIdealMember| - 468 |exponent| 474 |exp1| 479 |exp| 483 |euclideanSize| - 488 |doubleFloatFormat| 493 |divide| 498 |digits| 504 - |differentiate| 508 |csch| 519 |csc| 524 |coth| 529 |cot| - 534 |cosh| 539 |cos| 544 |convert| 549 |coerce| 569 - |characteristic| 599 |ceiling| 603 |bits| 608 |base| 612 - |atanh| 616 |atan| 621 |associates?| 632 |asinh| 638 - |asin| 643 |asech| 648 |asec| 653 |acsch| 658 |acsc| 663 - |acoth| 668 |acot| 673 |acosh| 678 |acos| 683 |abs| 688 ^ - 693 |Zero| 711 |One| 715 |OMwrite| 719 |Gamma| 743 D 748 - |Beta| 759 >= 765 > 771 = 777 <= 783 < 789 / 795 - 807 + - 818 ** 824 * 854) - '((|approximate| . 0) (|canonicalsClosed| . 0) - (|canonicalUnitNormal| . 0) (|noZeroDivisors| . 0) - ((|commutative| "*") . 0) (|rightUnitary| . 0) - (|leftUnitary| . 0) (|unitsKnown| . 0)) - (CONS (|makeByteWordVec2| 1 - '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0)) - (CONS '#(|FloatingPointSystem&| |RealNumberSystem&| - |Field&| |EuclideanDomain&| NIL - |UniqueFactorizationDomain&| |GcdDomain&| - |DivisionRing&| |IntegralDomain&| |Algebra&| - |Algebra&| |DifferentialRing&| NIL - |OrderedRing&| |Module&| NIL NIL |Module&| NIL - NIL NIL |Ring&| NIL NIL NIL NIL NIL NIL NIL - |AbelianGroup&| NIL NIL |AbelianMonoid&| - |Monoid&| NIL |OrderedSet&| - |AbelianSemiGroup&| |SemiGroup&| - |TranscendentalFunctionCategory&| NIL - |SetCategory&| NIL - |ElementaryFunctionCategory&| NIL - |HyperbolicFunctionCategory&| - |ArcTrigonometricFunctionCategory&| - |TrigonometricFunctionCategory&| NIL NIL - |RadicalCategory&| |RetractableTo&| - |RetractableTo&| NIL NIL |BasicType&| NIL) - (CONS '#((|FloatingPointSystem|) - (|RealNumberSystem|) (|Field|) - (|EuclideanDomain|) - (|PrincipalIdealDomain|) - (|UniqueFactorizationDomain|) - (|GcdDomain|) (|DivisionRing|) - (|IntegralDomain|) (|Algebra| 105) - (|Algebra| $$) (|DifferentialRing|) - (|CharacteristicZero|) (|OrderedRing|) - (|Module| 105) (|EntireRing|) - (|CommutativeRing|) (|Module| $$) - (|OrderedAbelianGroup|) - (|BiModule| 105 105) (|BiModule| $$ $$) - (|Ring|) - (|OrderedCancellationAbelianMonoid|) - (|RightModule| 105) (|LeftModule| 105) - (|LeftModule| $$) (|Rng|) - (|RightModule| $$) - (|OrderedAbelianMonoid|) - (|AbelianGroup|) - (|OrderedAbelianSemiGroup|) - (|CancellationAbelianMonoid|) - (|AbelianMonoid|) (|Monoid|) - (|PatternMatchable| 102) (|OrderedSet|) - (|AbelianSemiGroup|) (|SemiGroup|) - (|TranscendentalFunctionCategory|) - (|RealConstant|) (|SetCategory|) - (|ConvertibleTo| 43) - (|ElementaryFunctionCategory|) - (|ArcHyperbolicFunctionCategory|) - (|HyperbolicFunctionCategory|) - (|ArcTrigonometricFunctionCategory|) - (|TrigonometricFunctionCategory|) - (|OpenMath|) (|ConvertibleTo| 130) - (|RadicalCategory|) - (|RetractableTo| 105) - (|RetractableTo| 26) - (|ConvertibleTo| 102) - (|ConvertibleTo| 15) (|BasicType|) - (|CoercibleTo| 40)) - (|makeByteWordVec2| 141 - '(0 9 0 10 2 11 0 7 9 12 1 11 13 0 14 2 - 11 13 0 15 16 1 11 13 0 17 1 11 13 0 - 18 2 0 0 24 0 31 1 40 0 15 41 1 43 0 - 15 44 1 94 15 15 95 2 94 15 15 15 97 - 1 102 0 15 103 0 105 0 118 2 105 0 26 - 26 119 2 26 0 106 0 120 1 105 0 26 - 121 1 105 20 0 122 1 105 20 0 123 0 - 105 0 124 2 105 20 0 0 125 1 105 26 0 - 126 1 105 26 0 127 2 0 20 0 0 1 1 0 - 20 0 89 1 0 26 0 99 1 0 140 0 1 1 0 0 - 0 1 1 0 20 0 1 1 0 0 0 1 1 0 0 0 77 1 - 0 0 0 65 2 0 91 0 0 1 1 0 0 0 1 1 0 - 131 0 1 1 0 0 0 56 2 0 20 0 0 1 1 0 0 - 0 75 1 0 0 0 63 1 0 26 0 116 1 0 0 0 - 80 1 0 0 0 67 0 0 0 1 1 0 0 0 1 1 0 - 111 0 112 1 0 114 0 115 1 0 105 0 110 - 1 0 26 0 113 2 0 0 0 0 1 1 0 91 0 92 - 2 0 105 0 106 108 3 0 105 0 106 106 - 107 2 0 0 0 0 1 1 0 138 132 1 1 0 20 - 0 1 0 0 24 29 1 0 20 0 1 0 0 0 39 3 0 - 129 0 130 129 1 1 0 26 0 35 1 0 20 0 - 1 2 0 0 0 26 1 1 0 0 0 1 1 0 20 0 88 - 2 0 133 132 0 1 0 0 0 34 2 0 0 0 0 53 - 0 0 0 33 2 0 0 0 0 52 1 0 26 0 27 1 0 - 0 0 30 1 0 0 0 57 1 0 0 0 62 1 0 0 - 132 1 2 0 0 0 0 1 1 0 7 0 1 1 0 0 0 1 - 1 0 26 0 90 1 0 141 0 1 2 0 139 139 - 139 1 1 0 0 132 1 2 0 0 0 0 1 1 0 0 0 - 1 1 0 0 0 1 3 0 0 26 26 24 100 2 0 0 - 26 26 1 1 0 131 0 1 2 0 134 0 0 1 3 0 - 136 0 0 0 1 2 0 91 0 0 1 2 0 133 132 - 0 1 1 0 26 0 28 0 0 0 38 1 0 0 0 61 1 - 0 106 0 1 1 0 7 7 8 2 0 137 0 0 1 0 0 - 24 1 1 0 0 0 93 2 0 0 0 106 1 1 0 0 0 - 78 1 0 0 0 68 1 0 0 0 79 1 0 0 0 66 1 - 0 0 0 76 1 0 0 0 64 1 0 43 0 45 1 0 - 130 0 1 1 0 102 0 104 1 0 15 0 101 1 - 0 0 105 1 1 0 0 26 60 1 0 0 105 1 1 0 - 0 26 60 1 0 0 0 1 1 0 40 0 42 0 0 106 - 1 1 0 0 0 1 0 0 24 32 0 0 24 25 1 0 0 - 0 83 2 0 0 0 0 109 1 0 0 0 71 2 0 20 - 0 0 1 1 0 0 0 81 1 0 0 0 69 1 0 0 0 - 86 1 0 0 0 74 1 0 0 0 84 1 0 0 0 72 1 - 0 0 0 85 1 0 0 0 73 1 0 0 0 82 1 0 0 - 0 70 1 0 0 0 117 2 0 0 0 26 1 2 0 0 0 - 106 1 2 0 0 0 24 1 0 0 0 36 0 0 0 37 - 3 0 13 11 0 20 23 2 0 7 0 20 21 2 0 - 13 11 0 22 1 0 7 0 19 1 0 0 0 96 1 0 - 0 0 1 2 0 0 0 106 1 2 0 0 0 0 98 2 0 - 20 0 0 1 2 0 20 0 0 1 2 0 20 0 0 54 2 - 0 20 0 0 1 2 0 20 0 0 46 2 0 0 0 26 - 55 2 0 0 0 0 87 2 0 0 0 0 49 1 0 0 0 - 47 2 0 0 0 0 48 2 0 0 0 0 59 2 0 0 0 - 105 128 2 0 0 0 26 58 2 0 0 0 106 1 2 - 0 0 0 24 1 2 0 0 0 105 1 2 0 0 105 0 - 1 2 0 0 0 0 50 2 0 0 26 0 51 2 0 0 - 106 0 1 2 0 0 24 0 31))))) - '|lookupComplete|)) - -(MAKEPROP '|DoubleFloat| 'NILADIC T) -@ \section{License} <<license>>= --Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. diff --git a/src/algebra/si.spad.pamphlet b/src/algebra/si.spad.pamphlet index e078bbb9..65253830 100644 --- a/src/algebra/si.spad.pamphlet +++ b/src/algebra/si.spad.pamphlet @@ -162,395 +162,7 @@ IntegerNumberSystem(): Category == z := mulmod(z, z, p) @ -\section{INS.lsp BOOTSTRAP} -{\bf INS} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf INS} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf INS.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. -<<INS.lsp BOOTSTRAP>>= -(/VERSIONCHECK 2) - -(DEFPARAMETER |IntegerNumberSystem;AL| 'NIL) - -(DEFUN |IntegerNumberSystem| () - (LET (#:G1403) - (COND - (|IntegerNumberSystem;AL|) - (T (SETQ |IntegerNumberSystem;AL| (|IntegerNumberSystem;|)))))) - -(DEFUN |IntegerNumberSystem;| () - (PROG (#0=#:G1401) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(#1=#:G1395 #2=#:G1396 #3=#:G1397 - #4=#:G1398 #5=#:G1399 #6=#:G1400) - (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) - ((|hash| ($ $)) 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|) - (SETELT #0# 0 '(|IntegerNumberSystem|)))))) - -(MAKEPROP '|IntegerNumberSystem| 'NILADIC T) -@ -\section{INS-.lsp BOOTSTRAP} -{\bf INS-} depends on {\bf INS}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf INS-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf INS-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. -<<INS-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(PUT '|INS-;characteristic;Nni;1| '|SPADreplace| '(XLAM NIL 0)) - -(DEFUN |INS-;characteristic;Nni;1| ($) 0) - -(DEFUN |INS-;differentiate;2S;2| (|x| $) (|spadConstant| $ 9)) - -(DEFUN |INS-;even?;SB;3| (|x| $) - (SPADCALL (SPADCALL |x| (QREFELT $ 12)) (QREFELT $ 13))) - -(DEFUN |INS-;positive?;SB;4| (|x| $) - (SPADCALL (|spadConstant| $ 9) |x| (QREFELT $ 15))) - -(PUT '|INS-;copy;2S;5| '|SPADreplace| '(XLAM (|x|) |x|)) - -(DEFUN |INS-;copy;2S;5| (|x| $) |x|) - -(DEFUN |INS-;bit?;2SB;6| (|x| |i| $) - (SPADCALL (SPADCALL |x| (SPADCALL |i| (QREFELT $ 18)) (QREFELT $ 19)) - (QREFELT $ 12))) - -(DEFUN |INS-;mask;2S;7| (|n| $) - (SPADCALL (SPADCALL (|spadConstant| $ 21) |n| (QREFELT $ 19)) - (QREFELT $ 22))) - -(PUT '|INS-;rational?;SB;8| '|SPADreplace| '(XLAM (|x|) 'T)) - -(DEFUN |INS-;rational?;SB;8| (|x| $) 'T) - -(DEFUN |INS-;euclideanSize;SNni;9| (|x| $) - (PROG (#0=#:G1412 #1=#:G1413) - (RETURN - (COND - ((SPADCALL |x| (|spadConstant| $ 9) (QREFELT $ 25)) - (|error| "euclideanSize called on zero")) - ((SPADCALL |x| (|spadConstant| $ 9) (QREFELT $ 15)) - (PROG1 (LETT #0# (- (SPADCALL |x| (QREFELT $ 27))) - |INS-;euclideanSize;SNni;9|) - (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))) - ('T - (PROG1 (LETT #1# (SPADCALL |x| (QREFELT $ 27)) - |INS-;euclideanSize;SNni;9|) - (|check-subtype| (>= #1# 0) '(|NonNegativeInteger|) #1#))))))) - -(DEFUN |INS-;convert;SF;10| (|x| $) - (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 30))) - -(DEFUN |INS-;convert;SDf;11| (|x| $) - (FLOAT (SPADCALL |x| (QREFELT $ 27)) MOST-POSITIVE-LONG-FLOAT)) - -(DEFUN |INS-;convert;SIf;12| (|x| $) - (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 35))) - -(DEFUN |INS-;retract;SI;13| (|x| $) (SPADCALL |x| (QREFELT $ 27))) - -(DEFUN |INS-;convert;SP;14| (|x| $) - (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 39))) - -(DEFUN |INS-;factor;SF;15| (|x| $) (SPADCALL |x| (QREFELT $ 43))) - -(DEFUN |INS-;squareFree;SF;16| (|x| $) (SPADCALL |x| (QREFELT $ 46))) - -(DEFUN |INS-;prime?;SB;17| (|x| $) (SPADCALL |x| (QREFELT $ 49))) - -(DEFUN |INS-;factorial;2S;18| (|x| $) (SPADCALL |x| (QREFELT $ 52))) - -(DEFUN |INS-;binomial;3S;19| (|n| |m| $) - (SPADCALL |n| |m| (QREFELT $ 54))) - -(DEFUN |INS-;permutation;3S;20| (|n| |m| $) - (SPADCALL |n| |m| (QREFELT $ 56))) - -(DEFUN |INS-;retractIfCan;SU;21| (|x| $) - (CONS 0 (SPADCALL |x| (QREFELT $ 27)))) - -(DEFUN |INS-;init;S;22| ($) (|spadConstant| $ 9)) - -(DEFUN |INS-;nextItem;SU;23| (|n| $) - (COND - ((SPADCALL |n| (QREFELT $ 61)) (CONS 0 (|spadConstant| $ 21))) - ((SPADCALL (|spadConstant| $ 9) |n| (QREFELT $ 15)) - (CONS 0 (SPADCALL |n| (QREFELT $ 18)))) - ('T (CONS 0 (SPADCALL (|spadConstant| $ 21) |n| (QREFELT $ 62)))))) - -(DEFUN |INS-;patternMatch;SP2Pmr;24| (|x| |p| |l| $) - (SPADCALL |x| |p| |l| (QREFELT $ 67))) - -(DEFUN |INS-;rational;SF;25| (|x| $) - (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 71))) - -(DEFUN |INS-;rationalIfCan;SU;26| (|x| $) - (CONS 0 (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 71)))) - -(DEFUN |INS-;symmetricRemainder;3S;27| (|x| |n| $) - (PROG (|r|) - (RETURN - (SEQ (LETT |r| (SPADCALL |x| |n| (QREFELT $ 75)) - |INS-;symmetricRemainder;3S;27|) - (EXIT (COND - ((SPADCALL |r| (|spadConstant| $ 9) (QREFELT $ 25)) - |r|) - ('T - (SEQ (COND - ((SPADCALL |n| (|spadConstant| $ 9) - (QREFELT $ 15)) - (LETT |n| (SPADCALL |n| (QREFELT $ 18)) - |INS-;symmetricRemainder;3S;27|))) - (EXIT (COND - ((SPADCALL (|spadConstant| $ 9) |r| - (QREFELT $ 15)) - (COND - ((SPADCALL |n| - (SPADCALL 2 |r| (QREFELT $ 77)) - (QREFELT $ 15)) - (SPADCALL |r| |n| (QREFELT $ 62))) - ('T |r|))) - ((NULL (SPADCALL (|spadConstant| $ 9) - (SPADCALL - (SPADCALL 2 |r| - (QREFELT $ 77)) - |n| (QREFELT $ 78)) - (QREFELT $ 15))) - (SPADCALL |r| |n| (QREFELT $ 78))) - ('T |r|))))))))))) - -(DEFUN |INS-;invmod;3S;28| (|a| |b| $) - (PROG (|q| |r| |r1| |c| |c1| |d| |d1|) - (RETURN - (SEQ (COND - ((SPADCALL |a| (QREFELT $ 80)) - (LETT |a| (SPADCALL |a| |b| (QREFELT $ 81)) - |INS-;invmod;3S;28|))) - (LETT |c| |a| |INS-;invmod;3S;28|) - (LETT |c1| (|spadConstant| $ 21) |INS-;invmod;3S;28|) - (LETT |d| |b| |INS-;invmod;3S;28|) - (LETT |d1| (|spadConstant| $ 9) |INS-;invmod;3S;28|) - (SEQ G190 - (COND - ((NULL (SPADCALL (SPADCALL |d| (QREFELT $ 61)) - (QREFELT $ 13))) - (GO G191))) - (SEQ (LETT |q| (SPADCALL |c| |d| (QREFELT $ 82)) - |INS-;invmod;3S;28|) - (LETT |r| - (SPADCALL |c| - (SPADCALL |q| |d| (QREFELT $ 83)) - (QREFELT $ 62)) - |INS-;invmod;3S;28|) - (LETT |r1| - (SPADCALL |c1| - (SPADCALL |q| |d1| (QREFELT $ 83)) - (QREFELT $ 62)) - |INS-;invmod;3S;28|) - (LETT |c| |d| |INS-;invmod;3S;28|) - (LETT |c1| |d1| |INS-;invmod;3S;28|) - (LETT |d| |r| |INS-;invmod;3S;28|) - (EXIT (LETT |d1| |r1| |INS-;invmod;3S;28|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |c| (|spadConstant| $ 21) (QREFELT $ 25)) - (COND - ((SPADCALL |c1| (QREFELT $ 80)) - (SPADCALL |c1| |b| (QREFELT $ 78))) - ('T |c1|))) - ('T (|error| "inverse does not exist")))))))) - -(DEFUN |INS-;powmod;4S;29| (|x| |n| |p| $) - (PROG (|y| #0=#:G1470 |z|) - (RETURN - (SEQ (EXIT (SEQ (COND - ((SPADCALL |x| (QREFELT $ 80)) - (LETT |x| (SPADCALL |x| |p| (QREFELT $ 81)) - |INS-;powmod;4S;29|))) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 61)) - (|spadConstant| $ 9)) - ((SPADCALL |n| (QREFELT $ 61)) - (|spadConstant| $ 21)) - ('T - (SEQ (LETT |y| (|spadConstant| $ 21) - |INS-;powmod;4S;29|) - (LETT |z| |x| |INS-;powmod;4S;29|) - (EXIT - (SEQ G190 NIL - (SEQ - (COND - ((SPADCALL |n| (QREFELT $ 12)) - (LETT |y| - (SPADCALL |y| |z| |p| - (QREFELT $ 85)) - |INS-;powmod;4S;29|))) - (EXIT - (COND - ((SPADCALL - (LETT |n| - (SPADCALL |n| - (SPADCALL - (|spadConstant| $ 21) - (QREFELT $ 18)) - (QREFELT $ 19)) - |INS-;powmod;4S;29|) - (QREFELT $ 61)) - (PROGN - (LETT #0# |y| - |INS-;powmod;4S;29|) - (GO #0#))) - ('T - (LETT |z| - (SPADCALL |z| |z| |p| - (QREFELT $ 85)) - |INS-;powmod;4S;29|))))) - NIL (GO G190) G191 (EXIT NIL))))))))) - #0# (EXIT #0#))))) - -(DEFUN |IntegerNumberSystem&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|IntegerNumberSystem&|)) - (LETT |dv$| (LIST '|IntegerNumberSystem&| |dv$1|) . #0#) - (LETT $ (GETREFV 87) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) - -(MAKEPROP '|IntegerNumberSystem&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) - (|NonNegativeInteger|) |INS-;characteristic;Nni;1| - (0 . |Zero|) |INS-;differentiate;2S;2| (|Boolean|) - (4 . |odd?|) (9 . |not|) |INS-;even?;SB;3| (14 . <) - |INS-;positive?;SB;4| |INS-;copy;2S;5| (20 . -) - (25 . |shift|) |INS-;bit?;2SB;6| (31 . |One|) (35 . |dec|) - |INS-;mask;2S;7| |INS-;rational?;SB;8| (40 . =) - (|Integer|) (46 . |convert|) |INS-;euclideanSize;SNni;9| - (|Float|) (51 . |coerce|) |INS-;convert;SF;10| - (|DoubleFloat|) |INS-;convert;SDf;11| (|InputForm|) - (56 . |convert|) |INS-;convert;SIf;12| - |INS-;retract;SI;13| (|Pattern| 26) (61 . |coerce|) - |INS-;convert;SP;14| (|Factored| 6) - (|IntegerFactorizationPackage| 6) (66 . |factor|) - (|Factored| $) |INS-;factor;SF;15| (71 . |squareFree|) - |INS-;squareFree;SF;16| (|IntegerPrimesPackage| 6) - (76 . |prime?|) |INS-;prime?;SB;17| - (|IntegerCombinatoricFunctions| 6) (81 . |factorial|) - |INS-;factorial;2S;18| (86 . |binomial|) - |INS-;binomial;3S;19| (92 . |permutation|) - |INS-;permutation;3S;20| (|Union| 26 '"failed") - |INS-;retractIfCan;SU;21| |INS-;init;S;22| (98 . |zero?|) - (103 . -) (|Union| $ '"failed") |INS-;nextItem;SU;23| - (|PatternMatchResult| 26 6) - (|PatternMatchIntegerNumberSystem| 6) - (109 . |patternMatch|) (|PatternMatchResult| 26 $) - |INS-;patternMatch;SP2Pmr;24| (|Fraction| 26) - (116 . |coerce|) |INS-;rational;SF;25| - (|Union| 70 '"failed") |INS-;rationalIfCan;SU;26| - (121 . |rem|) (|PositiveInteger|) (127 . *) (133 . +) - |INS-;symmetricRemainder;3S;27| (139 . |negative?|) - (144 . |positiveRemainder|) (150 . |quo|) (156 . *) - |INS-;invmod;3S;28| (162 . |mulmod|) |INS-;powmod;4S;29|) - '#(|symmetricRemainder| 169 |squareFree| 175 |retractIfCan| - 180 |retract| 185 |rationalIfCan| 190 |rational?| 195 - |rational| 200 |prime?| 205 |powmod| 210 |positive?| 217 - |permutation| 222 |patternMatch| 228 |nextItem| 235 |mask| - 240 |invmod| 245 |init| 251 |factorial| 255 |factor| 260 - |even?| 265 |euclideanSize| 270 |differentiate| 275 |copy| - 280 |convert| 285 |characteristic| 305 |bit?| 309 - |binomial| 315) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 86 - '(0 6 0 9 1 6 11 0 12 1 11 0 0 13 2 6 - 11 0 0 15 1 6 0 0 18 2 6 0 0 0 19 0 6 - 0 21 1 6 0 0 22 2 6 11 0 0 25 1 6 26 - 0 27 1 29 0 26 30 1 34 0 26 35 1 38 0 - 26 39 1 42 41 6 43 1 42 41 6 46 1 48 - 11 6 49 1 51 6 6 52 2 51 6 6 6 54 2 - 51 6 6 6 56 1 6 11 0 61 2 6 0 0 0 62 - 3 66 65 6 38 65 67 1 70 0 26 71 2 6 0 - 0 0 75 2 6 0 76 0 77 2 6 0 0 0 78 1 6 - 11 0 80 2 6 0 0 0 81 2 6 0 0 0 82 2 6 - 0 0 0 83 3 6 0 0 0 0 85 2 0 0 0 0 79 - 1 0 44 0 47 1 0 58 0 59 1 0 26 0 37 1 - 0 73 0 74 1 0 11 0 24 1 0 70 0 72 1 0 - 11 0 50 3 0 0 0 0 0 86 1 0 11 0 16 2 - 0 0 0 0 57 3 0 68 0 38 68 69 1 0 63 0 - 64 1 0 0 0 23 2 0 0 0 0 84 0 0 0 60 1 - 0 0 0 53 1 0 44 0 45 1 0 11 0 14 1 0 - 7 0 28 1 0 0 0 10 1 0 0 0 17 1 0 32 0 - 33 1 0 29 0 31 1 0 38 0 40 1 0 34 0 - 36 0 0 7 8 2 0 11 0 0 20 2 0 0 0 0 - 55))))) - '|lookupComplete|)) -@ \section{domain SINT SingleInteger} The definition of {\bf one?} has been rewritten as it relies on calling {\bf ONEP} which is a function specific @@ -751,473 +363,6 @@ SingleInteger(): Join(IntegerNumberSystem,Logic,OpenMath) with @ -\section{SINT.lsp BOOTSTRAP} - -<<SINT.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |SINT;writeOMSingleInt| (|dev| |x| $) - (SEQ (COND - ((QSLESSP |x| 0) - (SEQ (SPADCALL |dev| (|getShellEntry| $ 9)) - (SPADCALL |dev| "arith1" "unaryminus" - (|getShellEntry| $ 11)) - (SPADCALL |dev| (QSMINUS |x|) (|getShellEntry| $ 13)) - (EXIT (SPADCALL |dev| (|getShellEntry| $ 14))))) - ('T (SPADCALL |dev| |x| (|getShellEntry| $ 13)))))) - -(DEFUN |SINT;OMwrite;$S;2| (|x| $) - (PROG (|sp| |dev| |s|) - (RETURN - (SEQ (LETT |s| "" |SINT;OMwrite;$S;2|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SINT;OMwrite;$S;2|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 16)) - (|getShellEntry| $ 17)) - |SINT;OMwrite;$S;2|) - (SPADCALL |dev| (|getShellEntry| $ 18)) - (|SINT;writeOMSingleInt| |dev| |x| $) - (SPADCALL |dev| (|getShellEntry| $ 19)) - (SPADCALL |dev| (|getShellEntry| $ 20)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |SINT;OMwrite;$S;2|) - (EXIT |s|))))) - -(DEFUN |SINT;OMwrite;$BS;3| (|x| |wholeObj| $) - (PROG (|sp| |dev| |s|) - (RETURN - (SEQ (LETT |s| "" |SINT;OMwrite;$BS;3|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SINT;OMwrite;$BS;3|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 16)) - (|getShellEntry| $ 17)) - |SINT;OMwrite;$BS;3|) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 18)))) - (|SINT;writeOMSingleInt| |dev| |x| $) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 19)))) - (SPADCALL |dev| (|getShellEntry| $ 20)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |SINT;OMwrite;$BS;3|) - (EXIT |s|))))) - -(DEFUN |SINT;OMwrite;Omd$V;4| (|dev| |x| $) - (SEQ (SPADCALL |dev| (|getShellEntry| $ 18)) - (|SINT;writeOMSingleInt| |dev| |x| $) - (EXIT (SPADCALL |dev| (|getShellEntry| $ 19))))) - -(DEFUN |SINT;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 18)))) - (|SINT;writeOMSingleInt| |dev| |x| $) - (EXIT (COND - (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 19))))))) - -(PUT '|SINT;reducedSystem;MM;6| '|SPADreplace| '(XLAM (|m|) |m|)) - -(DEFUN |SINT;reducedSystem;MM;6| (|m| $) |m|) - -(DEFUN |SINT;coerce;$Of;7| (|x| $) - (SPADCALL |x| (|getShellEntry| $ 30))) - -(PUT '|SINT;convert;$I;8| '|SPADreplace| '(XLAM (|x|) |x|)) - -(DEFUN |SINT;convert;$I;8| (|x| $) |x|) - -(DEFUN |SINT;*;I2$;9| (|i| |y| $) - (QSTIMES (SPADCALL |i| (|getShellEntry| $ 33)) |y|)) - -(PUT '|SINT;Zero;$;10| '|SPADreplace| '(XLAM NIL 0)) - -(DEFUN |SINT;Zero;$;10| ($) 0) - -(PUT '|SINT;One;$;11| '|SPADreplace| '(XLAM NIL 1)) - -(DEFUN |SINT;One;$;11| ($) 1) - -(PUT '|SINT;base;$;12| '|SPADreplace| '(XLAM NIL 2)) - -(DEFUN |SINT;base;$;12| ($) 2) - -(PUT '|SINT;max;$;13| '|SPADreplace| '(XLAM NIL MOST-POSITIVE-FIXNUM)) - -(DEFUN |SINT;max;$;13| ($) MOST-POSITIVE-FIXNUM) - -(PUT '|SINT;min;$;14| '|SPADreplace| '(XLAM NIL MOST-NEGATIVE-FIXNUM)) - -(DEFUN |SINT;min;$;14| ($) MOST-NEGATIVE-FIXNUM) - -(PUT '|SINT;=;2$B;15| '|SPADreplace| 'EQL) - -(DEFUN |SINT;=;2$B;15| (|x| |y| $) (EQL |x| |y|)) - -(PUT '|SINT;~;2$;16| '|SPADreplace| 'LOGNOT) - -(DEFUN |SINT;~;2$;16| (|x| $) (LOGNOT |x|)) - -(PUT '|SINT;not;2$;17| '|SPADreplace| 'LOGNOT) - -(DEFUN |SINT;not;2$;17| (|x| $) (LOGNOT |x|)) - -(PUT '|SINT;/\\;3$;18| '|SPADreplace| 'LOGAND) - -(DEFUN |SINT;/\\;3$;18| (|x| |y| $) (LOGAND |x| |y|)) - -(PUT '|SINT;\\/;3$;19| '|SPADreplace| 'LOGIOR) - -(DEFUN |SINT;\\/;3$;19| (|x| |y| $) (LOGIOR |x| |y|)) - -(PUT '|SINT;Not;2$;20| '|SPADreplace| 'LOGNOT) - -(DEFUN |SINT;Not;2$;20| (|x| $) (LOGNOT |x|)) - -(PUT '|SINT;And;3$;21| '|SPADreplace| 'LOGAND) - -(DEFUN |SINT;And;3$;21| (|x| |y| $) (LOGAND |x| |y|)) - -(PUT '|SINT;Or;3$;22| '|SPADreplace| 'LOGIOR) - -(DEFUN |SINT;Or;3$;22| (|x| |y| $) (LOGIOR |x| |y|)) - -(PUT '|SINT;xor;3$;23| '|SPADreplace| 'LOGXOR) - -(DEFUN |SINT;xor;3$;23| (|x| |y| $) (LOGXOR |x| |y|)) - -(PUT '|SINT;<;2$B;24| '|SPADreplace| 'QSLESSP) - -(DEFUN |SINT;<;2$B;24| (|x| |y| $) (QSLESSP |x| |y|)) - -(PUT '|SINT;inc;2$;25| '|SPADreplace| 'QSADD1) - -(DEFUN |SINT;inc;2$;25| (|x| $) (QSADD1 |x|)) - -(PUT '|SINT;dec;2$;26| '|SPADreplace| 'QSSUB1) - -(DEFUN |SINT;dec;2$;26| (|x| $) (QSSUB1 |x|)) - -(PUT '|SINT;-;2$;27| '|SPADreplace| 'QSMINUS) - -(DEFUN |SINT;-;2$;27| (|x| $) (QSMINUS |x|)) - -(PUT '|SINT;+;3$;28| '|SPADreplace| 'QSPLUS) - -(DEFUN |SINT;+;3$;28| (|x| |y| $) (QSPLUS |x| |y|)) - -(PUT '|SINT;-;3$;29| '|SPADreplace| 'QSDIFFERENCE) - -(DEFUN |SINT;-;3$;29| (|x| |y| $) (QSDIFFERENCE |x| |y|)) - -(PUT '|SINT;*;3$;30| '|SPADreplace| 'QSTIMES) - -(DEFUN |SINT;*;3$;30| (|x| |y| $) (QSTIMES |x| |y|)) - -(DEFUN |SINT;**;$Nni$;31| (|x| |n| $) - (SPADCALL (EXPT |x| |n|) (|getShellEntry| $ 33))) - -(PUT '|SINT;quo;3$;32| '|SPADreplace| 'QSQUOTIENT) - -(DEFUN |SINT;quo;3$;32| (|x| |y| $) (QSQUOTIENT |x| |y|)) - -(PUT '|SINT;rem;3$;33| '|SPADreplace| 'QSREMAINDER) - -(DEFUN |SINT;rem;3$;33| (|x| |y| $) (QSREMAINDER |x| |y|)) - -(DEFUN |SINT;divide;2$R;34| (|x| |y| $) - (CONS (QSQUOTIENT |x| |y|) (QSREMAINDER |x| |y|))) - -(PUT '|SINT;gcd;3$;35| '|SPADreplace| 'GCD) - -(DEFUN |SINT;gcd;3$;35| (|x| |y| $) (GCD |x| |y|)) - -(PUT '|SINT;abs;2$;36| '|SPADreplace| 'QSABSVAL) - -(DEFUN |SINT;abs;2$;36| (|x| $) (QSABSVAL |x|)) - -(PUT '|SINT;odd?;$B;37| '|SPADreplace| 'QSODDP) - -(DEFUN |SINT;odd?;$B;37| (|x| $) (QSODDP |x|)) - -(PUT '|SINT;zero?;$B;38| '|SPADreplace| 'QSZEROP) - -(DEFUN |SINT;zero?;$B;38| (|x| $) (QSZEROP |x|)) - -(PUT '|SINT;one?;$B;39| '|SPADreplace| '(XLAM (|x|) (EQL |x| 1))) - -(DEFUN |SINT;one?;$B;39| (|x| $) (EQL |x| 1)) - -(PUT '|SINT;max;3$;40| '|SPADreplace| 'QSMAX) - -(DEFUN |SINT;max;3$;40| (|x| |y| $) (QSMAX |x| |y|)) - -(PUT '|SINT;min;3$;41| '|SPADreplace| 'QSMIN) - -(DEFUN |SINT;min;3$;41| (|x| |y| $) (QSMIN |x| |y|)) - -(PUT '|SINT;hash;2$;42| '|SPADreplace| 'HASHEQ) - -(DEFUN |SINT;hash;2$;42| (|x| $) (HASHEQ |x|)) - -(PUT '|SINT;length;2$;43| '|SPADreplace| 'INTEGER-LENGTH) - -(DEFUN |SINT;length;2$;43| (|x| $) (INTEGER-LENGTH |x|)) - -(PUT '|SINT;shift;3$;44| '|SPADreplace| 'QSLEFTSHIFT) - -(DEFUN |SINT;shift;3$;44| (|x| |n| $) (QSLEFTSHIFT |x| |n|)) - -(PUT '|SINT;mulmod;4$;45| '|SPADreplace| 'QSMULTMOD) - -(DEFUN |SINT;mulmod;4$;45| (|a| |b| |p| $) (QSMULTMOD |a| |b| |p|)) - -(PUT '|SINT;addmod;4$;46| '|SPADreplace| 'QSADDMOD) - -(DEFUN |SINT;addmod;4$;46| (|a| |b| |p| $) (QSADDMOD |a| |b| |p|)) - -(PUT '|SINT;submod;4$;47| '|SPADreplace| 'QSDIFMOD) - -(DEFUN |SINT;submod;4$;47| (|a| |b| |p| $) (QSDIFMOD |a| |b| |p|)) - -(PUT '|SINT;negative?;$B;48| '|SPADreplace| 'QSMINUSP) - -(DEFUN |SINT;negative?;$B;48| (|x| $) (QSMINUSP |x|)) - -(PUT '|SINT;reducedSystem;MVR;49| '|SPADreplace| 'CONS) - -(DEFUN |SINT;reducedSystem;MVR;49| (|m| |v| $) (CONS |m| |v|)) - -(DEFUN |SINT;positiveRemainder;3$;50| (|x| |n| $) - (PROG (|r|) - (RETURN - (SEQ (LETT |r| (QSREMAINDER |x| |n|) - |SINT;positiveRemainder;3$;50|) - (EXIT (COND - ((QSMINUSP |r|) - (COND - ((QSMINUSP |n|) (QSDIFFERENCE |x| |n|)) - ('T (QSPLUS |r| |n|)))) - ('T |r|))))))) - -(DEFUN |SINT;coerce;I$;51| (|x| $) - (SEQ (COND - ((NULL (< MOST-POSITIVE-FIXNUM |x|)) - (COND ((NULL (< |x| MOST-NEGATIVE-FIXNUM)) (EXIT |x|))))) - (EXIT (|error| "integer too large to represent in a machine word")))) - -(DEFUN |SINT;random;$;52| ($) - (SEQ (SETELT $ 6 - (REMAINDER (TIMES 314159269 (|getShellEntry| $ 6)) - 2147483647)) - (EXIT (REMAINDER (|getShellEntry| $ 6) 67108864)))) - -(PUT '|SINT;random;2$;53| '|SPADreplace| 'RANDOM) - -(DEFUN |SINT;random;2$;53| (|n| $) (RANDOM |n|)) - -(DEFUN |SINT;unitNormal;$R;54| (|x| $) - (COND - ((QSLESSP |x| 0) (VECTOR -1 (QSMINUS |x|) -1)) - ('T (VECTOR 1 |x| 1)))) - -(DEFUN |SingleInteger| () - (PROG () - (RETURN - (PROG (#0=#:G1486) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|SingleInteger|) - |SingleInteger|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|SingleInteger| - (LIST - (CONS NIL - (CONS 1 (|SingleInteger;|)))))) - (LETT #0# T |SingleInteger|)) - (COND - ((NOT #0#) - (HREM |$ConstructorCache| '|SingleInteger|))))))))))) - -(DEFUN |SingleInteger;| () - (PROG (|dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$| '(|SingleInteger|) . #0=(|SingleInteger|)) - (LETT $ (|newShell| 105) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|haddProp| |$ConstructorCache| '|SingleInteger| NIL - (CONS 1 $)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 1) - $)))) - -(MAKEPROP '|SingleInteger| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL '|seed| (|Void|) - (|OpenMathDevice|) (0 . |OMputApp|) (|String|) - (5 . |OMputSymbol|) (|Integer|) (12 . |OMputInteger|) - (18 . |OMputEndApp|) (|OpenMathEncoding|) - (23 . |OMencodingXML|) (27 . |OMopenString|) - (33 . |OMputObject|) (38 . |OMputEndObject|) - (43 . |OMclose|) |SINT;OMwrite;$S;2| (|Boolean|) - |SINT;OMwrite;$BS;3| |SINT;OMwrite;Omd$V;4| - |SINT;OMwrite;Omd$BV;5| (|Matrix| 12) (|Matrix| $) - |SINT;reducedSystem;MM;6| (|OutputForm|) (48 . |coerce|) - |SINT;coerce;$Of;7| |SINT;convert;$I;8| (53 . |coerce|) - |SINT;*;I2$;9| - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |SINT;Zero;$;10|) $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |SINT;One;$;11|) $)) - |SINT;base;$;12| |SINT;max;$;13| |SINT;min;$;14| - |SINT;=;2$B;15| |SINT;~;2$;16| |SINT;not;2$;17| - |SINT;/\\;3$;18| |SINT;\\/;3$;19| |SINT;Not;2$;20| - |SINT;And;3$;21| |SINT;Or;3$;22| |SINT;xor;3$;23| - |SINT;<;2$B;24| |SINT;inc;2$;25| |SINT;dec;2$;26| - |SINT;-;2$;27| |SINT;+;3$;28| |SINT;-;3$;29| - |SINT;*;3$;30| (|NonNegativeInteger|) |SINT;**;$Nni$;31| - |SINT;quo;3$;32| |SINT;rem;3$;33| - (|Record| (|:| |quotient| $) (|:| |remainder| $)) - |SINT;divide;2$R;34| |SINT;gcd;3$;35| |SINT;abs;2$;36| - |SINT;odd?;$B;37| |SINT;zero?;$B;38| |SINT;one?;$B;39| - |SINT;max;3$;40| |SINT;min;3$;41| |SINT;hash;2$;42| - |SINT;length;2$;43| |SINT;shift;3$;44| |SINT;mulmod;4$;45| - |SINT;addmod;4$;46| |SINT;submod;4$;47| - |SINT;negative?;$B;48| (|Vector| 12) - (|Record| (|:| |mat| 26) (|:| |vec| 76)) (|Vector| $) - |SINT;reducedSystem;MVR;49| |SINT;positiveRemainder;3$;50| - |SINT;coerce;I$;51| |SINT;random;$;52| |SINT;random;2$;53| - (|Record| (|:| |unit| $) (|:| |canonical| $) - (|:| |associate| $)) - |SINT;unitNormal;$R;54| (|Fraction| 12) - (|Union| 86 '"failed") (|Union| $ '"failed") (|Float|) - (|DoubleFloat|) (|Pattern| 12) (|PatternMatchResult| 12 $) - (|InputForm|) (|Union| 12 '"failed") (|List| $) - (|Record| (|:| |coef| 95) (|:| |generator| $)) - (|Union| 95 '"failed") - (|Record| (|:| |coef1| $) (|:| |coef2| $) - (|:| |generator| $)) - (|Record| (|:| |coef1| $) (|:| |coef2| $)) - (|Union| 99 '"failed") (|Factored| $) - (|SparseUnivariatePolynomial| $) (|PositiveInteger|) - (|SingleInteger|)) - '#(~= 58 ~ 64 |zero?| 69 |xor| 74 |unitNormal| 80 - |unitCanonical| 85 |unit?| 90 |symmetricRemainder| 95 - |subtractIfCan| 101 |submod| 107 |squareFreePart| 114 - |squareFree| 119 |sizeLess?| 124 |sign| 130 |shift| 135 - |sample| 141 |retractIfCan| 145 |retract| 150 |rem| 155 - |reducedSystem| 161 |recip| 172 |rationalIfCan| 177 - |rational?| 182 |rational| 187 |random| 192 |quo| 201 - |principalIdeal| 207 |prime?| 212 |powmod| 217 - |positiveRemainder| 224 |positive?| 230 |permutation| 235 - |patternMatch| 241 |one?| 248 |odd?| 253 |not| 258 - |nextItem| 263 |negative?| 268 |multiEuclidean| 273 - |mulmod| 279 |min| 286 |max| 296 |mask| 306 |length| 311 - |lcm| 316 |latex| 327 |invmod| 332 |init| 338 |inc| 342 - |hash| 347 |gcdPolynomial| 357 |gcd| 363 |factorial| 374 - |factor| 379 |extendedEuclidean| 384 |exquo| 397 - |expressIdealMember| 403 |even?| 409 |euclideanSize| 414 - |divide| 419 |differentiate| 425 |dec| 436 |copy| 441 - |convert| 446 |coerce| 471 |characteristic| 491 |bit?| 495 - |binomial| 501 |base| 507 |associates?| 511 |addmod| 517 - |abs| 524 ^ 529 |\\/| 541 |Zero| 547 |Or| 551 |One| 557 - |OMwrite| 561 |Not| 585 D 590 |And| 601 >= 607 > 613 = 619 - <= 625 < 631 |/\\| 637 - 643 + 654 ** 660 * 672) - '((|noetherian| . 0) (|canonicalsClosed| . 0) - (|canonical| . 0) (|canonicalUnitNormal| . 0) - (|multiplicativeValuation| . 0) (|noZeroDivisors| . 0) - ((|commutative| "*") . 0) (|rightUnitary| . 0) - (|leftUnitary| . 0) (|unitsKnown| . 0)) - (CONS (|makeByteWordVec2| 1 - '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)) - (CONS '#(|IntegerNumberSystem&| |EuclideanDomain&| - |UniqueFactorizationDomain&| NIL NIL - |GcdDomain&| |IntegralDomain&| |Algebra&| NIL - NIL |DifferentialRing&| |OrderedRing&| NIL NIL - |Module&| NIL NIL |Ring&| NIL NIL NIL NIL NIL - |AbelianGroup&| NIL NIL |AbelianMonoid&| - |Monoid&| NIL NIL |OrderedSet&| - |AbelianSemiGroup&| |SemiGroup&| |Logic&| NIL - |SetCategory&| NIL NIL NIL NIL NIL NIL - |RetractableTo&| NIL |BasicType&| NIL) - (CONS '#((|IntegerNumberSystem|) - (|EuclideanDomain|) - (|UniqueFactorizationDomain|) - (|PrincipalIdealDomain|) - (|OrderedIntegralDomain|) (|GcdDomain|) - (|IntegralDomain|) (|Algebra| $$) - (|CharacteristicZero|) - (|LinearlyExplicitRingOver| 12) - (|DifferentialRing|) (|OrderedRing|) - (|CommutativeRing|) (|EntireRing|) - (|Module| $$) (|OrderedAbelianGroup|) - (|BiModule| $$ $$) (|Ring|) - (|OrderedCancellationAbelianMonoid|) - (|LeftModule| $$) (|Rng|) - (|RightModule| $$) - (|OrderedAbelianMonoid|) - (|AbelianGroup|) - (|OrderedAbelianSemiGroup|) - (|CancellationAbelianMonoid|) - (|AbelianMonoid|) (|Monoid|) - (|StepThrough|) (|PatternMatchable| 12) - (|OrderedSet|) (|AbelianSemiGroup|) - (|SemiGroup|) (|Logic|) (|RealConstant|) - (|SetCategory|) (|OpenMath|) - (|ConvertibleTo| 89) - (|ConvertibleTo| 90) - (|CombinatorialFunctionCategory|) - (|ConvertibleTo| 91) - (|ConvertibleTo| 93) - (|RetractableTo| 12) - (|ConvertibleTo| 12) (|BasicType|) - (|CoercibleTo| 29)) - (|makeByteWordVec2| 104 - '(1 8 7 0 9 3 8 7 0 10 10 11 2 8 7 0 12 - 13 1 8 7 0 14 0 15 0 16 2 8 0 10 15 - 17 1 8 7 0 18 1 8 7 0 19 1 8 7 0 20 1 - 12 29 0 30 1 0 0 12 33 2 0 22 0 0 1 1 - 0 0 0 41 1 0 22 0 65 2 0 0 0 0 48 1 0 - 84 0 85 1 0 0 0 1 1 0 22 0 1 2 0 0 0 - 0 1 2 0 88 0 0 1 3 0 0 0 0 0 74 1 0 0 - 0 1 1 0 101 0 1 2 0 22 0 0 1 1 0 12 0 - 1 2 0 0 0 0 71 0 0 0 1 1 0 94 0 1 1 0 - 12 0 1 2 0 0 0 0 59 1 0 26 27 28 2 0 - 77 27 78 79 1 0 88 0 1 1 0 87 0 1 1 0 - 22 0 1 1 0 86 0 1 1 0 0 0 83 0 0 0 82 - 2 0 0 0 0 58 1 0 96 95 1 1 0 22 0 1 3 - 0 0 0 0 0 1 2 0 0 0 0 80 1 0 22 0 1 2 - 0 0 0 0 1 3 0 92 0 91 92 1 1 0 22 0 - 66 1 0 22 0 64 1 0 0 0 42 1 0 88 0 1 - 1 0 22 0 75 2 0 97 95 0 1 3 0 0 0 0 0 - 72 0 0 0 39 2 0 0 0 0 68 0 0 0 38 2 0 - 0 0 0 67 1 0 0 0 1 1 0 0 0 70 1 0 0 - 95 1 2 0 0 0 0 1 1 0 10 0 1 2 0 0 0 0 - 1 0 0 0 1 1 0 0 0 50 1 0 0 0 69 1 0 - 104 0 1 2 0 102 102 102 1 1 0 0 95 1 - 2 0 0 0 0 62 1 0 0 0 1 1 0 101 0 1 2 - 0 98 0 0 1 3 0 100 0 0 0 1 2 0 88 0 0 - 1 2 0 97 95 0 1 1 0 22 0 1 1 0 56 0 1 - 2 0 60 0 0 61 1 0 0 0 1 2 0 0 0 56 1 - 1 0 0 0 51 1 0 0 0 1 1 0 89 0 1 1 0 - 90 0 1 1 0 91 0 1 1 0 93 0 1 1 0 12 0 - 32 1 0 0 12 81 1 0 0 0 1 1 0 0 12 81 - 1 0 29 0 31 0 0 56 1 2 0 22 0 0 1 2 0 - 0 0 0 1 0 0 0 37 2 0 22 0 0 1 3 0 0 0 - 0 0 73 1 0 0 0 63 2 0 0 0 56 1 2 0 0 - 0 103 1 2 0 0 0 0 44 0 0 0 35 2 0 0 0 - 0 47 0 0 0 36 3 0 7 8 0 22 25 2 0 10 - 0 22 23 2 0 7 8 0 24 1 0 10 0 21 1 0 - 0 0 45 1 0 0 0 1 2 0 0 0 56 1 2 0 0 0 - 0 46 2 0 22 0 0 1 2 0 22 0 0 1 2 0 22 - 0 0 40 2 0 22 0 0 1 2 0 22 0 0 49 2 0 - 0 0 0 43 1 0 0 0 52 2 0 0 0 0 54 2 0 - 0 0 0 53 2 0 0 0 56 57 2 0 0 0 103 1 - 2 0 0 0 0 55 2 0 0 12 0 34 2 0 0 56 0 - 1 2 0 0 103 0 1))))) - '|lookupComplete|)) - -(MAKEPROP '|SingleInteger| 'NILADIC T) -@ \section{License} diff --git a/src/algebra/strap/ABELGRP-.lsp b/src/algebra/strap/ABELGRP-.lsp new file mode 100644 index 00000000..ca331722 --- /dev/null +++ b/src/algebra/strap/ABELGRP-.lsp @@ -0,0 +1,53 @@ + +(/VERSIONCHECK 2) + +(DEFUN |ABELGRP-;-;3S;1| (|x| |y| $) + (SPADCALL |x| (SPADCALL |y| (QREFELT $ 7)) (QREFELT $ 8))) + +(DEFUN |ABELGRP-;subtractIfCan;2SU;2| (|x| |y| $) + (CONS 0 (SPADCALL |x| |y| (QREFELT $ 10)))) + +(DEFUN |ABELGRP-;*;Nni2S;3| (|n| |x| $) + (SPADCALL |n| |x| (QREFELT $ 14))) + +(DEFUN |ABELGRP-;*;I2S;4| (|n| |x| $) + (COND + ((ZEROP |n|) (|spadConstant| $ 17)) + ((< 0 |n|) (SPADCALL |n| |x| (QREFELT $ 20))) + ('T (SPADCALL (- |n|) (SPADCALL |x| (QREFELT $ 7)) (QREFELT $ 20))))) + +(DEFUN |AbelianGroup&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|AbelianGroup&|)) + (LETT |dv$| (LIST '|AbelianGroup&| |dv$1|) . #0#) + (LETT $ (GETREFV 22) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (COND + ((|HasCategory| |#1| '(|Ring|))) + ('T + (QSETREFV $ 21 + (CONS (|dispatchFunction| |ABELGRP-;*;I2S;4|) $)))) + $)))) + +(MAKEPROP '|AbelianGroup&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . -) (5 . +) + |ABELGRP-;-;3S;1| (11 . -) (|Union| $ '"failed") + |ABELGRP-;subtractIfCan;2SU;2| (|Integer|) (17 . *) + (|NonNegativeInteger|) |ABELGRP-;*;Nni2S;3| (23 . |Zero|) + (|PositiveInteger|) (|RepeatedDoubling| 6) (27 . |double|) + (33 . *)) + '#(|subtractIfCan| 39 - 45 * 51) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 21 + '(1 6 0 0 7 2 6 0 0 0 8 2 6 0 0 0 10 2 + 6 0 13 0 14 0 6 0 17 2 19 6 18 6 20 2 + 0 0 13 0 21 2 0 11 0 0 12 2 0 0 0 0 9 + 2 0 0 13 0 21 2 0 0 15 0 16))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/ABELGRP.lsp b/src/algebra/strap/ABELGRP.lsp new file mode 100644 index 00000000..f667c2d5 --- /dev/null +++ b/src/algebra/strap/ABELGRP.lsp @@ -0,0 +1,24 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |AbelianGroup;AL| 'NIL) + +(DEFUN |AbelianGroup| () + (LET (#:G1388) + (COND + (|AbelianGroup;AL|) + (T (SETQ |AbelianGroup;AL| (|AbelianGroup;|)))))) + +(DEFUN |AbelianGroup;| () + (PROG (#0=#:G1386) + (RETURN + (PROG1 (LETT #0# + (|Join| (|CancellationAbelianMonoid|) + (|mkCategory| '|domain| + '(((- ($ $)) T) ((- ($ $ $)) T) + ((* ($ (|Integer|) $)) T)) + NIL '((|Integer|)) NIL)) + |AbelianGroup|) + (SETELT #0# 0 '(|AbelianGroup|)))))) + +(MAKEPROP '|AbelianGroup| 'NILADIC T) diff --git a/src/algebra/strap/ABELMON-.lsp b/src/algebra/strap/ABELMON-.lsp new file mode 100644 index 00000000..a38826e3 --- /dev/null +++ b/src/algebra/strap/ABELMON-.lsp @@ -0,0 +1,49 @@ + +(/VERSIONCHECK 2) + +(DEFUN |ABELMON-;zero?;SB;1| (|x| $) + (SPADCALL |x| (|spadConstant| $ 7) (QREFELT $ 9))) + +(DEFUN |ABELMON-;*;Pi2S;2| (|n| |x| $) + (SPADCALL |n| |x| (QREFELT $ 12))) + +(DEFUN |ABELMON-;sample;S;3| ($) (|spadConstant| $ 7)) + +(DEFUN |ABELMON-;*;Nni2S;4| (|n| |x| $) + (COND + ((ZEROP |n|) (|spadConstant| $ 7)) + ('T (SPADCALL |n| |x| (QREFELT $ 17))))) + +(DEFUN |AbelianMonoid&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|AbelianMonoid&|)) + (LETT |dv$| (LIST '|AbelianMonoid&| |dv$1|) . #0#) + (LETT $ (GETREFV 19) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (COND + ((|HasCategory| |#1| '(|Ring|))) + ('T + (QSETREFV $ 18 + (CONS (|dispatchFunction| |ABELMON-;*;Nni2S;4|) $)))) + $)))) + +(MAKEPROP '|AbelianMonoid&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|) + (|Boolean|) (4 . =) |ABELMON-;zero?;SB;1| + (|NonNegativeInteger|) (10 . *) (|PositiveInteger|) + |ABELMON-;*;Pi2S;2| |ABELMON-;sample;S;3| + (|RepeatedDoubling| 6) (16 . |double|) (22 . *)) + '#(|zero?| 28 |sample| 33 * 37) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 18 + '(0 6 0 7 2 6 8 0 0 9 2 6 0 11 0 12 2 + 16 6 13 6 17 2 0 0 11 0 18 1 0 8 0 10 + 0 0 0 15 2 0 0 11 0 18 2 0 0 13 0 14))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/ABELMON.lsp b/src/algebra/strap/ABELMON.lsp new file mode 100644 index 00000000..5de5fbba --- /dev/null +++ b/src/algebra/strap/ABELMON.lsp @@ -0,0 +1,28 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |AbelianMonoid;AL| 'NIL) + +(DEFUN |AbelianMonoid| () + (LET (#:G1388) + (COND + (|AbelianMonoid;AL|) + (T (SETQ |AbelianMonoid;AL| (|AbelianMonoid;|)))))) + +(DEFUN |AbelianMonoid;| () + (PROG (#0=#:G1386) + (RETURN + (PROG1 (LETT #0# + (|Join| (|AbelianSemiGroup|) + (|mkCategory| '|domain| + '(((|Zero| ($) |constant|) T) + ((|sample| ($) |constant|) T) + ((|zero?| ((|Boolean|) $)) T) + ((* ($ (|NonNegativeInteger|) $)) T)) + NIL + '((|NonNegativeInteger|) (|Boolean|)) + NIL)) + |AbelianMonoid|) + (SETELT #0# 0 '(|AbelianMonoid|)))))) + +(MAKEPROP '|AbelianMonoid| 'NILADIC T) diff --git a/src/algebra/strap/ABELSG-.lsp b/src/algebra/strap/ABELSG-.lsp new file mode 100644 index 00000000..6c9c3182 --- /dev/null +++ b/src/algebra/strap/ABELSG-.lsp @@ -0,0 +1,35 @@ + +(/VERSIONCHECK 2) + +(DEFUN |ABELSG-;*;Pi2S;1| (|n| |x| $) + (SPADCALL |n| |x| (QREFELT $ 9))) + +(DEFUN |AbelianSemiGroup&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|AbelianSemiGroup&|)) + (LETT |dv$| (LIST '|AbelianSemiGroup&| |dv$1|) . #0#) + (LETT $ (GETREFV 11) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (COND + ((|HasCategory| |#1| '(|Ring|))) + ('T + (QSETREFV $ 10 + (CONS (|dispatchFunction| |ABELSG-;*;Pi2S;1|) $)))) + $)))) + +(MAKEPROP '|AbelianSemiGroup&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|PositiveInteger|) + (|RepeatedDoubling| 6) (0 . |double|) (6 . *)) + '#(* 12) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 10 + '(2 8 6 7 6 9 2 0 0 7 0 10 2 0 0 7 0 + 10))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/ABELSG.lsp b/src/algebra/strap/ABELSG.lsp new file mode 100644 index 00000000..6ad00a8f --- /dev/null +++ b/src/algebra/strap/ABELSG.lsp @@ -0,0 +1,24 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |AbelianSemiGroup;AL| 'NIL) + +(DEFUN |AbelianSemiGroup| () + (LET (#:G1387) + (COND + (|AbelianSemiGroup;AL|) + (T (SETQ |AbelianSemiGroup;AL| (|AbelianSemiGroup;|)))))) + +(DEFUN |AbelianSemiGroup;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# + (|Join| (|SetCategory|) + (|mkCategory| '|domain| + '(((+ ($ $ $)) T) + ((* ($ (|PositiveInteger|) $)) T)) + NIL '((|PositiveInteger|)) NIL)) + |AbelianSemiGroup|) + (SETELT #0# 0 '(|AbelianSemiGroup|)))))) + +(MAKEPROP '|AbelianSemiGroup| 'NILADIC T) diff --git a/src/algebra/strap/ALAGG.lsp b/src/algebra/strap/ALAGG.lsp new file mode 100644 index 00000000..e42de7db --- /dev/null +++ b/src/algebra/strap/ALAGG.lsp @@ -0,0 +1,55 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |AssociationListAggregate;CAT| 'NIL) + +(DEFPARAMETER |AssociationListAggregate;AL| 'NIL) + +(DEFUN |AssociationListAggregate| (&REST #0=#:G1397 &AUX #1=#:G1395) + (DSETQ #1# #0#) + (LET (#2=#:G1396) + (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#)))) + +(DEFUN |AssociationListAggregate;| (|t#1| |t#2|) + (PROG (#0=#:G1394) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1| |t#2|) + (LIST (|devaluate| |t#1|) + (|devaluate| |t#2|))) + (|sublisV| + (PAIR '(#1=#:G1393) + (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| + ((|Union| + (|Record| (|:| |key| |t#1|) + (|:| |entry| |t#2|)) + "failed") + |t#1| $)) + T)) + NIL 'NIL NIL)) + . #2=(|AssociationListAggregate|)))))) . #2#) + (SETELT #0# 0 + (LIST '|AssociationListAggregate| (|devaluate| |t#1|) + (|devaluate| |t#2|))))))) diff --git a/src/algebra/strap/BOOLEAN.lsp b/src/algebra/strap/BOOLEAN.lsp new file mode 100644 index 00000000..bca63812 --- /dev/null +++ b/src/algebra/strap/BOOLEAN.lsp @@ -0,0 +1,156 @@ + +(/VERSIONCHECK 2) + +(PUT '|BOOLEAN;test;2$;1| '|SPADreplace| '(XLAM (|a|) |a|)) + +(DEFUN |BOOLEAN;test;2$;1| (|a| $) |a|) + +(DEFUN |BOOLEAN;nt| (|b| $) (COND (|b| 'NIL) ('T 'T))) + +(PUT '|BOOLEAN;true;$;3| '|SPADreplace| '(XLAM NIL 'T)) + +(DEFUN |BOOLEAN;true;$;3| ($) 'T) + +(PUT '|BOOLEAN;false;$;4| '|SPADreplace| '(XLAM NIL NIL)) + +(DEFUN |BOOLEAN;false;$;4| ($) NIL) + +(DEFUN |BOOLEAN;not;2$;5| (|b| $) (COND (|b| 'NIL) ('T 'T))) + +(DEFUN |BOOLEAN;^;2$;6| (|b| $) (COND (|b| 'NIL) ('T 'T))) + +(DEFUN |BOOLEAN;~;2$;7| (|b| $) (COND (|b| 'NIL) ('T 'T))) + +(DEFUN |BOOLEAN;and;3$;8| (|a| |b| $) (COND (|a| |b|) ('T 'NIL))) + +(DEFUN |BOOLEAN;/\\;3$;9| (|a| |b| $) (COND (|a| |b|) ('T 'NIL))) + +(DEFUN |BOOLEAN;or;3$;10| (|a| |b| $) (COND (|a| 'T) ('T |b|))) + +(DEFUN |BOOLEAN;\\/;3$;11| (|a| |b| $) (COND (|a| 'T) ('T |b|))) + +(DEFUN |BOOLEAN;xor;3$;12| (|a| |b| $) + (COND (|a| (|BOOLEAN;nt| |b| $)) ('T |b|))) + +(DEFUN |BOOLEAN;nor;3$;13| (|a| |b| $) + (COND (|a| 'NIL) ('T (|BOOLEAN;nt| |b| $)))) + +(DEFUN |BOOLEAN;nand;3$;14| (|a| |b| $) + (COND (|a| (|BOOLEAN;nt| |b| $)) ('T 'T))) + +(PUT '|BOOLEAN;=;2$B;15| '|SPADreplace| 'EQ) + +(DEFUN |BOOLEAN;=;2$B;15| (|a| |b| $) (EQ |a| |b|)) + +(DEFUN |BOOLEAN;implies;3$;16| (|a| |b| $) (COND (|a| |b|) ('T 'T))) + +(PUT '|BOOLEAN;equiv;3$;17| '|SPADreplace| 'EQ) + +(DEFUN |BOOLEAN;equiv;3$;17| (|a| |b| $) (EQ |a| |b|)) + +(DEFUN |BOOLEAN;<;2$B;18| (|a| |b| $) + (COND (|b| (|BOOLEAN;nt| |a| $)) ('T 'NIL))) + +(PUT '|BOOLEAN;size;Nni;19| '|SPADreplace| '(XLAM NIL 2)) + +(DEFUN |BOOLEAN;size;Nni;19| ($) 2) + +(DEFUN |BOOLEAN;index;Pi$;20| (|i| $) + (COND ((SPADCALL |i| (|getShellEntry| $ 27)) 'NIL) ('T 'T))) + +(DEFUN |BOOLEAN;lookup;$Pi;21| (|a| $) (COND (|a| 1) ('T 2))) + +(DEFUN |BOOLEAN;random;$;22| ($) + (COND ((SPADCALL (|random|) (|getShellEntry| $ 27)) 'NIL) ('T 'T))) + +(DEFUN |BOOLEAN;convert;$If;23| (|x| $) + (COND + (|x| (SPADCALL (SPADCALL "true" (|getShellEntry| $ 34)) + (|getShellEntry| $ 36))) + ('T + (SPADCALL (SPADCALL "false" (|getShellEntry| $ 34)) + (|getShellEntry| $ 36))))) + +(DEFUN |BOOLEAN;coerce;$Of;24| (|x| $) + (COND + (|x| (SPADCALL "true" (|getShellEntry| $ 39))) + ('T (SPADCALL "false" (|getShellEntry| $ 39))))) + +(DEFUN |Boolean| () + (PROG () + (RETURN + (PROG (#0=#:G1421) + (RETURN + (COND + ((LETT #0# (HGET |$ConstructorCache| '|Boolean|) |Boolean|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Boolean| + (LIST + (CONS NIL (CONS 1 (|Boolean;|)))))) + (LETT #0# T |Boolean|)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|Boolean|))))))))))) + +(DEFUN |Boolean;| () + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| '(|Boolean|) . #0=(|Boolean|)) + (LETT $ (|newShell| 42) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| '|Boolean| NIL (CONS 1 $)) + (|stuffDomainSlots| $) + $)))) + +(MAKEPROP '|Boolean| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL |BOOLEAN;test;2$;1| + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |BOOLEAN;true;$;3|) $)) + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |BOOLEAN;false;$;4|) $)) + |BOOLEAN;not;2$;5| |BOOLEAN;^;2$;6| |BOOLEAN;~;2$;7| + |BOOLEAN;and;3$;8| |BOOLEAN;/\\;3$;9| |BOOLEAN;or;3$;10| + |BOOLEAN;\\/;3$;11| |BOOLEAN;xor;3$;12| + |BOOLEAN;nor;3$;13| |BOOLEAN;nand;3$;14| (|Boolean|) + |BOOLEAN;=;2$B;15| |BOOLEAN;implies;3$;16| + |BOOLEAN;equiv;3$;17| |BOOLEAN;<;2$B;18| + (|NonNegativeInteger|) |BOOLEAN;size;Nni;19| (|Integer|) + (0 . |even?|) (|PositiveInteger|) |BOOLEAN;index;Pi$;20| + |BOOLEAN;lookup;$Pi;21| |BOOLEAN;random;$;22| (|String|) + (|Symbol|) (5 . |coerce|) (|InputForm|) (10 . |convert|) + |BOOLEAN;convert;$If;23| (|OutputForm|) (15 . |message|) + |BOOLEAN;coerce;$Of;24| (|SingleInteger|)) + '#(~= 20 ~ 26 |xor| 31 |true| 37 |test| 41 |size| 46 |random| + 50 |or| 54 |not| 60 |nor| 65 |nand| 71 |min| 77 |max| 83 + |lookup| 89 |latex| 94 |index| 99 |implies| 104 |hash| 110 + |false| 115 |equiv| 119 |convert| 125 |coerce| 130 |and| + 135 ^ 141 |\\/| 146 >= 152 > 158 = 164 <= 170 < 176 |/\\| + 182) + 'NIL + (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0 0 0)) + (CONS '#(|OrderedSet&| NIL |Logic&| |SetCategory&| NIL + NIL |BasicType&| NIL) + (CONS '#((|OrderedSet|) (|Finite|) (|Logic|) + (|SetCategory|) (|ConvertibleTo| 35) + (|PropositionalLogic|) (|BasicType|) + (|CoercibleTo| 38)) + (|makeByteWordVec2| 41 + '(1 26 19 0 27 1 33 0 32 34 1 35 0 33 + 36 1 38 0 32 39 2 0 19 0 0 1 1 0 0 0 + 11 2 0 0 0 0 16 0 0 0 7 1 0 0 0 6 0 0 + 24 25 0 0 0 31 2 0 0 0 0 14 1 0 0 0 9 + 2 0 0 0 0 17 2 0 0 0 0 18 2 0 0 0 0 1 + 2 0 0 0 0 1 1 0 28 0 30 1 0 32 0 1 1 + 0 0 28 29 2 0 0 0 0 21 1 0 41 0 1 0 0 + 0 8 2 0 0 0 0 22 1 0 35 0 37 1 0 38 0 + 40 2 0 0 0 0 12 1 0 0 0 10 2 0 0 0 0 + 15 2 0 19 0 0 1 2 0 19 0 0 1 2 0 19 0 + 0 20 2 0 19 0 0 1 2 0 19 0 0 23 2 0 0 + 0 0 13))))) + '|lookupComplete|)) + +(MAKEPROP '|Boolean| 'NILADIC T) diff --git a/src/algebra/strap/CABMON.lsp b/src/algebra/strap/CABMON.lsp new file mode 100644 index 00000000..d1059b38 --- /dev/null +++ b/src/algebra/strap/CABMON.lsp @@ -0,0 +1,26 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |CancellationAbelianMonoid;AL| 'NIL) + +(DEFUN |CancellationAbelianMonoid| () + (LET (#:G1387) + (COND + (|CancellationAbelianMonoid;AL|) + (T (SETQ |CancellationAbelianMonoid;AL| + (|CancellationAbelianMonoid;|)))))) + +(DEFUN |CancellationAbelianMonoid;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# + (|Join| (|AbelianMonoid|) + (|mkCategory| '|domain| + '(((|subtractIfCan| + ((|Union| $ "failed") $ $)) + T)) + NIL 'NIL NIL)) + |CancellationAbelianMonoid|) + (SETELT #0# 0 '(|CancellationAbelianMonoid|)))))) + +(MAKEPROP '|CancellationAbelianMonoid| 'NILADIC T) diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp new file mode 100644 index 00000000..1395d670 --- /dev/null +++ b/src/algebra/strap/CHAR.lsp @@ -0,0 +1,168 @@ + +(/VERSIONCHECK 2) + +(PUT '|CHAR;=;2$B;1| '|SPADreplace| 'CHAR=) + +(DEFUN |CHAR;=;2$B;1| (|a| |b| $) (CHAR= |a| |b|)) + +(PUT '|CHAR;<;2$B;2| '|SPADreplace| 'CHAR<) + +(DEFUN |CHAR;<;2$B;2| (|a| |b| $) (CHAR< |a| |b|)) + +(PUT '|CHAR;size;Nni;3| '|SPADreplace| '(XLAM NIL 256)) + +(DEFUN |CHAR;size;Nni;3| ($) 256) + +(DEFUN |CHAR;index;Pi$;4| (|n| $) + (PROG (#0=#:G1389) + (RETURN + (SPADCALL + (PROG1 (LETT #0# (- |n| 1) |CHAR;index;Pi$;4|) + (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)) + (QREFELT $ 11))))) + +(DEFUN |CHAR;lookup;$Pi;5| (|c| $) + (PROG (#0=#:G1391) + (RETURN + (PROG1 (LETT #0# (+ 1 (SPADCALL |c| (QREFELT $ 14))) + |CHAR;lookup;$Pi;5|) + (|check-subtype| (> #0# 0) '(|PositiveInteger|) #0#))))) + +(PUT '|CHAR;char;Nni$;6| '|SPADreplace| 'CODE-CHAR) + +(DEFUN |CHAR;char;Nni$;6| (|n| $) (CODE-CHAR |n|)) + +(PUT '|CHAR;ord;$Nni;7| '|SPADreplace| 'CHAR-CODE) + +(DEFUN |CHAR;ord;$Nni;7| (|c| $) (CHAR-CODE |c|)) + +(DEFUN |CHAR;random;$;8| ($) + (SPADCALL (RANDOM (SPADCALL (QREFELT $ 10))) (QREFELT $ 11))) + +(PUT '|CHAR;space;$;9| '|SPADreplace| '(XLAM NIL (CHAR " " 0))) + +(DEFUN |CHAR;space;$;9| ($) (CHAR " " 0)) + +(PUT '|CHAR;quote;$;10| '|SPADreplace| '(XLAM NIL (CHAR "\" " 0))) + +(DEFUN |CHAR;quote;$;10| ($) (CHAR "\" " 0)) + +(PUT '|CHAR;escape;$;11| '|SPADreplace| '(XLAM NIL (CHAR "_ " 0))) + +(DEFUN |CHAR;escape;$;11| ($) (CHAR "_ " 0)) + +(PUT '|CHAR;coerce;$Of;12| '|SPADreplace| '(XLAM (|c|) |c|)) + +(DEFUN |CHAR;coerce;$Of;12| (|c| $) |c|) + +(DEFUN |CHAR;digit?;$B;13| (|c| $) + (SPADCALL |c| (|spadConstant| $ 23) (QREFELT $ 25))) + +(DEFUN |CHAR;hexDigit?;$B;14| (|c| $) + (SPADCALL |c| (|spadConstant| $ 27) (QREFELT $ 25))) + +(DEFUN |CHAR;upperCase?;$B;15| (|c| $) + (SPADCALL |c| (|spadConstant| $ 29) (QREFELT $ 25))) + +(DEFUN |CHAR;lowerCase?;$B;16| (|c| $) + (SPADCALL |c| (|spadConstant| $ 31) (QREFELT $ 25))) + +(DEFUN |CHAR;alphabetic?;$B;17| (|c| $) + (SPADCALL |c| (|spadConstant| $ 33) (QREFELT $ 25))) + +(DEFUN |CHAR;alphanumeric?;$B;18| (|c| $) + (SPADCALL |c| (|spadConstant| $ 35) (QREFELT $ 25))) + +(DEFUN |CHAR;latex;$S;19| (|c| $) + (STRCONC "\\mbox{`" (STRCONC (MAKE-FULL-CVEC 1 |c|) "'}"))) + +(DEFUN |CHAR;char;S$;20| (|s| $) + (COND + ((EQL (QCSIZE |s|) 1) + (SPADCALL |s| (SPADCALL |s| (QREFELT $ 40)) (QREFELT $ 41))) + ('T (|userError| "String is not a single character")))) + +(PUT '|CHAR;upperCase;2$;21| '|SPADreplace| 'CHAR-UPCASE) + +(DEFUN |CHAR;upperCase;2$;21| (|c| $) (CHAR-UPCASE |c|)) + +(PUT '|CHAR;lowerCase;2$;22| '|SPADreplace| 'CHAR-DOWNCASE) + +(DEFUN |CHAR;lowerCase;2$;22| (|c| $) (CHAR-DOWNCASE |c|)) + +(DEFUN |Character| () + (PROG () + (RETURN + (PROG (#0=#:G1412) + (RETURN + (COND + ((LETT #0# (HGET |$ConstructorCache| '|Character|) + |Character|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Character| + (LIST + (CONS NIL (CONS 1 (|Character;|)))))) + (LETT #0# T |Character|)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|Character|))))))))))) + +(DEFUN |Character;| () + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| '(|Character|) . #0=(|Character|)) + (LETT $ (|newShell| 46) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| '|Character| NIL (CONS 1 $)) + (|stuffDomainSlots| $) + $)))) + +(MAKEPROP '|Character| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|Boolean|) |CHAR;=;2$B;1| + |CHAR;<;2$B;2| (|NonNegativeInteger|) |CHAR;size;Nni;3| + |CHAR;char;Nni$;6| (|PositiveInteger|) |CHAR;index;Pi$;4| + |CHAR;ord;$Nni;7| |CHAR;lookup;$Pi;5| |CHAR;random;$;8| + |CHAR;space;$;9| |CHAR;quote;$;10| |CHAR;escape;$;11| + (|OutputForm|) |CHAR;coerce;$Of;12| (|CharacterClass|) + (0 . |digit|) (|Character|) (4 . |member?|) + |CHAR;digit?;$B;13| (10 . |hexDigit|) + |CHAR;hexDigit?;$B;14| (14 . |upperCase|) + |CHAR;upperCase?;$B;15| (18 . |lowerCase|) + |CHAR;lowerCase?;$B;16| (22 . |alphabetic|) + |CHAR;alphabetic?;$B;17| (26 . |alphanumeric|) + |CHAR;alphanumeric?;$B;18| (|String|) |CHAR;latex;$S;19| + (|Integer|) (30 . |minIndex|) (35 . |elt|) + |CHAR;char;S$;20| |CHAR;upperCase;2$;21| + |CHAR;lowerCase;2$;22| (|SingleInteger|)) + '#(~= 41 |upperCase?| 47 |upperCase| 52 |space| 57 |size| 61 + |random| 65 |quote| 69 |ord| 73 |min| 78 |max| 84 + |lowerCase?| 90 |lowerCase| 95 |lookup| 100 |latex| 105 + |index| 110 |hexDigit?| 115 |hash| 120 |escape| 125 + |digit?| 129 |coerce| 134 |char| 139 |alphanumeric?| 149 + |alphabetic?| 154 >= 159 > 165 = 171 <= 177 < 183) + 'NIL + (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0)) + (CONS '#(NIL |OrderedSet&| NIL |SetCategory&| + |BasicType&| NIL) + (CONS '#((|OrderedFinite|) (|OrderedSet|) + (|Finite|) (|SetCategory|) (|BasicType|) + (|CoercibleTo| 20)) + (|makeByteWordVec2| 45 + '(0 22 0 23 2 22 6 24 0 25 0 22 0 27 0 + 22 0 29 0 22 0 31 0 22 0 33 0 22 0 35 + 1 37 39 0 40 2 37 24 0 39 41 2 0 6 0 + 0 1 1 0 6 0 30 1 0 0 0 43 0 0 0 17 0 + 0 9 10 0 0 0 16 0 0 0 18 1 0 9 0 14 2 + 0 0 0 0 1 2 0 0 0 0 1 1 0 6 0 32 1 0 + 0 0 44 1 0 12 0 15 1 0 37 0 38 1 0 0 + 12 13 1 0 6 0 28 1 0 45 0 1 0 0 0 19 + 1 0 6 0 26 1 0 20 0 21 1 0 0 37 42 1 + 0 0 9 11 1 0 6 0 36 1 0 6 0 34 2 0 6 + 0 0 1 2 0 6 0 0 1 2 0 6 0 0 7 2 0 6 0 + 0 1 2 0 6 0 0 8))))) + '|lookupComplete|)) + +(MAKEPROP '|Character| 'NILADIC T) diff --git a/src/algebra/strap/CLAGG-.lsp b/src/algebra/strap/CLAGG-.lsp new file mode 100644 index 00000000..0306e826 --- /dev/null +++ b/src/algebra/strap/CLAGG-.lsp @@ -0,0 +1,221 @@ + +(/VERSIONCHECK 2) + +(DEFUN |CLAGG-;#;ANni;1| (|c| $) + (LENGTH (SPADCALL |c| (QREFELT $ 9)))) + +(DEFUN |CLAGG-;count;MANni;2| (|f| |c| $) + (PROG (|x| #0=#:G1406 #1=#:G1403 #2=#:G1401 #3=#:G1402) + (RETURN + (SEQ (PROGN + (LETT #3# NIL |CLAGG-;count;MANni;2|) + (SEQ (LETT |x| NIL |CLAGG-;count;MANni;2|) + (LETT #0# (SPADCALL |c| (QREFELT $ 9)) + |CLAGG-;count;MANni;2|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |x| (CAR #0#) |CLAGG-;count;MANni;2|) + NIL)) + (GO G191))) + (SEQ (EXIT (COND + ((SPADCALL |x| |f|) + (PROGN + (LETT #1# 1 |CLAGG-;count;MANni;2|) + (COND + (#3# + (LETT #2# (+ #2# #1#) + |CLAGG-;count;MANni;2|)) + ('T + (PROGN + (LETT #2# #1# + |CLAGG-;count;MANni;2|) + (LETT #3# 'T + |CLAGG-;count;MANni;2|))))))))) + (LETT #0# (CDR #0#) |CLAGG-;count;MANni;2|) (GO G190) + G191 (EXIT NIL)) + (COND (#3# #2#) ('T 0))))))) + +(DEFUN |CLAGG-;any?;MAB;3| (|f| |c| $) + (PROG (|x| #0=#:G1411 #1=#:G1409 #2=#:G1407 #3=#:G1408) + (RETURN + (SEQ (PROGN + (LETT #3# NIL |CLAGG-;any?;MAB;3|) + (SEQ (LETT |x| NIL |CLAGG-;any?;MAB;3|) + (LETT #0# (SPADCALL |c| (QREFELT $ 9)) + |CLAGG-;any?;MAB;3|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |x| (CAR #0#) |CLAGG-;any?;MAB;3|) + NIL)) + (GO G191))) + (SEQ (EXIT (PROGN + (LETT #1# (SPADCALL |x| |f|) + |CLAGG-;any?;MAB;3|) + (COND + (#3# (LETT #2# + (COND (#2# 'T) ('T #1#)) + |CLAGG-;any?;MAB;3|)) + ('T + (PROGN + (LETT #2# #1# |CLAGG-;any?;MAB;3|) + (LETT #3# 'T |CLAGG-;any?;MAB;3|))))))) + (LETT #0# (CDR #0#) |CLAGG-;any?;MAB;3|) (GO G190) + G191 (EXIT NIL)) + (COND (#3# #2#) ('T 'NIL))))))) + +(DEFUN |CLAGG-;every?;MAB;4| (|f| |c| $) + (PROG (|x| #0=#:G1416 #1=#:G1414 #2=#:G1412 #3=#:G1413) + (RETURN + (SEQ (PROGN + (LETT #3# NIL |CLAGG-;every?;MAB;4|) + (SEQ (LETT |x| NIL |CLAGG-;every?;MAB;4|) + (LETT #0# (SPADCALL |c| (QREFELT $ 9)) + |CLAGG-;every?;MAB;4|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |x| (CAR #0#) |CLAGG-;every?;MAB;4|) + NIL)) + (GO G191))) + (SEQ (EXIT (PROGN + (LETT #1# (SPADCALL |x| |f|) + |CLAGG-;every?;MAB;4|) + (COND + (#3# (LETT #2# + (COND (#2# #1#) ('T 'NIL)) + |CLAGG-;every?;MAB;4|)) + ('T + (PROGN + (LETT #2# #1# + |CLAGG-;every?;MAB;4|) + (LETT #3# 'T |CLAGG-;every?;MAB;4|))))))) + (LETT #0# (CDR #0#) |CLAGG-;every?;MAB;4|) (GO G190) + G191 (EXIT NIL)) + (COND (#3# #2#) ('T 'T))))))) + +(DEFUN |CLAGG-;find;MAU;5| (|f| |c| $) + (SPADCALL |f| (SPADCALL |c| (QREFELT $ 9)) (QREFELT $ 18))) + +(DEFUN |CLAGG-;reduce;MAS;6| (|f| |x| $) + (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 21))) + +(DEFUN |CLAGG-;reduce;MA2S;7| (|f| |x| |s| $) + (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) |s| (QREFELT $ 23))) + +(DEFUN |CLAGG-;remove;M2A;8| (|f| |x| $) + (SPADCALL (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 25)) + (QREFELT $ 26))) + +(DEFUN |CLAGG-;select;M2A;9| (|f| |x| $) + (SPADCALL (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 28)) + (QREFELT $ 26))) + +(DEFUN |CLAGG-;remove;S2A;10| (|s| |x| $) + (SPADCALL (CONS #'|CLAGG-;remove;S2A;10!0| (VECTOR $ |s|)) |x| + (QREFELT $ 31))) + +(DEFUN |CLAGG-;remove;S2A;10!0| (|#1| $$) + (SPADCALL |#1| (QREFELT $$ 1) (QREFELT (QREFELT $$ 0) 30))) + +(DEFUN |CLAGG-;reduce;MA3S;11| (|f| |x| |s1| |s2| $) + (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) |s1| |s2| (QREFELT $ 33))) + +(DEFUN |CLAGG-;removeDuplicates;2A;12| (|x| $) + (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 35)) + (QREFELT $ 26))) + +(DEFUN |Collection&| (|#1| |#2|) + (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|Collection&|)) + (LETT |dv$2| (|devaluate| |#2|) . #0#) + (LETT |dv$| (LIST '|Collection&| |dv$1| |dv$2|) . #0#) + (LETT $ (GETREFV 37) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#2| + '(|ConvertibleTo| (|InputForm|))) + (|HasCategory| |#2| '(|SetCategory|)) + (|HasAttribute| |#1| '|finiteAggregate|))) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (QSETREFV $ 7 |#2|) + (COND + ((|testBitVector| |pv$| 3) + (PROGN + (QSETREFV $ 11 + (CONS (|dispatchFunction| |CLAGG-;#;ANni;1|) $)) + (QSETREFV $ 13 + (CONS (|dispatchFunction| |CLAGG-;count;MANni;2|) $)) + (QSETREFV $ 15 + (CONS (|dispatchFunction| |CLAGG-;any?;MAB;3|) $)) + (QSETREFV $ 16 + (CONS (|dispatchFunction| |CLAGG-;every?;MAB;4|) $)) + (QSETREFV $ 19 + (CONS (|dispatchFunction| |CLAGG-;find;MAU;5|) $)) + (QSETREFV $ 22 + (CONS (|dispatchFunction| |CLAGG-;reduce;MAS;6|) $)) + (QSETREFV $ 24 + (CONS (|dispatchFunction| |CLAGG-;reduce;MA2S;7|) $)) + (QSETREFV $ 27 + (CONS (|dispatchFunction| |CLAGG-;remove;M2A;8|) $)) + (QSETREFV $ 29 + (CONS (|dispatchFunction| |CLAGG-;select;M2A;9|) $)) + (COND + ((|testBitVector| |pv$| 2) + (PROGN + (QSETREFV $ 32 + (CONS (|dispatchFunction| |CLAGG-;remove;S2A;10|) + $)) + (QSETREFV $ 34 + (CONS (|dispatchFunction| + |CLAGG-;reduce;MA3S;11|) + $)) + (QSETREFV $ 36 + (CONS (|dispatchFunction| + |CLAGG-;removeDuplicates;2A;12|) + $)))))))) + $)))) + +(MAKEPROP '|Collection&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|List| 7) (0 . |parts|) (|NonNegativeInteger|) (5 . |#|) + (|Mapping| 14 7) (10 . |count|) (|Boolean|) (16 . |any?|) + (22 . |every?|) (|Union| 7 '"failed") (28 . |find|) + (34 . |find|) (|Mapping| 7 7 7) (40 . |reduce|) + (46 . |reduce|) (52 . |reduce|) (59 . |reduce|) + (66 . |remove|) (72 . |construct|) (77 . |remove|) + (83 . |select|) (89 . |select|) (95 . =) (101 . |remove|) + (107 . |remove|) (113 . |reduce|) (121 . |reduce|) + (129 . |removeDuplicates|) (134 . |removeDuplicates|)) + '#(|select| 139 |removeDuplicates| 145 |remove| 150 |reduce| + 162 |find| 183 |every?| 189 |count| 195 |any?| 201 |#| + 207) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 36 + '(1 6 8 0 9 1 0 10 0 11 2 0 10 12 0 13 + 2 0 14 12 0 15 2 0 14 12 0 16 2 8 17 + 12 0 18 2 0 17 12 0 19 2 8 7 20 0 21 + 2 0 7 20 0 22 3 8 7 20 0 7 23 3 0 7 + 20 0 7 24 2 8 0 12 0 25 1 6 0 8 26 2 + 0 0 12 0 27 2 8 0 12 0 28 2 0 0 12 0 + 29 2 7 14 0 0 30 2 6 0 12 0 31 2 0 0 + 7 0 32 4 8 7 20 0 7 7 33 4 0 7 20 0 7 + 7 34 1 8 0 0 35 1 0 0 0 36 2 0 0 12 0 + 29 1 0 0 0 36 2 0 0 7 0 32 2 0 0 12 0 + 27 4 0 7 20 0 7 7 34 3 0 7 20 0 7 24 + 2 0 7 20 0 22 2 0 17 12 0 19 2 0 14 + 12 0 16 2 0 10 12 0 13 2 0 14 12 0 15 + 1 0 10 0 11))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/CLAGG.lsp b/src/algebra/strap/CLAGG.lsp new file mode 100644 index 00000000..eb1fd581 --- /dev/null +++ b/src/algebra/strap/CLAGG.lsp @@ -0,0 +1,104 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |Collection;CAT| 'NIL) + +(DEFPARAMETER |Collection;AL| 'NIL) + +(DEFUN |Collection| (#0=#:G1398) + (LET (#1=#:G1399) + (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#)))) + +(DEFUN |Collection;| (|t#1|) + (PROG (#0=#:G1397) + (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#) + (SETELT #0# 0 (LIST '|Collection| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/COMRING.lsp b/src/algebra/strap/COMRING.lsp new file mode 100644 index 00000000..fc0f6ace --- /dev/null +++ b/src/algebra/strap/COMRING.lsp @@ -0,0 +1,22 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |CommutativeRing;AL| 'NIL) + +(DEFUN |CommutativeRing| () + (LET (#:G1387) + (COND + (|CommutativeRing;AL|) + (T (SETQ |CommutativeRing;AL| (|CommutativeRing;|)))))) + +(DEFUN |CommutativeRing;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# + (|Join| (|Ring|) (|BiModule| '$ '$) + (|mkCategory| '|package| NIL + '(((|commutative| "*") T)) 'NIL NIL)) + |CommutativeRing|) + (SETELT #0# 0 '(|CommutativeRing|)))))) + +(MAKEPROP '|CommutativeRing| 'NILADIC T) diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp new file mode 100644 index 00000000..84f447f4 --- /dev/null +++ b/src/algebra/strap/DFLOAT.lsp @@ -0,0 +1,872 @@ + +(/VERSIONCHECK 2) + +(DEFUN |DFLOAT;doubleFloatFormat;2S;1| (|s| $) + (PROG (|ss|) + (RETURN + (SEQ (LETT |ss| (|getShellEntry| $ 6) + |DFLOAT;doubleFloatFormat;2S;1|) + (SETELT $ 6 |s|) (EXIT |ss|))))) + +(DEFUN |DFLOAT;OMwrite;$S;2| (|x| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |DFLOAT;OMwrite;$S;2|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |DFLOAT;OMwrite;$S;2|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 10)) + (|getShellEntry| $ 12)) + |DFLOAT;OMwrite;$S;2|) + (SPADCALL |dev| (|getShellEntry| $ 14)) + (SPADCALL |dev| |x| (|getShellEntry| $ 16)) + (SPADCALL |dev| (|getShellEntry| $ 17)) + (SPADCALL |dev| (|getShellEntry| $ 18)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |DFLOAT;OMwrite;$S;2|) + (EXIT |s|))))) + +(DEFUN |DFLOAT;OMwrite;$BS;3| (|x| |wholeObj| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |DFLOAT;OMwrite;$BS;3|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) + |DFLOAT;OMwrite;$BS;3|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 10)) + (|getShellEntry| $ 12)) + |DFLOAT;OMwrite;$BS;3|) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 14)))) + (SPADCALL |dev| |x| (|getShellEntry| $ 16)) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 17)))) + (SPADCALL |dev| (|getShellEntry| $ 18)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) + |DFLOAT;OMwrite;$BS;3|) + (EXIT |s|))))) + +(DEFUN |DFLOAT;OMwrite;Omd$V;4| (|dev| |x| $) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 14)) + (SPADCALL |dev| |x| (|getShellEntry| $ 16)) + (EXIT (SPADCALL |dev| (|getShellEntry| $ 17))))) + +(DEFUN |DFLOAT;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 14)))) + (SPADCALL |dev| |x| (|getShellEntry| $ 16)) + (EXIT (COND + (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 17))))))) + +(PUT '|DFLOAT;checkComplex| '|SPADreplace| 'C-TO-R) + +(DEFUN |DFLOAT;checkComplex| (|x| $) (C-TO-R |x|)) + +(PUT '|DFLOAT;base;Pi;7| '|SPADreplace| '(XLAM NIL (FLOAT-RADIX 0.0))) + +(DEFUN |DFLOAT;base;Pi;7| ($) (FLOAT-RADIX 0.0)) + +(DEFUN |DFLOAT;mantissa;$I;8| (|x| $) (QCAR (|DFLOAT;manexp| |x| $))) + +(DEFUN |DFLOAT;exponent;$I;9| (|x| $) (QCDR (|DFLOAT;manexp| |x| $))) + +(PUT '|DFLOAT;precision;Pi;10| '|SPADreplace| + '(XLAM NIL (FLOAT-DIGITS 0.0))) + +(DEFUN |DFLOAT;precision;Pi;10| ($) (FLOAT-DIGITS 0.0)) + +(DEFUN |DFLOAT;bits;Pi;11| ($) + (PROG (#0=#:G1419) + (RETURN + (COND + ((EQL (FLOAT-RADIX 0.0) 2) (FLOAT-DIGITS 0.0)) + ((EQL (FLOAT-RADIX 0.0) 16) (* 4 (FLOAT-DIGITS 0.0))) + ('T + (PROG1 (LETT #0# + (FIX (SPADCALL (FLOAT-DIGITS 0.0) + (SPADCALL + (FLOAT (FLOAT-RADIX 0.0) + MOST-POSITIVE-LONG-FLOAT) + (|getShellEntry| $ 30)) + (|getShellEntry| $ 31))) + |DFLOAT;bits;Pi;11|) + (|check-subtype| (> #0# 0) '(|PositiveInteger|) #0#))))))) + +(PUT '|DFLOAT;max;$;12| '|SPADreplace| + '(XLAM NIL MOST-POSITIVE-LONG-FLOAT)) + +(DEFUN |DFLOAT;max;$;12| ($) MOST-POSITIVE-LONG-FLOAT) + +(PUT '|DFLOAT;min;$;13| '|SPADreplace| + '(XLAM NIL MOST-NEGATIVE-LONG-FLOAT)) + +(DEFUN |DFLOAT;min;$;13| ($) MOST-NEGATIVE-LONG-FLOAT) + +(DEFUN |DFLOAT;order;$I;14| (|a| $) + (- (+ (FLOAT-DIGITS 0.0) (SPADCALL |a| (|getShellEntry| $ 28))) 1)) + +(PUT '|DFLOAT;Zero;$;15| '|SPADreplace| + '(XLAM NIL (FLOAT 0 MOST-POSITIVE-LONG-FLOAT))) + +(DEFUN |DFLOAT;Zero;$;15| ($) (FLOAT 0 MOST-POSITIVE-LONG-FLOAT)) + +(PUT '|DFLOAT;One;$;16| '|SPADreplace| + '(XLAM NIL (FLOAT 1 MOST-POSITIVE-LONG-FLOAT))) + +(DEFUN |DFLOAT;One;$;16| ($) (FLOAT 1 MOST-POSITIVE-LONG-FLOAT)) + +(DEFUN |DFLOAT;exp1;$;17| ($) + (/ (FLOAT 534625820200 MOST-POSITIVE-LONG-FLOAT) + (FLOAT 196677847971 MOST-POSITIVE-LONG-FLOAT))) + +(PUT '|DFLOAT;pi;$;18| '|SPADreplace| '(XLAM NIL PI)) + +(DEFUN |DFLOAT;pi;$;18| ($) PI) + +(DEFUN |DFLOAT;coerce;$Of;19| (|x| $) + (SPADCALL (FORMAT NIL (|getShellEntry| $ 6) |x|) + (|getShellEntry| $ 41))) + +(DEFUN |DFLOAT;convert;$If;20| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 44))) + +(PUT '|DFLOAT;<;2$B;21| '|SPADreplace| '<) + +(DEFUN |DFLOAT;<;2$B;21| (|x| |y| $) (< |x| |y|)) + +(PUT '|DFLOAT;-;2$;22| '|SPADreplace| '-) + +(DEFUN |DFLOAT;-;2$;22| (|x| $) (- |x|)) + +(PUT '|DFLOAT;+;3$;23| '|SPADreplace| '+) + +(DEFUN |DFLOAT;+;3$;23| (|x| |y| $) (+ |x| |y|)) + +(PUT '|DFLOAT;-;3$;24| '|SPADreplace| '-) + +(DEFUN |DFLOAT;-;3$;24| (|x| |y| $) (- |x| |y|)) + +(PUT '|DFLOAT;*;3$;25| '|SPADreplace| '*) + +(DEFUN |DFLOAT;*;3$;25| (|x| |y| $) (* |x| |y|)) + +(PUT '|DFLOAT;*;I2$;26| '|SPADreplace| '*) + +(DEFUN |DFLOAT;*;I2$;26| (|i| |x| $) (* |i| |x|)) + +(PUT '|DFLOAT;max;3$;27| '|SPADreplace| 'MAX) + +(DEFUN |DFLOAT;max;3$;27| (|x| |y| $) (MAX |x| |y|)) + +(PUT '|DFLOAT;min;3$;28| '|SPADreplace| 'MIN) + +(DEFUN |DFLOAT;min;3$;28| (|x| |y| $) (MIN |x| |y|)) + +(PUT '|DFLOAT;=;2$B;29| '|SPADreplace| '=) + +(DEFUN |DFLOAT;=;2$B;29| (|x| |y| $) (= |x| |y|)) + +(PUT '|DFLOAT;/;$I$;30| '|SPADreplace| '/) + +(DEFUN |DFLOAT;/;$I$;30| (|x| |i| $) (/ |x| |i|)) + +(DEFUN |DFLOAT;sqrt;2$;31| (|x| $) + (|DFLOAT;checkComplex| (SQRT |x|) $)) + +(DEFUN |DFLOAT;log10;2$;32| (|x| $) + (|DFLOAT;checkComplex| (|log| |x|) $)) + +(PUT '|DFLOAT;**;$I$;33| '|SPADreplace| 'EXPT) + +(DEFUN |DFLOAT;**;$I$;33| (|x| |i| $) (EXPT |x| |i|)) + +(DEFUN |DFLOAT;**;3$;34| (|x| |y| $) + (|DFLOAT;checkComplex| (EXPT |x| |y|) $)) + +(PUT '|DFLOAT;coerce;I$;35| '|SPADreplace| + '(XLAM (|i|) (FLOAT |i| MOST-POSITIVE-LONG-FLOAT))) + +(DEFUN |DFLOAT;coerce;I$;35| (|i| $) + (FLOAT |i| MOST-POSITIVE-LONG-FLOAT)) + +(PUT '|DFLOAT;exp;2$;36| '|SPADreplace| 'EXP) + +(DEFUN |DFLOAT;exp;2$;36| (|x| $) (EXP |x|)) + +(DEFUN |DFLOAT;log;2$;37| (|x| $) (|DFLOAT;checkComplex| (LN |x|) $)) + +(DEFUN |DFLOAT;log2;2$;38| (|x| $) + (|DFLOAT;checkComplex| (LOG2 |x|) $)) + +(PUT '|DFLOAT;sin;2$;39| '|SPADreplace| 'SIN) + +(DEFUN |DFLOAT;sin;2$;39| (|x| $) (SIN |x|)) + +(PUT '|DFLOAT;cos;2$;40| '|SPADreplace| 'COS) + +(DEFUN |DFLOAT;cos;2$;40| (|x| $) (COS |x|)) + +(PUT '|DFLOAT;tan;2$;41| '|SPADreplace| 'TAN) + +(DEFUN |DFLOAT;tan;2$;41| (|x| $) (TAN |x|)) + +(PUT '|DFLOAT;cot;2$;42| '|SPADreplace| 'COT) + +(DEFUN |DFLOAT;cot;2$;42| (|x| $) (COT |x|)) + +(PUT '|DFLOAT;sec;2$;43| '|SPADreplace| 'SEC) + +(DEFUN |DFLOAT;sec;2$;43| (|x| $) (SEC |x|)) + +(PUT '|DFLOAT;csc;2$;44| '|SPADreplace| 'CSC) + +(DEFUN |DFLOAT;csc;2$;44| (|x| $) (CSC |x|)) + +(DEFUN |DFLOAT;asin;2$;45| (|x| $) + (|DFLOAT;checkComplex| (ASIN |x|) $)) + +(DEFUN |DFLOAT;acos;2$;46| (|x| $) + (|DFLOAT;checkComplex| (ACOS |x|) $)) + +(PUT '|DFLOAT;atan;2$;47| '|SPADreplace| 'ATAN) + +(DEFUN |DFLOAT;atan;2$;47| (|x| $) (ATAN |x|)) + +(DEFUN |DFLOAT;acsc;2$;48| (|x| $) + (|DFLOAT;checkComplex| (ACSC |x|) $)) + +(PUT '|DFLOAT;acot;2$;49| '|SPADreplace| 'ACOT) + +(DEFUN |DFLOAT;acot;2$;49| (|x| $) (ACOT |x|)) + +(DEFUN |DFLOAT;asec;2$;50| (|x| $) + (|DFLOAT;checkComplex| (ASEC |x|) $)) + +(PUT '|DFLOAT;sinh;2$;51| '|SPADreplace| 'SINH) + +(DEFUN |DFLOAT;sinh;2$;51| (|x| $) (SINH |x|)) + +(PUT '|DFLOAT;cosh;2$;52| '|SPADreplace| 'COSH) + +(DEFUN |DFLOAT;cosh;2$;52| (|x| $) (COSH |x|)) + +(PUT '|DFLOAT;tanh;2$;53| '|SPADreplace| 'TANH) + +(DEFUN |DFLOAT;tanh;2$;53| (|x| $) (TANH |x|)) + +(PUT '|DFLOAT;csch;2$;54| '|SPADreplace| 'CSCH) + +(DEFUN |DFLOAT;csch;2$;54| (|x| $) (CSCH |x|)) + +(PUT '|DFLOAT;coth;2$;55| '|SPADreplace| 'COTH) + +(DEFUN |DFLOAT;coth;2$;55| (|x| $) (COTH |x|)) + +(PUT '|DFLOAT;sech;2$;56| '|SPADreplace| 'SECH) + +(DEFUN |DFLOAT;sech;2$;56| (|x| $) (SECH |x|)) + +(PUT '|DFLOAT;asinh;2$;57| '|SPADreplace| 'ASINH) + +(DEFUN |DFLOAT;asinh;2$;57| (|x| $) (ASINH |x|)) + +(DEFUN |DFLOAT;acosh;2$;58| (|x| $) + (|DFLOAT;checkComplex| (ACOSH |x|) $)) + +(DEFUN |DFLOAT;atanh;2$;59| (|x| $) + (|DFLOAT;checkComplex| (ATANH |x|) $)) + +(PUT '|DFLOAT;acsch;2$;60| '|SPADreplace| 'ACSCH) + +(DEFUN |DFLOAT;acsch;2$;60| (|x| $) (ACSCH |x|)) + +(DEFUN |DFLOAT;acoth;2$;61| (|x| $) + (|DFLOAT;checkComplex| (ACOTH |x|) $)) + +(DEFUN |DFLOAT;asech;2$;62| (|x| $) + (|DFLOAT;checkComplex| (ASECH |x|) $)) + +(PUT '|DFLOAT;/;3$;63| '|SPADreplace| '/) + +(DEFUN |DFLOAT;/;3$;63| (|x| |y| $) (/ |x| |y|)) + +(PUT '|DFLOAT;negative?;$B;64| '|SPADreplace| 'MINUSP) + +(DEFUN |DFLOAT;negative?;$B;64| (|x| $) (MINUSP |x|)) + +(PUT '|DFLOAT;zero?;$B;65| '|SPADreplace| 'ZEROP) + +(DEFUN |DFLOAT;zero?;$B;65| (|x| $) (ZEROP |x|)) + +(PUT '|DFLOAT;hash;$I;66| '|SPADreplace| 'HASHEQ) + +(DEFUN |DFLOAT;hash;$I;66| (|x| $) (HASHEQ |x|)) + +(DEFUN |DFLOAT;recip;$U;67| (|x| $) + (COND ((ZEROP |x|) (CONS 1 "failed")) ('T (CONS 0 (/ 1.0 |x|))))) + +(PUT '|DFLOAT;differentiate;2$;68| '|SPADreplace| '(XLAM (|x|) 0.0)) + +(DEFUN |DFLOAT;differentiate;2$;68| (|x| $) 0.0) + +(DEFUN |DFLOAT;Gamma;2$;69| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 95))) + +(DEFUN |DFLOAT;Beta;3$;70| (|x| |y| $) + (SPADCALL |x| |y| (|getShellEntry| $ 97))) + +(PUT '|DFLOAT;wholePart;$I;71| '|SPADreplace| 'FIX) + +(DEFUN |DFLOAT;wholePart;$I;71| (|x| $) (FIX |x|)) + +(DEFUN |DFLOAT;float;2IPi$;72| (|ma| |ex| |b| $) + (* |ma| (EXPT (FLOAT |b| MOST-POSITIVE-LONG-FLOAT) |ex|))) + +(PUT '|DFLOAT;convert;$Df;73| '|SPADreplace| '(XLAM (|x|) |x|)) + +(DEFUN |DFLOAT;convert;$Df;73| (|x| $) |x|) + +(DEFUN |DFLOAT;convert;$F;74| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 103))) + +(DEFUN |DFLOAT;rationalApproximation;$NniF;75| (|x| |d| $) + (SPADCALL |x| |d| 10 (|getShellEntry| $ 107))) + +(DEFUN |DFLOAT;atan;3$;76| (|x| |y| $) + (PROG (|theta|) + (RETURN + (SEQ (COND + ((= |x| 0.0) + (COND + ((< 0.0 |y|) (/ PI 2)) + ((< |y| 0.0) (- (/ PI 2))) + ('T 0.0))) + ('T + (SEQ (LETT |theta| (ATAN (FLOAT-SIGN 1.0 (/ |y| |x|))) + |DFLOAT;atan;3$;76|) + (COND + ((< |x| 0.0) + (LETT |theta| (- PI |theta|) |DFLOAT;atan;3$;76|))) + (COND + ((< |y| 0.0) + (LETT |theta| (- |theta|) |DFLOAT;atan;3$;76|))) + (EXIT |theta|)))))))) + +(DEFUN |DFLOAT;retract;$F;77| (|x| $) + (PROG (#0=#:G1494) + (RETURN + (SPADCALL |x| + (PROG1 (LETT #0# (- (FLOAT-DIGITS 0.0) 1) + |DFLOAT;retract;$F;77|) + (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)) + (FLOAT-RADIX 0.0) (|getShellEntry| $ 107))))) + +(DEFUN |DFLOAT;retractIfCan;$U;78| (|x| $) + (PROG (#0=#:G1499) + (RETURN + (CONS 0 + (SPADCALL |x| + (PROG1 (LETT #0# (- (FLOAT-DIGITS 0.0) 1) + |DFLOAT;retractIfCan;$U;78|) + (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) + #0#)) + (FLOAT-RADIX 0.0) (|getShellEntry| $ 107)))))) + +(DEFUN |DFLOAT;retract;$I;79| (|x| $) + (PROG (|n|) + (RETURN + (SEQ (LETT |n| (FIX |x|) |DFLOAT;retract;$I;79|) + (EXIT (COND + ((= |x| (FLOAT |n| MOST-POSITIVE-LONG-FLOAT)) |n|) + ('T (|error| "Not an integer")))))))) + +(DEFUN |DFLOAT;retractIfCan;$U;80| (|x| $) + (PROG (|n|) + (RETURN + (SEQ (LETT |n| (FIX |x|) |DFLOAT;retractIfCan;$U;80|) + (EXIT (COND + ((= |x| (FLOAT |n| MOST-POSITIVE-LONG-FLOAT)) + (CONS 0 |n|)) + ('T (CONS 1 "failed")))))))) + +(DEFUN |DFLOAT;sign;$I;81| (|x| $) + (SPADCALL (FLOAT-SIGN |x| 1.0) (|getShellEntry| $ 113))) + +(PUT '|DFLOAT;abs;2$;82| '|SPADreplace| + '(XLAM (|x|) (FLOAT-SIGN 1.0 |x|))) + +(DEFUN |DFLOAT;abs;2$;82| (|x| $) (FLOAT-SIGN 1.0 |x|)) + +(DEFUN |DFLOAT;manexp| (|x| $) + (PROG (|s| #0=#:G1520 |me| |two53|) + (RETURN + (SEQ (EXIT (COND + ((ZEROP |x|) (CONS 0 0)) + ('T + (SEQ (LETT |s| + (SPADCALL |x| (|getShellEntry| $ 116)) + |DFLOAT;manexp|) + (LETT |x| (FLOAT-SIGN 1.0 |x|) + |DFLOAT;manexp|) + (COND + ((< MOST-POSITIVE-LONG-FLOAT |x|) + (PROGN + (LETT #0# + (CONS + (+ + (* |s| + (SPADCALL + MOST-POSITIVE-LONG-FLOAT + (|getShellEntry| $ 27))) + 1) + (SPADCALL MOST-POSITIVE-LONG-FLOAT + (|getShellEntry| $ 28))) + |DFLOAT;manexp|) + (GO #0#)))) + (LETT |me| (MANEXP |x|) |DFLOAT;manexp|) + (LETT |two53| + (EXPT (FLOAT-RADIX 0.0) + (FLOAT-DIGITS 0.0)) + |DFLOAT;manexp|) + (EXIT (CONS (* |s| + (FIX (* |two53| (QCAR |me|)))) + (- (QCDR |me|) (FLOAT-DIGITS 0.0)))))))) + #0# (EXIT #0#))))) + +(DEFUN |DFLOAT;rationalApproximation;$2NniF;84| (|f| |d| |b| $) + (PROG (|#G103| |nu| |ex| BASE #0=#:G1523 |de| |tol| |#G104| |q| |r| + |p2| |q2| #1=#:G1541 |#G105| |#G106| |p0| |p1| |#G107| + |#G108| |q0| |q1| |#G109| |#G110| |s| |t| #2=#:G1539) + (RETURN + (SEQ (EXIT (SEQ (PROGN + (LETT |#G103| (|DFLOAT;manexp| |f| $) + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |nu| (QCAR |#G103|) + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |ex| (QCDR |#G103|) + |DFLOAT;rationalApproximation;$2NniF;84|) + |#G103|) + (LETT BASE (FLOAT-RADIX 0.0) + |DFLOAT;rationalApproximation;$2NniF;84|) + (EXIT (COND + ((< |ex| 0) + (SEQ (LETT |de| + (EXPT BASE + (PROG1 + (LETT #0# (- |ex|) + |DFLOAT;rationalApproximation;$2NniF;84|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#))) + |DFLOAT;rationalApproximation;$2NniF;84|) + (EXIT + (COND + ((< |b| 2) + (|error| "base must be > 1")) + ('T + (SEQ + (LETT |tol| (EXPT |b| |d|) + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |s| |nu| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |t| |de| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |p0| 0 + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |p1| 1 + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |q0| 1 + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |q1| 0 + |DFLOAT;rationalApproximation;$2NniF;84|) + (EXIT + (SEQ G190 NIL + (SEQ + (PROGN + (LETT |#G104| + (DIVIDE2 |s| |t|) + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |q| (QCAR |#G104|) + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |r| (QCDR |#G104|) + |DFLOAT;rationalApproximation;$2NniF;84|) + |#G104|) + (LETT |p2| + (+ (* |q| |p1|) |p0|) + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |q2| + (+ (* |q| |q1|) |q0|) + |DFLOAT;rationalApproximation;$2NniF;84|) + (COND + ((OR (EQL |r| 0) + (< + (SPADCALL |tol| + (ABS + (- (* |nu| |q2|) + (* |de| |p2|))) + (|getShellEntry| $ + 120)) + (* |de| (ABS |p2|)))) + (EXIT + (PROGN + (LETT #1# + (SPADCALL |p2| |q2| + (|getShellEntry| $ + 119)) + |DFLOAT;rationalApproximation;$2NniF;84|) + (GO #1#))))) + (PROGN + (LETT |#G105| |p1| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |#G106| |p2| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |p0| |#G105| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |p1| |#G106| + |DFLOAT;rationalApproximation;$2NniF;84|)) + (PROGN + (LETT |#G107| |q1| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |#G108| |q2| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |q0| |#G107| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |q1| |#G108| + |DFLOAT;rationalApproximation;$2NniF;84|)) + (EXIT + (PROGN + (LETT |#G109| |t| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |#G110| |r| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |s| |#G109| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |t| |#G110| + |DFLOAT;rationalApproximation;$2NniF;84|)))) + NIL (GO G190) G191 + (EXIT NIL))))))))) + ('T + (SPADCALL + (* |nu| + (EXPT BASE + (PROG1 + (LETT #2# |ex| + |DFLOAT;rationalApproximation;$2NniF;84|) + (|check-subtype| (>= #2# 0) + '(|NonNegativeInteger|) #2#)))) + (|getShellEntry| $ 121))))))) + #1# (EXIT #1#))))) + +(DEFUN |DFLOAT;**;$F$;85| (|x| |r| $) + (PROG (|n| |d| #0=#:G1550) + (RETURN + (SEQ (EXIT (COND + ((ZEROP |x|) + (COND + ((SPADCALL |r| (|getShellEntry| $ 122)) + (|error| "0**0 is undefined")) + ((SPADCALL |r| (|getShellEntry| $ 123)) + (|error| "division by 0")) + ('T 0.0))) + ((OR (SPADCALL |r| (|getShellEntry| $ 122)) + (= |x| 1.0)) + 1.0) + ('T + (COND + ((SPADCALL |r| (|spadConstant| $ 124) + (|getShellEntry| $ 125)) + |x|) + ('T + (SEQ (LETT |n| + (SPADCALL |r| + (|getShellEntry| $ 126)) + |DFLOAT;**;$F$;85|) + (LETT |d| + (SPADCALL |r| + (|getShellEntry| $ 127)) + |DFLOAT;**;$F$;85|) + (EXIT (COND + ((MINUSP |x|) + (COND + ((ODDP |d|) + (COND + ((ODDP |n|) + (PROGN + (LETT #0# + (- + (SPADCALL (- |x|) |r| + (|getShellEntry| $ 128))) + |DFLOAT;**;$F$;85|) + (GO #0#))) + ('T + (PROGN + (LETT #0# + (SPADCALL (- |x|) |r| + (|getShellEntry| $ 128)) + |DFLOAT;**;$F$;85|) + (GO #0#))))) + ('T (|error| "negative root")))) + ((EQL |d| 2) + (EXPT + (SPADCALL |x| + (|getShellEntry| $ 56)) + |n|)) + ('T + (SPADCALL |x| + (/ + (FLOAT |n| + MOST-POSITIVE-LONG-FLOAT) + (FLOAT |d| + MOST-POSITIVE-LONG-FLOAT)) + (|getShellEntry| $ 59))))))))))) + #0# (EXIT #0#))))) + +(DEFUN |DoubleFloat| () + (PROG () + (RETURN + (PROG (#0=#:G1563) + (RETURN + (COND + ((LETT #0# (HGET |$ConstructorCache| '|DoubleFloat|) + |DoubleFloat|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|DoubleFloat| + (LIST + (CONS NIL + (CONS 1 (|DoubleFloat;|)))))) + (LETT #0# T |DoubleFloat|)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|DoubleFloat|))))))))))) + +(DEFUN |DoubleFloat;| () + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| '(|DoubleFloat|) . #0=(|DoubleFloat|)) + (LETT $ (|newShell| 142) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| '|DoubleFloat| NIL (CONS 1 $)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 "~G") + $)))) + +(MAKEPROP '|DoubleFloat| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL '|format| (|String|) + |DFLOAT;doubleFloatFormat;2S;1| (|OpenMathEncoding|) + (0 . |OMencodingXML|) (|OpenMathDevice|) + (4 . |OMopenString|) (|Void|) (10 . |OMputObject|) + (|DoubleFloat|) (15 . |OMputFloat|) + (21 . |OMputEndObject|) (26 . |OMclose|) + |DFLOAT;OMwrite;$S;2| (|Boolean|) |DFLOAT;OMwrite;$BS;3| + |DFLOAT;OMwrite;Omd$V;4| |DFLOAT;OMwrite;Omd$BV;5| + (|PositiveInteger|) |DFLOAT;base;Pi;7| (|Integer|) + |DFLOAT;mantissa;$I;8| |DFLOAT;exponent;$I;9| + |DFLOAT;precision;Pi;10| |DFLOAT;log2;2$;38| (31 . *) + |DFLOAT;bits;Pi;11| |DFLOAT;max;$;12| |DFLOAT;min;$;13| + |DFLOAT;order;$I;14| + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |DFLOAT;Zero;$;15|) $)) + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |DFLOAT;One;$;16|) $)) + |DFLOAT;exp1;$;17| |DFLOAT;pi;$;18| (|OutputForm|) + (37 . |outputForm|) |DFLOAT;coerce;$Of;19| (|InputForm|) + (42 . |convert|) |DFLOAT;convert;$If;20| |DFLOAT;<;2$B;21| + |DFLOAT;-;2$;22| |DFLOAT;+;3$;23| |DFLOAT;-;3$;24| + |DFLOAT;*;3$;25| |DFLOAT;*;I2$;26| |DFLOAT;max;3$;27| + |DFLOAT;min;3$;28| |DFLOAT;=;2$B;29| |DFLOAT;/;$I$;30| + |DFLOAT;sqrt;2$;31| |DFLOAT;log10;2$;32| + |DFLOAT;**;$I$;33| |DFLOAT;**;3$;34| |DFLOAT;coerce;I$;35| + |DFLOAT;exp;2$;36| |DFLOAT;log;2$;37| |DFLOAT;sin;2$;39| + |DFLOAT;cos;2$;40| |DFLOAT;tan;2$;41| |DFLOAT;cot;2$;42| + |DFLOAT;sec;2$;43| |DFLOAT;csc;2$;44| |DFLOAT;asin;2$;45| + |DFLOAT;acos;2$;46| |DFLOAT;atan;2$;47| + |DFLOAT;acsc;2$;48| |DFLOAT;acot;2$;49| + |DFLOAT;asec;2$;50| |DFLOAT;sinh;2$;51| + |DFLOAT;cosh;2$;52| |DFLOAT;tanh;2$;53| + |DFLOAT;csch;2$;54| |DFLOAT;coth;2$;55| + |DFLOAT;sech;2$;56| |DFLOAT;asinh;2$;57| + |DFLOAT;acosh;2$;58| |DFLOAT;atanh;2$;59| + |DFLOAT;acsch;2$;60| |DFLOAT;acoth;2$;61| + |DFLOAT;asech;2$;62| |DFLOAT;/;3$;63| + |DFLOAT;negative?;$B;64| |DFLOAT;zero?;$B;65| + |DFLOAT;hash;$I;66| (|Union| $ '"failed") + |DFLOAT;recip;$U;67| |DFLOAT;differentiate;2$;68| + (|DoubleFloatSpecialFunctions|) (47 . |Gamma|) + |DFLOAT;Gamma;2$;69| (52 . |Beta|) |DFLOAT;Beta;3$;70| + |DFLOAT;wholePart;$I;71| |DFLOAT;float;2IPi$;72| + |DFLOAT;convert;$Df;73| (|Float|) (58 . |convert|) + |DFLOAT;convert;$F;74| (|Fraction| 26) + (|NonNegativeInteger|) + |DFLOAT;rationalApproximation;$2NniF;84| + |DFLOAT;rationalApproximation;$NniF;75| + |DFLOAT;atan;3$;76| |DFLOAT;retract;$F;77| + (|Union| 105 '"failed") |DFLOAT;retractIfCan;$U;78| + |DFLOAT;retract;$I;79| (|Union| 26 '"failed") + |DFLOAT;retractIfCan;$U;80| |DFLOAT;sign;$I;81| + |DFLOAT;abs;2$;82| (63 . |Zero|) (67 . /) (73 . *) + (79 . |coerce|) (84 . |zero?|) (89 . |negative?|) + (94 . |One|) (98 . =) (104 . |numer|) (109 . |denom|) + |DFLOAT;**;$F$;85| (|PatternMatchResult| 102 $) + (|Pattern| 102) (|Factored| $) (|List| $) + (|Union| 132 '"failed") + (|Record| (|:| |coef1| $) (|:| |coef2| $) + (|:| |generator| $)) + (|Record| (|:| |coef1| $) (|:| |coef2| $)) + (|Union| 135 '"failed") + (|Record| (|:| |quotient| $) (|:| |remainder| $)) + (|Record| (|:| |coef| 132) (|:| |generator| $)) + (|SparseUnivariatePolynomial| $) + (|Record| (|:| |unit| $) (|:| |canonical| $) + (|:| |associate| $)) + (|SingleInteger|)) + '#(~= 114 |zero?| 120 |wholePart| 125 |unitNormal| 130 + |unitCanonical| 135 |unit?| 140 |truncate| 145 |tanh| 150 + |tan| 155 |subtractIfCan| 160 |squareFreePart| 166 + |squareFree| 171 |sqrt| 176 |sizeLess?| 181 |sinh| 187 + |sin| 192 |sign| 197 |sech| 202 |sec| 207 |sample| 212 + |round| 216 |retractIfCan| 221 |retract| 231 |rem| 241 + |recip| 247 |rationalApproximation| 252 |quo| 265 + |principalIdeal| 271 |prime?| 276 |precision| 281 + |positive?| 285 |pi| 290 |patternMatch| 294 |order| 301 + |one?| 306 |nthRoot| 311 |norm| 317 |negative?| 322 + |multiEuclidean| 327 |min| 333 |max| 343 |mantissa| 353 + |log2| 358 |log10| 363 |log| 368 |lcm| 373 |latex| 384 + |inv| 389 |hash| 394 |gcdPolynomial| 404 |gcd| 410 + |fractionPart| 421 |floor| 426 |float| 431 |factor| 444 + |extendedEuclidean| 449 |exquo| 462 |expressIdealMember| + 468 |exponent| 474 |exp1| 479 |exp| 483 |euclideanSize| + 488 |doubleFloatFormat| 493 |divide| 498 |digits| 504 + |differentiate| 508 |csch| 519 |csc| 524 |coth| 529 |cot| + 534 |cosh| 539 |cos| 544 |convert| 549 |coerce| 569 + |characteristic| 599 |ceiling| 603 |bits| 608 |base| 612 + |atanh| 616 |atan| 621 |associates?| 632 |asinh| 638 + |asin| 643 |asech| 648 |asec| 653 |acsch| 658 |acsc| 663 + |acoth| 668 |acot| 673 |acosh| 678 |acos| 683 |abs| 688 ^ + 693 |Zero| 711 |One| 715 |OMwrite| 719 |Gamma| 743 D 748 + |Beta| 759 >= 765 > 771 = 777 <= 783 < 789 / 795 - 807 + + 818 ** 824 * 854) + '((|approximate| . 0) (|canonicalsClosed| . 0) + (|canonicalUnitNormal| . 0) (|noZeroDivisors| . 0) + ((|commutative| "*") . 0) (|rightUnitary| . 0) + (|leftUnitary| . 0) (|unitsKnown| . 0)) + (CONS (|makeByteWordVec2| 1 + '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0)) + (CONS '#(|FloatingPointSystem&| |RealNumberSystem&| + |Field&| |EuclideanDomain&| NIL + |UniqueFactorizationDomain&| |GcdDomain&| + |DivisionRing&| |IntegralDomain&| |Algebra&| + |Algebra&| |DifferentialRing&| NIL + |OrderedRing&| |Module&| NIL NIL |Module&| NIL + NIL NIL |Ring&| NIL NIL NIL NIL NIL NIL NIL + |AbelianGroup&| NIL NIL |AbelianMonoid&| + |Monoid&| NIL |OrderedSet&| + |AbelianSemiGroup&| |SemiGroup&| + |TranscendentalFunctionCategory&| NIL + |SetCategory&| NIL + |ElementaryFunctionCategory&| NIL + |HyperbolicFunctionCategory&| + |ArcTrigonometricFunctionCategory&| + |TrigonometricFunctionCategory&| NIL NIL + |RadicalCategory&| |RetractableTo&| + |RetractableTo&| NIL NIL |BasicType&| NIL) + (CONS '#((|FloatingPointSystem|) + (|RealNumberSystem|) (|Field|) + (|EuclideanDomain|) + (|PrincipalIdealDomain|) + (|UniqueFactorizationDomain|) + (|GcdDomain|) (|DivisionRing|) + (|IntegralDomain|) (|Algebra| 105) + (|Algebra| $$) (|DifferentialRing|) + (|CharacteristicZero|) (|OrderedRing|) + (|Module| 105) (|EntireRing|) + (|CommutativeRing|) (|Module| $$) + (|OrderedAbelianGroup|) + (|BiModule| 105 105) (|BiModule| $$ $$) + (|Ring|) + (|OrderedCancellationAbelianMonoid|) + (|RightModule| 105) (|LeftModule| 105) + (|LeftModule| $$) (|Rng|) + (|RightModule| $$) + (|OrderedAbelianMonoid|) + (|AbelianGroup|) + (|OrderedAbelianSemiGroup|) + (|CancellationAbelianMonoid|) + (|AbelianMonoid|) (|Monoid|) + (|PatternMatchable| 102) (|OrderedSet|) + (|AbelianSemiGroup|) (|SemiGroup|) + (|TranscendentalFunctionCategory|) + (|RealConstant|) (|SetCategory|) + (|ConvertibleTo| 43) + (|ElementaryFunctionCategory|) + (|ArcHyperbolicFunctionCategory|) + (|HyperbolicFunctionCategory|) + (|ArcTrigonometricFunctionCategory|) + (|TrigonometricFunctionCategory|) + (|OpenMath|) (|ConvertibleTo| 130) + (|RadicalCategory|) + (|RetractableTo| 105) + (|RetractableTo| 26) + (|ConvertibleTo| 102) + (|ConvertibleTo| 15) (|BasicType|) + (|CoercibleTo| 40)) + (|makeByteWordVec2| 141 + '(0 9 0 10 2 11 0 7 9 12 1 11 13 0 14 2 + 11 13 0 15 16 1 11 13 0 17 1 11 13 0 + 18 2 0 0 24 0 31 1 40 0 15 41 1 43 0 + 15 44 1 94 15 15 95 2 94 15 15 15 97 + 1 102 0 15 103 0 105 0 118 2 105 0 26 + 26 119 2 26 0 106 0 120 1 105 0 26 + 121 1 105 20 0 122 1 105 20 0 123 0 + 105 0 124 2 105 20 0 0 125 1 105 26 0 + 126 1 105 26 0 127 2 0 20 0 0 1 1 0 + 20 0 89 1 0 26 0 99 1 0 140 0 1 1 0 0 + 0 1 1 0 20 0 1 1 0 0 0 1 1 0 0 0 77 1 + 0 0 0 65 2 0 91 0 0 1 1 0 0 0 1 1 0 + 131 0 1 1 0 0 0 56 2 0 20 0 0 1 1 0 0 + 0 75 1 0 0 0 63 1 0 26 0 116 1 0 0 0 + 80 1 0 0 0 67 0 0 0 1 1 0 0 0 1 1 0 + 111 0 112 1 0 114 0 115 1 0 105 0 110 + 1 0 26 0 113 2 0 0 0 0 1 1 0 91 0 92 + 2 0 105 0 106 108 3 0 105 0 106 106 + 107 2 0 0 0 0 1 1 0 138 132 1 1 0 20 + 0 1 0 0 24 29 1 0 20 0 1 0 0 0 39 3 0 + 129 0 130 129 1 1 0 26 0 35 1 0 20 0 + 1 2 0 0 0 26 1 1 0 0 0 1 1 0 20 0 88 + 2 0 133 132 0 1 0 0 0 34 2 0 0 0 0 53 + 0 0 0 33 2 0 0 0 0 52 1 0 26 0 27 1 0 + 0 0 30 1 0 0 0 57 1 0 0 0 62 1 0 0 + 132 1 2 0 0 0 0 1 1 0 7 0 1 1 0 0 0 1 + 1 0 26 0 90 1 0 141 0 1 2 0 139 139 + 139 1 1 0 0 132 1 2 0 0 0 0 1 1 0 0 0 + 1 1 0 0 0 1 3 0 0 26 26 24 100 2 0 0 + 26 26 1 1 0 131 0 1 2 0 134 0 0 1 3 0 + 136 0 0 0 1 2 0 91 0 0 1 2 0 133 132 + 0 1 1 0 26 0 28 0 0 0 38 1 0 0 0 61 1 + 0 106 0 1 1 0 7 7 8 2 0 137 0 0 1 0 0 + 24 1 1 0 0 0 93 2 0 0 0 106 1 1 0 0 0 + 78 1 0 0 0 68 1 0 0 0 79 1 0 0 0 66 1 + 0 0 0 76 1 0 0 0 64 1 0 43 0 45 1 0 + 130 0 1 1 0 102 0 104 1 0 15 0 101 1 + 0 0 105 1 1 0 0 26 60 1 0 0 105 1 1 0 + 0 26 60 1 0 0 0 1 1 0 40 0 42 0 0 106 + 1 1 0 0 0 1 0 0 24 32 0 0 24 25 1 0 0 + 0 83 2 0 0 0 0 109 1 0 0 0 71 2 0 20 + 0 0 1 1 0 0 0 81 1 0 0 0 69 1 0 0 0 + 86 1 0 0 0 74 1 0 0 0 84 1 0 0 0 72 1 + 0 0 0 85 1 0 0 0 73 1 0 0 0 82 1 0 0 + 0 70 1 0 0 0 117 2 0 0 0 26 1 2 0 0 0 + 106 1 2 0 0 0 24 1 0 0 0 36 0 0 0 37 + 3 0 13 11 0 20 23 2 0 7 0 20 21 2 0 + 13 11 0 22 1 0 7 0 19 1 0 0 0 96 1 0 + 0 0 1 2 0 0 0 106 1 2 0 0 0 0 98 2 0 + 20 0 0 1 2 0 20 0 0 1 2 0 20 0 0 54 2 + 0 20 0 0 1 2 0 20 0 0 46 2 0 0 0 26 + 55 2 0 0 0 0 87 2 0 0 0 0 49 1 0 0 0 + 47 2 0 0 0 0 48 2 0 0 0 0 59 2 0 0 0 + 105 128 2 0 0 0 26 58 2 0 0 0 106 1 2 + 0 0 0 24 1 2 0 0 0 105 1 2 0 0 105 0 + 1 2 0 0 0 0 50 2 0 0 26 0 51 2 0 0 + 106 0 1 2 0 0 24 0 31))))) + '|lookupComplete|)) + +(MAKEPROP '|DoubleFloat| 'NILADIC T) diff --git a/src/algebra/strap/DIFRING-.lsp b/src/algebra/strap/DIFRING-.lsp new file mode 100644 index 00000000..1fb59bfb --- /dev/null +++ b/src/algebra/strap/DIFRING-.lsp @@ -0,0 +1,46 @@ + +(/VERSIONCHECK 2) + +(DEFUN |DIFRING-;D;2S;1| (|r| $) (SPADCALL |r| (QREFELT $ 7))) + +(DEFUN |DIFRING-;differentiate;SNniS;2| (|r| |n| $) + (PROG (|i|) + (RETURN + (SEQ (SEQ (LETT |i| 1 |DIFRING-;differentiate;SNniS;2|) G190 + (COND ((QSGREATERP |i| |n|) (GO G191))) + (SEQ (EXIT (LETT |r| (SPADCALL |r| (QREFELT $ 7)) + |DIFRING-;differentiate;SNniS;2|))) + (LETT |i| (QSADD1 |i|) + |DIFRING-;differentiate;SNniS;2|) + (GO G190) G191 (EXIT NIL)) + (EXIT |r|))))) + +(DEFUN |DIFRING-;D;SNniS;3| (|r| |n| $) + (SPADCALL |r| |n| (QREFELT $ 11))) + +(DEFUN |DifferentialRing&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|DifferentialRing&|)) + (LETT |dv$| (LIST '|DifferentialRing&| |dv$1|) . #0#) + (LETT $ (GETREFV 13) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|DifferentialRing&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) + (0 . |differentiate|) |DIFRING-;D;2S;1| + (|NonNegativeInteger|) |DIFRING-;differentiate;SNniS;2| + (5 . |differentiate|) |DIFRING-;D;SNniS;3|) + '#(|differentiate| 11 D 17) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 12 + '(1 6 0 0 7 2 6 0 0 9 11 2 0 0 0 9 10 2 + 0 0 0 9 12 1 0 0 0 8))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/DIFRING.lsp b/src/algebra/strap/DIFRING.lsp new file mode 100644 index 00000000..3c823149 --- /dev/null +++ b/src/algebra/strap/DIFRING.lsp @@ -0,0 +1,28 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |DifferentialRing;AL| 'NIL) + +(DEFUN |DifferentialRing| () + (LET (#:G1387) + (COND + (|DifferentialRing;AL|) + (T (SETQ |DifferentialRing;AL| (|DifferentialRing;|)))))) + +(DEFUN |DifferentialRing;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# + (|Join| (|Ring|) + (|mkCategory| '|domain| + '(((|differentiate| ($ $)) T) + ((D ($ $)) T) + ((|differentiate| + ($ $ (|NonNegativeInteger|))) + T) + ((D ($ $ (|NonNegativeInteger|))) T)) + NIL '((|NonNegativeInteger|)) NIL)) + |DifferentialRing|) + (SETELT #0# 0 '(|DifferentialRing|)))))) + +(MAKEPROP '|DifferentialRing| 'NILADIC T) diff --git a/src/algebra/strap/DIVRING-.lsp b/src/algebra/strap/DIVRING-.lsp new file mode 100644 index 00000000..e3efca81 --- /dev/null +++ b/src/algebra/strap/DIVRING-.lsp @@ -0,0 +1,56 @@ + +(/VERSIONCHECK 2) + +(DEFUN |DIVRING-;^;SIS;1| (|x| |n| $) + (SPADCALL |x| |n| (QREFELT $ 8))) + +(DEFUN |DIVRING-;**;SIS;2| (|x| |n| $) + (COND + ((ZEROP |n|) (|spadConstant| $ 10)) + ((SPADCALL |x| (QREFELT $ 12)) + (COND ((< |n| 0) (|error| "division by zero")) ('T |x|))) + ((< |n| 0) + (SPADCALL (SPADCALL |x| (QREFELT $ 14)) (- |n|) (QREFELT $ 17))) + ('T (SPADCALL |x| |n| (QREFELT $ 17))))) + +(DEFUN |DIVRING-;*;F2S;3| (|q| |x| $) + (SPADCALL + (SPADCALL (SPADCALL |q| (QREFELT $ 20)) + (SPADCALL + (SPADCALL (SPADCALL |q| (QREFELT $ 21)) (QREFELT $ 22)) + (QREFELT $ 14)) + (QREFELT $ 23)) + |x| (QREFELT $ 24))) + +(DEFUN |DivisionRing&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|DivisionRing&|)) + (LETT |dv$| (LIST '|DivisionRing&| |dv$1|) . #0#) + (LETT $ (GETREFV 27) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|DivisionRing&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Integer|) + (0 . **) |DIVRING-;^;SIS;1| (6 . |One|) (|Boolean|) + (10 . |zero?|) (15 . |Zero|) (19 . |inv|) + (|PositiveInteger|) (|RepeatedSquaring| 6) (24 . |expt|) + |DIVRING-;**;SIS;2| (|Fraction| 7) (30 . |numer|) + (35 . |denom|) (40 . |coerce|) (45 . *) (51 . *) + |DIVRING-;*;F2S;3| (|NonNegativeInteger|)) + '#(^ 57 ** 63 * 69) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 25 + '(2 6 0 0 7 8 0 6 0 10 1 6 11 0 12 0 6 + 0 13 1 6 0 0 14 2 16 6 6 15 17 1 19 7 + 0 20 1 19 7 0 21 1 6 0 7 22 2 6 0 7 0 + 23 2 6 0 0 0 24 2 0 0 0 7 9 2 0 0 0 7 + 18 2 0 0 19 0 25))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/DIVRING.lsp b/src/algebra/strap/DIVRING.lsp new file mode 100644 index 00000000..2523c524 --- /dev/null +++ b/src/algebra/strap/DIVRING.lsp @@ -0,0 +1,28 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |DivisionRing;AL| 'NIL) + +(DEFUN |DivisionRing| () + (LET (#:G1390) + (COND + (|DivisionRing;AL|) + (T (SETQ |DivisionRing;AL| (|DivisionRing;|)))))) + +(DEFUN |DivisionRing;| () + (PROG (#0=#:G1388) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(#1=#:G1387) + (LIST '(|Fraction| (|Integer|)))) + (|Join| (|EntireRing|) (|Algebra| '#1#) + (|mkCategory| '|domain| + '(((** ($ $ (|Integer|))) T) + ((^ ($ $ (|Integer|))) T) + ((|inv| ($ $)) T)) + NIL '((|Integer|)) NIL))) + |DivisionRing|) + (SETELT #0# 0 '(|DivisionRing|)))))) + +(MAKEPROP '|DivisionRing| 'NILADIC T) diff --git a/src/algebra/strap/ENTIRER.lsp b/src/algebra/strap/ENTIRER.lsp new file mode 100644 index 00000000..1de80763 --- /dev/null +++ b/src/algebra/strap/ENTIRER.lsp @@ -0,0 +1,22 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |EntireRing;AL| 'NIL) + +(DEFUN |EntireRing| () + (LET (#:G1387) + (COND + (|EntireRing;AL|) + (T (SETQ |EntireRing;AL| (|EntireRing;|)))))) + +(DEFUN |EntireRing;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# + (|Join| (|Ring|) (|BiModule| '$ '$) + (|mkCategory| '|package| NIL + '((|noZeroDivisors| T)) 'NIL NIL)) + |EntireRing|) + (SETELT #0# 0 '(|EntireRing|)))))) + +(MAKEPROP '|EntireRing| 'NILADIC T) diff --git a/src/algebra/strap/ES-.lsp b/src/algebra/strap/ES-.lsp new file mode 100644 index 00000000..da5d43a9 --- /dev/null +++ b/src/algebra/strap/ES-.lsp @@ -0,0 +1,796 @@ + +(/VERSIONCHECK 2) + +(DEFUN |ES-;box;2S;1| (|x| $) + (SPADCALL (LIST |x|) (|getShellEntry| $ 16))) + +(DEFUN |ES-;paren;2S;2| (|x| $) + (SPADCALL (LIST |x|) (|getShellEntry| $ 18))) + +(DEFUN |ES-;belong?;BoB;3| (|op| $) + (COND + ((SPADCALL |op| (|getShellEntry| $ 13) (|getShellEntry| $ 21)) 'T) + ('T (SPADCALL |op| (|getShellEntry| $ 14) (|getShellEntry| $ 21))))) + +(DEFUN |ES-;listk| (|f| $) + (SPADCALL (|ES-;allKernels| |f| $) (|getShellEntry| $ 26))) + +(DEFUN |ES-;tower;SL;5| (|f| $) + (SPADCALL (|ES-;listk| |f| $) (|getShellEntry| $ 27))) + +(DEFUN |ES-;allk| (|l| $) + (PROG (#0=#:G1419 |f| #1=#:G1420) + (RETURN + (SEQ (SPADCALL (ELT $ 32) + (PROGN + (LETT #0# NIL |ES-;allk|) + (SEQ (LETT |f| NIL |ES-;allk|) + (LETT #1# |l| |ES-;allk|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |f| (CAR #1#) |ES-;allk|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS (|ES-;allKernels| |f| $) + #0#) + |ES-;allk|))) + (LETT #1# (CDR #1#) |ES-;allk|) (GO G190) G191 + (EXIT (NREVERSE0 #0#)))) + (SPADCALL NIL (|getShellEntry| $ 31)) + (|getShellEntry| $ 35)))))) + +(DEFUN |ES-;operators;SL;7| (|f| $) + (PROG (#0=#:G1423 |k| #1=#:G1424) + (RETURN + (SEQ (PROGN + (LETT #0# NIL |ES-;operators;SL;7|) + (SEQ (LETT |k| NIL |ES-;operators;SL;7|) + (LETT #1# (|ES-;listk| |f| $) |ES-;operators;SL;7|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |k| (CAR #1#) |ES-;operators;SL;7|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |k| + (|getShellEntry| $ 36)) + #0#) + |ES-;operators;SL;7|))) + (LETT #1# (CDR #1#) |ES-;operators;SL;7|) (GO G190) + G191 (EXIT (NREVERSE0 #0#)))))))) + +(DEFUN |ES-;height;SNni;8| (|f| $) + (PROG (#0=#:G1429 |k| #1=#:G1430) + (RETURN + (SEQ (SPADCALL (ELT $ 42) + (PROGN + (LETT #0# NIL |ES-;height;SNni;8|) + (SEQ (LETT |k| NIL |ES-;height;SNni;8|) + (LETT #1# (SPADCALL |f| (|getShellEntry| $ 39)) + |ES-;height;SNni;8|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |k| (CAR #1#) |ES-;height;SNni;8|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |k| + (|getShellEntry| $ 41)) + #0#) + |ES-;height;SNni;8|))) + (LETT #1# (CDR #1#) |ES-;height;SNni;8|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + 0 (|getShellEntry| $ 45)))))) + +(DEFUN |ES-;freeOf?;SSB;9| (|x| |s| $) + (PROG (#0=#:G1434 |k| #1=#:G1435) + (RETURN + (SEQ (SPADCALL + (SPADCALL |s| + (PROGN + (LETT #0# NIL |ES-;freeOf?;SSB;9|) + (SEQ (LETT |k| NIL |ES-;freeOf?;SSB;9|) + (LETT #1# (|ES-;listk| |x| $) + |ES-;freeOf?;SSB;9|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |k| (CAR #1#) + |ES-;freeOf?;SSB;9|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |k| + (|getShellEntry| $ 47)) + #0#) + |ES-;freeOf?;SSB;9|))) + (LETT #1# (CDR #1#) |ES-;freeOf?;SSB;9|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 49)) + (|getShellEntry| $ 50)))))) + +(DEFUN |ES-;distribute;2S;10| (|x| $) + (PROG (#0=#:G1438 |k| #1=#:G1439) + (RETURN + (SEQ (|ES-;unwrap| + (PROGN + (LETT #0# NIL |ES-;distribute;2S;10|) + (SEQ (LETT |k| NIL |ES-;distribute;2S;10|) + (LETT #1# (|ES-;listk| |x| $) + |ES-;distribute;2S;10|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |k| (CAR #1#) + |ES-;distribute;2S;10|) + NIL)) + (GO G191))) + (SEQ (EXIT (COND + ((SPADCALL |k| + (|getShellEntry| $ 13) + (|getShellEntry| $ 52)) + (LETT #0# (CONS |k| #0#) + |ES-;distribute;2S;10|))))) + (LETT #1# (CDR #1#) |ES-;distribute;2S;10|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + |x| $))))) + +(DEFUN |ES-;box;LS;11| (|l| $) + (SPADCALL (|getShellEntry| $ 14) |l| (|getShellEntry| $ 54))) + +(DEFUN |ES-;paren;LS;12| (|l| $) + (SPADCALL (|getShellEntry| $ 13) |l| (|getShellEntry| $ 54))) + +(DEFUN |ES-;freeOf?;2SB;13| (|x| |k| $) + (SPADCALL + (SPADCALL (SPADCALL |k| (|getShellEntry| $ 57)) + (|ES-;listk| |x| $) (|getShellEntry| $ 58)) + (|getShellEntry| $ 50))) + +(DEFUN |ES-;kernel;Bo2S;14| (|op| |arg| $) + (SPADCALL |op| (LIST |arg|) (|getShellEntry| $ 60))) + +(DEFUN |ES-;elt;Bo2S;15| (|op| |x| $) + (SPADCALL |op| (LIST |x|) (|getShellEntry| $ 54))) + +(DEFUN |ES-;elt;Bo3S;16| (|op| |x| |y| $) + (SPADCALL |op| (LIST |x| |y|) (|getShellEntry| $ 54))) + +(DEFUN |ES-;elt;Bo4S;17| (|op| |x| |y| |z| $) + (SPADCALL |op| (LIST |x| |y| |z|) (|getShellEntry| $ 54))) + +(DEFUN |ES-;elt;Bo5S;18| (|op| |x| |y| |z| |t| $) + (SPADCALL |op| (LIST |x| |y| |z| |t|) (|getShellEntry| $ 54))) + +(DEFUN |ES-;eval;SSMS;19| (|x| |s| |f| $) + (SPADCALL |x| (LIST |s|) (LIST |f|) (|getShellEntry| $ 68))) + +(DEFUN |ES-;eval;SBoMS;20| (|x| |s| |f| $) + (SPADCALL |x| (LIST (SPADCALL |s| (|getShellEntry| $ 70))) (LIST |f|) + (|getShellEntry| $ 68))) + +(DEFUN |ES-;eval;SSMS;21| (|x| |s| |f| $) + (SPADCALL |x| (LIST |s|) + (LIST (CONS #'|ES-;eval;SSMS;21!0| (VECTOR |f| $))) + (|getShellEntry| $ 68))) + +(DEFUN |ES-;eval;SSMS;21!0| (|#1| $$) + (SPADCALL (SPADCALL |#1| (|getShellEntry| (|getShellEntry| $$ 1) 73)) + (|getShellEntry| $$ 0))) + +(DEFUN |ES-;eval;SBoMS;22| (|x| |s| |f| $) + (SPADCALL |x| (LIST |s|) + (LIST (CONS #'|ES-;eval;SBoMS;22!0| (VECTOR |f| $))) + (|getShellEntry| $ 76))) + +(DEFUN |ES-;eval;SBoMS;22!0| (|#1| $$) + (SPADCALL (SPADCALL |#1| (|getShellEntry| (|getShellEntry| $$ 1) 73)) + (|getShellEntry| $$ 0))) + +(DEFUN |ES-;subst;SES;23| (|x| |e| $) + (SPADCALL |x| (LIST |e|) (|getShellEntry| $ 80))) + +(DEFUN |ES-;eval;SLLS;24| (|x| |ls| |lf| $) + (PROG (#0=#:G1459 |f| #1=#:G1460) + (RETURN + (SEQ (SPADCALL |x| |ls| + (PROGN + (LETT #0# NIL |ES-;eval;SLLS;24|) + (SEQ (LETT |f| NIL |ES-;eval;SLLS;24|) + (LETT #1# |lf| |ES-;eval;SLLS;24|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |f| (CAR #1#) |ES-;eval;SLLS;24|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (CONS #'|ES-;eval;SLLS;24!0| + (VECTOR |f| $)) + #0#) + |ES-;eval;SLLS;24|))) + (LETT #1# (CDR #1#) |ES-;eval;SLLS;24|) (GO G190) + G191 (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 76)))))) + +(DEFUN |ES-;eval;SLLS;24!0| (|#1| $$) + (SPADCALL (SPADCALL |#1| (|getShellEntry| (|getShellEntry| $$ 1) 73)) + (|getShellEntry| $$ 0))) + +(DEFUN |ES-;eval;SLLS;25| (|x| |ls| |lf| $) + (PROG (#0=#:G1463 |f| #1=#:G1464) + (RETURN + (SEQ (SPADCALL |x| |ls| + (PROGN + (LETT #0# NIL |ES-;eval;SLLS;25|) + (SEQ (LETT |f| NIL |ES-;eval;SLLS;25|) + (LETT #1# |lf| |ES-;eval;SLLS;25|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |f| (CAR #1#) |ES-;eval;SLLS;25|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (CONS #'|ES-;eval;SLLS;25!0| + (VECTOR |f| $)) + #0#) + |ES-;eval;SLLS;25|))) + (LETT #1# (CDR #1#) |ES-;eval;SLLS;25|) (GO G190) + G191 (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 68)))))) + +(DEFUN |ES-;eval;SLLS;25!0| (|#1| $$) + (SPADCALL (SPADCALL |#1| (|getShellEntry| (|getShellEntry| $$ 1) 73)) + (|getShellEntry| $$ 0))) + +(DEFUN |ES-;eval;SLLS;26| (|x| |ls| |lf| $) + (PROG (#0=#:G1468 |s| #1=#:G1469) + (RETURN + (SEQ (SPADCALL |x| + (PROGN + (LETT #0# NIL |ES-;eval;SLLS;26|) + (SEQ (LETT |s| NIL |ES-;eval;SLLS;26|) + (LETT #1# |ls| |ES-;eval;SLLS;26|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |s| (CAR #1#) |ES-;eval;SLLS;26|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |s| + (|getShellEntry| $ 70)) + #0#) + |ES-;eval;SLLS;26|))) + (LETT #1# (CDR #1#) |ES-;eval;SLLS;26|) (GO G190) + G191 (EXIT (NREVERSE0 #0#)))) + |lf| (|getShellEntry| $ 68)))))) + +(DEFUN |ES-;map;MKS;27| (|fn| |k| $) + (PROG (#0=#:G1484 |x| #1=#:G1485 |l|) + (RETURN + (SEQ (COND + ((SPADCALL + (LETT |l| + (PROGN + (LETT #0# NIL |ES-;map;MKS;27|) + (SEQ (LETT |x| NIL |ES-;map;MKS;27|) + (LETT #1# + (SPADCALL |k| + (|getShellEntry| $ 86)) + |ES-;map;MKS;27|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |x| (CAR #1#) + |ES-;map;MKS;27|) + NIL)) + (GO G191))) + (SEQ (EXIT + (LETT #0# + (CONS (SPADCALL |x| |fn|) #0#) + |ES-;map;MKS;27|))) + (LETT #1# (CDR #1#) |ES-;map;MKS;27|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + |ES-;map;MKS;27|) + (SPADCALL |k| (|getShellEntry| $ 86)) + (|getShellEntry| $ 87)) + (SPADCALL |k| (|getShellEntry| $ 88))) + ('T + (SPADCALL (SPADCALL |k| (|getShellEntry| $ 36)) |l| + (|getShellEntry| $ 54)))))))) + +(DEFUN |ES-;operator;2Bo;28| (|op| $) + (COND + ((SPADCALL |op| (SPADCALL "%paren" (|getShellEntry| $ 9)) + (|getShellEntry| $ 90)) + (|getShellEntry| $ 13)) + ((SPADCALL |op| (SPADCALL "%box" (|getShellEntry| $ 9)) + (|getShellEntry| $ 90)) + (|getShellEntry| $ 14)) + ('T (|error| "Unknown operator")))) + +(DEFUN |ES-;mainKernel;SU;29| (|x| $) + (PROG (|l| |kk| #0=#:G1501 |n| |k|) + (RETURN + (SEQ (COND + ((NULL (LETT |l| (SPADCALL |x| (|getShellEntry| $ 39)) + |ES-;mainKernel;SU;29|)) + (CONS 1 "failed")) + ('T + (SEQ (LETT |n| + (SPADCALL + (LETT |k| (|SPADfirst| |l|) + |ES-;mainKernel;SU;29|) + (|getShellEntry| $ 41)) + |ES-;mainKernel;SU;29|) + (SEQ (LETT |kk| NIL |ES-;mainKernel;SU;29|) + (LETT #0# (CDR |l|) |ES-;mainKernel;SU;29|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |kk| (CAR #0#) + |ES-;mainKernel;SU;29|) + NIL)) + (GO G191))) + (SEQ (EXIT (COND + ((< |n| + (SPADCALL |kk| + (|getShellEntry| $ 41))) + (SEQ + (LETT |n| + (SPADCALL |kk| + (|getShellEntry| $ 41)) + |ES-;mainKernel;SU;29|) + (EXIT + (LETT |k| |kk| + |ES-;mainKernel;SU;29|))))))) + (LETT #0# (CDR #0#) |ES-;mainKernel;SU;29|) + (GO G190) G191 (EXIT NIL)) + (EXIT (CONS 0 |k|))))))))) + +(DEFUN |ES-;allKernels| (|f| $) + (PROG (|l| |k| #0=#:G1514 |u| |s0| |n| |arg| |t| |s|) + (RETURN + (SEQ (LETT |s| + (SPADCALL + (LETT |l| (SPADCALL |f| (|getShellEntry| $ 39)) + |ES-;allKernels|) + (|getShellEntry| $ 31)) + |ES-;allKernels|) + (SEQ (LETT |k| NIL |ES-;allKernels|) + (LETT #0# |l| |ES-;allKernels|) G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |k| (CAR #0#) |ES-;allKernels|) + NIL)) + (GO G191))) + (SEQ (LETT |t| + (SEQ (LETT |u| + (SPADCALL + (SPADCALL |k| + (|getShellEntry| $ 36)) + "%dummyVar" + (|getShellEntry| $ 96)) + |ES-;allKernels|) + (EXIT (COND + ((QEQCAR |u| 0) + (SEQ + (LETT |arg| + (SPADCALL |k| + (|getShellEntry| $ 86)) + |ES-;allKernels|) + (LETT |s0| + (SPADCALL + (SPADCALL + (SPADCALL |arg| + (|getShellEntry| $ 97)) + (|getShellEntry| $ 57)) + (|ES-;allKernels| + (|SPADfirst| |arg|) $) + (|getShellEntry| $ 98)) + |ES-;allKernels|) + (LETT |arg| (CDR (CDR |arg|)) + |ES-;allKernels|) + (LETT |n| (QCDR |u|) + |ES-;allKernels|) + (COND + ((< 1 |n|) + (LETT |arg| (CDR |arg|) + |ES-;allKernels|))) + (EXIT + (SPADCALL |s0| + (|ES-;allk| |arg| $) + (|getShellEntry| $ 32))))) + ('T + (|ES-;allk| + (SPADCALL |k| + (|getShellEntry| $ 86)) + $))))) + |ES-;allKernels|) + (EXIT (LETT |s| + (SPADCALL |s| |t| + (|getShellEntry| $ 32)) + |ES-;allKernels|))) + (LETT #0# (CDR #0#) |ES-;allKernels|) (GO G190) G191 + (EXIT NIL)) + (EXIT |s|))))) + +(DEFUN |ES-;kernel;BoLS;31| (|op| |args| $) + (COND + ((NULL (SPADCALL |op| (|getShellEntry| $ 99))) + (|error| "Unknown operator")) + ('T (|ES-;okkernel| |op| |args| $)))) + +(DEFUN |ES-;okkernel| (|op| |l| $) + (PROG (#0=#:G1521 |f| #1=#:G1522) + (RETURN + (SEQ (SPADCALL + (SPADCALL |op| |l| + (+ 1 + (SPADCALL (ELT $ 42) + (PROGN + (LETT #0# NIL |ES-;okkernel|) + (SEQ (LETT |f| NIL |ES-;okkernel|) + (LETT #1# |l| |ES-;okkernel|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |f| (CAR #1#) + |ES-;okkernel|) + NIL)) + (GO G191))) + (SEQ (EXIT + (LETT #0# + (CONS + (SPADCALL |f| + (|getShellEntry| $ 101)) + #0#) + |ES-;okkernel|))) + (LETT #1# (CDR #1#) |ES-;okkernel|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + 0 (|getShellEntry| $ 45))) + (|getShellEntry| $ 102)) + (|getShellEntry| $ 88)))))) + +(DEFUN |ES-;elt;BoLS;33| (|op| |args| $) + (PROG (|u| #0=#:G1538 |v|) + (RETURN + (SEQ (EXIT (COND + ((NULL (SPADCALL |op| (|getShellEntry| $ 99))) + (|error| "Unknown operator")) + ('T + (SEQ (SEQ (LETT |u| + (SPADCALL |op| + (|getShellEntry| $ 104)) + |ES-;elt;BoLS;33|) + (EXIT (COND + ((QEQCAR |u| 0) + (COND + ((SPADCALL (LENGTH |args|) + (QCDR |u|) + (|getShellEntry| $ 105)) + (PROGN + (LETT #0# + (|error| + "Wrong number of arguments") + |ES-;elt;BoLS;33|) + (GO #0#)))))))) + (LETT |v| + (SPADCALL |op| |args| + (|getShellEntry| $ 108)) + |ES-;elt;BoLS;33|) + (EXIT (COND + ((QEQCAR |v| 0) (QCDR |v|)) + ('T (|ES-;okkernel| |op| |args| $)))))))) + #0# (EXIT #0#))))) + +(DEFUN |ES-;retract;SK;34| (|f| $) + (PROG (|k|) + (RETURN + (SEQ (LETT |k| (SPADCALL |f| (|getShellEntry| $ 110)) + |ES-;retract;SK;34|) + (EXIT (COND + ((OR (QEQCAR |k| 1) + (SPADCALL + (SPADCALL (QCDR |k|) + (|getShellEntry| $ 88)) + |f| (|getShellEntry| $ 111))) + (|error| "not a kernel")) + ('T (QCDR |k|)))))))) + +(DEFUN |ES-;retractIfCan;SU;35| (|f| $) + (PROG (|k|) + (RETURN + (SEQ (LETT |k| (SPADCALL |f| (|getShellEntry| $ 110)) + |ES-;retractIfCan;SU;35|) + (EXIT (COND + ((OR (QEQCAR |k| 1) + (SPADCALL + (SPADCALL (QCDR |k|) + (|getShellEntry| $ 88)) + |f| (|getShellEntry| $ 111))) + (CONS 1 "failed")) + ('T |k|))))))) + +(DEFUN |ES-;is?;SSB;36| (|f| |s| $) + (PROG (|k|) + (RETURN + (SEQ (LETT |k| (SPADCALL |f| (|getShellEntry| $ 114)) + |ES-;is?;SSB;36|) + (EXIT (COND + ((QEQCAR |k| 1) 'NIL) + ('T + (SPADCALL (QCDR |k|) |s| (|getShellEntry| $ 115))))))))) + +(DEFUN |ES-;is?;SBoB;37| (|f| |op| $) + (PROG (|k|) + (RETURN + (SEQ (LETT |k| (SPADCALL |f| (|getShellEntry| $ 114)) + |ES-;is?;SBoB;37|) + (EXIT (COND + ((QEQCAR |k| 1) 'NIL) + ('T + (SPADCALL (QCDR |k|) |op| (|getShellEntry| $ 52))))))))) + +(DEFUN |ES-;unwrap| (|l| |x| $) + (PROG (|k| #0=#:G1565) + (RETURN + (SEQ (SEQ (LETT |k| NIL |ES-;unwrap|) + (LETT #0# (NREVERSE |l|) |ES-;unwrap|) G190 + (COND + ((OR (ATOM #0#) + (PROGN (LETT |k| (CAR #0#) |ES-;unwrap|) NIL)) + (GO G191))) + (SEQ (EXIT (LETT |x| + (SPADCALL |x| |k| + (|SPADfirst| + (SPADCALL |k| + (|getShellEntry| $ 86))) + (|getShellEntry| $ 118)) + |ES-;unwrap|))) + (LETT #0# (CDR #0#) |ES-;unwrap|) (GO G190) G191 + (EXIT NIL)) + (EXIT |x|))))) + +(DEFUN |ES-;distribute;3S;39| (|x| |y| $) + (PROG (|ky| #0=#:G1570 |k| #1=#:G1571) + (RETURN + (SEQ (LETT |ky| (SPADCALL |y| (|getShellEntry| $ 57)) + |ES-;distribute;3S;39|) + (EXIT (|ES-;unwrap| + (PROGN + (LETT #0# NIL |ES-;distribute;3S;39|) + (SEQ (LETT |k| NIL |ES-;distribute;3S;39|) + (LETT #1# (|ES-;listk| |x| $) + |ES-;distribute;3S;39|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |k| (CAR #1#) + |ES-;distribute;3S;39|) + NIL)) + (GO G191))) + (SEQ (EXIT (COND + ((COND + ((SPADCALL |k| + (SPADCALL "%paren" + (|getShellEntry| $ 9)) + (|getShellEntry| $ 115)) + (SPADCALL |ky| + (|ES-;listk| + (SPADCALL |k| + (|getShellEntry| $ 88)) + $) + (|getShellEntry| $ 58))) + ('T 'NIL)) + (LETT #0# (CONS |k| #0#) + |ES-;distribute;3S;39|))))) + (LETT #1# (CDR #1#) |ES-;distribute;3S;39|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + |x| $)))))) + +(DEFUN |ES-;eval;SLS;40| (|f| |leq| $) + (PROG (|rec|) + (RETURN + (SEQ (LETT |rec| (|ES-;mkKerLists| |leq| $) |ES-;eval;SLS;40|) + (EXIT (SPADCALL |f| (QCAR |rec|) (QCDR |rec|) + (|getShellEntry| $ 120))))))) + +(DEFUN |ES-;subst;SLS;41| (|f| |leq| $) + (PROG (|rec|) + (RETURN + (SEQ (LETT |rec| (|ES-;mkKerLists| |leq| $) |ES-;subst;SLS;41|) + (EXIT (SPADCALL |f| (QCAR |rec|) (QCDR |rec|) + (|getShellEntry| $ 122))))))) + +(DEFUN |ES-;mkKerLists| (|leq| $) + (PROG (|eq| #0=#:G1588 |k| |lk| |lv|) + (RETURN + (SEQ (LETT |lk| NIL |ES-;mkKerLists|) + (LETT |lv| NIL |ES-;mkKerLists|) + (SEQ (LETT |eq| NIL |ES-;mkKerLists|) + (LETT #0# |leq| |ES-;mkKerLists|) G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |eq| (CAR #0#) |ES-;mkKerLists|) + NIL)) + (GO G191))) + (SEQ (LETT |k| + (SPADCALL + (SPADCALL |eq| (|getShellEntry| $ 125)) + (|getShellEntry| $ 114)) + |ES-;mkKerLists|) + (EXIT (COND + ((QEQCAR |k| 1) + (|error| "left hand side must be a single kernel")) + ((NULL (SPADCALL (QCDR |k|) |lk| + (|getShellEntry| $ 58))) + (SEQ (LETT |lk| (CONS (QCDR |k|) |lk|) + |ES-;mkKerLists|) + (EXIT + (LETT |lv| + (CONS + (SPADCALL |eq| + (|getShellEntry| $ 126)) + |lv|) + |ES-;mkKerLists|))))))) + (LETT #0# (CDR #0#) |ES-;mkKerLists|) (GO G190) G191 + (EXIT NIL)) + (EXIT (CONS |lk| |lv|)))))) + +(DEFUN |ES-;even?;SB;43| (|x| $) (|ES-;intpred?| |x| (ELT $ 128) $)) + +(DEFUN |ES-;odd?;SB;44| (|x| $) (|ES-;intpred?| |x| (ELT $ 130) $)) + +(DEFUN |ES-;intpred?| (|x| |pred?| $) + (PROG (|u|) + (RETURN + (SEQ (LETT |u| (SPADCALL |x| (|getShellEntry| $ 133)) + |ES-;intpred?|) + (EXIT (COND + ((QEQCAR |u| 0) (SPADCALL (QCDR |u|) |pred?|)) + ('T 'NIL))))))) + +(DEFUN |ExpressionSpace&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|ExpressionSpace&|)) + (LETT |dv$| (LIST '|ExpressionSpace&| |dv$1|) . #0#) + (LETT $ (|newShell| 134) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#1| + '(|RetractableTo| (|Integer|))) + (|HasCategory| |#1| '(|Ring|)))) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + (|setShellEntry| $ 13 + (SPADCALL (SPADCALL "%paren" (|getShellEntry| $ 9)) + (|getShellEntry| $ 12))) + (|setShellEntry| $ 14 + (SPADCALL (SPADCALL "%box" (|getShellEntry| $ 9)) + (|getShellEntry| $ 12))) + (COND + ((|testBitVector| |pv$| 1) + (PROGN + (|setShellEntry| $ 129 + (CONS (|dispatchFunction| |ES-;even?;SB;43|) $)) + (|setShellEntry| $ 131 + (CONS (|dispatchFunction| |ES-;odd?;SB;44|) $))))) + $)))) + +(MAKEPROP '|ExpressionSpace&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|String|) + (|Symbol|) (0 . |coerce|) (|BasicOperator|) + (|CommonOperators|) (5 . |operator|) '|oppren| '|opbox| + (|List| $) (10 . |box|) |ES-;box;2S;1| (15 . |paren|) + |ES-;paren;2S;2| (|Boolean|) (20 . =) |ES-;belong?;BoB;3| + (|Kernel| 6) (|List| 23) (|Set| 23) (26 . |parts|) + (31 . |sort!|) (|Kernel| $) (|List| 28) |ES-;tower;SL;5| + (36 . |brace|) (41 . |union|) (|Mapping| 25 25 25) + (|List| 25) (47 . |reduce|) (54 . |operator|) (|List| 10) + |ES-;operators;SL;7| (59 . |kernels|) + (|NonNegativeInteger|) (64 . |height|) (69 . |max|) + (|Mapping| 40 40 40) (|List| 40) (75 . |reduce|) + |ES-;height;SNni;8| (82 . |name|) (|List| 8) + (87 . |member?|) (93 . |not|) |ES-;freeOf?;SSB;9| + (98 . |is?|) |ES-;distribute;2S;10| (104 . |elt|) + |ES-;box;LS;11| |ES-;paren;LS;12| (110 . |retract|) + (115 . |member?|) |ES-;freeOf?;2SB;13| (121 . |kernel|) + |ES-;kernel;Bo2S;14| |ES-;elt;Bo2S;15| |ES-;elt;Bo3S;16| + |ES-;elt;Bo4S;17| |ES-;elt;Bo5S;18| (|Mapping| $ 15) + (|List| 66) (127 . |eval|) |ES-;eval;SSMS;19| + (134 . |name|) |ES-;eval;SBoMS;20| (|List| 6) + (139 . |first|) (|Mapping| $ $) |ES-;eval;SSMS;21| + (144 . |eval|) |ES-;eval;SBoMS;22| (|Equation| $) + (|List| 78) (151 . |subst|) |ES-;subst;SES;23| (|List| 74) + |ES-;eval;SLLS;24| |ES-;eval;SLLS;25| |ES-;eval;SLLS;26| + (157 . |argument|) (162 . =) (168 . |coerce|) + |ES-;map;MKS;27| (173 . |is?|) |ES-;operator;2Bo;28| + (|Union| 28 '"failed") |ES-;mainKernel;SU;29| (|None|) + (|Union| 94 '"failed") (179 . |property|) (185 . |second|) + (190 . |remove!|) (196 . |belong?|) |ES-;kernel;BoLS;31| + (201 . |height|) (206 . |kernel|) (|Union| 40 '"failed") + (213 . |arity|) (218 . ~=) (|Union| 6 '"failed") + (|BasicOperatorFunctions1| 6) (224 . |evaluate|) + |ES-;elt;BoLS;33| (230 . |mainKernel|) (235 . ~=) + |ES-;retract;SK;34| |ES-;retractIfCan;SU;35| + (241 . |retractIfCan|) (246 . |is?|) |ES-;is?;SSB;36| + |ES-;is?;SBoB;37| (252 . |eval|) |ES-;distribute;3S;39| + (259 . |eval|) |ES-;eval;SLS;40| (266 . |subst|) + |ES-;subst;SLS;41| (|Equation| 6) (273 . |lhs|) + (278 . |rhs|) (|Integer|) (283 . |even?|) (288 . |even?|) + (293 . |odd?|) (298 . |odd?|) (|Union| 127 '"failed") + (303 . |retractIfCan|)) + '#(|tower| 308 |subst| 313 |retractIfCan| 325 |retract| 330 + |paren| 335 |operators| 345 |operator| 350 |odd?| 355 + |map| 360 |mainKernel| 366 |kernel| 371 |is?| 383 |height| + 395 |freeOf?| 400 |even?| 412 |eval| 417 |elt| 472 + |distribute| 508 |box| 519 |belong?| 529) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 133 + '(1 8 0 7 9 1 11 10 8 12 1 6 0 15 16 1 + 6 0 15 18 2 10 20 0 0 21 1 25 24 0 26 + 1 24 0 0 27 1 25 0 24 31 2 25 0 0 0 + 32 3 34 25 33 0 25 35 1 23 10 0 36 1 + 6 29 0 39 1 23 40 0 41 2 40 0 0 0 42 + 3 44 40 43 0 40 45 1 23 8 0 47 2 48 + 20 8 0 49 1 20 0 0 50 2 23 20 0 10 52 + 2 6 0 10 15 54 1 6 28 0 57 2 24 20 23 + 0 58 2 6 0 10 15 60 3 6 0 0 48 67 68 + 1 10 8 0 70 1 72 6 0 73 3 6 0 0 37 67 + 76 2 6 0 0 79 80 1 23 72 0 86 2 72 20 + 0 0 87 1 6 0 28 88 2 10 20 0 8 90 2 + 10 95 0 7 96 1 72 6 0 97 2 25 0 23 0 + 98 1 6 20 10 99 1 6 40 0 101 3 23 0 + 10 72 40 102 1 10 103 0 104 2 40 20 0 + 0 105 2 107 106 10 72 108 1 6 92 0 + 110 2 6 20 0 0 111 1 6 92 0 114 2 23 + 20 0 8 115 3 6 0 0 28 0 118 3 6 0 0 + 29 15 120 3 6 0 0 29 15 122 1 124 6 0 + 125 1 124 6 0 126 1 127 20 0 128 1 0 + 20 0 129 1 127 20 0 130 1 0 20 0 131 + 1 6 132 0 133 1 0 29 0 30 2 0 0 0 79 + 123 2 0 0 0 78 81 1 0 92 0 113 1 0 28 + 0 112 1 0 0 0 19 1 0 0 15 56 1 0 37 0 + 38 1 0 10 10 91 1 0 20 0 131 2 0 0 74 + 28 89 1 0 92 0 93 2 0 0 10 15 100 2 0 + 0 10 0 61 2 0 20 0 8 116 2 0 20 0 10 + 117 1 0 40 0 46 2 0 20 0 8 51 2 0 20 + 0 0 59 1 0 20 0 129 3 0 0 0 10 74 77 + 3 0 0 0 37 67 85 3 0 0 0 10 66 71 3 0 + 0 0 37 82 83 3 0 0 0 8 66 69 3 0 0 0 + 8 74 75 3 0 0 0 48 82 84 2 0 0 0 79 + 121 2 0 0 10 15 109 5 0 0 10 0 0 0 0 + 65 3 0 0 10 0 0 63 4 0 0 10 0 0 0 64 + 2 0 0 10 0 62 2 0 0 0 0 119 1 0 0 0 + 53 1 0 0 15 55 1 0 0 0 17 1 0 20 10 + 22))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/ES.lsp b/src/algebra/strap/ES.lsp new file mode 100644 index 00000000..53f77b8c --- /dev/null +++ b/src/algebra/strap/ES.lsp @@ -0,0 +1,155 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |ExpressionSpace;AL| 'NIL) + +(DEFUN |ExpressionSpace| () + (LET (#:G1400) + (COND + (|ExpressionSpace;AL|) + (T (SETQ |ExpressionSpace;AL| (|ExpressionSpace;|)))))) + +(DEFUN |ExpressionSpace;| () + (PROG (#0=#:G1398) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(#1=#:G1396 #2=#:G1397) + (LIST '(|Kernel| $) '(|Kernel| $))) + (|Join| (|OrderedSet|) (|RetractableTo| '#1#) + (|InnerEvalable| '#2# '$) + (|Evalable| '$) + (|mkCategory| '|domain| + '(((|elt| ($ (|BasicOperator|) $)) + T) + ((|elt| ($ (|BasicOperator|) $ $)) + T) + ((|elt| + ($ (|BasicOperator|) $ $ $)) + T) + ((|elt| + ($ (|BasicOperator|) $ $ $ $)) + T) + ((|elt| + ($ (|BasicOperator|) (|List| $))) + T) + ((|subst| ($ $ (|Equation| $))) T) + ((|subst| + ($ $ (|List| (|Equation| $)))) + T) + ((|subst| + ($ $ (|List| (|Kernel| $)) + (|List| $))) + T) + ((|box| ($ $)) T) + ((|box| ($ (|List| $))) T) + ((|paren| ($ $)) T) + ((|paren| ($ (|List| $))) T) + ((|distribute| ($ $)) T) + ((|distribute| ($ $ $)) T) + ((|height| + ((|NonNegativeInteger|) $)) + T) + ((|mainKernel| + ((|Union| (|Kernel| $) "failed") + $)) + T) + ((|kernels| + ((|List| (|Kernel| $)) $)) + T) + ((|tower| + ((|List| (|Kernel| $)) $)) + T) + ((|operators| + ((|List| (|BasicOperator|)) $)) + T) + ((|operator| + ((|BasicOperator|) + (|BasicOperator|))) + T) + ((|belong?| + ((|Boolean|) (|BasicOperator|))) + T) + ((|is?| + ((|Boolean|) $ + (|BasicOperator|))) + T) + ((|is?| + ((|Boolean|) $ (|Symbol|))) + T) + ((|kernel| + ($ (|BasicOperator|) $)) + T) + ((|kernel| + ($ (|BasicOperator|) (|List| $))) + T) + ((|map| + ($ (|Mapping| $ $) (|Kernel| $))) + T) + ((|freeOf?| ((|Boolean|) $ $)) T) + ((|freeOf?| + ((|Boolean|) $ (|Symbol|))) + T) + ((|eval| + ($ $ (|List| (|Symbol|)) + (|List| (|Mapping| $ $)))) + T) + ((|eval| + ($ $ (|List| (|Symbol|)) + (|List| + (|Mapping| $ (|List| $))))) + T) + ((|eval| + ($ $ (|Symbol|) + (|Mapping| $ (|List| $)))) + T) + ((|eval| + ($ $ (|Symbol|) (|Mapping| $ $))) + T) + ((|eval| + ($ $ (|List| (|BasicOperator|)) + (|List| (|Mapping| $ $)))) + T) + ((|eval| + ($ $ (|List| (|BasicOperator|)) + (|List| + (|Mapping| $ (|List| $))))) + T) + ((|eval| + ($ $ (|BasicOperator|) + (|Mapping| $ (|List| $)))) + T) + ((|eval| + ($ $ (|BasicOperator|) + (|Mapping| $ $))) + T) + ((|minPoly| + ((|SparseUnivariatePolynomial| + $) + (|Kernel| $))) + (|has| $ (|Ring|))) + ((|definingPolynomial| ($ $)) + (|has| $ (|Ring|))) + ((|even?| ((|Boolean|) $)) + (|has| $ + (|RetractableTo| (|Integer|)))) + ((|odd?| ((|Boolean|) $)) + (|has| $ + (|RetractableTo| (|Integer|))))) + NIL + '((|Boolean|) + (|SparseUnivariatePolynomial| $) + (|Kernel| $) (|BasicOperator|) + (|List| (|BasicOperator|)) + (|List| (|Mapping| $ (|List| $))) + (|List| (|Mapping| $ $)) + (|Symbol|) (|List| (|Symbol|)) + (|List| $) (|List| (|Kernel| $)) + (|NonNegativeInteger|) + (|List| (|Equation| $)) + (|Equation| $)) + NIL))) + |ExpressionSpace|) + (SETELT #0# 0 '(|ExpressionSpace|)))))) + +(MAKEPROP '|ExpressionSpace| 'NILADIC T) diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp new file mode 100644 index 00000000..8a08bd2e --- /dev/null +++ b/src/algebra/strap/EUCDOM-.lsp @@ -0,0 +1,518 @@ + +(/VERSIONCHECK 2) + +(DEFUN |EUCDOM-;sizeLess?;2SB;1| (|x| |y| $) + (COND + ((SPADCALL |y| (|getShellEntry| $ 8)) 'NIL) + ((SPADCALL |x| (|getShellEntry| $ 8)) 'T) + ('T + (< (SPADCALL |x| (|getShellEntry| $ 10)) + (SPADCALL |y| (|getShellEntry| $ 10)))))) + +(DEFUN |EUCDOM-;quo;3S;2| (|x| |y| $) + (QCAR (SPADCALL |x| |y| (|getShellEntry| $ 13)))) + +(DEFUN |EUCDOM-;rem;3S;3| (|x| |y| $) + (QCDR (SPADCALL |x| |y| (|getShellEntry| $ 13)))) + +(DEFUN |EUCDOM-;exquo;2SU;4| (|x| |y| $) + (PROG (|qr|) + (RETURN + (SEQ (COND + ((SPADCALL |y| (|getShellEntry| $ 8)) (CONS 1 "failed")) + ('T + (SEQ (LETT |qr| (SPADCALL |x| |y| (|getShellEntry| $ 13)) + |EUCDOM-;exquo;2SU;4|) + (EXIT (COND + ((SPADCALL (QCDR |qr|) + (|getShellEntry| $ 8)) + (CONS 0 (QCAR |qr|))) + ('T (CONS 1 "failed"))))))))))) + +(DEFUN |EUCDOM-;gcd;3S;5| (|x| |y| $) + (PROG (|#G13| |#G14|) + (RETURN + (SEQ (LETT |x| (SPADCALL |x| (|getShellEntry| $ 18)) + |EUCDOM-;gcd;3S;5|) + (LETT |y| (SPADCALL |y| (|getShellEntry| $ 18)) + |EUCDOM-;gcd;3S;5|) + (SEQ G190 + (COND + ((NULL (SPADCALL (SPADCALL |y| (|getShellEntry| $ 8)) + (|getShellEntry| $ 19))) + (GO G191))) + (SEQ (PROGN + (LETT |#G13| |y| |EUCDOM-;gcd;3S;5|) + (LETT |#G14| + (SPADCALL |x| |y| (|getShellEntry| $ 20)) + |EUCDOM-;gcd;3S;5|) + (LETT |x| |#G13| |EUCDOM-;gcd;3S;5|) + (LETT |y| |#G14| |EUCDOM-;gcd;3S;5|)) + (EXIT (LETT |y| + (SPADCALL |y| (|getShellEntry| $ 18)) + |EUCDOM-;gcd;3S;5|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |x|))))) + +(DEFUN |EUCDOM-;unitNormalizeIdealElt| (|s| $) + (PROG (|#G16| |u| |c| |a|) + (RETURN + (SEQ (PROGN + (LETT |#G16| + (SPADCALL (QVELT |s| 2) (|getShellEntry| $ 23)) + |EUCDOM-;unitNormalizeIdealElt|) + (LETT |u| (QVELT |#G16| 0) + |EUCDOM-;unitNormalizeIdealElt|) + (LETT |c| (QVELT |#G16| 1) + |EUCDOM-;unitNormalizeIdealElt|) + (LETT |a| (QVELT |#G16| 2) + |EUCDOM-;unitNormalizeIdealElt|) + |#G16|) + (EXIT (COND + ((SPADCALL |a| (|spadConstant| $ 24) + (|getShellEntry| $ 25)) + |s|) + ('T + (VECTOR (SPADCALL |a| (QVELT |s| 0) + (|getShellEntry| $ 26)) + (SPADCALL |a| (QVELT |s| 1) + (|getShellEntry| $ 26)) + |c|)))))))) + +(DEFUN |EUCDOM-;extendedEuclidean;2SR;7| (|x| |y| $) + (PROG (|s3| |s2| |qr| |s1|) + (RETURN + (SEQ (LETT |s1| + (|EUCDOM-;unitNormalizeIdealElt| + (VECTOR (|spadConstant| $ 24) + (|spadConstant| $ 27) |x|) + $) + |EUCDOM-;extendedEuclidean;2SR;7|) + (LETT |s2| + (|EUCDOM-;unitNormalizeIdealElt| + (VECTOR (|spadConstant| $ 27) + (|spadConstant| $ 24) |y|) + $) + |EUCDOM-;extendedEuclidean;2SR;7|) + (EXIT (COND + ((SPADCALL |y| (|getShellEntry| $ 8)) |s1|) + ((SPADCALL |x| (|getShellEntry| $ 8)) |s2|) + ('T + (SEQ (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL (QVELT |s2| 2) + (|getShellEntry| $ 8)) + (|getShellEntry| $ 19))) + (GO G191))) + (SEQ (LETT |qr| + (SPADCALL (QVELT |s1| 2) + (QVELT |s2| 2) + (|getShellEntry| $ 13)) + |EUCDOM-;extendedEuclidean;2SR;7|) + (LETT |s3| + (VECTOR + (SPADCALL (QVELT |s1| 0) + (SPADCALL (QCAR |qr|) + (QVELT |s2| 0) + (|getShellEntry| $ 26)) + (|getShellEntry| $ 28)) + (SPADCALL (QVELT |s1| 1) + (SPADCALL (QCAR |qr|) + (QVELT |s2| 1) + (|getShellEntry| $ 26)) + (|getShellEntry| $ 28)) + (QCDR |qr|)) + |EUCDOM-;extendedEuclidean;2SR;7|) + (LETT |s1| |s2| + |EUCDOM-;extendedEuclidean;2SR;7|) + (EXIT + (LETT |s2| + (|EUCDOM-;unitNormalizeIdealElt| + |s3| $) + |EUCDOM-;extendedEuclidean;2SR;7|))) + NIL (GO G190) G191 (EXIT NIL)) + (COND + ((NULL (SPADCALL (QVELT |s1| 0) + (|getShellEntry| $ 8))) + (COND + ((NULL (SPADCALL (QVELT |s1| 0) |y| + (|getShellEntry| $ 29))) + (SEQ (LETT |qr| + (SPADCALL (QVELT |s1| 0) |y| + (|getShellEntry| $ 13)) + |EUCDOM-;extendedEuclidean;2SR;7|) + (QSETVELT |s1| 0 (QCDR |qr|)) + (QSETVELT |s1| 1 + (SPADCALL (QVELT |s1| 1) + (SPADCALL (QCAR |qr|) |x| + (|getShellEntry| $ 26)) + (|getShellEntry| $ 30))) + (EXIT + (LETT |s1| + (|EUCDOM-;unitNormalizeIdealElt| + |s1| $) + |EUCDOM-;extendedEuclidean;2SR;7|))))))) + (EXIT |s1|))))))))) + +(DEFUN |EUCDOM-;extendedEuclidean;3SU;8| (|x| |y| |z| $) + (PROG (|s| |w| |qr|) + (RETURN + (SEQ (COND + ((SPADCALL |z| (|getShellEntry| $ 8)) + (CONS 0 + (CONS (|spadConstant| $ 27) (|spadConstant| $ 27)))) + ('T + (SEQ (LETT |s| (SPADCALL |x| |y| (|getShellEntry| $ 33)) + |EUCDOM-;extendedEuclidean;3SU;8|) + (LETT |w| + (SPADCALL |z| (QVELT |s| 2) + (|getShellEntry| $ 34)) + |EUCDOM-;extendedEuclidean;3SU;8|) + (EXIT (COND + ((QEQCAR |w| 1) (CONS 1 "failed")) + ((SPADCALL |y| (|getShellEntry| $ 8)) + (CONS 0 + (CONS (SPADCALL (QVELT |s| 0) + (QCDR |w|) + (|getShellEntry| $ 26)) + (SPADCALL (QVELT |s| 1) + (QCDR |w|) + (|getShellEntry| $ 26))))) + ('T + (SEQ (LETT |qr| + (SPADCALL + (SPADCALL (QVELT |s| 0) + (QCDR |w|) + (|getShellEntry| $ 26)) + |y| (|getShellEntry| $ 13)) + |EUCDOM-;extendedEuclidean;3SU;8|) + (EXIT (CONS 0 + (CONS (QCDR |qr|) + (SPADCALL + (SPADCALL (QVELT |s| 1) + (QCDR |w|) + (|getShellEntry| $ 26)) + (SPADCALL (QCAR |qr|) |x| + (|getShellEntry| $ 26)) + (|getShellEntry| $ 30)))))))))))))))) + +(DEFUN |EUCDOM-;principalIdeal;LR;9| (|l| $) + (PROG (|uca| |v| |u| #0=#:G1478 |vv| #1=#:G1479) + (RETURN + (SEQ (COND + ((SPADCALL |l| NIL (|getShellEntry| $ 39)) + (|error| "empty list passed to principalIdeal")) + ((SPADCALL (CDR |l|) NIL (|getShellEntry| $ 39)) + (SEQ (LETT |uca| + (SPADCALL (|SPADfirst| |l|) + (|getShellEntry| $ 23)) + |EUCDOM-;principalIdeal;LR;9|) + (EXIT (CONS (LIST (QVELT |uca| 0)) (QVELT |uca| 1))))) + ((SPADCALL (CDR (CDR |l|)) NIL (|getShellEntry| $ 39)) + (SEQ (LETT |u| + (SPADCALL (|SPADfirst| |l|) + (SPADCALL |l| (|getShellEntry| $ 40)) + (|getShellEntry| $ 33)) + |EUCDOM-;principalIdeal;LR;9|) + (EXIT (CONS (LIST (QVELT |u| 0) (QVELT |u| 1)) + (QVELT |u| 2))))) + ('T + (SEQ (LETT |v| + (SPADCALL (CDR |l|) (|getShellEntry| $ 43)) + |EUCDOM-;principalIdeal;LR;9|) + (LETT |u| + (SPADCALL (|SPADfirst| |l|) (QCDR |v|) + (|getShellEntry| $ 33)) + |EUCDOM-;principalIdeal;LR;9|) + (EXIT (CONS (CONS (QVELT |u| 0) + (PROGN + (LETT #0# NIL + |EUCDOM-;principalIdeal;LR;9|) + (SEQ + (LETT |vv| NIL + |EUCDOM-;principalIdeal;LR;9|) + (LETT #1# (QCAR |v|) + |EUCDOM-;principalIdeal;LR;9|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |vv| (CAR #1#) + |EUCDOM-;principalIdeal;LR;9|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #0# + (CONS + (SPADCALL (QVELT |u| 1) + |vv| + (|getShellEntry| $ 26)) + #0#) + |EUCDOM-;principalIdeal;LR;9|))) + (LETT #1# (CDR #1#) + |EUCDOM-;principalIdeal;LR;9|) + (GO G190) G191 + (EXIT (NREVERSE0 #0#))))) + (QVELT |u| 2)))))))))) + +(DEFUN |EUCDOM-;expressIdealMember;LSU;10| (|l| |z| $) + (PROG (#0=#:G1494 #1=#:G1495 |pid| |q| #2=#:G1496 |v| #3=#:G1497) + (RETURN + (SEQ (COND + ((SPADCALL |z| (|spadConstant| $ 27) + (|getShellEntry| $ 25)) + (CONS 0 + (PROGN + (LETT #0# NIL + |EUCDOM-;expressIdealMember;LSU;10|) + (SEQ (LETT |v| NIL + |EUCDOM-;expressIdealMember;LSU;10|) + (LETT #1# |l| + |EUCDOM-;expressIdealMember;LSU;10|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |v| (CAR #1#) + |EUCDOM-;expressIdealMember;LSU;10|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS (|spadConstant| $ 27) #0#) + |EUCDOM-;expressIdealMember;LSU;10|))) + (LETT #1# (CDR #1#) + |EUCDOM-;expressIdealMember;LSU;10|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))))) + ('T + (SEQ (LETT |pid| (SPADCALL |l| (|getShellEntry| $ 43)) + |EUCDOM-;expressIdealMember;LSU;10|) + (LETT |q| + (SPADCALL |z| (QCDR |pid|) + (|getShellEntry| $ 34)) + |EUCDOM-;expressIdealMember;LSU;10|) + (EXIT (COND + ((QEQCAR |q| 1) (CONS 1 "failed")) + ('T + (CONS 0 + (PROGN + (LETT #2# NIL + |EUCDOM-;expressIdealMember;LSU;10|) + (SEQ + (LETT |v| NIL + |EUCDOM-;expressIdealMember;LSU;10|) + (LETT #3# (QCAR |pid|) + |EUCDOM-;expressIdealMember;LSU;10|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |v| (CAR #3#) + |EUCDOM-;expressIdealMember;LSU;10|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #2# + (CONS + (SPADCALL (QCDR |q|) |v| + (|getShellEntry| $ 26)) + #2#) + |EUCDOM-;expressIdealMember;LSU;10|))) + (LETT #3# (CDR #3#) + |EUCDOM-;expressIdealMember;LSU;10|) + (GO G190) G191 + (EXIT (NREVERSE0 #2#))))))))))))))) + +(DEFUN |EUCDOM-;multiEuclidean;LSU;11| (|l| |z| $) + (PROG (|n| |l1| |l2| #0=#:G1392 #1=#:G1516 #2=#:G1503 #3=#:G1501 + #4=#:G1502 #5=#:G1393 #6=#:G1517 #7=#:G1506 #8=#:G1504 + #9=#:G1505 |u| |v1| |v2|) + (RETURN + (SEQ (LETT |n| (LENGTH |l|) |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT (COND + ((ZEROP |n|) + (|error| "empty list passed to multiEuclidean")) + ((EQL |n| 1) (CONS 0 (LIST |z|))) + ('T + (SEQ (LETT |l1| + (SPADCALL |l| (|getShellEntry| $ 47)) + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT |l2| + (SPADCALL |l1| (QUOTIENT2 |n| 2) + (|getShellEntry| $ 49)) + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT |u| + (SPADCALL + (PROGN + (LETT #4# NIL + |EUCDOM-;multiEuclidean;LSU;11|) + (SEQ + (LETT #0# NIL + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT #1# |l1| + |EUCDOM-;multiEuclidean;LSU;11|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT #0# (CAR #1#) + |EUCDOM-;multiEuclidean;LSU;11|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (PROGN + (LETT #2# #0# + |EUCDOM-;multiEuclidean;LSU;11|) + (COND + (#4# + (LETT #3# + (SPADCALL #3# #2# + (|getShellEntry| $ 26)) + |EUCDOM-;multiEuclidean;LSU;11|)) + ('T + (PROGN + (LETT #3# #2# + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT #4# 'T + |EUCDOM-;multiEuclidean;LSU;11|))))))) + (LETT #1# (CDR #1#) + |EUCDOM-;multiEuclidean;LSU;11|) + (GO G190) G191 (EXIT NIL)) + (COND + (#4# #3#) + ('T (|spadConstant| $ 24)))) + (PROGN + (LETT #9# NIL + |EUCDOM-;multiEuclidean;LSU;11|) + (SEQ + (LETT #5# NIL + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT #6# |l2| + |EUCDOM-;multiEuclidean;LSU;11|) + G190 + (COND + ((OR (ATOM #6#) + (PROGN + (LETT #5# (CAR #6#) + |EUCDOM-;multiEuclidean;LSU;11|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (PROGN + (LETT #7# #5# + |EUCDOM-;multiEuclidean;LSU;11|) + (COND + (#9# + (LETT #8# + (SPADCALL #8# #7# + (|getShellEntry| $ 26)) + |EUCDOM-;multiEuclidean;LSU;11|)) + ('T + (PROGN + (LETT #8# #7# + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT #9# 'T + |EUCDOM-;multiEuclidean;LSU;11|))))))) + (LETT #6# (CDR #6#) + |EUCDOM-;multiEuclidean;LSU;11|) + (GO G190) G191 (EXIT NIL)) + (COND + (#9# #8#) + ('T (|spadConstant| $ 24)))) + |z| (|getShellEntry| $ 50)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT (COND + ((QEQCAR |u| 1) (CONS 1 "failed")) + ('T + (SEQ (LETT |v1| + (SPADCALL |l1| + (QCDR (QCDR |u|)) + (|getShellEntry| $ 51)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT + (COND + ((QEQCAR |v1| 1) + (CONS 1 "failed")) + ('T + (SEQ + (LETT |v2| + (SPADCALL |l2| + (QCAR (QCDR |u|)) + (|getShellEntry| $ 51)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT + (COND + ((QEQCAR |v2| 1) + (CONS 1 "failed")) + ('T + (CONS 0 + (SPADCALL (QCDR |v1|) + (QCDR |v2|) + (|getShellEntry| $ + 52)))))))))))))))))))))) + +(DEFUN |EuclideanDomain&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|EuclideanDomain&|)) + (LETT |dv$| (LIST '|EuclideanDomain&| |dv$1|) . #0#) + (LETT $ (|newShell| 54) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + $)))) + +(MAKEPROP '|EuclideanDomain&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Boolean|) + (0 . |zero?|) (|NonNegativeInteger|) (5 . |euclideanSize|) + |EUCDOM-;sizeLess?;2SB;1| + (|Record| (|:| |quotient| $) (|:| |remainder| $)) + (10 . |divide|) |EUCDOM-;quo;3S;2| |EUCDOM-;rem;3S;3| + (|Union| $ '"failed") |EUCDOM-;exquo;2SU;4| + (16 . |unitCanonical|) (21 . |not|) (26 . |rem|) + |EUCDOM-;gcd;3S;5| + (|Record| (|:| |unit| $) (|:| |canonical| $) + (|:| |associate| $)) + (32 . |unitNormal|) (37 . |One|) (41 . =) (47 . *) + (53 . |Zero|) (57 . -) (63 . |sizeLess?|) (69 . +) + (|Record| (|:| |coef1| $) (|:| |coef2| $) + (|:| |generator| $)) + |EUCDOM-;extendedEuclidean;2SR;7| + (75 . |extendedEuclidean|) (81 . |exquo|) + (|Record| (|:| |coef1| $) (|:| |coef2| $)) + (|Union| 35 '"failed") |EUCDOM-;extendedEuclidean;3SU;8| + (|List| 6) (87 . =) (93 . |second|) (|List| $) + (|Record| (|:| |coef| 41) (|:| |generator| $)) + (98 . |principalIdeal|) |EUCDOM-;principalIdeal;LR;9| + (|Union| 41 '"failed") |EUCDOM-;expressIdealMember;LSU;10| + (103 . |copy|) (|Integer|) (108 . |split!|) + (114 . |extendedEuclidean|) (121 . |multiEuclidean|) + (127 . |concat|) |EUCDOM-;multiEuclidean;LSU;11|) + '#(|sizeLess?| 133 |rem| 139 |quo| 145 |principalIdeal| 151 + |multiEuclidean| 156 |gcd| 162 |extendedEuclidean| 168 + |exquo| 181 |expressIdealMember| 187) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 53 + '(1 6 7 0 8 1 6 9 0 10 2 6 12 0 0 13 1 + 6 0 0 18 1 7 0 0 19 2 6 0 0 0 20 1 6 + 22 0 23 0 6 0 24 2 6 7 0 0 25 2 6 0 0 + 0 26 0 6 0 27 2 6 0 0 0 28 2 6 7 0 0 + 29 2 6 0 0 0 30 2 6 31 0 0 33 2 6 16 + 0 0 34 2 38 7 0 0 39 1 38 6 0 40 1 6 + 42 41 43 1 38 0 0 47 2 38 0 0 48 49 3 + 6 36 0 0 0 50 2 6 45 41 0 51 2 38 0 0 + 0 52 2 0 7 0 0 11 2 0 0 0 0 15 2 0 0 + 0 0 14 1 0 42 41 44 2 0 45 41 0 53 2 + 0 0 0 0 21 3 0 36 0 0 0 37 2 0 31 0 0 + 32 2 0 16 0 0 17 2 0 45 41 0 46))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/EUCDOM.lsp b/src/algebra/strap/EUCDOM.lsp new file mode 100644 index 00000000..c58fa54c --- /dev/null +++ b/src/algebra/strap/EUCDOM.lsp @@ -0,0 +1,53 @@ +(|/VERSIONCHECK| 2) + +(DEFPARAMETER |EuclideanDomain;AL| (QUOTE NIL)) + +(DEFUN |EuclideanDomain| NIL + (LET (#:G83585) + (COND + (|EuclideanDomain;AL|) + (T (SETQ |EuclideanDomain;AL| (|EuclideanDomain;|)))))) + +(DEFUN |EuclideanDomain;| NIL + (PROG (#1=#:G83583) + (RETURN + (PROG1 + (LETT #1# + (|Join| + (|PrincipalIdealDomain|) + (|mkCategory| + (QUOTE |domain|) + (QUOTE ( + ((|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 + (QUOTE ((|List| |$|) (|NonNegativeInteger|) (|Boolean|))) + NIL)) + |EuclideanDomain|) + (SETELT #1# 0 (QUOTE (|EuclideanDomain|))))))) + +(MAKEPROP (QUOTE |EuclideanDomain|) (QUOTE NILADIC) T) + diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp new file mode 100644 index 00000000..e886e7ff --- /dev/null +++ b/src/algebra/strap/FFIELDC-.lsp @@ -0,0 +1,615 @@ + +(/VERSIONCHECK 2) + +(DEFUN |FFIELDC-;differentiate;2S;1| (|x| $) (|spadConstant| $ 7)) + +(DEFUN |FFIELDC-;init;S;2| ($) (|spadConstant| $ 7)) + +(DEFUN |FFIELDC-;nextItem;SU;3| (|a| $) + (COND + ((SPADCALL + (LETT |a| + (SPADCALL (+ (SPADCALL |a| (|getShellEntry| $ 11)) 1) + (|getShellEntry| $ 12)) + |FFIELDC-;nextItem;SU;3|) + (|getShellEntry| $ 14)) + (CONS 1 "failed")) + ('T (CONS 0 |a|)))) + +(DEFUN |FFIELDC-;order;SOpc;4| (|e| $) + (SPADCALL (SPADCALL |e| (|getShellEntry| $ 17)) + (|getShellEntry| $ 20))) + +(DEFUN |FFIELDC-;conditionP;MU;5| (|mat| $) + (PROG (|l|) + (RETURN + (SEQ (LETT |l| (SPADCALL |mat| (|getShellEntry| $ 25)) + |FFIELDC-;conditionP;MU;5|) + (COND + ((OR (NULL |l|) + (SPADCALL (ELT $ 14) (|SPADfirst| |l|) + (|getShellEntry| $ 27))) + (EXIT (CONS 1 "failed")))) + (EXIT (CONS 0 + (SPADCALL (ELT $ 28) (|SPADfirst| |l|) + (|getShellEntry| $ 30)))))))) + +(DEFUN |FFIELDC-;charthRoot;2S;6| (|x| $) + (SPADCALL |x| + (QUOTIENT2 (SPADCALL (|getShellEntry| $ 36)) + (SPADCALL (|getShellEntry| $ 37))) + (|getShellEntry| $ 38))) + +(DEFUN |FFIELDC-;charthRoot;SU;7| (|x| $) + (CONS 0 (SPADCALL |x| (|getShellEntry| $ 28)))) + +(DEFUN |FFIELDC-;createPrimitiveElement;S;8| ($) + (PROG (|sm1| |start| |i| #0=#:G1441 |e| |found|) + (RETURN + (SEQ (LETT |sm1| (- (SPADCALL (|getShellEntry| $ 36)) 1) + |FFIELDC-;createPrimitiveElement;S;8|) + (LETT |start| + (COND + ((SPADCALL (SPADCALL (|getShellEntry| $ 43)) + (CONS 1 "polynomial") (|getShellEntry| $ 44)) + (SPADCALL (|getShellEntry| $ 37))) + ('T 1)) + |FFIELDC-;createPrimitiveElement;S;8|) + (LETT |found| 'NIL |FFIELDC-;createPrimitiveElement;S;8|) + (SEQ (LETT |i| |start| + |FFIELDC-;createPrimitiveElement;S;8|) + G190 + (COND + ((NULL (SPADCALL |found| (|getShellEntry| $ 45))) + (GO G191))) + (SEQ (LETT |e| + (SPADCALL + (PROG1 (LETT #0# |i| + |FFIELDC-;createPrimitiveElement;S;8|) + (|check-subtype| (> #0# 0) + '(|PositiveInteger|) #0#)) + (|getShellEntry| $ 12)) + |FFIELDC-;createPrimitiveElement;S;8|) + (EXIT (LETT |found| + (EQL (SPADCALL |e| + (|getShellEntry| $ 17)) + |sm1|) + |FFIELDC-;createPrimitiveElement;S;8|))) + (LETT |i| (+ |i| 1) + |FFIELDC-;createPrimitiveElement;S;8|) + (GO G190) G191 (EXIT NIL)) + (EXIT |e|))))) + +(DEFUN |FFIELDC-;primitive?;SB;9| (|a| $) + (PROG (|explist| |q| |exp| #0=#:G1453 |equalone|) + (RETURN + (SEQ (COND + ((SPADCALL |a| (|getShellEntry| $ 14)) 'NIL) + ('T + (SEQ (LETT |explist| (SPADCALL (|getShellEntry| $ 49)) + |FFIELDC-;primitive?;SB;9|) + (LETT |q| (- (SPADCALL (|getShellEntry| $ 36)) 1) + |FFIELDC-;primitive?;SB;9|) + (LETT |equalone| 'NIL |FFIELDC-;primitive?;SB;9|) + (SEQ (LETT |exp| NIL |FFIELDC-;primitive?;SB;9|) + (LETT #0# |explist| |FFIELDC-;primitive?;SB;9|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |exp| (CAR #0#) + |FFIELDC-;primitive?;SB;9|) + NIL) + (NULL (SPADCALL |equalone| + (|getShellEntry| $ 45)))) + (GO G191))) + (SEQ (EXIT (LETT |equalone| + (SPADCALL + (SPADCALL |a| + (QUOTIENT2 |q| (QCAR |exp|)) + (|getShellEntry| $ 50)) + (|spadConstant| $ 41) + (|getShellEntry| $ 51)) + |FFIELDC-;primitive?;SB;9|))) + (LETT #0# (CDR #0#) |FFIELDC-;primitive?;SB;9|) + (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |equalone| (|getShellEntry| $ 45)))))))))) + +(DEFUN |FFIELDC-;order;SPi;10| (|e| $) + (PROG (|lof| |rec| #0=#:G1461 |primeDivisor| |j| #1=#:G1462 |a| + |goon| |ord|) + (RETURN + (SEQ (COND + ((SPADCALL |e| (|spadConstant| $ 7) + (|getShellEntry| $ 51)) + (|error| "order(0) is not defined ")) + ('T + (SEQ (LETT |ord| (- (SPADCALL (|getShellEntry| $ 36)) 1) + |FFIELDC-;order;SPi;10|) + (LETT |a| 0 |FFIELDC-;order;SPi;10|) + (LETT |lof| (SPADCALL (|getShellEntry| $ 49)) + |FFIELDC-;order;SPi;10|) + (SEQ (LETT |rec| NIL |FFIELDC-;order;SPi;10|) + (LETT #0# |lof| |FFIELDC-;order;SPi;10|) G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |rec| (CAR #0#) + |FFIELDC-;order;SPi;10|) + NIL)) + (GO G191))) + (SEQ (LETT |a| + (QUOTIENT2 |ord| + (LETT |primeDivisor| (QCAR |rec|) + |FFIELDC-;order;SPi;10|)) + |FFIELDC-;order;SPi;10|) + (LETT |goon| + (SPADCALL + (SPADCALL |e| |a| + (|getShellEntry| $ 50)) + (|spadConstant| $ 41) + (|getShellEntry| $ 51)) + |FFIELDC-;order;SPi;10|) + (SEQ (LETT |j| 0 |FFIELDC-;order;SPi;10|) + (LETT #1# (- (QCDR |rec|) 2) + |FFIELDC-;order;SPi;10|) + G190 + (COND + ((OR (QSGREATERP |j| #1#) + (NULL |goon|)) + (GO G191))) + (SEQ (LETT |ord| |a| + |FFIELDC-;order;SPi;10|) + (LETT |a| + (QUOTIENT2 |ord| + |primeDivisor|) + |FFIELDC-;order;SPi;10|) + (EXIT + (LETT |goon| + (SPADCALL + (SPADCALL |e| |a| + (|getShellEntry| $ 50)) + (|spadConstant| $ 41) + (|getShellEntry| $ 51)) + |FFIELDC-;order;SPi;10|))) + (LETT |j| (QSADD1 |j|) + |FFIELDC-;order;SPi;10|) + (GO G190) G191 (EXIT NIL)) + (EXIT (COND + (|goon| + (LETT |ord| |a| + |FFIELDC-;order;SPi;10|))))) + (LETT #0# (CDR #0#) |FFIELDC-;order;SPi;10|) + (GO G190) G191 (EXIT NIL)) + (EXIT |ord|)))))))) + +(DEFUN |FFIELDC-;discreteLog;SNni;11| (|b| $) + (PROG (|faclist| |gen| |groupord| |f| #0=#:G1482 |fac| |t| #1=#:G1483 + |exp| |exptable| |n| |end| |i| |rho| |found| |disc1| |c| + |mult| |disclog| |a|) + (RETURN + (SEQ (COND + ((SPADCALL |b| (|getShellEntry| $ 14)) + (|error| "discreteLog: logarithm of zero")) + ('T + (SEQ (LETT |faclist| (SPADCALL (|getShellEntry| $ 49)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |a| |b| |FFIELDC-;discreteLog;SNni;11|) + (LETT |gen| (SPADCALL (|getShellEntry| $ 54)) + |FFIELDC-;discreteLog;SNni;11|) + (EXIT (COND + ((SPADCALL |b| |gen| (|getShellEntry| $ 51)) + 1) + ('T + (SEQ (LETT |disclog| 0 + |FFIELDC-;discreteLog;SNni;11|) + (LETT |mult| 1 + |FFIELDC-;discreteLog;SNni;11|) + (LETT |groupord| + (- + (SPADCALL + (|getShellEntry| $ 36)) + 1) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |exp| |groupord| + |FFIELDC-;discreteLog;SNni;11|) + (SEQ (LETT |f| NIL + |FFIELDC-;discreteLog;SNni;11|) + (LETT #0# |faclist| + |FFIELDC-;discreteLog;SNni;11|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |f| (CAR #0#) + |FFIELDC-;discreteLog;SNni;11|) + NIL)) + (GO G191))) + (SEQ + (LETT |fac| (QCAR |f|) + |FFIELDC-;discreteLog;SNni;11|) + (EXIT + (SEQ + (LETT |t| 0 + |FFIELDC-;discreteLog;SNni;11|) + (LETT #1# (- (QCDR |f|) 1) + |FFIELDC-;discreteLog;SNni;11|) + G190 + (COND + ((QSGREATERP |t| #1#) + (GO G191))) + (SEQ + (LETT |exp| + (QUOTIENT2 |exp| |fac|) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |exptable| + (SPADCALL |fac| + (|getShellEntry| $ 56)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |n| + (SPADCALL |exptable| + (|getShellEntry| $ 57)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |c| + (SPADCALL |a| |exp| + (|getShellEntry| $ 50)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |end| + (QUOTIENT2 (- |fac| 1) |n|) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |found| 'NIL + |FFIELDC-;discreteLog;SNni;11|) + (LETT |disc1| 0 + |FFIELDC-;discreteLog;SNni;11|) + (SEQ + (LETT |i| 0 + |FFIELDC-;discreteLog;SNni;11|) + G190 + (COND + ((OR + (QSGREATERP |i| |end|) + (NULL + (SPADCALL |found| + (|getShellEntry| $ 45)))) + (GO G191))) + (SEQ + (LETT |rho| + (SPADCALL + (SPADCALL |c| + (|getShellEntry| $ 11)) + |exptable| + (|getShellEntry| $ 59)) + |FFIELDC-;discreteLog;SNni;11|) + (EXIT + (COND + ((QEQCAR |rho| 0) + (SEQ + (LETT |found| 'T + |FFIELDC-;discreteLog;SNni;11|) + (EXIT + (LETT |disc1| + (* + (+ (* |n| |i|) + (QCDR |rho|)) + |mult|) + |FFIELDC-;discreteLog;SNni;11|)))) + ('T + (LETT |c| + (SPADCALL |c| + (SPADCALL |gen| + (* + (QUOTIENT2 + |groupord| |fac|) + (- |n|)) + (|getShellEntry| $ + 50)) + (|getShellEntry| $ + 60)) + |FFIELDC-;discreteLog;SNni;11|))))) + (LETT |i| (QSADD1 |i|) + |FFIELDC-;discreteLog;SNni;11|) + (GO G190) G191 (EXIT NIL)) + (EXIT + (COND + (|found| + (SEQ + (LETT |mult| + (* |mult| |fac|) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |disclog| + (+ |disclog| |disc1|) + |FFIELDC-;discreteLog;SNni;11|) + (EXIT + (LETT |a| + (SPADCALL |a| + (SPADCALL |gen| + (- |disc1|) + (|getShellEntry| $ + 50)) + (|getShellEntry| $ + 60)) + |FFIELDC-;discreteLog;SNni;11|)))) + ('T + (|error| + "discreteLog: ?? discrete logarithm"))))) + (LETT |t| (QSADD1 |t|) + |FFIELDC-;discreteLog;SNni;11|) + (GO G190) G191 (EXIT NIL)))) + (LETT #0# (CDR #0#) + |FFIELDC-;discreteLog;SNni;11|) + (GO G190) G191 (EXIT NIL)) + (EXIT |disclog|)))))))))))) + +(DEFUN |FFIELDC-;discreteLog;2SU;12| (|logbase| |b| $) + (PROG (|groupord| |faclist| |f| #0=#:G1501 |fac| |primroot| |t| + #1=#:G1502 |exp| |rhoHelp| #2=#:G1500 |rho| |disclog| + |mult| |a|) + (RETURN + (SEQ (EXIT (COND + ((SPADCALL |b| (|getShellEntry| $ 14)) + (SEQ (SPADCALL "discreteLog: logarithm of zero" + (|getShellEntry| $ 65)) + (EXIT (CONS 1 "failed")))) + ((SPADCALL |logbase| (|getShellEntry| $ 14)) + (SEQ (SPADCALL + "discreteLog: logarithm to base zero" + (|getShellEntry| $ 65)) + (EXIT (CONS 1 "failed")))) + ((SPADCALL |b| |logbase| (|getShellEntry| $ 51)) + (CONS 0 1)) + ('T + (COND + ((NULL (ZEROP (REMAINDER2 + (LETT |groupord| + (SPADCALL |logbase| + (|getShellEntry| $ 17)) + |FFIELDC-;discreteLog;2SU;12|) + (SPADCALL |b| + (|getShellEntry| $ 17))))) + (SEQ (SPADCALL + "discreteLog: second argument not in cyclic group generated by first argument" + (|getShellEntry| $ 65)) + (EXIT (CONS 1 "failed")))) + ('T + (SEQ (LETT |faclist| + (SPADCALL + (SPADCALL |groupord| + (|getShellEntry| $ 67)) + (|getShellEntry| $ 69)) + |FFIELDC-;discreteLog;2SU;12|) + (LETT |a| |b| + |FFIELDC-;discreteLog;2SU;12|) + (LETT |disclog| 0 + |FFIELDC-;discreteLog;2SU;12|) + (LETT |mult| 1 + |FFIELDC-;discreteLog;2SU;12|) + (LETT |exp| |groupord| + |FFIELDC-;discreteLog;2SU;12|) + (SEQ (LETT |f| NIL + |FFIELDC-;discreteLog;2SU;12|) + (LETT #0# |faclist| + |FFIELDC-;discreteLog;2SU;12|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |f| (CAR #0#) + |FFIELDC-;discreteLog;2SU;12|) + NIL)) + (GO G191))) + (SEQ (LETT |fac| (QCAR |f|) + |FFIELDC-;discreteLog;2SU;12|) + (LETT |primroot| + (SPADCALL |logbase| + (QUOTIENT2 |groupord| |fac|) + (|getShellEntry| $ 50)) + |FFIELDC-;discreteLog;2SU;12|) + (EXIT + (SEQ + (LETT |t| 0 + |FFIELDC-;discreteLog;2SU;12|) + (LETT #1# (- (QCDR |f|) 1) + |FFIELDC-;discreteLog;2SU;12|) + G190 + (COND + ((QSGREATERP |t| #1#) + (GO G191))) + (SEQ + (LETT |exp| + (QUOTIENT2 |exp| |fac|) + |FFIELDC-;discreteLog;2SU;12|) + (LETT |rhoHelp| + (SPADCALL |primroot| + (SPADCALL |a| |exp| + (|getShellEntry| $ 50)) + |fac| + (|getShellEntry| $ 71)) + |FFIELDC-;discreteLog;2SU;12|) + (EXIT + (COND + ((QEQCAR |rhoHelp| 1) + (PROGN + (LETT #2# + (CONS 1 "failed") + |FFIELDC-;discreteLog;2SU;12|) + (GO #2#))) + ('T + (SEQ + (LETT |rho| + (* (QCDR |rhoHelp|) + |mult|) + |FFIELDC-;discreteLog;2SU;12|) + (LETT |disclog| + (+ |disclog| |rho|) + |FFIELDC-;discreteLog;2SU;12|) + (LETT |mult| + (* |mult| |fac|) + |FFIELDC-;discreteLog;2SU;12|) + (EXIT + (LETT |a| + (SPADCALL |a| + (SPADCALL |logbase| + (- |rho|) + (|getShellEntry| $ + 50)) + (|getShellEntry| $ 60)) + |FFIELDC-;discreteLog;2SU;12|))))))) + (LETT |t| (QSADD1 |t|) + |FFIELDC-;discreteLog;2SU;12|) + (GO G190) G191 (EXIT NIL)))) + (LETT #0# (CDR #0#) + |FFIELDC-;discreteLog;2SU;12|) + (GO G190) G191 (EXIT NIL)) + (EXIT (CONS 0 |disclog|)))))))) + #2# (EXIT #2#))))) + +(DEFUN |FFIELDC-;squareFreePolynomial| (|f| $) + (SPADCALL |f| (|getShellEntry| $ 76))) + +(DEFUN |FFIELDC-;factorPolynomial| (|f| $) + (SPADCALL |f| (|getShellEntry| $ 78))) + +(DEFUN |FFIELDC-;factorSquareFreePolynomial| (|f| $) + (PROG (|flist| |u| #0=#:G1515 #1=#:G1512 #2=#:G1510 #3=#:G1511) + (RETURN + (SEQ (COND + ((SPADCALL |f| (|spadConstant| $ 79) + (|getShellEntry| $ 80)) + (|spadConstant| $ 81)) + ('T + (SEQ (LETT |flist| + (SPADCALL |f| 'T (|getShellEntry| $ 85)) + |FFIELDC-;factorSquareFreePolynomial|) + (EXIT (SPADCALL + (SPADCALL (QCAR |flist|) + (|getShellEntry| $ 86)) + (PROGN + (LETT #3# NIL + |FFIELDC-;factorSquareFreePolynomial|) + (SEQ (LETT |u| NIL + |FFIELDC-;factorSquareFreePolynomial|) + (LETT #0# (QCDR |flist|) + |FFIELDC-;factorSquareFreePolynomial|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |u| (CAR #0#) + |FFIELDC-;factorSquareFreePolynomial|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (PROGN + (LETT #1# + (SPADCALL (QCAR |u|) + (QCDR |u|) + (|getShellEntry| $ 87)) + |FFIELDC-;factorSquareFreePolynomial|) + (COND + (#3# + (LETT #2# + (SPADCALL #2# #1# + (|getShellEntry| $ 88)) + |FFIELDC-;factorSquareFreePolynomial|)) + ('T + (PROGN + (LETT #2# #1# + |FFIELDC-;factorSquareFreePolynomial|) + (LETT #3# 'T + |FFIELDC-;factorSquareFreePolynomial|))))))) + (LETT #0# (CDR #0#) + |FFIELDC-;factorSquareFreePolynomial|) + (GO G190) G191 (EXIT NIL)) + (COND + (#3# #2#) + ('T (|spadConstant| $ 89)))) + (|getShellEntry| $ 90)))))))))) + +(DEFUN |FFIELDC-;gcdPolynomial;3Sup;16| (|f| |g| $) + (SPADCALL |f| |g| (|getShellEntry| $ 92))) + +(DEFUN |FiniteFieldCategory&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|FiniteFieldCategory&|)) + (LETT |dv$| (LIST '|FiniteFieldCategory&| |dv$1|) . #0#) + (LETT $ (|newShell| 95) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + $)))) + +(MAKEPROP '|FiniteFieldCategory&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|) + |FFIELDC-;differentiate;2S;1| |FFIELDC-;init;S;2| + (|PositiveInteger|) (4 . |lookup|) (9 . |index|) + (|Boolean|) (14 . |zero?|) (|Union| $ '"failed") + |FFIELDC-;nextItem;SU;3| (19 . |order|) (|Integer|) + (|OnePointCompletion| 10) (24 . |coerce|) + |FFIELDC-;order;SOpc;4| (|Vector| 6) (|List| 22) + (|Matrix| 6) (29 . |nullSpace|) (|Mapping| 13 6) + (34 . |every?|) (40 . |charthRoot|) (|Mapping| 6 6) + (45 . |map|) (|Vector| $) (|Union| 31 '"failed") + (|Matrix| $) |FFIELDC-;conditionP;MU;5| + (|NonNegativeInteger|) (51 . |size|) + (55 . |characteristic|) (59 . **) + |FFIELDC-;charthRoot;2S;6| |FFIELDC-;charthRoot;SU;7| + (65 . |One|) + (|Union| '"prime" '"polynomial" '"normal" '"cyclic") + (69 . |representationType|) (73 . =) (79 . |not|) + |FFIELDC-;createPrimitiveElement;S;8| + (|Record| (|:| |factor| 18) (|:| |exponent| 18)) + (|List| 47) (84 . |factorsOfCyclicGroupSize|) (88 . **) + (94 . =) |FFIELDC-;primitive?;SB;9| + |FFIELDC-;order;SPi;10| (100 . |primitiveElement|) + (|Table| 10 35) (104 . |tableForDiscreteLogarithm|) + (109 . |#|) (|Union| 35 '"failed") (114 . |search|) + (120 . *) |FFIELDC-;discreteLog;SNni;11| (|Void|) + (|String|) (|OutputForm|) (126 . |messagePrint|) + (|Factored| $) (131 . |factor|) (|Factored| 18) + (136 . |factors|) (|DiscreteLogarithmPackage| 6) + (141 . |shanksDiscLogAlgorithm|) + |FFIELDC-;discreteLog;2SU;12| + (|SparseUnivariatePolynomial| 6) (|Factored| 73) + (|UnivariatePolynomialSquareFree| 6 73) + (148 . |squareFree|) (|DistinctDegreeFactorize| 6 73) + (153 . |factor|) (158 . |Zero|) (162 . =) (168 . |Zero|) + (|Record| (|:| |irr| 73) (|:| |pow| 18)) (|List| 82) + (|Record| (|:| |cont| 6) (|:| |factors| 83)) + (172 . |distdfact|) (178 . |coerce|) (183 . |primeFactor|) + (189 . *) (195 . |One|) (199 . *) (|EuclideanDomain&| 73) + (205 . |gcd|) (|SparseUnivariatePolynomial| $) + |FFIELDC-;gcdPolynomial;3Sup;16|) + '#(|primitive?| 211 |order| 216 |nextItem| 226 |init| 231 + |gcdPolynomial| 235 |discreteLog| 241 |differentiate| 252 + |createPrimitiveElement| 257 |conditionP| 261 |charthRoot| + 266) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 94 + '(0 6 0 7 1 6 10 0 11 1 6 0 10 12 1 6 + 13 0 14 1 6 10 0 17 1 19 0 18 20 1 24 + 23 0 25 2 22 13 26 0 27 1 6 0 0 28 2 + 22 0 29 0 30 0 6 35 36 0 6 35 37 2 6 + 0 0 35 38 0 6 0 41 0 6 42 43 2 42 13 + 0 0 44 1 13 0 0 45 0 6 48 49 2 6 0 0 + 18 50 2 6 13 0 0 51 0 6 0 54 1 6 55 + 18 56 1 55 35 0 57 2 55 58 10 0 59 2 + 6 0 0 0 60 1 64 62 63 65 1 18 66 0 67 + 1 68 48 0 69 3 70 58 6 6 35 71 1 75 + 74 73 76 1 77 74 73 78 0 73 0 79 2 73 + 13 0 0 80 0 74 0 81 2 77 84 73 13 85 + 1 73 0 6 86 2 74 0 73 18 87 2 74 0 0 + 0 88 0 74 0 89 2 74 0 73 0 90 2 91 0 + 0 0 92 1 0 13 0 52 1 0 10 0 53 1 0 19 + 0 21 1 0 15 0 16 0 0 0 9 2 0 93 93 93 + 94 1 0 35 0 61 2 0 58 0 0 72 1 0 0 0 + 8 0 0 0 46 1 0 32 33 34 1 0 0 0 39 1 + 0 15 0 40))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/FFIELDC.lsp b/src/algebra/strap/FFIELDC.lsp new file mode 100644 index 00000000..9099175c --- /dev/null +++ b/src/algebra/strap/FFIELDC.lsp @@ -0,0 +1,60 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |FiniteFieldCategory;AL| 'NIL) + +(DEFUN |FiniteFieldCategory| () + (LET (#:G1395) + (COND + (|FiniteFieldCategory;AL|) + (T (SETQ |FiniteFieldCategory;AL| (|FiniteFieldCategory;|)))))) + +(DEFUN |FiniteFieldCategory;| () + (PROG (#0=#:G1393) + (RETURN + (PROG1 (LETT #0# + (|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|) + (SETELT #0# 0 '(|FiniteFieldCategory|)))))) + +(MAKEPROP '|FiniteFieldCategory| 'NILADIC T) diff --git a/src/algebra/strap/FPS-.lsp b/src/algebra/strap/FPS-.lsp new file mode 100644 index 00000000..56751bc4 --- /dev/null +++ b/src/algebra/strap/FPS-.lsp @@ -0,0 +1,50 @@ + +(/VERSIONCHECK 2) + +(DEFUN |FPS-;float;2IS;1| (|ma| |ex| $) + (SPADCALL |ma| |ex| (SPADCALL (QREFELT $ 8)) (QREFELT $ 10))) + +(DEFUN |FPS-;digits;Pi;2| ($) + (PROG (#0=#:G1389) + (RETURN + (PROG1 (LETT #0# + (MAX 1 + (QUOTIENT2 + (SPADCALL 4004 + (- (SPADCALL (QREFELT $ 13)) 1) + (QREFELT $ 14)) + 13301)) + |FPS-;digits;Pi;2|) + (|check-subtype| (> #0# 0) '(|PositiveInteger|) #0#))))) + +(DEFUN |FloatingPointSystem&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|FloatingPointSystem&|)) + (LETT |dv$| (LIST '|FloatingPointSystem&| |dv$1|) . #0#) + (LETT $ (GETREFV 17) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasAttribute| |#1| '|arbitraryExponent|) + (|HasAttribute| |#1| '|arbitraryPrecision|))) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|FloatingPointSystem&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|PositiveInteger|) + (0 . |base|) (|Integer|) (4 . |float|) |FPS-;float;2IS;1| + (11 . |One|) (15 . |bits|) (19 . *) (25 . |max|) + |FPS-;digits;Pi;2|) + '#(|float| 29 |digits| 35) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 16 + '(0 6 7 8 3 6 0 9 9 7 10 0 6 0 12 0 6 7 + 13 2 9 0 7 0 14 0 6 0 15 2 0 0 9 9 11 + 0 0 7 16))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/FPS.lsp b/src/algebra/strap/FPS.lsp new file mode 100644 index 00000000..75e426f7 --- /dev/null +++ b/src/algebra/strap/FPS.lsp @@ -0,0 +1,81 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |FloatingPointSystem;AL| 'NIL) + +(DEFUN |FloatingPointSystem| () + (LET (#:G1387) + (COND + (|FloatingPointSystem;AL|) + (T (SETQ |FloatingPointSystem;AL| (|FloatingPointSystem;|)))))) + +(DEFUN |FloatingPointSystem;| () + (PROG (#0=#:G1385) + (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|) + (SETELT #0# 0 '(|FloatingPointSystem|)))))) + +(MAKEPROP '|FloatingPointSystem| 'NILADIC T) diff --git a/src/algebra/strap/GCDDOM-.lsp b/src/algebra/strap/GCDDOM-.lsp new file mode 100644 index 00000000..b5c3cd1f --- /dev/null +++ b/src/algebra/strap/GCDDOM-.lsp @@ -0,0 +1,208 @@ + +(/VERSIONCHECK 2) + +(DEFUN |GCDDOM-;lcm;3S;1| (|x| |y| $) + (PROG (LCM) + (RETURN + (SEQ (COND + ((OR (SPADCALL |y| (|spadConstant| $ 7) (QREFELT $ 9)) + (SPADCALL |x| (|spadConstant| $ 7) (QREFELT $ 9))) + (|spadConstant| $ 7)) + ('T + (SEQ (LETT LCM + (SPADCALL |y| + (SPADCALL |x| |y| (QREFELT $ 10)) + (QREFELT $ 12)) + |GCDDOM-;lcm;3S;1|) + (EXIT (COND + ((QEQCAR LCM 0) + (SPADCALL |x| (QCDR LCM) (QREFELT $ 13))) + ('T (|error| "bad gcd in lcm computation"))))))))))) + +(DEFUN |GCDDOM-;lcm;LS;2| (|l| $) + (SPADCALL (ELT $ 15) |l| (|spadConstant| $ 16) (|spadConstant| $ 7) + (QREFELT $ 19))) + +(DEFUN |GCDDOM-;gcd;LS;3| (|l| $) + (SPADCALL (ELT $ 10) |l| (|spadConstant| $ 7) (|spadConstant| $ 16) + (QREFELT $ 19))) + +(DEFUN |GCDDOM-;gcdPolynomial;3Sup;4| (|p1| |p2| $) + (PROG (|e2| |e1| |c1| |p| |c2| #0=#:G1406) + (RETURN + (SEQ (COND + ((SPADCALL |p1| (QREFELT $ 24)) + (SPADCALL |p2| (QREFELT $ 25))) + ((SPADCALL |p2| (QREFELT $ 24)) + (SPADCALL |p1| (QREFELT $ 25))) + ('T + (SEQ (LETT |c1| (SPADCALL |p1| (QREFELT $ 26)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (LETT |c2| (SPADCALL |p2| (QREFELT $ 26)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (LETT |p1| + (PROG2 (LETT #0# + (SPADCALL |p1| |c1| + (QREFELT $ 27)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|SparseUnivariatePolynomial| + (QREFELT $ 6)) + #0#)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (LETT |p2| + (PROG2 (LETT #0# + (SPADCALL |p2| |c2| + (QREFELT $ 27)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|SparseUnivariatePolynomial| + (QREFELT $ 6)) + #0#)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (SEQ (LETT |e1| (SPADCALL |p1| (QREFELT $ 29)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT (COND + ((< 0 |e1|) + (LETT |p1| + (PROG2 + (LETT #0# + (SPADCALL |p1| + (SPADCALL + (|spadConstant| $ 16) |e1| + (QREFELT $ 32)) + (QREFELT $ 33)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|SparseUnivariatePolynomial| + (QREFELT $ 6)) + #0#)) + |GCDDOM-;gcdPolynomial;3Sup;4|))))) + (SEQ (LETT |e2| (SPADCALL |p2| (QREFELT $ 29)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT (COND + ((< 0 |e2|) + (LETT |p2| + (PROG2 + (LETT #0# + (SPADCALL |p2| + (SPADCALL + (|spadConstant| $ 16) |e2| + (QREFELT $ 32)) + (QREFELT $ 33)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|SparseUnivariatePolynomial| + (QREFELT $ 6)) + #0#)) + |GCDDOM-;gcdPolynomial;3Sup;4|))))) + (LETT |e1| (MIN |e1| |e2|) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (LETT |c1| (SPADCALL |c1| |c2| (QREFELT $ 10)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (LETT |p1| + (COND + ((OR (EQL (SPADCALL |p1| (QREFELT $ 34)) 0) + (EQL (SPADCALL |p2| (QREFELT $ 34)) 0)) + (SPADCALL |c1| 0 (QREFELT $ 32))) + ('T + (SEQ (LETT |p| + (SPADCALL |p1| |p2| + (QREFELT $ 35)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT (COND + ((EQL + (SPADCALL |p| + (QREFELT $ 34)) + 0) + (SPADCALL |c1| 0 + (QREFELT $ 32))) + ('T + (SEQ + (LETT |c2| + (SPADCALL + (SPADCALL |p1| + (QREFELT $ 36)) + (SPADCALL |p2| + (QREFELT $ 36)) + (QREFELT $ 10)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT + (SPADCALL + (SPADCALL |c1| + (SPADCALL + (PROG2 + (LETT #0# + (SPADCALL + (SPADCALL |c2| |p| + (QREFELT $ 37)) + (SPADCALL |p| + (QREFELT $ 36)) + (QREFELT $ 27)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (QCDR #0#) + (|check-union| + (QEQCAR #0# 0) + (|SparseUnivariatePolynomial| + (QREFELT $ 6)) + #0#)) + (QREFELT $ 38)) + (QREFELT $ 37)) + (QREFELT $ 25)))))))))) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT (COND + ((ZEROP |e1|) |p1|) + ('T + (SPADCALL + (SPADCALL (|spadConstant| $ 16) |e1| + (QREFELT $ 32)) + |p1| (QREFELT $ 39)))))))))))) + +(DEFUN |GcdDomain&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|GcdDomain&|)) + (LETT |dv$| (LIST '|GcdDomain&| |dv$1|) . #0#) + (LETT $ (GETREFV 42) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|GcdDomain&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|) + (|Boolean|) (4 . =) (10 . |gcd|) (|Union| $ '"failed") + (16 . |exquo|) (22 . *) |GCDDOM-;lcm;3S;1| (28 . |lcm|) + (34 . |One|) (|Mapping| 6 6 6) (|List| 6) (38 . |reduce|) + (|List| $) |GCDDOM-;lcm;LS;2| |GCDDOM-;gcd;LS;3| + (|SparseUnivariatePolynomial| 6) (46 . |zero?|) + (51 . |unitCanonical|) (56 . |content|) (61 . |exquo|) + (|NonNegativeInteger|) (67 . |minimumDegree|) + (72 . |Zero|) (76 . |One|) (80 . |monomial|) + (86 . |exquo|) (92 . |degree|) (97 . |subResultantGcd|) + (103 . |leadingCoefficient|) (108 . *) + (114 . |primitivePart|) (119 . *) + (|SparseUnivariatePolynomial| $) + |GCDDOM-;gcdPolynomial;3Sup;4|) + '#(|lcm| 125 |gcdPolynomial| 136 |gcd| 142) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 41 + '(0 6 0 7 2 6 8 0 0 9 2 6 0 0 0 10 2 6 + 11 0 0 12 2 6 0 0 0 13 2 6 0 0 0 15 0 + 6 0 16 4 18 6 17 0 6 6 19 1 23 8 0 24 + 1 23 0 0 25 1 23 6 0 26 2 23 11 0 6 + 27 1 23 28 0 29 0 23 0 30 0 23 0 31 2 + 23 0 6 28 32 2 23 11 0 0 33 1 23 28 0 + 34 2 23 0 0 0 35 1 23 6 0 36 2 23 0 6 + 0 37 1 23 0 0 38 2 23 0 0 0 39 1 0 0 + 20 21 2 0 0 0 0 14 2 0 40 40 40 41 1 + 0 0 20 22))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/GCDDOM.lsp b/src/algebra/strap/GCDDOM.lsp new file mode 100644 index 00000000..1756b55f --- /dev/null +++ b/src/algebra/strap/GCDDOM.lsp @@ -0,0 +1,32 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |GcdDomain;AL| 'NIL) + +(DEFUN |GcdDomain| () + (LET (#:G1393) + (COND (|GcdDomain;AL|) (T (SETQ |GcdDomain;AL| (|GcdDomain;|)))))) + +(DEFUN |GcdDomain;| () + (PROG (#0=#:G1391) + (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|) + (SETELT #0# 0 '(|GcdDomain|)))))) + +(MAKEPROP '|GcdDomain| 'NILADIC T) diff --git a/src/algebra/strap/HOAGG-.lsp b/src/algebra/strap/HOAGG-.lsp new file mode 100644 index 00000000..de348637 --- /dev/null +++ b/src/algebra/strap/HOAGG-.lsp @@ -0,0 +1,288 @@ + +(/VERSIONCHECK 2) + +(DEFUN |HOAGG-;eval;ALA;1| (|u| |l| $) + (SPADCALL (CONS #'|HOAGG-;eval;ALA;1!0| (VECTOR $ |l|)) |u| + (QREFELT $ 11))) + +(DEFUN |HOAGG-;eval;ALA;1!0| (|#1| $$) + (SPADCALL |#1| (QREFELT $$ 1) (QREFELT (QREFELT $$ 0) 9))) + +(DEFUN |HOAGG-;#;ANni;2| (|c| $) + (LENGTH (SPADCALL |c| (QREFELT $ 14)))) + +(DEFUN |HOAGG-;any?;MAB;3| (|f| |c| $) + (PROG (|x| #0=#:G1409 #1=#:G1406 #2=#:G1404 #3=#:G1405) + (RETURN + (SEQ (PROGN + (LETT #3# NIL |HOAGG-;any?;MAB;3|) + (SEQ (LETT |x| NIL |HOAGG-;any?;MAB;3|) + (LETT #0# (SPADCALL |c| (QREFELT $ 14)) + |HOAGG-;any?;MAB;3|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |x| (CAR #0#) |HOAGG-;any?;MAB;3|) + NIL)) + (GO G191))) + (SEQ (EXIT (PROGN + (LETT #1# (SPADCALL |x| |f|) + |HOAGG-;any?;MAB;3|) + (COND + (#3# (LETT #2# + (COND (#2# 'T) ('T #1#)) + |HOAGG-;any?;MAB;3|)) + ('T + (PROGN + (LETT #2# #1# |HOAGG-;any?;MAB;3|) + (LETT #3# 'T |HOAGG-;any?;MAB;3|))))))) + (LETT #0# (CDR #0#) |HOAGG-;any?;MAB;3|) (GO G190) + G191 (EXIT NIL)) + (COND (#3# #2#) ('T 'NIL))))))) + +(DEFUN |HOAGG-;every?;MAB;4| (|f| |c| $) + (PROG (|x| #0=#:G1414 #1=#:G1412 #2=#:G1410 #3=#:G1411) + (RETURN + (SEQ (PROGN + (LETT #3# NIL |HOAGG-;every?;MAB;4|) + (SEQ (LETT |x| NIL |HOAGG-;every?;MAB;4|) + (LETT #0# (SPADCALL |c| (QREFELT $ 14)) + |HOAGG-;every?;MAB;4|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |x| (CAR #0#) |HOAGG-;every?;MAB;4|) + NIL)) + (GO G191))) + (SEQ (EXIT (PROGN + (LETT #1# (SPADCALL |x| |f|) + |HOAGG-;every?;MAB;4|) + (COND + (#3# (LETT #2# + (COND (#2# #1#) ('T 'NIL)) + |HOAGG-;every?;MAB;4|)) + ('T + (PROGN + (LETT #2# #1# + |HOAGG-;every?;MAB;4|) + (LETT #3# 'T |HOAGG-;every?;MAB;4|))))))) + (LETT #0# (CDR #0#) |HOAGG-;every?;MAB;4|) (GO G190) + G191 (EXIT NIL)) + (COND (#3# #2#) ('T 'T))))))) + +(DEFUN |HOAGG-;count;MANni;5| (|f| |c| $) + (PROG (|x| #0=#:G1419 #1=#:G1417 #2=#:G1415 #3=#:G1416) + (RETURN + (SEQ (PROGN + (LETT #3# NIL |HOAGG-;count;MANni;5|) + (SEQ (LETT |x| NIL |HOAGG-;count;MANni;5|) + (LETT #0# (SPADCALL |c| (QREFELT $ 14)) + |HOAGG-;count;MANni;5|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |x| (CAR #0#) |HOAGG-;count;MANni;5|) + NIL)) + (GO G191))) + (SEQ (EXIT (COND + ((SPADCALL |x| |f|) + (PROGN + (LETT #1# 1 |HOAGG-;count;MANni;5|) + (COND + (#3# + (LETT #2# (+ #2# #1#) + |HOAGG-;count;MANni;5|)) + ('T + (PROGN + (LETT #2# #1# + |HOAGG-;count;MANni;5|) + (LETT #3# 'T + |HOAGG-;count;MANni;5|))))))))) + (LETT #0# (CDR #0#) |HOAGG-;count;MANni;5|) (GO G190) + G191 (EXIT NIL)) + (COND (#3# #2#) ('T 0))))))) + +(DEFUN |HOAGG-;members;AL;6| (|x| $) (SPADCALL |x| (QREFELT $ 14))) + +(DEFUN |HOAGG-;count;SANni;7| (|s| |x| $) + (SPADCALL (CONS #'|HOAGG-;count;SANni;7!0| (VECTOR $ |s|)) |x| + (QREFELT $ 24))) + +(DEFUN |HOAGG-;count;SANni;7!0| (|#1| $$) + (SPADCALL (QREFELT $$ 1) |#1| (QREFELT (QREFELT $$ 0) 23))) + +(DEFUN |HOAGG-;member?;SAB;8| (|e| |c| $) + (SPADCALL (CONS #'|HOAGG-;member?;SAB;8!0| (VECTOR $ |e|)) |c| + (QREFELT $ 26))) + +(DEFUN |HOAGG-;member?;SAB;8!0| (|#1| $$) + (SPADCALL (QREFELT $$ 1) |#1| (QREFELT (QREFELT $$ 0) 23))) + +(DEFUN |HOAGG-;=;2AB;9| (|x| |y| $) + (PROG (|b| #0=#:G1429 |a| #1=#:G1428 #2=#:G1425 #3=#:G1423 + #4=#:G1424) + (RETURN + (SEQ (COND + ((SPADCALL |x| (SPADCALL |y| (QREFELT $ 28)) + (QREFELT $ 29)) + (PROGN + (LETT #4# NIL |HOAGG-;=;2AB;9|) + (SEQ (LETT |b| NIL |HOAGG-;=;2AB;9|) + (LETT #0# (SPADCALL |y| (QREFELT $ 14)) + |HOAGG-;=;2AB;9|) + (LETT |a| NIL |HOAGG-;=;2AB;9|) + (LETT #1# (SPADCALL |x| (QREFELT $ 14)) + |HOAGG-;=;2AB;9|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |a| (CAR #1#) |HOAGG-;=;2AB;9|) + NIL) + (ATOM #0#) + (PROGN + (LETT |b| (CAR #0#) |HOAGG-;=;2AB;9|) + NIL)) + (GO G191))) + (SEQ (EXIT (PROGN + (LETT #2# + (SPADCALL |a| |b| + (QREFELT $ 23)) + |HOAGG-;=;2AB;9|) + (COND + (#4# + (LETT #3# + (COND (#3# #2#) ('T 'NIL)) + |HOAGG-;=;2AB;9|)) + ('T + (PROGN + (LETT #3# #2# |HOAGG-;=;2AB;9|) + (LETT #4# 'T |HOAGG-;=;2AB;9|))))))) + (LETT #1# + (PROG1 (CDR #1#) + (LETT #0# (CDR #0#) |HOAGG-;=;2AB;9|)) + |HOAGG-;=;2AB;9|) + (GO G190) G191 (EXIT NIL)) + (COND (#4# #3#) ('T 'T)))) + ('T 'NIL)))))) + +(DEFUN |HOAGG-;coerce;AOf;10| (|x| $) + (PROG (#0=#:G1433 |a| #1=#:G1434) + (RETURN + (SEQ (SPADCALL + (SPADCALL + (PROGN + (LETT #0# NIL |HOAGG-;coerce;AOf;10|) + (SEQ (LETT |a| NIL |HOAGG-;coerce;AOf;10|) + (LETT #1# (SPADCALL |x| (QREFELT $ 14)) + |HOAGG-;coerce;AOf;10|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |a| (CAR #1#) + |HOAGG-;coerce;AOf;10|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |a| (QREFELT $ 32)) + #0#) + |HOAGG-;coerce;AOf;10|))) + (LETT #1# (CDR #1#) |HOAGG-;coerce;AOf;10|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + (QREFELT $ 34)) + (QREFELT $ 35)))))) + +(DEFUN |HomogeneousAggregate&| (|#1| |#2|) + (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|HomogeneousAggregate&|)) + (LETT |dv$2| (|devaluate| |#2|) . #0#) + (LETT |dv$| + (LIST '|HomogeneousAggregate&| |dv$1| |dv$2|) . #0#) + (LETT $ (GETREFV 38) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasAttribute| |#1| '|finiteAggregate|) + (|HasAttribute| |#1| '|shallowlyMutable|) + (|HasCategory| |#2| + (LIST '|Evalable| (|devaluate| |#2|))) + (|HasCategory| |#2| '(|SetCategory|)) + (|HasCategory| |#2| + '(|CoercibleTo| (|OutputForm|))))) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (QSETREFV $ 7 |#2|) + (COND + ((|testBitVector| |pv$| 3) + (QSETREFV $ 12 + (CONS (|dispatchFunction| |HOAGG-;eval;ALA;1|) $)))) + (COND + ((|testBitVector| |pv$| 1) + (PROGN + (QSETREFV $ 16 + (CONS (|dispatchFunction| |HOAGG-;#;ANni;2|) $)) + (QSETREFV $ 19 + (CONS (|dispatchFunction| |HOAGG-;any?;MAB;3|) $)) + (QSETREFV $ 20 + (CONS (|dispatchFunction| |HOAGG-;every?;MAB;4|) $)) + (QSETREFV $ 21 + (CONS (|dispatchFunction| |HOAGG-;count;MANni;5|) $)) + (QSETREFV $ 22 + (CONS (|dispatchFunction| |HOAGG-;members;AL;6|) $)) + (COND + ((|testBitVector| |pv$| 4) + (PROGN + (QSETREFV $ 25 + (CONS (|dispatchFunction| |HOAGG-;count;SANni;7|) + $)) + (QSETREFV $ 27 + (CONS (|dispatchFunction| |HOAGG-;member?;SAB;8|) + $)) + (QSETREFV $ 30 + (CONS (|dispatchFunction| |HOAGG-;=;2AB;9|) $))))) + (COND + ((|testBitVector| |pv$| 5) + (QSETREFV $ 36 + (CONS (|dispatchFunction| |HOAGG-;coerce;AOf;10|) + $))))))) + $)))) + +(MAKEPROP '|HomogeneousAggregate&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|List| 37) (0 . |eval|) (|Mapping| 7 7) (6 . |map|) + (12 . |eval|) (|List| 7) (18 . |parts|) + (|NonNegativeInteger|) (23 . |#|) (|Boolean|) + (|Mapping| 17 7) (28 . |any?|) (34 . |every?|) + (40 . |count|) (46 . |members|) (51 . =) (57 . |count|) + (63 . |count|) (69 . |any?|) (75 . |member?|) (81 . |#|) + (86 . |size?|) (92 . =) (|OutputForm|) (98 . |coerce|) + (|List| $) (103 . |commaSeparate|) (108 . |bracket|) + (113 . |coerce|) (|Equation| 7)) + '#(|members| 118 |member?| 123 |every?| 129 |eval| 135 + |count| 141 |coerce| 153 |any?| 158 = 164 |#| 170) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 36 + '(2 7 0 0 8 9 2 6 0 10 0 11 2 0 0 0 8 + 12 1 6 13 0 14 1 0 15 0 16 2 0 17 18 + 0 19 2 0 17 18 0 20 2 0 15 18 0 21 1 + 0 13 0 22 2 7 17 0 0 23 2 6 15 18 0 + 24 2 0 15 7 0 25 2 6 17 18 0 26 2 0 + 17 7 0 27 1 6 15 0 28 2 6 17 0 15 29 + 2 0 17 0 0 30 1 7 31 0 32 1 31 0 33 + 34 1 31 0 0 35 1 0 31 0 36 1 0 13 0 + 22 2 0 17 7 0 27 2 0 17 18 0 20 2 0 0 + 0 8 12 2 0 15 7 0 25 2 0 15 18 0 21 1 + 0 31 0 36 2 0 17 18 0 19 2 0 17 0 0 + 30 1 0 15 0 16))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/HOAGG.lsp b/src/algebra/strap/HOAGG.lsp new file mode 100644 index 00000000..1dc9a3bf --- /dev/null +++ b/src/algebra/strap/HOAGG.lsp @@ -0,0 +1,112 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |HomogeneousAggregate;CAT| 'NIL) + +(DEFPARAMETER |HomogeneousAggregate;AL| 'NIL) + +(DEFUN |HomogeneousAggregate| (#0=#:G1399) + (LET (#1=#:G1400) + (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#)))) + +(DEFUN |HomogeneousAggregate;| (|t#1|) + (PROG (#0=#:G1398) + (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#) + (SETELT #0# 0 + (LIST '|HomogeneousAggregate| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp new file mode 100644 index 00000000..569cd271 --- /dev/null +++ b/src/algebra/strap/ILIST.lsp @@ -0,0 +1,621 @@ + +(/VERSIONCHECK 2) + +(PUT '|ILIST;#;$Nni;1| '|SPADreplace| 'LENGTH) + +(DEFUN |ILIST;#;$Nni;1| (|x| $) (LENGTH |x|)) + +(PUT '|ILIST;concat;S2$;2| '|SPADreplace| 'CONS) + +(DEFUN |ILIST;concat;S2$;2| (|s| |x| $) (CONS |s| |x|)) + +(PUT '|ILIST;eq?;2$B;3| '|SPADreplace| 'EQ) + +(DEFUN |ILIST;eq?;2$B;3| (|x| |y| $) (EQ |x| |y|)) + +(PUT '|ILIST;first;$S;4| '|SPADreplace| '|SPADfirst|) + +(DEFUN |ILIST;first;$S;4| (|x| $) (|SPADfirst| |x|)) + +(PUT '|ILIST;elt;$firstS;5| '|SPADreplace| + '(XLAM (|x| "first") (|SPADfirst| |x|))) + +(DEFUN |ILIST;elt;$firstS;5| (|x| T0 $) (|SPADfirst| |x|)) + +(PUT '|ILIST;empty;$;6| '|SPADreplace| '(XLAM NIL NIL)) + +(DEFUN |ILIST;empty;$;6| ($) NIL) + +(PUT '|ILIST;empty?;$B;7| '|SPADreplace| 'NULL) + +(DEFUN |ILIST;empty?;$B;7| (|x| $) (NULL |x|)) + +(PUT '|ILIST;rest;2$;8| '|SPADreplace| 'CDR) + +(DEFUN |ILIST;rest;2$;8| (|x| $) (CDR |x|)) + +(PUT '|ILIST;elt;$rest$;9| '|SPADreplace| + '(XLAM (|x| "rest") (CDR |x|))) + +(DEFUN |ILIST;elt;$rest$;9| (|x| T1 $) (CDR |x|)) + +(DEFUN |ILIST;setfirst!;$2S;10| (|x| |s| $) + (COND + ((SPADCALL |x| (QREFELT $ 17)) + (|error| "Cannot update an empty list")) + ('T (QCAR (RPLACA |x| |s|))))) + +(DEFUN |ILIST;setelt;$first2S;11| (|x| T2 |s| $) + (COND + ((SPADCALL |x| (QREFELT $ 17)) + (|error| "Cannot update an empty list")) + ('T (QCAR (RPLACA |x| |s|))))) + +(DEFUN |ILIST;setrest!;3$;12| (|x| |y| $) + (COND + ((SPADCALL |x| (QREFELT $ 17)) + (|error| "Cannot update an empty list")) + ('T (QCDR (RPLACD |x| |y|))))) + +(DEFUN |ILIST;setelt;$rest2$;13| (|x| T3 |y| $) + (COND + ((SPADCALL |x| (QREFELT $ 17)) + (|error| "Cannot update an empty list")) + ('T (QCDR (RPLACD |x| |y|))))) + +(PUT '|ILIST;construct;L$;14| '|SPADreplace| '(XLAM (|l|) |l|)) + +(DEFUN |ILIST;construct;L$;14| (|l| $) |l|) + +(PUT '|ILIST;parts;$L;15| '|SPADreplace| '(XLAM (|s|) |s|)) + +(DEFUN |ILIST;parts;$L;15| (|s| $) |s|) + +(PUT '|ILIST;reverse!;2$;16| '|SPADreplace| 'NREVERSE) + +(DEFUN |ILIST;reverse!;2$;16| (|x| $) (NREVERSE |x|)) + +(PUT '|ILIST;reverse;2$;17| '|SPADreplace| 'REVERSE) + +(DEFUN |ILIST;reverse;2$;17| (|x| $) (REVERSE |x|)) + +(DEFUN |ILIST;minIndex;$I;18| (|x| $) (QREFELT $ 7)) + +(DEFUN |ILIST;rest;$Nni$;19| (|x| |n| $) + (PROG (|i|) + (RETURN + (SEQ (SEQ (LETT |i| 1 |ILIST;rest;$Nni$;19|) G190 + (COND ((QSGREATERP |i| |n|) (GO G191))) + (SEQ (COND + ((NULL |x|) (|error| "index out of range"))) + (EXIT (LETT |x| (QCDR |x|) |ILIST;rest;$Nni$;19|))) + (LETT |i| (QSADD1 |i|) |ILIST;rest;$Nni$;19|) (GO G190) + G191 (EXIT NIL)) + (EXIT |x|))))) + +(DEFUN |ILIST;copy;2$;20| (|x| $) + (PROG (|i| |y|) + (RETURN + (SEQ (LETT |y| (SPADCALL (QREFELT $ 16)) |ILIST;copy;2$;20|) + (SEQ (LETT |i| 0 |ILIST;copy;2$;20|) G190 + (COND + ((NULL (SPADCALL (NULL |x|) (QREFELT $ 33))) + (GO G191))) + (SEQ (COND + ((EQ |i| 1000) + (COND + ((SPADCALL |x| (QREFELT $ 34)) + (|error| "cyclic list"))))) + (LETT |y| (CONS (QCAR |x|) |y|) + |ILIST;copy;2$;20|) + (EXIT (LETT |x| (QCDR |x|) |ILIST;copy;2$;20|))) + (LETT |i| (QSADD1 |i|) |ILIST;copy;2$;20|) (GO G190) + G191 (EXIT NIL)) + (EXIT (NREVERSE |y|)))))) + +(DEFUN |ILIST;coerce;$Of;21| (|x| $) + (PROG (|s| |y| |z|) + (RETURN + (SEQ (LETT |y| NIL |ILIST;coerce;$Of;21|) + (LETT |s| (SPADCALL |x| (QREFELT $ 36)) + |ILIST;coerce;$Of;21|) + (SEQ G190 (COND ((NULL (NEQ |x| |s|)) (GO G191))) + (SEQ (LETT |y| + (CONS (SPADCALL + (SPADCALL |x| (QREFELT $ 13)) + (QREFELT $ 38)) + |y|) + |ILIST;coerce;$Of;21|) + (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 18)) + |ILIST;coerce;$Of;21|))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |y| (NREVERSE |y|) |ILIST;coerce;$Of;21|) + (EXIT (COND + ((SPADCALL |s| (QREFELT $ 17)) + (SPADCALL |y| (QREFELT $ 40))) + ('T + (SEQ (LETT |z| + (SPADCALL + (SPADCALL + (SPADCALL |x| (QREFELT $ 13)) + (QREFELT $ 38)) + (QREFELT $ 42)) + |ILIST;coerce;$Of;21|) + (SEQ G190 + (COND + ((NULL (NEQ |s| + (SPADCALL |x| (QREFELT $ 18)))) + (GO G191))) + (SEQ (LETT |x| + (SPADCALL |x| (QREFELT $ 18)) + |ILIST;coerce;$Of;21|) + (EXIT + (LETT |z| + (CONS + (SPADCALL + (SPADCALL |x| (QREFELT $ 13)) + (QREFELT $ 38)) + |z|) + |ILIST;coerce;$Of;21|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL + (SPADCALL |y| + (SPADCALL + (SPADCALL (NREVERSE |z|) + (QREFELT $ 43)) + (QREFELT $ 44)) + (QREFELT $ 45)) + (QREFELT $ 40))))))))))) + +(DEFUN |ILIST;=;2$B;22| (|x| |y| $) + (PROG (#0=#:G1469) + (RETURN + (SEQ (EXIT (COND + ((EQ |x| |y|) 'T) + ('T + (SEQ (SEQ G190 + (COND + ((NULL (COND + ((NULL |x|) 'NIL) + ('T + (SPADCALL (NULL |y|) + (QREFELT $ 33))))) + (GO G191))) + (SEQ (EXIT + (COND + ((NULL + (SPADCALL (QCAR |x|) (QCAR |y|) + (QREFELT $ 47))) + (PROGN + (LETT #0# 'NIL + |ILIST;=;2$B;22|) + (GO #0#))) + ('T + (SEQ + (LETT |x| (QCDR |x|) + |ILIST;=;2$B;22|) + (EXIT + (LETT |y| (QCDR |y|) + |ILIST;=;2$B;22|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((NULL |x|) (NULL |y|)) + ('T 'NIL))))))) + #0# (EXIT #0#))))) + +(DEFUN |ILIST;latex;$S;23| (|x| $) + (PROG (|s|) + (RETURN + (SEQ (LETT |s| "\\left[" |ILIST;latex;$S;23|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |x|) (QREFELT $ 33))) + (GO G191))) + (SEQ (LETT |s| + (STRCONC |s| + (SPADCALL (QCAR |x|) + (QREFELT $ 50))) + |ILIST;latex;$S;23|) + (LETT |x| (QCDR |x|) |ILIST;latex;$S;23|) + (EXIT (COND + ((NULL (NULL |x|)) + (LETT |s| (STRCONC |s| ", ") + |ILIST;latex;$S;23|))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (STRCONC |s| " \\right]")))))) + +(DEFUN |ILIST;member?;S$B;24| (|s| |x| $) + (PROG (#0=#:G1477) + (RETURN + (SEQ (EXIT (SEQ (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |x|) + (QREFELT $ 33))) + (GO G191))) + (SEQ (EXIT (COND + ((SPADCALL |s| (QCAR |x|) + (QREFELT $ 47)) + (PROGN + (LETT #0# 'T + |ILIST;member?;S$B;24|) + (GO #0#))) + ('T + (LETT |x| (QCDR |x|) + |ILIST;member?;S$B;24|))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT 'NIL))) + #0# (EXIT #0#))))) + +(DEFUN |ILIST;concat!;3$;25| (|x| |y| $) + (PROG (|z|) + (RETURN + (SEQ (COND + ((NULL |x|) + (COND + ((NULL |y|) |x|) + ('T + (SEQ (PUSH (SPADCALL |y| (QREFELT $ 13)) |x|) + (QRPLACD |x| (SPADCALL |y| (QREFELT $ 18))) + (EXIT |x|))))) + ('T + (SEQ (LETT |z| |x| |ILIST;concat!;3$;25|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL (QCDR |z|)) + (QREFELT $ 33))) + (GO G191))) + (SEQ (EXIT (LETT |z| (QCDR |z|) + |ILIST;concat!;3$;25|))) + NIL (GO G190) G191 (EXIT NIL)) + (QRPLACD |z| |y|) (EXIT |x|)))))))) + +(DEFUN |ILIST;removeDuplicates!;2$;26| (|l| $) + (PROG (|f| |p| |pr| |pp|) + (RETURN + (SEQ (LETT |p| |l| |ILIST;removeDuplicates!;2$;26|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |p|) (QREFELT $ 33))) + (GO G191))) + (SEQ (LETT |pp| |p| |ILIST;removeDuplicates!;2$;26|) + (LETT |f| (QCAR |p|) + |ILIST;removeDuplicates!;2$;26|) + (LETT |p| (QCDR |p|) + |ILIST;removeDuplicates!;2$;26|) + (EXIT (SEQ G190 + (COND + ((NULL + (SPADCALL + (NULL + (LETT |pr| (QCDR |pp|) + |ILIST;removeDuplicates!;2$;26|)) + (QREFELT $ 33))) + (GO G191))) + (SEQ (EXIT + (COND + ((SPADCALL (QCAR |pr|) |f| + (QREFELT $ 47)) + (QRPLACD |pp| (QCDR |pr|))) + ('T + (LETT |pp| |pr| + |ILIST;removeDuplicates!;2$;26|))))) + NIL (GO G190) G191 (EXIT NIL)))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |l|))))) + +(DEFUN |ILIST;sort!;M2$;27| (|f| |l| $) + (|ILIST;mergeSort| |f| |l| (SPADCALL |l| (QREFELT $ 9)) $)) + +(DEFUN |ILIST;merge!;M3$;28| (|f| |p| |q| $) + (PROG (|r| |t|) + (RETURN + (SEQ (COND + ((NULL |p|) |q|) + ((NULL |q|) |p|) + ((EQ |p| |q|) (|error| "cannot merge a list into itself")) + ('T + (SEQ (COND + ((SPADCALL (QCAR |p|) (QCAR |q|) |f|) + (SEQ (LETT |r| + (LETT |t| |p| |ILIST;merge!;M3$;28|) + |ILIST;merge!;M3$;28|) + (EXIT (LETT |p| (QCDR |p|) + |ILIST;merge!;M3$;28|)))) + ('T + (SEQ (LETT |r| + (LETT |t| |q| |ILIST;merge!;M3$;28|) + |ILIST;merge!;M3$;28|) + (EXIT (LETT |q| (QCDR |q|) + |ILIST;merge!;M3$;28|))))) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |p|) 'NIL) + ('T + (SPADCALL (NULL |q|) + (QREFELT $ 33))))) + (GO G191))) + (SEQ (EXIT (COND + ((SPADCALL (QCAR |p|) (QCAR |q|) + |f|) + (SEQ (QRPLACD |t| |p|) + (LETT |t| |p| + |ILIST;merge!;M3$;28|) + (EXIT + (LETT |p| (QCDR |p|) + |ILIST;merge!;M3$;28|)))) + ('T + (SEQ (QRPLACD |t| |q|) + (LETT |t| |q| + |ILIST;merge!;M3$;28|) + (EXIT + (LETT |q| (QCDR |q|) + |ILIST;merge!;M3$;28|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (QRPLACD |t| (COND ((NULL |p|) |q|) ('T |p|))) + (EXIT |r|)))))))) + +(DEFUN |ILIST;split!;$I$;29| (|p| |n| $) + (PROG (#0=#:G1506 |q|) + (RETURN + (SEQ (COND + ((< |n| 1) (|error| "index out of range")) + ('T + (SEQ (LETT |p| + (SPADCALL |p| + (PROG1 (LETT #0# (- |n| 1) + |ILIST;split!;$I$;29|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 32)) + |ILIST;split!;$I$;29|) + (LETT |q| (QCDR |p|) |ILIST;split!;$I$;29|) + (QRPLACD |p| NIL) (EXIT |q|)))))))) + +(DEFUN |ILIST;mergeSort| (|f| |p| |n| $) + (PROG (#0=#:G1510 |l| |q|) + (RETURN + (SEQ (COND + ((EQL |n| 2) + (COND + ((SPADCALL + (SPADCALL (SPADCALL |p| (QREFELT $ 18)) + (QREFELT $ 13)) + (SPADCALL |p| (QREFELT $ 13)) |f|) + (LETT |p| (SPADCALL |p| (QREFELT $ 28)) + |ILIST;mergeSort|))))) + (EXIT (COND + ((< |n| 3) |p|) + ('T + (SEQ (LETT |l| + (PROG1 (LETT #0# (QUOTIENT2 |n| 2) + |ILIST;mergeSort|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + |ILIST;mergeSort|) + (LETT |q| (SPADCALL |p| |l| (QREFELT $ 58)) + |ILIST;mergeSort|) + (LETT |p| (|ILIST;mergeSort| |f| |p| |l| $) + |ILIST;mergeSort|) + (LETT |q| + (|ILIST;mergeSort| |f| |q| (- |n| |l|) + $) + |ILIST;mergeSort|) + (EXIT (SPADCALL |f| |p| |q| (QREFELT $ 57))))))))))) + +(DEFUN |IndexedList| (&REST #0=#:G1525 &AUX #1=#:G1523) + (DSETQ #1# #0#) + (PROG () + (RETURN + (PROG (#2=#:G1524) + (RETURN + (COND + ((LETT #2# + (|lassocShiftWithFunction| (|devaluateList| #1#) + (HGET |$ConstructorCache| '|IndexedList|) + '|domainEqualList|) + |IndexedList|) + (|CDRwithIncrement| #2#)) + ('T + (UNWIND-PROTECT + (PROG1 (APPLY (|function| |IndexedList;|) #1#) + (LETT #2# T |IndexedList|)) + (COND + ((NOT #2#) (HREM |$ConstructorCache| '|IndexedList|))))))))))) + +(DEFUN |IndexedList;| (|#1| |#2|) + (PROG (|dv$1| |dv$2| |dv$| $ #0=#:G1522 #1=#:G1520 |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #2=(|IndexedList|)) + (LETT |dv$2| (|devaluate| |#2|) . #2#) + (LETT |dv$| (LIST '|IndexedList| |dv$1| |dv$2|) . #2#) + (LETT $ (GETREFV 72) . #2#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#1| + '(|ConvertibleTo| (|InputForm|))) + (|HasCategory| |#1| '(|OrderedSet|)) + (|HasCategory| (|Integer|) '(|OrderedSet|)) + (LETT #0# + (|HasCategory| |#1| '(|SetCategory|)) . #2#) + (OR (|HasCategory| |#1| '(|OrderedSet|)) + #0#) + (AND #0# + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + (OR (AND (|HasCategory| |#1| + '(|OrderedSet|)) + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + (AND #0# + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|))))) + (LETT #1# + (|HasCategory| |#1| + '(|CoercibleTo| (|OutputForm|))) . #2#) + (OR (AND #0# + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + #1#))) . #2#)) + (|haddProp| |$ConstructorCache| '|IndexedList| + (LIST |dv$1| |dv$2|) (CONS 1 $)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (QSETREFV $ 7 |#2|) + (COND + ((|testBitVector| |pv$| 8) + (QSETREFV $ 46 + (CONS (|dispatchFunction| |ILIST;coerce;$Of;21|) $)))) + (COND + ((|testBitVector| |pv$| 4) + (PROGN + (QSETREFV $ 48 + (CONS (|dispatchFunction| |ILIST;=;2$B;22|) $)) + (QSETREFV $ 51 + (CONS (|dispatchFunction| |ILIST;latex;$S;23|) $)) + (QSETREFV $ 52 + (CONS (|dispatchFunction| |ILIST;member?;S$B;24|) $))))) + (COND + ((|testBitVector| |pv$| 4) + (QSETREFV $ 54 + (CONS (|dispatchFunction| + |ILIST;removeDuplicates!;2$;26|) + $)))) + $)))) + +(MAKEPROP '|IndexedList| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|NonNegativeInteger|) |ILIST;#;$Nni;1| + |ILIST;concat;S2$;2| (|Boolean|) |ILIST;eq?;2$B;3| + |ILIST;first;$S;4| '"first" |ILIST;elt;$firstS;5| + |ILIST;empty;$;6| |ILIST;empty?;$B;7| |ILIST;rest;2$;8| + '"rest" |ILIST;elt;$rest$;9| |ILIST;setfirst!;$2S;10| + |ILIST;setelt;$first2S;11| |ILIST;setrest!;3$;12| + |ILIST;setelt;$rest2$;13| (|List| 6) + |ILIST;construct;L$;14| |ILIST;parts;$L;15| + |ILIST;reverse!;2$;16| |ILIST;reverse;2$;17| (|Integer|) + |ILIST;minIndex;$I;18| |ILIST;rest;$Nni$;19| (0 . |not|) + (5 . |cyclic?|) |ILIST;copy;2$;20| (10 . |cycleEntry|) + (|OutputForm|) (15 . |coerce|) (|List| $) (20 . |bracket|) + (|List| 37) (25 . |list|) (30 . |commaSeparate|) + (35 . |overbar|) (40 . |concat!|) (46 . |coerce|) (51 . =) + (57 . =) (|String|) (63 . |latex|) (68 . |latex|) + (73 . |member?|) |ILIST;concat!;3$;25| + (79 . |removeDuplicates!|) (|Mapping| 11 6 6) + |ILIST;sort!;M2$;27| |ILIST;merge!;M3$;28| + |ILIST;split!;$I$;29| (|Mapping| 6 6 6) (|Equation| 6) + (|List| 60) (|Mapping| 11 6) (|Void|) + (|UniversalSegment| 30) '"last" '"value" (|Mapping| 6 6) + (|InputForm|) (|SingleInteger|) (|List| 30) + (|Union| 6 '"failed")) + '#(~= 84 |value| 90 |third| 95 |tail| 100 |swap!| 105 + |split!| 112 |sorted?| 118 |sort!| 129 |sort| 140 |size?| + 151 |setvalue!| 157 |setrest!| 163 |setlast!| 169 + |setfirst!| 175 |setelt| 181 |setchildren!| 223 |select!| + 229 |select| 235 |second| 241 |sample| 246 |reverse!| 250 + |reverse| 255 |rest| 260 |removeDuplicates!| 271 + |removeDuplicates| 276 |remove!| 281 |remove| 293 |reduce| + 305 |qsetelt!| 326 |qelt| 333 |possiblyInfinite?| 339 + |position| 344 |parts| 363 |nodes| 368 |node?| 373 |new| + 379 |more?| 385 |minIndex| 391 |min| 396 |merge!| 402 + |merge| 415 |members| 428 |member?| 433 |maxIndex| 439 + |max| 444 |map!| 450 |map| 456 |list| 469 |less?| 474 + |leaves| 480 |leaf?| 485 |latex| 490 |last| 495 |insert!| + 506 |insert| 520 |indices| 534 |index?| 539 |hash| 545 + |first| 550 |find| 561 |fill!| 567 |explicitlyFinite?| 573 + |every?| 578 |eval| 584 |eq?| 610 |entry?| 616 |entries| + 622 |empty?| 627 |empty| 632 |elt| 636 |distance| 679 + |delete!| 685 |delete| 697 |cyclic?| 709 |cycleTail| 714 + |cycleSplit!| 719 |cycleLength| 724 |cycleEntry| 729 + |count| 734 |copyInto!| 746 |copy| 753 |convert| 758 + |construct| 763 |concat!| 768 |concat| 780 |coerce| 803 + |children| 808 |child?| 813 |any?| 819 >= 825 > 831 = 837 + <= 843 < 849 |#| 855) + '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) + (CONS (|makeByteWordVec2| 9 + '(0 0 0 0 0 0 0 0 0 0 2 0 0 7 5 0 0 7 9 1 5)) + (CONS '#(|ListAggregate&| |StreamAggregate&| + |ExtensibleLinearAggregate&| + |FiniteLinearAggregate&| + |UnaryRecursiveAggregate&| |LinearAggregate&| + |RecursiveAggregate&| |IndexedAggregate&| + |Collection&| |HomogeneousAggregate&| + |OrderedSet&| |Aggregate&| |EltableAggregate&| + |Evalable&| |SetCategory&| NIL NIL + |InnerEvalable&| NIL NIL |BasicType&|) + (CONS '#((|ListAggregate| 6) + (|StreamAggregate| 6) + (|ExtensibleLinearAggregate| 6) + (|FiniteLinearAggregate| 6) + (|UnaryRecursiveAggregate| 6) + (|LinearAggregate| 6) + (|RecursiveAggregate| 6) + (|IndexedAggregate| 30 6) + (|Collection| 6) + (|HomogeneousAggregate| 6) + (|OrderedSet|) (|Aggregate|) + (|EltableAggregate| 30 6) (|Evalable| 6) + (|SetCategory|) (|Type|) + (|Eltable| 30 6) (|InnerEvalable| 6 6) + (|CoercibleTo| 37) (|ConvertibleTo| 68) + (|BasicType|)) + (|makeByteWordVec2| 71 + '(1 11 0 0 33 1 0 11 0 34 1 0 0 0 36 1 + 6 37 0 38 1 37 0 39 40 1 41 0 37 42 1 + 37 0 39 43 1 37 0 0 44 2 41 0 0 37 45 + 1 0 37 0 46 2 6 11 0 0 47 2 0 11 0 0 + 48 1 6 49 0 50 1 0 49 0 51 2 0 11 6 0 + 52 1 0 0 0 54 2 4 11 0 0 1 1 0 6 0 1 + 1 0 6 0 1 1 0 0 0 1 3 0 63 0 30 30 1 + 2 0 0 0 30 58 1 2 11 0 1 2 0 11 55 0 + 1 1 2 0 0 1 2 0 0 55 0 56 1 2 0 0 1 2 + 0 0 55 0 1 2 0 11 0 8 1 2 0 6 0 6 1 2 + 0 0 0 0 23 2 0 6 0 6 1 2 0 6 0 6 21 3 + 0 6 0 30 6 1 3 0 6 0 64 6 1 3 0 6 0 + 65 6 1 3 0 0 0 19 0 24 3 0 6 0 14 6 + 22 3 0 6 0 66 6 1 2 0 0 0 39 1 2 0 0 + 62 0 1 2 0 0 62 0 1 1 0 6 0 1 0 0 0 1 + 1 0 0 0 28 1 0 0 0 29 2 0 0 0 8 32 1 + 0 0 0 18 1 4 0 0 54 1 4 0 0 1 2 4 0 6 + 0 1 2 0 0 62 0 1 2 4 0 6 0 1 2 0 0 62 + 0 1 4 4 6 59 0 6 6 1 2 0 6 59 0 1 3 0 + 6 59 0 6 1 3 0 6 0 30 6 1 2 0 6 0 30 + 1 1 0 11 0 1 2 4 30 6 0 1 3 4 30 6 0 + 30 1 2 0 30 62 0 1 1 0 25 0 27 1 0 39 + 0 1 2 4 11 0 0 1 2 0 0 8 6 1 2 0 11 0 + 8 1 1 3 30 0 31 2 2 0 0 0 1 2 2 0 0 0 + 1 3 0 0 55 0 0 57 2 2 0 0 0 1 3 0 0 + 55 0 0 1 1 0 25 0 1 2 4 11 6 0 52 1 3 + 30 0 1 2 2 0 0 0 1 2 0 0 67 0 1 3 0 0 + 59 0 0 1 2 0 0 67 0 1 1 0 0 6 1 2 0 + 11 0 8 1 1 0 25 0 1 1 0 11 0 1 1 4 49 + 0 51 2 0 0 0 8 1 1 0 6 0 1 3 0 0 6 0 + 30 1 3 0 0 0 0 30 1 3 0 0 0 0 30 1 3 + 0 0 6 0 30 1 1 0 70 0 1 2 0 11 30 0 1 + 1 4 69 0 1 2 0 0 0 8 1 1 0 6 0 13 2 0 + 71 62 0 1 2 0 0 0 6 1 1 0 11 0 1 2 0 + 11 62 0 1 3 6 0 0 6 6 1 3 6 0 0 25 25 + 1 2 6 0 0 60 1 2 6 0 0 61 1 2 0 11 0 + 0 12 2 4 11 6 0 1 1 0 25 0 1 1 0 11 0 + 17 0 0 0 16 2 0 6 0 30 1 3 0 6 0 30 6 + 1 2 0 0 0 64 1 2 0 6 0 65 1 2 0 0 0 + 19 20 2 0 6 0 14 15 2 0 6 0 66 1 2 0 + 30 0 0 1 2 0 0 0 64 1 2 0 0 0 30 1 2 + 0 0 0 64 1 2 0 0 0 30 1 1 0 11 0 34 1 + 0 0 0 1 1 0 0 0 1 1 0 8 0 1 1 0 0 0 + 36 2 4 8 6 0 1 2 0 8 62 0 1 3 0 0 0 0 + 30 1 1 0 0 0 35 1 1 68 0 1 1 0 0 25 + 26 2 0 0 0 0 53 2 0 0 0 6 1 1 0 0 39 + 1 2 0 0 0 6 1 2 0 0 6 0 10 2 0 0 0 0 + 1 1 8 37 0 46 1 0 39 0 1 2 4 11 0 0 1 + 2 0 11 62 0 1 2 2 11 0 0 1 2 2 11 0 0 + 1 2 4 11 0 0 48 2 2 11 0 0 1 2 2 11 0 + 0 1 1 0 8 0 9))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/INS-.lsp b/src/algebra/strap/INS-.lsp new file mode 100644 index 00000000..b5a58e4f --- /dev/null +++ b/src/algebra/strap/INS-.lsp @@ -0,0 +1,298 @@ + +(/VERSIONCHECK 2) + +(PUT '|INS-;characteristic;Nni;1| '|SPADreplace| '(XLAM NIL 0)) + +(DEFUN |INS-;characteristic;Nni;1| ($) 0) + +(DEFUN |INS-;differentiate;2S;2| (|x| $) (|spadConstant| $ 9)) + +(DEFUN |INS-;even?;SB;3| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 12)) (QREFELT $ 13))) + +(DEFUN |INS-;positive?;SB;4| (|x| $) + (SPADCALL (|spadConstant| $ 9) |x| (QREFELT $ 15))) + +(PUT '|INS-;copy;2S;5| '|SPADreplace| '(XLAM (|x|) |x|)) + +(DEFUN |INS-;copy;2S;5| (|x| $) |x|) + +(DEFUN |INS-;bit?;2SB;6| (|x| |i| $) + (SPADCALL (SPADCALL |x| (SPADCALL |i| (QREFELT $ 18)) (QREFELT $ 19)) + (QREFELT $ 12))) + +(DEFUN |INS-;mask;2S;7| (|n| $) + (SPADCALL (SPADCALL (|spadConstant| $ 21) |n| (QREFELT $ 19)) + (QREFELT $ 22))) + +(PUT '|INS-;rational?;SB;8| '|SPADreplace| '(XLAM (|x|) 'T)) + +(DEFUN |INS-;rational?;SB;8| (|x| $) 'T) + +(DEFUN |INS-;euclideanSize;SNni;9| (|x| $) + (PROG (#0=#:G1412 #1=#:G1413) + (RETURN + (COND + ((SPADCALL |x| (|spadConstant| $ 9) (QREFELT $ 25)) + (|error| "euclideanSize called on zero")) + ((SPADCALL |x| (|spadConstant| $ 9) (QREFELT $ 15)) + (PROG1 (LETT #0# (- (SPADCALL |x| (QREFELT $ 27))) + |INS-;euclideanSize;SNni;9|) + (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))) + ('T + (PROG1 (LETT #1# (SPADCALL |x| (QREFELT $ 27)) + |INS-;euclideanSize;SNni;9|) + (|check-subtype| (>= #1# 0) '(|NonNegativeInteger|) #1#))))))) + +(DEFUN |INS-;convert;SF;10| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 30))) + +(DEFUN |INS-;convert;SDf;11| (|x| $) + (FLOAT (SPADCALL |x| (QREFELT $ 27)) MOST-POSITIVE-LONG-FLOAT)) + +(DEFUN |INS-;convert;SIf;12| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 35))) + +(DEFUN |INS-;retract;SI;13| (|x| $) (SPADCALL |x| (QREFELT $ 27))) + +(DEFUN |INS-;convert;SP;14| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 39))) + +(DEFUN |INS-;factor;SF;15| (|x| $) (SPADCALL |x| (QREFELT $ 43))) + +(DEFUN |INS-;squareFree;SF;16| (|x| $) (SPADCALL |x| (QREFELT $ 46))) + +(DEFUN |INS-;prime?;SB;17| (|x| $) (SPADCALL |x| (QREFELT $ 49))) + +(DEFUN |INS-;factorial;2S;18| (|x| $) (SPADCALL |x| (QREFELT $ 52))) + +(DEFUN |INS-;binomial;3S;19| (|n| |m| $) + (SPADCALL |n| |m| (QREFELT $ 54))) + +(DEFUN |INS-;permutation;3S;20| (|n| |m| $) + (SPADCALL |n| |m| (QREFELT $ 56))) + +(DEFUN |INS-;retractIfCan;SU;21| (|x| $) + (CONS 0 (SPADCALL |x| (QREFELT $ 27)))) + +(DEFUN |INS-;init;S;22| ($) (|spadConstant| $ 9)) + +(DEFUN |INS-;nextItem;SU;23| (|n| $) + (COND + ((SPADCALL |n| (QREFELT $ 61)) (CONS 0 (|spadConstant| $ 21))) + ((SPADCALL (|spadConstant| $ 9) |n| (QREFELT $ 15)) + (CONS 0 (SPADCALL |n| (QREFELT $ 18)))) + ('T (CONS 0 (SPADCALL (|spadConstant| $ 21) |n| (QREFELT $ 62)))))) + +(DEFUN |INS-;patternMatch;SP2Pmr;24| (|x| |p| |l| $) + (SPADCALL |x| |p| |l| (QREFELT $ 67))) + +(DEFUN |INS-;rational;SF;25| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 71))) + +(DEFUN |INS-;rationalIfCan;SU;26| (|x| $) + (CONS 0 (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 71)))) + +(DEFUN |INS-;symmetricRemainder;3S;27| (|x| |n| $) + (PROG (|r|) + (RETURN + (SEQ (LETT |r| (SPADCALL |x| |n| (QREFELT $ 75)) + |INS-;symmetricRemainder;3S;27|) + (EXIT (COND + ((SPADCALL |r| (|spadConstant| $ 9) (QREFELT $ 25)) + |r|) + ('T + (SEQ (COND + ((SPADCALL |n| (|spadConstant| $ 9) + (QREFELT $ 15)) + (LETT |n| (SPADCALL |n| (QREFELT $ 18)) + |INS-;symmetricRemainder;3S;27|))) + (EXIT (COND + ((SPADCALL (|spadConstant| $ 9) |r| + (QREFELT $ 15)) + (COND + ((SPADCALL |n| + (SPADCALL 2 |r| (QREFELT $ 77)) + (QREFELT $ 15)) + (SPADCALL |r| |n| (QREFELT $ 62))) + ('T |r|))) + ((NULL (SPADCALL (|spadConstant| $ 9) + (SPADCALL + (SPADCALL 2 |r| + (QREFELT $ 77)) + |n| (QREFELT $ 78)) + (QREFELT $ 15))) + (SPADCALL |r| |n| (QREFELT $ 78))) + ('T |r|))))))))))) + +(DEFUN |INS-;invmod;3S;28| (|a| |b| $) + (PROG (|q| |r| |r1| |c| |c1| |d| |d1|) + (RETURN + (SEQ (COND + ((SPADCALL |a| (QREFELT $ 80)) + (LETT |a| (SPADCALL |a| |b| (QREFELT $ 81)) + |INS-;invmod;3S;28|))) + (LETT |c| |a| |INS-;invmod;3S;28|) + (LETT |c1| (|spadConstant| $ 21) |INS-;invmod;3S;28|) + (LETT |d| |b| |INS-;invmod;3S;28|) + (LETT |d1| (|spadConstant| $ 9) |INS-;invmod;3S;28|) + (SEQ G190 + (COND + ((NULL (SPADCALL (SPADCALL |d| (QREFELT $ 61)) + (QREFELT $ 13))) + (GO G191))) + (SEQ (LETT |q| (SPADCALL |c| |d| (QREFELT $ 82)) + |INS-;invmod;3S;28|) + (LETT |r| + (SPADCALL |c| + (SPADCALL |q| |d| (QREFELT $ 83)) + (QREFELT $ 62)) + |INS-;invmod;3S;28|) + (LETT |r1| + (SPADCALL |c1| + (SPADCALL |q| |d1| (QREFELT $ 83)) + (QREFELT $ 62)) + |INS-;invmod;3S;28|) + (LETT |c| |d| |INS-;invmod;3S;28|) + (LETT |c1| |d1| |INS-;invmod;3S;28|) + (LETT |d| |r| |INS-;invmod;3S;28|) + (EXIT (LETT |d1| |r1| |INS-;invmod;3S;28|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |c| (|spadConstant| $ 21) (QREFELT $ 25)) + (COND + ((SPADCALL |c1| (QREFELT $ 80)) + (SPADCALL |c1| |b| (QREFELT $ 78))) + ('T |c1|))) + ('T (|error| "inverse does not exist")))))))) + +(DEFUN |INS-;powmod;4S;29| (|x| |n| |p| $) + (PROG (|y| #0=#:G1470 |z|) + (RETURN + (SEQ (EXIT (SEQ (COND + ((SPADCALL |x| (QREFELT $ 80)) + (LETT |x| (SPADCALL |x| |p| (QREFELT $ 81)) + |INS-;powmod;4S;29|))) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 61)) + (|spadConstant| $ 9)) + ((SPADCALL |n| (QREFELT $ 61)) + (|spadConstant| $ 21)) + ('T + (SEQ (LETT |y| (|spadConstant| $ 21) + |INS-;powmod;4S;29|) + (LETT |z| |x| |INS-;powmod;4S;29|) + (EXIT + (SEQ G190 NIL + (SEQ + (COND + ((SPADCALL |n| (QREFELT $ 12)) + (LETT |y| + (SPADCALL |y| |z| |p| + (QREFELT $ 85)) + |INS-;powmod;4S;29|))) + (EXIT + (COND + ((SPADCALL + (LETT |n| + (SPADCALL |n| + (SPADCALL + (|spadConstant| $ 21) + (QREFELT $ 18)) + (QREFELT $ 19)) + |INS-;powmod;4S;29|) + (QREFELT $ 61)) + (PROGN + (LETT #0# |y| + |INS-;powmod;4S;29|) + (GO #0#))) + ('T + (LETT |z| + (SPADCALL |z| |z| |p| + (QREFELT $ 85)) + |INS-;powmod;4S;29|))))) + NIL (GO G190) G191 (EXIT NIL))))))))) + #0# (EXIT #0#))))) + +(DEFUN |IntegerNumberSystem&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|IntegerNumberSystem&|)) + (LETT |dv$| (LIST '|IntegerNumberSystem&| |dv$1|) . #0#) + (LETT $ (GETREFV 87) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|IntegerNumberSystem&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) + (|NonNegativeInteger|) |INS-;characteristic;Nni;1| + (0 . |Zero|) |INS-;differentiate;2S;2| (|Boolean|) + (4 . |odd?|) (9 . |not|) |INS-;even?;SB;3| (14 . <) + |INS-;positive?;SB;4| |INS-;copy;2S;5| (20 . -) + (25 . |shift|) |INS-;bit?;2SB;6| (31 . |One|) (35 . |dec|) + |INS-;mask;2S;7| |INS-;rational?;SB;8| (40 . =) + (|Integer|) (46 . |convert|) |INS-;euclideanSize;SNni;9| + (|Float|) (51 . |coerce|) |INS-;convert;SF;10| + (|DoubleFloat|) |INS-;convert;SDf;11| (|InputForm|) + (56 . |convert|) |INS-;convert;SIf;12| + |INS-;retract;SI;13| (|Pattern| 26) (61 . |coerce|) + |INS-;convert;SP;14| (|Factored| 6) + (|IntegerFactorizationPackage| 6) (66 . |factor|) + (|Factored| $) |INS-;factor;SF;15| (71 . |squareFree|) + |INS-;squareFree;SF;16| (|IntegerPrimesPackage| 6) + (76 . |prime?|) |INS-;prime?;SB;17| + (|IntegerCombinatoricFunctions| 6) (81 . |factorial|) + |INS-;factorial;2S;18| (86 . |binomial|) + |INS-;binomial;3S;19| (92 . |permutation|) + |INS-;permutation;3S;20| (|Union| 26 '"failed") + |INS-;retractIfCan;SU;21| |INS-;init;S;22| (98 . |zero?|) + (103 . -) (|Union| $ '"failed") |INS-;nextItem;SU;23| + (|PatternMatchResult| 26 6) + (|PatternMatchIntegerNumberSystem| 6) + (109 . |patternMatch|) (|PatternMatchResult| 26 $) + |INS-;patternMatch;SP2Pmr;24| (|Fraction| 26) + (116 . |coerce|) |INS-;rational;SF;25| + (|Union| 70 '"failed") |INS-;rationalIfCan;SU;26| + (121 . |rem|) (|PositiveInteger|) (127 . *) (133 . +) + |INS-;symmetricRemainder;3S;27| (139 . |negative?|) + (144 . |positiveRemainder|) (150 . |quo|) (156 . *) + |INS-;invmod;3S;28| (162 . |mulmod|) |INS-;powmod;4S;29|) + '#(|symmetricRemainder| 169 |squareFree| 175 |retractIfCan| + 180 |retract| 185 |rationalIfCan| 190 |rational?| 195 + |rational| 200 |prime?| 205 |powmod| 210 |positive?| 217 + |permutation| 222 |patternMatch| 228 |nextItem| 235 |mask| + 240 |invmod| 245 |init| 251 |factorial| 255 |factor| 260 + |even?| 265 |euclideanSize| 270 |differentiate| 275 |copy| + 280 |convert| 285 |characteristic| 305 |bit?| 309 + |binomial| 315) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 86 + '(0 6 0 9 1 6 11 0 12 1 11 0 0 13 2 6 + 11 0 0 15 1 6 0 0 18 2 6 0 0 0 19 0 6 + 0 21 1 6 0 0 22 2 6 11 0 0 25 1 6 26 + 0 27 1 29 0 26 30 1 34 0 26 35 1 38 0 + 26 39 1 42 41 6 43 1 42 41 6 46 1 48 + 11 6 49 1 51 6 6 52 2 51 6 6 6 54 2 + 51 6 6 6 56 1 6 11 0 61 2 6 0 0 0 62 + 3 66 65 6 38 65 67 1 70 0 26 71 2 6 0 + 0 0 75 2 6 0 76 0 77 2 6 0 0 0 78 1 6 + 11 0 80 2 6 0 0 0 81 2 6 0 0 0 82 2 6 + 0 0 0 83 3 6 0 0 0 0 85 2 0 0 0 0 79 + 1 0 44 0 47 1 0 58 0 59 1 0 26 0 37 1 + 0 73 0 74 1 0 11 0 24 1 0 70 0 72 1 0 + 11 0 50 3 0 0 0 0 0 86 1 0 11 0 16 2 + 0 0 0 0 57 3 0 68 0 38 68 69 1 0 63 0 + 64 1 0 0 0 23 2 0 0 0 0 84 0 0 0 60 1 + 0 0 0 53 1 0 44 0 45 1 0 11 0 14 1 0 + 7 0 28 1 0 0 0 10 1 0 0 0 17 1 0 32 0 + 33 1 0 29 0 31 1 0 38 0 40 1 0 34 0 + 36 0 0 7 8 2 0 11 0 0 20 2 0 0 0 0 + 55))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/INS.lsp b/src/algebra/strap/INS.lsp new file mode 100644 index 00000000..c951d143 --- /dev/null +++ b/src/algebra/strap/INS.lsp @@ -0,0 +1,75 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |IntegerNumberSystem;AL| 'NIL) + +(DEFUN |IntegerNumberSystem| () + (LET (#:G1403) + (COND + (|IntegerNumberSystem;AL|) + (T (SETQ |IntegerNumberSystem;AL| (|IntegerNumberSystem;|)))))) + +(DEFUN |IntegerNumberSystem;| () + (PROG (#0=#:G1401) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(#1=#:G1395 #2=#:G1396 #3=#:G1397 + #4=#:G1398 #5=#:G1399 #6=#:G1400) + (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) + ((|hash| ($ $)) 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|) + (SETELT #0# 0 '(|IntegerNumberSystem|)))))) + +(MAKEPROP '|IntegerNumberSystem| 'NILADIC T) diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp new file mode 100644 index 00000000..06ad04a0 --- /dev/null +++ b/src/algebra/strap/INT.lsp @@ -0,0 +1,528 @@ + +(/VERSIONCHECK 2) + +(DEFUN |INT;writeOMInt| (|dev| |x| $) + (SEQ (COND + ((< |x| 0) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 8)) + (SPADCALL |dev| "arith1" "unary_minus" + (|getShellEntry| $ 10)) + (SPADCALL |dev| (- |x|) (|getShellEntry| $ 12)) + (EXIT (SPADCALL |dev| (|getShellEntry| $ 13))))) + ('T (SPADCALL |dev| |x| (|getShellEntry| $ 12)))))) + +(DEFUN |INT;OMwrite;$S;2| (|x| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |INT;OMwrite;$S;2|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |INT;OMwrite;$S;2|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 15)) + (|getShellEntry| $ 16)) + |INT;OMwrite;$S;2|) + (SPADCALL |dev| (|getShellEntry| $ 17)) + (|INT;writeOMInt| |dev| |x| $) + (SPADCALL |dev| (|getShellEntry| $ 18)) + (SPADCALL |dev| (|getShellEntry| $ 19)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |INT;OMwrite;$S;2|) + (EXIT |s|))))) + +(DEFUN |INT;OMwrite;$BS;3| (|x| |wholeObj| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |INT;OMwrite;$BS;3|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |INT;OMwrite;$BS;3|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 15)) + (|getShellEntry| $ 16)) + |INT;OMwrite;$BS;3|) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 17)))) + (|INT;writeOMInt| |dev| |x| $) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 18)))) + (SPADCALL |dev| (|getShellEntry| $ 19)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |INT;OMwrite;$BS;3|) + (EXIT |s|))))) + +(DEFUN |INT;OMwrite;Omd$V;4| (|dev| |x| $) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 17)) + (|INT;writeOMInt| |dev| |x| $) + (EXIT (SPADCALL |dev| (|getShellEntry| $ 18))))) + +(DEFUN |INT;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 17)))) + (|INT;writeOMInt| |dev| |x| $) + (EXIT (COND + (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 18))))))) + +(PUT '|INT;zero?;$B;6| '|SPADreplace| 'ZEROP) + +(DEFUN |INT;zero?;$B;6| (|x| $) (ZEROP |x|)) + +(PUT '|INT;one?;$B;7| '|SPADreplace| '(XLAM (|x|) (EQL |x| 1))) + +(DEFUN |INT;one?;$B;7| (|x| $) (EQL |x| 1)) + +(PUT '|INT;Zero;$;8| '|SPADreplace| '(XLAM NIL 0)) + +(DEFUN |INT;Zero;$;8| ($) 0) + +(PUT '|INT;One;$;9| '|SPADreplace| '(XLAM NIL 1)) + +(DEFUN |INT;One;$;9| ($) 1) + +(PUT '|INT;base;$;10| '|SPADreplace| '(XLAM NIL 2)) + +(DEFUN |INT;base;$;10| ($) 2) + +(PUT '|INT;copy;2$;11| '|SPADreplace| '(XLAM (|x|) |x|)) + +(DEFUN |INT;copy;2$;11| (|x| $) |x|) + +(PUT '|INT;inc;2$;12| '|SPADreplace| '(XLAM (|x|) (+ |x| 1))) + +(DEFUN |INT;inc;2$;12| (|x| $) (+ |x| 1)) + +(PUT '|INT;dec;2$;13| '|SPADreplace| '(XLAM (|x|) (- |x| 1))) + +(DEFUN |INT;dec;2$;13| (|x| $) (- |x| 1)) + +(PUT '|INT;hash;2$;14| '|SPADreplace| 'SXHASH) + +(DEFUN |INT;hash;2$;14| (|x| $) (SXHASH |x|)) + +(PUT '|INT;negative?;$B;15| '|SPADreplace| 'MINUSP) + +(DEFUN |INT;negative?;$B;15| (|x| $) (MINUSP |x|)) + +(DEFUN |INT;coerce;$Of;16| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 36))) + +(PUT '|INT;coerce;I$;17| '|SPADreplace| '(XLAM (|m|) |m|)) + +(DEFUN |INT;coerce;I$;17| (|m| $) |m|) + +(PUT '|INT;convert;$I;18| '|SPADreplace| '(XLAM (|x|) |x|)) + +(DEFUN |INT;convert;$I;18| (|x| $) |x|) + +(PUT '|INT;length;2$;19| '|SPADreplace| 'INTEGER-LENGTH) + +(DEFUN |INT;length;2$;19| (|a| $) (INTEGER-LENGTH |a|)) + +(DEFUN |INT;addmod;4$;20| (|a| |b| |p| $) + (PROG (|c| #0=#:G1427) + (RETURN + (SEQ (EXIT (SEQ (SEQ (LETT |c| (+ |a| |b|) |INT;addmod;4$;20|) + (EXIT (COND + ((NULL (< |c| |p|)) + (PROGN + (LETT #0# (- |c| |p|) + |INT;addmod;4$;20|) + (GO #0#)))))) + (EXIT |c|))) + #0# (EXIT #0#))))) + +(DEFUN |INT;submod;4$;21| (|a| |b| |p| $) + (PROG (|c|) + (RETURN + (SEQ (LETT |c| (- |a| |b|) |INT;submod;4$;21|) + (EXIT (COND ((< |c| 0) (+ |c| |p|)) ('T |c|))))))) + +(DEFUN |INT;mulmod;4$;22| (|a| |b| |p| $) + (REMAINDER2 (* |a| |b|) |p|)) + +(DEFUN |INT;convert;$F;23| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 45))) + +(PUT '|INT;convert;$Df;24| '|SPADreplace| + '(XLAM (|x|) (FLOAT |x| MOST-POSITIVE-LONG-FLOAT))) + +(DEFUN |INT;convert;$Df;24| (|x| $) + (FLOAT |x| MOST-POSITIVE-LONG-FLOAT)) + +(DEFUN |INT;convert;$If;25| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 50))) + +(PUT '|INT;convert;$S;26| '|SPADreplace| 'STRINGIMAGE) + +(DEFUN |INT;convert;$S;26| (|x| $) (STRINGIMAGE |x|)) + +(DEFUN |INT;latex;$S;27| (|x| $) + (PROG (|s|) + (RETURN + (SEQ (LETT |s| (STRINGIMAGE |x|) |INT;latex;$S;27|) + (COND ((< -1 |x|) (COND ((< |x| 10) (EXIT |s|))))) + (EXIT (STRCONC "{" (STRCONC |s| "}"))))))) + +(DEFUN |INT;positiveRemainder;3$;28| (|a| |b| $) + (PROG (|r|) + (RETURN + (COND + ((MINUSP (LETT |r| (REMAINDER2 |a| |b|) + |INT;positiveRemainder;3$;28|)) + (COND ((MINUSP |b|) (- |r| |b|)) ('T (+ |r| |b|)))) + ('T |r|))))) + +(PUT '|INT;reducedSystem;MM;29| '|SPADreplace| '(XLAM (|m|) |m|)) + +(DEFUN |INT;reducedSystem;MM;29| (|m| $) |m|) + +(DEFUN |INT;reducedSystem;MVR;30| (|m| |v| $) (CONS |m| '|vec|)) + +(PUT '|INT;abs;2$;31| '|SPADreplace| 'ABS) + +(DEFUN |INT;abs;2$;31| (|x| $) (ABS |x|)) + +(PUT '|INT;random;$;32| '|SPADreplace| '|random|) + +(DEFUN |INT;random;$;32| ($) (|random|)) + +(PUT '|INT;random;2$;33| '|SPADreplace| 'RANDOM) + +(DEFUN |INT;random;2$;33| (|x| $) (RANDOM |x|)) + +(PUT '|INT;=;2$B;34| '|SPADreplace| 'EQL) + +(DEFUN |INT;=;2$B;34| (|x| |y| $) (EQL |x| |y|)) + +(PUT '|INT;<;2$B;35| '|SPADreplace| '<) + +(DEFUN |INT;<;2$B;35| (|x| |y| $) (< |x| |y|)) + +(PUT '|INT;-;2$;36| '|SPADreplace| '-) + +(DEFUN |INT;-;2$;36| (|x| $) (- |x|)) + +(PUT '|INT;+;3$;37| '|SPADreplace| '+) + +(DEFUN |INT;+;3$;37| (|x| |y| $) (+ |x| |y|)) + +(PUT '|INT;-;3$;38| '|SPADreplace| '-) + +(DEFUN |INT;-;3$;38| (|x| |y| $) (- |x| |y|)) + +(PUT '|INT;*;3$;39| '|SPADreplace| '*) + +(DEFUN |INT;*;3$;39| (|x| |y| $) (* |x| |y|)) + +(PUT '|INT;*;I2$;40| '|SPADreplace| '*) + +(DEFUN |INT;*;I2$;40| (|m| |y| $) (* |m| |y|)) + +(PUT '|INT;**;$Nni$;41| '|SPADreplace| 'EXPT) + +(DEFUN |INT;**;$Nni$;41| (|x| |n| $) (EXPT |x| |n|)) + +(PUT '|INT;odd?;$B;42| '|SPADreplace| 'ODDP) + +(DEFUN |INT;odd?;$B;42| (|x| $) (ODDP |x|)) + +(PUT '|INT;max;3$;43| '|SPADreplace| 'MAX) + +(DEFUN |INT;max;3$;43| (|x| |y| $) (MAX |x| |y|)) + +(PUT '|INT;min;3$;44| '|SPADreplace| 'MIN) + +(DEFUN |INT;min;3$;44| (|x| |y| $) (MIN |x| |y|)) + +(PUT '|INT;divide;2$R;45| '|SPADreplace| 'DIVIDE2) + +(DEFUN |INT;divide;2$R;45| (|x| |y| $) (DIVIDE2 |x| |y|)) + +(PUT '|INT;quo;3$;46| '|SPADreplace| 'QUOTIENT2) + +(DEFUN |INT;quo;3$;46| (|x| |y| $) (QUOTIENT2 |x| |y|)) + +(PUT '|INT;rem;3$;47| '|SPADreplace| 'REMAINDER2) + +(DEFUN |INT;rem;3$;47| (|x| |y| $) (REMAINDER2 |x| |y|)) + +(PUT '|INT;shift;3$;48| '|SPADreplace| 'ASH) + +(DEFUN |INT;shift;3$;48| (|x| |y| $) (ASH |x| |y|)) + +(DEFUN |INT;exquo;2$U;49| (|x| |y| $) + (COND + ((OR (ZEROP |y|) (NULL (ZEROP (REMAINDER2 |x| |y|)))) + (CONS 1 "failed")) + ('T (CONS 0 (QUOTIENT2 |x| |y|))))) + +(DEFUN |INT;recip;$U;50| (|x| $) + (COND + ((OR (EQL |x| 1) (EQL |x| -1)) (CONS 0 |x|)) + ('T (CONS 1 "failed")))) + +(PUT '|INT;gcd;3$;51| '|SPADreplace| 'GCD) + +(DEFUN |INT;gcd;3$;51| (|x| |y| $) (GCD |x| |y|)) + +(DEFUN |INT;unitNormal;$R;52| (|x| $) + (COND ((< |x| 0) (VECTOR -1 (- |x|) -1)) ('T (VECTOR 1 |x| 1)))) + +(PUT '|INT;unitCanonical;2$;53| '|SPADreplace| 'ABS) + +(DEFUN |INT;unitCanonical;2$;53| (|x| $) (ABS |x|)) + +(DEFUN |INT;solveLinearPolynomialEquation| (|lp| |p| $) + (SPADCALL |lp| |p| (|getShellEntry| $ 93))) + +(DEFUN |INT;squareFreePolynomial| (|p| $) + (SPADCALL |p| (|getShellEntry| $ 97))) + +(DEFUN |INT;factorPolynomial| (|p| $) + (PROG (|pp| #0=#:G1498) + (RETURN + (SEQ (LETT |pp| (SPADCALL |p| (|getShellEntry| $ 98)) + |INT;factorPolynomial|) + (EXIT (COND + ((EQL (SPADCALL |pp| (|getShellEntry| $ 99)) + (SPADCALL |p| (|getShellEntry| $ 99))) + (SPADCALL |p| (|getShellEntry| $ 101))) + ('T + (SPADCALL (SPADCALL |pp| (|getShellEntry| $ 101)) + (SPADCALL (CONS #'|INT;factorPolynomial!0| $) + (SPADCALL + (PROG2 (LETT #0# + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 99)) + (SPADCALL |pp| + (|getShellEntry| $ 99)) + (|getShellEntry| $ 83)) + |INT;factorPolynomial|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) $ #0#)) + (|getShellEntry| $ 104)) + (|getShellEntry| $ 108)) + (|getShellEntry| $ 110))))))))) + +(DEFUN |INT;factorPolynomial!0| (|#1| $) + (SPADCALL |#1| (|getShellEntry| $ 102))) + +(DEFUN |INT;factorSquareFreePolynomial| (|p| $) + (SPADCALL |p| (|getShellEntry| $ 111))) + +(DEFUN |INT;gcdPolynomial;3Sup;58| (|p| |q| $) + (COND + ((SPADCALL |p| (|getShellEntry| $ 112)) + (SPADCALL |q| (|getShellEntry| $ 113))) + ((SPADCALL |q| (|getShellEntry| $ 112)) + (SPADCALL |p| (|getShellEntry| $ 113))) + ('T (SPADCALL (LIST |p| |q|) (|getShellEntry| $ 116))))) + +(DEFUN |Integer| () + (PROG () + (RETURN + (PROG (#0=#:G1523) + (RETURN + (COND + ((LETT #0# (HGET |$ConstructorCache| '|Integer|) |Integer|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Integer| + (LIST + (CONS NIL (CONS 1 (|Integer;|)))))) + (LETT #0# T |Integer|)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|Integer|))))))))))) + +(DEFUN |Integer;| () + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| '(|Integer|) . #0=(|Integer|)) + (LETT $ (|newShell| 132) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| '|Integer| NIL (CONS 1 $)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 71 + (|setShellEntry| $ 70 + (CONS (|dispatchFunction| |INT;*;I2$;40|) $))) + $)))) + +(MAKEPROP '|Integer| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|Void|) (|OpenMathDevice|) + (0 . |OMputApp|) (|String|) (5 . |OMputSymbol|) + (|Integer|) (12 . |OMputInteger|) (18 . |OMputEndApp|) + (|OpenMathEncoding|) (23 . |OMencodingXML|) + (27 . |OMopenString|) (33 . |OMputObject|) + (38 . |OMputEndObject|) (43 . |OMclose|) + |INT;OMwrite;$S;2| (|Boolean|) |INT;OMwrite;$BS;3| + |INT;OMwrite;Omd$V;4| |INT;OMwrite;Omd$BV;5| + |INT;zero?;$B;6| |INT;one?;$B;7| + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |INT;Zero;$;8|) $)) + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |INT;One;$;9|) $)) + |INT;base;$;10| |INT;copy;2$;11| |INT;inc;2$;12| + |INT;dec;2$;13| |INT;hash;2$;14| |INT;negative?;$B;15| + (|OutputForm|) (48 . |outputForm|) |INT;coerce;$Of;16| + |INT;coerce;I$;17| |INT;convert;$I;18| |INT;length;2$;19| + |INT;addmod;4$;20| |INT;submod;4$;21| |INT;mulmod;4$;22| + (|Float|) (53 . |coerce|) |INT;convert;$F;23| + (|DoubleFloat|) |INT;convert;$Df;24| (|InputForm|) + (58 . |convert|) |INT;convert;$If;25| |INT;convert;$S;26| + |INT;latex;$S;27| |INT;positiveRemainder;3$;28| + (|Matrix| 11) (|Matrix| $) |INT;reducedSystem;MM;29| + (|Vector| 11) (|Record| (|:| |mat| 55) (|:| |vec| 58)) + (|Vector| $) |INT;reducedSystem;MVR;30| |INT;abs;2$;31| + |INT;random;$;32| |INT;random;2$;33| |INT;=;2$B;34| + |INT;<;2$B;35| |INT;-;2$;36| |INT;+;3$;37| |INT;-;3$;38| + NIL NIL (|NonNegativeInteger|) |INT;**;$Nni$;41| + |INT;odd?;$B;42| |INT;max;3$;43| |INT;min;3$;44| + (|Record| (|:| |quotient| $) (|:| |remainder| $)) + |INT;divide;2$R;45| |INT;quo;3$;46| |INT;rem;3$;47| + |INT;shift;3$;48| (|Union| $ '"failed") |INT;exquo;2$U;49| + |INT;recip;$U;50| |INT;gcd;3$;51| + (|Record| (|:| |unit| $) (|:| |canonical| $) + (|:| |associate| $)) + |INT;unitNormal;$R;52| |INT;unitCanonical;2$;53| + (|SparseUnivariatePolynomial| 11) (|List| 89) + (|Union| 90 '"failed") + (|IntegerSolveLinearPolynomialEquation|) + (63 . |solveLinearPolynomialEquation|) + (|SparseUnivariatePolynomial| $$) (|Factored| 94) + (|UnivariatePolynomialSquareFree| $$ 94) + (69 . |squareFree|) (74 . |primitivePart|) + (79 . |leadingCoefficient|) (|GaloisGroupFactorizer| 94) + (84 . |factor|) (89 . |coerce|) (|Factored| $) + (94 . |factor|) (|Mapping| 94 $$) (|Factored| $$) + (|FactoredFunctions2| $$ 94) (99 . |map|) + (|FactoredFunctionUtilities| 94) (105 . |mergeFactors|) + (111 . |factorSquareFree|) (116 . |zero?|) + (121 . |unitCanonical|) (|List| 94) (|HeuGcd| 94) + (126 . |gcd|) (|SparseUnivariatePolynomial| $) + |INT;gcdPolynomial;3Sup;58| (|Fraction| 11) + (|Union| 119 '"failed") (|PatternMatchResult| 11 $) + (|Pattern| 11) (|Union| 11 '"failed") (|List| $) + (|Union| 124 '"failed") + (|Record| (|:| |coef| 124) (|:| |generator| $)) + (|Record| (|:| |coef1| $) (|:| |coef2| $)) + (|Union| 127 '"failed") + (|Record| (|:| |coef1| $) (|:| |coef2| $) + (|:| |generator| $)) + (|PositiveInteger|) (|SingleInteger|)) + '#(~= 131 |zero?| 137 |unitNormal| 142 |unitCanonical| 147 + |unit?| 152 |symmetricRemainder| 157 |subtractIfCan| 163 + |submod| 169 |squareFreePart| 176 |squareFree| 181 + |sizeLess?| 186 |sign| 192 |shift| 197 |sample| 203 + |retractIfCan| 207 |retract| 212 |rem| 217 |reducedSystem| + 223 |recip| 234 |rationalIfCan| 239 |rational?| 244 + |rational| 249 |random| 254 |quo| 263 |principalIdeal| 269 + |prime?| 274 |powmod| 279 |positiveRemainder| 286 + |positive?| 292 |permutation| 297 |patternMatch| 303 + |one?| 310 |odd?| 315 |nextItem| 320 |negative?| 325 + |multiEuclidean| 330 |mulmod| 336 |min| 343 |max| 349 + |mask| 355 |length| 360 |lcm| 365 |latex| 376 |invmod| 381 + |init| 387 |inc| 391 |hash| 396 |gcdPolynomial| 406 |gcd| + 412 |factorial| 423 |factor| 428 |extendedEuclidean| 433 + |exquo| 446 |expressIdealMember| 452 |even?| 458 + |euclideanSize| 463 |divide| 468 |differentiate| 474 |dec| + 485 |copy| 490 |convert| 495 |coerce| 525 |characteristic| + 545 |bit?| 549 |binomial| 555 |base| 561 |associates?| 565 + |addmod| 571 |abs| 578 ^ 583 |Zero| 595 |One| 599 + |OMwrite| 603 D 627 >= 638 > 644 = 650 <= 656 < 662 - 668 + + 679 ** 685 * 697) + '((|infinite| . 0) (|noetherian| . 0) + (|canonicalsClosed| . 0) (|canonical| . 0) + (|canonicalUnitNormal| . 0) (|multiplicativeValuation| . 0) + (|noZeroDivisors| . 0) ((|commutative| "*") . 0) + (|rightUnitary| . 0) (|leftUnitary| . 0) + (|unitsKnown| . 0)) + (CONS (|makeByteWordVec2| 1 + '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)) + (CONS '#(|IntegerNumberSystem&| |EuclideanDomain&| + |UniqueFactorizationDomain&| NIL NIL + |GcdDomain&| |IntegralDomain&| |Algebra&| NIL + NIL |DifferentialRing&| |OrderedRing&| NIL NIL + |Module&| NIL NIL |Ring&| NIL NIL NIL NIL NIL + |AbelianGroup&| NIL NIL |AbelianMonoid&| + |Monoid&| NIL NIL |OrderedSet&| + |AbelianSemiGroup&| |SemiGroup&| NIL + |SetCategory&| NIL NIL NIL NIL NIL NIL NIL + |RetractableTo&| NIL |BasicType&| NIL) + (CONS '#((|IntegerNumberSystem|) + (|EuclideanDomain|) + (|UniqueFactorizationDomain|) + (|PrincipalIdealDomain|) + (|OrderedIntegralDomain|) (|GcdDomain|) + (|IntegralDomain|) (|Algebra| $$) + (|CharacteristicZero|) + (|LinearlyExplicitRingOver| 11) + (|DifferentialRing|) (|OrderedRing|) + (|CommutativeRing|) (|EntireRing|) + (|Module| $$) (|OrderedAbelianGroup|) + (|BiModule| $$ $$) (|Ring|) + (|OrderedCancellationAbelianMonoid|) + (|LeftModule| $$) (|Rng|) + (|RightModule| $$) + (|OrderedAbelianMonoid|) + (|AbelianGroup|) + (|OrderedAbelianSemiGroup|) + (|CancellationAbelianMonoid|) + (|AbelianMonoid|) (|Monoid|) + (|StepThrough|) (|PatternMatchable| 11) + (|OrderedSet|) (|AbelianSemiGroup|) + (|SemiGroup|) (|RealConstant|) + (|SetCategory|) (|OpenMath|) + (|ConvertibleTo| 9) (|ConvertibleTo| 44) + (|ConvertibleTo| 47) + (|CombinatorialFunctionCategory|) + (|ConvertibleTo| 122) + (|ConvertibleTo| 49) + (|RetractableTo| 11) + (|ConvertibleTo| 11) (|BasicType|) + (|CoercibleTo| 35)) + (|makeByteWordVec2| 131 + '(1 7 6 0 8 3 7 6 0 9 9 10 2 7 6 0 11 + 12 1 7 6 0 13 0 14 0 15 2 7 0 9 14 16 + 1 7 6 0 17 1 7 6 0 18 1 7 6 0 19 1 35 + 0 11 36 1 44 0 11 45 1 49 0 11 50 2 + 92 91 90 89 93 1 96 95 94 97 1 94 0 0 + 98 1 94 2 0 99 1 100 95 94 101 1 94 0 + 2 102 1 0 103 0 104 2 107 95 105 106 + 108 2 109 95 95 95 110 1 100 95 94 + 111 1 94 21 0 112 1 94 0 0 113 1 115 + 94 114 116 2 0 21 0 0 1 1 0 21 0 25 1 + 0 86 0 87 1 0 0 0 88 1 0 21 0 1 2 0 0 + 0 0 1 2 0 82 0 0 1 3 0 0 0 0 0 42 1 0 + 0 0 1 1 0 103 0 1 2 0 21 0 0 1 1 0 11 + 0 1 2 0 0 0 0 81 0 0 0 1 1 0 123 0 1 + 1 0 11 0 1 2 0 0 0 0 80 2 0 59 56 60 + 61 1 0 55 56 57 1 0 82 0 84 1 0 120 0 + 1 1 0 21 0 1 1 0 119 0 1 1 0 0 0 64 0 + 0 0 63 2 0 0 0 0 79 1 0 126 124 1 1 0 + 21 0 1 3 0 0 0 0 0 1 2 0 0 0 0 54 1 0 + 21 0 1 2 0 0 0 0 1 3 0 121 0 122 121 + 1 1 0 21 0 26 1 0 21 0 74 1 0 82 0 1 + 1 0 21 0 34 2 0 125 124 0 1 3 0 0 0 0 + 0 43 2 0 0 0 0 76 2 0 0 0 0 75 1 0 0 + 0 1 1 0 0 0 40 1 0 0 124 1 2 0 0 0 0 + 1 1 0 9 0 53 2 0 0 0 0 1 0 0 0 1 1 0 + 0 0 31 1 0 0 0 33 1 0 131 0 1 2 0 117 + 117 117 118 2 0 0 0 0 85 1 0 0 124 1 + 1 0 0 0 1 1 0 103 0 104 3 0 128 0 0 0 + 1 2 0 129 0 0 1 2 0 82 0 0 83 2 0 125 + 124 0 1 1 0 21 0 1 1 0 72 0 1 2 0 77 + 0 0 78 1 0 0 0 1 2 0 0 0 72 1 1 0 0 0 + 32 1 0 0 0 30 1 0 9 0 52 1 0 47 0 48 + 1 0 44 0 46 1 0 49 0 51 1 0 122 0 1 1 + 0 11 0 39 1 0 0 11 38 1 0 0 11 38 1 0 + 0 0 1 1 0 35 0 37 0 0 72 1 2 0 21 0 0 + 1 2 0 0 0 0 1 0 0 0 29 2 0 21 0 0 1 3 + 0 0 0 0 0 41 1 0 0 0 62 2 0 0 0 72 1 + 2 0 0 0 130 1 0 0 0 27 0 0 0 28 3 0 6 + 7 0 21 24 2 0 9 0 21 22 2 0 6 7 0 23 + 1 0 9 0 20 1 0 0 0 1 2 0 0 0 72 1 2 0 + 21 0 0 1 2 0 21 0 0 1 2 0 21 0 0 65 2 + 0 21 0 0 1 2 0 21 0 0 66 2 0 0 0 0 69 + 1 0 0 0 67 2 0 0 0 0 68 2 0 0 0 72 73 + 2 0 0 0 130 1 2 0 0 0 0 70 2 0 0 11 0 + 71 2 0 0 72 0 1 2 0 0 130 0 1))))) + '|lookupComplete|)) + +(MAKEPROP '|Integer| 'NILADIC T) diff --git a/src/algebra/strap/INTDOM-.lsp b/src/algebra/strap/INTDOM-.lsp new file mode 100644 index 00000000..7c1f5677 --- /dev/null +++ b/src/algebra/strap/INTDOM-.lsp @@ -0,0 +1,79 @@ + +(/VERSIONCHECK 2) + +(DEFUN |INTDOM-;unitNormal;SR;1| (|x| $) + (VECTOR (|spadConstant| $ 7) |x| (|spadConstant| $ 7))) + +(DEFUN |INTDOM-;unitCanonical;2S;2| (|x| $) + (QVELT (SPADCALL |x| (QREFELT $ 10)) 1)) + +(DEFUN |INTDOM-;recip;SU;3| (|x| $) + (COND + ((SPADCALL |x| (QREFELT $ 13)) (CONS 1 "failed")) + ('T (SPADCALL (|spadConstant| $ 7) |x| (QREFELT $ 15))))) + +(DEFUN |INTDOM-;unit?;SB;4| (|x| $) + (COND ((QEQCAR (SPADCALL |x| (QREFELT $ 17)) 1) 'NIL) ('T 'T))) + +(DEFUN |INTDOM-;associates?;2SB;5| (|x| |y| $) + (SPADCALL (QVELT (SPADCALL |x| (QREFELT $ 10)) 1) + (QVELT (SPADCALL |y| (QREFELT $ 10)) 1) (QREFELT $ 19))) + +(DEFUN |INTDOM-;associates?;2SB;6| (|x| |y| $) + (COND + ((SPADCALL |x| (QREFELT $ 13)) (SPADCALL |y| (QREFELT $ 13))) + ((OR (SPADCALL |y| (QREFELT $ 13)) + (OR (QEQCAR (SPADCALL |x| |y| (QREFELT $ 15)) 1) + (QEQCAR (SPADCALL |y| |x| (QREFELT $ 15)) 1))) + 'NIL) + ('T 'T))) + +(DEFUN |IntegralDomain&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|IntegralDomain&|)) + (LETT |dv$| (LIST '|IntegralDomain&| |dv$1|) . #0#) + (LETT $ (GETREFV 21) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (COND + ((|HasCategory| |#1| '(|Field|))) + ('T + (QSETREFV $ 9 + (CONS (|dispatchFunction| |INTDOM-;unitNormal;SR;1|) $)))) + (COND + ((|HasAttribute| |#1| '|canonicalUnitNormal|) + (QSETREFV $ 20 + (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;5|) + $))) + ('T + (QSETREFV $ 20 + (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;6|) + $)))) + $)))) + +(MAKEPROP '|IntegralDomain&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |One|) + (|Record| (|:| |unit| $) (|:| |canonical| $) + (|:| |associate| $)) + (4 . |unitNormal|) (9 . |unitNormal|) + |INTDOM-;unitCanonical;2S;2| (|Boolean|) (14 . |zero?|) + (|Union| $ '"failed") (19 . |exquo|) |INTDOM-;recip;SU;3| + (25 . |recip|) |INTDOM-;unit?;SB;4| (30 . =) + (36 . |associates?|)) + '#(|unitNormal| 42 |unitCanonical| 47 |unit?| 52 |recip| 57 + |associates?| 62) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 20 + '(0 6 0 7 1 0 8 0 9 1 6 8 0 10 1 6 12 0 + 13 2 6 14 0 0 15 1 6 14 0 17 2 6 12 0 + 0 19 2 0 12 0 0 20 1 0 8 0 9 1 0 0 0 + 11 1 0 12 0 18 1 0 14 0 16 2 0 12 0 0 + 20))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/INTDOM.lsp b/src/algebra/strap/INTDOM.lsp new file mode 100644 index 00000000..9f770345 --- /dev/null +++ b/src/algebra/strap/INTDOM.lsp @@ -0,0 +1,34 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |IntegralDomain;AL| 'NIL) + +(DEFUN |IntegralDomain| () + (LET (#:G1393) + (COND + (|IntegralDomain;AL|) + (T (SETQ |IntegralDomain;AL| (|IntegralDomain;|)))))) + +(DEFUN |IntegralDomain;| () + (PROG (#0=#:G1391) + (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|) + (SETELT #0# 0 '(|IntegralDomain|)))))) + +(MAKEPROP '|IntegralDomain| 'NILADIC T) diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp new file mode 100644 index 00000000..65f503c0 --- /dev/null +++ b/src/algebra/strap/ISTRING.lsp @@ -0,0 +1,891 @@ + +(/VERSIONCHECK 2) + +(PUT '|ISTRING;new;NniC$;1| '|SPADreplace| 'MAKE-FULL-CVEC) + +(DEFUN |ISTRING;new;NniC$;1| (|n| |c| $) (MAKE-FULL-CVEC |n| |c|)) + +(PUT '|ISTRING;empty;$;2| '|SPADreplace| + '(XLAM NIL (MAKE-FULL-CVEC 0))) + +(DEFUN |ISTRING;empty;$;2| ($) (MAKE-FULL-CVEC 0)) + +(DEFUN |ISTRING;empty?;$B;3| (|s| $) (EQL (QCSIZE |s|) 0)) + +(PUT '|ISTRING;#;$Nni;4| '|SPADreplace| 'QCSIZE) + +(DEFUN |ISTRING;#;$Nni;4| (|s| $) (QCSIZE |s|)) + +(PUT '|ISTRING;=;2$B;5| '|SPADreplace| 'EQUAL) + +(DEFUN |ISTRING;=;2$B;5| (|s| |t| $) (EQUAL |s| |t|)) + +(PUT '|ISTRING;<;2$B;6| '|SPADreplace| + '(XLAM (|s| |t|) (CGREATERP |t| |s|))) + +(DEFUN |ISTRING;<;2$B;6| (|s| |t| $) (CGREATERP |t| |s|)) + +(PUT '|ISTRING;concat;3$;7| '|SPADreplace| 'STRCONC) + +(DEFUN |ISTRING;concat;3$;7| (|s| |t| $) (STRCONC |s| |t|)) + +(PUT '|ISTRING;copy;2$;8| '|SPADreplace| 'COPY-SEQ) + +(DEFUN |ISTRING;copy;2$;8| (|s| $) (COPY-SEQ |s|)) + +(DEFUN |ISTRING;insert;2$I$;9| (|s| |t| |i| $) + (SPADCALL + (SPADCALL + (SPADCALL |s| + (SPADCALL (QREFELT $ 6) (- |i| 1) (QREFELT $ 20)) + (QREFELT $ 21)) + |t| (QREFELT $ 16)) + (SPADCALL |s| (SPADCALL |i| (QREFELT $ 22)) (QREFELT $ 21)) + (QREFELT $ 16))) + +(DEFUN |ISTRING;coerce;$Of;10| (|s| $) (SPADCALL |s| (QREFELT $ 26))) + +(DEFUN |ISTRING;minIndex;$I;11| (|s| $) (QREFELT $ 6)) + +(DEFUN |ISTRING;upperCase!;2$;12| (|s| $) + (SPADCALL (ELT $ 31) |s| (QREFELT $ 33))) + +(DEFUN |ISTRING;lowerCase!;2$;13| (|s| $) + (SPADCALL (ELT $ 36) |s| (QREFELT $ 33))) + +(DEFUN |ISTRING;latex;$S;14| (|s| $) + (STRCONC "\\mbox{``" (STRCONC |s| "''}"))) + +(DEFUN |ISTRING;replace;$Us2$;15| (|s| |sg| |t| $) + (PROG (|l| |m| |n| |h| #0=#:G1770 |r| #1=#:G1776 #2=#:G1777 |i| + #3=#:G1778 |k|) + (RETURN + (SEQ (LETT |l| (- (SPADCALL |sg| (QREFELT $ 39)) (QREFELT $ 6)) + |ISTRING;replace;$Us2$;15|) + (LETT |m| (SPADCALL |s| (QREFELT $ 13)) + |ISTRING;replace;$Us2$;15|) + (LETT |n| (SPADCALL |t| (QREFELT $ 13)) + |ISTRING;replace;$Us2$;15|) + (LETT |h| + (COND + ((SPADCALL |sg| (QREFELT $ 40)) + (- (SPADCALL |sg| (QREFELT $ 41)) (QREFELT $ 6))) + ('T (- (SPADCALL |s| (QREFELT $ 42)) (QREFELT $ 6)))) + |ISTRING;replace;$Us2$;15|) + (COND + ((OR (OR (< |l| 0) (NULL (< |h| |m|))) (< |h| (- |l| 1))) + (EXIT (|error| "index out of range")))) + (LETT |r| + (SPADCALL + (PROG1 (LETT #0# (+ (- |m| (+ (- |h| |l|) 1)) |n|) + |ISTRING;replace;$Us2$;15|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (SPADCALL (QREFELT $ 43)) (QREFELT $ 9)) + |ISTRING;replace;$Us2$;15|) + (SEQ (LETT |i| 0 |ISTRING;replace;$Us2$;15|) + (LETT #1# (- |l| 1) |ISTRING;replace;$Us2$;15|) + (LETT |k| 0 |ISTRING;replace;$Us2$;15|) G190 + (COND ((QSGREATERP |i| #1#) (GO G191))) + (SEQ (EXIT (QESET |r| |k| (CHAR |s| |i|)))) + (LETT |k| + (PROG1 (QSADD1 |k|) + (LETT |i| (QSADD1 |i|) + |ISTRING;replace;$Us2$;15|)) + |ISTRING;replace;$Us2$;15|) + (GO G190) G191 (EXIT NIL)) + (SEQ (LETT |i| 0 |ISTRING;replace;$Us2$;15|) + (LETT #2# (- |n| 1) |ISTRING;replace;$Us2$;15|) + (LETT |k| |k| |ISTRING;replace;$Us2$;15|) G190 + (COND ((QSGREATERP |i| #2#) (GO G191))) + (SEQ (EXIT (QESET |r| |k| (CHAR |t| |i|)))) + (LETT |k| + (PROG1 (+ |k| 1) + (LETT |i| (QSADD1 |i|) + |ISTRING;replace;$Us2$;15|)) + |ISTRING;replace;$Us2$;15|) + (GO G190) G191 (EXIT NIL)) + (SEQ (LETT |i| (+ |h| 1) |ISTRING;replace;$Us2$;15|) + (LETT #3# (- |m| 1) |ISTRING;replace;$Us2$;15|) + (LETT |k| |k| |ISTRING;replace;$Us2$;15|) G190 + (COND ((> |i| #3#) (GO G191))) + (SEQ (EXIT (QESET |r| |k| (CHAR |s| |i|)))) + (LETT |k| + (PROG1 (+ |k| 1) + (LETT |i| (+ |i| 1) |ISTRING;replace;$Us2$;15|)) + |ISTRING;replace;$Us2$;15|) + (GO G190) G191 (EXIT NIL)) + (EXIT |r|))))) + +(DEFUN |ISTRING;setelt;$I2C;16| (|s| |i| |c| $) + (SEQ (COND + ((OR (< |i| (QREFELT $ 6)) + (< (SPADCALL |s| (QREFELT $ 42)) |i|)) + (|error| "index out of range")) + ('T (SEQ (QESET |s| (- |i| (QREFELT $ 6)) |c|) (EXIT |c|)))))) + +(DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $) + (PROG (|np| |nw| |iw| |ip| #0=#:G1788 #1=#:G1787 #2=#:G1783) + (RETURN + (SEQ (EXIT (SEQ (LETT |np| (QCSIZE |part|) + |ISTRING;substring?;2$IB;17|) + (LETT |nw| (QCSIZE |whole|) + |ISTRING;substring?;2$IB;17|) + (LETT |startpos| (- |startpos| (QREFELT $ 6)) + |ISTRING;substring?;2$IB;17|) + (EXIT (COND + ((< |startpos| 0) + (|error| "index out of bounds")) + ((< (- |nw| |startpos|) |np|) 'NIL) + ('T + (SEQ (SEQ + (EXIT + (SEQ + (LETT |iw| |startpos| + |ISTRING;substring?;2$IB;17|) + (LETT |ip| 0 + |ISTRING;substring?;2$IB;17|) + (LETT #0# (- |np| 1) + |ISTRING;substring?;2$IB;17|) + G190 + (COND + ((QSGREATERP |ip| #0#) + (GO G191))) + (SEQ + (EXIT + (COND + ((NULL + (CHAR= (CHAR |part| |ip|) + (CHAR |whole| |iw|))) + (PROGN + (LETT #2# + (PROGN + (LETT #1# 'NIL + |ISTRING;substring?;2$IB;17|) + (GO #1#)) + |ISTRING;substring?;2$IB;17|) + (GO #2#)))))) + (LETT |ip| + (PROG1 (QSADD1 |ip|) + (LETT |iw| (+ |iw| 1) + |ISTRING;substring?;2$IB;17|)) + |ISTRING;substring?;2$IB;17|) + (GO G190) G191 (EXIT NIL))) + #2# (EXIT #2#)) + (EXIT 'T))))))) + #1# (EXIT #1#))))) + +(DEFUN |ISTRING;position;2$2I;18| (|s| |t| |startpos| $) + (PROG (|r|) + (RETURN + (SEQ (LETT |startpos| (- |startpos| (QREFELT $ 6)) + |ISTRING;position;2$2I;18|) + (EXIT (COND + ((< |startpos| 0) (|error| "index out of bounds")) + ((NULL (< |startpos| (QCSIZE |t|))) + (- (QREFELT $ 6) 1)) + ('T + (SEQ (LETT |r| (STRPOS |s| |t| |startpos| NIL) + |ISTRING;position;2$2I;18|) + (EXIT (COND + ((EQ |r| NIL) (- (QREFELT $ 6) 1)) + ('T (+ |r| (QREFELT $ 6))))))))))))) + +(DEFUN |ISTRING;position;C$2I;19| (|c| |t| |startpos| $) + (PROG (|r| #0=#:G1799 #1=#:G1798) + (RETURN + (SEQ (EXIT (SEQ (LETT |startpos| (- |startpos| (QREFELT $ 6)) + |ISTRING;position;C$2I;19|) + (EXIT (COND + ((< |startpos| 0) + (|error| "index out of bounds")) + ((NULL (< |startpos| (QCSIZE |t|))) + (- (QREFELT $ 6) 1)) + ('T + (SEQ (SEQ + (LETT |r| |startpos| + |ISTRING;position;C$2I;19|) + (LETT #0# + (QSDIFFERENCE (QCSIZE |t|) 1) + |ISTRING;position;C$2I;19|) + G190 + (COND ((> |r| #0#) (GO G191))) + (SEQ + (EXIT + (COND + ((CHAR= (CHAR |t| |r|) |c|) + (PROGN + (LETT #1# + (+ |r| (QREFELT $ 6)) + |ISTRING;position;C$2I;19|) + (GO #1#)))))) + (LETT |r| (+ |r| 1) + |ISTRING;position;C$2I;19|) + (GO G190) G191 (EXIT NIL)) + (EXIT (- (QREFELT $ 6) 1)))))))) + #1# (EXIT #1#))))) + +(DEFUN |ISTRING;position;Cc$2I;20| (|cc| |t| |startpos| $) + (PROG (|r| #0=#:G1806 #1=#:G1805) + (RETURN + (SEQ (EXIT (SEQ (LETT |startpos| (- |startpos| (QREFELT $ 6)) + |ISTRING;position;Cc$2I;20|) + (EXIT (COND + ((< |startpos| 0) + (|error| "index out of bounds")) + ((NULL (< |startpos| (QCSIZE |t|))) + (- (QREFELT $ 6) 1)) + ('T + (SEQ (SEQ + (LETT |r| |startpos| + |ISTRING;position;Cc$2I;20|) + (LETT #0# + (QSDIFFERENCE (QCSIZE |t|) 1) + |ISTRING;position;Cc$2I;20|) + G190 + (COND ((> |r| #0#) (GO G191))) + (SEQ + (EXIT + (COND + ((SPADCALL (CHAR |t| |r|) |cc| + (QREFELT $ 49)) + (PROGN + (LETT #1# + (+ |r| (QREFELT $ 6)) + |ISTRING;position;Cc$2I;20|) + (GO #1#)))))) + (LETT |r| (+ |r| 1) + |ISTRING;position;Cc$2I;20|) + (GO G190) G191 (EXIT NIL)) + (EXIT (- (QREFELT $ 6) 1)))))))) + #1# (EXIT #1#))))) + +(DEFUN |ISTRING;suffix?;2$B;21| (|s| |t| $) + (PROG (|n| |m|) + (RETURN + (SEQ (LETT |n| (SPADCALL |t| (QREFELT $ 42)) + |ISTRING;suffix?;2$B;21|) + (LETT |m| (SPADCALL |s| (QREFELT $ 42)) + |ISTRING;suffix?;2$B;21|) + (EXIT (COND + ((< |n| |m|) 'NIL) + ('T + (SPADCALL |s| |t| (- (+ (QREFELT $ 6) |n|) |m|) + (QREFELT $ 46))))))))) + +(DEFUN |ISTRING;split;$CL;22| (|s| |c| $) + (PROG (|n| |j| |i| |l|) + (RETURN + (SEQ (LETT |n| (SPADCALL |s| (QREFELT $ 42)) + |ISTRING;split;$CL;22|) + (SEQ (LETT |i| (QREFELT $ 6) |ISTRING;split;$CL;22|) G190 + (COND + ((OR (> |i| |n|) + (NULL (SPADCALL + (SPADCALL |s| |i| (QREFELT $ 52)) |c| + (QREFELT $ 53)))) + (GO G191))) + (SEQ (EXIT 0)) + (LETT |i| (+ |i| 1) |ISTRING;split;$CL;22|) (GO G190) + G191 (EXIT NIL)) + (LETT |l| (SPADCALL (QREFELT $ 55)) |ISTRING;split;$CL;22|) + (SEQ G190 + (COND + ((NULL (COND + ((< |n| |i|) 'NIL) + ('T + (SPADCALL + (< (LETT |j| + (SPADCALL |c| |s| |i| + (QREFELT $ 48)) + |ISTRING;split;$CL;22|) + (QREFELT $ 6)) + (QREFELT $ 56))))) + (GO G191))) + (SEQ (LETT |l| + (SPADCALL + (SPADCALL |s| + (SPADCALL |i| (- |j| 1) + (QREFELT $ 20)) + (QREFELT $ 21)) + |l| (QREFELT $ 57)) + |ISTRING;split;$CL;22|) + (EXIT (SEQ (LETT |i| |j| |ISTRING;split;$CL;22|) + G190 + (COND + ((OR (> |i| |n|) + (NULL + (SPADCALL + (SPADCALL |s| |i| (QREFELT $ 52)) + |c| (QREFELT $ 53)))) + (GO G191))) + (SEQ (EXIT 0)) + (LETT |i| (+ |i| 1) + |ISTRING;split;$CL;22|) + (GO G190) G191 (EXIT NIL)))) + NIL (GO G190) G191 (EXIT NIL)) + (COND + ((NULL (< |n| |i|)) + (LETT |l| + (SPADCALL + (SPADCALL |s| (SPADCALL |i| |n| (QREFELT $ 20)) + (QREFELT $ 21)) + |l| (QREFELT $ 57)) + |ISTRING;split;$CL;22|))) + (EXIT (SPADCALL |l| (QREFELT $ 58))))))) + +(DEFUN |ISTRING;split;$CcL;23| (|s| |cc| $) + (PROG (|n| |j| |i| |l|) + (RETURN + (SEQ (LETT |n| (SPADCALL |s| (QREFELT $ 42)) + |ISTRING;split;$CcL;23|) + (SEQ (LETT |i| (QREFELT $ 6) |ISTRING;split;$CcL;23|) G190 + (COND + ((OR (> |i| |n|) + (NULL (SPADCALL + (SPADCALL |s| |i| (QREFELT $ 52)) |cc| + (QREFELT $ 49)))) + (GO G191))) + (SEQ (EXIT 0)) + (LETT |i| (+ |i| 1) |ISTRING;split;$CcL;23|) (GO G190) + G191 (EXIT NIL)) + (LETT |l| (SPADCALL (QREFELT $ 55)) |ISTRING;split;$CcL;23|) + (SEQ G190 + (COND + ((NULL (COND + ((< |n| |i|) 'NIL) + ('T + (SPADCALL + (< (LETT |j| + (SPADCALL |cc| |s| |i| + (QREFELT $ 50)) + |ISTRING;split;$CcL;23|) + (QREFELT $ 6)) + (QREFELT $ 56))))) + (GO G191))) + (SEQ (LETT |l| + (SPADCALL + (SPADCALL |s| + (SPADCALL |i| (- |j| 1) + (QREFELT $ 20)) + (QREFELT $ 21)) + |l| (QREFELT $ 57)) + |ISTRING;split;$CcL;23|) + (EXIT (SEQ (LETT |i| |j| |ISTRING;split;$CcL;23|) + G190 + (COND + ((OR (> |i| |n|) + (NULL + (SPADCALL + (SPADCALL |s| |i| (QREFELT $ 52)) + |cc| (QREFELT $ 49)))) + (GO G191))) + (SEQ (EXIT 0)) + (LETT |i| (+ |i| 1) + |ISTRING;split;$CcL;23|) + (GO G190) G191 (EXIT NIL)))) + NIL (GO G190) G191 (EXIT NIL)) + (COND + ((NULL (< |n| |i|)) + (LETT |l| + (SPADCALL + (SPADCALL |s| (SPADCALL |i| |n| (QREFELT $ 20)) + (QREFELT $ 21)) + |l| (QREFELT $ 57)) + |ISTRING;split;$CcL;23|))) + (EXIT (SPADCALL |l| (QREFELT $ 58))))))) + +(DEFUN |ISTRING;leftTrim;$C$;24| (|s| |c| $) + (PROG (|n| |i|) + (RETURN + (SEQ (LETT |n| (SPADCALL |s| (QREFELT $ 42)) + |ISTRING;leftTrim;$C$;24|) + (SEQ (LETT |i| (QREFELT $ 6) |ISTRING;leftTrim;$C$;24|) G190 + (COND + ((OR (> |i| |n|) + (NULL (SPADCALL + (SPADCALL |s| |i| (QREFELT $ 52)) |c| + (QREFELT $ 53)))) + (GO G191))) + (SEQ (EXIT 0)) + (LETT |i| (+ |i| 1) |ISTRING;leftTrim;$C$;24|) + (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |s| (SPADCALL |i| |n| (QREFELT $ 20)) + (QREFELT $ 21))))))) + +(DEFUN |ISTRING;leftTrim;$Cc$;25| (|s| |cc| $) + (PROG (|n| |i|) + (RETURN + (SEQ (LETT |n| (SPADCALL |s| (QREFELT $ 42)) + |ISTRING;leftTrim;$Cc$;25|) + (SEQ (LETT |i| (QREFELT $ 6) |ISTRING;leftTrim;$Cc$;25|) + G190 + (COND + ((OR (> |i| |n|) + (NULL (SPADCALL + (SPADCALL |s| |i| (QREFELT $ 52)) |cc| + (QREFELT $ 49)))) + (GO G191))) + (SEQ (EXIT 0)) + (LETT |i| (+ |i| 1) |ISTRING;leftTrim;$Cc$;25|) + (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |s| (SPADCALL |i| |n| (QREFELT $ 20)) + (QREFELT $ 21))))))) + +(DEFUN |ISTRING;rightTrim;$C$;26| (|s| |c| $) + (PROG (|j| #0=#:G1830) + (RETURN + (SEQ (SEQ (LETT |j| (SPADCALL |s| (QREFELT $ 42)) + |ISTRING;rightTrim;$C$;26|) + (LETT #0# (QREFELT $ 6) |ISTRING;rightTrim;$C$;26|) + G190 + (COND + ((OR (< |j| #0#) + (NULL (SPADCALL + (SPADCALL |s| |j| (QREFELT $ 52)) |c| + (QREFELT $ 53)))) + (GO G191))) + (SEQ (EXIT 0)) + (LETT |j| (+ |j| -1) |ISTRING;rightTrim;$C$;26|) + (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |s| + (SPADCALL (SPADCALL |s| (QREFELT $ 28)) |j| + (QREFELT $ 20)) + (QREFELT $ 21))))))) + +(DEFUN |ISTRING;rightTrim;$Cc$;27| (|s| |cc| $) + (PROG (|j| #0=#:G1834) + (RETURN + (SEQ (SEQ (LETT |j| (SPADCALL |s| (QREFELT $ 42)) + |ISTRING;rightTrim;$Cc$;27|) + (LETT #0# (QREFELT $ 6) |ISTRING;rightTrim;$Cc$;27|) + G190 + (COND + ((OR (< |j| #0#) + (NULL (SPADCALL + (SPADCALL |s| |j| (QREFELT $ 52)) |cc| + (QREFELT $ 49)))) + (GO G191))) + (SEQ (EXIT 0)) + (LETT |j| (+ |j| -1) |ISTRING;rightTrim;$Cc$;27|) + (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |s| + (SPADCALL (SPADCALL |s| (QREFELT $ 28)) |j| + (QREFELT $ 20)) + (QREFELT $ 21))))))) + +(DEFUN |ISTRING;concat;L$;28| (|l| $) + (PROG (#0=#:G1842 #1=#:G1837 #2=#:G1835 #3=#:G1836 |t| |s| #4=#:G1843 + |i|) + (RETURN + (SEQ (LETT |t| + (SPADCALL + (PROGN + (LETT #3# NIL |ISTRING;concat;L$;28|) + (SEQ (LETT |s| NIL |ISTRING;concat;L$;28|) + (LETT #0# |l| |ISTRING;concat;L$;28|) G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |s| (CAR #0#) + |ISTRING;concat;L$;28|) + NIL)) + (GO G191))) + (SEQ (EXIT (PROGN + (LETT #1# + (SPADCALL |s| (QREFELT $ 13)) + |ISTRING;concat;L$;28|) + (COND + (#3# + (LETT #2# (+ #2# #1#) + |ISTRING;concat;L$;28|)) + ('T + (PROGN + (LETT #2# #1# + |ISTRING;concat;L$;28|) + (LETT #3# 'T + |ISTRING;concat;L$;28|))))))) + (LETT #0# (CDR #0#) |ISTRING;concat;L$;28|) + (GO G190) G191 (EXIT NIL)) + (COND (#3# #2#) ('T 0))) + (SPADCALL (QREFELT $ 43)) (QREFELT $ 9)) + |ISTRING;concat;L$;28|) + (LETT |i| (QREFELT $ 6) |ISTRING;concat;L$;28|) + (SEQ (LETT |s| NIL |ISTRING;concat;L$;28|) + (LETT #4# |l| |ISTRING;concat;L$;28|) G190 + (COND + ((OR (ATOM #4#) + (PROGN + (LETT |s| (CAR #4#) |ISTRING;concat;L$;28|) + NIL)) + (GO G191))) + (SEQ (SPADCALL |t| |s| |i| (QREFELT $ 66)) + (EXIT (LETT |i| + (+ |i| (SPADCALL |s| (QREFELT $ 13))) + |ISTRING;concat;L$;28|))) + (LETT #4# (CDR #4#) |ISTRING;concat;L$;28|) (GO G190) + G191 (EXIT NIL)) + (EXIT |t|))))) + +(DEFUN |ISTRING;copyInto!;2$I$;29| (|y| |x| |s| $) + (PROG (|m| |n|) + (RETURN + (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 13)) + |ISTRING;copyInto!;2$I$;29|) + (LETT |n| (SPADCALL |y| (QREFELT $ 13)) + |ISTRING;copyInto!;2$I$;29|) + (LETT |s| (- |s| (QREFELT $ 6)) |ISTRING;copyInto!;2$I$;29|) + (COND + ((OR (< |s| 0) (< |n| (+ |s| |m|))) + (EXIT (|error| "index out of range")))) + (RPLACSTR |y| |s| |m| |x| 0 |m|) (EXIT |y|))))) + +(DEFUN |ISTRING;elt;$IC;30| (|s| |i| $) + (COND + ((OR (< |i| (QREFELT $ 6)) (< (SPADCALL |s| (QREFELT $ 42)) |i|)) + (|error| "index out of range")) + ('T (CHAR |s| (- |i| (QREFELT $ 6)))))) + +(DEFUN |ISTRING;elt;$Us$;31| (|s| |sg| $) + (PROG (|l| |h|) + (RETURN + (SEQ (LETT |l| (- (SPADCALL |sg| (QREFELT $ 39)) (QREFELT $ 6)) + |ISTRING;elt;$Us$;31|) + (LETT |h| + (COND + ((SPADCALL |sg| (QREFELT $ 40)) + (- (SPADCALL |sg| (QREFELT $ 41)) (QREFELT $ 6))) + ('T (- (SPADCALL |s| (QREFELT $ 42)) (QREFELT $ 6)))) + |ISTRING;elt;$Us$;31|) + (COND + ((OR (< |l| 0) + (NULL (< |h| (SPADCALL |s| (QREFELT $ 13))))) + (EXIT (|error| "index out of bound")))) + (EXIT (SUBSTRING |s| |l| (MAX 0 (+ (- |h| |l|) 1)))))))) + +(DEFUN |ISTRING;hash;$I;32| (|s| $) + (PROG (|n|) + (RETURN + (SEQ (LETT |n| (QCSIZE |s|) |ISTRING;hash;$I;32|) + (EXIT (COND + ((ZEROP |n|) 0) + ((EQL |n| 1) + (SPADCALL + (SPADCALL |s| (QREFELT $ 6) (QREFELT $ 52)) + (QREFELT $ 68))) + ('T + (* (* (SPADCALL + (SPADCALL |s| (QREFELT $ 6) + (QREFELT $ 52)) + (QREFELT $ 68)) + (SPADCALL + (SPADCALL |s| (- (+ (QREFELT $ 6) |n|) 1) + (QREFELT $ 52)) + (QREFELT $ 68))) + (SPADCALL + (SPADCALL |s| + (+ (QREFELT $ 6) (QUOTIENT2 |n| 2)) + (QREFELT $ 52)) + (QREFELT $ 68)))))))))) + +(DEFUN |ISTRING;match;2$CNni;33| (|pattern| |target| |wildcard| $) + (|stringMatch| |pattern| |target| (CHARACTER |wildcard|))) + +(DEFUN |ISTRING;match?;2$CB;34| (|pattern| |target| |dontcare| $) + (PROG (|n| |m| #0=#:G1857 #1=#:G1859 |s| #2=#:G1860 #3=#:G1868 |i| + |p| #4=#:G1861 |q|) + (RETURN + (SEQ (EXIT (SEQ (LETT |n| (SPADCALL |pattern| (QREFELT $ 42)) + |ISTRING;match?;2$CB;34|) + (LETT |p| + (PROG1 (LETT #0# + (SPADCALL |dontcare| |pattern| + (LETT |m| + (SPADCALL |pattern| + (QREFELT $ 28)) + |ISTRING;match?;2$CB;34|) + (QREFELT $ 48)) + |ISTRING;match?;2$CB;34|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + |ISTRING;match?;2$CB;34|) + (EXIT (COND + ((EQL |p| (- |m| 1)) + (SPADCALL |pattern| |target| + (QREFELT $ 14))) + ('T + (SEQ (COND + ((NULL (EQL |p| |m|)) + (COND + ((NULL + (SPADCALL + (SPADCALL |pattern| + (SPADCALL |m| (- |p| 1) + (QREFELT $ 20)) + (QREFELT $ 21)) + |target| (QREFELT $ 71))) + (EXIT 'NIL))))) + (LETT |i| |p| + |ISTRING;match?;2$CB;34|) + (LETT |q| + (PROG1 + (LETT #1# + (SPADCALL |dontcare| |pattern| + (+ |p| 1) (QREFELT $ 48)) + |ISTRING;match?;2$CB;34|) + (|check-subtype| (>= #1# 0) + '(|NonNegativeInteger|) #1#)) + |ISTRING;match?;2$CB;34|) + (SEQ G190 + (COND + ((NULL + (SPADCALL (EQL |q| (- |m| 1)) + (QREFELT $ 56))) + (GO G191))) + (SEQ + (LETT |s| + (SPADCALL |pattern| + (SPADCALL (+ |p| 1) (- |q| 1) + (QREFELT $ 20)) + (QREFELT $ 21)) + |ISTRING;match?;2$CB;34|) + (LETT |i| + (PROG1 + (LETT #2# + (SPADCALL |s| |target| |i| + (QREFELT $ 47)) + |ISTRING;match?;2$CB;34|) + (|check-subtype| (>= #2# 0) + '(|NonNegativeInteger|) #2#)) + |ISTRING;match?;2$CB;34|) + (EXIT + (COND + ((EQL |i| (- |m| 1)) + (PROGN + (LETT #3# 'NIL + |ISTRING;match?;2$CB;34|) + (GO #3#))) + ('T + (SEQ + (LETT |i| + (+ |i| + (SPADCALL |s| + (QREFELT $ 13))) + |ISTRING;match?;2$CB;34|) + (LETT |p| |q| + |ISTRING;match?;2$CB;34|) + (EXIT + (LETT |q| + (PROG1 + (LETT #4# + (SPADCALL |dontcare| + |pattern| (+ |q| 1) + (QREFELT $ 48)) + |ISTRING;match?;2$CB;34|) + (|check-subtype| + (>= #4# 0) + '(|NonNegativeInteger|) + #4#)) + |ISTRING;match?;2$CB;34|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (COND + ((NULL (EQL |p| |n|)) + (COND + ((NULL + (SPADCALL + (SPADCALL |pattern| + (SPADCALL (+ |p| 1) |n| + (QREFELT $ 20)) + (QREFELT $ 21)) + |target| (QREFELT $ 51))) + (EXIT 'NIL))))) + (EXIT 'T))))))) + #3# (EXIT #3#))))) + +(DEFUN |IndexedString| (#0=#:G1875) + (PROG () + (RETURN + (PROG (#1=#:G1876) + (RETURN + (COND + ((LETT #1# + (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) + (HGET |$ConstructorCache| '|IndexedString|) + '|domainEqualList|) + |IndexedString|) + (|CDRwithIncrement| #1#)) + ('T + (UNWIND-PROTECT + (PROG1 (|IndexedString;| #0#) + (LETT #1# T |IndexedString|)) + (COND + ((NOT #1#) + (HREM |$ConstructorCache| '|IndexedString|))))))))))) + +(DEFUN |IndexedString;| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|IndexedString|)) + (LETT |dv$| (LIST '|IndexedString| |dv$1|) . #0#) + (LETT $ (|newShell| 84) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (OR (AND (|HasCategory| (|Character|) + '(|OrderedSet|)) + (|HasCategory| (|Character|) + '(|Evalable| (|Character|)))) + (AND (|HasCategory| (|Character|) + '(|SetCategory|)) + (|HasCategory| (|Character|) + '(|Evalable| (|Character|))))) + (OR (|HasCategory| (|Character|) + '(|CoercibleTo| (|OutputForm|))) + (AND (|HasCategory| (|Character|) + '(|SetCategory|)) + (|HasCategory| (|Character|) + '(|Evalable| (|Character|))))) + (|HasCategory| (|Character|) + '(|ConvertibleTo| (|InputForm|))) + (OR (|HasCategory| (|Character|) + '(|OrderedSet|)) + (|HasCategory| (|Character|) + '(|SetCategory|))) + (|HasCategory| (|Character|) + '(|OrderedSet|)) + (|HasCategory| (|Integer|) '(|OrderedSet|)) + (|HasCategory| (|Character|) + '(|SetCategory|)) + (AND (|HasCategory| (|Character|) + '(|SetCategory|)) + (|HasCategory| (|Character|) + '(|Evalable| (|Character|)))) + (|HasCategory| (|Character|) + '(|CoercibleTo| (|OutputForm|))))) . #0#)) + (|haddProp| |$ConstructorCache| '|IndexedString| (LIST |dv$1|) + (CONS 1 $)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|IndexedString| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) + (|NonNegativeInteger|) (|Character|) |ISTRING;new;NniC$;1| + |ISTRING;empty;$;2| (|Boolean|) |ISTRING;empty?;$B;3| + |ISTRING;#;$Nni;4| |ISTRING;=;2$B;5| |ISTRING;<;2$B;6| + |ISTRING;concat;3$;7| |ISTRING;copy;2$;8| (|Integer|) + (|UniversalSegment| 18) (0 . SEGMENT) + |ISTRING;elt;$Us$;31| (6 . SEGMENT) + |ISTRING;insert;2$I$;9| (|String|) (|OutputForm|) + (11 . |outputForm|) |ISTRING;coerce;$Of;10| + |ISTRING;minIndex;$I;11| (|CharacterClass|) + (16 . |upperCase|) (20 . |upperCase|) (|Mapping| 8 8) + (25 . |map!|) |ISTRING;upperCase!;2$;12| + (31 . |lowerCase|) (35 . |lowerCase|) + |ISTRING;lowerCase!;2$;13| |ISTRING;latex;$S;14| + (40 . |lo|) (45 . |hasHi|) (50 . |hi|) (55 . |maxIndex|) + (60 . |space|) |ISTRING;replace;$Us2$;15| + |ISTRING;setelt;$I2C;16| |ISTRING;substring?;2$IB;17| + |ISTRING;position;2$2I;18| |ISTRING;position;C$2I;19| + (64 . |member?|) |ISTRING;position;Cc$2I;20| + |ISTRING;suffix?;2$B;21| |ISTRING;elt;$IC;30| (70 . =) + (|List| $$) (76 . |empty|) (80 . |not|) (85 . |concat|) + (91 . |reverse!|) (|List| $) |ISTRING;split;$CL;22| + |ISTRING;split;$CcL;23| |ISTRING;leftTrim;$C$;24| + |ISTRING;leftTrim;$Cc$;25| |ISTRING;rightTrim;$C$;26| + |ISTRING;rightTrim;$Cc$;27| |ISTRING;copyInto!;2$I$;29| + |ISTRING;concat;L$;28| (96 . |ord|) |ISTRING;hash;$I;32| + |ISTRING;match;2$CNni;33| (101 . |prefix?|) + |ISTRING;match?;2$CB;34| (|List| 8) (|List| 75) + (|Equation| 8) (|Mapping| 8 8 8) (|InputForm|) + (|SingleInteger|) (|Mapping| 11 8) (|Mapping| 11 8 8) + (|Void|) (|Union| 8 '"failed") (|List| 18)) + '#(~= 107 |upperCase!| 113 |upperCase| 118 |trim| 123 |swap!| + 135 |suffix?| 142 |substring?| 148 |split| 155 |sorted?| + 167 |sort!| 178 |sort| 189 |size?| 200 |setelt| 206 + |select| 220 |sample| 226 |rightTrim| 230 |reverse!| 242 + |reverse| 247 |replace| 252 |removeDuplicates| 259 + |remove| 264 |reduce| 276 |qsetelt!| 297 |qelt| 304 + |prefix?| 310 |position| 316 |parts| 349 |new| 354 |more?| + 360 |minIndex| 366 |min| 371 |merge| 377 |members| 390 + |member?| 395 |maxIndex| 401 |max| 406 |match?| 412 + |match| 419 |map!| 426 |map| 432 |lowerCase!| 445 + |lowerCase| 450 |less?| 455 |leftTrim| 461 |latex| 473 + |insert| 478 |indices| 492 |index?| 497 |hash| 503 |first| + 513 |find| 518 |fill!| 524 |every?| 530 |eval| 536 |eq?| + 562 |entry?| 568 |entries| 574 |empty?| 579 |empty| 584 + |elt| 588 |delete| 613 |count| 625 |copyInto!| 637 |copy| + 644 |convert| 649 |construct| 654 |concat| 659 |coerce| + 682 |any?| 692 >= 698 > 704 = 710 <= 716 < 722 |#| 728) + '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) + (CONS (|makeByteWordVec2| 5 + '(0 0 0 0 0 0 0 5 0 0 1 4 0 0 1 2 3 4)) + (CONS '#(|StringAggregate&| + |OneDimensionalArrayAggregate&| + |FiniteLinearAggregate&| |LinearAggregate&| + |IndexedAggregate&| |Collection&| + |HomogeneousAggregate&| |OrderedSet&| + |Aggregate&| |EltableAggregate&| |Evalable&| + |SetCategory&| NIL NIL |InnerEvalable&| NIL + NIL |BasicType&|) + (CONS '#((|StringAggregate|) + (|OneDimensionalArrayAggregate| 8) + (|FiniteLinearAggregate| 8) + (|LinearAggregate| 8) + (|IndexedAggregate| 18 8) + (|Collection| 8) + (|HomogeneousAggregate| 8) + (|OrderedSet|) (|Aggregate|) + (|EltableAggregate| 18 8) (|Evalable| 8) + (|SetCategory|) (|Type|) + (|Eltable| 18 8) (|InnerEvalable| 8 8) + (|CoercibleTo| 25) (|ConvertibleTo| 77) + (|BasicType|)) + (|makeByteWordVec2| 83 + '(2 19 0 18 18 20 1 19 0 18 22 1 25 0 + 24 26 0 29 0 30 1 8 0 0 31 2 0 0 32 0 + 33 0 29 0 35 1 8 0 0 36 1 19 18 0 39 + 1 19 11 0 40 1 19 18 0 41 1 0 18 0 42 + 0 8 0 43 2 29 11 8 0 49 2 8 11 0 0 53 + 0 54 0 55 1 11 0 0 56 2 54 0 2 0 57 1 + 54 0 0 58 1 8 7 0 68 2 0 11 0 0 71 2 + 7 11 0 0 1 1 0 0 0 34 1 0 0 0 1 2 0 0 + 0 8 1 2 0 0 0 29 1 3 0 81 0 18 18 1 2 + 0 11 0 0 51 3 0 11 0 0 18 46 2 0 59 0 + 29 61 2 0 59 0 8 60 1 5 11 0 1 2 0 11 + 80 0 1 1 5 0 0 1 2 0 0 80 0 1 1 5 0 0 + 1 2 0 0 80 0 1 2 0 11 0 7 1 3 0 8 0 + 19 8 1 3 0 8 0 18 8 45 2 0 0 79 0 1 0 + 0 0 1 2 0 0 0 8 64 2 0 0 0 29 65 1 0 + 0 0 1 1 0 0 0 1 3 0 0 0 19 0 44 1 7 0 + 0 1 2 7 0 8 0 1 2 0 0 79 0 1 4 7 8 76 + 0 8 8 1 3 0 8 76 0 8 1 2 0 8 76 0 1 3 + 0 8 0 18 8 1 2 0 8 0 18 1 2 0 11 0 0 + 71 3 7 18 8 0 18 48 2 7 18 8 0 1 3 0 + 18 29 0 18 50 3 0 18 0 0 18 47 2 0 18 + 79 0 1 1 0 73 0 1 2 0 0 7 8 9 2 0 11 + 0 7 1 1 6 18 0 28 2 5 0 0 0 1 2 5 0 0 + 0 1 3 0 0 80 0 0 1 1 0 73 0 1 2 7 11 + 8 0 1 1 6 18 0 42 2 5 0 0 0 1 3 0 11 + 0 0 8 72 3 0 7 0 0 8 70 2 0 0 32 0 33 + 3 0 0 76 0 0 1 2 0 0 32 0 1 1 0 0 0 + 37 1 0 0 0 1 2 0 11 0 7 1 2 0 0 0 8 + 62 2 0 0 0 29 63 1 7 24 0 38 3 0 0 8 + 0 18 1 3 0 0 0 0 18 23 1 0 83 0 1 2 0 + 11 18 0 1 1 7 78 0 1 1 0 18 0 69 1 6 + 8 0 1 2 0 82 79 0 1 2 0 0 0 8 1 2 0 + 11 79 0 1 3 8 0 0 73 73 1 3 8 0 0 8 8 + 1 2 8 0 0 74 1 2 8 0 0 75 1 2 0 11 0 + 0 1 2 7 11 8 0 1 1 0 73 0 1 1 0 11 0 + 12 0 0 0 10 2 0 0 0 0 1 2 0 0 0 19 21 + 2 0 8 0 18 52 3 0 8 0 18 8 1 2 0 0 0 + 18 1 2 0 0 0 19 1 2 7 7 8 0 1 2 0 7 + 79 0 1 3 0 0 0 0 18 66 1 0 0 0 17 1 3 + 77 0 1 1 0 0 73 1 1 0 0 59 67 2 0 0 0 + 0 16 2 0 0 0 8 1 2 0 0 8 0 1 1 9 25 0 + 27 1 0 0 8 1 2 0 11 79 0 1 2 5 11 0 0 + 1 2 5 11 0 0 1 2 7 11 0 0 14 2 5 11 0 + 0 1 2 5 11 0 0 15 1 0 7 0 13))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp new file mode 100644 index 00000000..69ffd104 --- /dev/null +++ b/src/algebra/strap/LIST.lsp @@ -0,0 +1,302 @@ + +(/VERSIONCHECK 2) + +(PUT '|LIST;nil;$;1| '|SPADreplace| '(XLAM NIL NIL)) + +(DEFUN |LIST;nil;$;1| ($) NIL) + +(PUT '|LIST;null;$B;2| '|SPADreplace| 'NULL) + +(DEFUN |LIST;null;$B;2| (|l| $) (NULL |l|)) + +(PUT '|LIST;cons;S2$;3| '|SPADreplace| 'CONS) + +(DEFUN |LIST;cons;S2$;3| (|s| |l| $) (CONS |s| |l|)) + +(PUT '|LIST;append;3$;4| '|SPADreplace| 'APPEND) + +(DEFUN |LIST;append;3$;4| (|l| |t| $) (APPEND |l| |t|)) + +(DEFUN |LIST;writeOMList| (|dev| |x| $) + (SEQ (SPADCALL |dev| (QREFELT $ 14)) + (SPADCALL |dev| "list1" "list" (QREFELT $ 16)) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |x|) (QREFELT $ 17))) (GO G191))) + (SEQ (SPADCALL |dev| (|SPADfirst| |x|) 'NIL (QREFELT $ 18)) + (EXIT (LETT |x| (CDR |x|) |LIST;writeOMList|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |dev| (QREFELT $ 19))))) + +(DEFUN |LIST;OMwrite;$S;6| (|x| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |LIST;OMwrite;$S;6|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |LIST;OMwrite;$S;6|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (QREFELT $ 21)) + (QREFELT $ 22)) + |LIST;OMwrite;$S;6|) + (SPADCALL |dev| (QREFELT $ 23)) + (|LIST;writeOMList| |dev| |x| $) + (SPADCALL |dev| (QREFELT $ 24)) + (SPADCALL |dev| (QREFELT $ 25)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |LIST;OMwrite;$S;6|) + (EXIT |s|))))) + +(DEFUN |LIST;OMwrite;$BS;7| (|x| |wholeObj| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |LIST;OMwrite;$BS;7|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |LIST;OMwrite;$BS;7|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (QREFELT $ 21)) + (QREFELT $ 22)) + |LIST;OMwrite;$BS;7|) + (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 23)))) + (|LIST;writeOMList| |dev| |x| $) + (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 24)))) + (SPADCALL |dev| (QREFELT $ 25)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |LIST;OMwrite;$BS;7|) + (EXIT |s|))))) + +(DEFUN |LIST;OMwrite;Omd$V;8| (|dev| |x| $) + (SEQ (SPADCALL |dev| (QREFELT $ 23)) (|LIST;writeOMList| |dev| |x| $) + (EXIT (SPADCALL |dev| (QREFELT $ 24))))) + +(DEFUN |LIST;OMwrite;Omd$BV;9| (|dev| |x| |wholeObj| $) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 23)))) + (|LIST;writeOMList| |dev| |x| $) + (EXIT (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 24))))))) + +(DEFUN |LIST;setUnion;3$;10| (|l1| |l2| $) + (SPADCALL (SPADCALL |l1| |l2| (QREFELT $ 30)) (QREFELT $ 31))) + +(DEFUN |LIST;setIntersection;3$;11| (|l1| |l2| $) + (PROG (|u|) + (RETURN + (SEQ (LETT |u| NIL |LIST;setIntersection;3$;11|) + (LETT |l1| (SPADCALL |l1| (QREFELT $ 31)) + |LIST;setIntersection;3$;11|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |l1|) (QREFELT $ 17))) + (GO G191))) + (SEQ (COND + ((SPADCALL (|SPADfirst| |l1|) |l2| + (QREFELT $ 33)) + (LETT |u| (CONS (|SPADfirst| |l1|) |u|) + |LIST;setIntersection;3$;11|))) + (EXIT (LETT |l1| (CDR |l1|) + |LIST;setIntersection;3$;11|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |u|))))) + +(DEFUN |LIST;setDifference;3$;12| (|l1| |l2| $) + (PROG (|l11| |lu|) + (RETURN + (SEQ (LETT |l1| (SPADCALL |l1| (QREFELT $ 31)) + |LIST;setDifference;3$;12|) + (LETT |lu| NIL |LIST;setDifference;3$;12|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |l1|) (QREFELT $ 17))) + (GO G191))) + (SEQ (LETT |l11| (SPADCALL |l1| 1 (QREFELT $ 36)) + |LIST;setDifference;3$;12|) + (COND + ((NULL (SPADCALL |l11| |l2| (QREFELT $ 33))) + (LETT |lu| (CONS |l11| |lu|) + |LIST;setDifference;3$;12|))) + (EXIT (LETT |l1| (CDR |l1|) + |LIST;setDifference;3$;12|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |lu|))))) + +(DEFUN |LIST;convert;$If;13| (|x| $) + (PROG (#0=#:G1440 |a| #1=#:G1441) + (RETURN + (SEQ (SPADCALL + (CONS (SPADCALL (SPADCALL "construct" (QREFELT $ 39)) + (QREFELT $ 41)) + (PROGN + (LETT #0# NIL |LIST;convert;$If;13|) + (SEQ (LETT |a| NIL |LIST;convert;$If;13|) + (LETT #1# |x| |LIST;convert;$If;13|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |a| (CAR #1#) + |LIST;convert;$If;13|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |a| (QREFELT $ 42)) + #0#) + |LIST;convert;$If;13|))) + (LETT #1# (CDR #1#) |LIST;convert;$If;13|) + (GO G190) G191 (EXIT (NREVERSE0 #0#))))) + (QREFELT $ 44)))))) + +(DEFUN |List| (#0=#:G1452) + (PROG () + (RETURN + (PROG (#1=#:G1453) + (RETURN + (COND + ((LETT #1# + (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) + (HGET |$ConstructorCache| '|List|) + '|domainEqualList|) + |List|) + (|CDRwithIncrement| #1#)) + ('T + (UNWIND-PROTECT + (PROG1 (|List;| #0#) (LETT #1# T |List|)) + (COND ((NOT #1#) (HREM |$ConstructorCache| '|List|))))))))))) + +(DEFUN |List;| (|#1|) + (PROG (|dv$1| |dv$| $ #0=#:G1451 #1=#:G1449 |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #2=(|List|)) + (LETT |dv$| (LIST '|List| |dv$1|) . #2#) + (LETT $ (GETREFV 63) . #2#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#1| + '(|ConvertibleTo| (|InputForm|))) + (|HasCategory| |#1| '(|OrderedSet|)) + (|HasCategory| |#1| '(|OpenMath|)) + (|HasCategory| (|Integer|) '(|OrderedSet|)) + (LETT #0# + (|HasCategory| |#1| '(|SetCategory|)) . #2#) + (OR (|HasCategory| |#1| '(|OrderedSet|)) + #0#) + (AND #0# + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + (OR (AND (|HasCategory| |#1| + '(|OrderedSet|)) + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + (AND #0# + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|))))) + (LETT #1# + (|HasCategory| |#1| + '(|CoercibleTo| (|OutputForm|))) . #2#) + (OR (AND #0# + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + #1#))) . #2#)) + (|haddProp| |$ConstructorCache| '|List| (LIST |dv$1|) + (CONS 1 $)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (COND + ((|testBitVector| |pv$| 3) + (PROGN + (QSETREFV $ 26 + (CONS (|dispatchFunction| |LIST;OMwrite;$S;6|) $)) + (QSETREFV $ 27 + (CONS (|dispatchFunction| |LIST;OMwrite;$BS;7|) $)) + (QSETREFV $ 28 + (CONS (|dispatchFunction| |LIST;OMwrite;Omd$V;8|) $)) + (QSETREFV $ 29 + (CONS (|dispatchFunction| |LIST;OMwrite;Omd$BV;9|) $))))) + (COND + ((|testBitVector| |pv$| 5) + (PROGN + (QSETREFV $ 32 + (CONS (|dispatchFunction| |LIST;setUnion;3$;10|) $)) + (QSETREFV $ 34 + (CONS (|dispatchFunction| + |LIST;setIntersection;3$;11|) + $)) + (QSETREFV $ 37 + (CONS (|dispatchFunction| |LIST;setDifference;3$;12|) + $))))) + (COND + ((|testBitVector| |pv$| 1) + (QSETREFV $ 45 + (CONS (|dispatchFunction| |LIST;convert;$If;13|) $)))) + $)))) + +(MAKEPROP '|List| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL (|IndexedList| 6 (NRTEVAL 1)) + (|local| |#1|) |LIST;nil;$;1| (|Boolean|) |LIST;null;$B;2| + |LIST;cons;S2$;3| |LIST;append;3$;4| (|Void|) + (|OpenMathDevice|) (0 . |OMputApp|) (|String|) + (5 . |OMputSymbol|) (12 . |not|) (17 . |OMwrite|) + (24 . |OMputEndApp|) (|OpenMathEncoding|) + (29 . |OMencodingXML|) (33 . |OMopenString|) + (39 . |OMputObject|) (44 . |OMputEndObject|) + (49 . |OMclose|) (54 . |OMwrite|) (59 . |OMwrite|) + (65 . |OMwrite|) (71 . |OMwrite|) (78 . |concat|) + (84 . |removeDuplicates|) (89 . |setUnion|) + (95 . |member?|) (101 . |setIntersection|) (|Integer|) + (107 . |elt|) (113 . |setDifference|) (|Symbol|) + (119 . |coerce|) (|InputForm|) (124 . |convert|) + (129 . |convert|) (|List| $) (134 . |convert|) + (139 . |convert|) (|Mapping| 6 6 6) (|NonNegativeInteger|) + (|List| 6) (|List| 50) (|Equation| 6) (|Mapping| 8 6) + (|Mapping| 8 6 6) (|UniversalSegment| 35) '"last" '"rest" + '"first" '"value" (|Mapping| 6 6) (|OutputForm|) + (|SingleInteger|) (|List| 35) (|Union| 6 '"failed")) + '#(|setUnion| 144 |setIntersection| 150 |setDifference| 156 + |removeDuplicates| 162 |null| 167 |nil| 172 |member?| 176 + |elt| 182 |convert| 188 |cons| 193 |concat| 199 |append| + 205 |OMwrite| 211) + '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) + (CONS (|makeByteWordVec2| 10 + '(0 0 0 0 0 0 0 0 0 0 2 0 0 8 6 0 0 8 10 1 6 3)) + (CONS '#(|ListAggregate&| |StreamAggregate&| + |ExtensibleLinearAggregate&| + |FiniteLinearAggregate&| + |UnaryRecursiveAggregate&| |LinearAggregate&| + |RecursiveAggregate&| |IndexedAggregate&| + |Collection&| |HomogeneousAggregate&| + |OrderedSet&| |Aggregate&| |EltableAggregate&| + |Evalable&| |SetCategory&| NIL NIL + |InnerEvalable&| NIL NIL |BasicType&| NIL) + (CONS '#((|ListAggregate| 6) + (|StreamAggregate| 6) + (|ExtensibleLinearAggregate| 6) + (|FiniteLinearAggregate| 6) + (|UnaryRecursiveAggregate| 6) + (|LinearAggregate| 6) + (|RecursiveAggregate| 6) + (|IndexedAggregate| 35 6) + (|Collection| 6) + (|HomogeneousAggregate| 6) + (|OrderedSet|) (|Aggregate|) + (|EltableAggregate| 35 6) (|Evalable| 6) + (|SetCategory|) (|Type|) + (|Eltable| 35 6) (|InnerEvalable| 6 6) + (|CoercibleTo| 59) (|ConvertibleTo| 40) + (|BasicType|) (|OpenMath|)) + (|makeByteWordVec2| 45 + '(1 13 12 0 14 3 13 12 0 15 15 16 1 8 0 + 0 17 3 6 12 13 0 8 18 1 13 12 0 19 0 + 20 0 21 2 13 0 15 20 22 1 13 12 0 23 + 1 13 12 0 24 1 13 12 0 25 1 0 15 0 26 + 2 0 15 0 8 27 2 0 12 13 0 28 3 0 12 + 13 0 8 29 2 0 0 0 0 30 1 0 0 0 31 2 0 + 0 0 0 32 2 0 8 6 0 33 2 0 0 0 0 34 2 + 0 6 0 35 36 2 0 0 0 0 37 1 38 0 15 39 + 1 40 0 38 41 1 6 40 0 42 1 40 0 43 44 + 1 0 40 0 45 2 5 0 0 0 32 2 5 0 0 0 34 + 2 5 0 0 0 37 1 5 0 0 31 1 0 8 0 9 0 0 + 0 7 2 5 8 6 0 33 2 0 6 0 35 36 1 1 40 + 0 45 2 0 0 6 0 10 2 0 0 0 0 30 2 0 0 + 0 0 11 3 3 12 13 0 8 29 2 3 12 13 0 + 28 1 3 15 0 26 2 3 15 0 8 27))))) + '|lookupIncomplete|)) diff --git a/src/algebra/strap/LNAGG-.lsp b/src/algebra/strap/LNAGG-.lsp new file mode 100644 index 00000000..5ba1d59c --- /dev/null +++ b/src/algebra/strap/LNAGG-.lsp @@ -0,0 +1,80 @@ + +(/VERSIONCHECK 2) + +(DEFUN |LNAGG-;indices;AL;1| (|a| $) + (PROG (#0=#:G1404 |i| #1=#:G1405) + (RETURN + (SEQ (PROGN + (LETT #0# NIL |LNAGG-;indices;AL;1|) + (SEQ (LETT |i| (SPADCALL |a| (QREFELT $ 9)) + |LNAGG-;indices;AL;1|) + (LETT #1# (SPADCALL |a| (QREFELT $ 10)) + |LNAGG-;indices;AL;1|) + G190 (COND ((> |i| #1#) (GO G191))) + (SEQ (EXIT (LETT #0# (CONS |i| #0#) + |LNAGG-;indices;AL;1|))) + (LETT |i| (+ |i| 1) |LNAGG-;indices;AL;1|) (GO G190) + G191 (EXIT (NREVERSE0 #0#)))))))) + +(DEFUN |LNAGG-;index?;IAB;2| (|i| |a| $) + (COND + ((< |i| (SPADCALL |a| (QREFELT $ 9))) 'NIL) + ('T + (SPADCALL (< (SPADCALL |a| (QREFELT $ 10)) |i|) (QREFELT $ 14))))) + +(DEFUN |LNAGG-;concat;ASA;3| (|a| |x| $) + (SPADCALL |a| (SPADCALL 1 |x| (QREFELT $ 17)) (QREFELT $ 18))) + +(DEFUN |LNAGG-;concat;S2A;4| (|x| |y| $) + (SPADCALL (SPADCALL 1 |x| (QREFELT $ 17)) |y| (QREFELT $ 18))) + +(DEFUN |LNAGG-;insert;SAIA;5| (|x| |a| |i| $) + (SPADCALL (SPADCALL 1 |x| (QREFELT $ 17)) |a| |i| (QREFELT $ 21))) + +(DEFUN |LNAGG-;maxIndex;AI;6| (|l| $) + (+ (- (SPADCALL |l| (QREFELT $ 23)) 1) (SPADCALL |l| (QREFELT $ 9)))) + +(DEFUN |LinearAggregate&| (|#1| |#2|) + (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|LinearAggregate&|)) + (LETT |dv$2| (|devaluate| |#2|) . #0#) + (LETT |dv$| (LIST '|LinearAggregate&| |dv$1| |dv$2|) . #0#) + (LETT $ (GETREFV 26) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasAttribute| |#1| '|shallowlyMutable|))) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (QSETREFV $ 7 |#2|) + (COND + ((|HasAttribute| |#1| '|finiteAggregate|) + (QSETREFV $ 24 + (CONS (|dispatchFunction| |LNAGG-;maxIndex;AI;6|) $)))) + $)))) + +(MAKEPROP '|LinearAggregate&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|Integer|) (0 . |minIndex|) (5 . |maxIndex|) (|List| 8) + |LNAGG-;indices;AL;1| (|Boolean|) (10 . |not|) + |LNAGG-;index?;IAB;2| (|NonNegativeInteger|) (15 . |new|) + (21 . |concat|) |LNAGG-;concat;ASA;3| + |LNAGG-;concat;S2A;4| (27 . |insert|) + |LNAGG-;insert;SAIA;5| (34 . |#|) (39 . |maxIndex|) + (|List| $)) + '#(|maxIndex| 44 |insert| 49 |indices| 56 |index?| 61 + |concat| 67) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 24 + '(1 6 8 0 9 1 6 8 0 10 1 13 0 0 14 2 6 + 0 16 7 17 2 6 0 0 0 18 3 6 0 0 0 8 21 + 1 6 16 0 23 1 0 8 0 24 1 0 8 0 24 3 0 + 0 7 0 8 22 1 0 11 0 12 2 0 13 8 0 15 + 2 0 0 0 7 19 2 0 0 7 0 20))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/LNAGG.lsp b/src/algebra/strap/LNAGG.lsp new file mode 100644 index 00000000..a97133de --- /dev/null +++ b/src/algebra/strap/LNAGG.lsp @@ -0,0 +1,81 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |LinearAggregate;CAT| 'NIL) + +(DEFPARAMETER |LinearAggregate;AL| 'NIL) + +(DEFUN |LinearAggregate| (#0=#:G1400) + (LET (#1=#:G1401) + (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#)))) + +(DEFUN |LinearAggregate;| (|t#1|) + (PROG (#0=#:G1399) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) + (|sublisV| + (PAIR '(#1=#:G1398) (LIST '(|Integer|))) + (COND + (|LinearAggregate;CAT|) + ('T + (LETT |LinearAggregate;CAT| + (|Join| + (|IndexedAggregate| '#1# '|t#1|) + (|Collection| '|t#1|) + (|mkCategory| '|domain| + '(((|new| + ($ (|NonNegativeInteger|) + |t#1|)) + T) + ((|concat| ($ $ |t#1|)) T) + ((|concat| ($ |t#1| $)) T) + ((|concat| ($ $ $)) T) + ((|concat| ($ (|List| $))) T) + ((|map| + ($ + (|Mapping| |t#1| |t#1| + |t#1|) + $ $)) + T) + ((|elt| + ($ $ + (|UniversalSegment| + (|Integer|)))) + T) + ((|delete| ($ $ (|Integer|))) + T) + ((|delete| + ($ $ + (|UniversalSegment| + (|Integer|)))) + T) + ((|insert| + ($ |t#1| $ (|Integer|))) + T) + ((|insert| ($ $ $ (|Integer|))) + T) + ((|setelt| + (|t#1| $ + (|UniversalSegment| + (|Integer|)) + |t#1|)) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|)))) + NIL + '((|UniversalSegment| + (|Integer|)) + (|Integer|) (|List| $) + (|NonNegativeInteger|)) + NIL)) + . #2=(|LinearAggregate|)))))) . #2#) + (SETELT #0# 0 (LIST '|LinearAggregate| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp new file mode 100644 index 00000000..5a27a55c --- /dev/null +++ b/src/algebra/strap/LSAGG-.lsp @@ -0,0 +1,794 @@ + +(/VERSIONCHECK 2) + +(DEFUN |LSAGG-;sort!;M2A;1| (|f| |l| $) + (|LSAGG-;mergeSort| |f| |l| (SPADCALL |l| (QREFELT $ 9)) $)) + +(DEFUN |LSAGG-;list;SA;2| (|x| $) + (SPADCALL |x| (SPADCALL (QREFELT $ 12)) (QREFELT $ 13))) + +(DEFUN |LSAGG-;reduce;MAS;3| (|f| |x| $) + (COND + ((SPADCALL |x| (QREFELT $ 16)) + (|error| "reducing over an empty list needs the 3 argument form")) + ('T + (SPADCALL |f| (SPADCALL |x| (QREFELT $ 17)) + (SPADCALL |x| (QREFELT $ 18)) (QREFELT $ 20))))) + +(DEFUN |LSAGG-;merge;M3A;4| (|f| |p| |q| $) + (SPADCALL |f| (SPADCALL |p| (QREFELT $ 22)) + (SPADCALL |q| (QREFELT $ 22)) (QREFELT $ 23))) + +(DEFUN |LSAGG-;select!;M2A;5| (|f| |x| $) + (PROG (|y| |z|) + (RETURN + (SEQ (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 16)) 'NIL) + ('T + (SPADCALL + (SPADCALL (SPADCALL |x| (QREFELT $ 18)) + |f|) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;select!;M2A;5|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 16)) |x|) + ('T + (SEQ (LETT |y| |x| |LSAGG-;select!;M2A;5|) + (LETT |z| (SPADCALL |y| (QREFELT $ 17)) + |LSAGG-;select!;M2A;5|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL |z| (QREFELT $ 16)) + (QREFELT $ 25))) + (GO G191))) + (SEQ (EXIT + (COND + ((SPADCALL + (SPADCALL |z| (QREFELT $ 18)) + |f|) + (SEQ + (LETT |y| |z| + |LSAGG-;select!;M2A;5|) + (EXIT + (LETT |z| + (SPADCALL |z| (QREFELT $ 17)) + |LSAGG-;select!;M2A;5|)))) + ('T + (SEQ + (LETT |z| + (SPADCALL |z| (QREFELT $ 17)) + |LSAGG-;select!;M2A;5|) + (EXIT + (SPADCALL |y| |z| + (QREFELT $ 26)))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |x|))))))))) + +(DEFUN |LSAGG-;merge!;M3A;6| (|f| |p| |q| $) + (PROG (|r| |t|) + (RETURN + (SEQ (COND + ((SPADCALL |p| (QREFELT $ 16)) |q|) + ((SPADCALL |q| (QREFELT $ 16)) |p|) + ((SPADCALL |p| |q| (QREFELT $ 29)) + (|error| "cannot merge a list into itself")) + ('T + (SEQ (COND + ((SPADCALL (SPADCALL |p| (QREFELT $ 18)) + (SPADCALL |q| (QREFELT $ 18)) |f|) + (SEQ (LETT |r| + (LETT |t| |p| |LSAGG-;merge!;M3A;6|) + |LSAGG-;merge!;M3A;6|) + (EXIT (LETT |p| + (SPADCALL |p| (QREFELT $ 17)) + |LSAGG-;merge!;M3A;6|)))) + ('T + (SEQ (LETT |r| + (LETT |t| |q| |LSAGG-;merge!;M3A;6|) + |LSAGG-;merge!;M3A;6|) + (EXIT (LETT |q| + (SPADCALL |q| (QREFELT $ 17)) + |LSAGG-;merge!;M3A;6|))))) + (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |p| (QREFELT $ 16)) 'NIL) + ('T + (SPADCALL + (SPADCALL |q| (QREFELT $ 16)) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (EXIT (COND + ((SPADCALL + (SPADCALL |p| (QREFELT $ 18)) + (SPADCALL |q| (QREFELT $ 18)) + |f|) + (SEQ + (SPADCALL |t| |p| + (QREFELT $ 26)) + (LETT |t| |p| + |LSAGG-;merge!;M3A;6|) + (EXIT + (LETT |p| + (SPADCALL |p| (QREFELT $ 17)) + |LSAGG-;merge!;M3A;6|)))) + ('T + (SEQ + (SPADCALL |t| |q| + (QREFELT $ 26)) + (LETT |t| |q| + |LSAGG-;merge!;M3A;6|) + (EXIT + (LETT |q| + (SPADCALL |q| (QREFELT $ 17)) + |LSAGG-;merge!;M3A;6|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (SPADCALL |t| + (COND + ((SPADCALL |p| (QREFELT $ 16)) |q|) + ('T |p|)) + (QREFELT $ 26)) + (EXIT |r|)))))))) + +(DEFUN |LSAGG-;insert!;SAIA;7| (|s| |x| |i| $) + (PROG (|m| #0=#:G1464 |y| |z|) + (RETURN + (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 32)) + |LSAGG-;insert!;SAIA;7|) + (EXIT (COND + ((< |i| |m|) (|error| "index out of range")) + ((EQL |i| |m|) (SPADCALL |s| |x| (QREFELT $ 13))) + ('T + (SEQ (LETT |y| + (SPADCALL |x| + (PROG1 + (LETT #0# (- (- |i| 1) |m|) + |LSAGG-;insert!;SAIA;7|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 33)) + |LSAGG-;insert!;SAIA;7|) + (LETT |z| (SPADCALL |y| (QREFELT $ 17)) + |LSAGG-;insert!;SAIA;7|) + (SPADCALL |y| + (SPADCALL |s| |z| (QREFELT $ 13)) + (QREFELT $ 26)) + (EXIT |x|))))))))) + +(DEFUN |LSAGG-;insert!;2AIA;8| (|w| |x| |i| $) + (PROG (|m| #0=#:G1468 |y| |z|) + (RETURN + (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 32)) + |LSAGG-;insert!;2AIA;8|) + (EXIT (COND + ((< |i| |m|) (|error| "index out of range")) + ((EQL |i| |m|) (SPADCALL |w| |x| (QREFELT $ 35))) + ('T + (SEQ (LETT |y| + (SPADCALL |x| + (PROG1 + (LETT #0# (- (- |i| 1) |m|) + |LSAGG-;insert!;2AIA;8|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 33)) + |LSAGG-;insert!;2AIA;8|) + (LETT |z| (SPADCALL |y| (QREFELT $ 17)) + |LSAGG-;insert!;2AIA;8|) + (SPADCALL |y| |w| (QREFELT $ 26)) + (SPADCALL |y| |z| (QREFELT $ 35)) (EXIT |x|))))))))) + +(DEFUN |LSAGG-;remove!;M2A;9| (|f| |x| $) + (PROG (|p| |q|) + (RETURN + (SEQ (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 16)) 'NIL) + ('T + (SPADCALL (SPADCALL |x| (QREFELT $ 18)) + |f|)))) + (GO G191))) + (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;remove!;M2A;9|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 16)) |x|) + ('T + (SEQ (LETT |p| |x| |LSAGG-;remove!;M2A;9|) + (LETT |q| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;remove!;M2A;9|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL |q| (QREFELT $ 16)) + (QREFELT $ 25))) + (GO G191))) + (SEQ (EXIT + (COND + ((SPADCALL + (SPADCALL |q| (QREFELT $ 18)) + |f|) + (LETT |q| + (SPADCALL |p| + (SPADCALL |q| (QREFELT $ 17)) + (QREFELT $ 26)) + |LSAGG-;remove!;M2A;9|)) + ('T + (SEQ + (LETT |p| |q| + |LSAGG-;remove!;M2A;9|) + (EXIT + (LETT |q| + (SPADCALL |q| (QREFELT $ 17)) + |LSAGG-;remove!;M2A;9|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |x|))))))))) + +(DEFUN |LSAGG-;delete!;AIA;10| (|x| |i| $) + (PROG (|m| #0=#:G1480 |y|) + (RETURN + (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 32)) + |LSAGG-;delete!;AIA;10|) + (EXIT (COND + ((< |i| |m|) (|error| "index out of range")) + ((EQL |i| |m|) (SPADCALL |x| (QREFELT $ 17))) + ('T + (SEQ (LETT |y| + (SPADCALL |x| + (PROG1 + (LETT #0# (- (- |i| 1) |m|) + |LSAGG-;delete!;AIA;10|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 33)) + |LSAGG-;delete!;AIA;10|) + (SPADCALL |y| (SPADCALL |y| 2 (QREFELT $ 33)) + (QREFELT $ 26)) + (EXIT |x|))))))))) + +(DEFUN |LSAGG-;delete!;AUsA;11| (|x| |i| $) + (PROG (|l| |m| |h| #0=#:G1485 #1=#:G1486 |t| #2=#:G1487) + (RETURN + (SEQ (LETT |l| (SPADCALL |i| (QREFELT $ 40)) + |LSAGG-;delete!;AUsA;11|) + (LETT |m| (SPADCALL |x| (QREFELT $ 32)) + |LSAGG-;delete!;AUsA;11|) + (EXIT (COND + ((< |l| |m|) (|error| "index out of range")) + ('T + (SEQ (LETT |h| + (COND + ((SPADCALL |i| (QREFELT $ 41)) + (SPADCALL |i| (QREFELT $ 42))) + ('T (SPADCALL |x| (QREFELT $ 43)))) + |LSAGG-;delete!;AUsA;11|) + (EXIT (COND + ((< |h| |l|) |x|) + ((EQL |l| |m|) + (SPADCALL |x| + (PROG1 + (LETT #0# (- (+ |h| 1) |m|) + |LSAGG-;delete!;AUsA;11|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 33))) + ('T + (SEQ (LETT |t| + (SPADCALL |x| + (PROG1 + (LETT #1# (- (- |l| 1) |m|) + |LSAGG-;delete!;AUsA;11|) + (|check-subtype| (>= #1# 0) + '(|NonNegativeInteger|) + #1#)) + (QREFELT $ 33)) + |LSAGG-;delete!;AUsA;11|) + (SPADCALL |t| + (SPADCALL |t| + (PROG1 + (LETT #2# (+ (- |h| |l|) 2) + |LSAGG-;delete!;AUsA;11|) + (|check-subtype| (>= #2# 0) + '(|NonNegativeInteger|) + #2#)) + (QREFELT $ 33)) + (QREFELT $ 26)) + (EXIT |x|))))))))))))) + +(DEFUN |LSAGG-;find;MAU;12| (|f| |x| $) + (SEQ (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 16)) 'NIL) + ('T + (SPADCALL + (SPADCALL (SPADCALL |x| (QREFELT $ 18)) + |f|) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;find;MAU;12|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 16)) (CONS 1 "failed")) + ('T (CONS 0 (SPADCALL |x| (QREFELT $ 18)))))))) + +(DEFUN |LSAGG-;position;MAI;13| (|f| |x| $) + (PROG (|k|) + (RETURN + (SEQ (SEQ (LETT |k| (SPADCALL |x| (QREFELT $ 32)) + |LSAGG-;position;MAI;13|) + G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 16)) 'NIL) + ('T + (SPADCALL + (SPADCALL (SPADCALL |x| (QREFELT $ 18)) + |f|) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;position;MAI;13|))) + (LETT |k| (+ |k| 1) |LSAGG-;position;MAI;13|) (GO G190) + G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 16)) + (- (SPADCALL |x| (QREFELT $ 32)) 1)) + ('T |k|))))))) + +(DEFUN |LSAGG-;mergeSort| (|f| |p| |n| $) + (PROG (#0=#:G1507 |l| |q|) + (RETURN + (SEQ (COND + ((EQL |n| 2) + (COND + ((SPADCALL + (SPADCALL (SPADCALL |p| (QREFELT $ 17)) + (QREFELT $ 18)) + (SPADCALL |p| (QREFELT $ 18)) |f|) + (LETT |p| (SPADCALL |p| (QREFELT $ 48)) + |LSAGG-;mergeSort|))))) + (EXIT (COND + ((< |n| 3) |p|) + ('T + (SEQ (LETT |l| + (PROG1 (LETT #0# (QUOTIENT2 |n| 2) + |LSAGG-;mergeSort|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + |LSAGG-;mergeSort|) + (LETT |q| (SPADCALL |p| |l| (QREFELT $ 49)) + |LSAGG-;mergeSort|) + (LETT |p| (|LSAGG-;mergeSort| |f| |p| |l| $) + |LSAGG-;mergeSort|) + (LETT |q| + (|LSAGG-;mergeSort| |f| |q| (- |n| |l|) + $) + |LSAGG-;mergeSort|) + (EXIT (SPADCALL |f| |p| |q| (QREFELT $ 23))))))))))) + +(DEFUN |LSAGG-;sorted?;MAB;15| (|f| |l| $) + (PROG (#0=#:G1516 |p|) + (RETURN + (SEQ (EXIT (COND + ((SPADCALL |l| (QREFELT $ 16)) 'T) + ('T + (SEQ (LETT |p| (SPADCALL |l| (QREFELT $ 17)) + |LSAGG-;sorted?;MAB;15|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL |p| (QREFELT $ 16)) + (QREFELT $ 25))) + (GO G191))) + (SEQ (EXIT + (COND + ((NULL + (SPADCALL + (SPADCALL |l| (QREFELT $ 18)) + (SPADCALL |p| (QREFELT $ 18)) + |f|)) + (PROGN + (LETT #0# 'NIL + |LSAGG-;sorted?;MAB;15|) + (GO #0#))) + ('T + (LETT |p| + (SPADCALL + (LETT |l| |p| + |LSAGG-;sorted?;MAB;15|) + (QREFELT $ 17)) + |LSAGG-;sorted?;MAB;15|))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT 'T))))) + #0# (EXIT #0#))))) + +(DEFUN |LSAGG-;reduce;MA2S;16| (|f| |x| |i| $) + (PROG (|r|) + (RETURN + (SEQ (LETT |r| |i| |LSAGG-;reduce;MA2S;16|) + (SEQ G190 + (COND + ((NULL (SPADCALL (SPADCALL |x| (QREFELT $ 16)) + (QREFELT $ 25))) + (GO G191))) + (SEQ (LETT |r| + (SPADCALL |r| (SPADCALL |x| (QREFELT $ 18)) + |f|) + |LSAGG-;reduce;MA2S;16|) + (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;reduce;MA2S;16|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |r|))))) + +(DEFUN |LSAGG-;reduce;MA3S;17| (|f| |x| |i| |a| $) + (PROG (|r|) + (RETURN + (SEQ (LETT |r| |i| |LSAGG-;reduce;MA3S;17|) + (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 16)) 'NIL) + ('T + (SPADCALL (SPADCALL |r| |a| (QREFELT $ 52)) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (LETT |r| + (SPADCALL |r| (SPADCALL |x| (QREFELT $ 18)) + |f|) + |LSAGG-;reduce;MA3S;17|) + (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;reduce;MA3S;17|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |r|))))) + +(DEFUN |LSAGG-;new;NniSA;18| (|n| |s| $) + (PROG (|k| |l|) + (RETURN + (SEQ (LETT |l| (SPADCALL (QREFELT $ 12)) |LSAGG-;new;NniSA;18|) + (SEQ (LETT |k| 1 |LSAGG-;new;NniSA;18|) G190 + (COND ((QSGREATERP |k| |n|) (GO G191))) + (SEQ (EXIT (LETT |l| (SPADCALL |s| |l| (QREFELT $ 13)) + |LSAGG-;new;NniSA;18|))) + (LETT |k| (QSADD1 |k|) |LSAGG-;new;NniSA;18|) (GO G190) + G191 (EXIT NIL)) + (EXIT |l|))))) + +(DEFUN |LSAGG-;map;M3A;19| (|f| |x| |y| $) + (PROG (|z|) + (RETURN + (SEQ (LETT |z| (SPADCALL (QREFELT $ 12)) |LSAGG-;map;M3A;19|) + (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 16)) 'NIL) + ('T + (SPADCALL (SPADCALL |y| (QREFELT $ 16)) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (LETT |z| + (SPADCALL + (SPADCALL (SPADCALL |x| (QREFELT $ 18)) + (SPADCALL |y| (QREFELT $ 18)) |f|) + |z| (QREFELT $ 13)) + |LSAGG-;map;M3A;19|) + (LETT |x| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;map;M3A;19|) + (EXIT (LETT |y| (SPADCALL |y| (QREFELT $ 17)) + |LSAGG-;map;M3A;19|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |z| (QREFELT $ 48))))))) + +(DEFUN |LSAGG-;reverse!;2A;20| (|x| $) + (PROG (|z| |y|) + (RETURN + (SEQ (COND + ((OR (SPADCALL |x| (QREFELT $ 16)) + (SPADCALL + (LETT |y| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;reverse!;2A;20|) + (QREFELT $ 16))) + |x|) + ('T + (SEQ (SPADCALL |x| (SPADCALL (QREFELT $ 12)) + (QREFELT $ 26)) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL |y| (QREFELT $ 16)) + (QREFELT $ 25))) + (GO G191))) + (SEQ (LETT |z| (SPADCALL |y| (QREFELT $ 17)) + |LSAGG-;reverse!;2A;20|) + (SPADCALL |y| |x| (QREFELT $ 26)) + (LETT |x| |y| |LSAGG-;reverse!;2A;20|) + (EXIT (LETT |y| |z| + |LSAGG-;reverse!;2A;20|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |x|)))))))) + +(DEFUN |LSAGG-;copy;2A;21| (|x| $) + (PROG (|k| |y|) + (RETURN + (SEQ (LETT |y| (SPADCALL (QREFELT $ 12)) |LSAGG-;copy;2A;21|) + (SEQ (LETT |k| 0 |LSAGG-;copy;2A;21|) G190 + (COND + ((NULL (SPADCALL (SPADCALL |x| (QREFELT $ 16)) + (QREFELT $ 25))) + (GO G191))) + (SEQ (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |x| (QREFELT $ 57)) + (EXIT (|error| "cyclic list")))))) + (LETT |y| + (SPADCALL (SPADCALL |x| (QREFELT $ 18)) |y| + (QREFELT $ 13)) + |LSAGG-;copy;2A;21|) + (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;copy;2A;21|))) + (LETT |k| (QSADD1 |k|) |LSAGG-;copy;2A;21|) (GO G190) + G191 (EXIT NIL)) + (EXIT (SPADCALL |y| (QREFELT $ 48))))))) + +(DEFUN |LSAGG-;copyInto!;2AIA;22| (|y| |x| |s| $) + (PROG (|m| #0=#:G1545 |z|) + (RETURN + (SEQ (LETT |m| (SPADCALL |y| (QREFELT $ 32)) + |LSAGG-;copyInto!;2AIA;22|) + (EXIT (COND + ((< |s| |m|) (|error| "index out of range")) + ('T + (SEQ (LETT |z| + (SPADCALL |y| + (PROG1 + (LETT #0# (- |s| |m|) + |LSAGG-;copyInto!;2AIA;22|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 33)) + |LSAGG-;copyInto!;2AIA;22|) + (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |z| (QREFELT $ 16)) + 'NIL) + ('T + (SPADCALL + (SPADCALL |x| + (QREFELT $ 16)) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (SPADCALL |z| + (SPADCALL |x| (QREFELT $ 18)) + (QREFELT $ 59)) + (LETT |x| + (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;copyInto!;2AIA;22|) + (EXIT + (LETT |z| + (SPADCALL |z| (QREFELT $ 17)) + |LSAGG-;copyInto!;2AIA;22|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |y|))))))))) + +(DEFUN |LSAGG-;position;SA2I;23| (|w| |x| |s| $) + (PROG (|m| #0=#:G1552 |k|) + (RETURN + (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 32)) + |LSAGG-;position;SA2I;23|) + (EXIT (COND + ((< |s| |m|) (|error| "index out of range")) + ('T + (SEQ (LETT |x| + (SPADCALL |x| + (PROG1 + (LETT #0# (- |s| |m|) + |LSAGG-;position;SA2I;23|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 33)) + |LSAGG-;position;SA2I;23|) + (SEQ (LETT |k| |s| |LSAGG-;position;SA2I;23|) + G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 16)) + 'NIL) + ('T + (SPADCALL + (SPADCALL |w| + (SPADCALL |x| + (QREFELT $ 18)) + (QREFELT $ 52)) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (EXIT + (LETT |x| + (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;position;SA2I;23|))) + (LETT |k| (+ |k| 1) + |LSAGG-;position;SA2I;23|) + (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 16)) + (- (SPADCALL |x| (QREFELT $ 32)) 1)) + ('T |k|))))))))))) + +(DEFUN |LSAGG-;removeDuplicates!;2A;24| (|l| $) + (PROG (|p|) + (RETURN + (SEQ (LETT |p| |l| |LSAGG-;removeDuplicates!;2A;24|) + (SEQ G190 + (COND + ((NULL (SPADCALL (SPADCALL |p| (QREFELT $ 16)) + (QREFELT $ 25))) + (GO G191))) + (SEQ (EXIT (LETT |p| + (SPADCALL |p| + (SPADCALL + (CONS + #'|LSAGG-;removeDuplicates!;2A;24!0| + (VECTOR $ |p|)) + (SPADCALL |p| (QREFELT $ 17)) + (QREFELT $ 62)) + (QREFELT $ 26)) + |LSAGG-;removeDuplicates!;2A;24|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |l|))))) + +(DEFUN |LSAGG-;removeDuplicates!;2A;24!0| (|#1| $$) + (PROG ($) + (LETT $ (QREFELT $$ 0) |LSAGG-;removeDuplicates!;2A;24|) + (RETURN + (PROGN + (SPADCALL |#1| (SPADCALL (QREFELT $$ 1) (QREFELT $ 18)) + (QREFELT $ 52)))))) + +(DEFUN |LSAGG-;<;2AB;25| (|x| |y| $) + (PROG (#0=#:G1566) + (RETURN + (SEQ (EXIT (SEQ (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 16)) + 'NIL) + ('T + (SPADCALL + (SPADCALL |y| (QREFELT $ 16)) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (EXIT (COND + ((NULL + (SPADCALL + (SPADCALL |x| + (QREFELT $ 18)) + (SPADCALL |y| + (QREFELT $ 18)) + (QREFELT $ 52))) + (PROGN + (LETT #0# + (SPADCALL + (SPADCALL |x| + (QREFELT $ 18)) + (SPADCALL |y| + (QREFELT $ 18)) + (QREFELT $ 64)) + |LSAGG-;<;2AB;25|) + (GO #0#))) + ('T + (SEQ + (LETT |x| + (SPADCALL |x| + (QREFELT $ 17)) + |LSAGG-;<;2AB;25|) + (EXIT + (LETT |y| + (SPADCALL |y| + (QREFELT $ 17)) + |LSAGG-;<;2AB;25|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 16)) + (SPADCALL (SPADCALL |y| (QREFELT $ 16)) + (QREFELT $ 25))) + ('T 'NIL))))) + #0# (EXIT #0#))))) + +(DEFUN |ListAggregate&| (|#1| |#2|) + (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|ListAggregate&|)) + (LETT |dv$2| (|devaluate| |#2|) . #0#) + (LETT |dv$| (LIST '|ListAggregate&| |dv$1| |dv$2|) . #0#) + (LETT $ (GETREFV 67) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (QSETREFV $ 7 |#2|) + (COND + ((|HasCategory| |#2| '(|SetCategory|)) + (QSETREFV $ 53 + (CONS (|dispatchFunction| |LSAGG-;reduce;MA3S;17|) $)))) + (COND + ((|HasCategory| |#2| '(|SetCategory|)) + (PROGN + (QSETREFV $ 61 + (CONS (|dispatchFunction| |LSAGG-;position;SA2I;23|) + $)) + (QSETREFV $ 63 + (CONS (|dispatchFunction| + |LSAGG-;removeDuplicates!;2A;24|) + $))))) + (COND + ((|HasCategory| |#2| '(|OrderedSet|)) + (QSETREFV $ 65 + (CONS (|dispatchFunction| |LSAGG-;<;2AB;25|) $)))) + $)))) + +(MAKEPROP '|ListAggregate&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|NonNegativeInteger|) (0 . |#|) (|Mapping| 15 7 7) + |LSAGG-;sort!;M2A;1| (5 . |empty|) (9 . |concat|) + |LSAGG-;list;SA;2| (|Boolean|) (15 . |empty?|) + (20 . |rest|) (25 . |first|) (|Mapping| 7 7 7) + (30 . |reduce|) |LSAGG-;reduce;MAS;3| (37 . |copy|) + (42 . |merge!|) |LSAGG-;merge;M3A;4| (49 . |not|) + (54 . |setrest!|) (|Mapping| 15 7) |LSAGG-;select!;M2A;5| + (60 . |eq?|) |LSAGG-;merge!;M3A;6| (|Integer|) + (66 . |minIndex|) (71 . |rest|) |LSAGG-;insert!;SAIA;7| + (77 . |concat!|) |LSAGG-;insert!;2AIA;8| + |LSAGG-;remove!;M2A;9| |LSAGG-;delete!;AIA;10| + (|UniversalSegment| 31) (83 . |lo|) (88 . |hasHi|) + (93 . |hi|) (98 . |maxIndex|) |LSAGG-;delete!;AUsA;11| + (|Union| 7 '"failed") |LSAGG-;find;MAU;12| + |LSAGG-;position;MAI;13| (103 . |reverse!|) + (108 . |split!|) |LSAGG-;sorted?;MAB;15| + |LSAGG-;reduce;MA2S;16| (114 . =) (120 . |reduce|) + |LSAGG-;new;NniSA;18| |LSAGG-;map;M3A;19| + |LSAGG-;reverse!;2A;20| (128 . |cyclic?|) + |LSAGG-;copy;2A;21| (133 . |setfirst!|) + |LSAGG-;copyInto!;2AIA;22| (139 . |position|) + (146 . |remove!|) (152 . |removeDuplicates!|) (157 . <) + (163 . <) (|Mapping| 7 7)) + '#(|sorted?| 169 |sort!| 175 |select!| 181 |reverse!| 187 + |removeDuplicates!| 192 |remove!| 197 |reduce| 203 + |position| 224 |new| 237 |merge!| 243 |merge| 250 |map| + 257 |list| 264 |insert!| 269 |find| 283 |delete!| 289 + |copyInto!| 301 |copy| 308 < 313) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 65 + '(1 6 8 0 9 0 6 0 12 2 6 0 7 0 13 1 6 + 15 0 16 1 6 0 0 17 1 6 7 0 18 3 6 7 + 19 0 7 20 1 6 0 0 22 3 6 0 10 0 0 23 + 1 15 0 0 25 2 6 0 0 0 26 2 6 15 0 0 + 29 1 6 31 0 32 2 6 0 0 8 33 2 6 0 0 0 + 35 1 39 31 0 40 1 39 15 0 41 1 39 31 + 0 42 1 6 31 0 43 1 6 0 0 48 2 6 0 0 + 31 49 2 7 15 0 0 52 4 0 7 19 0 7 7 53 + 1 6 15 0 57 2 6 7 0 7 59 3 0 31 7 0 + 31 61 2 6 0 27 0 62 1 0 0 0 63 2 7 15 + 0 0 64 2 0 15 0 0 65 2 0 15 10 0 50 2 + 0 0 10 0 11 2 0 0 27 0 28 1 0 0 0 56 + 1 0 0 0 63 2 0 0 27 0 37 3 0 7 19 0 7 + 51 4 0 7 19 0 7 7 53 2 0 7 19 0 21 2 + 0 31 27 0 47 3 0 31 7 0 31 61 2 0 0 8 + 7 54 3 0 0 10 0 0 30 3 0 0 10 0 0 24 + 3 0 0 19 0 0 55 1 0 0 7 14 3 0 0 7 0 + 31 34 3 0 0 0 0 31 36 2 0 45 27 0 46 + 2 0 0 0 39 44 2 0 0 0 31 38 3 0 0 0 0 + 31 60 1 0 0 0 58 2 0 15 0 0 65))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/LSAGG.lsp b/src/algebra/strap/LSAGG.lsp new file mode 100644 index 00000000..c0470689 --- /dev/null +++ b/src/algebra/strap/LSAGG.lsp @@ -0,0 +1,38 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |ListAggregate;CAT| 'NIL) + +(DEFPARAMETER |ListAggregate;AL| 'NIL) + +(DEFUN |ListAggregate| (#0=#:G1431) + (LET (#1=#:G1432) + (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#)))) + +(DEFUN |ListAggregate;| (|t#1|) + (PROG (#0=#:G1430) + (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#) + (SETELT #0# 0 (LIST '|ListAggregate| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/MONOID-.lsp b/src/algebra/strap/MONOID-.lsp new file mode 100644 index 00000000..c9bcbbe5 --- /dev/null +++ b/src/algebra/strap/MONOID-.lsp @@ -0,0 +1,50 @@ + +(/VERSIONCHECK 2) + +(DEFUN |MONOID-;^;SNniS;1| (|x| |n| $) + (SPADCALL |x| |n| (QREFELT $ 8))) + +(DEFUN |MONOID-;one?;SB;2| (|x| $) + (SPADCALL |x| (|spadConstant| $ 10) (QREFELT $ 12))) + +(DEFUN |MONOID-;sample;S;3| ($) (|spadConstant| $ 10)) + +(DEFUN |MONOID-;recip;SU;4| (|x| $) + (COND + ((SPADCALL |x| (|spadConstant| $ 10) (QREFELT $ 12)) (CONS 0 |x|)) + ('T (CONS 1 "failed")))) + +(DEFUN |MONOID-;**;SNniS;5| (|x| |n| $) + (COND + ((ZEROP |n|) (|spadConstant| $ 10)) + ('T (SPADCALL |x| |n| (QREFELT $ 19))))) + +(DEFUN |Monoid&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|Monoid&|)) + (LETT |dv$| (LIST '|Monoid&| |dv$1|) . #0#) + (LETT $ (GETREFV 21) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|Monoid&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) + (|NonNegativeInteger|) (0 . **) |MONOID-;^;SNniS;1| + (6 . |One|) (|Boolean|) (10 . =) |MONOID-;one?;SB;2| + |MONOID-;sample;S;3| (|Union| $ '"failed") + |MONOID-;recip;SU;4| (|PositiveInteger|) + (|RepeatedSquaring| 6) (16 . |expt|) |MONOID-;**;SNniS;5|) + '#(|sample| 22 |recip| 26 |one?| 31 ^ 36 ** 42) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 20 + '(2 6 0 0 7 8 0 6 0 10 2 6 11 0 0 12 2 + 18 6 6 17 19 0 0 0 14 1 0 15 0 16 1 0 + 11 0 13 2 0 0 0 7 9 2 0 0 0 7 20))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/MONOID.lsp b/src/algebra/strap/MONOID.lsp new file mode 100644 index 00000000..eecfccc9 --- /dev/null +++ b/src/algebra/strap/MONOID.lsp @@ -0,0 +1,28 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |Monoid;AL| 'NIL) + +(DEFUN |Monoid| () + (LET (#:G1388) + (COND (|Monoid;AL|) (T (SETQ |Monoid;AL| (|Monoid;|)))))) + +(DEFUN |Monoid;| () + (PROG (#0=#:G1386) + (RETURN + (PROG1 (LETT #0# + (|Join| (|SemiGroup|) + (|mkCategory| '|domain| + '(((|One| ($) |constant|) T) + ((|sample| ($) |constant|) T) + ((|one?| ((|Boolean|) $)) T) + ((** ($ $ (|NonNegativeInteger|))) T) + ((^ ($ $ (|NonNegativeInteger|))) T) + ((|recip| ((|Union| $ "failed") $)) T)) + NIL + '((|NonNegativeInteger|) (|Boolean|)) + NIL)) + |Monoid|) + (SETELT #0# 0 '(|Monoid|)))))) + +(MAKEPROP '|Monoid| 'NILADIC T) diff --git a/src/algebra/strap/MTSCAT.lsp b/src/algebra/strap/MTSCAT.lsp new file mode 100644 index 00000000..dbd30965 --- /dev/null +++ b/src/algebra/strap/MTSCAT.lsp @@ -0,0 +1,107 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |MultivariateTaylorSeriesCategory;CAT| 'NIL) + +(DEFPARAMETER |MultivariateTaylorSeriesCategory;AL| 'NIL) + +(DEFUN |MultivariateTaylorSeriesCategory| + (&REST #0=#:G1390 &AUX #1=#:G1388) + (DSETQ #1# #0#) + (LET (#2=#:G1389) + (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#)))) + +(DEFUN |MultivariateTaylorSeriesCategory;| (|t#1| |t#2|) + (PROG (#0=#:G1387) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1| |t#2|) + (LIST (|devaluate| |t#1|) + (|devaluate| |t#2|))) + (|sublisV| + (PAIR '(#1=#:G1386) + (LIST '(|IndexedExponents| |t#2|))) + (COND + (|MultivariateTaylorSeriesCategory;CAT|) + ('T + (LETT |MultivariateTaylorSeriesCategory;CAT| + (|Join| + (|PartialDifferentialRing| '|t#2|) + (|PowerSeriesCategory| '|t#1| '#1# + '|t#2|) + (|InnerEvalable| '|t#2| '$) + (|Evalable| '$) + (|mkCategory| '|domain| + '(((|coefficient| + ($ $ |t#2| + (|NonNegativeInteger|))) + T) + ((|coefficient| + ($ $ (|List| |t#2|) + (|List| + (|NonNegativeInteger|)))) + T) + ((|extend| + ($ $ (|NonNegativeInteger|))) + T) + ((|monomial| + ($ $ |t#2| + (|NonNegativeInteger|))) + T) + ((|monomial| + ($ $ (|List| |t#2|) + (|List| + (|NonNegativeInteger|)))) + T) + ((|order| + ((|NonNegativeInteger|) $ + |t#2|)) + T) + ((|order| + ((|NonNegativeInteger|) $ + |t#2| + (|NonNegativeInteger|))) + T) + ((|polynomial| + ((|Polynomial| |t#1|) $ + (|NonNegativeInteger|))) + T) + ((|polynomial| + ((|Polynomial| |t#1|) $ + (|NonNegativeInteger|) + (|NonNegativeInteger|))) + T) + ((|integrate| ($ $ |t#2|)) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|)))))) + '(((|RadicalCategory|) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|))))) + ((|TranscendentalFunctionCategory|) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|)))))) + '((|Polynomial| |t#1|) + (|NonNegativeInteger|) + (|List| |t#2|) + (|List| (|NonNegativeInteger|))) + NIL)) + . #2=(|MultivariateTaylorSeriesCategory|)))))) . #2#) + (SETELT #0# 0 + (LIST '|MultivariateTaylorSeriesCategory| + (|devaluate| |t#1|) (|devaluate| |t#2|))))))) diff --git a/src/algebra/strap/NNI.lsp b/src/algebra/strap/NNI.lsp new file mode 100644 index 00000000..7952eb34 --- /dev/null +++ b/src/algebra/strap/NNI.lsp @@ -0,0 +1,148 @@ + +(|/VERSIONCHECK| 2) + +(SETQ |$CategoryFrame| + (|put| + #1=(QUOTE |NonNegativeInteger|) + (QUOTE |SuperDomain|) + #2=(QUOTE (|Integer|)) + (|put| + #2# + #3=(QUOTE |SubDomain|) + (CONS + (QUOTE + (|NonNegativeInteger| + COND ((|<| |#1| 0) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) + (DELASC #1# (|get| #2# #3# |$CategoryFrame|))) + |$CategoryFrame|))) + +(PUT + (QUOTE |NNI;sup;3$;1|) + (QUOTE |SPADreplace|) + (QUOTE MAX)) + +(DEFUN |NNI;sup;3$;1| (|x| |y| |$|) (MAX |x| |y|)) + +(PUT + (QUOTE |NNI;shift;$I$;2|) + (QUOTE |SPADreplace|) + (QUOTE ASH)) + +(DEFUN |NNI;shift;$I$;2| (|x| |n| |$|) (ASH |x| |n|)) + +(DEFUN |NNI;subtractIfCan;2$U;3| (|x| |y| |$|) + (PROG (|c|) + (RETURN + (SEQ + (LETT |c| (|-| |x| |y|) |NNI;subtractIfCan;2$U;3|) + (EXIT + (COND + ((|<| |c| 0) (CONS 1 "failed")) + ((QUOTE T) (CONS 0 |c|)))))))) + +(DEFUN |NonNegativeInteger| NIL + (PROG NIL + (RETURN + (PROG (#1=#:G96708) + (RETURN + (COND + ((LETT #1# + (HGET |$ConstructorCache| (QUOTE |NonNegativeInteger|)) + |NonNegativeInteger|) + (|CDRwithIncrement| (CDAR #1#))) + ((QUOTE T) + (|UNWIND-PROTECT| + (PROG1 + (CDDAR + (HPUT + |$ConstructorCache| + (QUOTE |NonNegativeInteger|) + (LIST (CONS NIL (CONS 1 (|NonNegativeInteger;|)))))) + (LETT #1# T |NonNegativeInteger|)) + (COND + ((NOT #1#) + (HREM + |$ConstructorCache| + (QUOTE |NonNegativeInteger|)))))))))))) + +(DEFUN |NonNegativeInteger;| NIL + (PROG (|dv$| |$| |pv$|) + (RETURN + (PROGN + (LETT |dv$| (QUOTE (|NonNegativeInteger|)) . #1=(|NonNegativeInteger|)) + (LETT |$| (GETREFV 17) . #1#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) + (|haddProp| + |$ConstructorCache| + (QUOTE |NonNegativeInteger|) + NIL + (CONS 1 |$|)) + (|stuffDomainSlots| |$|) |$|)))) + +(MAKEPROP + (QUOTE |NonNegativeInteger|) + (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL + (|Integer|) + |NNI;sup;3$;1| + |NNI;shift;$I$;2| + (|Union| |$| (QUOTE "failed")) + |NNI;subtractIfCan;2$U;3| + (|Record| (|:| |quotient| |$|) (|:| |remainder| |$|)) + (|PositiveInteger|) + (|Boolean|) + (|NonNegativeInteger|) + (|SingleInteger|) + (|String|) + (|OutputForm|))) + (QUOTE + #(|~=| 0 |zero?| 6 |sup| 11 |subtractIfCan| 17 |shift| 23 |sample| 29 + |rem| 33 |recip| 39 |random| 44 |quo| 49 |one?| 55 |min| 60 |max| 66 + |latex| 72 |hash| 77 |gcd| 82 |exquo| 88 |divide| 94 |coerce| 100 + |^| 105 |Zero| 117 |One| 121 |>=| 125 |>| 131 |=| 137 |<=| 143 + |<| 149 |+| 155 |**| 161 |*| 173)) + (QUOTE (((|commutative| "*") . 0))) + (CONS + (|makeByteWordVec2| 1 (QUOTE (0 0 0 0 0 0 0 0 0 0 0 0 0))) + (CONS + (QUOTE + #(NIL NIL NIL NIL NIL + |Monoid&| + |AbelianMonoid&| + |OrderedSet&| + |SemiGroup&| + |AbelianSemiGroup&| + |SetCategory&| + |BasicType&| + NIL)) + (CONS + (QUOTE + #((|OrderedAbelianMonoidSup|) + (|OrderedCancellationAbelianMonoid|) + (|OrderedAbelianMonoid|) + (|OrderedAbelianSemiGroup|) + (|CancellationAbelianMonoid|) + (|Monoid|) + (|AbelianMonoid|) + (|OrderedSet|) + (|SemiGroup|) + (|AbelianSemiGroup|) + (|SetCategory|) + (|BasicType|) + (|CoercibleTo| 16))) + (|makeByteWordVec2| 16 + (QUOTE + (2 0 12 0 0 1 1 0 12 0 1 2 0 0 0 0 6 2 0 8 0 0 9 2 0 0 0 5 7 0 0 + 0 1 2 0 0 0 0 1 1 0 8 0 1 1 0 0 0 1 2 0 0 0 0 1 1 0 12 0 1 2 0 + 0 0 0 1 2 0 0 0 0 1 1 0 15 0 1 1 0 14 0 1 2 0 0 0 0 1 2 0 8 0 0 + 1 2 0 10 0 0 1 1 0 16 0 1 2 0 0 0 11 1 2 0 0 0 13 1 0 0 0 1 0 0 + 0 1 2 0 12 0 0 1 2 0 12 0 0 1 2 0 12 0 0 1 2 0 12 0 0 1 2 0 12 + 0 0 1 2 0 0 0 0 1 2 0 0 0 11 1 2 0 0 0 13 1 2 0 0 0 0 1 2 0 0 + 11 0 1 2 0 0 13 0 1)))))) + (QUOTE |lookupComplete|))) + +(MAKEPROP (QUOTE |NonNegativeInteger|) (QUOTE NILADIC) T) + diff --git a/src/algebra/strap/OINTDOM.lsp b/src/algebra/strap/OINTDOM.lsp new file mode 100644 index 00000000..8729184b --- /dev/null +++ b/src/algebra/strap/OINTDOM.lsp @@ -0,0 +1,19 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |OrderedIntegralDomain;AL| 'NIL) + +(DEFUN |OrderedIntegralDomain| () + (LET (#:G1387) + (COND + (|OrderedIntegralDomain;AL|) + (T (SETQ |OrderedIntegralDomain;AL| (|OrderedIntegralDomain;|)))))) + +(DEFUN |OrderedIntegralDomain;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# (|Join| (|IntegralDomain|) (|OrderedRing|)) + |OrderedIntegralDomain|) + (SETELT #0# 0 '(|OrderedIntegralDomain|)))))) + +(MAKEPROP '|OrderedIntegralDomain| 'NILADIC T) diff --git a/src/algebra/strap/ORDRING-.lsp b/src/algebra/strap/ORDRING-.lsp new file mode 100644 index 00000000..b556918a --- /dev/null +++ b/src/algebra/strap/ORDRING-.lsp @@ -0,0 +1,52 @@ + +(/VERSIONCHECK 2) + +(DEFUN |ORDRING-;positive?;SB;1| (|x| $) + (SPADCALL (|spadConstant| $ 7) |x| (QREFELT $ 9))) + +(DEFUN |ORDRING-;negative?;SB;2| (|x| $) + (SPADCALL |x| (|spadConstant| $ 7) (QREFELT $ 9))) + +(DEFUN |ORDRING-;sign;SI;3| (|x| $) + (COND + ((SPADCALL |x| (QREFELT $ 12)) 1) + ((SPADCALL |x| (QREFELT $ 13)) -1) + ((SPADCALL |x| (QREFELT $ 15)) 0) + ('T (|error| "x satisfies neither positive?, negative? or zero?")))) + +(DEFUN |ORDRING-;abs;2S;4| (|x| $) + (COND + ((SPADCALL |x| (QREFELT $ 12)) |x|) + ((SPADCALL |x| (QREFELT $ 13)) (SPADCALL |x| (QREFELT $ 18))) + ((SPADCALL |x| (QREFELT $ 15)) (|spadConstant| $ 7)) + ('T (|error| "x satisfies neither positive?, negative? or zero?")))) + +(DEFUN |OrderedRing&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|OrderedRing&|)) + (LETT |dv$| (LIST '|OrderedRing&| |dv$1|) . #0#) + (LETT $ (GETREFV 20) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|OrderedRing&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|) + (|Boolean|) (4 . <) |ORDRING-;positive?;SB;1| + |ORDRING-;negative?;SB;2| (10 . |positive?|) + (15 . |negative?|) (20 . |One|) (24 . |zero?|) (|Integer|) + |ORDRING-;sign;SI;3| (29 . -) |ORDRING-;abs;2S;4|) + '#(|sign| 34 |positive?| 39 |negative?| 44 |abs| 49) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 19 + '(0 6 0 7 2 6 8 0 0 9 1 6 8 0 12 1 6 8 + 0 13 0 6 0 14 1 6 8 0 15 1 6 0 0 18 1 + 0 16 0 17 1 0 8 0 10 1 0 8 0 11 1 0 0 + 0 19))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/ORDRING.lsp b/src/algebra/strap/ORDRING.lsp new file mode 100644 index 00000000..9d3e60c9 --- /dev/null +++ b/src/algebra/strap/ORDRING.lsp @@ -0,0 +1,26 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |OrderedRing;AL| 'NIL) + +(DEFUN |OrderedRing| () + (LET (#:G1393) + (COND + (|OrderedRing;AL|) + (T (SETQ |OrderedRing;AL| (|OrderedRing;|)))))) + +(DEFUN |OrderedRing;| () + (PROG (#0=#:G1391) + (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|) + (SETELT #0# 0 '(|OrderedRing|)))))) + +(MAKEPROP '|OrderedRing| 'NILADIC T) diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp new file mode 100644 index 00000000..91e85005 --- /dev/null +++ b/src/algebra/strap/OUTFORM.lsp @@ -0,0 +1,626 @@ + +(/VERSIONCHECK 2) + +(PUT '|OUTFORM;print;$V;1| '|SPADreplace| '|mathprint|) + +(DEFUN |OUTFORM;print;$V;1| (|x| $) (|mathprint| |x|)) + +(DEFUN |OUTFORM;message;S$;2| (|s| $) + (COND + ((SPADCALL |s| (QREFELT $ 11)) (SPADCALL (QREFELT $ 12))) + ('T |s|))) + +(DEFUN |OUTFORM;messagePrint;SV;3| (|s| $) + (SPADCALL (SPADCALL |s| (QREFELT $ 13)) (QREFELT $ 8))) + +(PUT '|OUTFORM;=;2$B;4| '|SPADreplace| 'EQUAL) + +(DEFUN |OUTFORM;=;2$B;4| (|a| |b| $) (EQUAL |a| |b|)) + +(DEFUN |OUTFORM;=;3$;5| (|a| |b| $) + (LIST (|OUTFORM;sform| "=" $) |a| |b|)) + +(PUT '|OUTFORM;coerce;$Of;6| '|SPADreplace| '(XLAM (|a|) |a|)) + +(DEFUN |OUTFORM;coerce;$Of;6| (|a| $) |a|) + +(PUT '|OUTFORM;outputForm;I$;7| '|SPADreplace| '(XLAM (|n|) |n|)) + +(DEFUN |OUTFORM;outputForm;I$;7| (|n| $) |n|) + +(PUT '|OUTFORM;outputForm;S$;8| '|SPADreplace| '(XLAM (|e|) |e|)) + +(DEFUN |OUTFORM;outputForm;S$;8| (|e| $) |e|) + +(PUT '|OUTFORM;outputForm;Df$;9| '|SPADreplace| '(XLAM (|f|) |f|)) + +(DEFUN |OUTFORM;outputForm;Df$;9| (|f| $) |f|) + +(PUT '|OUTFORM;sform| '|SPADreplace| '(XLAM (|s|) |s|)) + +(DEFUN |OUTFORM;sform| (|s| $) |s|) + +(PUT '|OUTFORM;eform| '|SPADreplace| '(XLAM (|e|) |e|)) + +(DEFUN |OUTFORM;eform| (|e| $) |e|) + +(PUT '|OUTFORM;iform| '|SPADreplace| '(XLAM (|n|) |n|)) + +(DEFUN |OUTFORM;iform| (|n| $) |n|) + +(DEFUN |OUTFORM;outputForm;S$;13| (|s| $) + (|OUTFORM;sform| + (SPADCALL (SPADCALL (QREFELT $ 26)) + (SPADCALL |s| (SPADCALL (QREFELT $ 26)) (QREFELT $ 27)) + (QREFELT $ 28)) + $)) + +(PUT '|OUTFORM;width;$I;14| '|SPADreplace| '|outformWidth|) + +(DEFUN |OUTFORM;width;$I;14| (|a| $) (|outformWidth| |a|)) + +(PUT '|OUTFORM;height;$I;15| '|SPADreplace| '|height|) + +(DEFUN |OUTFORM;height;$I;15| (|a| $) (|height| |a|)) + +(PUT '|OUTFORM;subHeight;$I;16| '|SPADreplace| '|subspan|) + +(DEFUN |OUTFORM;subHeight;$I;16| (|a| $) (|subspan| |a|)) + +(PUT '|OUTFORM;superHeight;$I;17| '|SPADreplace| '|superspan|) + +(DEFUN |OUTFORM;superHeight;$I;17| (|a| $) (|superspan| |a|)) + +(PUT '|OUTFORM;height;I;18| '|SPADreplace| '(XLAM NIL 20)) + +(DEFUN |OUTFORM;height;I;18| ($) 20) + +(PUT '|OUTFORM;width;I;19| '|SPADreplace| '(XLAM NIL 66)) + +(DEFUN |OUTFORM;width;I;19| ($) 66) + +(DEFUN |OUTFORM;center;$I$;20| (|a| |w| $) + (SPADCALL + (SPADCALL (QUOTIENT2 (- |w| (SPADCALL |a| (QREFELT $ 30))) 2) + (QREFELT $ 36)) + |a| (QREFELT $ 37))) + +(DEFUN |OUTFORM;left;$I$;21| (|a| |w| $) + (SPADCALL |a| + (SPADCALL (- |w| (SPADCALL |a| (QREFELT $ 30))) (QREFELT $ 36)) + (QREFELT $ 37))) + +(DEFUN |OUTFORM;right;$I$;22| (|a| |w| $) + (SPADCALL + (SPADCALL (- |w| (SPADCALL |a| (QREFELT $ 30))) (QREFELT $ 36)) + |a| (QREFELT $ 37))) + +(DEFUN |OUTFORM;center;2$;23| (|a| $) + (SPADCALL |a| (SPADCALL (QREFELT $ 35)) (QREFELT $ 38))) + +(DEFUN |OUTFORM;left;2$;24| (|a| $) + (SPADCALL |a| (SPADCALL (QREFELT $ 35)) (QREFELT $ 39))) + +(DEFUN |OUTFORM;right;2$;25| (|a| $) + (SPADCALL |a| (SPADCALL (QREFELT $ 35)) (QREFELT $ 40))) + +(DEFUN |OUTFORM;vspace;I$;26| (|n| $) + (COND + ((EQL |n| 0) (SPADCALL (QREFELT $ 12))) + ('T + (SPADCALL (|OUTFORM;sform| " " $) + (SPADCALL (- |n| 1) (QREFELT $ 44)) (QREFELT $ 45))))) + +(DEFUN |OUTFORM;hspace;I$;27| (|n| $) + (COND + ((EQL |n| 0) (SPADCALL (QREFELT $ 12))) + ('T (|OUTFORM;sform| (|fillerSpaces| |n|) $)))) + +(DEFUN |OUTFORM;rspace;2I$;28| (|n| |m| $) + (COND + ((OR (EQL |n| 0) (EQL |m| 0)) (SPADCALL (QREFELT $ 12))) + ('T + (SPADCALL (SPADCALL |n| (QREFELT $ 36)) + (SPADCALL |n| (- |m| 1) (QREFELT $ 46)) (QREFELT $ 45))))) + +(DEFUN |OUTFORM;matrix;L$;29| (|ll| $) + (PROG (#0=#:G1437 |l| #1=#:G1438 |lv|) + (RETURN + (SEQ (LETT |lv| + (PROGN + (LETT #0# NIL |OUTFORM;matrix;L$;29|) + (SEQ (LETT |l| NIL |OUTFORM;matrix;L$;29|) + (LETT #1# |ll| |OUTFORM;matrix;L$;29|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |l| (CAR #1#) + |OUTFORM;matrix;L$;29|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# (CONS (LIST2VEC |l|) #0#) + |OUTFORM;matrix;L$;29|))) + (LETT #1# (CDR #1#) |OUTFORM;matrix;L$;29|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + |OUTFORM;matrix;L$;29|) + (EXIT (CONS (|OUTFORM;eform| 'MATRIX $) (LIST2VEC |lv|))))))) + +(DEFUN |OUTFORM;pile;L$;30| (|l| $) + (CONS (|OUTFORM;eform| 'SC $) |l|)) + +(DEFUN |OUTFORM;commaSeparate;L$;31| (|l| $) + (CONS (|OUTFORM;eform| 'AGGLST $) |l|)) + +(DEFUN |OUTFORM;semicolonSeparate;L$;32| (|l| $) + (CONS (|OUTFORM;eform| 'AGGSET $) |l|)) + +(DEFUN |OUTFORM;blankSeparate;L$;33| (|l| $) + (PROG (|c| |u| #0=#:G1446 |l1|) + (RETURN + (SEQ (LETT |c| (|OUTFORM;eform| 'CONCATB $) + |OUTFORM;blankSeparate;L$;33|) + (LETT |l1| NIL |OUTFORM;blankSeparate;L$;33|) + (SEQ (LETT |u| NIL |OUTFORM;blankSeparate;L$;33|) + (LETT #0# (SPADCALL |l| (QREFELT $ 53)) + |OUTFORM;blankSeparate;L$;33|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |u| (CAR #0#) + |OUTFORM;blankSeparate;L$;33|) + NIL)) + (GO G191))) + (SEQ (EXIT (COND + ((EQCAR |u| |c|) + (LETT |l1| + (SPADCALL (CDR |u|) |l1| + (QREFELT $ 54)) + |OUTFORM;blankSeparate;L$;33|)) + ('T + (LETT |l1| (CONS |u| |l1|) + |OUTFORM;blankSeparate;L$;33|))))) + (LETT #0# (CDR #0#) |OUTFORM;blankSeparate;L$;33|) + (GO G190) G191 (EXIT NIL)) + (EXIT (CONS |c| |l1|)))))) + +(DEFUN |OUTFORM;brace;2$;34| (|a| $) + (LIST (|OUTFORM;eform| 'BRACE $) |a|)) + +(DEFUN |OUTFORM;brace;L$;35| (|l| $) + (SPADCALL (SPADCALL |l| (QREFELT $ 51)) (QREFELT $ 56))) + +(DEFUN |OUTFORM;bracket;2$;36| (|a| $) + (LIST (|OUTFORM;eform| 'BRACKET $) |a|)) + +(DEFUN |OUTFORM;bracket;L$;37| (|l| $) + (SPADCALL (SPADCALL |l| (QREFELT $ 51)) (QREFELT $ 58))) + +(DEFUN |OUTFORM;paren;2$;38| (|a| $) + (LIST (|OUTFORM;eform| 'PAREN $) |a|)) + +(DEFUN |OUTFORM;paren;L$;39| (|l| $) + (SPADCALL (SPADCALL |l| (QREFELT $ 51)) (QREFELT $ 60))) + +(DEFUN |OUTFORM;sub;3$;40| (|a| |b| $) + (LIST (|OUTFORM;eform| 'SUB $) |a| |b|)) + +(DEFUN |OUTFORM;super;3$;41| (|a| |b| $) + (LIST (|OUTFORM;eform| 'SUPERSUB $) |a| (|OUTFORM;sform| " " $) |b|)) + +(DEFUN |OUTFORM;presub;3$;42| (|a| |b| $) + (LIST (|OUTFORM;eform| 'SUPERSUB $) |a| (|OUTFORM;sform| " " $) + (|OUTFORM;sform| " " $) (|OUTFORM;sform| " " $) |b|)) + +(DEFUN |OUTFORM;presuper;3$;43| (|a| |b| $) + (LIST (|OUTFORM;eform| 'SUPERSUB $) |a| (|OUTFORM;sform| " " $) + (|OUTFORM;sform| " " $) |b|)) + +(DEFUN |OUTFORM;scripts;$L$;44| (|a| |l| $) + (COND + ((SPADCALL |l| (QREFELT $ 66)) |a|) + ((SPADCALL (SPADCALL |l| (QREFELT $ 67)) (QREFELT $ 66)) + (SPADCALL |a| (SPADCALL |l| (QREFELT $ 68)) (QREFELT $ 62))) + ('T (CONS (|OUTFORM;eform| 'SUPERSUB $) (CONS |a| |l|))))) + +(DEFUN |OUTFORM;supersub;$L$;45| (|a| |l| $) + (SEQ (COND + ((ODDP (SPADCALL |l| (QREFELT $ 71))) + (LETT |l| + (SPADCALL |l| (LIST (SPADCALL (QREFELT $ 12))) + (QREFELT $ 73)) + |OUTFORM;supersub;$L$;45|))) + (EXIT (CONS (|OUTFORM;eform| 'ALTSUPERSUB $) (CONS |a| |l|))))) + +(DEFUN |OUTFORM;hconcat;3$;46| (|a| |b| $) + (LIST (|OUTFORM;eform| 'CONCAT $) |a| |b|)) + +(DEFUN |OUTFORM;hconcat;L$;47| (|l| $) + (CONS (|OUTFORM;eform| 'CONCAT $) |l|)) + +(DEFUN |OUTFORM;vconcat;3$;48| (|a| |b| $) + (LIST (|OUTFORM;eform| 'VCONCAT $) |a| |b|)) + +(DEFUN |OUTFORM;vconcat;L$;49| (|l| $) + (CONS (|OUTFORM;eform| 'VCONCAT $) |l|)) + +(DEFUN |OUTFORM;~=;3$;50| (|a| |b| $) + (LIST (|OUTFORM;sform| "~=" $) |a| |b|)) + +(DEFUN |OUTFORM;<;3$;51| (|a| |b| $) + (LIST (|OUTFORM;sform| "<" $) |a| |b|)) + +(DEFUN |OUTFORM;>;3$;52| (|a| |b| $) + (LIST (|OUTFORM;sform| ">" $) |a| |b|)) + +(DEFUN |OUTFORM;<=;3$;53| (|a| |b| $) + (LIST (|OUTFORM;sform| "<=" $) |a| |b|)) + +(DEFUN |OUTFORM;>=;3$;54| (|a| |b| $) + (LIST (|OUTFORM;sform| ">=" $) |a| |b|)) + +(DEFUN |OUTFORM;+;3$;55| (|a| |b| $) + (LIST (|OUTFORM;sform| "+" $) |a| |b|)) + +(DEFUN |OUTFORM;-;3$;56| (|a| |b| $) + (LIST (|OUTFORM;sform| "-" $) |a| |b|)) + +(DEFUN |OUTFORM;-;2$;57| (|a| $) (LIST (|OUTFORM;sform| "-" $) |a|)) + +(DEFUN |OUTFORM;*;3$;58| (|a| |b| $) + (LIST (|OUTFORM;sform| "*" $) |a| |b|)) + +(DEFUN |OUTFORM;/;3$;59| (|a| |b| $) + (LIST (|OUTFORM;sform| "/" $) |a| |b|)) + +(DEFUN |OUTFORM;**;3$;60| (|a| |b| $) + (LIST (|OUTFORM;sform| "**" $) |a| |b|)) + +(DEFUN |OUTFORM;div;3$;61| (|a| |b| $) + (LIST (|OUTFORM;sform| "div" $) |a| |b|)) + +(DEFUN |OUTFORM;rem;3$;62| (|a| |b| $) + (LIST (|OUTFORM;sform| "rem" $) |a| |b|)) + +(DEFUN |OUTFORM;quo;3$;63| (|a| |b| $) + (LIST (|OUTFORM;sform| "quo" $) |a| |b|)) + +(DEFUN |OUTFORM;exquo;3$;64| (|a| |b| $) + (LIST (|OUTFORM;sform| "exquo" $) |a| |b|)) + +(DEFUN |OUTFORM;and;3$;65| (|a| |b| $) + (LIST (|OUTFORM;sform| "and" $) |a| |b|)) + +(DEFUN |OUTFORM;or;3$;66| (|a| |b| $) + (LIST (|OUTFORM;sform| "or" $) |a| |b|)) + +(DEFUN |OUTFORM;not;2$;67| (|a| $) + (LIST (|OUTFORM;sform| "not" $) |a|)) + +(DEFUN |OUTFORM;SEGMENT;3$;68| (|a| |b| $) + (LIST (|OUTFORM;eform| 'SEGMENT $) |a| |b|)) + +(DEFUN |OUTFORM;SEGMENT;2$;69| (|a| $) + (LIST (|OUTFORM;eform| 'SEGMENT $) |a|)) + +(DEFUN |OUTFORM;binomial;3$;70| (|a| |b| $) + (LIST (|OUTFORM;eform| 'BINOMIAL $) |a| |b|)) + +(DEFUN |OUTFORM;empty;$;71| ($) (LIST (|OUTFORM;eform| 'NOTHING $))) + +(DEFUN |OUTFORM;infix?;$B;72| (|a| $) + (PROG (#0=#:G1491 |e|) + (RETURN + (SEQ (EXIT (SEQ (LETT |e| + (COND + ((IDENTP |a|) |a|) + ((STRINGP |a|) (INTERN |a|)) + ('T + (PROGN + (LETT #0# 'NIL |OUTFORM;infix?;$B;72|) + (GO #0#)))) + |OUTFORM;infix?;$B;72|) + (EXIT (COND ((GET |e| 'INFIXOP) 'T) ('T 'NIL))))) + #0# (EXIT #0#))))) + +(PUT '|OUTFORM;elt;$L$;73| '|SPADreplace| 'CONS) + +(DEFUN |OUTFORM;elt;$L$;73| (|a| |l| $) (CONS |a| |l|)) + +(DEFUN |OUTFORM;prefix;$L$;74| (|a| |l| $) + (COND + ((NULL (SPADCALL |a| (QREFELT $ 98))) (CONS |a| |l|)) + ('T + (SPADCALL |a| + (SPADCALL (SPADCALL |l| (QREFELT $ 51)) (QREFELT $ 60)) + (QREFELT $ 37))))) + +(DEFUN |OUTFORM;infix;$L$;75| (|a| |l| $) + (COND + ((SPADCALL |l| (QREFELT $ 66)) (SPADCALL (QREFELT $ 12))) + ((SPADCALL (SPADCALL |l| (QREFELT $ 67)) (QREFELT $ 66)) + (SPADCALL |l| (QREFELT $ 68))) + ((SPADCALL |a| (QREFELT $ 98)) (CONS |a| |l|)) + ('T + (SPADCALL + (LIST (SPADCALL |l| (QREFELT $ 68)) |a| + (SPADCALL |a| (SPADCALL |l| (QREFELT $ 101)) + (QREFELT $ 102))) + (QREFELT $ 75))))) + +(DEFUN |OUTFORM;infix;4$;76| (|a| |b| |c| $) + (COND + ((SPADCALL |a| (QREFELT $ 98)) (LIST |a| |b| |c|)) + ('T (SPADCALL (LIST |b| |a| |c|) (QREFELT $ 75))))) + +(DEFUN |OUTFORM;postfix;3$;77| (|a| |b| $) + (SPADCALL |b| |a| (QREFELT $ 37))) + +(DEFUN |OUTFORM;string;2$;78| (|a| $) + (LIST (|OUTFORM;eform| 'STRING $) |a|)) + +(DEFUN |OUTFORM;quote;2$;79| (|a| $) + (LIST (|OUTFORM;eform| 'QUOTE $) |a|)) + +(DEFUN |OUTFORM;overbar;2$;80| (|a| $) + (LIST (|OUTFORM;eform| 'OVERBAR $) |a|)) + +(DEFUN |OUTFORM;dot;2$;81| (|a| $) + (SPADCALL |a| (|OUTFORM;sform| "." $) (QREFELT $ 63))) + +(DEFUN |OUTFORM;prime;2$;82| (|a| $) + (SPADCALL |a| (|OUTFORM;sform| "," $) (QREFELT $ 63))) + +(DEFUN |OUTFORM;dot;$Nni$;83| (|a| |nn| $) + (PROG (|s|) + (RETURN + (SEQ (LETT |s| + (MAKE-FULL-CVEC |nn| (SPADCALL "." (QREFELT $ 110))) + |OUTFORM;dot;$Nni$;83|) + (EXIT (SPADCALL |a| (|OUTFORM;sform| |s| $) (QREFELT $ 63))))))) + +(DEFUN |OUTFORM;prime;$Nni$;84| (|a| |nn| $) + (PROG (|s|) + (RETURN + (SEQ (LETT |s| + (MAKE-FULL-CVEC |nn| (SPADCALL "," (QREFELT $ 110))) + |OUTFORM;prime;$Nni$;84|) + (EXIT (SPADCALL |a| (|OUTFORM;sform| |s| $) (QREFELT $ 63))))))) + +(DEFUN |OUTFORM;overlabel;3$;85| (|a| |b| $) + (LIST (|OUTFORM;eform| 'OVERLABEL $) |a| |b|)) + +(DEFUN |OUTFORM;box;2$;86| (|a| $) + (LIST (|OUTFORM;eform| 'BOX $) |a|)) + +(DEFUN |OUTFORM;zag;3$;87| (|a| |b| $) + (LIST (|OUTFORM;eform| 'ZAG $) |a| |b|)) + +(DEFUN |OUTFORM;root;2$;88| (|a| $) + (LIST (|OUTFORM;eform| 'ROOT $) |a|)) + +(DEFUN |OUTFORM;root;3$;89| (|a| |b| $) + (LIST (|OUTFORM;eform| 'ROOT $) |a| |b|)) + +(DEFUN |OUTFORM;over;3$;90| (|a| |b| $) + (LIST (|OUTFORM;eform| 'OVER $) |a| |b|)) + +(DEFUN |OUTFORM;slash;3$;91| (|a| |b| $) + (LIST (|OUTFORM;eform| 'SLASH $) |a| |b|)) + +(DEFUN |OUTFORM;assign;3$;92| (|a| |b| $) + (LIST (|OUTFORM;eform| 'LET $) |a| |b|)) + +(DEFUN |OUTFORM;label;3$;93| (|a| |b| $) + (LIST (|OUTFORM;eform| 'EQUATNUM $) |a| |b|)) + +(DEFUN |OUTFORM;rarrow;3$;94| (|a| |b| $) + (LIST (|OUTFORM;eform| 'TAG $) |a| |b|)) + +(DEFUN |OUTFORM;differentiate;$Nni$;95| (|a| |nn| $) + (PROG (#0=#:G1521 |r| |s|) + (RETURN + (SEQ (COND + ((ZEROP |nn|) |a|) + ((< |nn| 4) (SPADCALL |a| |nn| (QREFELT $ 112))) + ('T + (SEQ (LETT |r| + (SPADCALL + (PROG1 (LETT #0# |nn| + |OUTFORM;differentiate;$Nni$;95|) + (|check-subtype| (> #0# 0) + '(|PositiveInteger|) #0#)) + (QREFELT $ 125)) + |OUTFORM;differentiate;$Nni$;95|) + (LETT |s| (SPADCALL |r| (QREFELT $ 126)) + |OUTFORM;differentiate;$Nni$;95|) + (EXIT (SPADCALL |a| + (SPADCALL (|OUTFORM;sform| |s| $) + (QREFELT $ 60)) + (QREFELT $ 63)))))))))) + +(DEFUN |OUTFORM;sum;2$;96| (|a| $) + (LIST (|OUTFORM;eform| 'SIGMA $) (SPADCALL (QREFELT $ 12)) |a|)) + +(DEFUN |OUTFORM;sum;3$;97| (|a| |b| $) + (LIST (|OUTFORM;eform| 'SIGMA $) |b| |a|)) + +(DEFUN |OUTFORM;sum;4$;98| (|a| |b| |c| $) + (LIST (|OUTFORM;eform| 'SIGMA2 $) |b| |c| |a|)) + +(DEFUN |OUTFORM;prod;2$;99| (|a| $) + (LIST (|OUTFORM;eform| 'PI $) (SPADCALL (QREFELT $ 12)) |a|)) + +(DEFUN |OUTFORM;prod;3$;100| (|a| |b| $) + (LIST (|OUTFORM;eform| 'PI $) |b| |a|)) + +(DEFUN |OUTFORM;prod;4$;101| (|a| |b| |c| $) + (LIST (|OUTFORM;eform| 'PI2 $) |b| |c| |a|)) + +(DEFUN |OUTFORM;int;2$;102| (|a| $) + (LIST (|OUTFORM;eform| 'INTSIGN $) (SPADCALL (QREFELT $ 12)) + (SPADCALL (QREFELT $ 12)) |a|)) + +(DEFUN |OUTFORM;int;3$;103| (|a| |b| $) + (LIST (|OUTFORM;eform| 'INTSIGN $) |b| (SPADCALL (QREFELT $ 12)) |a|)) + +(DEFUN |OUTFORM;int;4$;104| (|a| |b| |c| $) + (LIST (|OUTFORM;eform| 'INTSIGN $) |b| |c| |a|)) + +(DEFUN |OutputForm| () + (PROG () + (RETURN + (PROG (#0=#:G1535) + (RETURN + (COND + ((LETT #0# (HGET |$ConstructorCache| '|OutputForm|) + |OutputForm|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|OutputForm| + (LIST + (CONS NIL (CONS 1 (|OutputForm;|)))))) + (LETT #0# T |OutputForm|)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|OutputForm|))))))))))) + +(DEFUN |OutputForm;| () + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| '(|OutputForm|) . #0=(|OutputForm|)) + (LETT $ (|newShell| 138) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| '|OutputForm| NIL (CONS 1 $)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 (|List| $)) + $)))) + +(MAKEPROP '|OutputForm| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL '|Rep| (|Void|) + |OUTFORM;print;$V;1| (|Boolean|) (|String|) (0 . |empty?|) + |OUTFORM;empty;$;71| |OUTFORM;message;S$;2| + |OUTFORM;messagePrint;SV;3| |OUTFORM;=;2$B;4| + |OUTFORM;=;3$;5| (|OutputForm|) |OUTFORM;coerce;$Of;6| + (|Integer|) |OUTFORM;outputForm;I$;7| (|Symbol|) + |OUTFORM;outputForm;S$;8| (|DoubleFloat|) + |OUTFORM;outputForm;Df$;9| (|Character|) (5 . |quote|) + (9 . |concat|) (15 . |concat|) |OUTFORM;outputForm;S$;13| + |OUTFORM;width;$I;14| |OUTFORM;height;$I;15| + |OUTFORM;subHeight;$I;16| |OUTFORM;superHeight;$I;17| + |OUTFORM;height;I;18| |OUTFORM;width;I;19| + |OUTFORM;hspace;I$;27| |OUTFORM;hconcat;3$;46| + |OUTFORM;center;$I$;20| |OUTFORM;left;$I$;21| + |OUTFORM;right;$I$;22| |OUTFORM;center;2$;23| + |OUTFORM;left;2$;24| |OUTFORM;right;2$;25| + |OUTFORM;vspace;I$;26| |OUTFORM;vconcat;3$;48| + |OUTFORM;rspace;2I$;28| (|List| 49) |OUTFORM;matrix;L$;29| + (|List| $) |OUTFORM;pile;L$;30| + |OUTFORM;commaSeparate;L$;31| + |OUTFORM;semicolonSeparate;L$;32| (21 . |reverse|) + (26 . |append|) |OUTFORM;blankSeparate;L$;33| + |OUTFORM;brace;2$;34| |OUTFORM;brace;L$;35| + |OUTFORM;bracket;2$;36| |OUTFORM;bracket;L$;37| + |OUTFORM;paren;2$;38| |OUTFORM;paren;L$;39| + |OUTFORM;sub;3$;40| |OUTFORM;super;3$;41| + |OUTFORM;presub;3$;42| |OUTFORM;presuper;3$;43| + (32 . |null|) (37 . |rest|) (42 . |first|) + |OUTFORM;scripts;$L$;44| (|NonNegativeInteger|) (47 . |#|) + (|List| $$) (52 . |append|) |OUTFORM;supersub;$L$;45| + |OUTFORM;hconcat;L$;47| |OUTFORM;vconcat;L$;49| + |OUTFORM;~=;3$;50| |OUTFORM;<;3$;51| |OUTFORM;>;3$;52| + |OUTFORM;<=;3$;53| |OUTFORM;>=;3$;54| |OUTFORM;+;3$;55| + |OUTFORM;-;3$;56| |OUTFORM;-;2$;57| |OUTFORM;*;3$;58| + |OUTFORM;/;3$;59| |OUTFORM;**;3$;60| |OUTFORM;div;3$;61| + |OUTFORM;rem;3$;62| |OUTFORM;quo;3$;63| + |OUTFORM;exquo;3$;64| |OUTFORM;and;3$;65| + |OUTFORM;or;3$;66| |OUTFORM;not;2$;67| + |OUTFORM;SEGMENT;3$;68| |OUTFORM;SEGMENT;2$;69| + |OUTFORM;binomial;3$;70| |OUTFORM;infix?;$B;72| + |OUTFORM;elt;$L$;73| |OUTFORM;prefix;$L$;74| (58 . |rest|) + |OUTFORM;infix;$L$;75| |OUTFORM;infix;4$;76| + |OUTFORM;postfix;3$;77| |OUTFORM;string;2$;78| + |OUTFORM;quote;2$;79| |OUTFORM;overbar;2$;80| + |OUTFORM;dot;2$;81| |OUTFORM;prime;2$;82| (63 . |char|) + |OUTFORM;dot;$Nni$;83| |OUTFORM;prime;$Nni$;84| + |OUTFORM;overlabel;3$;85| |OUTFORM;box;2$;86| + |OUTFORM;zag;3$;87| |OUTFORM;root;2$;88| + |OUTFORM;root;3$;89| |OUTFORM;over;3$;90| + |OUTFORM;slash;3$;91| |OUTFORM;assign;3$;92| + |OUTFORM;label;3$;93| |OUTFORM;rarrow;3$;94| + (|PositiveInteger|) (|NumberFormats|) (68 . |FormatRoman|) + (73 . |lowerCase|) |OUTFORM;differentiate;$Nni$;95| + |OUTFORM;sum;2$;96| |OUTFORM;sum;3$;97| + |OUTFORM;sum;4$;98| |OUTFORM;prod;2$;99| + |OUTFORM;prod;3$;100| |OUTFORM;prod;4$;101| + |OUTFORM;int;2$;102| |OUTFORM;int;3$;103| + |OUTFORM;int;4$;104| (|SingleInteger|)) + '#(~= 78 |zag| 90 |width| 96 |vspace| 105 |vconcat| 110 + |supersub| 121 |superHeight| 127 |super| 132 |sum| 138 + |subHeight| 156 |sub| 161 |string| 167 |slash| 172 + |semicolonSeparate| 178 |scripts| 183 |rspace| 189 |root| + 195 |right| 206 |rem| 217 |rarrow| 223 |quote| 229 |quo| + 234 |prod| 240 |print| 258 |prime| 263 |presuper| 274 + |presub| 280 |prefix| 286 |postfix| 292 |pile| 298 |paren| + 303 |overlabel| 313 |overbar| 319 |over| 324 |outputForm| + 330 |or| 350 |not| 356 |messagePrint| 361 |message| 366 + |matrix| 371 |left| 376 |latex| 387 |label| 392 |int| 398 + |infix?| 416 |infix| 421 |hspace| 434 |height| 439 + |hconcat| 448 |hash| 459 |exquo| 464 |empty| 470 |elt| 474 + |dot| 480 |div| 491 |differentiate| 497 |commaSeparate| + 503 |coerce| 508 |center| 513 |bracket| 524 |brace| 534 + |box| 544 |blankSeparate| 549 |binomial| 554 |assign| 560 + |and| 566 SEGMENT 572 >= 583 > 589 = 595 <= 607 < 613 / + 619 - 625 + 636 ** 642 * 648) + 'NIL + (CONS (|makeByteWordVec2| 1 '(0 0 0)) + (CONS '#(|SetCategory&| |BasicType&| NIL) + (CONS '#((|SetCategory|) (|BasicType|) + (|CoercibleTo| 17)) + (|makeByteWordVec2| 137 + '(1 10 9 0 11 0 25 0 26 2 10 0 0 25 27 + 2 10 0 25 0 28 1 6 0 0 53 2 6 0 0 0 + 54 1 6 9 0 66 1 6 0 0 67 1 6 2 0 68 1 + 6 70 0 71 2 72 0 0 0 73 1 72 0 0 101 + 1 25 0 10 110 1 124 10 123 125 1 10 0 + 0 126 2 0 0 0 0 77 2 0 9 0 0 1 2 0 0 + 0 0 115 0 0 19 35 1 0 19 0 30 1 0 0 + 19 44 1 0 0 49 76 2 0 0 0 0 45 2 0 0 + 0 49 74 1 0 19 0 33 2 0 0 0 0 63 2 0 + 0 0 0 129 3 0 0 0 0 0 130 1 0 0 0 128 + 1 0 19 0 32 2 0 0 0 0 62 1 0 0 0 105 + 2 0 0 0 0 119 1 0 0 49 52 2 0 0 0 49 + 69 2 0 0 19 19 46 1 0 0 0 116 2 0 0 0 + 0 117 1 0 0 0 43 2 0 0 0 19 40 2 0 0 + 0 0 89 2 0 0 0 0 122 1 0 0 0 106 2 0 + 0 0 0 90 3 0 0 0 0 0 133 1 0 0 0 131 + 2 0 0 0 0 132 1 0 7 0 8 2 0 0 0 70 + 112 1 0 0 0 109 2 0 0 0 0 65 2 0 0 0 + 0 64 2 0 0 0 49 100 2 0 0 0 0 104 1 0 + 0 49 50 1 0 0 49 61 1 0 0 0 60 2 0 0 + 0 0 113 1 0 0 0 107 2 0 0 0 0 118 1 0 + 0 10 29 1 0 0 23 24 1 0 0 21 22 1 0 0 + 19 20 2 0 0 0 0 93 1 0 0 0 94 1 0 7 + 10 14 1 0 0 10 13 1 0 0 47 48 1 0 0 0 + 42 2 0 0 0 19 39 1 0 10 0 1 2 0 0 0 0 + 121 3 0 0 0 0 0 136 2 0 0 0 0 135 1 0 + 0 0 134 1 0 9 0 98 2 0 0 0 49 102 3 0 + 0 0 0 0 103 1 0 0 19 36 0 0 19 34 1 0 + 19 0 31 1 0 0 49 75 2 0 0 0 0 37 1 0 + 137 0 1 2 0 0 0 0 91 0 0 0 12 2 0 0 0 + 49 99 2 0 0 0 70 111 1 0 0 0 108 2 0 + 0 0 0 88 2 0 0 0 70 127 1 0 0 49 51 1 + 0 17 0 18 1 0 0 0 41 2 0 0 0 19 38 1 + 0 0 0 58 1 0 0 49 59 1 0 0 49 57 1 0 + 0 0 56 1 0 0 0 114 1 0 0 49 55 2 0 0 + 0 0 97 2 0 0 0 0 120 2 0 0 0 0 92 1 0 + 0 0 96 2 0 0 0 0 95 2 0 0 0 0 81 2 0 + 0 0 0 79 2 0 0 0 0 16 2 0 9 0 0 15 2 + 0 0 0 0 80 2 0 0 0 0 78 2 0 0 0 0 86 + 1 0 0 0 84 2 0 0 0 0 83 2 0 0 0 0 82 + 2 0 0 0 0 87 2 0 0 0 0 85))))) + '|lookupComplete|)) + +(MAKEPROP '|OutputForm| 'NILADIC T) diff --git a/src/algebra/strap/PI.lsp b/src/algebra/strap/PI.lsp new file mode 100644 index 00000000..bf877607 --- /dev/null +++ b/src/algebra/strap/PI.lsp @@ -0,0 +1,75 @@ + +(/VERSIONCHECK 2) + +(SETQ |$CategoryFrame| + (|put| #0='|PositiveInteger| '|SuperDomain| + #1='(|NonNegativeInteger|) + (|put| #1# '|SubDomain| + (CONS '(|PositiveInteger| < 0 |#1|) + (DELASC #0# + (|get| #1# '|SubDomain| + |$CategoryFrame|))) + |$CategoryFrame|))) + +(DEFUN |PositiveInteger| () + (PROG () + (RETURN + (PROG (#0=#:G1396) + (RETURN + (COND + ((LETT #0# (HGET |$ConstructorCache| '|PositiveInteger|) + |PositiveInteger|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| + '|PositiveInteger| + (LIST + (CONS NIL + (CONS 1 (|PositiveInteger;|)))))) + (LETT #0# T |PositiveInteger|)) + (COND + ((NOT #0#) + (HREM |$ConstructorCache| '|PositiveInteger|))))))))))) + +(DEFUN |PositiveInteger;| () + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| '(|PositiveInteger|) . #0=(|PositiveInteger|)) + (LETT $ (|newShell| 12) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| '|PositiveInteger| NIL + (CONS 1 $)) + (|stuffDomainSlots| $) + $)))) + +(MAKEPROP '|PositiveInteger| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL (|NonNegativeInteger|) + (|PositiveInteger|) (|Boolean|) (|Union| $ '"failed") + (|SingleInteger|) (|String|) (|OutputForm|)) + '#(~= 0 |sample| 6 |recip| 10 |one?| 15 |min| 20 |max| 26 + |latex| 32 |hash| 37 |gcd| 42 |coerce| 48 ^ 53 |One| 65 >= + 69 > 75 = 81 <= 87 < 93 + 99 ** 105 * 117) + '(((|commutative| "*") . 0)) + (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0 0 0)) + (CONS '#(NIL |Monoid&| |OrderedSet&| |SemiGroup&| + |AbelianSemiGroup&| |SetCategory&| + |BasicType&| NIL) + (CONS '#((|OrderedAbelianSemiGroup|) (|Monoid|) + (|OrderedSet|) (|SemiGroup|) + (|AbelianSemiGroup|) (|SetCategory|) + (|BasicType|) (|CoercibleTo| 11)) + (|makeByteWordVec2| 11 + '(2 0 7 0 0 1 0 0 0 1 1 0 8 0 1 1 0 7 0 + 1 2 0 0 0 0 1 2 0 0 0 0 1 1 0 10 0 1 + 1 0 9 0 1 2 0 0 0 0 1 1 0 11 0 1 2 0 + 0 0 6 1 2 0 0 0 5 1 0 0 0 1 2 0 7 0 0 + 1 2 0 7 0 0 1 2 0 7 0 0 1 2 0 7 0 0 1 + 2 0 7 0 0 1 2 0 0 0 0 1 2 0 0 0 6 1 2 + 0 0 0 5 1 2 0 0 0 0 1 2 0 0 6 0 1))))) + '|lookupComplete|)) + +(MAKEPROP '|PositiveInteger| 'NILADIC T) diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp new file mode 100644 index 00000000..557b4f8e --- /dev/null +++ b/src/algebra/strap/POLYCAT-.lsp @@ -0,0 +1,1757 @@ + +(/VERSIONCHECK 2) + +(DEFUN |POLYCAT-;eval;SLS;1| (|p| |l| $) + (PROG (#0=#:G1427 #1=#:G1421 #2=#:G1428 #3=#:G1429 |lvar| #4=#:G1430 + |e| #5=#:G1431) + (RETURN + (SEQ (COND + ((NULL |l|) |p|) + ('T + (SEQ (SEQ (EXIT (SEQ (LETT |e| NIL |POLYCAT-;eval;SLS;1|) + (LETT #0# |l| |POLYCAT-;eval;SLS;1|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |e| (CAR #0#) + |POLYCAT-;eval;SLS;1|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (COND + ((QEQCAR + (SPADCALL + (SPADCALL |e| + (|getShellEntry| $ 11)) + (|getShellEntry| $ 13)) + 1) + (PROGN + (LETT #1# + (|error| + "cannot find a variable to evaluate") + |POLYCAT-;eval;SLS;1|) + (GO #1#)))))) + (LETT #0# (CDR #0#) + |POLYCAT-;eval;SLS;1|) + (GO G190) G191 (EXIT NIL))) + #1# (EXIT #1#)) + (LETT |lvar| + (PROGN + (LETT #2# NIL |POLYCAT-;eval;SLS;1|) + (SEQ (LETT |e| NIL |POLYCAT-;eval;SLS;1|) + (LETT #3# |l| |POLYCAT-;eval;SLS;1|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |e| (CAR #3#) + |POLYCAT-;eval;SLS;1|) + NIL)) + (GO G191))) + (SEQ (EXIT + (LETT #2# + (CONS + (SPADCALL + (SPADCALL |e| + (|getShellEntry| $ 11)) + (|getShellEntry| $ 14)) + #2#) + |POLYCAT-;eval;SLS;1|))) + (LETT #3# (CDR #3#) + |POLYCAT-;eval;SLS;1|) + (GO G190) G191 (EXIT (NREVERSE0 #2#)))) + |POLYCAT-;eval;SLS;1|) + (EXIT (SPADCALL |p| |lvar| + (PROGN + (LETT #4# NIL |POLYCAT-;eval;SLS;1|) + (SEQ (LETT |e| NIL + |POLYCAT-;eval;SLS;1|) + (LETT #5# |l| + |POLYCAT-;eval;SLS;1|) + G190 + (COND + ((OR (ATOM #5#) + (PROGN + (LETT |e| (CAR #5#) + |POLYCAT-;eval;SLS;1|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #4# + (CONS + (SPADCALL |e| + (|getShellEntry| $ 15)) + #4#) + |POLYCAT-;eval;SLS;1|))) + (LETT #5# (CDR #5#) + |POLYCAT-;eval;SLS;1|) + (GO G190) G191 + (EXIT (NREVERSE0 #4#)))) + (|getShellEntry| $ 18)))))))))) + +(DEFUN |POLYCAT-;monomials;SL;2| (|p| $) + (PROG (|ml|) + (RETURN + (SEQ (LETT |ml| NIL |POLYCAT-;monomials;SL;2|) + (SEQ G190 + (COND + ((NULL (SPADCALL |p| (|spadConstant| $ 22) + (|getShellEntry| $ 25))) + (GO G191))) + (SEQ (LETT |ml| + (CONS (SPADCALL |p| (|getShellEntry| $ 26)) + |ml|) + |POLYCAT-;monomials;SL;2|) + (EXIT (LETT |p| + (SPADCALL |p| (|getShellEntry| $ 27)) + |POLYCAT-;monomials;SL;2|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (REVERSE |ml|)))))) + +(DEFUN |POLYCAT-;isPlus;SU;3| (|p| $) + (PROG (|l|) + (RETURN + (COND + ((NULL (CDR (LETT |l| (SPADCALL |p| (|getShellEntry| $ 29)) + |POLYCAT-;isPlus;SU;3|))) + (CONS 1 "failed")) + ('T (CONS 0 |l|)))))) + +(DEFUN |POLYCAT-;isTimes;SU;4| (|p| $) + (PROG (|lv| #0=#:G1453 |v| #1=#:G1454 |l| |r|) + (RETURN + (SEQ (COND + ((OR (NULL (LETT |lv| + (SPADCALL |p| (|getShellEntry| $ 32)) + |POLYCAT-;isTimes;SU;4|)) + (NULL (SPADCALL |p| (|getShellEntry| $ 33)))) + (CONS 1 "failed")) + ('T + (SEQ (LETT |l| + (PROGN + (LETT #0# NIL |POLYCAT-;isTimes;SU;4|) + (SEQ (LETT |v| NIL |POLYCAT-;isTimes;SU;4|) + (LETT #1# |lv| |POLYCAT-;isTimes;SU;4|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |v| (CAR #1#) + |POLYCAT-;isTimes;SU;4|) + NIL)) + (GO G191))) + (SEQ (EXIT + (LETT #0# + (CONS + (SPADCALL (|spadConstant| $ 34) + |v| + (SPADCALL |p| |v| + (|getShellEntry| $ 37)) + (|getShellEntry| $ 38)) + #0#) + |POLYCAT-;isTimes;SU;4|))) + (LETT #1# (CDR #1#) + |POLYCAT-;isTimes;SU;4|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + |POLYCAT-;isTimes;SU;4|) + (LETT |r| (SPADCALL |p| (|getShellEntry| $ 39)) + |POLYCAT-;isTimes;SU;4|) + (EXIT (COND + ((SPADCALL |r| (|spadConstant| $ 35) + (|getShellEntry| $ 40)) + (COND + ((NULL (CDR |lv|)) (CONS 1 "failed")) + ('T (CONS 0 |l|)))) + ('T + (CONS 0 + (CONS (SPADCALL |r| + (|getShellEntry| $ 41)) + |l|)))))))))))) + +(DEFUN |POLYCAT-;isExpt;SU;5| (|p| $) + (PROG (|u| |d|) + (RETURN + (SEQ (LETT |u| (SPADCALL |p| (|getShellEntry| $ 43)) + |POLYCAT-;isExpt;SU;5|) + (EXIT (COND + ((OR (QEQCAR |u| 1) + (NULL (SPADCALL |p| + (SPADCALL (|spadConstant| $ 34) + (QCDR |u|) + (LETT |d| + (SPADCALL |p| (QCDR |u|) + (|getShellEntry| $ 37)) + |POLYCAT-;isExpt;SU;5|) + (|getShellEntry| $ 38)) + (|getShellEntry| $ 44)))) + (CONS 1 "failed")) + ('T (CONS 0 (CONS (QCDR |u|) |d|))))))))) + +(DEFUN |POLYCAT-;coefficient;SVarSetNniS;6| (|p| |v| |n| $) + (SPADCALL (SPADCALL |p| |v| (|getShellEntry| $ 49)) |n| + (|getShellEntry| $ 51))) + +(DEFUN |POLYCAT-;coefficient;SLLS;7| (|p| |lv| |ln| $) + (COND + ((NULL |lv|) + (COND + ((NULL |ln|) |p|) + ('T (|error| "mismatched lists in coefficient")))) + ((NULL |ln|) (|error| "mismatched lists in coefficient")) + ('T + (SPADCALL + (SPADCALL + (SPADCALL |p| (|SPADfirst| |lv|) (|getShellEntry| $ 49)) + (|SPADfirst| |ln|) (|getShellEntry| $ 51)) + (CDR |lv|) (CDR |ln|) (|getShellEntry| $ 54))))) + +(DEFUN |POLYCAT-;monomial;SLLS;8| (|p| |lv| |ln| $) + (COND + ((NULL |lv|) + (COND + ((NULL |ln|) |p|) + ('T (|error| "mismatched lists in monomial")))) + ((NULL |ln|) (|error| "mismatched lists in monomial")) + ('T + (SPADCALL + (SPADCALL |p| (|SPADfirst| |lv|) (|SPADfirst| |ln|) + (|getShellEntry| $ 38)) + (CDR |lv|) (CDR |ln|) (|getShellEntry| $ 56))))) + +(DEFUN |POLYCAT-;retract;SVarSet;9| (|p| $) + (PROG (#0=#:G1479 |q|) + (RETURN + (SEQ (LETT |q| + (PROG2 (LETT #0# (SPADCALL |p| (|getShellEntry| $ 43)) + |POLYCAT-;retract;SVarSet;9|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 9) + #0#)) + |POLYCAT-;retract;SVarSet;9|) + (EXIT (COND + ((SPADCALL (SPADCALL |q| (|getShellEntry| $ 58)) |p| + (|getShellEntry| $ 44)) + |q|) + ('T (|error| "Polynomial is not a single variable")))))))) + +(DEFUN |POLYCAT-;retractIfCan;SU;10| (|p| $) + (PROG (|q| #0=#:G1487) + (RETURN + (SEQ (EXIT (SEQ (SEQ (LETT |q| + (SPADCALL |p| (|getShellEntry| $ 43)) + |POLYCAT-;retractIfCan;SU;10|) + (EXIT (COND + ((QEQCAR |q| 0) + (COND + ((SPADCALL + (SPADCALL (QCDR |q|) + (|getShellEntry| $ 58)) + |p| (|getShellEntry| $ 44)) + (PROGN + (LETT #0# |q| + |POLYCAT-;retractIfCan;SU;10|) + (GO #0#)))))))) + (EXIT (CONS 1 "failed")))) + #0# (EXIT #0#))))) + +(DEFUN |POLYCAT-;mkPrim| (|p| $) + (SPADCALL (|spadConstant| $ 35) (SPADCALL |p| (|getShellEntry| $ 61)) + (|getShellEntry| $ 62))) + +(DEFUN |POLYCAT-;primitiveMonomials;SL;12| (|p| $) + (PROG (#0=#:G1492 |q| #1=#:G1493) + (RETURN + (SEQ (PROGN + (LETT #0# NIL |POLYCAT-;primitiveMonomials;SL;12|) + (SEQ (LETT |q| NIL |POLYCAT-;primitiveMonomials;SL;12|) + (LETT #1# (SPADCALL |p| (|getShellEntry| $ 29)) + |POLYCAT-;primitiveMonomials;SL;12|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |q| (CAR #1#) + |POLYCAT-;primitiveMonomials;SL;12|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS (|POLYCAT-;mkPrim| |q| $) #0#) + |POLYCAT-;primitiveMonomials;SL;12|))) + (LETT #1# (CDR #1#) + |POLYCAT-;primitiveMonomials;SL;12|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))))))) + +(DEFUN |POLYCAT-;totalDegree;SNni;13| (|p| $) + (PROG (#0=#:G1495 |d| |u|) + (RETURN + (SEQ (COND + ((SPADCALL |p| (|getShellEntry| $ 64)) 0) + ('T + (SEQ (LETT |u| + (SPADCALL |p| + (PROG2 (LETT #0# + (SPADCALL |p| + (|getShellEntry| $ 43)) + |POLYCAT-;totalDegree;SNni;13|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 9) #0#)) + (|getShellEntry| $ 49)) + |POLYCAT-;totalDegree;SNni;13|) + (LETT |d| 0 |POLYCAT-;totalDegree;SNni;13|) + (SEQ G190 + (COND + ((NULL (SPADCALL |u| (|spadConstant| $ 65) + (|getShellEntry| $ 66))) + (GO G191))) + (SEQ (LETT |d| + (MAX |d| + (+ + (SPADCALL |u| + (|getShellEntry| $ 67)) + (SPADCALL + (SPADCALL |u| + (|getShellEntry| $ 68)) + (|getShellEntry| $ 69)))) + |POLYCAT-;totalDegree;SNni;13|) + (EXIT (LETT |u| + (SPADCALL |u| + (|getShellEntry| $ 70)) + |POLYCAT-;totalDegree;SNni;13|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |d|)))))))) + +(DEFUN |POLYCAT-;totalDegree;SLNni;14| (|p| |lv| $) + (PROG (#0=#:G1503 |v| |w| |d| |u|) + (RETURN + (SEQ (COND + ((SPADCALL |p| (|getShellEntry| $ 64)) 0) + ('T + (SEQ (LETT |u| + (SPADCALL |p| + (LETT |v| + (PROG2 + (LETT #0# + (SPADCALL |p| + (|getShellEntry| $ 43)) + |POLYCAT-;totalDegree;SLNni;14|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 9) #0#)) + |POLYCAT-;totalDegree;SLNni;14|) + (|getShellEntry| $ 49)) + |POLYCAT-;totalDegree;SLNni;14|) + (LETT |d| 0 |POLYCAT-;totalDegree;SLNni;14|) + (LETT |w| 0 |POLYCAT-;totalDegree;SLNni;14|) + (COND + ((SPADCALL |v| |lv| (|getShellEntry| $ 72)) + (LETT |w| 1 |POLYCAT-;totalDegree;SLNni;14|))) + (SEQ G190 + (COND + ((NULL (SPADCALL |u| (|spadConstant| $ 65) + (|getShellEntry| $ 66))) + (GO G191))) + (SEQ (LETT |d| + (MAX |d| + (+ + (* |w| + (SPADCALL |u| + (|getShellEntry| $ 67))) + (SPADCALL + (SPADCALL |u| + (|getShellEntry| $ 68)) + |lv| (|getShellEntry| $ 73)))) + |POLYCAT-;totalDegree;SLNni;14|) + (EXIT (LETT |u| + (SPADCALL |u| + (|getShellEntry| $ 70)) + |POLYCAT-;totalDegree;SLNni;14|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |d|)))))))) + +(DEFUN |POLYCAT-;resultant;2SVarSetS;15| (|p1| |p2| |mvar| $) + (SPADCALL (SPADCALL |p1| |mvar| (|getShellEntry| $ 49)) + (SPADCALL |p2| |mvar| (|getShellEntry| $ 49)) + (|getShellEntry| $ 75))) + +(DEFUN |POLYCAT-;discriminant;SVarSetS;16| (|p| |var| $) + (SPADCALL (SPADCALL |p| |var| (|getShellEntry| $ 49)) + (|getShellEntry| $ 77))) + +(DEFUN |POLYCAT-;allMonoms| (|l| $) + (PROG (#0=#:G1515 |p| #1=#:G1516) + (RETURN + (SEQ (SPADCALL + (SPADCALL + (PROGN + (LETT #0# NIL |POLYCAT-;allMonoms|) + (SEQ (LETT |p| NIL |POLYCAT-;allMonoms|) + (LETT #1# |l| |POLYCAT-;allMonoms|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |p| (CAR #1#) + |POLYCAT-;allMonoms|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |p| + (|getShellEntry| $ 79)) + #0#) + |POLYCAT-;allMonoms|))) + (LETT #1# (CDR #1#) |POLYCAT-;allMonoms|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 81)) + (|getShellEntry| $ 82)))))) + +(DEFUN |POLYCAT-;P2R| (|p| |b| |n| $) + (PROG (|w| |bj| #0=#:G1521 |i| #1=#:G1520) + (RETURN + (SEQ (LETT |w| + (SPADCALL |n| (|spadConstant| $ 23) + (|getShellEntry| $ 84)) + |POLYCAT-;P2R|) + (SEQ (LETT |bj| NIL |POLYCAT-;P2R|) + (LETT #0# |b| |POLYCAT-;P2R|) + (LETT |i| (SPADCALL |w| (|getShellEntry| $ 86)) + |POLYCAT-;P2R|) + (LETT #1# (QVSIZE |w|) |POLYCAT-;P2R|) G190 + (COND + ((OR (> |i| #1#) (ATOM #0#) + (PROGN + (LETT |bj| (CAR #0#) |POLYCAT-;P2R|) + NIL)) + (GO G191))) + (SEQ (EXIT (SPADCALL |w| |i| + (SPADCALL |p| |bj| + (|getShellEntry| $ 87)) + (|getShellEntry| $ 88)))) + (LETT |i| + (PROG1 (+ |i| 1) + (LETT #0# (CDR #0#) |POLYCAT-;P2R|)) + |POLYCAT-;P2R|) + (GO G190) G191 (EXIT NIL)) + (EXIT |w|))))) + +(DEFUN |POLYCAT-;eq2R| (|l| |b| $) + (PROG (#0=#:G1525 |bj| #1=#:G1526 #2=#:G1527 |p| #3=#:G1528) + (RETURN + (SEQ (SPADCALL + (PROGN + (LETT #0# NIL |POLYCAT-;eq2R|) + (SEQ (LETT |bj| NIL |POLYCAT-;eq2R|) + (LETT #1# |b| |POLYCAT-;eq2R|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |bj| (CAR #1#) |POLYCAT-;eq2R|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (PROGN + (LETT #2# NIL + |POLYCAT-;eq2R|) + (SEQ + (LETT |p| NIL + |POLYCAT-;eq2R|) + (LETT #3# |l| + |POLYCAT-;eq2R|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |p| (CAR #3#) + |POLYCAT-;eq2R|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #2# + (CONS + (SPADCALL |p| |bj| + (|getShellEntry| $ 87)) + #2#) + |POLYCAT-;eq2R|))) + (LETT #3# (CDR #3#) + |POLYCAT-;eq2R|) + (GO G190) G191 + (EXIT (NREVERSE0 #2#)))) + #0#) + |POLYCAT-;eq2R|))) + (LETT #1# (CDR #1#) |POLYCAT-;eq2R|) (GO G190) + G191 (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 92)))))) + +(DEFUN |POLYCAT-;reducedSystem;MM;20| (|m| $) + (PROG (#0=#:G1537 |r| #1=#:G1538 |b| #2=#:G1539 |bj| #3=#:G1540 |d| + |mm| |l|) + (RETURN + (SEQ (LETT |l| (SPADCALL |m| (|getShellEntry| $ 95)) + |POLYCAT-;reducedSystem;MM;20|) + (LETT |b| + (SPADCALL + (SPADCALL + (PROGN + (LETT #0# NIL + |POLYCAT-;reducedSystem;MM;20|) + (SEQ (LETT |r| NIL + |POLYCAT-;reducedSystem;MM;20|) + (LETT #1# |l| + |POLYCAT-;reducedSystem;MM;20|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |r| (CAR #1#) + |POLYCAT-;reducedSystem;MM;20|) + NIL)) + (GO G191))) + (SEQ (EXIT + (LETT #0# + (CONS + (|POLYCAT-;allMonoms| |r| $) + #0#) + |POLYCAT-;reducedSystem;MM;20|))) + (LETT #1# (CDR #1#) + |POLYCAT-;reducedSystem;MM;20|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 81)) + (|getShellEntry| $ 82)) + |POLYCAT-;reducedSystem;MM;20|) + (LETT |d| + (PROGN + (LETT #2# NIL |POLYCAT-;reducedSystem;MM;20|) + (SEQ (LETT |bj| NIL |POLYCAT-;reducedSystem;MM;20|) + (LETT #3# |b| |POLYCAT-;reducedSystem;MM;20|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |bj| (CAR #3#) + |POLYCAT-;reducedSystem;MM;20|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #2# + (CONS + (SPADCALL |bj| + (|getShellEntry| $ 61)) + #2#) + |POLYCAT-;reducedSystem;MM;20|))) + (LETT #3# (CDR #3#) + |POLYCAT-;reducedSystem;MM;20|) + (GO G190) G191 (EXIT (NREVERSE0 #2#)))) + |POLYCAT-;reducedSystem;MM;20|) + (LETT |mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $) + |POLYCAT-;reducedSystem;MM;20|) + (LETT |l| (CDR |l|) |POLYCAT-;reducedSystem;MM;20|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |l|) (|getShellEntry| $ 96))) + (GO G191))) + (SEQ (LETT |mm| + (SPADCALL |mm| + (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| + $) + (|getShellEntry| $ 97)) + |POLYCAT-;reducedSystem;MM;20|) + (EXIT (LETT |l| (CDR |l|) + |POLYCAT-;reducedSystem;MM;20|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |mm|))))) + +(DEFUN |POLYCAT-;reducedSystem;MVR;21| (|m| |v| $) + (PROG (#0=#:G1551 |s| #1=#:G1552 |b| #2=#:G1553 |bj| #3=#:G1554 |d| + |n| |mm| |w| |l| |r|) + (RETURN + (SEQ (LETT |l| (SPADCALL |m| (|getShellEntry| $ 95)) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |r| (SPADCALL |v| (|getShellEntry| $ 101)) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |b| + (SPADCALL + (SPADCALL (|POLYCAT-;allMonoms| |r| $) + (SPADCALL + (PROGN + (LETT #0# NIL + |POLYCAT-;reducedSystem;MVR;21|) + (SEQ (LETT |s| NIL + |POLYCAT-;reducedSystem;MVR;21|) + (LETT #1# |l| + |POLYCAT-;reducedSystem;MVR;21|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |s| (CAR #1#) + |POLYCAT-;reducedSystem;MVR;21|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #0# + (CONS + (|POLYCAT-;allMonoms| |s| $) + #0#) + |POLYCAT-;reducedSystem;MVR;21|))) + (LETT #1# (CDR #1#) + |POLYCAT-;reducedSystem;MVR;21|) + (GO G190) G191 + (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 81)) + (|getShellEntry| $ 102)) + (|getShellEntry| $ 82)) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |d| + (PROGN + (LETT #2# NIL |POLYCAT-;reducedSystem;MVR;21|) + (SEQ (LETT |bj| NIL |POLYCAT-;reducedSystem;MVR;21|) + (LETT #3# |b| |POLYCAT-;reducedSystem;MVR;21|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |bj| (CAR #3#) + |POLYCAT-;reducedSystem;MVR;21|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #2# + (CONS + (SPADCALL |bj| + (|getShellEntry| $ 61)) + #2#) + |POLYCAT-;reducedSystem;MVR;21|))) + (LETT #3# (CDR #3#) + |POLYCAT-;reducedSystem;MVR;21|) + (GO G190) G191 (EXIT (NREVERSE0 #2#)))) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |n| (LENGTH |d|) |POLYCAT-;reducedSystem;MVR;21|) + (LETT |mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |w| (|POLYCAT-;P2R| (|SPADfirst| |r|) |d| |n| $) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |l| (CDR |l|) |POLYCAT-;reducedSystem;MVR;21|) + (LETT |r| (CDR |r|) |POLYCAT-;reducedSystem;MVR;21|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |l|) (|getShellEntry| $ 96))) + (GO G191))) + (SEQ (LETT |mm| + (SPADCALL |mm| + (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| + $) + (|getShellEntry| $ 97)) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |w| + (SPADCALL |w| + (|POLYCAT-;P2R| (|SPADfirst| |r|) |d| + |n| $) + (|getShellEntry| $ 103)) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |l| (CDR |l|) + |POLYCAT-;reducedSystem;MVR;21|) + (EXIT (LETT |r| (CDR |r|) + |POLYCAT-;reducedSystem;MVR;21|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (CONS |mm| |w|)))))) + +(DEFUN |POLYCAT-;gcdPolynomial;3Sup;22| (|pp| |qq| $) + (SPADCALL |pp| |qq| (|getShellEntry| $ 108))) + +(DEFUN |POLYCAT-;solveLinearPolynomialEquation;LSupU;23| (|lpp| |pp| $) + (SPADCALL |lpp| |pp| (|getShellEntry| $ 113))) + +(DEFUN |POLYCAT-;factorPolynomial;SupF;24| (|pp| $) + (SPADCALL |pp| (|getShellEntry| $ 118))) + +(DEFUN |POLYCAT-;factorSquareFreePolynomial;SupF;25| (|pp| $) + (SPADCALL |pp| (|getShellEntry| $ 121))) + +(DEFUN |POLYCAT-;factor;SF;26| (|p| $) + (PROG (|v| |ansR| #0=#:G1596 |w| #1=#:G1597 |up| |ansSUP| #2=#:G1598 + |ww| #3=#:G1599) + (RETURN + (SEQ (LETT |v| (SPADCALL |p| (|getShellEntry| $ 43)) + |POLYCAT-;factor;SF;26|) + (EXIT (COND + ((QEQCAR |v| 1) + (SEQ (LETT |ansR| + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 39)) + (|getShellEntry| $ 124)) + |POLYCAT-;factor;SF;26|) + (EXIT (SPADCALL + (SPADCALL + (SPADCALL |ansR| + (|getShellEntry| $ 126)) + (|getShellEntry| $ 41)) + (PROGN + (LETT #0# NIL + |POLYCAT-;factor;SF;26|) + (SEQ + (LETT |w| NIL + |POLYCAT-;factor;SF;26|) + (LETT #1# + (SPADCALL |ansR| + (|getShellEntry| $ 130)) + |POLYCAT-;factor;SF;26|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |w| (CAR #1#) + |POLYCAT-;factor;SF;26|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #0# + (CONS + (VECTOR (QVELT |w| 0) + (SPADCALL (QVELT |w| 1) + (|getShellEntry| $ 41)) + (QVELT |w| 2)) + #0#) + |POLYCAT-;factor;SF;26|))) + (LETT #1# (CDR #1#) + |POLYCAT-;factor;SF;26|) + (GO G190) G191 + (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 134))))) + ('T + (SEQ (LETT |up| + (SPADCALL |p| (QCDR |v|) + (|getShellEntry| $ 49)) + |POLYCAT-;factor;SF;26|) + (LETT |ansSUP| + (SPADCALL |up| (|getShellEntry| $ 118)) + |POLYCAT-;factor;SF;26|) + (EXIT (SPADCALL + (SPADCALL + (SPADCALL |ansSUP| + (|getShellEntry| $ 135)) + (QCDR |v|) (|getShellEntry| $ 136)) + (PROGN + (LETT #2# NIL + |POLYCAT-;factor;SF;26|) + (SEQ + (LETT |ww| NIL + |POLYCAT-;factor;SF;26|) + (LETT #3# + (SPADCALL |ansSUP| + (|getShellEntry| $ 139)) + |POLYCAT-;factor;SF;26|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |ww| (CAR #3#) + |POLYCAT-;factor;SF;26|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #2# + (CONS + (VECTOR (QVELT |ww| 0) + (SPADCALL (QVELT |ww| 1) + (QCDR |v|) + (|getShellEntry| $ 136)) + (QVELT |ww| 2)) + #2#) + |POLYCAT-;factor;SF;26|))) + (LETT #3# (CDR #3#) + |POLYCAT-;factor;SF;26|) + (GO G190) G191 + (EXIT (NREVERSE0 #2#)))) + (|getShellEntry| $ 134))))))))))) + +(DEFUN |POLYCAT-;conditionP;MU;27| (|mat| $) + (PROG (|ll| #0=#:G1634 |z| #1=#:G1635 |ch| |l| #2=#:G1636 #3=#:G1637 + #4=#:G1606 #5=#:G1604 #6=#:G1605 #7=#:G1638 |vars| |degs| + #8=#:G1639 |d| #9=#:G1640 |nd| #10=#:G1633 #11=#:G1613 + |deg1| |redmons| #12=#:G1641 |v| #13=#:G1643 |u| + #14=#:G1642 |llR| |monslist| |ans| #15=#:G1644 + #16=#:G1645 |mons| #17=#:G1646 |m| #18=#:G1647 |i| + #19=#:G1629 #20=#:G1627 #21=#:G1628) + (RETURN + (SEQ (EXIT (SEQ (LETT |ll| + (SPADCALL + (SPADCALL |mat| + (|getShellEntry| $ 141)) + (|getShellEntry| $ 95)) + |POLYCAT-;conditionP;MU;27|) + (LETT |llR| + (PROGN + (LETT #0# NIL + |POLYCAT-;conditionP;MU;27|) + (SEQ (LETT |z| NIL + |POLYCAT-;conditionP;MU;27|) + (LETT #1# (|SPADfirst| |ll|) + |POLYCAT-;conditionP;MU;27|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |z| (CAR #1#) + |POLYCAT-;conditionP;MU;27|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #0# (CONS NIL #0#) + |POLYCAT-;conditionP;MU;27|))) + (LETT #1# (CDR #1#) + |POLYCAT-;conditionP;MU;27|) + (GO G190) G191 + (EXIT (NREVERSE0 #0#)))) + |POLYCAT-;conditionP;MU;27|) + (LETT |monslist| NIL |POLYCAT-;conditionP;MU;27|) + (LETT |ch| (SPADCALL (|getShellEntry| $ 142)) + |POLYCAT-;conditionP;MU;27|) + (SEQ (LETT |l| NIL |POLYCAT-;conditionP;MU;27|) + (LETT #2# |ll| |POLYCAT-;conditionP;MU;27|) + G190 + (COND + ((OR (ATOM #2#) + (PROGN + (LETT |l| (CAR #2#) + |POLYCAT-;conditionP;MU;27|) + NIL)) + (GO G191))) + (SEQ (LETT |mons| + (PROGN + (LETT #6# NIL + |POLYCAT-;conditionP;MU;27|) + (SEQ + (LETT |u| NIL + |POLYCAT-;conditionP;MU;27|) + (LETT #3# |l| + |POLYCAT-;conditionP;MU;27|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |u| (CAR #3#) + |POLYCAT-;conditionP;MU;27|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (PROGN + (LETT #4# + (SPADCALL |u| + (|getShellEntry| $ 79)) + |POLYCAT-;conditionP;MU;27|) + (COND + (#6# + (LETT #5# + (SPADCALL #5# #4# + (|getShellEntry| $ + 143)) + |POLYCAT-;conditionP;MU;27|)) + ('T + (PROGN + (LETT #5# #4# + |POLYCAT-;conditionP;MU;27|) + (LETT #6# 'T + |POLYCAT-;conditionP;MU;27|))))))) + (LETT #3# (CDR #3#) + |POLYCAT-;conditionP;MU;27|) + (GO G190) G191 (EXIT NIL)) + (COND + (#6# #5#) + ('T + (|IdentityError| + '|setUnion|)))) + |POLYCAT-;conditionP;MU;27|) + (LETT |redmons| NIL + |POLYCAT-;conditionP;MU;27|) + (SEQ (LETT |m| NIL + |POLYCAT-;conditionP;MU;27|) + (LETT #7# |mons| + |POLYCAT-;conditionP;MU;27|) + G190 + (COND + ((OR (ATOM #7#) + (PROGN + (LETT |m| (CAR #7#) + |POLYCAT-;conditionP;MU;27|) + NIL)) + (GO G191))) + (SEQ + (LETT |vars| + (SPADCALL |m| + (|getShellEntry| $ 32)) + |POLYCAT-;conditionP;MU;27|) + (LETT |degs| + (SPADCALL |m| |vars| + (|getShellEntry| $ 144)) + |POLYCAT-;conditionP;MU;27|) + (LETT |deg1| + (PROGN + (LETT #8# NIL + |POLYCAT-;conditionP;MU;27|) + (SEQ + (LETT |d| NIL + |POLYCAT-;conditionP;MU;27|) + (LETT #9# |degs| + |POLYCAT-;conditionP;MU;27|) + G190 + (COND + ((OR (ATOM #9#) + (PROGN + (LETT |d| (CAR #9#) + |POLYCAT-;conditionP;MU;27|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #8# + (CONS + (SEQ + (LETT |nd| + (SPADCALL |d| |ch| + (|getShellEntry| $ + 146)) + |POLYCAT-;conditionP;MU;27|) + (EXIT + (COND + ((QEQCAR |nd| 1) + (PROGN + (LETT #10# + (CONS 1 "failed") + |POLYCAT-;conditionP;MU;27|) + (GO #10#))) + ('T + (PROG1 + (LETT #11# + (QCDR |nd|) + |POLYCAT-;conditionP;MU;27|) + (|check-subtype| + (>= #11# 0) + '(|NonNegativeInteger|) + #11#)))))) + #8#) + |POLYCAT-;conditionP;MU;27|))) + (LETT #9# (CDR #9#) + |POLYCAT-;conditionP;MU;27|) + (GO G190) G191 + (EXIT (NREVERSE0 #8#)))) + |POLYCAT-;conditionP;MU;27|) + (LETT |redmons| + (CONS + (SPADCALL (|spadConstant| $ 34) + |vars| |deg1| + (|getShellEntry| $ 56)) + |redmons|) + |POLYCAT-;conditionP;MU;27|) + (EXIT + (LETT |llR| + (PROGN + (LETT #12# NIL + |POLYCAT-;conditionP;MU;27|) + (SEQ + (LETT |v| NIL + |POLYCAT-;conditionP;MU;27|) + (LETT #13# |llR| + |POLYCAT-;conditionP;MU;27|) + (LETT |u| NIL + |POLYCAT-;conditionP;MU;27|) + (LETT #14# |l| + |POLYCAT-;conditionP;MU;27|) + G190 + (COND + ((OR (ATOM #14#) + (PROGN + (LETT |u| (CAR #14#) + |POLYCAT-;conditionP;MU;27|) + NIL) + (ATOM #13#) + (PROGN + (LETT |v| (CAR #13#) + |POLYCAT-;conditionP;MU;27|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #12# + (CONS + (CONS + (SPADCALL + (SPADCALL |u| |vars| + |degs| + (|getShellEntry| $ + 54)) + (|getShellEntry| $ + 147)) + |v|) + #12#) + |POLYCAT-;conditionP;MU;27|))) + (LETT #14# + (PROG1 (CDR #14#) + (LETT #13# (CDR #13#) + |POLYCAT-;conditionP;MU;27|)) + |POLYCAT-;conditionP;MU;27|) + (GO G190) G191 + (EXIT (NREVERSE0 #12#)))) + |POLYCAT-;conditionP;MU;27|))) + (LETT #7# (CDR #7#) + |POLYCAT-;conditionP;MU;27|) + (GO G190) G191 (EXIT NIL)) + (EXIT (LETT |monslist| + (CONS |redmons| |monslist|) + |POLYCAT-;conditionP;MU;27|))) + (LETT #2# (CDR #2#) + |POLYCAT-;conditionP;MU;27|) + (GO G190) G191 (EXIT NIL)) + (LETT |ans| + (SPADCALL + (SPADCALL + (SPADCALL |llR| + (|getShellEntry| $ 92)) + (|getShellEntry| $ 148)) + (|getShellEntry| $ 150)) + |POLYCAT-;conditionP;MU;27|) + (EXIT (COND + ((QEQCAR |ans| 1) (CONS 1 "failed")) + ('T + (SEQ (LETT |i| 0 + |POLYCAT-;conditionP;MU;27|) + (EXIT + (CONS 0 + (PRIMVEC2ARR + (PROGN + (LETT #15# + (GETREFV (SIZE |monslist|)) + |POLYCAT-;conditionP;MU;27|) + (SEQ + (LETT #16# 0 + |POLYCAT-;conditionP;MU;27|) + (LETT |mons| NIL + |POLYCAT-;conditionP;MU;27|) + (LETT #17# |monslist| + |POLYCAT-;conditionP;MU;27|) + G190 + (COND + ((OR (ATOM #17#) + (PROGN + (LETT |mons| (CAR #17#) + |POLYCAT-;conditionP;MU;27|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (SETELT #15# #16# + (PROGN + (LETT #21# NIL + |POLYCAT-;conditionP;MU;27|) + (SEQ + (LETT |m| NIL + |POLYCAT-;conditionP;MU;27|) + (LETT #18# |mons| + |POLYCAT-;conditionP;MU;27|) + G190 + (COND + ((OR (ATOM #18#) + (PROGN + (LETT |m| + (CAR #18#) + |POLYCAT-;conditionP;MU;27|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (PROGN + (LETT #19# + (SPADCALL |m| + (SPADCALL + (SPADCALL + (QCDR |ans|) + (LETT |i| + (+ |i| 1) + |POLYCAT-;conditionP;MU;27|) + (|getShellEntry| + $ 151)) + (|getShellEntry| + $ 41)) + (|getShellEntry| + $ 152)) + |POLYCAT-;conditionP;MU;27|) + (COND + (#21# + (LETT #20# + (SPADCALL #20# + #19# + (|getShellEntry| + $ 153)) + |POLYCAT-;conditionP;MU;27|)) + ('T + (PROGN + (LETT #20# + #19# + |POLYCAT-;conditionP;MU;27|) + (LETT #21# 'T + |POLYCAT-;conditionP;MU;27|))))))) + (LETT #18# (CDR #18#) + |POLYCAT-;conditionP;MU;27|) + (GO G190) G191 + (EXIT NIL)) + (COND + (#21# #20#) + ('T + (|spadConstant| $ 22))))))) + (LETT #17# + (PROG1 (CDR #17#) + (LETT #16# (QSADD1 #16#) + |POLYCAT-;conditionP;MU;27|)) + |POLYCAT-;conditionP;MU;27|) + (GO G190) G191 (EXIT NIL)) + #15#)))))))))) + #10# (EXIT #10#))))) + +(DEFUN |POLYCAT-;charthRoot;SU;28| (|p| $) + (PROG (|vars| |ans| |ch|) + (RETURN + (SEQ (LETT |vars| (SPADCALL |p| (|getShellEntry| $ 32)) + |POLYCAT-;charthRoot;SU;28|) + (EXIT (COND + ((NULL |vars|) + (SEQ (LETT |ans| + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 147)) + (|getShellEntry| $ 155)) + |POLYCAT-;charthRoot;SU;28|) + (EXIT (COND + ((QEQCAR |ans| 1) (CONS 1 "failed")) + ('T + (CONS 0 + (SPADCALL (QCDR |ans|) + (|getShellEntry| $ 41)))))))) + ('T + (SEQ (LETT |ch| (SPADCALL (|getShellEntry| $ 142)) + |POLYCAT-;charthRoot;SU;28|) + (EXIT (|POLYCAT-;charthRootlv| |p| |vars| |ch| + $)))))))))) + +(DEFUN |POLYCAT-;charthRootlv| (|p| |vars| |ch| $) + (PROG (|v| |dd| |cp| |d| #0=#:G1668 |ans| |ansx| #1=#:G1675) + (RETURN + (SEQ (EXIT (COND + ((NULL |vars|) + (SEQ (LETT |ans| + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 147)) + (|getShellEntry| $ 155)) + |POLYCAT-;charthRootlv|) + (EXIT (COND + ((QEQCAR |ans| 1) (CONS 1 "failed")) + ('T + (CONS 0 + (SPADCALL (QCDR |ans|) + (|getShellEntry| $ 41)))))))) + ('T + (SEQ (LETT |v| (|SPADfirst| |vars|) + |POLYCAT-;charthRootlv|) + (LETT |vars| (CDR |vars|) + |POLYCAT-;charthRootlv|) + (LETT |d| + (SPADCALL |p| |v| + (|getShellEntry| $ 37)) + |POLYCAT-;charthRootlv|) + (LETT |ans| (|spadConstant| $ 22) + |POLYCAT-;charthRootlv|) + (SEQ G190 (COND ((NULL (< 0 |d|)) (GO G191))) + (SEQ (LETT |dd| + (SPADCALL |d| |ch| + (|getShellEntry| $ 146)) + |POLYCAT-;charthRootlv|) + (EXIT + (COND + ((QEQCAR |dd| 1) + (PROGN + (LETT #1# (CONS 1 "failed") + |POLYCAT-;charthRootlv|) + (GO #1#))) + ('T + (SEQ + (LETT |cp| + (SPADCALL |p| |v| |d| + (|getShellEntry| $ 158)) + |POLYCAT-;charthRootlv|) + (LETT |p| + (SPADCALL |p| + (SPADCALL |cp| |v| |d| + (|getShellEntry| $ 38)) + (|getShellEntry| $ 159)) + |POLYCAT-;charthRootlv|) + (LETT |ansx| + (|POLYCAT-;charthRootlv| |cp| + |vars| |ch| $) + |POLYCAT-;charthRootlv|) + (EXIT + (COND + ((QEQCAR |ansx| 1) + (PROGN + (LETT #1# + (CONS 1 "failed") + |POLYCAT-;charthRootlv|) + (GO #1#))) + ('T + (SEQ + (LETT |d| + (SPADCALL |p| |v| + (|getShellEntry| $ 37)) + |POLYCAT-;charthRootlv|) + (EXIT + (LETT |ans| + (SPADCALL |ans| + (SPADCALL (QCDR |ansx|) + |v| + (PROG1 + (LETT #0# (QCDR |dd|) + |POLYCAT-;charthRootlv|) + (|check-subtype| + (>= #0# 0) + '(|NonNegativeInteger|) + #0#)) + (|getShellEntry| $ 38)) + (|getShellEntry| $ 153)) + |POLYCAT-;charthRootlv|))))))))))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |ansx| + (|POLYCAT-;charthRootlv| |p| |vars| |ch| + $) + |POLYCAT-;charthRootlv|) + (EXIT (COND + ((QEQCAR |ansx| 1) + (PROGN + (LETT #1# (CONS 1 "failed") + |POLYCAT-;charthRootlv|) + (GO #1#))) + ('T + (PROGN + (LETT #1# + (CONS 0 + (SPADCALL |ans| (QCDR |ansx|) + (|getShellEntry| $ 153))) + |POLYCAT-;charthRootlv|) + (GO #1#))))))))) + #1# (EXIT #1#))))) + +(DEFUN |POLYCAT-;monicDivide;2SVarSetR;30| (|p1| |p2| |mvar| $) + (PROG (|result|) + (RETURN + (SEQ (LETT |result| + (SPADCALL + (SPADCALL |p1| |mvar| (|getShellEntry| $ 49)) + (SPADCALL |p2| |mvar| (|getShellEntry| $ 49)) + (|getShellEntry| $ 161)) + |POLYCAT-;monicDivide;2SVarSetR;30|) + (EXIT (CONS (SPADCALL (QCAR |result|) |mvar| + (|getShellEntry| $ 136)) + (SPADCALL (QCDR |result|) |mvar| + (|getShellEntry| $ 136)))))))) + +(DEFUN |POLYCAT-;squareFree;SF;31| (|p| $) + (SPADCALL |p| (|getShellEntry| $ 164))) + +(DEFUN |POLYCAT-;squareFree;SF;32| (|p| $) + (SPADCALL |p| (|getShellEntry| $ 167))) + +(DEFUN |POLYCAT-;squareFree;SF;33| (|p| $) + (SPADCALL |p| (|getShellEntry| $ 167))) + +(DEFUN |POLYCAT-;squareFreePart;2S;34| (|p| $) + (PROG (|s| |f| #0=#:G1691 #1=#:G1689 #2=#:G1687 #3=#:G1688) + (RETURN + (SEQ (SPADCALL + (SPADCALL + (LETT |s| (SPADCALL |p| (|getShellEntry| $ 168)) + |POLYCAT-;squareFreePart;2S;34|) + (|getShellEntry| $ 169)) + (PROGN + (LETT #3# NIL |POLYCAT-;squareFreePart;2S;34|) + (SEQ (LETT |f| NIL |POLYCAT-;squareFreePart;2S;34|) + (LETT #0# (SPADCALL |s| (|getShellEntry| $ 172)) + |POLYCAT-;squareFreePart;2S;34|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |f| (CAR #0#) + |POLYCAT-;squareFreePart;2S;34|) + NIL)) + (GO G191))) + (SEQ (EXIT (PROGN + (LETT #1# (QCAR |f|) + |POLYCAT-;squareFreePart;2S;34|) + (COND + (#3# + (LETT #2# + (SPADCALL #2# #1# + (|getShellEntry| $ 152)) + |POLYCAT-;squareFreePart;2S;34|)) + ('T + (PROGN + (LETT #2# #1# + |POLYCAT-;squareFreePart;2S;34|) + (LETT #3# 'T + |POLYCAT-;squareFreePart;2S;34|))))))) + (LETT #0# (CDR #0#) + |POLYCAT-;squareFreePart;2S;34|) + (GO G190) G191 (EXIT NIL)) + (COND (#3# #2#) ('T (|spadConstant| $ 34)))) + (|getShellEntry| $ 152)))))) + +(DEFUN |POLYCAT-;content;SVarSetS;35| (|p| |v| $) + (SPADCALL (SPADCALL |p| |v| (|getShellEntry| $ 49)) + (|getShellEntry| $ 174))) + +(DEFUN |POLYCAT-;primitivePart;2S;36| (|p| $) + (PROG (#0=#:G1694) + (RETURN + (QVELT (SPADCALL + (PROG2 (LETT #0# + (SPADCALL |p| + (SPADCALL |p| + (|getShellEntry| $ 176)) + (|getShellEntry| $ 177)) + |POLYCAT-;primitivePart;2S;36|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 6) + #0#)) + (|getShellEntry| $ 179)) + 1)))) + +(DEFUN |POLYCAT-;primitivePart;SVarSetS;37| (|p| |v| $) + (PROG (#0=#:G1700) + (RETURN + (QVELT (SPADCALL + (PROG2 (LETT #0# + (SPADCALL |p| + (SPADCALL |p| |v| + (|getShellEntry| $ 181)) + (|getShellEntry| $ 182)) + |POLYCAT-;primitivePart;SVarSetS;37|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 6) + #0#)) + (|getShellEntry| $ 179)) + 1)))) + +(DEFUN |POLYCAT-;<;2SB;38| (|p| |q| $) + (PROG (|dp| |dq|) + (RETURN + (SEQ (LETT |dp| (SPADCALL |p| (|getShellEntry| $ 61)) + |POLYCAT-;<;2SB;38|) + (LETT |dq| (SPADCALL |q| (|getShellEntry| $ 61)) + |POLYCAT-;<;2SB;38|) + (EXIT (COND + ((SPADCALL |dp| |dq| (|getShellEntry| $ 184)) + (SPADCALL (|spadConstant| $ 23) + (SPADCALL |q| (|getShellEntry| $ 39)) + (|getShellEntry| $ 185))) + ((SPADCALL |dq| |dp| (|getShellEntry| $ 184)) + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 39)) + (|spadConstant| $ 23) (|getShellEntry| $ 185))) + ('T + (SPADCALL + (SPADCALL (SPADCALL |p| |q| + (|getShellEntry| $ 159)) + (|getShellEntry| $ 39)) + (|spadConstant| $ 23) (|getShellEntry| $ 185))))))))) + +(DEFUN |POLYCAT-;patternMatch;SP2Pmr;39| (|p| |pat| |l| $) + (SPADCALL |p| |pat| |l| (|getShellEntry| $ 190))) + +(DEFUN |POLYCAT-;patternMatch;SP2Pmr;40| (|p| |pat| |l| $) + (SPADCALL |p| |pat| |l| (|getShellEntry| $ 197))) + +(DEFUN |POLYCAT-;convert;SP;41| (|x| $) + (SPADCALL (ELT $ 200) (ELT $ 201) |x| (|getShellEntry| $ 205))) + +(DEFUN |POLYCAT-;convert;SP;42| (|x| $) + (SPADCALL (ELT $ 207) (ELT $ 208) |x| (|getShellEntry| $ 212))) + +(DEFUN |POLYCAT-;convert;SIf;43| (|p| $) + (SPADCALL (ELT $ 215) (ELT $ 216) |p| (|getShellEntry| $ 220))) + +(DEFUN |PolynomialCategory&| (|#1| |#2| |#3| |#4|) + (PROG (|dv$1| |dv$2| |dv$3| |dv$4| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|PolynomialCategory&|)) + (LETT |dv$2| (|devaluate| |#2|) . #0#) + (LETT |dv$3| (|devaluate| |#3|) . #0#) + (LETT |dv$4| (|devaluate| |#4|) . #0#) + (LETT |dv$| + (LIST '|PolynomialCategory&| |dv$1| |dv$2| |dv$3| |dv$4|) . #0#) + (LETT $ (|newShell| 229) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#2| + '(|PolynomialFactorizationExplicit|)) + (|HasAttribute| |#2| + '|canonicalUnitNormal|) + (|HasCategory| |#2| '(|GcdDomain|)) + (|HasCategory| |#2| '(|CommutativeRing|)) + (|HasCategory| |#4| + '(|PatternMatchable| (|Float|))) + (|HasCategory| |#2| + '(|PatternMatchable| (|Float|))) + (|HasCategory| |#4| + '(|PatternMatchable| (|Integer|))) + (|HasCategory| |#2| + '(|PatternMatchable| (|Integer|))) + (|HasCategory| |#4| + '(|ConvertibleTo| + (|Pattern| (|Float|)))) + (|HasCategory| |#2| + '(|ConvertibleTo| + (|Pattern| (|Float|)))) + (|HasCategory| |#4| + '(|ConvertibleTo| + (|Pattern| (|Integer|)))) + (|HasCategory| |#2| + '(|ConvertibleTo| + (|Pattern| (|Integer|)))) + (|HasCategory| |#4| + '(|ConvertibleTo| (|InputForm|))) + (|HasCategory| |#2| + '(|ConvertibleTo| (|InputForm|))) + (|HasCategory| |#2| '(|OrderedSet|)))) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + (|setShellEntry| $ 7 |#2|) + (|setShellEntry| $ 8 |#3|) + (|setShellEntry| $ 9 |#4|) + (COND + ((|testBitVector| |pv$| 4) + (PROGN + (|setShellEntry| $ 76 + (CONS (|dispatchFunction| + |POLYCAT-;resultant;2SVarSetS;15|) + $)) + (|setShellEntry| $ 78 + (CONS (|dispatchFunction| + |POLYCAT-;discriminant;SVarSetS;16|) + $))))) + (COND + ((|HasCategory| |#2| '(|IntegralDomain|)) + (PROGN + (|setShellEntry| $ 99 + (CONS (|dispatchFunction| + |POLYCAT-;reducedSystem;MM;20|) + $)) + (|setShellEntry| $ 106 + (CONS (|dispatchFunction| + |POLYCAT-;reducedSystem;MVR;21|) + $))))) + (COND + ((|testBitVector| |pv$| 1) + (PROGN + (|setShellEntry| $ 109 + (CONS (|dispatchFunction| + |POLYCAT-;gcdPolynomial;3Sup;22|) + $)) + (|setShellEntry| $ 116 + (CONS (|dispatchFunction| + |POLYCAT-;solveLinearPolynomialEquation;LSupU;23|) + $)) + (|setShellEntry| $ 120 + (CONS (|dispatchFunction| + |POLYCAT-;factorPolynomial;SupF;24|) + $)) + (|setShellEntry| $ 122 + (CONS (|dispatchFunction| + |POLYCAT-;factorSquareFreePolynomial;SupF;25|) + $)) + (|setShellEntry| $ 140 + (CONS (|dispatchFunction| |POLYCAT-;factor;SF;26|) $)) + (COND + ((|HasCategory| |#2| '(|CharacteristicNonZero|)) + (PROGN + (|setShellEntry| $ 154 + (CONS (|dispatchFunction| + |POLYCAT-;conditionP;MU;27|) + $)))))))) + (COND + ((|HasCategory| |#2| '(|CharacteristicNonZero|)) + (PROGN + (|setShellEntry| $ 156 + (CONS (|dispatchFunction| |POLYCAT-;charthRoot;SU;28|) + $))))) + (COND + ((|testBitVector| |pv$| 3) + (PROGN + (COND + ((|HasCategory| |#2| '(|EuclideanDomain|)) + (COND + ((|HasCategory| |#2| '(|CharacteristicZero|)) + (|setShellEntry| $ 165 + (CONS (|dispatchFunction| + |POLYCAT-;squareFree;SF;31|) + $))) + ('T + (|setShellEntry| $ 165 + (CONS (|dispatchFunction| + |POLYCAT-;squareFree;SF;32|) + $))))) + ('T + (|setShellEntry| $ 165 + (CONS (|dispatchFunction| + |POLYCAT-;squareFree;SF;33|) + $)))) + (|setShellEntry| $ 173 + (CONS (|dispatchFunction| + |POLYCAT-;squareFreePart;2S;34|) + $)) + (|setShellEntry| $ 175 + (CONS (|dispatchFunction| + |POLYCAT-;content;SVarSetS;35|) + $)) + (|setShellEntry| $ 180 + (CONS (|dispatchFunction| + |POLYCAT-;primitivePart;2S;36|) + $)) + (|setShellEntry| $ 183 + (CONS (|dispatchFunction| + |POLYCAT-;primitivePart;SVarSetS;37|) + $))))) + (COND + ((|testBitVector| |pv$| 15) + (PROGN + (|setShellEntry| $ 186 + (CONS (|dispatchFunction| |POLYCAT-;<;2SB;38|) $)) + (COND + ((|testBitVector| |pv$| 8) + (COND + ((|testBitVector| |pv$| 7) + (|setShellEntry| $ 192 + (CONS (|dispatchFunction| + |POLYCAT-;patternMatch;SP2Pmr;39|) + $)))))) + (COND + ((|testBitVector| |pv$| 6) + (COND + ((|testBitVector| |pv$| 5) + (|setShellEntry| $ 199 + (CONS (|dispatchFunction| + |POLYCAT-;patternMatch;SP2Pmr;40|) + $))))))))) + (COND + ((|testBitVector| |pv$| 12) + (COND + ((|testBitVector| |pv$| 11) + (|setShellEntry| $ 206 + (CONS (|dispatchFunction| |POLYCAT-;convert;SP;41|) + $)))))) + (COND + ((|testBitVector| |pv$| 10) + (COND + ((|testBitVector| |pv$| 9) + (|setShellEntry| $ 213 + (CONS (|dispatchFunction| |POLYCAT-;convert;SP;42|) + $)))))) + (COND + ((|testBitVector| |pv$| 14) + (COND + ((|testBitVector| |pv$| 13) + (|setShellEntry| $ 221 + (CONS (|dispatchFunction| |POLYCAT-;convert;SIf;43|) + $)))))) + $)))) + +(MAKEPROP '|PolynomialCategory&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|local| |#3|) (|local| |#4|) (|Equation| 6) (0 . |lhs|) + (|Union| 9 '"failed") (5 . |retractIfCan|) + (10 . |retract|) (15 . |rhs|) (|List| 9) (|List| $) + (20 . |eval|) (|Equation| $) (|List| 19) + |POLYCAT-;eval;SLS;1| (27 . |Zero|) (31 . |Zero|) + (|Boolean|) (35 . ~=) (41 . |leadingMonomial|) + (46 . |reductum|) |POLYCAT-;monomials;SL;2| + (51 . |monomials|) (|Union| 17 '"failed") + |POLYCAT-;isPlus;SU;3| (56 . |variables|) + (61 . |monomial?|) (66 . |One|) (70 . |One|) + (|NonNegativeInteger|) (74 . |degree|) (80 . |monomial|) + (87 . |leadingCoefficient|) (92 . =) (98 . |coerce|) + |POLYCAT-;isTimes;SU;4| (103 . |mainVariable|) (108 . =) + (|Record| (|:| |var| 9) (|:| |exponent| 36)) + (|Union| 45 '"failed") |POLYCAT-;isExpt;SU;5| + (|SparseUnivariatePolynomial| $) (114 . |univariate|) + (|SparseUnivariatePolynomial| 6) (120 . |coefficient|) + |POLYCAT-;coefficient;SVarSetNniS;6| (|List| 36) + (126 . |coefficient|) |POLYCAT-;coefficient;SLLS;7| + (133 . |monomial|) |POLYCAT-;monomial;SLLS;8| + (140 . |coerce|) |POLYCAT-;retract;SVarSet;9| + |POLYCAT-;retractIfCan;SU;10| (145 . |degree|) + (150 . |monomial|) |POLYCAT-;primitiveMonomials;SL;12| + (156 . |ground?|) (161 . |Zero|) (165 . ~=) + (171 . |degree|) (176 . |leadingCoefficient|) + (181 . |totalDegree|) (186 . |reductum|) + |POLYCAT-;totalDegree;SNni;13| (191 . |member?|) + (197 . |totalDegree|) |POLYCAT-;totalDegree;SLNni;14| + (203 . |resultant|) (209 . |resultant|) + (216 . |discriminant|) (221 . |discriminant|) + (227 . |primitiveMonomials|) (|List| 6) (232 . |concat|) + (237 . |removeDuplicates!|) (|Vector| 7) (242 . |new|) + (|Integer|) (248 . |minIndex|) (253 . |coefficient|) + (259 . |qsetelt!|) (|List| 7) (|List| 89) (|Matrix| 7) + (266 . |matrix|) (|List| 80) (|Matrix| 6) + (271 . |listOfLists|) (276 . |not|) (281 . |vertConcat|) + (|Matrix| $) (287 . |reducedSystem|) (|Vector| 6) + (292 . |entries|) (297 . |concat|) (303 . |concat|) + (|Record| (|:| |mat| 91) (|:| |vec| 83)) (|Vector| $) + (309 . |reducedSystem|) + (|GeneralPolynomialGcdPackage| 8 9 7 6) + (315 . |gcdPolynomial|) (321 . |gcdPolynomial|) + (|List| 50) (|Union| 110 '"failed") + (|PolynomialFactorizationByRecursion| 7 8 9 6) + (327 . |solveLinearPolynomialEquationByRecursion|) + (|List| 48) (|Union| 114 '"failed") + (333 . |solveLinearPolynomialEquation|) (|Factored| 50) + (339 . |factorByRecursion|) (|Factored| 48) + (344 . |factorPolynomial|) + (349 . |factorSquareFreeByRecursion|) + (354 . |factorSquareFreePolynomial|) (|Factored| $) + (359 . |factor|) (|Factored| 7) (364 . |unit|) + (|Union| '"nil" '"sqfr" '"irred" '"prime") + (|Record| (|:| |flg| 127) (|:| |fctr| 7) (|:| |xpnt| 85)) + (|List| 128) (369 . |factorList|) + (|Record| (|:| |flg| 127) (|:| |fctr| 6) (|:| |xpnt| 85)) + (|List| 131) (|Factored| 6) (374 . |makeFR|) + (380 . |unit|) (385 . |multivariate|) + (|Record| (|:| |flg| 127) (|:| |fctr| 50) (|:| |xpnt| 85)) + (|List| 137) (391 . |factorList|) (396 . |factor|) + (401 . |transpose|) (406 . |characteristic|) + (410 . |setUnion|) (416 . |degree|) (|Union| $ '"failed") + (422 . |exquo|) (428 . |ground|) (433 . |transpose|) + (|Union| 105 '"failed") (438 . |conditionP|) (443 . |elt|) + (449 . *) (455 . +) (461 . |conditionP|) + (466 . |charthRoot|) (471 . |charthRoot|) (476 . |Zero|) + (480 . |coefficient|) (487 . -) + (|Record| (|:| |quotient| $) (|:| |remainder| $)) + (493 . |monicDivide|) |POLYCAT-;monicDivide;2SVarSetR;30| + (|MultivariateSquareFree| 8 9 7 6) (499 . |squareFree|) + (504 . |squareFree|) (|PolynomialSquareFree| 9 8 7 6) + (509 . |squareFree|) (514 . |squareFree|) (519 . |unit|) + (|Record| (|:| |factor| 6) (|:| |exponent| 85)) + (|List| 170) (524 . |factors|) (529 . |squareFreePart|) + (534 . |content|) (539 . |content|) (545 . |content|) + (550 . |exquo|) + (|Record| (|:| |unit| $) (|:| |canonical| $) + (|:| |associate| $)) + (556 . |unitNormal|) (561 . |primitivePart|) + (566 . |content|) (572 . |exquo|) (578 . |primitivePart|) + (584 . <) (590 . <) (596 . <) (|PatternMatchResult| 85 6) + (|Pattern| 85) + (|PatternMatchPolynomialCategory| 85 8 9 7 6) + (602 . |patternMatch|) (|PatternMatchResult| 85 $) + (609 . |patternMatch|) (|Float|) + (|PatternMatchResult| 193 6) (|Pattern| 193) + (|PatternMatchPolynomialCategory| 193 8 9 7 6) + (616 . |patternMatch|) (|PatternMatchResult| 193 $) + (623 . |patternMatch|) (630 . |convert|) (635 . |convert|) + (|Mapping| 188 9) (|Mapping| 188 7) + (|PolynomialCategoryLifting| 8 9 7 6 188) (640 . |map|) + (647 . |convert|) (652 . |convert|) (657 . |convert|) + (|Mapping| 195 9) (|Mapping| 195 7) + (|PolynomialCategoryLifting| 8 9 7 6 195) (662 . |map|) + (669 . |convert|) (|InputForm|) (674 . |convert|) + (679 . |convert|) (|Mapping| 214 9) (|Mapping| 214 7) + (|PolynomialCategoryLifting| 8 9 7 6 214) (684 . |map|) + (691 . |convert|) (|Matrix| 85) (|Vector| 85) + (|Record| (|:| |mat| 222) (|:| |vec| 223)) + (|Union| 85 '"failed") (|Fraction| 85) + (|Union| 226 '"failed") (|Union| 7 '"failed")) + '#(|totalDegree| 696 |squareFreePart| 707 |squareFree| 712 + |solveLinearPolynomialEquation| 717 |retractIfCan| 723 + |retract| 728 |resultant| 733 |reducedSystem| 740 + |primitivePart| 751 |primitiveMonomials| 762 + |patternMatch| 767 |monomials| 781 |monomial| 786 + |monicDivide| 793 |isTimes| 800 |isPlus| 805 |isExpt| 810 + |gcdPolynomial| 815 |factorSquareFreePolynomial| 821 + |factorPolynomial| 826 |factor| 831 |eval| 836 + |discriminant| 842 |convert| 848 |content| 863 + |conditionP| 869 |coefficient| 874 |charthRoot| 888 < 893) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 221 + '(1 10 6 0 11 1 6 12 0 13 1 6 9 0 14 1 + 10 6 0 15 3 6 0 0 16 17 18 0 6 0 22 0 + 7 0 23 2 6 24 0 0 25 1 6 0 0 26 1 6 0 + 0 27 1 6 17 0 29 1 6 16 0 32 1 6 24 0 + 33 0 6 0 34 0 7 0 35 2 6 36 0 9 37 3 + 6 0 0 9 36 38 1 6 7 0 39 2 7 24 0 0 + 40 1 6 0 7 41 1 6 12 0 43 2 6 24 0 0 + 44 2 6 48 0 9 49 2 50 6 0 36 51 3 6 0 + 0 16 53 54 3 6 0 0 16 53 56 1 6 0 9 + 58 1 6 8 0 61 2 6 0 7 8 62 1 6 24 0 + 64 0 50 0 65 2 50 24 0 0 66 1 50 36 0 + 67 1 50 6 0 68 1 6 36 0 69 1 50 0 0 + 70 2 16 24 9 0 72 2 6 36 0 16 73 2 50 + 6 0 0 75 3 0 0 0 0 9 76 1 50 6 0 77 2 + 0 0 0 9 78 1 6 17 0 79 1 80 0 17 81 1 + 80 0 0 82 2 83 0 36 7 84 1 83 85 0 86 + 2 6 7 0 8 87 3 83 7 0 85 7 88 1 91 0 + 90 92 1 94 93 0 95 1 24 0 0 96 2 91 0 + 0 0 97 1 0 91 98 99 1 100 80 0 101 2 + 80 0 0 0 102 2 83 0 0 0 103 2 0 104 + 98 105 106 2 107 50 50 50 108 2 0 48 + 48 48 109 2 112 111 110 50 113 2 0 + 115 114 48 116 1 112 117 50 118 1 0 + 119 48 120 1 112 117 50 121 1 0 119 + 48 122 1 7 123 0 124 1 125 7 0 126 1 + 125 129 0 130 2 133 0 6 132 134 1 117 + 50 0 135 2 6 0 48 9 136 1 117 138 0 + 139 1 0 123 0 140 1 94 0 0 141 0 6 36 + 142 2 80 0 0 0 143 2 6 53 0 16 144 2 + 85 145 0 0 146 1 6 7 0 147 1 91 0 0 + 148 1 7 149 98 150 2 83 7 0 85 151 2 + 6 0 0 0 152 2 6 0 0 0 153 1 0 149 98 + 154 1 7 145 0 155 1 0 145 0 156 0 8 0 + 157 3 6 0 0 9 36 158 2 6 0 0 0 159 2 + 50 160 0 0 161 1 163 133 6 164 1 0 + 123 0 165 1 166 133 6 167 1 6 123 0 + 168 1 133 6 0 169 1 133 171 0 172 1 0 + 0 0 173 1 50 6 0 174 2 0 0 0 9 175 1 + 6 7 0 176 2 6 145 0 7 177 1 6 178 0 + 179 1 0 0 0 180 2 6 0 0 9 181 2 6 145 + 0 0 182 2 0 0 0 9 183 2 8 24 0 0 184 + 2 7 24 0 0 185 2 0 24 0 0 186 3 189 + 187 6 188 187 190 3 0 191 0 188 191 + 192 3 196 194 6 195 194 197 3 0 198 0 + 195 198 199 1 9 188 0 200 1 7 188 0 + 201 3 204 188 202 203 6 205 1 0 188 0 + 206 1 9 195 0 207 1 7 195 0 208 3 211 + 195 209 210 6 212 1 0 195 0 213 1 9 + 214 0 215 1 7 214 0 216 3 219 214 217 + 218 6 220 1 0 214 0 221 2 0 36 0 16 + 74 1 0 36 0 71 1 0 0 0 173 1 0 123 0 + 165 2 0 115 114 48 116 1 0 12 0 60 1 + 0 9 0 59 3 0 0 0 0 9 76 1 0 91 98 99 + 2 0 104 98 105 106 2 0 0 0 9 183 1 0 + 0 0 180 1 0 17 0 63 3 0 191 0 188 191 + 192 3 0 198 0 195 198 199 1 0 17 0 28 + 3 0 0 0 16 53 57 3 0 160 0 0 9 162 1 + 0 30 0 42 1 0 30 0 31 1 0 46 0 47 2 0 + 48 48 48 109 1 0 119 48 122 1 0 119 + 48 120 1 0 123 0 140 2 0 0 0 20 21 2 + 0 0 0 9 78 1 0 214 0 221 1 0 188 0 + 206 1 0 195 0 213 2 0 0 0 9 175 1 0 + 149 98 154 3 0 0 0 16 53 55 3 0 0 0 9 + 36 52 1 0 145 0 156 2 0 24 0 0 186))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/POLYCAT.lsp b/src/algebra/strap/POLYCAT.lsp new file mode 100644 index 00000000..e328aa4d --- /dev/null +++ b/src/algebra/strap/POLYCAT.lsp @@ -0,0 +1,238 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |PolynomialCategory;CAT| 'NIL) + +(DEFPARAMETER |PolynomialCategory;AL| 'NIL) + +(DEFUN |PolynomialCategory| (&REST #0=#:G1406 &AUX #1=#:G1404) + (DSETQ #1# #0#) + (LET (#2=#:G1405) + (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#)))) + +(DEFUN |PolynomialCategory;| (|t#1| |t#2| |t#3|) + (PROG (#0=#:G1403) + (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|)))) + '(((|OrderedSet|) + (|has| |t#1| + (|OrderedSet|))) + ((|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#) + (SETELT #0# 0 + (LIST '|PolynomialCategory| (|devaluate| |t#1|) + (|devaluate| |t#2|) (|devaluate| |t#3|))))))) diff --git a/src/algebra/strap/PRIMARR.lsp b/src/algebra/strap/PRIMARR.lsp new file mode 100644 index 00000000..a8f4f9a7 --- /dev/null +++ b/src/algebra/strap/PRIMARR.lsp @@ -0,0 +1,193 @@ + +(/VERSIONCHECK 2) + +(PUT '|PRIMARR;#;$Nni;1| '|SPADreplace| '|sizeOfSimpleArray|) + +(DEFUN |PRIMARR;#;$Nni;1| (|x| $) (|sizeOfSimpleArray| |x|)) + +(PUT '|PRIMARR;minIndex;$I;2| '|SPADreplace| '(XLAM (|x|) 0)) + +(DEFUN |PRIMARR;minIndex;$I;2| (|x| $) 0) + +(DEFUN |PRIMARR;empty;$;3| ($) + (|makeSimpleArray| (|getVMType| (|getShellEntry| $ 6)) 0)) + +(DEFUN |PRIMARR;new;NniS$;4| (|n| |x| $) + (|makeFilledSimpleArray| (|getVMType| (|getShellEntry| $ 6)) |n| |x|)) + +(PUT '|PRIMARR;qelt;$IS;5| '|SPADreplace| '|getSimpleArrayEntry|) + +(DEFUN |PRIMARR;qelt;$IS;5| (|x| |i| $) + (|getSimpleArrayEntry| |x| |i|)) + +(PUT '|PRIMARR;elt;$IS;6| '|SPADreplace| '|getSimpleArrayEntry|) + +(DEFUN |PRIMARR;elt;$IS;6| (|x| |i| $) + (|getSimpleArrayEntry| |x| |i|)) + +(PUT '|PRIMARR;qsetelt!;$I2S;7| '|SPADreplace| '|setSimpleArrayEntry|) + +(DEFUN |PRIMARR;qsetelt!;$I2S;7| (|x| |i| |s| $) + (|setSimpleArrayEntry| |x| |i| |s|)) + +(PUT '|PRIMARR;setelt;$I2S;8| '|SPADreplace| '|setSimpleArrayEntry|) + +(DEFUN |PRIMARR;setelt;$I2S;8| (|x| |i| |s| $) + (|setSimpleArrayEntry| |x| |i| |s|)) + +(DEFUN |PRIMARR;fill!;$S$;9| (|x| |s| $) + (PROG (|i| #0=#:G1403) + (RETURN + (SEQ (SEQ (LETT |i| 0 |PRIMARR;fill!;$S$;9|) + (LETT #0# (|maxIndexOfSimpleArray| |x|) + |PRIMARR;fill!;$S$;9|) + G190 (COND ((QSGREATERP |i| #0#) (GO G191))) + (SEQ (EXIT (|setSimpleArrayEntry| |x| |i| |s|))) + (LETT |i| (QSADD1 |i|) |PRIMARR;fill!;$S$;9|) (GO G190) + G191 (EXIT NIL)) + (EXIT |x|))))) + +(DEFUN |PrimitiveArray| (#0=#:G1411) + (PROG () + (RETURN + (PROG (#1=#:G1412) + (RETURN + (COND + ((LETT #1# + (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) + (HGET |$ConstructorCache| '|PrimitiveArray|) + '|domainEqualList|) + |PrimitiveArray|) + (|CDRwithIncrement| #1#)) + ('T + (UNWIND-PROTECT + (PROG1 (|PrimitiveArray;| #0#) + (LETT #1# T |PrimitiveArray|)) + (COND + ((NOT #1#) + (HREM |$ConstructorCache| '|PrimitiveArray|))))))))))) + +(DEFUN |PrimitiveArray;| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|PrimitiveArray|)) + (LETT |dv$| (LIST '|PrimitiveArray| |dv$1|) . #0#) + (LETT $ (|newShell| 35) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (OR (AND (|HasCategory| |#1| + '(|OrderedSet|)) + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + (AND (|HasCategory| |#1| + '(|SetCategory|)) + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|))))) + (OR (AND (|HasCategory| |#1| + '(|SetCategory|)) + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + (|HasCategory| |#1| + '(|CoercibleTo| (|OutputForm|)))) + (|HasCategory| |#1| + '(|ConvertibleTo| (|InputForm|))) + (OR (|HasCategory| |#1| '(|OrderedSet|)) + (|HasCategory| |#1| '(|SetCategory|))) + (|HasCategory| |#1| '(|OrderedSet|)) + (|HasCategory| (|Integer|) '(|OrderedSet|)) + (|HasCategory| |#1| '(|SetCategory|)) + (AND (|HasCategory| |#1| '(|SetCategory|)) + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + (|HasCategory| |#1| + '(|CoercibleTo| (|OutputForm|))))) . #0#)) + (|haddProp| |$ConstructorCache| '|PrimitiveArray| (LIST |dv$1|) + (CONS 1 $)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + $)))) + +(MAKEPROP '|PrimitiveArray| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) + (|NonNegativeInteger|) |PRIMARR;#;$Nni;1| (|Integer|) + |PRIMARR;minIndex;$I;2| |PRIMARR;empty;$;3| + |PRIMARR;new;NniS$;4| |PRIMARR;qelt;$IS;5| + |PRIMARR;elt;$IS;6| |PRIMARR;qsetelt!;$I2S;7| + |PRIMARR;setelt;$I2S;8| |PRIMARR;fill!;$S$;9| + (|Mapping| 6 6 6) (|Boolean|) (|List| 6) (|Equation| 6) + (|List| 21) (|Mapping| 19 6) (|Mapping| 19 6 6) + (|UniversalSegment| 9) (|Void|) (|Mapping| 6 6) + (|OutputForm|) (|InputForm|) (|String|) (|SingleInteger|) + (|List| $) (|Union| 6 '"failed") (|List| 9)) + '#(~= 0 |swap!| 6 |sorted?| 13 |sort!| 24 |sort| 35 |size?| + 46 |setelt| 52 |select| 66 |sample| 72 |reverse!| 76 + |reverse| 81 |removeDuplicates| 86 |remove| 91 |reduce| + 103 |qsetelt!| 124 |qelt| 131 |position| 137 |parts| 156 + |new| 161 |more?| 167 |minIndex| 173 |min| 178 |merge| 184 + |members| 197 |member?| 202 |maxIndex| 208 |max| 213 + |map!| 219 |map| 225 |less?| 238 |latex| 244 |insert| 249 + |indices| 263 |index?| 268 |hash| 274 |first| 279 |find| + 284 |fill!| 290 |every?| 296 |eval| 302 |eq?| 328 |entry?| + 334 |entries| 340 |empty?| 345 |empty| 350 |elt| 354 + |delete| 373 |count| 385 |copyInto!| 397 |copy| 404 + |convert| 409 |construct| 414 |concat| 419 |coerce| 442 + |any?| 447 >= 453 > 459 = 465 <= 471 < 477 |#| 483) + '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) + (CONS (|makeByteWordVec2| 5 + '(0 0 0 0 0 0 5 0 0 1 4 0 0 1 2 3 4)) + (CONS '#(|OneDimensionalArrayAggregate&| + |FiniteLinearAggregate&| |LinearAggregate&| + |IndexedAggregate&| |Collection&| + |HomogeneousAggregate&| |OrderedSet&| + |Aggregate&| |EltableAggregate&| |Evalable&| + |SetCategory&| NIL NIL |InnerEvalable&| NIL + NIL |BasicType&|) + (CONS '#((|OneDimensionalArrayAggregate| 6) + (|FiniteLinearAggregate| 6) + (|LinearAggregate| 6) + (|IndexedAggregate| 9 6) + (|Collection| 6) + (|HomogeneousAggregate| 6) + (|OrderedSet|) (|Aggregate|) + (|EltableAggregate| 9 6) (|Evalable| 6) + (|SetCategory|) (|Type|) (|Eltable| 9 6) + (|InnerEvalable| 6 6) (|CoercibleTo| 28) + (|ConvertibleTo| 29) (|BasicType|)) + (|makeByteWordVec2| 34 + '(2 7 19 0 0 1 3 0 26 0 9 9 1 1 5 19 0 + 1 2 0 19 24 0 1 1 5 0 0 1 2 0 0 24 0 + 1 1 5 0 0 1 2 0 0 24 0 1 2 0 19 0 7 1 + 3 0 6 0 25 6 1 3 0 6 0 9 6 16 2 0 0 + 23 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 + 7 0 0 1 2 7 0 6 0 1 2 0 0 23 0 1 4 7 + 6 18 0 6 6 1 3 0 6 18 0 6 1 2 0 6 18 + 0 1 3 0 6 0 9 6 15 2 0 6 0 9 13 2 7 9 + 6 0 1 3 7 9 6 0 9 1 2 0 9 23 0 1 1 0 + 20 0 1 2 0 0 7 6 12 2 0 19 0 7 1 1 6 + 9 0 10 2 5 0 0 0 1 2 5 0 0 0 1 3 0 0 + 24 0 0 1 1 0 20 0 1 2 7 19 6 0 1 1 6 + 9 0 1 2 5 0 0 0 1 2 0 0 27 0 1 3 0 0 + 18 0 0 1 2 0 0 27 0 1 2 0 19 0 7 1 1 + 7 30 0 1 3 0 0 0 0 9 1 3 0 0 6 0 9 1 + 1 0 34 0 1 2 0 19 9 0 1 1 7 31 0 1 1 + 6 6 0 1 2 0 33 23 0 1 2 0 0 0 6 17 2 + 0 19 23 0 1 3 8 0 0 20 20 1 2 8 0 0 + 21 1 3 8 0 0 6 6 1 2 8 0 0 22 1 2 0 + 19 0 0 1 2 7 19 6 0 1 1 0 20 0 1 1 0 + 19 0 1 0 0 0 11 2 0 0 0 25 1 2 0 6 0 + 9 14 3 0 6 0 9 6 1 2 0 0 0 9 1 2 0 0 + 0 25 1 2 7 7 6 0 1 2 0 7 23 0 1 3 0 0 + 0 0 9 1 1 0 0 0 1 1 3 29 0 1 1 0 0 20 + 1 1 0 0 32 1 2 0 0 6 0 1 2 0 0 0 0 1 + 2 0 0 0 6 1 1 9 28 0 1 2 0 19 23 0 1 + 2 5 19 0 0 1 2 5 19 0 0 1 2 7 19 0 0 + 1 2 5 19 0 0 1 2 5 19 0 0 1 1 0 7 0 + 8))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/PSETCAT-.lsp b/src/algebra/strap/PSETCAT-.lsp new file mode 100644 index 00000000..3e22b5d1 --- /dev/null +++ b/src/algebra/strap/PSETCAT-.lsp @@ -0,0 +1,885 @@ + +(/VERSIONCHECK 2) + +(DEFUN |PSETCAT-;elements| (|ps| $) + (PROG (|lp|) + (RETURN + (LETT |lp| (SPADCALL |ps| (|getShellEntry| $ 12)) + |PSETCAT-;elements|)))) + +(DEFUN |PSETCAT-;variables1| (|lp| $) + (PROG (#0=#:G1435 |p| #1=#:G1436 |lvars|) + (RETURN + (SEQ (LETT |lvars| + (PROGN + (LETT #0# NIL |PSETCAT-;variables1|) + (SEQ (LETT |p| NIL |PSETCAT-;variables1|) + (LETT #1# |lp| |PSETCAT-;variables1|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |p| (CAR #1#) + |PSETCAT-;variables1|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |p| + (|getShellEntry| $ 14)) + #0#) + |PSETCAT-;variables1|))) + (LETT #1# (CDR #1#) |PSETCAT-;variables1|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + |PSETCAT-;variables1|) + (EXIT (SPADCALL (CONS #'|PSETCAT-;variables1!0| $) + (SPADCALL + (SPADCALL |lvars| (|getShellEntry| $ 18)) + (|getShellEntry| $ 19)) + (|getShellEntry| $ 21))))))) + +(DEFUN |PSETCAT-;variables1!0| (|#1| |#2| $) + (SPADCALL |#2| |#1| (|getShellEntry| $ 16))) + +(DEFUN |PSETCAT-;variables2| (|lp| $) + (PROG (#0=#:G1440 |p| #1=#:G1441 |lvars|) + (RETURN + (SEQ (LETT |lvars| + (PROGN + (LETT #0# NIL |PSETCAT-;variables2|) + (SEQ (LETT |p| NIL |PSETCAT-;variables2|) + (LETT #1# |lp| |PSETCAT-;variables2|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |p| (CAR #1#) + |PSETCAT-;variables2|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |p| + (|getShellEntry| $ 22)) + #0#) + |PSETCAT-;variables2|))) + (LETT #1# (CDR #1#) |PSETCAT-;variables2|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + |PSETCAT-;variables2|) + (EXIT (SPADCALL (CONS #'|PSETCAT-;variables2!0| $) + (SPADCALL |lvars| (|getShellEntry| $ 19)) + (|getShellEntry| $ 21))))))) + +(DEFUN |PSETCAT-;variables2!0| (|#1| |#2| $) + (SPADCALL |#2| |#1| (|getShellEntry| $ 16))) + +(DEFUN |PSETCAT-;variables;SL;4| (|ps| $) + (|PSETCAT-;variables1| (|PSETCAT-;elements| |ps| $) $)) + +(DEFUN |PSETCAT-;mainVariables;SL;5| (|ps| $) + (|PSETCAT-;variables2| + (SPADCALL (ELT $ 24) (|PSETCAT-;elements| |ps| $) + (|getShellEntry| $ 26)) + $)) + +(DEFUN |PSETCAT-;mainVariable?;VarSetSB;6| (|v| |ps| $) + (PROG (|lp|) + (RETURN + (SEQ (LETT |lp| + (SPADCALL (ELT $ 24) (|PSETCAT-;elements| |ps| $) + (|getShellEntry| $ 26)) + |PSETCAT-;mainVariable?;VarSetSB;6|) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp|) 'NIL) + ('T + (SPADCALL + (SPADCALL + (SPADCALL (|SPADfirst| |lp|) + (|getShellEntry| $ 22)) + |v| (|getShellEntry| $ 28)) + (|getShellEntry| $ 29))))) + (GO G191))) + (SEQ (EXIT (LETT |lp| (CDR |lp|) + |PSETCAT-;mainVariable?;VarSetSB;6|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL (NULL |lp|) (|getShellEntry| $ 29))))))) + +(DEFUN |PSETCAT-;collectUnder;SVarSetS;7| (|ps| |v| $) + (PROG (|p| |lp| |lq|) + (RETURN + (SEQ (LETT |lp| (|PSETCAT-;elements| |ps| $) + |PSETCAT-;collectUnder;SVarSetS;7|) + (LETT |lq| NIL |PSETCAT-;collectUnder;SVarSetS;7|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lp|) (|getShellEntry| $ 29))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |lp|) + |PSETCAT-;collectUnder;SVarSetS;7|) + (LETT |lp| (CDR |lp|) + |PSETCAT-;collectUnder;SVarSetS;7|) + (EXIT (COND + ((OR (SPADCALL |p| (|getShellEntry| $ 24)) + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 22)) + |v| (|getShellEntry| $ 16))) + (LETT |lq| (CONS |p| |lq|) + |PSETCAT-;collectUnder;SVarSetS;7|))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |lq| (|getShellEntry| $ 31))))))) + +(DEFUN |PSETCAT-;collectUpper;SVarSetS;8| (|ps| |v| $) + (PROG (|p| |lp| |lq|) + (RETURN + (SEQ (LETT |lp| (|PSETCAT-;elements| |ps| $) + |PSETCAT-;collectUpper;SVarSetS;8|) + (LETT |lq| NIL |PSETCAT-;collectUpper;SVarSetS;8|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lp|) (|getShellEntry| $ 29))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |lp|) + |PSETCAT-;collectUpper;SVarSetS;8|) + (LETT |lp| (CDR |lp|) + |PSETCAT-;collectUpper;SVarSetS;8|) + (EXIT (COND + ((NULL (SPADCALL |p| + (|getShellEntry| $ 24))) + (COND + ((SPADCALL |v| + (SPADCALL |p| + (|getShellEntry| $ 22)) + (|getShellEntry| $ 16)) + (LETT |lq| (CONS |p| |lq|) + |PSETCAT-;collectUpper;SVarSetS;8|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |lq| (|getShellEntry| $ 31))))))) + +(DEFUN |PSETCAT-;collect;SVarSetS;9| (|ps| |v| $) + (PROG (|p| |lp| |lq|) + (RETURN + (SEQ (LETT |lp| (|PSETCAT-;elements| |ps| $) + |PSETCAT-;collect;SVarSetS;9|) + (LETT |lq| NIL |PSETCAT-;collect;SVarSetS;9|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lp|) (|getShellEntry| $ 29))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |lp|) + |PSETCAT-;collect;SVarSetS;9|) + (LETT |lp| (CDR |lp|) + |PSETCAT-;collect;SVarSetS;9|) + (EXIT (COND + ((NULL (SPADCALL |p| + (|getShellEntry| $ 24))) + (COND + ((SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 22)) + |v| (|getShellEntry| $ 28)) + (LETT |lq| (CONS |p| |lq|) + |PSETCAT-;collect;SVarSetS;9|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |lq| (|getShellEntry| $ 31))))))) + +(DEFUN |PSETCAT-;sort;SVarSetR;10| (|ps| |v| $) + (PROG (|p| |lp| |us| |vs| |ws|) + (RETURN + (SEQ (LETT |lp| (|PSETCAT-;elements| |ps| $) + |PSETCAT-;sort;SVarSetR;10|) + (LETT |us| NIL |PSETCAT-;sort;SVarSetR;10|) + (LETT |vs| NIL |PSETCAT-;sort;SVarSetR;10|) + (LETT |ws| NIL |PSETCAT-;sort;SVarSetR;10|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lp|) (|getShellEntry| $ 29))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |lp|) + |PSETCAT-;sort;SVarSetR;10|) + (LETT |lp| (CDR |lp|) |PSETCAT-;sort;SVarSetR;10|) + (EXIT (COND + ((OR (SPADCALL |p| (|getShellEntry| $ 24)) + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 22)) + |v| (|getShellEntry| $ 16))) + (LETT |us| (CONS |p| |us|) + |PSETCAT-;sort;SVarSetR;10|)) + ((SPADCALL + (SPADCALL |p| (|getShellEntry| $ 22)) + |v| (|getShellEntry| $ 28)) + (LETT |vs| (CONS |p| |vs|) + |PSETCAT-;sort;SVarSetR;10|)) + ('T + (LETT |ws| (CONS |p| |ws|) + |PSETCAT-;sort;SVarSetR;10|))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (VECTOR (SPADCALL |us| (|getShellEntry| $ 31)) + (SPADCALL |vs| (|getShellEntry| $ 31)) + (SPADCALL |ws| (|getShellEntry| $ 31)))))))) + +(DEFUN |PSETCAT-;=;2SB;11| (|ps1| |ps2| $) + (PROG (#0=#:G1475 #1=#:G1476 #2=#:G1477 |p| #3=#:G1478) + (RETURN + (SEQ (SPADCALL + (SPADCALL + (PROGN + (LETT #0# NIL |PSETCAT-;=;2SB;11|) + (SEQ (LETT |p| NIL |PSETCAT-;=;2SB;11|) + (LETT #1# (|PSETCAT-;elements| |ps1| $) + |PSETCAT-;=;2SB;11|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |p| (CAR #1#) + |PSETCAT-;=;2SB;11|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# (CONS |p| #0#) + |PSETCAT-;=;2SB;11|))) + (LETT #1# (CDR #1#) |PSETCAT-;=;2SB;11|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 38)) + (SPADCALL + (PROGN + (LETT #2# NIL |PSETCAT-;=;2SB;11|) + (SEQ (LETT |p| NIL |PSETCAT-;=;2SB;11|) + (LETT #3# (|PSETCAT-;elements| |ps2| $) + |PSETCAT-;=;2SB;11|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |p| (CAR #3#) + |PSETCAT-;=;2SB;11|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #2# (CONS |p| #2#) + |PSETCAT-;=;2SB;11|))) + (LETT #3# (CDR #3#) |PSETCAT-;=;2SB;11|) + (GO G190) G191 (EXIT (NREVERSE0 #2#)))) + (|getShellEntry| $ 38)) + (|getShellEntry| $ 39)))))) + +(DEFUN |PSETCAT-;localInf?| (|p| |q| $) + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 41)) + (SPADCALL |q| (|getShellEntry| $ 41)) (|getShellEntry| $ 42))) + +(DEFUN |PSETCAT-;localTriangular?| (|lp| $) + (PROG (|q| |p|) + (RETURN + (SEQ (LETT |lp| (SPADCALL (ELT $ 43) |lp| (|getShellEntry| $ 26)) + |PSETCAT-;localTriangular?|) + (EXIT (COND + ((NULL |lp|) 'T) + ((SPADCALL (ELT $ 24) |lp| (|getShellEntry| $ 44)) + 'NIL) + ('T + (SEQ (LETT |lp| + (SPADCALL + (CONS + #'|PSETCAT-;localTriangular?!0| $) + |lp| (|getShellEntry| $ 46)) + |PSETCAT-;localTriangular?|) + (LETT |p| (|SPADfirst| |lp|) + |PSETCAT-;localTriangular?|) + (LETT |lp| (CDR |lp|) + |PSETCAT-;localTriangular?|) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp|) 'NIL) + ('T + (SPADCALL + (SPADCALL + (LETT |q| + (|SPADfirst| |lp|) + |PSETCAT-;localTriangular?|) + (|getShellEntry| $ 22)) + (SPADCALL |p| + (|getShellEntry| $ 22)) + (|getShellEntry| $ 16))))) + (GO G191))) + (SEQ (LETT |p| |q| + |PSETCAT-;localTriangular?|) + (EXIT + (LETT |lp| (CDR |lp|) + |PSETCAT-;localTriangular?|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (NULL |lp|)))))))))) + +(DEFUN |PSETCAT-;localTriangular?!0| (|#1| |#2| $) + (SPADCALL (SPADCALL |#2| (|getShellEntry| $ 22)) + (SPADCALL |#1| (|getShellEntry| $ 22)) (|getShellEntry| $ 16))) + +(DEFUN |PSETCAT-;triangular?;SB;14| (|ps| $) + (|PSETCAT-;localTriangular?| (|PSETCAT-;elements| |ps| $) $)) + +(DEFUN |PSETCAT-;trivialIdeal?;SB;15| (|ps| $) + (NULL (SPADCALL (ELT $ 43) (|PSETCAT-;elements| |ps| $) + (|getShellEntry| $ 26)))) + +(DEFUN |PSETCAT-;roughUnitIdeal?;SB;16| (|ps| $) + (SPADCALL (ELT $ 24) + (SPADCALL (ELT $ 43) (|PSETCAT-;elements| |ps| $) + (|getShellEntry| $ 26)) + (|getShellEntry| $ 44))) + +(DEFUN |PSETCAT-;relativelyPrimeLeadingMonomials?| (|p| |q| $) + (PROG (|dp| |dq|) + (RETURN + (SEQ (LETT |dp| (SPADCALL |p| (|getShellEntry| $ 41)) + |PSETCAT-;relativelyPrimeLeadingMonomials?|) + (LETT |dq| (SPADCALL |q| (|getShellEntry| $ 41)) + |PSETCAT-;relativelyPrimeLeadingMonomials?|) + (EXIT (SPADCALL (SPADCALL |dp| |dq| (|getShellEntry| $ 50)) + (SPADCALL |dp| |dq| (|getShellEntry| $ 51)) + (|getShellEntry| $ 52))))))) + +(DEFUN |PSETCAT-;roughBase?;SB;18| (|ps| $) + (PROG (|p| |lp| |rB?| |copylp|) + (RETURN + (SEQ (LETT |lp| + (SPADCALL (ELT $ 43) (|PSETCAT-;elements| |ps| $) + (|getShellEntry| $ 26)) + |PSETCAT-;roughBase?;SB;18|) + (EXIT (COND + ((NULL |lp|) 'T) + ('T + (SEQ (LETT |rB?| 'T |PSETCAT-;roughBase?;SB;18|) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp|) 'NIL) + ('T |rB?|))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |lp|) + |PSETCAT-;roughBase?;SB;18|) + (LETT |lp| (CDR |lp|) + |PSETCAT-;roughBase?;SB;18|) + (LETT |copylp| |lp| + |PSETCAT-;roughBase?;SB;18|) + (EXIT + (SEQ G190 + (COND + ((NULL + (COND + ((NULL |copylp|) 'NIL) + ('T |rB?|))) + (GO G191))) + (SEQ + (LETT |rB?| + (|PSETCAT-;relativelyPrimeLeadingMonomials?| + |p| (|SPADfirst| |copylp|) $) + |PSETCAT-;roughBase?;SB;18|) + (EXIT + (LETT |copylp| (CDR |copylp|) + |PSETCAT-;roughBase?;SB;18|))) + NIL (GO G190) G191 (EXIT NIL)))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |rB?|))))))))) + +(DEFUN |PSETCAT-;roughSubIdeal?;2SB;19| (|ps1| |ps2| $) + (PROG (|lp|) + (RETURN + (SEQ (LETT |lp| + (SPADCALL (|PSETCAT-;elements| |ps1| $) |ps2| + (|getShellEntry| $ 54)) + |PSETCAT-;roughSubIdeal?;2SB;19|) + (EXIT (NULL (SPADCALL (ELT $ 43) |lp| + (|getShellEntry| $ 26)))))))) + +(DEFUN |PSETCAT-;roughEqualIdeals?;2SB;20| (|ps1| |ps2| $) + (COND + ((SPADCALL |ps1| |ps2| (|getShellEntry| $ 56)) 'T) + ((SPADCALL |ps1| |ps2| (|getShellEntry| $ 57)) + (SPADCALL |ps2| |ps1| (|getShellEntry| $ 57))) + ('T 'NIL))) + +(DEFUN |PSETCAT-;exactQuo| (|r| |s| $) + (PROG (#0=#:G1510) + (RETURN + (COND + ((|HasCategory| (|getShellEntry| $ 7) '(|EuclideanDomain|)) + (SPADCALL |r| |s| (|getShellEntry| $ 59))) + ('T + (PROG2 (LETT #0# (SPADCALL |r| |s| (|getShellEntry| $ 61)) + |PSETCAT-;exactQuo|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 7) #0#))))))) + +(DEFUN |PSETCAT-;headRemainder;PSR;22| (|a| |ps| $) + (PROG (|lp1| |p| |e| |g| |#G45| |#G46| |lca| |lcp| |r| |lp2|) + (RETURN + (SEQ (LETT |lp1| + (SPADCALL (ELT $ 43) (|PSETCAT-;elements| |ps| $) + (|getShellEntry| $ 26)) + |PSETCAT-;headRemainder;PSR;22|) + (EXIT (COND + ((NULL |lp1|) (CONS |a| (|spadConstant| $ 62))) + ((SPADCALL (ELT $ 24) |lp1| (|getShellEntry| $ 44)) + (CONS (SPADCALL |a| (|getShellEntry| $ 63)) + (|spadConstant| $ 62))) + ('T + (SEQ (LETT |r| (|spadConstant| $ 62) + |PSETCAT-;headRemainder;PSR;22|) + (LETT |lp1| + (SPADCALL + (CONS + (|function| |PSETCAT-;localInf?|) + $) + (REVERSE + (|PSETCAT-;elements| |ps| $)) + (|getShellEntry| $ 46)) + |PSETCAT-;headRemainder;PSR;22|) + (LETT |lp2| |lp1| + |PSETCAT-;headRemainder;PSR;22|) + (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |a| + (|getShellEntry| $ 43)) + 'NIL) + ('T + (SPADCALL (NULL |lp2|) + (|getShellEntry| $ 29))))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |lp2|) + |PSETCAT-;headRemainder;PSR;22|) + (LETT |e| + (SPADCALL + (SPADCALL |a| + (|getShellEntry| $ 41)) + (SPADCALL |p| + (|getShellEntry| $ 41)) + (|getShellEntry| $ 64)) + |PSETCAT-;headRemainder;PSR;22|) + (EXIT + (COND + ((QEQCAR |e| 0) + (SEQ + (LETT |g| + (SPADCALL + (LETT |lca| + (SPADCALL |a| + (|getShellEntry| $ 65)) + |PSETCAT-;headRemainder;PSR;22|) + (LETT |lcp| + (SPADCALL |p| + (|getShellEntry| $ 65)) + |PSETCAT-;headRemainder;PSR;22|) + (|getShellEntry| $ 66)) + |PSETCAT-;headRemainder;PSR;22|) + (PROGN + (LETT |#G45| + (|PSETCAT-;exactQuo| |lca| + |g| $) + |PSETCAT-;headRemainder;PSR;22|) + (LETT |#G46| + (|PSETCAT-;exactQuo| |lcp| + |g| $) + |PSETCAT-;headRemainder;PSR;22|) + (LETT |lca| |#G45| + |PSETCAT-;headRemainder;PSR;22|) + (LETT |lcp| |#G46| + |PSETCAT-;headRemainder;PSR;22|)) + (LETT |a| + (SPADCALL + (SPADCALL |lcp| + (SPADCALL |a| + (|getShellEntry| $ 63)) + (|getShellEntry| $ 67)) + (SPADCALL + (SPADCALL |lca| (QCDR |e|) + (|getShellEntry| $ 68)) + (SPADCALL |p| + (|getShellEntry| $ 63)) + (|getShellEntry| $ 69)) + (|getShellEntry| $ 70)) + |PSETCAT-;headRemainder;PSR;22|) + (LETT |r| + (SPADCALL |r| |lcp| + (|getShellEntry| $ 71)) + |PSETCAT-;headRemainder;PSR;22|) + (EXIT + (LETT |lp2| |lp1| + |PSETCAT-;headRemainder;PSR;22|)))) + ('T + (LETT |lp2| (CDR |lp2|) + |PSETCAT-;headRemainder;PSR;22|))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (CONS |a| |r|)))))))))) + +(DEFUN |PSETCAT-;makeIrreducible!| (|frac| $) + (PROG (|g|) + (RETURN + (SEQ (LETT |g| + (SPADCALL (QCDR |frac|) (QCAR |frac|) + (|getShellEntry| $ 74)) + |PSETCAT-;makeIrreducible!|) + (EXIT (COND + ((SPADCALL |g| (|spadConstant| $ 62) + (|getShellEntry| $ 76)) + |frac|) + ('T + (SEQ (PROGN + (RPLACA |frac| + (SPADCALL (QCAR |frac|) |g| + (|getShellEntry| $ 77))) + (QCAR |frac|)) + (PROGN + (RPLACD |frac| + (|PSETCAT-;exactQuo| (QCDR |frac|) + |g| $)) + (QCDR |frac|)) + (EXIT |frac|))))))))) + +(DEFUN |PSETCAT-;remainder;PSR;24| (|a| |ps| $) + (PROG (|hRa| |r| |lca| |g| |b| |c|) + (RETURN + (SEQ (LETT |hRa| + (|PSETCAT-;makeIrreducible!| + (SPADCALL |a| |ps| (|getShellEntry| $ 78)) $) + |PSETCAT-;remainder;PSR;24|) + (LETT |a| (QCAR |hRa|) |PSETCAT-;remainder;PSR;24|) + (LETT |r| (QCDR |hRa|) |PSETCAT-;remainder;PSR;24|) + (EXIT (COND + ((SPADCALL |a| (|getShellEntry| $ 43)) + (VECTOR (|spadConstant| $ 62) |a| |r|)) + ('T + (SEQ (LETT |b| + (SPADCALL (|spadConstant| $ 62) + (SPADCALL |a| + (|getShellEntry| $ 41)) + (|getShellEntry| $ 68)) + |PSETCAT-;remainder;PSR;24|) + (LETT |c| + (SPADCALL |a| (|getShellEntry| $ 65)) + |PSETCAT-;remainder;PSR;24|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL + (LETT |a| + (SPADCALL |a| + (|getShellEntry| $ 63)) + |PSETCAT-;remainder;PSR;24|) + (|getShellEntry| $ 43)) + (|getShellEntry| $ 29))) + (GO G191))) + (SEQ (LETT |hRa| + (|PSETCAT-;makeIrreducible!| + (SPADCALL |a| |ps| + (|getShellEntry| $ 78)) + $) + |PSETCAT-;remainder;PSR;24|) + (LETT |a| (QCAR |hRa|) + |PSETCAT-;remainder;PSR;24|) + (LETT |r| + (SPADCALL |r| (QCDR |hRa|) + (|getShellEntry| $ 71)) + |PSETCAT-;remainder;PSR;24|) + (LETT |g| + (SPADCALL |c| + (LETT |lca| + (SPADCALL |a| + (|getShellEntry| $ 65)) + |PSETCAT-;remainder;PSR;24|) + (|getShellEntry| $ 66)) + |PSETCAT-;remainder;PSR;24|) + (LETT |b| + (SPADCALL + (SPADCALL + (SPADCALL (QCDR |hRa|) + (|PSETCAT-;exactQuo| |c| |g| $) + (|getShellEntry| $ 71)) + |b| (|getShellEntry| $ 67)) + (SPADCALL + (|PSETCAT-;exactQuo| |lca| |g| $) + (SPADCALL |a| + (|getShellEntry| $ 41)) + (|getShellEntry| $ 68)) + (|getShellEntry| $ 79)) + |PSETCAT-;remainder;PSR;24|) + (EXIT + (LETT |c| |g| + |PSETCAT-;remainder;PSR;24|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (VECTOR |c| |b| |r|)))))))))) + +(DEFUN |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25| (|ps| |cs| $) + (PROG (|p| |rs|) + (RETURN + (SEQ (COND + ((SPADCALL |cs| (|getShellEntry| $ 82)) |ps|) + ((SPADCALL |cs| (|getShellEntry| $ 83)) + (LIST (|spadConstant| $ 84))) + ('T + (SEQ (LETT |ps| + (SPADCALL (ELT $ 43) |ps| + (|getShellEntry| $ 26)) + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) + (EXIT (COND + ((NULL |ps|) |ps|) + ((SPADCALL (ELT $ 24) |ps| + (|getShellEntry| $ 44)) + (LIST (|spadConstant| $ 75))) + ('T + (SEQ (LETT |rs| NIL + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) + (SEQ G190 + (COND + ((NULL + (SPADCALL (NULL |ps|) + (|getShellEntry| $ 29))) + (GO G191))) + (SEQ + (LETT |p| (|SPADfirst| |ps|) + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) + (LETT |ps| (CDR |ps|) + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) + (LETT |p| + (QCAR + (SPADCALL |p| |cs| + (|getShellEntry| $ 78))) + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) + (EXIT + (COND + ((NULL + (SPADCALL |p| + (|getShellEntry| $ 43))) + (COND + ((SPADCALL |p| + (|getShellEntry| $ 24)) + (SEQ + (LETT |ps| NIL + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) + (EXIT + (LETT |rs| + (LIST + (|spadConstant| $ 75)) + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|)))) + ('T + (SEQ + (SPADCALL |p| + (|getShellEntry| $ 85)) + (EXIT + (LETT |rs| + (CONS |p| |rs|) + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|))))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |rs| + (|getShellEntry| $ 86)))))))))))))) + +(DEFUN |PSETCAT-;rewriteIdealWithRemainder;LSL;26| (|ps| |cs| $) + (PROG (|p| |rs|) + (RETURN + (SEQ (COND + ((SPADCALL |cs| (|getShellEntry| $ 82)) |ps|) + ((SPADCALL |cs| (|getShellEntry| $ 83)) + (LIST (|spadConstant| $ 84))) + ('T + (SEQ (LETT |ps| + (SPADCALL (ELT $ 43) |ps| + (|getShellEntry| $ 26)) + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) + (EXIT (COND + ((NULL |ps|) |ps|) + ((SPADCALL (ELT $ 24) |ps| + (|getShellEntry| $ 44)) + (LIST (|spadConstant| $ 75))) + ('T + (SEQ (LETT |rs| NIL + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) + (SEQ G190 + (COND + ((NULL + (SPADCALL (NULL |ps|) + (|getShellEntry| $ 29))) + (GO G191))) + (SEQ + (LETT |p| (|SPADfirst| |ps|) + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) + (LETT |ps| (CDR |ps|) + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) + (LETT |p| + (QVELT + (SPADCALL |p| |cs| + (|getShellEntry| $ 88)) + 1) + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) + (EXIT + (COND + ((NULL + (SPADCALL |p| + (|getShellEntry| $ 43))) + (COND + ((SPADCALL |p| + (|getShellEntry| $ 24)) + (SEQ + (LETT |ps| NIL + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) + (EXIT + (LETT |rs| + (LIST + (|spadConstant| $ 75)) + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|)))) + ('T + (LETT |rs| + (CONS + (SPADCALL |p| + (|getShellEntry| $ 89)) + |rs|) + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |rs| + (|getShellEntry| $ 86)))))))))))))) + +(DEFUN |PolynomialSetCategory&| (|#1| |#2| |#3| |#4| |#5|) + (PROG (|dv$1| |dv$2| |dv$3| |dv$4| |dv$5| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) + . #0=(|PolynomialSetCategory&|)) + (LETT |dv$2| (|devaluate| |#2|) . #0#) + (LETT |dv$3| (|devaluate| |#3|) . #0#) + (LETT |dv$4| (|devaluate| |#4|) . #0#) + (LETT |dv$5| (|devaluate| |#5|) . #0#) + (LETT |dv$| + (LIST '|PolynomialSetCategory&| |dv$1| |dv$2| |dv$3| + |dv$4| |dv$5|) . #0#) + (LETT $ (|newShell| 91) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#2| '(|IntegralDomain|)))) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + (|setShellEntry| $ 7 |#2|) + (|setShellEntry| $ 8 |#3|) + (|setShellEntry| $ 9 |#4|) + (|setShellEntry| $ 10 |#5|) + (COND + ((|testBitVector| |pv$| 1) + (PROGN + (|setShellEntry| $ 49 + (CONS (|dispatchFunction| + |PSETCAT-;roughUnitIdeal?;SB;16|) + $)) + (|setShellEntry| $ 53 + (CONS (|dispatchFunction| |PSETCAT-;roughBase?;SB;18|) + $)) + (|setShellEntry| $ 55 + (CONS (|dispatchFunction| + |PSETCAT-;roughSubIdeal?;2SB;19|) + $)) + (|setShellEntry| $ 58 + (CONS (|dispatchFunction| + |PSETCAT-;roughEqualIdeals?;2SB;20|) + $))))) + (COND + ((|HasCategory| |#2| '(|GcdDomain|)) + (COND + ((|HasCategory| |#4| '(|ConvertibleTo| (|Symbol|))) + (PROGN + (|setShellEntry| $ 73 + (CONS (|dispatchFunction| + |PSETCAT-;headRemainder;PSR;22|) + $)) + (|setShellEntry| $ 81 + (CONS (|dispatchFunction| + |PSETCAT-;remainder;PSR;24|) + $)) + (|setShellEntry| $ 87 + (CONS (|dispatchFunction| + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) + $)) + (|setShellEntry| $ 90 + (CONS (|dispatchFunction| + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) + $))))))) + $)))) + +(MAKEPROP '|PolynomialSetCategory&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|local| |#3|) (|local| |#4|) (|local| |#5|) (|List| 10) + (0 . |members|) (|List| 9) (5 . |variables|) (|Boolean|) + (10 . <) (|List| $) (16 . |concat|) + (21 . |removeDuplicates|) (|Mapping| 15 9 9) (26 . |sort|) + (32 . |mvar|) |PSETCAT-;variables;SL;4| (37 . |ground?|) + (|Mapping| 15 10) (42 . |remove|) + |PSETCAT-;mainVariables;SL;5| (48 . =) (54 . |not|) + |PSETCAT-;mainVariable?;VarSetSB;6| (59 . |construct|) + |PSETCAT-;collectUnder;SVarSetS;7| + |PSETCAT-;collectUpper;SVarSetS;8| + |PSETCAT-;collect;SVarSetS;9| + (|Record| (|:| |under| $) (|:| |floor| $) (|:| |upper| $)) + |PSETCAT-;sort;SVarSetR;10| (|Set| 10) (64 . |brace|) + (69 . =) |PSETCAT-;=;2SB;11| (75 . |degree|) (80 . <) + (86 . |zero?|) (91 . |any?|) (|Mapping| 15 10 10) + (97 . |sort|) |PSETCAT-;triangular?;SB;14| + |PSETCAT-;trivialIdeal?;SB;15| (103 . |roughUnitIdeal?|) + (108 . |sup|) (114 . +) (120 . =) (126 . |roughBase?|) + (131 . |rewriteIdealWithRemainder|) + (137 . |roughSubIdeal?|) (143 . =) + (149 . |roughSubIdeal?|) (155 . |roughEqualIdeals?|) + (161 . |quo|) (|Union| $ '"failed") (167 . |exquo|) + (173 . |One|) (177 . |reductum|) (182 . |subtractIfCan|) + (188 . |leadingCoefficient|) (193 . |gcd|) (199 . *) + (205 . |monomial|) (211 . *) (217 . -) (223 . *) + (|Record| (|:| |num| 10) (|:| |den| 7)) + (229 . |headRemainder|) (235 . |gcd|) (241 . |One|) + (245 . =) (251 . |exactQuotient!|) (257 . |headRemainder|) + (263 . +) + (|Record| (|:| |rnum| 7) (|:| |polnum| 10) (|:| |den| 7)) + (269 . |remainder|) (275 . |trivialIdeal?|) + (280 . |roughUnitIdeal?|) (285 . |Zero|) + (289 . |primitivePart!|) (294 . |removeDuplicates|) + (299 . |rewriteIdealWithHeadRemainder|) + (305 . |remainder|) (311 . |unitCanonical|) + (316 . |rewriteIdealWithRemainder|)) + '#(|variables| 322 |trivialIdeal?| 327 |triangular?| 332 + |sort| 337 |roughUnitIdeal?| 343 |roughSubIdeal?| 348 + |roughEqualIdeals?| 354 |roughBase?| 360 + |rewriteIdealWithRemainder| 365 + |rewriteIdealWithHeadRemainder| 371 |remainder| 377 + |mainVariables| 383 |mainVariable?| 388 |headRemainder| + 394 |collectUpper| 400 |collectUnder| 406 |collect| 412 = + 418) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 90 + '(1 6 11 0 12 1 10 13 0 14 2 9 15 0 0 + 16 1 13 0 17 18 1 13 0 0 19 2 13 0 20 + 0 21 1 10 9 0 22 1 10 15 0 24 2 11 0 + 25 0 26 2 9 15 0 0 28 1 15 0 0 29 1 6 + 0 11 31 1 37 0 11 38 2 37 15 0 0 39 1 + 10 8 0 41 2 8 15 0 0 42 1 10 15 0 43 + 2 11 15 25 0 44 2 11 0 45 0 46 1 0 15 + 0 49 2 8 0 0 0 50 2 8 0 0 0 51 2 8 15 + 0 0 52 1 0 15 0 53 2 6 11 11 0 54 2 0 + 15 0 0 55 2 6 15 0 0 56 2 6 15 0 0 57 + 2 0 15 0 0 58 2 7 0 0 0 59 2 7 60 0 0 + 61 0 7 0 62 1 10 0 0 63 2 8 60 0 0 64 + 1 10 7 0 65 2 7 0 0 0 66 2 10 0 7 0 + 67 2 10 0 7 8 68 2 10 0 0 0 69 2 10 0 + 0 0 70 2 7 0 0 0 71 2 0 72 10 0 73 2 + 10 7 7 0 74 0 10 0 75 2 7 15 0 0 76 2 + 10 0 0 7 77 2 6 72 10 0 78 2 10 0 0 0 + 79 2 0 80 10 0 81 1 6 15 0 82 1 6 15 + 0 83 0 10 0 84 1 10 0 0 85 1 11 0 0 + 86 2 0 11 11 0 87 2 6 80 10 0 88 1 10 + 0 0 89 2 0 11 11 0 90 1 0 13 0 23 1 0 + 15 0 48 1 0 15 0 47 2 0 35 0 9 36 1 0 + 15 0 49 2 0 15 0 0 55 2 0 15 0 0 58 1 + 0 15 0 53 2 0 11 11 0 90 2 0 11 11 0 + 87 2 0 80 10 0 81 1 0 13 0 27 2 0 15 + 9 0 30 2 0 72 10 0 73 2 0 0 0 9 33 2 + 0 0 0 9 32 2 0 0 0 9 34 2 0 15 0 0 + 40))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/PSETCAT.lsp b/src/algebra/strap/PSETCAT.lsp new file mode 100644 index 00000000..e4a1f465 --- /dev/null +++ b/src/algebra/strap/PSETCAT.lsp @@ -0,0 +1,123 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |PolynomialSetCategory;CAT| 'NIL) + +(DEFPARAMETER |PolynomialSetCategory;AL| 'NIL) + +(DEFUN |PolynomialSetCategory| (&REST #0=#:G1422 &AUX #1=#:G1420) + (DSETQ #1# #0#) + (LET (#2=#:G1421) + (COND + ((SETQ #2# + (|assoc| (|devaluateList| #1#) |PolynomialSetCategory;AL|)) + (CDR #2#)) + (T (SETQ |PolynomialSetCategory;AL| + (|cons5| (CONS (|devaluateList| #1#) + (SETQ #2# + (APPLY #'|PolynomialSetCategory;| + #1#))) + |PolynomialSetCategory;AL|)) + #2#)))) + +(DEFUN |PolynomialSetCategory;| (|t#1| |t#2| |t#3| |t#4|) + (PROG (#0=#:G1419) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1| |t#2| |t#3| |t#4|) + (LIST (|devaluate| |t#1|) + (|devaluate| |t#2|) + (|devaluate| |t#3|) + (|devaluate| |t#4|))) + (|sublisV| + (PAIR '(#1=#:G1418) (LIST '(|List| |t#4|))) + (COND + (|PolynomialSetCategory;CAT|) + ('T + (LETT |PolynomialSetCategory;CAT| + (|Join| (|SetCategory|) + (|Collection| '|t#4|) + (|CoercibleTo| '#1#) + (|mkCategory| '|domain| + '(((|retractIfCan| + ((|Union| $ "failed") + (|List| |t#4|))) + T) + ((|retract| ($ (|List| |t#4|))) + T) + ((|mvar| (|t#3| $)) T) + ((|variables| + ((|List| |t#3|) $)) + T) + ((|mainVariables| + ((|List| |t#3|) $)) + T) + ((|mainVariable?| + ((|Boolean|) |t#3| $)) + T) + ((|collectUnder| ($ $ |t#3|)) + T) + ((|collect| ($ $ |t#3|)) T) + ((|collectUpper| ($ $ |t#3|)) + T) + ((|sort| + ((|Record| (|:| |under| $) + (|:| |floor| $) + (|:| |upper| $)) + $ |t#3|)) + T) + ((|trivialIdeal?| + ((|Boolean|) $)) + T) + ((|roughBase?| ((|Boolean|) $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|roughSubIdeal?| + ((|Boolean|) $ $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|roughEqualIdeals?| + ((|Boolean|) $ $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|roughUnitIdeal?| + ((|Boolean|) $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|headRemainder| + ((|Record| (|:| |num| |t#4|) + (|:| |den| |t#1|)) + |t#4| $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|remainder| + ((|Record| (|:| |rnum| |t#1|) + (|:| |polnum| |t#4|) + (|:| |den| |t#1|)) + |t#4| $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|rewriteIdealWithHeadRemainder| + ((|List| |t#4|) + (|List| |t#4|) $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|rewriteIdealWithRemainder| + ((|List| |t#4|) + (|List| |t#4|) $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|triangular?| + ((|Boolean|) $)) + (|has| |t#1| + (|IntegralDomain|)))) + '((|finiteAggregate| T)) + '((|Boolean|) (|List| |t#4|) + (|List| |t#3|)) + NIL)) + . #2=(|PolynomialSetCategory|)))))) . #2#) + (SETELT #0# 0 + (LIST '|PolynomialSetCategory| (|devaluate| |t#1|) + (|devaluate| |t#2|) (|devaluate| |t#3|) + (|devaluate| |t#4|))))))) diff --git a/src/algebra/strap/QFCAT-.lsp b/src/algebra/strap/QFCAT-.lsp new file mode 100644 index 00000000..2197438a --- /dev/null +++ b/src/algebra/strap/QFCAT-.lsp @@ -0,0 +1,440 @@ + +(/VERSIONCHECK 2) + +(DEFUN |QFCAT-;numerator;2A;1| (|x| $) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) (|getShellEntry| $ 9))) + +(DEFUN |QFCAT-;denominator;2A;2| (|x| $) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) + (|getShellEntry| $ 9))) + +(DEFUN |QFCAT-;init;A;3| ($) + (SPADCALL (|spadConstant| $ 13) (|spadConstant| $ 14) + (|getShellEntry| $ 15))) + +(DEFUN |QFCAT-;nextItem;AU;4| (|n| $) + (PROG (|m|) + (RETURN + (SEQ (LETT |m| + (SPADCALL (SPADCALL |n| (|getShellEntry| $ 8)) + (|getShellEntry| $ 18)) + |QFCAT-;nextItem;AU;4|) + (EXIT (COND + ((QEQCAR |m| 1) + (|error| "We seem to have a Fraction of a finite object")) + ('T + (CONS 0 + (SPADCALL (QCDR |m|) (|spadConstant| $ 14) + (|getShellEntry| $ 15)))))))))) + +(DEFUN |QFCAT-;map;M2A;5| (|fn| |x| $) + (SPADCALL (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) |fn|) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) |fn|) + (|getShellEntry| $ 15))) + +(DEFUN |QFCAT-;reducedSystem;MM;6| (|m| $) + (SPADCALL |m| (|getShellEntry| $ 26))) + +(DEFUN |QFCAT-;characteristic;Nni;7| ($) + (SPADCALL (|getShellEntry| $ 30))) + +(DEFUN |QFCAT-;differentiate;AMA;8| (|x| |deriv| $) + (PROG (|n| |d|) + (RETURN + (SEQ (LETT |n| (SPADCALL |x| (|getShellEntry| $ 8)) + |QFCAT-;differentiate;AMA;8|) + (LETT |d| (SPADCALL |x| (|getShellEntry| $ 11)) + |QFCAT-;differentiate;AMA;8|) + (EXIT (SPADCALL + (SPADCALL + (SPADCALL (SPADCALL |n| |deriv|) |d| + (|getShellEntry| $ 32)) + (SPADCALL |n| (SPADCALL |d| |deriv|) + (|getShellEntry| $ 32)) + (|getShellEntry| $ 33)) + (SPADCALL |d| 2 (|getShellEntry| $ 35)) + (|getShellEntry| $ 15))))))) + +(DEFUN |QFCAT-;convert;AIf;9| (|x| $) + (SPADCALL + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) + (|getShellEntry| $ 38)) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) + (|getShellEntry| $ 38)) + (|getShellEntry| $ 39))) + +(DEFUN |QFCAT-;convert;AF;10| (|x| $) + (SPADCALL + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) + (|getShellEntry| $ 42)) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) + (|getShellEntry| $ 42)) + (|getShellEntry| $ 43))) + +(DEFUN |QFCAT-;convert;ADf;11| (|x| $) + (/ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) + (|getShellEntry| $ 46)) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) + (|getShellEntry| $ 46)))) + +(DEFUN |QFCAT-;<;2AB;12| (|x| |y| $) + (SPADCALL + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) + (SPADCALL |y| (|getShellEntry| $ 11)) (|getShellEntry| $ 32)) + (SPADCALL (SPADCALL |y| (|getShellEntry| $ 8)) + (SPADCALL |x| (|getShellEntry| $ 11)) (|getShellEntry| $ 32)) + (|getShellEntry| $ 49))) + +(DEFUN |QFCAT-;<;2AB;13| (|x| |y| $) + (PROG (|#G19| |#G20| |#G21| |#G22|) + (RETURN + (SEQ (COND + ((SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) + (|spadConstant| $ 51) (|getShellEntry| $ 49)) + (PROGN + (LETT |#G19| |y| |QFCAT-;<;2AB;13|) + (LETT |#G20| |x| |QFCAT-;<;2AB;13|) + (LETT |x| |#G19| |QFCAT-;<;2AB;13|) + (LETT |y| |#G20| |QFCAT-;<;2AB;13|)))) + (COND + ((SPADCALL (SPADCALL |y| (|getShellEntry| $ 11)) + (|spadConstant| $ 51) (|getShellEntry| $ 49)) + (PROGN + (LETT |#G21| |y| |QFCAT-;<;2AB;13|) + (LETT |#G22| |x| |QFCAT-;<;2AB;13|) + (LETT |x| |#G21| |QFCAT-;<;2AB;13|) + (LETT |y| |#G22| |QFCAT-;<;2AB;13|)))) + (EXIT (SPADCALL + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) + (SPADCALL |y| (|getShellEntry| $ 11)) + (|getShellEntry| $ 32)) + (SPADCALL (SPADCALL |y| (|getShellEntry| $ 8)) + (SPADCALL |x| (|getShellEntry| $ 11)) + (|getShellEntry| $ 32)) + (|getShellEntry| $ 49))))))) + +(DEFUN |QFCAT-;<;2AB;14| (|x| |y| $) + (SPADCALL + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) + (SPADCALL |y| (|getShellEntry| $ 11)) (|getShellEntry| $ 32)) + (SPADCALL (SPADCALL |y| (|getShellEntry| $ 8)) + (SPADCALL |x| (|getShellEntry| $ 11)) (|getShellEntry| $ 32)) + (|getShellEntry| $ 49))) + +(DEFUN |QFCAT-;fractionPart;2A;15| (|x| $) + (SPADCALL |x| + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 52)) + (|getShellEntry| $ 9)) + (|getShellEntry| $ 53))) + +(DEFUN |QFCAT-;coerce;SA;16| (|s| $) + (SPADCALL (SPADCALL |s| (|getShellEntry| $ 56)) + (|getShellEntry| $ 9))) + +(DEFUN |QFCAT-;retract;AS;17| (|x| $) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 58)) + (|getShellEntry| $ 59))) + +(DEFUN |QFCAT-;retractIfCan;AU;18| (|x| $) + (PROG (|r|) + (RETURN + (SEQ (LETT |r| (SPADCALL |x| (|getShellEntry| $ 62)) + |QFCAT-;retractIfCan;AU;18|) + (EXIT (COND + ((QEQCAR |r| 1) (CONS 1 "failed")) + ('T (SPADCALL (QCDR |r|) (|getShellEntry| $ 64))))))))) + +(DEFUN |QFCAT-;convert;AP;19| (|x| $) + (SPADCALL + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) + (|getShellEntry| $ 68)) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) + (|getShellEntry| $ 68)) + (|getShellEntry| $ 69))) + +(DEFUN |QFCAT-;patternMatch;AP2Pmr;20| (|x| |p| |l| $) + (SPADCALL |x| |p| |l| (|getShellEntry| $ 73))) + +(DEFUN |QFCAT-;convert;AP;21| (|x| $) + (SPADCALL + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) + (|getShellEntry| $ 77)) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) + (|getShellEntry| $ 77)) + (|getShellEntry| $ 78))) + +(DEFUN |QFCAT-;patternMatch;AP2Pmr;22| (|x| |p| |l| $) + (SPADCALL |x| |p| |l| (|getShellEntry| $ 82))) + +(DEFUN |QFCAT-;coerce;FA;23| (|x| $) + (SPADCALL + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 86)) + (|getShellEntry| $ 87)) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 88)) + (|getShellEntry| $ 87)) + (|getShellEntry| $ 89))) + +(DEFUN |QFCAT-;retract;AI;24| (|x| $) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 58)) + (|getShellEntry| $ 91))) + +(DEFUN |QFCAT-;retractIfCan;AU;25| (|x| $) + (PROG (|u|) + (RETURN + (SEQ (LETT |u| (SPADCALL |x| (|getShellEntry| $ 62)) + |QFCAT-;retractIfCan;AU;25|) + (EXIT (COND + ((QEQCAR |u| 1) (CONS 1 "failed")) + ('T (SPADCALL (QCDR |u|) (|getShellEntry| $ 94))))))))) + +(DEFUN |QFCAT-;random;A;26| ($) + (PROG (|d|) + (RETURN + (SEQ (SEQ G190 + (COND + ((NULL (SPADCALL + (LETT |d| + (SPADCALL (|getShellEntry| $ 96)) + |QFCAT-;random;A;26|) + (|getShellEntry| $ 97))) + (GO G191))) + (SEQ (EXIT |d|)) NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL (SPADCALL (|getShellEntry| $ 96)) |d| + (|getShellEntry| $ 15))))))) + +(DEFUN |QFCAT-;reducedSystem;MVR;27| (|m| |v| $) + (PROG (|n|) + (RETURN + (SEQ (LETT |n| + (SPADCALL + (SPADCALL (SPADCALL |v| (|getShellEntry| $ 100)) + |m| (|getShellEntry| $ 101)) + (|getShellEntry| $ 102)) + |QFCAT-;reducedSystem;MVR;27|) + (EXIT (CONS (SPADCALL |n| + (SPADCALL |n| (|getShellEntry| $ 103)) + (SPADCALL |n| (|getShellEntry| $ 104)) + (+ 1 (SPADCALL |n| (|getShellEntry| $ 105))) + (SPADCALL |n| (|getShellEntry| $ 106)) + (|getShellEntry| $ 107)) + (SPADCALL |n| + (SPADCALL |n| (|getShellEntry| $ 105)) + (|getShellEntry| $ 109)))))))) + +(DEFUN |QuotientFieldCategory&| (|#1| |#2|) + (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) + . #0=(|QuotientFieldCategory&|)) + (LETT |dv$2| (|devaluate| |#2|) . #0#) + (LETT |dv$| + (LIST '|QuotientFieldCategory&| |dv$1| |dv$2|) . #0#) + (LETT $ (|newShell| 120) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#2| + '(|PolynomialFactorizationExplicit|)) + (|HasCategory| |#2| + '(|IntegerNumberSystem|)) + (|HasCategory| |#2| '(|EuclideanDomain|)) + (|HasCategory| |#2| + '(|RetractableTo| (|Symbol|))) + (|HasCategory| |#2| + '(|CharacteristicNonZero|)) + (|HasCategory| |#2| + '(|CharacteristicZero|)) + (|HasCategory| |#2| + '(|ConvertibleTo| (|InputForm|))) + (|HasCategory| |#2| '(|RealConstant|)) + (|HasCategory| |#2| + '(|OrderedIntegralDomain|)) + (|HasCategory| |#2| '(|OrderedSet|)) + (|HasCategory| |#2| + '(|RetractableTo| (|Integer|))) + (|HasCategory| |#2| '(|StepThrough|)))) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + (|setShellEntry| $ 7 |#2|) + (COND + ((|testBitVector| |pv$| 12) + (PROGN + (|setShellEntry| $ 16 + (CONS (|dispatchFunction| |QFCAT-;init;A;3|) $)) + (|setShellEntry| $ 20 + (CONS (|dispatchFunction| |QFCAT-;nextItem;AU;4|) $))))) + (COND + ((|testBitVector| |pv$| 7) + (|setShellEntry| $ 40 + (CONS (|dispatchFunction| |QFCAT-;convert;AIf;9|) $)))) + (COND + ((|testBitVector| |pv$| 8) + (PROGN + (|setShellEntry| $ 44 + (CONS (|dispatchFunction| |QFCAT-;convert;AF;10|) $)) + (|setShellEntry| $ 47 + (CONS (|dispatchFunction| |QFCAT-;convert;ADf;11|) $))))) + (COND + ((|testBitVector| |pv$| 9) + (COND + ((|HasAttribute| |#2| '|canonicalUnitNormal|) + (|setShellEntry| $ 50 + (CONS (|dispatchFunction| |QFCAT-;<;2AB;12|) $))) + ('T + (|setShellEntry| $ 50 + (CONS (|dispatchFunction| |QFCAT-;<;2AB;13|) $))))) + ((|testBitVector| |pv$| 10) + (|setShellEntry| $ 50 + (CONS (|dispatchFunction| |QFCAT-;<;2AB;14|) $)))) + (COND + ((|testBitVector| |pv$| 3) + (|setShellEntry| $ 54 + (CONS (|dispatchFunction| |QFCAT-;fractionPart;2A;15|) + $)))) + (COND + ((|testBitVector| |pv$| 4) + (PROGN + (|setShellEntry| $ 57 + (CONS (|dispatchFunction| |QFCAT-;coerce;SA;16|) $)) + (|setShellEntry| $ 60 + (CONS (|dispatchFunction| |QFCAT-;retract;AS;17|) $)) + (|setShellEntry| $ 65 + (CONS (|dispatchFunction| |QFCAT-;retractIfCan;AU;18|) + $))))) + (COND + ((|HasCategory| |#2| + '(|ConvertibleTo| (|Pattern| (|Integer|)))) + (PROGN + (|setShellEntry| $ 70 + (CONS (|dispatchFunction| |QFCAT-;convert;AP;19|) $)) + (COND + ((|HasCategory| |#2| '(|PatternMatchable| (|Integer|))) + (|setShellEntry| $ 75 + (CONS (|dispatchFunction| + |QFCAT-;patternMatch;AP2Pmr;20|) + $))))))) + (COND + ((|HasCategory| |#2| + '(|ConvertibleTo| (|Pattern| (|Float|)))) + (PROGN + (|setShellEntry| $ 79 + (CONS (|dispatchFunction| |QFCAT-;convert;AP;21|) $)) + (COND + ((|HasCategory| |#2| '(|PatternMatchable| (|Float|))) + (|setShellEntry| $ 84 + (CONS (|dispatchFunction| + |QFCAT-;patternMatch;AP2Pmr;22|) + $))))))) + (COND + ((|testBitVector| |pv$| 11) + (PROGN + (|setShellEntry| $ 90 + (CONS (|dispatchFunction| |QFCAT-;coerce;FA;23|) $)) + (COND + ((|domainEqual| |#2| (|Integer|))) + ('T + (PROGN + (|setShellEntry| $ 92 + (CONS (|dispatchFunction| |QFCAT-;retract;AI;24|) + $)) + (|setShellEntry| $ 95 + (CONS (|dispatchFunction| + |QFCAT-;retractIfCan;AU;25|) + $)))))))) + (COND + ((|testBitVector| |pv$| 2) + (|setShellEntry| $ 98 + (CONS (|dispatchFunction| |QFCAT-;random;A;26|) $)))) + $)))) + +(MAKEPROP '|QuotientFieldCategory&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (0 . |numer|) (5 . |coerce|) |QFCAT-;numerator;2A;1| + (10 . |denom|) |QFCAT-;denominator;2A;2| (15 . |init|) + (19 . |One|) (23 . /) (29 . |init|) (|Union| $ '"failed") + (33 . |nextItem|) (38 . |One|) (42 . |nextItem|) + (|Mapping| 7 7) |QFCAT-;map;M2A;5| (|Matrix| 7) + (|Matrix| 6) (|MatrixCommonDenominator| 7 6) + (47 . |clearDenominator|) (|Matrix| $) + |QFCAT-;reducedSystem;MM;6| (|NonNegativeInteger|) + (52 . |characteristic|) |QFCAT-;characteristic;Nni;7| + (56 . *) (62 . -) (|PositiveInteger|) (68 . **) + |QFCAT-;differentiate;AMA;8| (|InputForm|) + (74 . |convert|) (79 . /) (85 . |convert|) (|Float|) + (90 . |convert|) (95 . /) (101 . |convert|) + (|DoubleFloat|) (106 . |convert|) (111 . |convert|) + (|Boolean|) (116 . <) (122 . <) (128 . |Zero|) + (132 . |wholePart|) (137 . -) (143 . |fractionPart|) + (|Symbol|) (148 . |coerce|) (153 . |coerce|) + (158 . |retract|) (163 . |retract|) (168 . |retract|) + (|Union| 7 '"failed") (173 . |retractIfCan|) + (|Union| 55 '"failed") (178 . |retractIfCan|) + (183 . |retractIfCan|) (|Integer|) (|Pattern| 66) + (188 . |convert|) (193 . /) (199 . |convert|) + (|PatternMatchResult| 66 6) + (|PatternMatchQuotientFieldCategory| 66 7 6) + (204 . |patternMatch|) (|PatternMatchResult| 66 $) + (211 . |patternMatch|) (|Pattern| 41) (218 . |convert|) + (223 . /) (229 . |convert|) (|PatternMatchResult| 41 6) + (|PatternMatchQuotientFieldCategory| 41 7 6) + (234 . |patternMatch|) (|PatternMatchResult| 41 $) + (241 . |patternMatch|) (|Fraction| 66) (248 . |numer|) + (253 . |coerce|) (258 . |denom|) (263 . /) + (269 . |coerce|) (274 . |retract|) (279 . |retract|) + (|Union| 66 '"failed") (284 . |retractIfCan|) + (289 . |retractIfCan|) (294 . |random|) (298 . |zero?|) + (303 . |random|) (|Vector| 6) (307 . |coerce|) + (312 . |horizConcat|) (318 . |reducedSystem|) + (323 . |minRowIndex|) (328 . |maxRowIndex|) + (333 . |minColIndex|) (338 . |maxColIndex|) + (343 . |subMatrix|) (|Vector| 7) (352 . |column|) + (|Record| (|:| |mat| 23) (|:| |vec| 108)) (|Vector| $) + |QFCAT-;reducedSystem;MVR;27| (|Union| 85 '"failed") + (|Matrix| 66) (|Vector| 66) + (|Record| (|:| |mat| 114) (|:| |vec| 115)) (|List| 55) + (|List| 29) (|OutputForm|)) + '#(|retractIfCan| 358 |retract| 368 |reducedSystem| 378 + |random| 389 |patternMatch| 393 |numerator| 407 |nextItem| + 412 |map| 417 |init| 423 |fractionPart| 427 + |differentiate| 432 |denominator| 438 |convert| 443 + |coerce| 468 |characteristic| 478 < 482) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 112 + '(1 6 7 0 8 1 6 0 7 9 1 6 7 0 11 0 7 0 + 13 0 7 0 14 2 6 0 7 7 15 0 0 0 16 1 7 + 17 0 18 0 6 0 19 1 0 17 0 20 1 25 23 + 24 26 0 7 29 30 2 7 0 0 0 32 2 7 0 0 + 0 33 2 7 0 0 34 35 1 7 37 0 38 2 37 0 + 0 0 39 1 0 37 0 40 1 7 41 0 42 2 41 0 + 0 0 43 1 0 41 0 44 1 7 45 0 46 1 0 45 + 0 47 2 7 48 0 0 49 2 0 48 0 0 50 0 7 + 0 51 1 6 7 0 52 2 6 0 0 0 53 1 0 0 0 + 54 1 7 0 55 56 1 0 0 55 57 1 6 7 0 58 + 1 7 55 0 59 1 0 55 0 60 1 6 61 0 62 1 + 7 63 0 64 1 0 63 0 65 1 7 67 0 68 2 + 67 0 0 0 69 1 0 67 0 70 3 72 71 6 67 + 71 73 3 0 74 0 67 74 75 1 7 76 0 77 2 + 76 0 0 0 78 1 0 76 0 79 3 81 80 6 76 + 80 82 3 0 83 0 76 83 84 1 85 66 0 86 + 1 6 0 66 87 1 85 66 0 88 2 6 0 0 0 89 + 1 0 0 85 90 1 7 66 0 91 1 0 66 0 92 1 + 7 93 0 94 1 0 93 0 95 0 7 0 96 1 7 48 + 0 97 0 0 0 98 1 24 0 99 100 2 24 0 0 + 0 101 1 6 23 27 102 1 23 66 0 103 1 + 23 66 0 104 1 23 66 0 105 1 23 66 0 + 106 5 23 0 0 66 66 66 66 107 2 23 108 + 0 66 109 1 0 93 0 95 1 0 63 0 65 1 0 + 66 0 92 1 0 55 0 60 2 0 110 27 111 + 112 1 0 23 27 28 0 0 0 98 3 0 83 0 76 + 83 84 3 0 74 0 67 74 75 1 0 0 0 10 1 + 0 17 0 20 2 0 0 21 0 22 0 0 0 16 1 0 + 0 0 54 2 0 0 0 21 36 1 0 0 0 12 1 0 + 45 0 47 1 0 37 0 40 1 0 41 0 44 1 0 + 67 0 70 1 0 76 0 79 1 0 0 55 57 1 0 0 + 85 90 0 0 29 31 2 0 48 0 0 50))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/QFCAT.lsp b/src/algebra/strap/QFCAT.lsp new file mode 100644 index 00000000..babf745e --- /dev/null +++ b/src/algebra/strap/QFCAT.lsp @@ -0,0 +1,105 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |QuotientFieldCategory;CAT| 'NIL) + +(DEFPARAMETER |QuotientFieldCategory;AL| 'NIL) + +(DEFUN |QuotientFieldCategory| (#0=#:G1388) + (LET (#1=#:G1389) + (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#)))) + +(DEFUN |QuotientFieldCategory;| (|t#1|) + (PROG (#0=#:G1387) + (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#) + (SETELT #0# 0 + (LIST '|QuotientFieldCategory| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/RCAGG-.lsp b/src/algebra/strap/RCAGG-.lsp new file mode 100644 index 00000000..24470798 --- /dev/null +++ b/src/algebra/strap/RCAGG-.lsp @@ -0,0 +1,54 @@ + +(/VERSIONCHECK 2) + +(DEFUN |RCAGG-;elt;AvalueS;1| (|x| T0 $) (SPADCALL |x| (QREFELT $ 8))) + +(DEFUN |RCAGG-;setelt;Avalue2S;2| (|x| T1 |y| $) + (SPADCALL |x| |y| (QREFELT $ 11))) + +(DEFUN |RCAGG-;child?;2AB;3| (|x| |l| $) + (SPADCALL |x| (SPADCALL |l| (QREFELT $ 14)) (QREFELT $ 17))) + +(DEFUN |RecursiveAggregate&| (|#1| |#2|) + (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|RecursiveAggregate&|)) + (LETT |dv$2| (|devaluate| |#2|) . #0#) + (LETT |dv$| (LIST '|RecursiveAggregate&| |dv$1| |dv$2|) . #0#) + (LETT $ (GETREFV 19) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasAttribute| |#1| '|shallowlyMutable|) + (|HasCategory| |#2| '(|SetCategory|)))) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (QSETREFV $ 7 |#2|) + (COND + ((|testBitVector| |pv$| 1) + (QSETREFV $ 12 + (CONS (|dispatchFunction| |RCAGG-;setelt;Avalue2S;2|) $)))) + (COND + ((|testBitVector| |pv$| 2) + (QSETREFV $ 18 + (CONS (|dispatchFunction| |RCAGG-;child?;2AB;3|) $)))) + $)))) + +(MAKEPROP '|RecursiveAggregate&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (0 . |value|) '"value" |RCAGG-;elt;AvalueS;1| + (5 . |setvalue!|) (11 . |setelt|) (|List| $) + (18 . |children|) (|Boolean|) (|List| 6) (23 . |member?|) + (29 . |child?|)) + '#(|setelt| 35 |elt| 42 |child?| 48) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 18 + '(1 6 7 0 8 2 6 7 0 7 11 3 0 7 0 9 7 12 + 1 6 13 0 14 2 16 15 6 0 17 2 0 15 0 0 + 18 3 0 7 0 9 7 12 2 0 7 0 9 10 2 0 15 + 0 0 18))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/RCAGG.lsp b/src/algebra/strap/RCAGG.lsp new file mode 100644 index 00000000..9981da27 --- /dev/null +++ b/src/algebra/strap/RCAGG.lsp @@ -0,0 +1,74 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |RecursiveAggregate;CAT| 'NIL) + +(DEFPARAMETER |RecursiveAggregate;AL| 'NIL) + +(DEFUN |RecursiveAggregate| (#0=#:G1398) + (LET (#1=#:G1399) + (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#)))) + +(DEFUN |RecursiveAggregate;| (|t#1|) + (PROG (#0=#:G1397) + (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#) + (SETELT #0# 0 (LIST '|RecursiveAggregate| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/REF.lsp b/src/algebra/strap/REF.lsp new file mode 100644 index 00000000..ad9f6dd0 --- /dev/null +++ b/src/algebra/strap/REF.lsp @@ -0,0 +1,92 @@ + +(/VERSIONCHECK 2) + +(PUT '|REF;=;2$B;1| '|SPADreplace| 'EQ) + +(DEFUN |REF;=;2$B;1| (|p| |q| $) (EQ |p| |q|)) + +(PUT '|REF;ref;S$;2| '|SPADreplace| 'LIST) + +(DEFUN |REF;ref;S$;2| (|v| $) (LIST |v|)) + +(PUT '|REF;elt;$S;3| '|SPADreplace| 'QCAR) + +(DEFUN |REF;elt;$S;3| (|p| $) (QCAR |p|)) + +(DEFUN |REF;setelt;$2S;4| (|p| |v| $) + (PROGN (RPLACA |p| |v|) (QCAR |p|))) + +(PUT '|REF;deref;$S;5| '|SPADreplace| 'QCAR) + +(DEFUN |REF;deref;$S;5| (|p| $) (QCAR |p|)) + +(DEFUN |REF;setref;$2S;6| (|p| |v| $) + (PROGN (RPLACA |p| |v|) (QCAR |p|))) + +(DEFUN |REF;coerce;$Of;7| (|p| $) + (SPADCALL (SPADCALL "ref" (|getShellEntry| $ 17)) + (LIST (SPADCALL (QCAR |p|) (|getShellEntry| $ 18))) + (|getShellEntry| $ 20))) + +(DEFUN |Reference| (#0=#:G1401) + (PROG () + (RETURN + (PROG (#1=#:G1402) + (RETURN + (COND + ((LETT #1# + (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) + (HGET |$ConstructorCache| '|Reference|) + '|domainEqualList|) + |Reference|) + (|CDRwithIncrement| #1#)) + ('T + (UNWIND-PROTECT + (PROG1 (|Reference;| #0#) (LETT #1# T |Reference|)) + (COND + ((NOT #1#) (HREM |$ConstructorCache| '|Reference|))))))))))) + +(DEFUN |Reference;| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|Reference|)) + (LETT |dv$| (LIST '|Reference| |dv$1|) . #0#) + (LETT $ (|newShell| 23) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#1| '(|SetCategory|)))) . #0#)) + (|haddProp| |$ConstructorCache| '|Reference| (LIST |dv$1|) + (CONS 1 $)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + (|setShellEntry| $ 7 (|Record| (|:| |value| |#1|))) + (COND + ((|testBitVector| |pv$| 1) + (|setShellEntry| $ 21 + (CONS (|dispatchFunction| |REF;coerce;$Of;7|) $)))) + $)))) + +(MAKEPROP '|Reference| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) '|Rep| (|Boolean|) + |REF;=;2$B;1| |REF;ref;S$;2| |REF;elt;$S;3| + |REF;setelt;$2S;4| |REF;deref;$S;5| |REF;setref;$2S;6| + (|String|) (|OutputForm|) (0 . |message|) (5 . |coerce|) + (|List| $) (10 . |prefix|) (16 . |coerce|) + (|SingleInteger|)) + '#(~= 21 |setref| 27 |setelt| 33 |ref| 39 |latex| 44 |hash| + 49 |elt| 54 |deref| 59 |coerce| 64 = 69) + 'NIL + (CONS (|makeByteWordVec2| 1 '(1 0 1 1)) + (CONS '#(|SetCategory&| NIL |BasicType&| NIL) + (CONS '#((|SetCategory|) (|Type|) (|BasicType|) + (|CoercibleTo| 16)) + (|makeByteWordVec2| 22 + '(1 16 0 15 17 1 6 16 0 18 2 16 0 0 19 + 20 1 0 16 0 21 2 1 8 0 0 1 2 0 6 0 6 + 14 2 0 6 0 6 12 1 0 0 6 10 1 1 15 0 1 + 1 1 22 0 1 1 0 6 0 11 1 0 6 0 13 1 1 + 16 0 21 2 0 8 0 0 9))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/RING-.lsp b/src/algebra/strap/RING-.lsp new file mode 100644 index 00000000..31e6daf4 --- /dev/null +++ b/src/algebra/strap/RING-.lsp @@ -0,0 +1,29 @@ + +(/VERSIONCHECK 2) + +(DEFUN |RING-;coerce;IS;1| (|n| $) + (SPADCALL |n| (|spadConstant| $ 7) (QREFELT $ 9))) + +(DEFUN |Ring&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|Ring&|)) + (LETT |dv$| (LIST '|Ring&| |dv$1|) . #0#) + (LETT $ (GETREFV 12) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|Ring&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |One|) + (|Integer|) (4 . *) |RING-;coerce;IS;1| (|OutputForm|)) + '#(|coerce| 10) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 10 + '(0 6 0 7 2 6 0 8 0 9 1 0 0 8 10))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/RING.lsp b/src/algebra/strap/RING.lsp new file mode 100644 index 00000000..47fce84a --- /dev/null +++ b/src/algebra/strap/RING.lsp @@ -0,0 +1,25 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |Ring;AL| 'NIL) + +(DEFUN |Ring| () + (LET (#:G1387) (COND (|Ring;AL|) (T (SETQ |Ring;AL| (|Ring;|)))))) + +(DEFUN |Ring;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# + (|Join| (|Rng|) (|Monoid|) (|LeftModule| '$) + (|mkCategory| '|domain| + '(((|characteristic| + ((|NonNegativeInteger|))) + T) + ((|coerce| ($ (|Integer|))) T)) + '((|unitsKnown| T)) + '((|Integer|) (|NonNegativeInteger|)) + NIL)) + |Ring|) + (SETELT #0# 0 '(|Ring|)))))) + +(MAKEPROP '|Ring| 'NILADIC T) diff --git a/src/algebra/strap/RNG.lsp b/src/algebra/strap/RNG.lsp new file mode 100644 index 00000000..5ba05b81 --- /dev/null +++ b/src/algebra/strap/RNG.lsp @@ -0,0 +1,15 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |Rng;AL| 'NIL) + +(DEFUN |Rng| () + (LET (#:G1387) (COND (|Rng;AL|) (T (SETQ |Rng;AL| (|Rng;|)))))) + +(DEFUN |Rng;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# (|Join| (|AbelianGroup|) (|SemiGroup|)) |Rng|) + (SETELT #0# 0 '(|Rng|)))))) + +(MAKEPROP '|Rng| 'NILADIC T) diff --git a/src/algebra/strap/RNS-.lsp b/src/algebra/strap/RNS-.lsp new file mode 100644 index 00000000..911b8420 --- /dev/null +++ b/src/algebra/strap/RNS-.lsp @@ -0,0 +1,144 @@ + +(/VERSIONCHECK 2) + +(PUT '|RNS-;characteristic;Nni;1| '|SPADreplace| '(XLAM NIL 0)) + +(DEFUN |RNS-;characteristic;Nni;1| ($) 0) + +(DEFUN |RNS-;fractionPart;2S;2| (|x| $) + (SPADCALL |x| (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 10))) + +(DEFUN |RNS-;truncate;2S;3| (|x| $) + (COND + ((SPADCALL |x| (QREFELT $ 13)) + (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT $ 14)) (QREFELT $ 15)) + (QREFELT $ 14))) + ('T (SPADCALL |x| (QREFELT $ 15))))) + +(DEFUN |RNS-;round;2S;4| (|x| $) + (COND + ((SPADCALL |x| (QREFELT $ 13)) + (SPADCALL + (SPADCALL |x| + (SPADCALL (|spadConstant| $ 17) + (SPADCALL 2 (QREFELT $ 19)) (QREFELT $ 20)) + (QREFELT $ 10)) + (QREFELT $ 9))) + ('T + (SPADCALL + (SPADCALL |x| + (SPADCALL (|spadConstant| $ 17) + (SPADCALL 2 (QREFELT $ 19)) (QREFELT $ 20)) + (QREFELT $ 21)) + (QREFELT $ 9))))) + +(DEFUN |RNS-;norm;2S;5| (|x| $) (SPADCALL |x| (QREFELT $ 23))) + +(DEFUN |RNS-;coerce;FS;6| (|x| $) + (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT $ 26)) (QREFELT $ 19)) + (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 19)) + (QREFELT $ 20))) + +(DEFUN |RNS-;convert;SP;7| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 30)) (QREFELT $ 32))) + +(DEFUN |RNS-;floor;2S;8| (|x| $) + (PROG (|x1|) + (RETURN + (SEQ (LETT |x1| + (SPADCALL (SPADCALL |x| (QREFELT $ 34)) + (QREFELT $ 19)) + |RNS-;floor;2S;8|) + (EXIT (COND + ((SPADCALL |x| |x1| (QREFELT $ 35)) |x|) + ((SPADCALL |x| (|spadConstant| $ 36) (QREFELT $ 37)) + (SPADCALL |x1| (|spadConstant| $ 17) + (QREFELT $ 10))) + ('T |x1|))))))) + +(DEFUN |RNS-;ceiling;2S;9| (|x| $) + (PROG (|x1|) + (RETURN + (SEQ (LETT |x1| + (SPADCALL (SPADCALL |x| (QREFELT $ 34)) + (QREFELT $ 19)) + |RNS-;ceiling;2S;9|) + (EXIT (COND + ((SPADCALL |x| |x1| (QREFELT $ 35)) |x|) + ((SPADCALL |x| (|spadConstant| $ 36) (QREFELT $ 37)) + |x1|) + ('T + (SPADCALL |x1| (|spadConstant| $ 17) + (QREFELT $ 21))))))))) + +(DEFUN |RNS-;patternMatch;SP2Pmr;10| (|x| |p| |l| $) + (PROG (|r|) + (RETURN + (SEQ (COND + ((SPADCALL |p| (QREFELT $ 40)) + (SPADCALL |p| |x| |l| (QREFELT $ 42))) + ((SPADCALL |p| (QREFELT $ 43)) + (SEQ (LETT |r| (SPADCALL |p| (QREFELT $ 45)) + |RNS-;patternMatch;SP2Pmr;10|) + (EXIT (COND + ((QEQCAR |r| 0) + (COND + ((SPADCALL (SPADCALL |x| (QREFELT $ 30)) + (QCDR |r|) (QREFELT $ 46)) + |l|) + ('T (SPADCALL (QREFELT $ 47))))) + ('T (SPADCALL (QREFELT $ 47))))))) + ('T (SPADCALL (QREFELT $ 47)))))))) + +(DEFUN |RealNumberSystem&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|RealNumberSystem&|)) + (LETT |dv$| (LIST '|RealNumberSystem&| |dv$1|) . #0#) + (LETT $ (GETREFV 52) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|RealNumberSystem&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) + (|NonNegativeInteger|) |RNS-;characteristic;Nni;1| + (0 . |truncate|) (5 . -) |RNS-;fractionPart;2S;2| + (|Boolean|) (11 . |negative?|) (16 . -) (21 . |floor|) + |RNS-;truncate;2S;3| (26 . |One|) (|Integer|) + (30 . |coerce|) (35 . /) (41 . +) |RNS-;round;2S;4| + (47 . |abs|) |RNS-;norm;2S;5| (|Fraction| 18) + (52 . |numer|) (57 . |denom|) |RNS-;coerce;FS;6| (|Float|) + (62 . |convert|) (|Pattern| 29) (67 . |coerce|) + |RNS-;convert;SP;7| (72 . |wholePart|) (77 . =) + (83 . |Zero|) (87 . <) |RNS-;floor;2S;8| + |RNS-;ceiling;2S;9| (93 . |generic?|) + (|PatternMatchResult| 29 6) (98 . |addMatch|) + (105 . |constant?|) (|Union| 29 '"failed") + (110 . |retractIfCan|) (115 . =) (121 . |failed|) + (|PatternMatchResult| 29 $) |RNS-;patternMatch;SP2Pmr;10| + (|DoubleFloat|) (|OutputForm|)) + '#(|truncate| 125 |round| 130 |patternMatch| 135 |norm| 142 + |fractionPart| 147 |floor| 152 |convert| 157 |coerce| 162 + |characteristic| 172 |ceiling| 176) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 49 + '(1 6 0 0 9 2 6 0 0 0 10 1 6 12 0 13 1 + 6 0 0 14 1 6 0 0 15 0 6 0 17 1 6 0 18 + 19 2 6 0 0 0 20 2 6 0 0 0 21 1 6 0 0 + 23 1 25 18 0 26 1 25 18 0 27 1 6 29 0 + 30 1 31 0 29 32 1 6 18 0 34 2 6 12 0 + 0 35 0 6 0 36 2 6 12 0 0 37 1 31 12 0 + 40 3 41 0 31 6 0 42 1 31 12 0 43 1 31 + 44 0 45 2 29 12 0 0 46 0 41 0 47 1 0 + 0 0 16 1 0 0 0 22 3 0 48 0 31 48 49 1 + 0 0 0 24 1 0 0 0 11 1 0 0 0 38 1 0 31 + 0 33 1 0 0 25 28 1 0 0 25 28 0 0 7 8 + 1 0 0 0 39))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/RNS.lsp b/src/algebra/strap/RNS.lsp new file mode 100644 index 00000000..7955ad3e --- /dev/null +++ b/src/algebra/strap/RNS.lsp @@ -0,0 +1,42 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |RealNumberSystem;AL| 'NIL) + +(DEFUN |RealNumberSystem| () + (LET (#:G1396) + (COND + (|RealNumberSystem;AL|) + (T (SETQ |RealNumberSystem;AL| (|RealNumberSystem;|)))))) + +(DEFUN |RealNumberSystem;| () + (PROG (#0=#:G1394) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(#1=#:G1390 #2=#:G1391 #3=#:G1392 + #4=#:G1393) + (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|) + (SETELT #0# 0 '(|RealNumberSystem|)))))) + +(MAKEPROP '|RealNumberSystem| 'NILADIC T) diff --git a/src/algebra/strap/SETAGG-.lsp b/src/algebra/strap/SETAGG-.lsp new file mode 100644 index 00000000..de45a200 --- /dev/null +++ b/src/algebra/strap/SETAGG-.lsp @@ -0,0 +1,50 @@ + +(/VERSIONCHECK 2) + +(DEFUN |SETAGG-;symmetricDifference;3A;1| (|x| |y| $) + (SPADCALL (SPADCALL |x| |y| (|getShellEntry| $ 8)) + (SPADCALL |y| |x| (|getShellEntry| $ 8)) (|getShellEntry| $ 9))) + +(DEFUN |SETAGG-;union;ASA;2| (|s| |x| $) + (SPADCALL |s| (SPADCALL (LIST |x|) (|getShellEntry| $ 12)) + (|getShellEntry| $ 9))) + +(DEFUN |SETAGG-;union;S2A;3| (|x| |s| $) + (SPADCALL |s| (SPADCALL (LIST |x|) (|getShellEntry| $ 12)) + (|getShellEntry| $ 9))) + +(DEFUN |SETAGG-;difference;ASA;4| (|s| |x| $) + (SPADCALL |s| (SPADCALL (LIST |x|) (|getShellEntry| $ 12)) + (|getShellEntry| $ 8))) + +(DEFUN |SetAggregate&| (|#1| |#2|) + (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|SetAggregate&|)) + (LETT |dv$2| (|devaluate| |#2|) . #0#) + (LETT |dv$| (LIST '|SetAggregate&| |dv$1| |dv$2|) . #0#) + (LETT $ (|newShell| 16) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + (|setShellEntry| $ 7 |#2|) + $)))) + +(MAKEPROP '|SetAggregate&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (0 . |difference|) (6 . |union|) + |SETAGG-;symmetricDifference;3A;1| (|List| 7) + (12 . |brace|) |SETAGG-;union;ASA;2| |SETAGG-;union;S2A;3| + |SETAGG-;difference;ASA;4|) + '#(|union| 17 |symmetricDifference| 29 |difference| 35) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 15 + '(2 6 0 0 0 8 2 6 0 0 0 9 1 6 0 11 12 2 + 0 0 7 0 14 2 0 0 0 7 13 2 0 0 0 0 10 + 2 0 0 0 7 15))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/SETAGG.lsp b/src/algebra/strap/SETAGG.lsp new file mode 100644 index 00000000..e28d5608 --- /dev/null +++ b/src/algebra/strap/SETAGG.lsp @@ -0,0 +1,58 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |SetAggregate;CAT| 'NIL) + +(DEFPARAMETER |SetAggregate;AL| 'NIL) + +(DEFUN |SetAggregate| (#0=#:G1394) + (LET (#1=#:G1395) + (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#)))) + +(DEFUN |SetAggregate;| (|t#1|) + (PROG (#0=#:G1393) + (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#) + (SETELT #0# 0 (LIST '|SetAggregate| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/SETCAT-.lsp b/src/algebra/strap/SETCAT-.lsp new file mode 100644 index 00000000..d4c1987b --- /dev/null +++ b/src/algebra/strap/SETCAT-.lsp @@ -0,0 +1,35 @@ + +(/VERSIONCHECK 2) + +(PUT '|SETCAT-;hash;SSi;1| '|SPADreplace| '(XLAM (|s|) 0)) + +(DEFUN |SETCAT-;hash;SSi;1| (|s| $) 0) + +(PUT '|SETCAT-;latex;SS;2| '|SPADreplace| + '(XLAM (|s|) "\\mbox{\\bf Unimplemented}")) + +(DEFUN |SETCAT-;latex;SS;2| (|s| $) "\\mbox{\\bf Unimplemented}") + +(DEFUN |SetCategory&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|SetCategory&|)) + (LETT |dv$| (LIST '|SetCategory&| |dv$1|) . #0#) + (LETT $ (GETREFV 11) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|SetCategory&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|SingleInteger|) + |SETCAT-;hash;SSi;1| (|String|) |SETCAT-;latex;SS;2|) + '#(|latex| 0 |hash| 5) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 10 + '(1 0 9 0 10 1 0 7 0 8))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/SETCAT.lsp b/src/algebra/strap/SETCAT.lsp new file mode 100644 index 00000000..075d8993 --- /dev/null +++ b/src/algebra/strap/SETCAT.lsp @@ -0,0 +1,27 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |SetCategory;AL| 'NIL) + +(DEFUN |SetCategory| () + (LET (#:G1388) + (COND + (|SetCategory;AL|) + (T (SETQ |SetCategory;AL| (|SetCategory;|)))))) + +(DEFUN |SetCategory;| () + (PROG (#0=#:G1386) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(#1=#:G1385) (LIST '(|OutputForm|))) + (|Join| (|BasicType|) (|CoercibleTo| '#1#) + (|mkCategory| '|domain| + '(((|hash| ((|SingleInteger|) $)) T) + ((|latex| ((|String|) $)) T)) + NIL '((|String|) (|SingleInteger|)) + NIL))) + |SetCategory|) + (SETELT #0# 0 '(|SetCategory|)))))) + +(MAKEPROP '|SetCategory| 'NILADIC T) diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp new file mode 100644 index 00000000..2ad4d6de --- /dev/null +++ b/src/algebra/strap/SINT.lsp @@ -0,0 +1,463 @@ + +(/VERSIONCHECK 2) + +(DEFUN |SINT;writeOMSingleInt| (|dev| |x| $) + (SEQ (COND + ((QSLESSP |x| 0) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 9)) + (SPADCALL |dev| "arith1" "unaryminus" + (|getShellEntry| $ 11)) + (SPADCALL |dev| (QSMINUS |x|) (|getShellEntry| $ 13)) + (EXIT (SPADCALL |dev| (|getShellEntry| $ 14))))) + ('T (SPADCALL |dev| |x| (|getShellEntry| $ 13)))))) + +(DEFUN |SINT;OMwrite;$S;2| (|x| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |SINT;OMwrite;$S;2|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SINT;OMwrite;$S;2|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 16)) + (|getShellEntry| $ 17)) + |SINT;OMwrite;$S;2|) + (SPADCALL |dev| (|getShellEntry| $ 18)) + (|SINT;writeOMSingleInt| |dev| |x| $) + (SPADCALL |dev| (|getShellEntry| $ 19)) + (SPADCALL |dev| (|getShellEntry| $ 20)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |SINT;OMwrite;$S;2|) + (EXIT |s|))))) + +(DEFUN |SINT;OMwrite;$BS;3| (|x| |wholeObj| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |SINT;OMwrite;$BS;3|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SINT;OMwrite;$BS;3|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 16)) + (|getShellEntry| $ 17)) + |SINT;OMwrite;$BS;3|) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 18)))) + (|SINT;writeOMSingleInt| |dev| |x| $) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 19)))) + (SPADCALL |dev| (|getShellEntry| $ 20)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |SINT;OMwrite;$BS;3|) + (EXIT |s|))))) + +(DEFUN |SINT;OMwrite;Omd$V;4| (|dev| |x| $) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 18)) + (|SINT;writeOMSingleInt| |dev| |x| $) + (EXIT (SPADCALL |dev| (|getShellEntry| $ 19))))) + +(DEFUN |SINT;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 18)))) + (|SINT;writeOMSingleInt| |dev| |x| $) + (EXIT (COND + (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 19))))))) + +(PUT '|SINT;reducedSystem;MM;6| '|SPADreplace| '(XLAM (|m|) |m|)) + +(DEFUN |SINT;reducedSystem;MM;6| (|m| $) |m|) + +(DEFUN |SINT;coerce;$Of;7| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 30))) + +(PUT '|SINT;convert;$I;8| '|SPADreplace| '(XLAM (|x|) |x|)) + +(DEFUN |SINT;convert;$I;8| (|x| $) |x|) + +(DEFUN |SINT;*;I2$;9| (|i| |y| $) + (QSTIMES (SPADCALL |i| (|getShellEntry| $ 33)) |y|)) + +(PUT '|SINT;Zero;$;10| '|SPADreplace| '(XLAM NIL 0)) + +(DEFUN |SINT;Zero;$;10| ($) 0) + +(PUT '|SINT;One;$;11| '|SPADreplace| '(XLAM NIL 1)) + +(DEFUN |SINT;One;$;11| ($) 1) + +(PUT '|SINT;base;$;12| '|SPADreplace| '(XLAM NIL 2)) + +(DEFUN |SINT;base;$;12| ($) 2) + +(PUT '|SINT;max;$;13| '|SPADreplace| '(XLAM NIL MOST-POSITIVE-FIXNUM)) + +(DEFUN |SINT;max;$;13| ($) MOST-POSITIVE-FIXNUM) + +(PUT '|SINT;min;$;14| '|SPADreplace| '(XLAM NIL MOST-NEGATIVE-FIXNUM)) + +(DEFUN |SINT;min;$;14| ($) MOST-NEGATIVE-FIXNUM) + +(PUT '|SINT;=;2$B;15| '|SPADreplace| 'EQL) + +(DEFUN |SINT;=;2$B;15| (|x| |y| $) (EQL |x| |y|)) + +(PUT '|SINT;~;2$;16| '|SPADreplace| 'LOGNOT) + +(DEFUN |SINT;~;2$;16| (|x| $) (LOGNOT |x|)) + +(PUT '|SINT;not;2$;17| '|SPADreplace| 'LOGNOT) + +(DEFUN |SINT;not;2$;17| (|x| $) (LOGNOT |x|)) + +(PUT '|SINT;/\\;3$;18| '|SPADreplace| 'LOGAND) + +(DEFUN |SINT;/\\;3$;18| (|x| |y| $) (LOGAND |x| |y|)) + +(PUT '|SINT;\\/;3$;19| '|SPADreplace| 'LOGIOR) + +(DEFUN |SINT;\\/;3$;19| (|x| |y| $) (LOGIOR |x| |y|)) + +(PUT '|SINT;Not;2$;20| '|SPADreplace| 'LOGNOT) + +(DEFUN |SINT;Not;2$;20| (|x| $) (LOGNOT |x|)) + +(PUT '|SINT;And;3$;21| '|SPADreplace| 'LOGAND) + +(DEFUN |SINT;And;3$;21| (|x| |y| $) (LOGAND |x| |y|)) + +(PUT '|SINT;Or;3$;22| '|SPADreplace| 'LOGIOR) + +(DEFUN |SINT;Or;3$;22| (|x| |y| $) (LOGIOR |x| |y|)) + +(PUT '|SINT;xor;3$;23| '|SPADreplace| 'LOGXOR) + +(DEFUN |SINT;xor;3$;23| (|x| |y| $) (LOGXOR |x| |y|)) + +(PUT '|SINT;<;2$B;24| '|SPADreplace| 'QSLESSP) + +(DEFUN |SINT;<;2$B;24| (|x| |y| $) (QSLESSP |x| |y|)) + +(PUT '|SINT;inc;2$;25| '|SPADreplace| 'QSADD1) + +(DEFUN |SINT;inc;2$;25| (|x| $) (QSADD1 |x|)) + +(PUT '|SINT;dec;2$;26| '|SPADreplace| 'QSSUB1) + +(DEFUN |SINT;dec;2$;26| (|x| $) (QSSUB1 |x|)) + +(PUT '|SINT;-;2$;27| '|SPADreplace| 'QSMINUS) + +(DEFUN |SINT;-;2$;27| (|x| $) (QSMINUS |x|)) + +(PUT '|SINT;+;3$;28| '|SPADreplace| 'QSPLUS) + +(DEFUN |SINT;+;3$;28| (|x| |y| $) (QSPLUS |x| |y|)) + +(PUT '|SINT;-;3$;29| '|SPADreplace| 'QSDIFFERENCE) + +(DEFUN |SINT;-;3$;29| (|x| |y| $) (QSDIFFERENCE |x| |y|)) + +(PUT '|SINT;*;3$;30| '|SPADreplace| 'QSTIMES) + +(DEFUN |SINT;*;3$;30| (|x| |y| $) (QSTIMES |x| |y|)) + +(DEFUN |SINT;**;$Nni$;31| (|x| |n| $) + (SPADCALL (EXPT |x| |n|) (|getShellEntry| $ 33))) + +(PUT '|SINT;quo;3$;32| '|SPADreplace| 'QSQUOTIENT) + +(DEFUN |SINT;quo;3$;32| (|x| |y| $) (QSQUOTIENT |x| |y|)) + +(PUT '|SINT;rem;3$;33| '|SPADreplace| 'QSREMAINDER) + +(DEFUN |SINT;rem;3$;33| (|x| |y| $) (QSREMAINDER |x| |y|)) + +(DEFUN |SINT;divide;2$R;34| (|x| |y| $) + (CONS (QSQUOTIENT |x| |y|) (QSREMAINDER |x| |y|))) + +(PUT '|SINT;gcd;3$;35| '|SPADreplace| 'GCD) + +(DEFUN |SINT;gcd;3$;35| (|x| |y| $) (GCD |x| |y|)) + +(PUT '|SINT;abs;2$;36| '|SPADreplace| 'QSABSVAL) + +(DEFUN |SINT;abs;2$;36| (|x| $) (QSABSVAL |x|)) + +(PUT '|SINT;odd?;$B;37| '|SPADreplace| 'QSODDP) + +(DEFUN |SINT;odd?;$B;37| (|x| $) (QSODDP |x|)) + +(PUT '|SINT;zero?;$B;38| '|SPADreplace| 'QSZEROP) + +(DEFUN |SINT;zero?;$B;38| (|x| $) (QSZEROP |x|)) + +(PUT '|SINT;one?;$B;39| '|SPADreplace| '(XLAM (|x|) (EQL |x| 1))) + +(DEFUN |SINT;one?;$B;39| (|x| $) (EQL |x| 1)) + +(PUT '|SINT;max;3$;40| '|SPADreplace| 'QSMAX) + +(DEFUN |SINT;max;3$;40| (|x| |y| $) (QSMAX |x| |y|)) + +(PUT '|SINT;min;3$;41| '|SPADreplace| 'QSMIN) + +(DEFUN |SINT;min;3$;41| (|x| |y| $) (QSMIN |x| |y|)) + +(PUT '|SINT;hash;2$;42| '|SPADreplace| 'HASHEQ) + +(DEFUN |SINT;hash;2$;42| (|x| $) (HASHEQ |x|)) + +(PUT '|SINT;length;2$;43| '|SPADreplace| 'INTEGER-LENGTH) + +(DEFUN |SINT;length;2$;43| (|x| $) (INTEGER-LENGTH |x|)) + +(PUT '|SINT;shift;3$;44| '|SPADreplace| 'QSLEFTSHIFT) + +(DEFUN |SINT;shift;3$;44| (|x| |n| $) (QSLEFTSHIFT |x| |n|)) + +(PUT '|SINT;mulmod;4$;45| '|SPADreplace| 'QSMULTMOD) + +(DEFUN |SINT;mulmod;4$;45| (|a| |b| |p| $) (QSMULTMOD |a| |b| |p|)) + +(PUT '|SINT;addmod;4$;46| '|SPADreplace| 'QSADDMOD) + +(DEFUN |SINT;addmod;4$;46| (|a| |b| |p| $) (QSADDMOD |a| |b| |p|)) + +(PUT '|SINT;submod;4$;47| '|SPADreplace| 'QSDIFMOD) + +(DEFUN |SINT;submod;4$;47| (|a| |b| |p| $) (QSDIFMOD |a| |b| |p|)) + +(PUT '|SINT;negative?;$B;48| '|SPADreplace| 'QSMINUSP) + +(DEFUN |SINT;negative?;$B;48| (|x| $) (QSMINUSP |x|)) + +(PUT '|SINT;reducedSystem;MVR;49| '|SPADreplace| 'CONS) + +(DEFUN |SINT;reducedSystem;MVR;49| (|m| |v| $) (CONS |m| |v|)) + +(DEFUN |SINT;positiveRemainder;3$;50| (|x| |n| $) + (PROG (|r|) + (RETURN + (SEQ (LETT |r| (QSREMAINDER |x| |n|) + |SINT;positiveRemainder;3$;50|) + (EXIT (COND + ((QSMINUSP |r|) + (COND + ((QSMINUSP |n|) (QSDIFFERENCE |x| |n|)) + ('T (QSPLUS |r| |n|)))) + ('T |r|))))))) + +(DEFUN |SINT;coerce;I$;51| (|x| $) + (SEQ (COND + ((NULL (< MOST-POSITIVE-FIXNUM |x|)) + (COND ((NULL (< |x| MOST-NEGATIVE-FIXNUM)) (EXIT |x|))))) + (EXIT (|error| "integer too large to represent in a machine word")))) + +(DEFUN |SINT;random;$;52| ($) + (SEQ (SETELT $ 6 + (REMAINDER (TIMES 314159269 (|getShellEntry| $ 6)) + 2147483647)) + (EXIT (REMAINDER (|getShellEntry| $ 6) 67108864)))) + +(PUT '|SINT;random;2$;53| '|SPADreplace| 'RANDOM) + +(DEFUN |SINT;random;2$;53| (|n| $) (RANDOM |n|)) + +(DEFUN |SINT;unitNormal;$R;54| (|x| $) + (COND + ((QSLESSP |x| 0) (VECTOR -1 (QSMINUS |x|) -1)) + ('T (VECTOR 1 |x| 1)))) + +(DEFUN |SingleInteger| () + (PROG () + (RETURN + (PROG (#0=#:G1486) + (RETURN + (COND + ((LETT #0# (HGET |$ConstructorCache| '|SingleInteger|) + |SingleInteger|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|SingleInteger| + (LIST + (CONS NIL + (CONS 1 (|SingleInteger;|)))))) + (LETT #0# T |SingleInteger|)) + (COND + ((NOT #0#) + (HREM |$ConstructorCache| '|SingleInteger|))))))))))) + +(DEFUN |SingleInteger;| () + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| '(|SingleInteger|) . #0=(|SingleInteger|)) + (LETT $ (|newShell| 105) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| '|SingleInteger| NIL + (CONS 1 $)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 1) + $)))) + +(MAKEPROP '|SingleInteger| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL '|seed| (|Void|) + (|OpenMathDevice|) (0 . |OMputApp|) (|String|) + (5 . |OMputSymbol|) (|Integer|) (12 . |OMputInteger|) + (18 . |OMputEndApp|) (|OpenMathEncoding|) + (23 . |OMencodingXML|) (27 . |OMopenString|) + (33 . |OMputObject|) (38 . |OMputEndObject|) + (43 . |OMclose|) |SINT;OMwrite;$S;2| (|Boolean|) + |SINT;OMwrite;$BS;3| |SINT;OMwrite;Omd$V;4| + |SINT;OMwrite;Omd$BV;5| (|Matrix| 12) (|Matrix| $) + |SINT;reducedSystem;MM;6| (|OutputForm|) (48 . |coerce|) + |SINT;coerce;$Of;7| |SINT;convert;$I;8| (53 . |coerce|) + |SINT;*;I2$;9| + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |SINT;Zero;$;10|) $)) + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |SINT;One;$;11|) $)) + |SINT;base;$;12| |SINT;max;$;13| |SINT;min;$;14| + |SINT;=;2$B;15| |SINT;~;2$;16| |SINT;not;2$;17| + |SINT;/\\;3$;18| |SINT;\\/;3$;19| |SINT;Not;2$;20| + |SINT;And;3$;21| |SINT;Or;3$;22| |SINT;xor;3$;23| + |SINT;<;2$B;24| |SINT;inc;2$;25| |SINT;dec;2$;26| + |SINT;-;2$;27| |SINT;+;3$;28| |SINT;-;3$;29| + |SINT;*;3$;30| (|NonNegativeInteger|) |SINT;**;$Nni$;31| + |SINT;quo;3$;32| |SINT;rem;3$;33| + (|Record| (|:| |quotient| $) (|:| |remainder| $)) + |SINT;divide;2$R;34| |SINT;gcd;3$;35| |SINT;abs;2$;36| + |SINT;odd?;$B;37| |SINT;zero?;$B;38| |SINT;one?;$B;39| + |SINT;max;3$;40| |SINT;min;3$;41| |SINT;hash;2$;42| + |SINT;length;2$;43| |SINT;shift;3$;44| |SINT;mulmod;4$;45| + |SINT;addmod;4$;46| |SINT;submod;4$;47| + |SINT;negative?;$B;48| (|Vector| 12) + (|Record| (|:| |mat| 26) (|:| |vec| 76)) (|Vector| $) + |SINT;reducedSystem;MVR;49| |SINT;positiveRemainder;3$;50| + |SINT;coerce;I$;51| |SINT;random;$;52| |SINT;random;2$;53| + (|Record| (|:| |unit| $) (|:| |canonical| $) + (|:| |associate| $)) + |SINT;unitNormal;$R;54| (|Fraction| 12) + (|Union| 86 '"failed") (|Union| $ '"failed") (|Float|) + (|DoubleFloat|) (|Pattern| 12) (|PatternMatchResult| 12 $) + (|InputForm|) (|Union| 12 '"failed") (|List| $) + (|Record| (|:| |coef| 95) (|:| |generator| $)) + (|Union| 95 '"failed") + (|Record| (|:| |coef1| $) (|:| |coef2| $) + (|:| |generator| $)) + (|Record| (|:| |coef1| $) (|:| |coef2| $)) + (|Union| 99 '"failed") (|Factored| $) + (|SparseUnivariatePolynomial| $) (|PositiveInteger|) + (|SingleInteger|)) + '#(~= 58 ~ 64 |zero?| 69 |xor| 74 |unitNormal| 80 + |unitCanonical| 85 |unit?| 90 |symmetricRemainder| 95 + |subtractIfCan| 101 |submod| 107 |squareFreePart| 114 + |squareFree| 119 |sizeLess?| 124 |sign| 130 |shift| 135 + |sample| 141 |retractIfCan| 145 |retract| 150 |rem| 155 + |reducedSystem| 161 |recip| 172 |rationalIfCan| 177 + |rational?| 182 |rational| 187 |random| 192 |quo| 201 + |principalIdeal| 207 |prime?| 212 |powmod| 217 + |positiveRemainder| 224 |positive?| 230 |permutation| 235 + |patternMatch| 241 |one?| 248 |odd?| 253 |not| 258 + |nextItem| 263 |negative?| 268 |multiEuclidean| 273 + |mulmod| 279 |min| 286 |max| 296 |mask| 306 |length| 311 + |lcm| 316 |latex| 327 |invmod| 332 |init| 338 |inc| 342 + |hash| 347 |gcdPolynomial| 357 |gcd| 363 |factorial| 374 + |factor| 379 |extendedEuclidean| 384 |exquo| 397 + |expressIdealMember| 403 |even?| 409 |euclideanSize| 414 + |divide| 419 |differentiate| 425 |dec| 436 |copy| 441 + |convert| 446 |coerce| 471 |characteristic| 491 |bit?| 495 + |binomial| 501 |base| 507 |associates?| 511 |addmod| 517 + |abs| 524 ^ 529 |\\/| 541 |Zero| 547 |Or| 551 |One| 557 + |OMwrite| 561 |Not| 585 D 590 |And| 601 >= 607 > 613 = 619 + <= 625 < 631 |/\\| 637 - 643 + 654 ** 660 * 672) + '((|noetherian| . 0) (|canonicalsClosed| . 0) + (|canonical| . 0) (|canonicalUnitNormal| . 0) + (|multiplicativeValuation| . 0) (|noZeroDivisors| . 0) + ((|commutative| "*") . 0) (|rightUnitary| . 0) + (|leftUnitary| . 0) (|unitsKnown| . 0)) + (CONS (|makeByteWordVec2| 1 + '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)) + (CONS '#(|IntegerNumberSystem&| |EuclideanDomain&| + |UniqueFactorizationDomain&| NIL NIL + |GcdDomain&| |IntegralDomain&| |Algebra&| NIL + NIL |DifferentialRing&| |OrderedRing&| NIL NIL + |Module&| NIL NIL |Ring&| NIL NIL NIL NIL NIL + |AbelianGroup&| NIL NIL |AbelianMonoid&| + |Monoid&| NIL NIL |OrderedSet&| + |AbelianSemiGroup&| |SemiGroup&| |Logic&| NIL + |SetCategory&| NIL NIL NIL NIL NIL NIL + |RetractableTo&| NIL |BasicType&| NIL) + (CONS '#((|IntegerNumberSystem|) + (|EuclideanDomain|) + (|UniqueFactorizationDomain|) + (|PrincipalIdealDomain|) + (|OrderedIntegralDomain|) (|GcdDomain|) + (|IntegralDomain|) (|Algebra| $$) + (|CharacteristicZero|) + (|LinearlyExplicitRingOver| 12) + (|DifferentialRing|) (|OrderedRing|) + (|CommutativeRing|) (|EntireRing|) + (|Module| $$) (|OrderedAbelianGroup|) + (|BiModule| $$ $$) (|Ring|) + (|OrderedCancellationAbelianMonoid|) + (|LeftModule| $$) (|Rng|) + (|RightModule| $$) + (|OrderedAbelianMonoid|) + (|AbelianGroup|) + (|OrderedAbelianSemiGroup|) + (|CancellationAbelianMonoid|) + (|AbelianMonoid|) (|Monoid|) + (|StepThrough|) (|PatternMatchable| 12) + (|OrderedSet|) (|AbelianSemiGroup|) + (|SemiGroup|) (|Logic|) (|RealConstant|) + (|SetCategory|) (|OpenMath|) + (|ConvertibleTo| 89) + (|ConvertibleTo| 90) + (|CombinatorialFunctionCategory|) + (|ConvertibleTo| 91) + (|ConvertibleTo| 93) + (|RetractableTo| 12) + (|ConvertibleTo| 12) (|BasicType|) + (|CoercibleTo| 29)) + (|makeByteWordVec2| 104 + '(1 8 7 0 9 3 8 7 0 10 10 11 2 8 7 0 12 + 13 1 8 7 0 14 0 15 0 16 2 8 0 10 15 + 17 1 8 7 0 18 1 8 7 0 19 1 8 7 0 20 1 + 12 29 0 30 1 0 0 12 33 2 0 22 0 0 1 1 + 0 0 0 41 1 0 22 0 65 2 0 0 0 0 48 1 0 + 84 0 85 1 0 0 0 1 1 0 22 0 1 2 0 0 0 + 0 1 2 0 88 0 0 1 3 0 0 0 0 0 74 1 0 0 + 0 1 1 0 101 0 1 2 0 22 0 0 1 1 0 12 0 + 1 2 0 0 0 0 71 0 0 0 1 1 0 94 0 1 1 0 + 12 0 1 2 0 0 0 0 59 1 0 26 27 28 2 0 + 77 27 78 79 1 0 88 0 1 1 0 87 0 1 1 0 + 22 0 1 1 0 86 0 1 1 0 0 0 83 0 0 0 82 + 2 0 0 0 0 58 1 0 96 95 1 1 0 22 0 1 3 + 0 0 0 0 0 1 2 0 0 0 0 80 1 0 22 0 1 2 + 0 0 0 0 1 3 0 92 0 91 92 1 1 0 22 0 + 66 1 0 22 0 64 1 0 0 0 42 1 0 88 0 1 + 1 0 22 0 75 2 0 97 95 0 1 3 0 0 0 0 0 + 72 0 0 0 39 2 0 0 0 0 68 0 0 0 38 2 0 + 0 0 0 67 1 0 0 0 1 1 0 0 0 70 1 0 0 + 95 1 2 0 0 0 0 1 1 0 10 0 1 2 0 0 0 0 + 1 0 0 0 1 1 0 0 0 50 1 0 0 0 69 1 0 + 104 0 1 2 0 102 102 102 1 1 0 0 95 1 + 2 0 0 0 0 62 1 0 0 0 1 1 0 101 0 1 2 + 0 98 0 0 1 3 0 100 0 0 0 1 2 0 88 0 0 + 1 2 0 97 95 0 1 1 0 22 0 1 1 0 56 0 1 + 2 0 60 0 0 61 1 0 0 0 1 2 0 0 0 56 1 + 1 0 0 0 51 1 0 0 0 1 1 0 89 0 1 1 0 + 90 0 1 1 0 91 0 1 1 0 93 0 1 1 0 12 0 + 32 1 0 0 12 81 1 0 0 0 1 1 0 0 12 81 + 1 0 29 0 31 0 0 56 1 2 0 22 0 0 1 2 0 + 0 0 0 1 0 0 0 37 2 0 22 0 0 1 3 0 0 0 + 0 0 73 1 0 0 0 63 2 0 0 0 56 1 2 0 0 + 0 103 1 2 0 0 0 0 44 0 0 0 35 2 0 0 0 + 0 47 0 0 0 36 3 0 7 8 0 22 25 2 0 10 + 0 22 23 2 0 7 8 0 24 1 0 10 0 21 1 0 + 0 0 45 1 0 0 0 1 2 0 0 0 56 1 2 0 0 0 + 0 46 2 0 22 0 0 1 2 0 22 0 0 1 2 0 22 + 0 0 40 2 0 22 0 0 1 2 0 22 0 0 49 2 0 + 0 0 0 43 1 0 0 0 52 2 0 0 0 0 54 2 0 + 0 0 0 53 2 0 0 0 56 57 2 0 0 0 103 1 + 2 0 0 0 0 55 2 0 0 12 0 34 2 0 0 56 0 + 1 2 0 0 103 0 1))))) + '|lookupComplete|)) + +(MAKEPROP '|SingleInteger| 'NILADIC T) diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp new file mode 100644 index 00000000..4b967563 --- /dev/null +++ b/src/algebra/strap/STAGG-.lsp @@ -0,0 +1,297 @@ + +(/VERSIONCHECK 2) + +(DEFUN |STAGG-;explicitlyFinite?;AB;1| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 10))) + +(DEFUN |STAGG-;possiblyInfinite?;AB;2| (|x| $) + (SPADCALL |x| (QREFELT $ 9))) + +(DEFUN |STAGG-;first;ANniA;3| (|x| |n| $) + (PROG (#0=#:G1411 |i|) + (RETURN + (SEQ (SPADCALL + (PROGN + (LETT #0# NIL |STAGG-;first;ANniA;3|) + (SEQ (LETT |i| 1 |STAGG-;first;ANniA;3|) G190 + (COND ((QSGREATERP |i| |n|) (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (|STAGG-;c2| |x| + (LETT |x| + (SPADCALL |x| (QREFELT $ 13)) + |STAGG-;first;ANniA;3|) + $) + #0#) + |STAGG-;first;ANniA;3|))) + (LETT |i| (QSADD1 |i|) |STAGG-;first;ANniA;3|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + (QREFELT $ 15)))))) + +(DEFUN |STAGG-;c2| (|x| |r| $) + (COND + ((SPADCALL |x| (QREFELT $ 18)) (|error| "Index out of range")) + ('T (SPADCALL |x| (QREFELT $ 19))))) + +(DEFUN |STAGG-;elt;AIS;5| (|x| |i| $) + (PROG (#0=#:G1414) + (RETURN + (SEQ (LETT |i| (- |i| (SPADCALL |x| (QREFELT $ 21))) + |STAGG-;elt;AIS;5|) + (COND + ((OR (< |i| 0) + (SPADCALL + (LETT |x| + (SPADCALL |x| + (PROG1 (LETT #0# |i| + |STAGG-;elt;AIS;5|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 22)) + |STAGG-;elt;AIS;5|) + (QREFELT $ 18))) + (EXIT (|error| "index out of range")))) + (EXIT (SPADCALL |x| (QREFELT $ 19))))))) + +(DEFUN |STAGG-;elt;AUsA;6| (|x| |i| $) + (PROG (|l| #0=#:G1418 |h| #1=#:G1420 #2=#:G1421) + (RETURN + (SEQ (LETT |l| + (- (SPADCALL |i| (QREFELT $ 25)) + (SPADCALL |x| (QREFELT $ 21))) + |STAGG-;elt;AUsA;6|) + (EXIT (COND + ((< |l| 0) (|error| "index out of range")) + ((NULL (SPADCALL |i| (QREFELT $ 26))) + (SPADCALL + (SPADCALL |x| + (PROG1 (LETT #0# |l| |STAGG-;elt;AUsA;6|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 22)) + (QREFELT $ 27))) + ('T + (SEQ (LETT |h| + (- (SPADCALL |i| (QREFELT $ 28)) + (SPADCALL |x| (QREFELT $ 21))) + |STAGG-;elt;AUsA;6|) + (EXIT (COND + ((< |h| |l|) + (SPADCALL (QREFELT $ 29))) + ('T + (SPADCALL + (SPADCALL |x| + (PROG1 + (LETT #1# |l| + |STAGG-;elt;AUsA;6|) + (|check-subtype| (>= #1# 0) + '(|NonNegativeInteger|) #1#)) + (QREFELT $ 22)) + (PROG1 + (LETT #2# (+ (- |h| |l|) 1) + |STAGG-;elt;AUsA;6|) + (|check-subtype| (>= #2# 0) + '(|NonNegativeInteger|) #2#)) + (QREFELT $ 30))))))))))))) + +(DEFUN |STAGG-;concat;3A;7| (|x| |y| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 27)) |y| (QREFELT $ 32))) + +(DEFUN |STAGG-;concat;LA;8| (|l| $) + (COND + ((NULL |l|) (SPADCALL (QREFELT $ 29))) + ('T + (SPADCALL (SPADCALL (|SPADfirst| |l|) (QREFELT $ 27)) + (SPADCALL (CDR |l|) (QREFELT $ 35)) (QREFELT $ 32))))) + +(DEFUN |STAGG-;map!;M2A;9| (|f| |l| $) + (PROG (|y|) + (RETURN + (SEQ (LETT |y| |l| |STAGG-;map!;M2A;9|) + (SEQ G190 + (COND + ((NULL (SPADCALL (SPADCALL |l| (QREFELT $ 18)) + (QREFELT $ 10))) + (GO G191))) + (SEQ (SPADCALL |l| + (SPADCALL (SPADCALL |l| (QREFELT $ 19)) |f|) + (QREFELT $ 37)) + (EXIT (LETT |l| (SPADCALL |l| (QREFELT $ 13)) + |STAGG-;map!;M2A;9|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |y|))))) + +(DEFUN |STAGG-;fill!;ASA;10| (|x| |s| $) + (PROG (|y|) + (RETURN + (SEQ (LETT |y| |x| |STAGG-;fill!;ASA;10|) + (SEQ G190 + (COND + ((NULL (SPADCALL (SPADCALL |y| (QREFELT $ 18)) + (QREFELT $ 10))) + (GO G191))) + (SEQ (SPADCALL |y| |s| (QREFELT $ 37)) + (EXIT (LETT |y| (SPADCALL |y| (QREFELT $ 13)) + |STAGG-;fill!;ASA;10|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |x|))))) + +(DEFUN |STAGG-;setelt;AI2S;11| (|x| |i| |s| $) + (PROG (#0=#:G1437) + (RETURN + (SEQ (LETT |i| (- |i| (SPADCALL |x| (QREFELT $ 21))) + |STAGG-;setelt;AI2S;11|) + (COND + ((OR (< |i| 0) + (SPADCALL + (LETT |x| + (SPADCALL |x| + (PROG1 (LETT #0# |i| + |STAGG-;setelt;AI2S;11|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 22)) + |STAGG-;setelt;AI2S;11|) + (QREFELT $ 18))) + (EXIT (|error| "index out of range")))) + (EXIT (SPADCALL |x| |s| (QREFELT $ 37))))))) + +(DEFUN |STAGG-;setelt;AUs2S;12| (|x| |i| |s| $) + (PROG (|l| |h| #0=#:G1442 #1=#:G1443 |z| |y|) + (RETURN + (SEQ (LETT |l| + (- (SPADCALL |i| (QREFELT $ 25)) + (SPADCALL |x| (QREFELT $ 21))) + |STAGG-;setelt;AUs2S;12|) + (EXIT (COND + ((< |l| 0) (|error| "index out of range")) + ('T + (SEQ (LETT |h| + (COND + ((SPADCALL |i| (QREFELT $ 26)) + (- (SPADCALL |i| (QREFELT $ 28)) + (SPADCALL |x| (QREFELT $ 21)))) + ('T (SPADCALL |x| (QREFELT $ 42)))) + |STAGG-;setelt;AUs2S;12|) + (EXIT (COND + ((< |h| |l|) |s|) + ('T + (SEQ (LETT |y| + (SPADCALL |x| + (PROG1 + (LETT #0# |l| + |STAGG-;setelt;AUs2S;12|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) + #0#)) + (QREFELT $ 22)) + |STAGG-;setelt;AUs2S;12|) + (LETT |z| + (SPADCALL |y| + (PROG1 + (LETT #1# (+ (- |h| |l|) 1) + |STAGG-;setelt;AUs2S;12|) + (|check-subtype| (>= #1# 0) + '(|NonNegativeInteger|) + #1#)) + (QREFELT $ 22)) + |STAGG-;setelt;AUs2S;12|) + (SEQ G190 + (COND + ((NULL + (SPADCALL + (SPADCALL |y| |z| + (QREFELT $ 43)) + (QREFELT $ 10))) + (GO G191))) + (SEQ + (SPADCALL |y| |s| + (QREFELT $ 37)) + (EXIT + (LETT |y| + (SPADCALL |y| + (QREFELT $ 13)) + |STAGG-;setelt;AUs2S;12|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |s|))))))))))))) + +(DEFUN |STAGG-;concat!;3A;13| (|x| |y| $) + (SEQ (COND + ((SPADCALL |x| (QREFELT $ 18)) |y|) + ('T + (SEQ (SPADCALL (SPADCALL |x| (QREFELT $ 45)) |y| + (QREFELT $ 46)) + (EXIT |x|)))))) + +(DEFUN |StreamAggregate&| (|#1| |#2|) + (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|StreamAggregate&|)) + (LETT |dv$2| (|devaluate| |#2|) . #0#) + (LETT |dv$| (LIST '|StreamAggregate&| |dv$1| |dv$2|) . #0#) + (LETT $ (GETREFV 52) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (QSETREFV $ 7 |#2|) + (COND + ((|HasAttribute| |#1| '|shallowlyMutable|) + (PROGN + (QSETREFV $ 33 + (CONS (|dispatchFunction| |STAGG-;concat;3A;7|) $)) + (QSETREFV $ 36 + (CONS (|dispatchFunction| |STAGG-;concat;LA;8|) $)) + (QSETREFV $ 39 + (CONS (|dispatchFunction| |STAGG-;map!;M2A;9|) $)) + (QSETREFV $ 40 + (CONS (|dispatchFunction| |STAGG-;fill!;ASA;10|) $)) + (QSETREFV $ 41 + (CONS (|dispatchFunction| |STAGG-;setelt;AI2S;11|) $)) + (QSETREFV $ 44 + (CONS (|dispatchFunction| |STAGG-;setelt;AUs2S;12|) $)) + (QSETREFV $ 47 + (CONS (|dispatchFunction| |STAGG-;concat!;3A;13|) $))))) + $)))) + +(MAKEPROP '|StreamAggregate&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|Boolean|) (0 . |cyclic?|) (5 . |not|) + |STAGG-;explicitlyFinite?;AB;1| + |STAGG-;possiblyInfinite?;AB;2| (10 . |rest|) (|List| 7) + (15 . |construct|) (|NonNegativeInteger|) + |STAGG-;first;ANniA;3| (20 . |empty?|) (25 . |first|) + (|Integer|) (30 . |minIndex|) (35 . |rest|) + |STAGG-;elt;AIS;5| (|UniversalSegment| 20) (41 . |lo|) + (46 . |hasHi|) (51 . |copy|) (56 . |hi|) (61 . |empty|) + (65 . |first|) |STAGG-;elt;AUsA;6| (71 . |concat!|) + (77 . |concat|) (|List| $) (83 . |concat|) (88 . |concat|) + (93 . |setfirst!|) (|Mapping| 7 7) (99 . |map!|) + (105 . |fill!|) (111 . |setelt|) (118 . |maxIndex|) + (123 . |eq?|) (129 . |setelt|) (136 . |tail|) + (141 . |setrest!|) (147 . |concat!|) '"rest" '"last" + '"first" '"value") + '#(|setelt| 153 |possiblyInfinite?| 167 |map!| 172 |first| + 178 |fill!| 184 |explicitlyFinite?| 190 |elt| 195 + |concat!| 207 |concat| 213) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 47 + '(1 6 8 0 9 1 8 0 0 10 1 6 0 0 13 1 6 0 + 14 15 1 6 8 0 18 1 6 7 0 19 1 6 20 0 + 21 2 6 0 0 16 22 1 24 20 0 25 1 24 8 + 0 26 1 6 0 0 27 1 24 20 0 28 0 6 0 29 + 2 6 0 0 16 30 2 6 0 0 0 32 2 0 0 0 0 + 33 1 6 0 34 35 1 0 0 34 36 2 6 7 0 7 + 37 2 0 0 38 0 39 2 0 0 0 7 40 3 0 7 0 + 20 7 41 1 6 20 0 42 2 6 8 0 0 43 3 0 + 7 0 24 7 44 1 6 0 0 45 2 6 0 0 0 46 2 + 0 0 0 0 47 3 0 7 0 20 7 41 3 0 7 0 24 + 7 44 1 0 8 0 12 2 0 0 38 0 39 2 0 0 0 + 16 17 2 0 0 0 7 40 1 0 8 0 11 2 0 7 0 + 20 23 2 0 0 0 24 31 2 0 0 0 0 47 1 0 + 0 34 36 2 0 0 0 0 33))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/STAGG.lsp b/src/algebra/strap/STAGG.lsp new file mode 100644 index 00000000..95a087cb --- /dev/null +++ b/src/algebra/strap/STAGG.lsp @@ -0,0 +1,41 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |StreamAggregate;CAT| 'NIL) + +(DEFPARAMETER |StreamAggregate;AL| 'NIL) + +(DEFUN |StreamAggregate| (#0=#:G1405) + (LET (#1=#:G1406) + (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#)))) + +(DEFUN |StreamAggregate;| (|t#1|) + (PROG (#0=#:G1404) + (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#) + (SETELT #0# 0 (LIST '|StreamAggregate| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp new file mode 100644 index 00000000..82291964 --- /dev/null +++ b/src/algebra/strap/SYMBOL.lsp @@ -0,0 +1,816 @@ + +(/VERSIONCHECK 2) + +(DEFUN |SYMBOL;writeOMSym| (|dev| |x| $) + (COND + ((SPADCALL |x| (|getShellEntry| $ 22)) + (|error| "Cannot convert a scripted symbol to OpenMath")) + ('T (SPADCALL |dev| |x| (|getShellEntry| $ 26))))) + +(DEFUN |SYMBOL;OMwrite;$S;2| (|x| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |SYMBOL;OMwrite;$S;2|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SYMBOL;OMwrite;$S;2|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 28)) + (|getShellEntry| $ 29)) + |SYMBOL;OMwrite;$S;2|) + (SPADCALL |dev| (|getShellEntry| $ 30)) + (|SYMBOL;writeOMSym| |dev| |x| $) + (SPADCALL |dev| (|getShellEntry| $ 31)) + (SPADCALL |dev| (|getShellEntry| $ 32)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |SYMBOL;OMwrite;$S;2|) + (EXIT |s|))))) + +(DEFUN |SYMBOL;OMwrite;$BS;3| (|x| |wholeObj| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |SYMBOL;OMwrite;$BS;3|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) + |SYMBOL;OMwrite;$BS;3|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 28)) + (|getShellEntry| $ 29)) + |SYMBOL;OMwrite;$BS;3|) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 30)))) + (|SYMBOL;writeOMSym| |dev| |x| $) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 31)))) + (SPADCALL |dev| (|getShellEntry| $ 32)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) + |SYMBOL;OMwrite;$BS;3|) + (EXIT |s|))))) + +(DEFUN |SYMBOL;OMwrite;Omd$V;4| (|dev| |x| $) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 30)) + (|SYMBOL;writeOMSym| |dev| |x| $) + (EXIT (SPADCALL |dev| (|getShellEntry| $ 31))))) + +(DEFUN |SYMBOL;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 30)))) + (|SYMBOL;writeOMSym| |dev| |x| $) + (EXIT (COND + (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 31))))))) + +(DEFUN |SYMBOL;convert;$If;6| (|s| $) + (SPADCALL |s| (|getShellEntry| $ 45))) + +(PUT '|SYMBOL;convert;$S;7| '|SPADreplace| '(XLAM (|s|) |s|)) + +(DEFUN |SYMBOL;convert;$S;7| (|s| $) |s|) + +(DEFUN |SYMBOL;coerce;S$;8| (|s| $) (VALUES (INTERN |s|))) + +(PUT '|SYMBOL;=;2$B;9| '|SPADreplace| 'EQUAL) + +(DEFUN |SYMBOL;=;2$B;9| (|x| |y| $) (EQUAL |x| |y|)) + +(PUT '|SYMBOL;<;2$B;10| '|SPADreplace| + '(XLAM (|x| |y|) (GGREATERP |y| |x|))) + +(DEFUN |SYMBOL;<;2$B;10| (|x| |y| $) (GGREATERP |y| |x|)) + +(DEFUN |SYMBOL;coerce;$Of;11| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 52))) + +(DEFUN |SYMBOL;subscript;$L$;12| (|sy| |lx| $) + (SPADCALL |sy| (LIST |lx| NIL NIL NIL NIL) (|getShellEntry| $ 56))) + +(DEFUN |SYMBOL;elt;$L$;13| (|sy| |lx| $) + (SPADCALL |sy| |lx| (|getShellEntry| $ 57))) + +(DEFUN |SYMBOL;superscript;$L$;14| (|sy| |lx| $) + (SPADCALL |sy| (LIST NIL |lx| NIL NIL NIL) (|getShellEntry| $ 56))) + +(DEFUN |SYMBOL;argscript;$L$;15| (|sy| |lx| $) + (SPADCALL |sy| (LIST NIL NIL NIL NIL |lx|) (|getShellEntry| $ 56))) + +(DEFUN |SYMBOL;patternMatch;$P2Pmr;16| (|x| |p| |l| $) + (SPADCALL |x| |p| |l| (|getShellEntry| $ 64))) + +(DEFUN |SYMBOL;patternMatch;$P2Pmr;17| (|x| |p| |l| $) + (SPADCALL |x| |p| |l| (|getShellEntry| $ 71))) + +(DEFUN |SYMBOL;convert;$P;18| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 74))) + +(DEFUN |SYMBOL;convert;$P;19| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 76))) + +(DEFUN |SYMBOL;syprefix| (|sc| $) + (PROG (|ns| #0=#:G1449 |n| #1=#:G1450) + (RETURN + (SEQ (LETT |ns| + (LIST (LENGTH (QVELT |sc| 3)) (LENGTH (QVELT |sc| 2)) + (LENGTH (QVELT |sc| 1)) (LENGTH (QVELT |sc| 0))) + |SYMBOL;syprefix|) + (SEQ G190 + (COND + ((NULL (COND + ((< (LENGTH |ns|) 2) 'NIL) + ('T (ZEROP (|SPADfirst| |ns|))))) + (GO G191))) + (SEQ (EXIT (LETT |ns| (CDR |ns|) |SYMBOL;syprefix|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL + (CONS (STRCONC (|getShellEntry| $ 37) + (|SYMBOL;istring| + (LENGTH (QVELT |sc| 4)) $)) + (PROGN + (LETT #0# NIL |SYMBOL;syprefix|) + (SEQ (LETT |n| NIL |SYMBOL;syprefix|) + (LETT #1# (NREVERSE |ns|) + |SYMBOL;syprefix|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |n| (CAR #1#) + |SYMBOL;syprefix|) + NIL)) + (GO G191))) + (SEQ (EXIT + (LETT #0# + (CONS (|SYMBOL;istring| |n| $) + #0#) + |SYMBOL;syprefix|))) + (LETT #1# (CDR #1#) + |SYMBOL;syprefix|) + (GO G190) G191 + (EXIT (NREVERSE0 #0#))))) + (|getShellEntry| $ 79))))))) + +(DEFUN |SYMBOL;syscripts| (|sc| $) + (PROG (|all|) + (RETURN + (SEQ (LETT |all| (QVELT |sc| 3) |SYMBOL;syscripts|) + (LETT |all| + (SPADCALL (QVELT |sc| 2) |all| (|getShellEntry| $ 80)) + |SYMBOL;syscripts|) + (LETT |all| + (SPADCALL (QVELT |sc| 1) |all| (|getShellEntry| $ 80)) + |SYMBOL;syscripts|) + (LETT |all| + (SPADCALL (QVELT |sc| 0) |all| (|getShellEntry| $ 80)) + |SYMBOL;syscripts|) + (EXIT (SPADCALL |all| (QVELT |sc| 4) (|getShellEntry| $ 80))))))) + +(DEFUN |SYMBOL;script;$L$;22| (|sy| |ls| $) + (PROG (|sc|) + (RETURN + (SEQ (LETT |sc| (VECTOR NIL NIL NIL NIL NIL) + |SYMBOL;script;$L$;22|) + (COND + ((NULL (NULL |ls|)) + (SEQ (QSETVELT |sc| 0 (|SPADfirst| |ls|)) + (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) + (COND + ((NULL (NULL |ls|)) + (SEQ (QSETVELT |sc| 1 (|SPADfirst| |ls|)) + (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) + (COND + ((NULL (NULL |ls|)) + (SEQ (QSETVELT |sc| 2 (|SPADfirst| |ls|)) + (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) + (COND + ((NULL (NULL |ls|)) + (SEQ (QSETVELT |sc| 3 (|SPADfirst| |ls|)) + (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) + (COND + ((NULL (NULL |ls|)) + (SEQ (QSETVELT |sc| 4 (|SPADfirst| |ls|)) + (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) + (EXIT (SPADCALL |sy| |sc| (|getShellEntry| $ 82))))))) + +(DEFUN |SYMBOL;script;$R$;23| (|sy| |sc| $) + (COND + ((SPADCALL |sy| (|getShellEntry| $ 22)) + (|error| "Cannot add scripts to a scripted symbol")) + ('T + (CONS (SPADCALL + (SPADCALL + (STRCONC (|SYMBOL;syprefix| |sc| $) + (SPADCALL + (SPADCALL |sy| (|getShellEntry| $ 83)) + (|getShellEntry| $ 84))) + (|getShellEntry| $ 48)) + (|getShellEntry| $ 53)) + (|SYMBOL;syscripts| |sc| $))))) + +(DEFUN |SYMBOL;string;$S;24| (|e| $) + (COND + ((NULL (SPADCALL |e| (|getShellEntry| $ 22))) (PNAME |e|)) + ('T (|error| "Cannot form string from non-atomic symbols.")))) + +(DEFUN |SYMBOL;latex;$S;25| (|e| $) + (PROG (|ss| |lo| |sc| |s|) + (RETURN + (SEQ (LETT |s| (PNAME (SPADCALL |e| (|getShellEntry| $ 83))) + |SYMBOL;latex;$S;25|) + (COND + ((< 1 (QCSIZE |s|)) + (COND + ((SPADCALL (SPADCALL |s| 1 (|getShellEntry| $ 85)) + (SPADCALL "\\" (|getShellEntry| $ 40)) + (|getShellEntry| $ 86)) + (LETT |s| (STRCONC "\\mbox{\\it " (STRCONC |s| "}")) + |SYMBOL;latex;$S;25|))))) + (COND + ((NULL (SPADCALL |e| (|getShellEntry| $ 22))) (EXIT |s|))) + (LETT |ss| (SPADCALL |e| (|getShellEntry| $ 87)) + |SYMBOL;latex;$S;25|) + (LETT |lo| (QVELT |ss| 0) |SYMBOL;latex;$S;25|) + (COND + ((NULL (NULL |lo|)) + (SEQ (LETT |sc| "_{" |SYMBOL;latex;$S;25|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lo|) + (|getShellEntry| $ 88))) + (GO G191))) + (SEQ (LETT |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 89))) + |SYMBOL;latex;$S;25|) + (LETT |lo| (CDR |lo|) + |SYMBOL;latex;$S;25|) + (EXIT (COND + ((NULL (NULL |lo|)) + (LETT |sc| (STRCONC |sc| ", ") + |SYMBOL;latex;$S;25|))))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) + (EXIT (LETT |s| (STRCONC |s| |sc|) + |SYMBOL;latex;$S;25|))))) + (LETT |lo| (QVELT |ss| 1) |SYMBOL;latex;$S;25|) + (COND + ((NULL (NULL |lo|)) + (SEQ (LETT |sc| "^{" |SYMBOL;latex;$S;25|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lo|) + (|getShellEntry| $ 88))) + (GO G191))) + (SEQ (LETT |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 89))) + |SYMBOL;latex;$S;25|) + (LETT |lo| (CDR |lo|) + |SYMBOL;latex;$S;25|) + (EXIT (COND + ((NULL (NULL |lo|)) + (LETT |sc| (STRCONC |sc| ", ") + |SYMBOL;latex;$S;25|))))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) + (EXIT (LETT |s| (STRCONC |s| |sc|) + |SYMBOL;latex;$S;25|))))) + (LETT |lo| (QVELT |ss| 2) |SYMBOL;latex;$S;25|) + (COND + ((NULL (NULL |lo|)) + (SEQ (LETT |sc| "{}^{" |SYMBOL;latex;$S;25|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lo|) + (|getShellEntry| $ 88))) + (GO G191))) + (SEQ (LETT |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 89))) + |SYMBOL;latex;$S;25|) + (LETT |lo| (CDR |lo|) + |SYMBOL;latex;$S;25|) + (EXIT (COND + ((NULL (NULL |lo|)) + (LETT |sc| (STRCONC |sc| ", ") + |SYMBOL;latex;$S;25|))))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) + (EXIT (LETT |s| (STRCONC |sc| |s|) + |SYMBOL;latex;$S;25|))))) + (LETT |lo| (QVELT |ss| 3) |SYMBOL;latex;$S;25|) + (COND + ((NULL (NULL |lo|)) + (SEQ (LETT |sc| "{}_{" |SYMBOL;latex;$S;25|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lo|) + (|getShellEntry| $ 88))) + (GO G191))) + (SEQ (LETT |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 89))) + |SYMBOL;latex;$S;25|) + (LETT |lo| (CDR |lo|) + |SYMBOL;latex;$S;25|) + (EXIT (COND + ((NULL (NULL |lo|)) + (LETT |sc| (STRCONC |sc| ", ") + |SYMBOL;latex;$S;25|))))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) + (EXIT (LETT |s| (STRCONC |sc| |s|) + |SYMBOL;latex;$S;25|))))) + (LETT |lo| (QVELT |ss| 4) |SYMBOL;latex;$S;25|) + (COND + ((NULL (NULL |lo|)) + (SEQ (LETT |sc| "\\left( {" |SYMBOL;latex;$S;25|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lo|) + (|getShellEntry| $ 88))) + (GO G191))) + (SEQ (LETT |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 89))) + |SYMBOL;latex;$S;25|) + (LETT |lo| (CDR |lo|) + |SYMBOL;latex;$S;25|) + (EXIT (COND + ((NULL (NULL |lo|)) + (LETT |sc| (STRCONC |sc| ", ") + |SYMBOL;latex;$S;25|))))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |sc| (STRCONC |sc| "} \\right)") + |SYMBOL;latex;$S;25|) + (EXIT (LETT |s| (STRCONC |s| |sc|) + |SYMBOL;latex;$S;25|))))) + (EXIT |s|))))) + +(DEFUN |SYMBOL;anyRadix| (|n| |s| $) + (PROG (|qr| |ns| #0=#:G1500) + (RETURN + (SEQ (EXIT (SEQ (LETT |ns| "" |SYMBOL;anyRadix|) + (EXIT (SEQ G190 NIL + (SEQ (LETT |qr| + (DIVIDE2 |n| (QCSIZE |s|)) + |SYMBOL;anyRadix|) + (LETT |n| (QCAR |qr|) + |SYMBOL;anyRadix|) + (LETT |ns| + (SPADCALL + (SPADCALL |s| + (+ (QCDR |qr|) + (SPADCALL |s| + (|getShellEntry| $ 91))) + (|getShellEntry| $ 85)) + |ns| (|getShellEntry| $ 92)) + |SYMBOL;anyRadix|) + (EXIT + (COND + ((ZEROP |n|) + (PROGN + (LETT #0# |ns| + |SYMBOL;anyRadix|) + (GO #0#)))))) + NIL (GO G190) G191 (EXIT NIL))))) + #0# (EXIT #0#))))) + +(DEFUN |SYMBOL;new;$;27| ($) + (PROG (|sym|) + (RETURN + (SEQ (LETT |sym| + (|SYMBOL;anyRadix| + (SPADCALL (|getShellEntry| $ 9) + (|getShellEntry| $ 93)) + (|getShellEntry| $ 19) $) + |SYMBOL;new;$;27|) + (SPADCALL (|getShellEntry| $ 9) + (+ (SPADCALL (|getShellEntry| $ 9) + (|getShellEntry| $ 93)) + 1) + (|getShellEntry| $ 94)) + (EXIT (SPADCALL (STRCONC "%" |sym|) (|getShellEntry| $ 48))))))) + +(DEFUN |SYMBOL;new;2$;28| (|x| $) + (PROG (|u| |n| |xx|) + (RETURN + (SEQ (LETT |n| + (SEQ (LETT |u| + (SPADCALL |x| (|getShellEntry| $ 12) + (|getShellEntry| $ 97)) + |SYMBOL;new;2$;28|) + (EXIT (COND + ((QEQCAR |u| 1) 0) + ('T (+ (QCDR |u|) 1))))) + |SYMBOL;new;2$;28|) + (SPADCALL (|getShellEntry| $ 12) |x| |n| + (|getShellEntry| $ 98)) + (LETT |xx| + (COND + ((NULL (SPADCALL |x| (|getShellEntry| $ 22))) + (SPADCALL |x| (|getShellEntry| $ 84))) + ('T + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 83)) + (|getShellEntry| $ 84)))) + |SYMBOL;new;2$;28|) + (LETT |xx| (STRCONC "%" |xx|) |SYMBOL;new;2$;28|) + (LETT |xx| + (COND + ((NULL (< (SPADCALL + (SPADCALL |xx| + (SPADCALL |xx| + (|getShellEntry| $ 99)) + (|getShellEntry| $ 85)) + (|getShellEntry| $ 18) + (|getShellEntry| $ 100)) + (SPADCALL (|getShellEntry| $ 18) + (|getShellEntry| $ 91)))) + (STRCONC |xx| + (|SYMBOL;anyRadix| |n| + (|getShellEntry| $ 20) $))) + ('T + (STRCONC |xx| + (|SYMBOL;anyRadix| |n| + (|getShellEntry| $ 18) $)))) + |SYMBOL;new;2$;28|) + (COND + ((NULL (SPADCALL |x| (|getShellEntry| $ 22))) + (EXIT (SPADCALL |xx| (|getShellEntry| $ 48))))) + (EXIT (SPADCALL (SPADCALL |xx| (|getShellEntry| $ 48)) + (SPADCALL |x| (|getShellEntry| $ 87)) + (|getShellEntry| $ 82))))))) + +(DEFUN |SYMBOL;resetNew;V;29| ($) + (PROG (|k| #0=#:G1523) + (RETURN + (SEQ (SPADCALL (|getShellEntry| $ 9) 0 (|getShellEntry| $ 94)) + (SEQ (LETT |k| NIL |SYMBOL;resetNew;V;29|) + (LETT #0# + (SPADCALL (|getShellEntry| $ 12) + (|getShellEntry| $ 103)) + |SYMBOL;resetNew;V;29|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |k| (CAR #0#) |SYMBOL;resetNew;V;29|) + NIL)) + (GO G191))) + (SEQ (EXIT (SPADCALL |k| (|getShellEntry| $ 12) + (|getShellEntry| $ 104)))) + (LETT #0# (CDR #0#) |SYMBOL;resetNew;V;29|) (GO G190) + G191 (EXIT NIL)) + (EXIT (SPADCALL (|getShellEntry| $ 105))))))) + +(DEFUN |SYMBOL;scripted?;$B;30| (|sy| $) + (SPADCALL (ATOM |sy|) (|getShellEntry| $ 88))) + +(DEFUN |SYMBOL;name;2$;31| (|sy| $) + (PROG (|str| |i| #0=#:G1530 #1=#:G1529 #2=#:G1527) + (RETURN + (SEQ (EXIT (COND + ((NULL (SPADCALL |sy| (|getShellEntry| $ 22))) |sy|) + ('T + (SEQ (LETT |str| + (SPADCALL + (SPADCALL + (SPADCALL |sy| + (|getShellEntry| $ 107)) + (|getShellEntry| $ 108)) + (|getShellEntry| $ 84)) + |SYMBOL;name;2$;31|) + (SEQ (EXIT (SEQ + (LETT |i| + (+ (|getShellEntry| $ 38) 1) + |SYMBOL;name;2$;31|) + (LETT #0# (QCSIZE |str|) + |SYMBOL;name;2$;31|) + G190 + (COND ((> |i| #0#) (GO G191))) + (SEQ + (EXIT + (COND + ((NULL + (SPADCALL + (SPADCALL |str| |i| + (|getShellEntry| $ 85)) + (|getShellEntry| $ 109))) + (PROGN + (LETT #2# + (PROGN + (LETT #1# + (SPADCALL + (SPADCALL |str| + (SPADCALL |i| + (QCSIZE |str|) + (|getShellEntry| $ + 111)) + (|getShellEntry| $ + 112)) + (|getShellEntry| $ 48)) + |SYMBOL;name;2$;31|) + (GO #1#)) + |SYMBOL;name;2$;31|) + (GO #2#)))))) + (LETT |i| (+ |i| 1) + |SYMBOL;name;2$;31|) + (GO G190) G191 (EXIT NIL))) + #2# (EXIT #2#)) + (EXIT (|error| "Improper scripted symbol")))))) + #1# (EXIT #1#))))) + +(DEFUN |SYMBOL;scripts;$R;32| (|sy| $) + (PROG (|lscripts| |str| |nstr| |j| #0=#:G1533 |nscripts| |m| |n| + #1=#:G1542 |i| #2=#:G1543 |a| #3=#:G1544 |allscripts|) + (RETURN + (SEQ (COND + ((NULL (SPADCALL |sy| (|getShellEntry| $ 22))) + (VECTOR NIL NIL NIL NIL NIL)) + ('T + (SEQ (LETT |nscripts| (LIST 0 0 0 0 0) + |SYMBOL;scripts;$R;32|) + (LETT |lscripts| (LIST NIL NIL NIL NIL NIL) + |SYMBOL;scripts;$R;32|) + (LETT |str| + (SPADCALL + (SPADCALL + (SPADCALL |sy| + (|getShellEntry| $ 107)) + (|getShellEntry| $ 108)) + (|getShellEntry| $ 84)) + |SYMBOL;scripts;$R;32|) + (LETT |nstr| (QCSIZE |str|) |SYMBOL;scripts;$R;32|) + (LETT |m| + (SPADCALL |nscripts| (|getShellEntry| $ 114)) + |SYMBOL;scripts;$R;32|) + (SEQ (LETT |j| (+ (|getShellEntry| $ 38) 1) + |SYMBOL;scripts;$R;32|) + (LETT |i| |m| |SYMBOL;scripts;$R;32|) G190 + (COND + ((OR (> |j| |nstr|) + (NULL (SPADCALL + (SPADCALL |str| |j| + (|getShellEntry| $ 85)) + (|getShellEntry| $ 109)))) + (GO G191))) + (SEQ (EXIT (SPADCALL |nscripts| |i| + (PROG1 + (LETT #0# + (- + (SPADCALL + (SPADCALL |str| |j| + (|getShellEntry| $ 85)) + (|getShellEntry| $ 42)) + (|getShellEntry| $ 43)) + |SYMBOL;scripts;$R;32|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 115)))) + (LETT |i| + (PROG1 (+ |i| 1) + (LETT |j| (+ |j| 1) + |SYMBOL;scripts;$R;32|)) + |SYMBOL;scripts;$R;32|) + (GO G190) G191 (EXIT NIL)) + (LETT |nscripts| + (SPADCALL (CDR |nscripts|) + (|SPADfirst| |nscripts|) + (|getShellEntry| $ 116)) + |SYMBOL;scripts;$R;32|) + (LETT |allscripts| + (SPADCALL + (SPADCALL |sy| (|getShellEntry| $ 107)) + (|getShellEntry| $ 117)) + |SYMBOL;scripts;$R;32|) + (LETT |m| + (SPADCALL |lscripts| (|getShellEntry| $ 118)) + |SYMBOL;scripts;$R;32|) + (SEQ (LETT |n| NIL |SYMBOL;scripts;$R;32|) + (LETT #1# |nscripts| |SYMBOL;scripts;$R;32|) + (LETT |i| |m| |SYMBOL;scripts;$R;32|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |n| (CAR #1#) + |SYMBOL;scripts;$R;32|) + NIL)) + (GO G191))) + (SEQ (EXIT (COND + ((< + (SPADCALL |allscripts| + (|getShellEntry| $ 119)) + |n|) + (|error| + "Improper script count in symbol")) + ('T + (SEQ + (SPADCALL |lscripts| |i| + (PROGN + (LETT #2# NIL + |SYMBOL;scripts;$R;32|) + (SEQ + (LETT |a| NIL + |SYMBOL;scripts;$R;32|) + (LETT #3# + (SPADCALL |allscripts| |n| + (|getShellEntry| $ 120)) + |SYMBOL;scripts;$R;32|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |a| (CAR #3#) + |SYMBOL;scripts;$R;32|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #2# + (CONS + (SPADCALL |a| + (|getShellEntry| $ 53)) + #2#) + |SYMBOL;scripts;$R;32|))) + (LETT #3# (CDR #3#) + |SYMBOL;scripts;$R;32|) + (GO G190) G191 + (EXIT (NREVERSE0 #2#)))) + (|getShellEntry| $ 121)) + (EXIT + (LETT |allscripts| + (SPADCALL |allscripts| |n| + (|getShellEntry| $ 122)) + |SYMBOL;scripts;$R;32|))))))) + (LETT |i| + (PROG1 (+ |i| 1) + (LETT #1# (CDR #1#) + |SYMBOL;scripts;$R;32|)) + |SYMBOL;scripts;$R;32|) + (GO G190) G191 (EXIT NIL)) + (EXIT (VECTOR (SPADCALL |lscripts| |m| + (|getShellEntry| $ 123)) + (SPADCALL |lscripts| (+ |m| 1) + (|getShellEntry| $ 123)) + (SPADCALL |lscripts| (+ |m| 2) + (|getShellEntry| $ 123)) + (SPADCALL |lscripts| (+ |m| 3) + (|getShellEntry| $ 123)) + (SPADCALL |lscripts| (+ |m| 4) + (|getShellEntry| $ 123))))))))))) + +(DEFUN |SYMBOL;istring| (|n| $) + (COND + ((< 9 |n|) (|error| "Can have at most 9 scripts of each kind")) + ('T (ELT (|getShellEntry| $ 17) (+ |n| 0))))) + +(DEFUN |SYMBOL;list;$L;34| (|sy| $) + (COND + ((NULL (SPADCALL |sy| (|getShellEntry| $ 22))) + (|error| "Cannot convert a symbol to a list if it is not subscripted")) + ('T |sy|))) + +(DEFUN |SYMBOL;sample;$;35| ($) + (SPADCALL "aSymbol" (|getShellEntry| $ 48))) + +(DEFUN |Symbol| () + (PROG () + (RETURN + (PROG (#0=#:G1551) + (RETURN + (COND + ((LETT #0# (HGET |$ConstructorCache| '|Symbol|) |Symbol|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Symbol| + (LIST + (CONS NIL (CONS 1 (|Symbol;|)))))) + (LETT #0# T |Symbol|)) + (COND ((NOT #0#) (HREM |$ConstructorCache| '|Symbol|))))))))))) + +(DEFUN |Symbol;| () + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| '(|Symbol|) . #0=(|Symbol|)) + (LETT $ (|newShell| 126) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| '|Symbol| NIL (CONS 1 $)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 9 (SPADCALL 0 (|getShellEntry| $ 8))) + (|setShellEntry| $ 12 (SPADCALL (|getShellEntry| $ 11))) + (|setShellEntry| $ 17 + (SPADCALL (LIST "0" "1" "2" "3" "4" "5" "6" "7" "8" "9") + (|getShellEntry| $ 16))) + (|setShellEntry| $ 18 "0123456789") + (|setShellEntry| $ 19 "ABCDEFGHIJKLMNOPQRSTUVWXYZ") + (|setShellEntry| $ 20 "abcdefghijklmnopqrstuvwxyz") + (|setShellEntry| $ 37 "*") + (|setShellEntry| $ 38 (QCSIZE (|getShellEntry| $ 37))) + (|setShellEntry| $ 43 + (SPADCALL (SPADCALL "0" (|getShellEntry| $ 40)) + (|getShellEntry| $ 42))) + $)))) + +(MAKEPROP '|Symbol| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|Integer|) (|Reference| 6) + (0 . |ref|) '|count| (|AssociationList| $$ 6) + (5 . |empty|) '|xcount| (|String|) (|List| 13) + (|PrimitiveArray| 13) (9 . |construct|) '|istrings| + '|nums| 'ALPHAS '|alphas| (|Boolean|) + |SYMBOL;scripted?;$B;30| (|Void|) (|Symbol|) + (|OpenMathDevice|) (14 . |OMputVariable|) + (|OpenMathEncoding|) (20 . |OMencodingXML|) + (24 . |OMopenString|) (30 . |OMputObject|) + (35 . |OMputEndObject|) (40 . |OMclose|) + |SYMBOL;OMwrite;$S;2| |SYMBOL;OMwrite;$BS;3| + |SYMBOL;OMwrite;Omd$V;4| |SYMBOL;OMwrite;Omd$BV;5| '|hd| + '|lhd| (|Character|) (45 . |char|) (|NonNegativeInteger|) + (50 . |ord|) '|ord0| (|InputForm|) (55 . |convert|) + |SYMBOL;convert;$If;6| |SYMBOL;convert;$S;7| + |SYMBOL;coerce;S$;8| |SYMBOL;=;2$B;9| |SYMBOL;<;2$B;10| + (|OutputForm|) (60 . |outputForm|) |SYMBOL;coerce;$Of;11| + (|List| 51) (|List| 54) |SYMBOL;script;$L$;22| + |SYMBOL;subscript;$L$;12| |SYMBOL;elt;$L$;13| + |SYMBOL;superscript;$L$;14| |SYMBOL;argscript;$L$;15| + (|PatternMatchResult| 6 24) (|Pattern| 6) + (|PatternMatchSymbol| 6) (65 . |patternMatch|) + (|PatternMatchResult| 6 $) |SYMBOL;patternMatch;$P2Pmr;16| + (|Float|) (|PatternMatchResult| 67 24) (|Pattern| 67) + (|PatternMatchSymbol| 67) (72 . |patternMatch|) + (|PatternMatchResult| 67 $) + |SYMBOL;patternMatch;$P2Pmr;17| (79 . |coerce|) + |SYMBOL;convert;$P;18| (84 . |coerce|) + |SYMBOL;convert;$P;19| (|List| $) (89 . |concat|) + (94 . |concat|) + (|Record| (|:| |sub| 54) (|:| |sup| 54) (|:| |presup| 54) + (|:| |presub| 54) (|:| |args| 54)) + |SYMBOL;script;$R$;23| |SYMBOL;name;2$;31| + |SYMBOL;string;$S;24| (100 . |elt|) (106 . ~=) + |SYMBOL;scripts;$R;32| (112 . |not|) (117 . |latex|) + |SYMBOL;latex;$S;25| (122 . |minIndex|) (127 . |concat|) + (133 . |elt|) (138 . |setelt|) |SYMBOL;new;$;27| + (|Union| 6 '"failed") (144 . |search|) (150 . |setelt|) + (157 . |maxIndex|) (162 . |position|) |SYMBOL;new;2$;28| + (|List| $$) (168 . |keys|) (173 . |remove!|) + (179 . |void|) |SYMBOL;resetNew;V;29| |SYMBOL;list;$L;34| + (183 . |first|) (188 . |digit?|) (|UniversalSegment| 6) + (193 . SEGMENT) (199 . |elt|) (|List| 41) + (205 . |minIndex|) (210 . |setelt|) (217 . |concat|) + (223 . |rest|) (228 . |minIndex|) (233 . |#|) + (238 . |first|) (244 . |setelt|) (251 . |rest|) + (257 . |elt|) + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |SYMBOL;sample;$;35|) + $)) + (|SingleInteger|)) + '#(~= 263 |superscript| 269 |subscript| 275 |string| 281 + |scripts| 286 |scripted?| 291 |script| 296 |sample| 308 + |resetNew| 312 |patternMatch| 316 |new| 330 |name| 339 + |min| 344 |max| 350 |list| 356 |latex| 361 |hash| 366 + |elt| 371 |convert| 377 |coerce| 397 |argscript| 407 + |OMwrite| 413 >= 437 > 443 = 449 <= 455 < 461) + 'NIL + (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0 0 0 0 0 0)) + (CONS '#(|OrderedSet&| NIL NIL |SetCategory&| + |BasicType&| NIL NIL NIL NIL NIL NIL) + (CONS '#((|OrderedSet|) (|PatternMatchable| 67) + (|PatternMatchable| 6) (|SetCategory|) + (|BasicType|) (|ConvertibleTo| 69) + (|ConvertibleTo| 62) + (|ConvertibleTo| 24) (|OpenMath|) + (|ConvertibleTo| 44) (|CoercibleTo| 51)) + (|makeByteWordVec2| 125 + '(1 7 0 6 8 0 10 0 11 1 15 0 14 16 2 25 + 23 0 24 26 0 27 0 28 2 25 0 13 27 29 + 1 25 23 0 30 1 25 23 0 31 1 25 23 0 + 32 1 39 0 13 40 1 39 41 0 42 1 44 0 + 24 45 1 51 0 24 52 3 63 61 24 62 61 + 64 3 70 68 24 69 68 71 1 69 0 24 74 1 + 62 0 24 76 1 13 0 78 79 2 54 0 0 0 80 + 2 13 39 0 6 85 2 39 21 0 0 86 1 21 0 + 0 88 1 51 13 0 89 1 13 6 0 91 2 13 0 + 39 0 92 1 7 6 0 93 2 7 6 0 6 94 2 10 + 96 2 0 97 3 10 6 0 2 6 98 1 13 6 0 99 + 2 13 6 39 0 100 1 10 102 0 103 2 10 + 96 2 0 104 0 23 0 105 1 102 2 0 108 1 + 39 21 0 109 2 110 0 6 6 111 2 13 0 0 + 110 112 1 113 6 0 114 3 113 41 0 6 41 + 115 2 113 0 0 41 116 1 102 0 0 117 1 + 55 6 0 118 1 102 41 0 119 2 102 0 0 + 41 120 3 55 54 0 6 54 121 2 102 0 0 + 41 122 2 55 54 0 6 123 2 0 21 0 0 1 2 + 0 0 0 54 59 2 0 0 0 54 57 1 0 13 0 84 + 1 0 81 0 87 1 0 21 0 22 2 0 0 0 55 56 + 2 0 0 0 81 82 0 0 0 124 0 0 23 106 3 + 0 65 0 62 65 66 3 0 72 0 69 72 73 1 0 + 0 0 101 0 0 0 95 1 0 0 0 83 2 0 0 0 0 + 1 2 0 0 0 0 1 1 0 78 0 107 1 0 13 0 + 90 1 0 125 0 1 2 0 0 0 54 58 1 0 62 0 + 77 1 0 69 0 75 1 0 24 0 47 1 0 44 0 + 46 1 0 0 13 48 1 0 51 0 53 2 0 0 0 54 + 60 3 0 23 25 0 21 36 2 0 13 0 21 34 2 + 0 23 25 0 35 1 0 13 0 33 2 0 21 0 0 1 + 2 0 21 0 0 1 2 0 21 0 0 49 2 0 21 0 0 + 1 2 0 21 0 0 50))))) + '|lookupComplete|)) + +(MAKEPROP '|Symbol| 'NILADIC T) diff --git a/src/algebra/strap/TSETCAT-.lsp b/src/algebra/strap/TSETCAT-.lsp new file mode 100644 index 00000000..2b979ff7 --- /dev/null +++ b/src/algebra/strap/TSETCAT-.lsp @@ -0,0 +1,1031 @@ + +(/VERSIONCHECK 2) + +(DEFUN |TSETCAT-;=;2SB;1| (|ts| |us| $) + (PROG (#0=#:G1451 #1=#:G1457) + (RETURN + (COND + ((SPADCALL |ts| (|getShellEntry| $ 12)) + (SPADCALL |us| (|getShellEntry| $ 12))) + ((OR (SPADCALL |us| (|getShellEntry| $ 12)) + (NULL (SPADCALL + (PROG2 (LETT #0# + (SPADCALL |ts| + (|getShellEntry| $ 14)) + |TSETCAT-;=;2SB;1|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 10) #0#)) + (PROG2 (LETT #0# + (SPADCALL |us| + (|getShellEntry| $ 14)) + |TSETCAT-;=;2SB;1|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 10) #0#)) + (|getShellEntry| $ 15)))) + 'NIL) + ('T + (SPADCALL + (PROG2 (LETT #1# (SPADCALL |ts| (|getShellEntry| $ 17)) + |TSETCAT-;=;2SB;1|) + (QCDR #1#) + (|check-union| (QEQCAR #1# 0) (|getShellEntry| $ 6) #1#)) + (PROG2 (LETT #1# (SPADCALL |us| (|getShellEntry| $ 17)) + |TSETCAT-;=;2SB;1|) + (QCDR #1#) + (|check-union| (QEQCAR #1# 0) (|getShellEntry| $ 6) #1#)) + (|getShellEntry| $ 18))))))) + +(DEFUN |TSETCAT-;infRittWu?;2SB;2| (|ts| |us| $) + (PROG (|p| #0=#:G1464 |q| |v|) + (RETURN + (SEQ (COND + ((SPADCALL |us| (|getShellEntry| $ 12)) + (SPADCALL (SPADCALL |ts| (|getShellEntry| $ 12)) + (|getShellEntry| $ 20))) + ((SPADCALL |ts| (|getShellEntry| $ 12)) 'NIL) + ('T + (SEQ (LETT |p| + (PROG2 (LETT #0# + (SPADCALL |ts| + (|getShellEntry| $ 21)) + |TSETCAT-;infRittWu?;2SB;2|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 10) #0#)) + |TSETCAT-;infRittWu?;2SB;2|) + (LETT |q| + (PROG2 (LETT #0# + (SPADCALL |us| + (|getShellEntry| $ 21)) + |TSETCAT-;infRittWu?;2SB;2|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 10) #0#)) + |TSETCAT-;infRittWu?;2SB;2|) + (EXIT (COND + ((SPADCALL |p| |q| (|getShellEntry| $ 22)) + 'T) + ((SPADCALL |p| |q| (|getShellEntry| $ 23)) + 'NIL) + ('T + (SEQ (LETT |v| + (SPADCALL |p| + (|getShellEntry| $ 24)) + |TSETCAT-;infRittWu?;2SB;2|) + (EXIT (SPADCALL + (SPADCALL |ts| |v| + (|getShellEntry| $ 25)) + (SPADCALL |us| |v| + (|getShellEntry| $ 25)) + (|getShellEntry| $ 26)))))))))))))) + +(DEFUN |TSETCAT-;reduced?;PSMB;3| (|p| |ts| |redOp?| $) + (PROG (|lp|) + (RETURN + (SEQ (LETT |lp| (SPADCALL |ts| (|getShellEntry| $ 29)) + |TSETCAT-;reduced?;PSMB;3|) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp|) 'NIL) + ('T + (SPADCALL |p| (|SPADfirst| |lp|) |redOp?|)))) + (GO G191))) + (SEQ (EXIT (LETT |lp| (CDR |lp|) + |TSETCAT-;reduced?;PSMB;3|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (NULL |lp|)))))) + +(DEFUN |TSETCAT-;basicSet;LMU;4| (|ps| |redOp?| $) + (PROG (|b| |bs| |p| |ts|) + (RETURN + (SEQ (LETT |ps| (SPADCALL (ELT $ 32) |ps| (|getShellEntry| $ 34)) + |TSETCAT-;basicSet;LMU;4|) + (EXIT (COND + ((SPADCALL (ELT $ 35) |ps| (|getShellEntry| $ 36)) + (CONS 1 "failed")) + ('T + (SEQ (LETT |ps| + (SPADCALL (ELT $ 22) |ps| + (|getShellEntry| $ 37)) + |TSETCAT-;basicSet;LMU;4|) + (LETT |bs| (SPADCALL (|getShellEntry| $ 38)) + |TSETCAT-;basicSet;LMU;4|) + (LETT |ts| NIL |TSETCAT-;basicSet;LMU;4|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |ps|) + (|getShellEntry| $ 20))) + (GO G191))) + (SEQ (LETT |b| (|SPADfirst| |ps|) + |TSETCAT-;basicSet;LMU;4|) + (LETT |bs| + (SPADCALL |bs| |b| + (|getShellEntry| $ 39)) + |TSETCAT-;basicSet;LMU;4|) + (LETT |ps| (CDR |ps|) + |TSETCAT-;basicSet;LMU;4|) + (EXIT + (SEQ G190 + (COND + ((NULL + (COND + ((NULL |ps|) 'NIL) + ('T + (SPADCALL + (SPADCALL + (LETT |p| + (|SPADfirst| |ps|) + |TSETCAT-;basicSet;LMU;4|) + |bs| |redOp?| + (|getShellEntry| $ 40)) + (|getShellEntry| $ 20))))) + (GO G191))) + (SEQ + (LETT |ts| (CONS |p| |ts|) + |TSETCAT-;basicSet;LMU;4|) + (EXIT + (LETT |ps| (CDR |ps|) + |TSETCAT-;basicSet;LMU;4|))) + NIL (GO G190) G191 (EXIT NIL)))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (CONS 0 (CONS |bs| |ts|))))))))))) + +(DEFUN |TSETCAT-;basicSet;LMMU;5| (|ps| |pred?| |redOp?| $) + (PROG (|bps| |b| |bs| |p| |gps| |ts|) + (RETURN + (SEQ (LETT |ps| (SPADCALL (ELT $ 32) |ps| (|getShellEntry| $ 34)) + |TSETCAT-;basicSet;LMMU;5|) + (EXIT (COND + ((SPADCALL (ELT $ 35) |ps| (|getShellEntry| $ 36)) + (CONS 1 "failed")) + ('T + (SEQ (LETT |gps| NIL |TSETCAT-;basicSet;LMMU;5|) + (LETT |bps| NIL |TSETCAT-;basicSet;LMMU;5|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |ps|) + (|getShellEntry| $ 20))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |ps|) + |TSETCAT-;basicSet;LMMU;5|) + (LETT |ps| (CDR |ps|) + |TSETCAT-;basicSet;LMMU;5|) + (EXIT + (COND + ((SPADCALL |p| |pred?|) + (LETT |gps| (CONS |p| |gps|) + |TSETCAT-;basicSet;LMMU;5|)) + ('T + (LETT |bps| (CONS |p| |bps|) + |TSETCAT-;basicSet;LMMU;5|))))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |gps| + (SPADCALL (ELT $ 22) |gps| + (|getShellEntry| $ 37)) + |TSETCAT-;basicSet;LMMU;5|) + (LETT |bs| (SPADCALL (|getShellEntry| $ 38)) + |TSETCAT-;basicSet;LMMU;5|) + (LETT |ts| NIL |TSETCAT-;basicSet;LMMU;5|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |gps|) + (|getShellEntry| $ 20))) + (GO G191))) + (SEQ (LETT |b| (|SPADfirst| |gps|) + |TSETCAT-;basicSet;LMMU;5|) + (LETT |bs| + (SPADCALL |bs| |b| + (|getShellEntry| $ 39)) + |TSETCAT-;basicSet;LMMU;5|) + (LETT |gps| (CDR |gps|) + |TSETCAT-;basicSet;LMMU;5|) + (EXIT + (SEQ G190 + (COND + ((NULL + (COND + ((NULL |gps|) 'NIL) + ('T + (SPADCALL + (SPADCALL + (LETT |p| + (|SPADfirst| |gps|) + |TSETCAT-;basicSet;LMMU;5|) + |bs| |redOp?| + (|getShellEntry| $ 40)) + (|getShellEntry| $ 20))))) + (GO G191))) + (SEQ + (LETT |ts| (CONS |p| |ts|) + |TSETCAT-;basicSet;LMMU;5|) + (EXIT + (LETT |gps| (CDR |gps|) + |TSETCAT-;basicSet;LMMU;5|))) + NIL (GO G190) G191 (EXIT NIL)))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |ts| + (SPADCALL (ELT $ 22) + (SPADCALL |ts| |bps| + (|getShellEntry| $ 44)) + (|getShellEntry| $ 37)) + |TSETCAT-;basicSet;LMMU;5|) + (EXIT (CONS 0 (CONS |bs| |ts|))))))))))) + +(DEFUN |TSETCAT-;initials;SL;6| (|ts| $) + (PROG (|p| |ip| |lip| |lp|) + (RETURN + (SEQ (LETT |lip| NIL |TSETCAT-;initials;SL;6|) + (EXIT (COND + ((SPADCALL |ts| (|getShellEntry| $ 12)) |lip|) + ('T + (SEQ (LETT |lp| + (SPADCALL |ts| (|getShellEntry| $ 29)) + |TSETCAT-;initials;SL;6|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lp|) + (|getShellEntry| $ 20))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |lp|) + |TSETCAT-;initials;SL;6|) + (COND + ((NULL + (SPADCALL + (LETT |ip| + (SPADCALL |p| + (|getShellEntry| $ 46)) + |TSETCAT-;initials;SL;6|) + (|getShellEntry| $ 35))) + (LETT |lip| + (CONS + (SPADCALL |ip| + (|getShellEntry| $ 47)) + |lip|) + |TSETCAT-;initials;SL;6|))) + (EXIT + (LETT |lp| (CDR |lp|) + |TSETCAT-;initials;SL;6|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |lip| (|getShellEntry| $ 48))))))))))) + +(DEFUN |TSETCAT-;degree;SNni;7| (|ts| $) + (PROG (|lp| |d|) + (RETURN + (SEQ (COND + ((SPADCALL |ts| (|getShellEntry| $ 12)) 0) + ('T + (SEQ (LETT |lp| (SPADCALL |ts| (|getShellEntry| $ 29)) + |TSETCAT-;degree;SNni;7|) + (LETT |d| + (SPADCALL (|SPADfirst| |lp|) + (|getShellEntry| $ 51)) + |TSETCAT-;degree;SNni;7|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (NULL + (LETT |lp| (CDR |lp|) + |TSETCAT-;degree;SNni;7|)) + (|getShellEntry| $ 20))) + (GO G191))) + (SEQ (EXIT (LETT |d| + (* |d| + (SPADCALL (|SPADfirst| |lp|) + (|getShellEntry| $ 51))) + |TSETCAT-;degree;SNni;7|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |d|)))))))) + +(DEFUN |TSETCAT-;quasiComponent;SR;8| (|ts| $) + (CONS (SPADCALL |ts| (|getShellEntry| $ 29)) + (SPADCALL |ts| (|getShellEntry| $ 53)))) + +(DEFUN |TSETCAT-;normalized?;PSB;9| (|p| |ts| $) + (SPADCALL |p| (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 57))) + +(DEFUN |TSETCAT-;stronglyReduced?;PSB;10| (|p| |ts| $) + (SPADCALL |p| (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 59))) + +(DEFUN |TSETCAT-;headReduced?;PSB;11| (|p| |ts| $) + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 61)) |ts| + (|getShellEntry| $ 62))) + +(DEFUN |TSETCAT-;initiallyReduced?;PSB;12| (|p| |ts| $) + (PROG (|lp| |red|) + (RETURN + (SEQ (LETT |lp| (SPADCALL |ts| (|getShellEntry| $ 29)) + |TSETCAT-;initiallyReduced?;PSB;12|) + (LETT |red| 'T |TSETCAT-;initiallyReduced?;PSB;12|) + (SEQ G190 + (COND + ((NULL (COND + ((OR (NULL |lp|) + (SPADCALL |p| (|getShellEntry| $ 35))) + 'NIL) + ('T |red|))) + (GO G191))) + (SEQ (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp|) 'NIL) + ('T + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 24)) + (SPADCALL (|SPADfirst| |lp|) + (|getShellEntry| $ 24)) + (|getShellEntry| $ 64))))) + (GO G191))) + (SEQ (EXIT (LETT |lp| (CDR |lp|) + |TSETCAT-;initiallyReduced?;PSB;12|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((NULL (NULL |lp|)) + (COND + ((SPADCALL + (SPADCALL (|SPADfirst| |lp|) + (|getShellEntry| $ 24)) + (SPADCALL |p| + (|getShellEntry| $ 24)) + (|getShellEntry| $ 65)) + (COND + ((SPADCALL |p| (|SPADfirst| |lp|) + (|getShellEntry| $ 66)) + (SEQ + (LETT |lp| (CDR |lp|) + |TSETCAT-;initiallyReduced?;PSB;12|) + (EXIT + (LETT |p| + (SPADCALL |p| + (|getShellEntry| $ 46)) + |TSETCAT-;initiallyReduced?;PSB;12|)))) + ('T + (LETT |red| 'NIL + |TSETCAT-;initiallyReduced?;PSB;12|)))) + ('T + (LETT |p| + (SPADCALL |p| + (|getShellEntry| $ 46)) + |TSETCAT-;initiallyReduced?;PSB;12|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |red|))))) + +(DEFUN |TSETCAT-;reduce;PSMMP;13| (|p| |ts| |redOp| |redOp?| $) + (PROG (|ts0| #0=#:G1539 |reductor| #1=#:G1542) + (RETURN + (SEQ (COND + ((OR (SPADCALL |ts| (|getShellEntry| $ 12)) + (SPADCALL |p| (|getShellEntry| $ 35))) + |p|) + ('T + (SEQ (LETT |ts0| |ts| |TSETCAT-;reduce;PSMMP;13|) + (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |ts| + (|getShellEntry| $ 12)) + 'NIL) + ('T + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 35)) + (|getShellEntry| $ 20))))) + (GO G191))) + (SEQ (LETT |reductor| + (PROG2 + (LETT #0# + (SPADCALL |ts| + (|getShellEntry| $ 14)) + |TSETCAT-;reduce;PSMMP;13|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 10) #0#)) + |TSETCAT-;reduce;PSMMP;13|) + (LETT |ts| + (PROG2 + (LETT #1# + (SPADCALL |ts| + (|getShellEntry| $ 17)) + |TSETCAT-;reduce;PSMMP;13|) + (QCDR #1#) + (|check-union| (QEQCAR #1# 0) + (|getShellEntry| $ 6) #1#)) + |TSETCAT-;reduce;PSMMP;13|) + (EXIT (COND + ((NULL + (SPADCALL |p| |reductor| + |redOp?|)) + (SEQ + (LETT |p| + (SPADCALL |p| |reductor| + |redOp|) + |TSETCAT-;reduce;PSMMP;13|) + (EXIT + (LETT |ts| |ts0| + |TSETCAT-;reduce;PSMMP;13|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |p|)))))))) + +(DEFUN |TSETCAT-;rewriteSetWithReduction;LSMML;14| + (|lp| |ts| |redOp| |redOp?| $) + (PROG (|p| |rs|) + (RETURN + (SEQ (COND + ((SPADCALL |ts| (|getShellEntry| $ 70)) |lp|) + ('T + (SEQ (LETT |lp| + (SPADCALL (ELT $ 32) |lp| + (|getShellEntry| $ 34)) + |TSETCAT-;rewriteSetWithReduction;LSMML;14|) + (EXIT (COND + ((NULL |lp|) |lp|) + ((SPADCALL (ELT $ 35) |lp| + (|getShellEntry| $ 36)) + (LIST (|spadConstant| $ 71))) + ('T + (SEQ (LETT |rs| NIL + |TSETCAT-;rewriteSetWithReduction;LSMML;14|) + (SEQ G190 + (COND + ((NULL + (SPADCALL (NULL |lp|) + (|getShellEntry| $ 20))) + (GO G191))) + (SEQ + (LETT |p| (|SPADfirst| |lp|) + |TSETCAT-;rewriteSetWithReduction;LSMML;14|) + (LETT |lp| (CDR |lp|) + |TSETCAT-;rewriteSetWithReduction;LSMML;14|) + (LETT |p| + (SPADCALL + (SPADCALL |p| |ts| |redOp| + |redOp?| + (|getShellEntry| $ 72)) + (|getShellEntry| $ 47)) + |TSETCAT-;rewriteSetWithReduction;LSMML;14|) + (EXIT + (COND + ((NULL + (SPADCALL |p| + (|getShellEntry| $ 32))) + (COND + ((SPADCALL |p| + (|getShellEntry| $ 35)) + (SEQ + (LETT |lp| NIL + |TSETCAT-;rewriteSetWithReduction;LSMML;14|) + (EXIT + (LETT |rs| + (LIST + (|spadConstant| $ 71)) + |TSETCAT-;rewriteSetWithReduction;LSMML;14|)))) + ('T + (LETT |rs| + (CONS |p| |rs|) + |TSETCAT-;rewriteSetWithReduction;LSMML;14|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |rs| + (|getShellEntry| $ 48)))))))))))))) + +(DEFUN |TSETCAT-;stronglyReduce;PSP;15| (|p| |ts| $) + (SPADCALL |p| |ts| (ELT $ 74) (ELT $ 66) (|getShellEntry| $ 72))) + +(DEFUN |TSETCAT-;headReduce;PSP;16| (|p| |ts| $) + (SPADCALL |p| |ts| (ELT $ 76) (ELT $ 77) (|getShellEntry| $ 72))) + +(DEFUN |TSETCAT-;initiallyReduce;PSP;17| (|p| |ts| $) + (SPADCALL |p| |ts| (ELT $ 79) (ELT $ 80) (|getShellEntry| $ 72))) + +(DEFUN |TSETCAT-;removeZero;PSP;18| (|p| |ts| $) + (PROG (|v| |tsv-| #0=#:G1565 #1=#:G1574 |q|) + (RETURN + (SEQ (EXIT (COND + ((OR (SPADCALL |p| (|getShellEntry| $ 35)) + (SPADCALL |ts| (|getShellEntry| $ 12))) + |p|) + ('T + (SEQ (LETT |v| + (SPADCALL |p| (|getShellEntry| $ 24)) + |TSETCAT-;removeZero;PSP;18|) + (LETT |tsv-| + (SPADCALL |ts| |v| + (|getShellEntry| $ 82)) + |TSETCAT-;removeZero;PSP;18|) + (COND + ((SPADCALL |v| |ts| (|getShellEntry| $ 83)) + (SEQ (LETT |q| + (SPADCALL |p| + (PROG2 + (LETT #0# + (SPADCALL |ts| |v| + (|getShellEntry| $ 84)) + |TSETCAT-;removeZero;PSP;18|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 10) #0#)) + (|getShellEntry| $ 74)) + |TSETCAT-;removeZero;PSP;18|) + (EXIT (COND + ((SPADCALL |q| + (|getShellEntry| $ 32)) + (PROGN + (LETT #1# |q| + |TSETCAT-;removeZero;PSP;18|) + (GO #1#))) + ((SPADCALL + (SPADCALL |q| |tsv-| + (|getShellEntry| $ 85)) + (|getShellEntry| $ 32)) + (PROGN + (LETT #1# + (|spadConstant| $ 86) + |TSETCAT-;removeZero;PSP;18|) + (GO #1#)))))))) + (EXIT (COND + ((SPADCALL |tsv-| + (|getShellEntry| $ 12)) + |p|) + ('T + (SEQ (LETT |q| (|spadConstant| $ 86) + |TSETCAT-;removeZero;PSP;18|) + (SEQ G190 + (COND + ((NULL + (SPADCALL + (SPADCALL |p| |v| + (|getShellEntry| $ 87)) + (|getShellEntry| $ 89))) + (GO G191))) + (SEQ + (LETT |q| + (SPADCALL + (SPADCALL + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 46)) + |tsv-| + (|getShellEntry| $ 85)) + (SPADCALL |p| + (|getShellEntry| $ 90)) + (|getShellEntry| $ 91)) + |q| (|getShellEntry| $ 92)) + |TSETCAT-;removeZero;PSP;18|) + (EXIT + (LETT |p| + (SPADCALL |p| + (|getShellEntry| $ 93)) + |TSETCAT-;removeZero;PSP;18|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT + (SPADCALL |q| + (SPADCALL |p| |tsv-| + (|getShellEntry| $ 85)) + (|getShellEntry| $ 92))))))))))) + #1# (EXIT #1#))))) + +(DEFUN |TSETCAT-;reduceByQuasiMonic;PSP;19| (|p| |ts| $) + (COND + ((OR (SPADCALL |p| (|getShellEntry| $ 35)) + (SPADCALL |ts| (|getShellEntry| $ 12))) + |p|) + ('T + (QVELT (SPADCALL |p| (SPADCALL |ts| (|getShellEntry| $ 95)) + (|getShellEntry| $ 97)) + 1)))) + +(DEFUN |TSETCAT-;autoReduced?;SMB;20| (|ts| |redOp?| $) + (PROG (|p| |lp|) + (RETURN + (SEQ (COND + ((SPADCALL |ts| (|getShellEntry| $ 12)) 'T) + ('T + (SEQ (LETT |lp| (SPADCALL |ts| (|getShellEntry| $ 29)) + |TSETCAT-;autoReduced?;SMB;20|) + (LETT |p| (|SPADfirst| |lp|) + |TSETCAT-;autoReduced?;SMB;20|) + (LETT |lp| (CDR |lp|) + |TSETCAT-;autoReduced?;SMB;20|) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp|) 'NIL) + ('T (SPADCALL |p| |lp| |redOp?|)))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |lp|) + |TSETCAT-;autoReduced?;SMB;20|) + (EXIT (LETT |lp| (CDR |lp|) + |TSETCAT-;autoReduced?;SMB;20|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (NULL |lp|))))))))) + +(DEFUN |TSETCAT-;stronglyReduced?;SB;21| (|ts| $) + (SPADCALL |ts| (ELT $ 59) (|getShellEntry| $ 101))) + +(DEFUN |TSETCAT-;normalized?;SB;22| (|ts| $) + (SPADCALL |ts| (ELT $ 57) (|getShellEntry| $ 101))) + +(DEFUN |TSETCAT-;headReduced?;SB;23| (|ts| $) + (SPADCALL |ts| (ELT $ 104) (|getShellEntry| $ 101))) + +(DEFUN |TSETCAT-;initiallyReduced?;SB;24| (|ts| $) + (SPADCALL |ts| (ELT $ 106) (|getShellEntry| $ 101))) + +(DEFUN |TSETCAT-;mvar;SV;25| (|ts| $) + (PROG (#0=#:G1593) + (RETURN + (COND + ((SPADCALL |ts| (|getShellEntry| $ 12)) + (|error| "Error from TSETCAT in mvar : #1 is empty")) + ('T + (SPADCALL + (PROG2 (LETT #0# (SPADCALL |ts| (|getShellEntry| $ 14)) + |TSETCAT-;mvar;SV;25|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 10) + #0#)) + (|getShellEntry| $ 24))))))) + +(DEFUN |TSETCAT-;first;SU;26| (|ts| $) + (PROG (|lp|) + (RETURN + (SEQ (COND + ((SPADCALL |ts| (|getShellEntry| $ 12)) (CONS 1 "failed")) + ('T + (SEQ (LETT |lp| + (SPADCALL (ELT $ 23) + (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 37)) + |TSETCAT-;first;SU;26|) + (EXIT (CONS 0 (|SPADfirst| |lp|)))))))))) + +(DEFUN |TSETCAT-;last;SU;27| (|ts| $) + (PROG (|lp|) + (RETURN + (SEQ (COND + ((SPADCALL |ts| (|getShellEntry| $ 12)) (CONS 1 "failed")) + ('T + (SEQ (LETT |lp| + (SPADCALL (ELT $ 22) + (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 37)) + |TSETCAT-;last;SU;27|) + (EXIT (CONS 0 (|SPADfirst| |lp|)))))))))) + +(DEFUN |TSETCAT-;rest;SU;28| (|ts| $) + (PROG (|lp|) + (RETURN + (SEQ (COND + ((SPADCALL |ts| (|getShellEntry| $ 12)) (CONS 1 "failed")) + ('T + (SEQ (LETT |lp| + (SPADCALL (ELT $ 23) + (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 37)) + |TSETCAT-;rest;SU;28|) + (EXIT (CONS 0 + (SPADCALL (CDR |lp|) + (|getShellEntry| $ 111))))))))))) + +(DEFUN |TSETCAT-;coerce;SL;29| (|ts| $) + (SPADCALL (ELT $ 23) (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 37))) + +(DEFUN |TSETCAT-;algebraicVariables;SL;30| (|ts| $) + (PROG (#0=#:G1618 |p| #1=#:G1619) + (RETURN + (SEQ (PROGN + (LETT #0# NIL |TSETCAT-;algebraicVariables;SL;30|) + (SEQ (LETT |p| NIL |TSETCAT-;algebraicVariables;SL;30|) + (LETT #1# (SPADCALL |ts| (|getShellEntry| $ 29)) + |TSETCAT-;algebraicVariables;SL;30|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |p| (CAR #1#) + |TSETCAT-;algebraicVariables;SL;30|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |p| + (|getShellEntry| $ 24)) + #0#) + |TSETCAT-;algebraicVariables;SL;30|))) + (LETT #1# (CDR #1#) + |TSETCAT-;algebraicVariables;SL;30|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))))))) + +(DEFUN |TSETCAT-;algebraic?;VSB;31| (|v| |ts| $) + (SPADCALL |v| (SPADCALL |ts| (|getShellEntry| $ 116)) + (|getShellEntry| $ 117))) + +(DEFUN |TSETCAT-;select;SVU;32| (|ts| |v| $) + (PROG (|lp|) + (RETURN + (SEQ (LETT |lp| + (SPADCALL (ELT $ 23) + (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 37)) + |TSETCAT-;select;SVU;32|) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp|) 'NIL) + ('T + (SPADCALL + (SPADCALL |v| + (SPADCALL (|SPADfirst| |lp|) + (|getShellEntry| $ 24)) + (|getShellEntry| $ 65)) + (|getShellEntry| $ 20))))) + (GO G191))) + (SEQ (EXIT (LETT |lp| (CDR |lp|) + |TSETCAT-;select;SVU;32|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((NULL |lp|) (CONS 1 "failed")) + ('T (CONS 0 (|SPADfirst| |lp|))))))))) + +(DEFUN |TSETCAT-;collectQuasiMonic;2S;33| (|ts| $) + (PROG (|newlp| |lp|) + (RETURN + (SEQ (LETT |lp| (SPADCALL |ts| (|getShellEntry| $ 29)) + |TSETCAT-;collectQuasiMonic;2S;33|) + (LETT |newlp| NIL |TSETCAT-;collectQuasiMonic;2S;33|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lp|) (|getShellEntry| $ 20))) + (GO G191))) + (SEQ (COND + ((SPADCALL + (SPADCALL (|SPADfirst| |lp|) + (|getShellEntry| $ 46)) + (|getShellEntry| $ 35)) + (LETT |newlp| (CONS (|SPADfirst| |lp|) |newlp|) + |TSETCAT-;collectQuasiMonic;2S;33|))) + (EXIT (LETT |lp| (CDR |lp|) + |TSETCAT-;collectQuasiMonic;2S;33|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |newlp| (|getShellEntry| $ 111))))))) + +(DEFUN |TSETCAT-;collectUnder;SVS;34| (|ts| |v| $) + (PROG (|lp|) + (RETURN + (SEQ (LETT |lp| + (SPADCALL (ELT $ 23) + (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 37)) + |TSETCAT-;collectUnder;SVS;34|) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp|) 'NIL) + ('T + (SPADCALL + (SPADCALL + (SPADCALL (|SPADfirst| |lp|) + (|getShellEntry| $ 24)) + |v| (|getShellEntry| $ 64)) + (|getShellEntry| $ 20))))) + (GO G191))) + (SEQ (EXIT (LETT |lp| (CDR |lp|) + |TSETCAT-;collectUnder;SVS;34|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |lp| (|getShellEntry| $ 111))))))) + +(DEFUN |TSETCAT-;collectUpper;SVS;35| (|ts| |v| $) + (PROG (|lp2| |lp1|) + (RETURN + (SEQ (LETT |lp1| + (SPADCALL (ELT $ 23) + (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 37)) + |TSETCAT-;collectUpper;SVS;35|) + (LETT |lp2| NIL |TSETCAT-;collectUpper;SVS;35|) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp1|) 'NIL) + ('T + (SPADCALL |v| + (SPADCALL (|SPADfirst| |lp1|) + (|getShellEntry| $ 24)) + (|getShellEntry| $ 64))))) + (GO G191))) + (SEQ (LETT |lp2| (CONS (|SPADfirst| |lp1|) |lp2|) + |TSETCAT-;collectUpper;SVS;35|) + (EXIT (LETT |lp1| (CDR |lp1|) + |TSETCAT-;collectUpper;SVS;35|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL (REVERSE |lp2|) (|getShellEntry| $ 111))))))) + +(DEFUN |TSETCAT-;construct;LS;36| (|lp| $) + (PROG (|rif|) + (RETURN + (SEQ (LETT |rif| (SPADCALL |lp| (|getShellEntry| $ 123)) + |TSETCAT-;construct;LS;36|) + (EXIT (COND + ((QEQCAR |rif| 0) (QCDR |rif|)) + ('T + (|error| "in construct : LP -> $ from TSETCAT : bad arg")))))))) + +(DEFUN |TSETCAT-;retractIfCan;LU;37| (|lp| $) + (PROG (|rif|) + (RETURN + (SEQ (COND + ((NULL |lp|) (CONS 0 (SPADCALL (|getShellEntry| $ 38)))) + ('T + (SEQ (LETT |lp| + (SPADCALL (ELT $ 23) |lp| + (|getShellEntry| $ 37)) + |TSETCAT-;retractIfCan;LU;37|) + (LETT |rif| + (SPADCALL (CDR |lp|) (|getShellEntry| $ 123)) + |TSETCAT-;retractIfCan;LU;37|) + (EXIT (COND + ((QEQCAR |rif| 0) + (SPADCALL (QCDR |rif|) (|SPADfirst| |lp|) + (|getShellEntry| $ 125))) + ('T + (|error| "in retractIfCan : LP -> ... from TSETCAT : bad arg"))))))))))) + +(DEFUN |TSETCAT-;extend;SPS;38| (|ts| |p| $) + (PROG (|eif|) + (RETURN + (SEQ (LETT |eif| (SPADCALL |ts| |p| (|getShellEntry| $ 125)) + |TSETCAT-;extend;SPS;38|) + (EXIT (COND + ((QEQCAR |eif| 0) (QCDR |eif|)) + ('T + (|error| "in extend : ($,P) -> $ from TSETCAT : bad ars")))))))) + +(DEFUN |TSETCAT-;coHeight;SNni;39| (|ts| $) + (PROG (|n| |m| #0=#:G1659) + (RETURN + (SEQ (LETT |n| (SPADCALL (|getShellEntry| $ 128)) + |TSETCAT-;coHeight;SNni;39|) + (LETT |m| (LENGTH (SPADCALL |ts| (|getShellEntry| $ 29))) + |TSETCAT-;coHeight;SNni;39|) + (EXIT (PROG2 (LETT #0# + (SPADCALL |n| |m| + (|getShellEntry| $ 129)) + |TSETCAT-;coHeight;SNni;39|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) (|NonNegativeInteger|) + #0#))))))) + +(DEFUN |TriangularSetCategory&| (|#1| |#2| |#3| |#4| |#5|) + (PROG (|dv$1| |dv$2| |dv$3| |dv$4| |dv$5| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) + . #0=(|TriangularSetCategory&|)) + (LETT |dv$2| (|devaluate| |#2|) . #0#) + (LETT |dv$3| (|devaluate| |#3|) . #0#) + (LETT |dv$4| (|devaluate| |#4|) . #0#) + (LETT |dv$5| (|devaluate| |#5|) . #0#) + (LETT |dv$| + (LIST '|TriangularSetCategory&| |dv$1| |dv$2| |dv$3| + |dv$4| |dv$5|) . #0#) + (LETT $ (|newShell| 132) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#4| '(|Finite|)))) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + (|setShellEntry| $ 7 |#2|) + (|setShellEntry| $ 8 |#3|) + (|setShellEntry| $ 9 |#4|) + (|setShellEntry| $ 10 |#5|) + (COND + ((|testBitVector| |pv$| 1) + (|setShellEntry| $ 130 + (CONS (|dispatchFunction| |TSETCAT-;coHeight;SNni;39|) + $)))) + $)))) + +(MAKEPROP '|TriangularSetCategory&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|local| |#3|) (|local| |#4|) (|local| |#5|) (|Boolean|) + (0 . |empty?|) (|Union| 10 '"failed") (5 . |first|) + (10 . =) (|Union| $ '"failed") (16 . |rest|) (21 . =) + |TSETCAT-;=;2SB;1| (27 . |not|) (32 . |last|) + (37 . |infRittWu?|) (43 . |supRittWu?|) (49 . |mvar|) + (54 . |collectUpper|) (60 . |infRittWu?|) + |TSETCAT-;infRittWu?;2SB;2| (|List| 10) (66 . |members|) + (|Mapping| 11 10 10) |TSETCAT-;reduced?;PSMB;3| + (71 . |zero?|) (|Mapping| 11 10) (76 . |remove|) + (82 . |ground?|) (87 . |any?|) (93 . |sort|) + (99 . |empty|) (103 . |extend|) (109 . |reduced?|) + (|Record| (|:| |bas| $) (|:| |top| 28)) + (|Union| 41 '"failed") |TSETCAT-;basicSet;LMU;4| + (116 . |concat|) |TSETCAT-;basicSet;LMMU;5| (122 . |init|) + (127 . |primPartElseUnitCanonical|) + (132 . |removeDuplicates|) |TSETCAT-;initials;SL;6| + (|NonNegativeInteger|) (137 . |mdeg|) + |TSETCAT-;degree;SNni;7| (142 . |initials|) + (|Record| (|:| |close| 28) (|:| |open| 28)) + |TSETCAT-;quasiComponent;SR;8| (|List| $) + (147 . |normalized?|) |TSETCAT-;normalized?;PSB;9| + (153 . |reduced?|) |TSETCAT-;stronglyReduced?;PSB;10| + (159 . |head|) (164 . |stronglyReduced?|) + |TSETCAT-;headReduced?;PSB;11| (170 . <) (176 . =) + (182 . |reduced?|) |TSETCAT-;initiallyReduced?;PSB;12| + (|Mapping| 10 10 10) |TSETCAT-;reduce;PSMMP;13| + (188 . |trivialIdeal?|) (193 . |One|) (197 . |reduce|) + |TSETCAT-;rewriteSetWithReduction;LSMML;14| + (205 . |lazyPrem|) |TSETCAT-;stronglyReduce;PSP;15| + (211 . |headReduce|) (217 . |headReduced?|) + |TSETCAT-;headReduce;PSP;16| (223 . |initiallyReduce|) + (229 . |initiallyReduced?|) + |TSETCAT-;initiallyReduce;PSP;17| (235 . |collectUnder|) + (241 . |algebraic?|) (247 . |select|) (253 . |removeZero|) + (259 . |Zero|) (263 . |degree|) (|Integer|) + (269 . |positive?|) (274 . |mainMonomial|) (279 . *) + (285 . +) (291 . |tail|) |TSETCAT-;removeZero;PSP;18| + (296 . |collectQuasiMonic|) + (|Record| (|:| |rnum| 7) (|:| |polnum| 10) (|:| |den| 7)) + (301 . |remainder|) |TSETCAT-;reduceByQuasiMonic;PSP;19| + (|Mapping| 11 10 28) |TSETCAT-;autoReduced?;SMB;20| + (307 . |autoReduced?|) |TSETCAT-;stronglyReduced?;SB;21| + |TSETCAT-;normalized?;SB;22| (313 . |headReduced?|) + |TSETCAT-;headReduced?;SB;23| (319 . |initiallyReduced?|) + |TSETCAT-;initiallyReduced?;SB;24| |TSETCAT-;mvar;SV;25| + |TSETCAT-;first;SU;26| |TSETCAT-;last;SU;27| + (325 . |construct|) |TSETCAT-;rest;SU;28| + |TSETCAT-;coerce;SL;29| (|List| 9) + |TSETCAT-;algebraicVariables;SL;30| + (330 . |algebraicVariables|) (335 . |member?|) + |TSETCAT-;algebraic?;VSB;31| |TSETCAT-;select;SVU;32| + |TSETCAT-;collectQuasiMonic;2S;33| + |TSETCAT-;collectUnder;SVS;34| + |TSETCAT-;collectUpper;SVS;35| (341 . |retractIfCan|) + |TSETCAT-;construct;LS;36| (346 . |extendIfCan|) + |TSETCAT-;retractIfCan;LU;37| |TSETCAT-;extend;SPS;38| + (352 . |size|) (356 . |subtractIfCan|) (362 . |coHeight|) + (|OutputForm|)) + '#(|stronglyReduced?| 367 |stronglyReduce| 378 |select| 384 + |rewriteSetWithReduction| 390 |retractIfCan| 398 |rest| + 403 |removeZero| 408 |reduced?| 414 |reduceByQuasiMonic| + 421 |reduce| 427 |quasiComponent| 435 |normalized?| 440 + |mvar| 451 |last| 456 |initials| 461 |initiallyReduced?| + 466 |initiallyReduce| 477 |infRittWu?| 483 |headReduced?| + 489 |headReduce| 500 |first| 506 |extend| 511 |degree| 517 + |construct| 522 |collectUpper| 527 |collectUnder| 533 + |collectQuasiMonic| 539 |coerce| 544 |coHeight| 549 + |basicSet| 554 |autoReduced?| 567 |algebraicVariables| 573 + |algebraic?| 578 = 584) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 130 + '(1 6 11 0 12 1 6 13 0 14 2 10 11 0 0 + 15 1 6 16 0 17 2 6 11 0 0 18 1 11 0 0 + 20 1 6 13 0 21 2 10 11 0 0 22 2 10 11 + 0 0 23 1 10 9 0 24 2 6 0 0 9 25 2 6 + 11 0 0 26 1 6 28 0 29 1 10 11 0 32 2 + 28 0 33 0 34 1 10 11 0 35 2 28 11 33 + 0 36 2 28 0 30 0 37 0 6 0 38 2 6 0 0 + 10 39 3 6 11 10 0 30 40 2 28 0 0 0 44 + 1 10 0 0 46 1 10 0 0 47 1 28 0 0 48 1 + 10 50 0 51 1 6 28 0 53 2 10 11 0 56 + 57 2 10 11 0 56 59 1 10 0 0 61 2 6 11 + 10 0 62 2 9 11 0 0 64 2 9 11 0 0 65 2 + 10 11 0 0 66 1 6 11 0 70 0 10 0 71 4 + 6 10 10 0 68 30 72 2 10 0 0 0 74 2 10 + 0 0 0 76 2 10 11 0 0 77 2 10 0 0 0 79 + 2 10 11 0 0 80 2 6 0 0 9 82 2 6 11 9 + 0 83 2 6 13 0 9 84 2 6 10 10 0 85 0 + 10 0 86 2 10 50 0 9 87 1 88 11 0 89 1 + 10 0 0 90 2 10 0 0 0 91 2 10 0 0 0 92 + 1 10 0 0 93 1 6 0 0 95 2 6 96 10 0 97 + 2 6 11 0 99 101 2 10 11 0 56 104 2 10 + 11 0 56 106 1 6 0 28 111 1 6 114 0 + 116 2 114 11 9 0 117 1 6 16 28 123 2 + 6 16 0 10 125 0 9 50 128 2 50 16 0 0 + 129 1 0 50 0 130 1 0 11 0 102 2 0 11 + 10 0 60 2 0 10 10 0 75 2 0 13 0 9 119 + 4 0 28 28 0 68 30 73 1 0 16 28 126 1 + 0 16 0 112 2 0 10 10 0 94 3 0 11 10 0 + 30 31 2 0 10 10 0 98 4 0 10 10 0 68 + 30 69 1 0 54 0 55 1 0 11 0 103 2 0 11 + 10 0 58 1 0 9 0 108 1 0 13 0 110 1 0 + 28 0 49 1 0 11 0 107 2 0 11 10 0 67 2 + 0 10 10 0 81 2 0 11 0 0 27 1 0 11 0 + 105 2 0 11 10 0 63 2 0 10 10 0 78 1 0 + 13 0 109 2 0 0 0 10 127 1 0 50 0 52 1 + 0 0 28 124 2 0 0 0 9 122 2 0 0 0 9 + 121 1 0 0 0 120 1 0 28 0 113 1 0 50 0 + 130 3 0 42 28 33 30 45 2 0 42 28 30 + 43 2 0 11 0 99 100 1 0 114 0 115 2 0 + 11 9 0 118 2 0 11 0 0 19))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/TSETCAT.lsp b/src/algebra/strap/TSETCAT.lsp new file mode 100644 index 00000000..8304c820 --- /dev/null +++ b/src/algebra/strap/TSETCAT.lsp @@ -0,0 +1,200 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |TriangularSetCategory;CAT| 'NIL) + +(DEFPARAMETER |TriangularSetCategory;AL| 'NIL) + +(DEFUN |TriangularSetCategory| (&REST #0=#:G1439 &AUX #1=#:G1437) + (DSETQ #1# #0#) + (LET (#2=#:G1438) + (COND + ((SETQ #2# + (|assoc| (|devaluateList| #1#) |TriangularSetCategory;AL|)) + (CDR #2#)) + (T (SETQ |TriangularSetCategory;AL| + (|cons5| (CONS (|devaluateList| #1#) + (SETQ #2# + (APPLY #'|TriangularSetCategory;| + #1#))) + |TriangularSetCategory;AL|)) + #2#)))) + +(DEFUN |TriangularSetCategory;| (|t#1| |t#2| |t#3| |t#4|) + (PROG (#0=#:G1436) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1| |t#2| |t#3| |t#4|) + (LIST (|devaluate| |t#1|) + (|devaluate| |t#2|) + (|devaluate| |t#3|) + (|devaluate| |t#4|))) + (COND + (|TriangularSetCategory;CAT|) + ('T + (LETT |TriangularSetCategory;CAT| + (|Join| (|PolynomialSetCategory| '|t#1| + '|t#2| '|t#3| '|t#4|) + (|mkCategory| '|domain| + '(((|infRittWu?| + ((|Boolean|) $ $)) + T) + ((|basicSet| + ((|Union| + (|Record| (|:| |bas| $) + (|:| |top| + (|List| |t#4|))) + "failed") + (|List| |t#4|) + (|Mapping| (|Boolean|) + |t#4| |t#4|))) + T) + ((|basicSet| + ((|Union| + (|Record| (|:| |bas| $) + (|:| |top| + (|List| |t#4|))) + "failed") + (|List| |t#4|) + (|Mapping| (|Boolean|) + |t#4|) + (|Mapping| (|Boolean|) + |t#4| |t#4|))) + T) + ((|initials| + ((|List| |t#4|) $)) + T) + ((|degree| + ((|NonNegativeInteger|) $)) + T) + ((|quasiComponent| + ((|Record| + (|:| |close| + (|List| |t#4|)) + (|:| |open| + (|List| |t#4|))) + $)) + T) + ((|normalized?| + ((|Boolean|) |t#4| $)) + T) + ((|normalized?| + ((|Boolean|) $)) + T) + ((|reduced?| + ((|Boolean|) |t#4| $ + (|Mapping| (|Boolean|) + |t#4| |t#4|))) + T) + ((|stronglyReduced?| + ((|Boolean|) |t#4| $)) + T) + ((|headReduced?| + ((|Boolean|) |t#4| $)) + T) + ((|initiallyReduced?| + ((|Boolean|) |t#4| $)) + T) + ((|autoReduced?| + ((|Boolean|) $ + (|Mapping| (|Boolean|) + |t#4| (|List| |t#4|)))) + T) + ((|stronglyReduced?| + ((|Boolean|) $)) + T) + ((|headReduced?| + ((|Boolean|) $)) + T) + ((|initiallyReduced?| + ((|Boolean|) $)) + T) + ((|reduce| + (|t#4| |t#4| $ + (|Mapping| |t#4| |t#4| + |t#4|) + (|Mapping| (|Boolean|) + |t#4| |t#4|))) + T) + ((|rewriteSetWithReduction| + ((|List| |t#4|) + (|List| |t#4|) $ + (|Mapping| |t#4| |t#4| + |t#4|) + (|Mapping| (|Boolean|) + |t#4| |t#4|))) + T) + ((|stronglyReduce| + (|t#4| |t#4| $)) + T) + ((|headReduce| + (|t#4| |t#4| $)) + T) + ((|initiallyReduce| + (|t#4| |t#4| $)) + T) + ((|removeZero| + (|t#4| |t#4| $)) + T) + ((|collectQuasiMonic| ($ $)) + T) + ((|reduceByQuasiMonic| + (|t#4| |t#4| $)) + T) + ((|zeroSetSplit| + ((|List| $) + (|List| |t#4|))) + T) + ((|zeroSetSplitIntoTriangularSystems| + ((|List| + (|Record| + (|:| |close| $) + (|:| |open| + (|List| |t#4|)))) + (|List| |t#4|))) + T) + ((|first| + ((|Union| |t#4| "failed") + $)) + T) + ((|last| + ((|Union| |t#4| "failed") + $)) + T) + ((|rest| + ((|Union| $ "failed") $)) + T) + ((|algebraicVariables| + ((|List| |t#3|) $)) + T) + ((|algebraic?| + ((|Boolean|) |t#3| $)) + T) + ((|select| + ((|Union| |t#4| "failed") + $ |t#3|)) + T) + ((|extendIfCan| + ((|Union| $ "failed") $ + |t#4|)) + T) + ((|extend| ($ $ |t#4|)) T) + ((|coHeight| + ((|NonNegativeInteger|) $)) + (|has| |t#3| (|Finite|)))) + '((|finiteAggregate| T) + (|shallowlyMutable| T)) + '((|NonNegativeInteger|) + (|Boolean|) (|List| |t#3|) + (|List| + (|Record| (|:| |close| $) + (|:| |open| + (|List| |t#4|)))) + (|List| |t#4|) (|List| $)) + NIL)) + . #1=(|TriangularSetCategory|))))) . #1#) + (SETELT #0# 0 + (LIST '|TriangularSetCategory| (|devaluate| |t#1|) + (|devaluate| |t#2|) (|devaluate| |t#3|) + (|devaluate| |t#4|))))))) diff --git a/src/algebra/strap/UFD-.lsp b/src/algebra/strap/UFD-.lsp new file mode 100644 index 00000000..eb1afd12 --- /dev/null +++ b/src/algebra/strap/UFD-.lsp @@ -0,0 +1,83 @@ + +(/VERSIONCHECK 2) + +(DEFUN |UFD-;squareFreePart;2S;1| (|x| $) + (PROG (|s| |f| #0=#:G1403 #1=#:G1401 #2=#:G1399 #3=#:G1400) + (RETURN + (SEQ (SPADCALL + (SPADCALL + (LETT |s| (SPADCALL |x| (|getShellEntry| $ 8)) + |UFD-;squareFreePart;2S;1|) + (|getShellEntry| $ 10)) + (PROGN + (LETT #3# NIL |UFD-;squareFreePart;2S;1|) + (SEQ (LETT |f| NIL |UFD-;squareFreePart;2S;1|) + (LETT #0# (SPADCALL |s| (|getShellEntry| $ 14)) + |UFD-;squareFreePart;2S;1|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |f| (CAR #0#) + |UFD-;squareFreePart;2S;1|) + NIL)) + (GO G191))) + (SEQ (EXIT (PROGN + (LETT #1# (QCAR |f|) + |UFD-;squareFreePart;2S;1|) + (COND + (#3# + (LETT #2# + (SPADCALL #2# #1# + (|getShellEntry| $ 15)) + |UFD-;squareFreePart;2S;1|)) + ('T + (PROGN + (LETT #2# #1# + |UFD-;squareFreePart;2S;1|) + (LETT #3# 'T + |UFD-;squareFreePart;2S;1|))))))) + (LETT #0# (CDR #0#) |UFD-;squareFreePart;2S;1|) + (GO G190) G191 (EXIT NIL)) + (COND (#3# #2#) ('T (|spadConstant| $ 16)))) + (|getShellEntry| $ 15)))))) + +(DEFUN |UFD-;prime?;SB;2| (|x| $) + (EQL (LENGTH (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18)) + (|getShellEntry| $ 22))) + 1)) + +(DEFUN |UniqueFactorizationDomain&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) + . #0=(|UniqueFactorizationDomain&|)) + (LETT |dv$| (LIST '|UniqueFactorizationDomain&| |dv$1|) . #0#) + (LETT $ (|newShell| 25) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + $)))) + +(MAKEPROP '|UniqueFactorizationDomain&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Factored| $) + (0 . |squareFree|) (|Factored| 6) (5 . |unit|) (|Integer|) + (|Record| (|:| |factor| 6) (|:| |exponent| 11)) + (|List| 12) (10 . |factors|) (15 . *) (21 . |One|) + |UFD-;squareFreePart;2S;1| (25 . |factor|) + (|Union| '"nil" '"sqfr" '"irred" '"prime") + (|Record| (|:| |flg| 19) (|:| |fctr| 6) (|:| |xpnt| 11)) + (|List| 20) (30 . |factorList|) (|Boolean|) + |UFD-;prime?;SB;2|) + '#(|squareFreePart| 35 |prime?| 40) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 24 + '(1 6 7 0 8 1 9 6 0 10 1 9 13 0 14 2 6 + 0 0 0 15 0 6 0 16 1 6 7 0 18 1 9 21 0 + 22 1 0 0 0 17 1 0 23 0 24))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/UFD.lsp b/src/algebra/strap/UFD.lsp new file mode 100644 index 00000000..ee4b7a18 --- /dev/null +++ b/src/algebra/strap/UFD.lsp @@ -0,0 +1,27 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |UniqueFactorizationDomain;AL| 'NIL) + +(DEFUN |UniqueFactorizationDomain| () + (LET (#:G1387) + (COND + (|UniqueFactorizationDomain;AL|) + (T (SETQ |UniqueFactorizationDomain;AL| + (|UniqueFactorizationDomain;|)))))) + +(DEFUN |UniqueFactorizationDomain;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# + (|Join| (|GcdDomain|) + (|mkCategory| '|domain| + '(((|prime?| ((|Boolean|) $)) T) + ((|squareFree| ((|Factored| $) $)) T) + ((|squareFreePart| ($ $)) T) + ((|factor| ((|Factored| $) $)) T)) + NIL '((|Factored| $) (|Boolean|)) NIL)) + |UniqueFactorizationDomain|) + (SETELT #0# 0 '(|UniqueFactorizationDomain|)))))) + +(MAKEPROP '|UniqueFactorizationDomain| 'NILADIC T) diff --git a/src/algebra/strap/ULSCAT.lsp b/src/algebra/strap/ULSCAT.lsp new file mode 100644 index 00000000..94ef7e99 --- /dev/null +++ b/src/algebra/strap/ULSCAT.lsp @@ -0,0 +1,113 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |UnivariateLaurentSeriesCategory;CAT| 'NIL) + +(DEFPARAMETER |UnivariateLaurentSeriesCategory;AL| 'NIL) + +(DEFUN |UnivariateLaurentSeriesCategory| (#0=#:G1388) + (LET (#1=#:G1389) + (COND + ((SETQ #1# + (|assoc| (|devaluate| #0#) + |UnivariateLaurentSeriesCategory;AL|)) + (CDR #1#)) + (T (SETQ |UnivariateLaurentSeriesCategory;AL| + (|cons5| (CONS (|devaluate| #0#) + (SETQ #1# + (|UnivariateLaurentSeriesCategory;| + #0#))) + |UnivariateLaurentSeriesCategory;AL|)) + #1#)))) + +(DEFUN |UnivariateLaurentSeriesCategory;| (|t#1|) + (PROG (#0=#:G1387) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) + (|sublisV| + (PAIR '(#1=#:G1386) (LIST '(|Integer|))) + (COND + (|UnivariateLaurentSeriesCategory;CAT|) + ('T + (LETT |UnivariateLaurentSeriesCategory;CAT| + (|Join| + (|UnivariatePowerSeriesCategory| + '|t#1| '#1#) + (|mkCategory| '|domain| + '(((|series| + ($ + (|Stream| + (|Record| + (|:| |k| (|Integer|)) + (|:| |c| |t#1|))))) + T) + ((|multiplyCoefficients| + ($ + (|Mapping| |t#1| + (|Integer|)) + $)) + T) + ((|rationalFunction| + ((|Fraction| + (|Polynomial| |t#1|)) + $ (|Integer|))) + (|has| |t#1| + (|IntegralDomain|))) + ((|rationalFunction| + ((|Fraction| + (|Polynomial| |t#1|)) + $ (|Integer|) (|Integer|))) + (|has| |t#1| + (|IntegralDomain|))) + ((|integrate| ($ $)) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|))))) + ((|integrate| ($ $ (|Symbol|))) + (AND + (|has| |t#1| + (SIGNATURE |variables| + ((|List| (|Symbol|)) |t#1|))) + (|has| |t#1| + (SIGNATURE |integrate| + (|t#1| |t#1| (|Symbol|)))) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|)))))) + ((|integrate| ($ $ (|Symbol|))) + (AND + (|has| |t#1| + (|AlgebraicallyClosedFunctionSpace| + (|Integer|))) + (|has| |t#1| + (|PrimitiveFunctionCategory|)) + (|has| |t#1| + (|TranscendentalFunctionCategory|)) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|))))))) + '(((|RadicalCategory|) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|))))) + ((|TranscendentalFunctionCategory|) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|))))) + ((|Field|) + (|has| |t#1| (|Field|)))) + '((|Symbol|) + (|Fraction| + (|Polynomial| |t#1|)) + (|Integer|) + (|Stream| + (|Record| + (|:| |k| (|Integer|)) + (|:| |c| |t#1|)))) + NIL)) + . #2=(|UnivariateLaurentSeriesCategory|)))))) . #2#) + (SETELT #0# 0 + (LIST '|UnivariateLaurentSeriesCategory| + (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/UPOLYC-.lsp b/src/algebra/strap/UPOLYC-.lsp new file mode 100644 index 00000000..ff1ac0da --- /dev/null +++ b/src/algebra/strap/UPOLYC-.lsp @@ -0,0 +1,1231 @@ + +(/VERSIONCHECK 2) + +(DEFUN |UPOLYC-;variables;SL;1| (|p| $) + (COND + ((OR (SPADCALL |p| (|getShellEntry| $ 9)) + (ZEROP (SPADCALL |p| (|getShellEntry| $ 11)))) + NIL) + ('T (LIST (SPADCALL (|getShellEntry| $ 13)))))) + +(DEFUN |UPOLYC-;degree;SSaosNni;2| (|p| |v| $) + (SPADCALL |p| (|getShellEntry| $ 11))) + +(DEFUN |UPOLYC-;totalDegree;SLNni;3| (|p| |lv| $) + (COND ((NULL |lv|) 0) ('T (SPADCALL |p| (|getShellEntry| $ 17))))) + +(DEFUN |UPOLYC-;degree;SLL;4| (|p| |lv| $) + (COND + ((NULL |lv|) NIL) + ('T (LIST (SPADCALL |p| (|getShellEntry| $ 11)))))) + +(DEFUN |UPOLYC-;eval;SLLS;5| (|p| |lv| |lq| $) + (COND + ((NULL |lv|) |p|) + ((NULL (NULL (CDR |lv|))) + (|error| "can only eval a univariate polynomial once")) + ('T + (SPADCALL |p| (|SPADfirst| |lv|) (|SPADfirst| |lq|) + (|getShellEntry| $ 21))))) + +(DEFUN |UPOLYC-;eval;SSaos2S;6| (|p| |v| |q| $) + (SPADCALL |p| |q| (|getShellEntry| $ 24))) + +(DEFUN |UPOLYC-;eval;SLLS;7| (|p| |lv| |lr| $) + (COND + ((NULL |lv|) |p|) + ((NULL (NULL (CDR |lv|))) + (|error| "can only eval a univariate polynomial once")) + ('T + (SPADCALL |p| (|SPADfirst| |lv|) (|SPADfirst| |lr|) + (|getShellEntry| $ 26))))) + +(DEFUN |UPOLYC-;eval;SSaosRS;8| (|p| |v| |r| $) + (SPADCALL (SPADCALL |p| |r| (|getShellEntry| $ 29)) + (|getShellEntry| $ 30))) + +(DEFUN |UPOLYC-;eval;SLS;9| (|p| |le| $) + (COND + ((NULL |le|) |p|) + ((NULL (NULL (CDR |le|))) + (|error| "can only eval a univariate polynomial once")) + ('T + (COND + ((QEQCAR (SPADCALL + (SPADCALL (|SPADfirst| |le|) + (|getShellEntry| $ 33)) + (|getShellEntry| $ 35)) + 1) + |p|) + ('T + (SPADCALL |p| + (SPADCALL (|SPADfirst| |le|) (|getShellEntry| $ 36)) + (|getShellEntry| $ 24))))))) + +(DEFUN |UPOLYC-;mainVariable;SU;10| (|p| $) + (COND + ((ZEROP (SPADCALL |p| (|getShellEntry| $ 11))) (CONS 1 "failed")) + ('T (CONS 0 (SPADCALL (|getShellEntry| $ 13)))))) + +(DEFUN |UPOLYC-;minimumDegree;SSaosNni;11| (|p| |v| $) + (SPADCALL |p| (|getShellEntry| $ 41))) + +(DEFUN |UPOLYC-;minimumDegree;SLL;12| (|p| |lv| $) + (COND + ((NULL |lv|) NIL) + ('T (LIST (SPADCALL |p| (|getShellEntry| $ 41)))))) + +(DEFUN |UPOLYC-;monomial;SSaosNniS;13| (|p| |v| |n| $) + (SPADCALL (CONS #'|UPOLYC-;monomial;SSaosNniS;13!0| (VECTOR $ |n|)) + |p| (|getShellEntry| $ 46))) + +(DEFUN |UPOLYC-;monomial;SSaosNniS;13!0| (|#1| $$) + (SPADCALL |#1| (|getShellEntry| $$ 1) + (|getShellEntry| (|getShellEntry| $$ 0) 44))) + +(DEFUN |UPOLYC-;coerce;SaosS;14| (|v| $) + (SPADCALL (|spadConstant| $ 49) 1 (|getShellEntry| $ 50))) + +(DEFUN |UPOLYC-;makeSUP;SSup;15| (|p| $) + (COND + ((SPADCALL |p| (|getShellEntry| $ 9)) (|spadConstant| $ 53)) + ('T + (SPADCALL + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 54)) + (SPADCALL |p| (|getShellEntry| $ 11)) + (|getShellEntry| $ 55)) + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 56)) + (|getShellEntry| $ 57)) + (|getShellEntry| $ 58))))) + +(DEFUN |UPOLYC-;unmakeSUP;SupS;16| (|sp| $) + (COND + ((SPADCALL |sp| (|getShellEntry| $ 60)) (|spadConstant| $ 61)) + ('T + (SPADCALL + (SPADCALL (SPADCALL |sp| (|getShellEntry| $ 62)) + (SPADCALL |sp| (|getShellEntry| $ 63)) + (|getShellEntry| $ 50)) + (SPADCALL (SPADCALL |sp| (|getShellEntry| $ 64)) + (|getShellEntry| $ 65)) + (|getShellEntry| $ 66))))) + +(DEFUN |UPOLYC-;karatsubaDivide;SNniR;17| (|p| |n| $) + (SPADCALL |p| + (SPADCALL (|spadConstant| $ 49) |n| (|getShellEntry| $ 50)) + (|getShellEntry| $ 69))) + +(DEFUN |UPOLYC-;shiftRight;SNniS;18| (|p| |n| $) + (QCAR (SPADCALL |p| + (SPADCALL (|spadConstant| $ 49) |n| (|getShellEntry| $ 50)) + (|getShellEntry| $ 69)))) + +(DEFUN |UPOLYC-;shiftLeft;SNniS;19| (|p| |n| $) + (SPADCALL |p| + (SPADCALL (|spadConstant| $ 49) |n| (|getShellEntry| $ 50)) + (|getShellEntry| $ 72))) + +(DEFUN |UPOLYC-;solveLinearPolynomialEquation;LSupU;20| (|lpp| |pp| $) + (SPADCALL |lpp| |pp| (|getShellEntry| $ 78))) + +(DEFUN |UPOLYC-;factorPolynomial;SupF;21| (|pp| $) + (SPADCALL |pp| (|getShellEntry| $ 84))) + +(DEFUN |UPOLYC-;factorSquareFreePolynomial;SupF;22| (|pp| $) + (SPADCALL |pp| (|getShellEntry| $ 87))) + +(DEFUN |UPOLYC-;factor;SF;23| (|p| $) + (PROG (|ansR| #0=#:G1516 |w| #1=#:G1517) + (RETURN + (SEQ (COND + ((ZEROP (SPADCALL |p| (|getShellEntry| $ 11))) + (SEQ (LETT |ansR| + (SPADCALL + (SPADCALL |p| (|getShellEntry| $ 54)) + (|getShellEntry| $ 90)) + |UPOLYC-;factor;SF;23|) + (EXIT (SPADCALL + (SPADCALL + (SPADCALL |ansR| + (|getShellEntry| $ 92)) + (|getShellEntry| $ 30)) + (PROGN + (LETT #0# NIL |UPOLYC-;factor;SF;23|) + (SEQ (LETT |w| NIL + |UPOLYC-;factor;SF;23|) + (LETT #1# + (SPADCALL |ansR| + (|getShellEntry| $ 97)) + |UPOLYC-;factor;SF;23|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |w| (CAR #1#) + |UPOLYC-;factor;SF;23|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #0# + (CONS + (VECTOR (QVELT |w| 0) + (SPADCALL (QVELT |w| 1) + (|getShellEntry| $ 30)) + (QVELT |w| 2)) + #0#) + |UPOLYC-;factor;SF;23|))) + (LETT #1# (CDR #1#) + |UPOLYC-;factor;SF;23|) + (GO G190) G191 + (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 101))))) + ('T + (SPADCALL (ELT $ 65) + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 57)) + (|getShellEntry| $ 102)) + (|getShellEntry| $ 106)))))))) + +(DEFUN |UPOLYC-;vectorise;SNniV;24| (|p| |n| $) + (PROG (|v| |m| |i| #0=#:G1522 #1=#:G1518) + (RETURN + (SEQ (LETT |m| + (SPADCALL + (LETT |v| + (SPADCALL |n| (|spadConstant| $ 108) + (|getShellEntry| $ 110)) + |UPOLYC-;vectorise;SNniV;24|) + (|getShellEntry| $ 111)) + |UPOLYC-;vectorise;SNniV;24|) + (SEQ (LETT |i| (SPADCALL |v| (|getShellEntry| $ 111)) + |UPOLYC-;vectorise;SNniV;24|) + (LETT #0# (QVSIZE |v|) |UPOLYC-;vectorise;SNniV;24|) + G190 (COND ((> |i| #0#) (GO G191))) + (SEQ (EXIT (SPADCALL |v| |i| + (SPADCALL |p| + (PROG1 + (LETT #1# (- |i| |m|) + |UPOLYC-;vectorise;SNniV;24|) + (|check-subtype| (>= #1# 0) + '(|NonNegativeInteger|) + #1#)) + (|getShellEntry| $ 112)) + (|getShellEntry| $ 113)))) + (LETT |i| (+ |i| 1) |UPOLYC-;vectorise;SNniV;24|) + (GO G190) G191 (EXIT NIL)) + (EXIT |v|))))) + +(DEFUN |UPOLYC-;retract;SR;25| (|p| $) + (COND + ((SPADCALL |p| (|getShellEntry| $ 9)) (|spadConstant| $ 108)) + ((ZEROP (SPADCALL |p| (|getShellEntry| $ 11))) + (SPADCALL |p| (|getShellEntry| $ 54))) + ('T (|error| "Polynomial is not of degree 0")))) + +(DEFUN |UPOLYC-;retractIfCan;SU;26| (|p| $) + (COND + ((SPADCALL |p| (|getShellEntry| $ 9)) + (CONS 0 (|spadConstant| $ 108))) + ((ZEROP (SPADCALL |p| (|getShellEntry| $ 11))) + (CONS 0 (SPADCALL |p| (|getShellEntry| $ 54)))) + ('T (CONS 1 "failed")))) + +(DEFUN |UPOLYC-;init;S;27| ($) + (SPADCALL (|spadConstant| $ 118) (|getShellEntry| $ 30))) + +(DEFUN |UPOLYC-;nextItemInner| (|n| $) + (PROG (|nn| |n1| |n2| #0=#:G1543 |n3|) + (RETURN + (SEQ (COND + ((SPADCALL |n| (|getShellEntry| $ 9)) + (CONS 0 + (SPADCALL + (PROG2 (LETT #0# + (SPADCALL (|spadConstant| $ 108) + (|getShellEntry| $ 121)) + |UPOLYC-;nextItemInner|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 7) #0#)) + (|getShellEntry| $ 30)))) + ((ZEROP (SPADCALL |n| (|getShellEntry| $ 11))) + (SEQ (LETT |nn| + (SPADCALL + (SPADCALL |n| (|getShellEntry| $ 54)) + (|getShellEntry| $ 121)) + |UPOLYC-;nextItemInner|) + (EXIT (COND + ((QEQCAR |nn| 1) (CONS 1 "failed")) + ('T + (CONS 0 + (SPADCALL (QCDR |nn|) + (|getShellEntry| $ 30)))))))) + ('T + (SEQ (LETT |n1| (SPADCALL |n| (|getShellEntry| $ 56)) + |UPOLYC-;nextItemInner|) + (LETT |n2| (|UPOLYC-;nextItemInner| |n1| $) + |UPOLYC-;nextItemInner|) + (EXIT (COND + ((QEQCAR |n2| 0) + (CONS 0 + (SPADCALL + (SPADCALL + (SPADCALL |n| + (|getShellEntry| $ 54)) + (SPADCALL |n| + (|getShellEntry| $ 11)) + (|getShellEntry| $ 50)) + (QCDR |n2|) + (|getShellEntry| $ 66)))) + ((< (+ 1 + (SPADCALL |n1| + (|getShellEntry| $ 11))) + (SPADCALL |n| (|getShellEntry| $ 11))) + (CONS 0 + (SPADCALL + (SPADCALL + (SPADCALL |n| + (|getShellEntry| $ 54)) + (SPADCALL |n| + (|getShellEntry| $ 11)) + (|getShellEntry| $ 50)) + (SPADCALL + (PROG2 + (LETT #0# + (SPADCALL + (|spadConstant| $ 118) + (|getShellEntry| $ 121)) + |UPOLYC-;nextItemInner|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 7) #0#)) + (+ 1 + (SPADCALL |n1| + (|getShellEntry| $ 11))) + (|getShellEntry| $ 50)) + (|getShellEntry| $ 66)))) + ('T + (SEQ (LETT |n3| + (SPADCALL + (SPADCALL |n| + (|getShellEntry| $ 54)) + (|getShellEntry| $ 121)) + |UPOLYC-;nextItemInner|) + (EXIT (COND + ((QEQCAR |n3| 1) + (CONS 1 "failed")) + ('T + (CONS 0 + (SPADCALL (QCDR |n3|) + (SPADCALL |n| + (|getShellEntry| $ 11)) + (|getShellEntry| $ 50))))))))))))))))) + +(DEFUN |UPOLYC-;nextItem;SU;29| (|n| $) + (PROG (|n1| #0=#:G1556) + (RETURN + (SEQ (LETT |n1| (|UPOLYC-;nextItemInner| |n| $) + |UPOLYC-;nextItem;SU;29|) + (EXIT (COND + ((QEQCAR |n1| 1) + (CONS 0 + (SPADCALL + (PROG2 (LETT #0# + (SPADCALL (|spadConstant| $ 118) + (|getShellEntry| $ 121)) + |UPOLYC-;nextItem;SU;29|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 7) #0#)) + (+ 1 + (SPADCALL |n| (|getShellEntry| $ 11))) + (|getShellEntry| $ 50)))) + ('T |n1|))))))) + +(DEFUN |UPOLYC-;content;SSaosS;30| (|p| |v| $) + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 124)) + (|getShellEntry| $ 30))) + +(DEFUN |UPOLYC-;primeFactor| (|p| |q| $) + (PROG (#0=#:G1562 |p1|) + (RETURN + (SEQ (LETT |p1| + (PROG2 (LETT #0# + (SPADCALL |p| + (SPADCALL |p| |q| + (|getShellEntry| $ 126)) + (|getShellEntry| $ 127)) + |UPOLYC-;primeFactor|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 6) + #0#)) + |UPOLYC-;primeFactor|) + (EXIT (COND + ((SPADCALL |p1| |p| (|getShellEntry| $ 128)) |p|) + ('T (|UPOLYC-;primeFactor| |p1| |q| $)))))))) + +(DEFUN |UPOLYC-;separate;2SR;32| (|p| |q| $) + (PROG (|a| #0=#:G1568) + (RETURN + (SEQ (LETT |a| (|UPOLYC-;primeFactor| |p| |q| $) + |UPOLYC-;separate;2SR;32|) + (EXIT (CONS |a| + (PROG2 (LETT #0# + (SPADCALL |p| |a| + (|getShellEntry| $ 127)) + |UPOLYC-;separate;2SR;32|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 6) #0#)))))))) + +(DEFUN |UPOLYC-;differentiate;SM2S;33| (|x| |deriv| |x'| $) + (PROG (|dg| |lc| #0=#:G1573 |d|) + (RETURN + (SEQ (LETT |d| (|spadConstant| $ 61) + |UPOLYC-;differentiate;SM2S;33|) + (SEQ G190 + (COND + ((NULL (< 0 + (LETT |dg| + (SPADCALL |x| (|getShellEntry| $ 11)) + |UPOLYC-;differentiate;SM2S;33|))) + (GO G191))) + (SEQ (LETT |lc| (SPADCALL |x| (|getShellEntry| $ 54)) + |UPOLYC-;differentiate;SM2S;33|) + (LETT |d| + (SPADCALL + (SPADCALL |d| + (SPADCALL |x'| + (SPADCALL + (SPADCALL |dg| |lc| + (|getShellEntry| $ 132)) + (PROG1 + (LETT #0# (- |dg| 1) + |UPOLYC-;differentiate;SM2S;33|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 50)) + (|getShellEntry| $ 72)) + (|getShellEntry| $ 66)) + (SPADCALL (SPADCALL |lc| |deriv|) |dg| + (|getShellEntry| $ 50)) + (|getShellEntry| $ 66)) + |UPOLYC-;differentiate;SM2S;33|) + (EXIT (LETT |x| + (SPADCALL |x| (|getShellEntry| $ 56)) + |UPOLYC-;differentiate;SM2S;33|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |d| + (SPADCALL + (SPADCALL + (SPADCALL |x| (|getShellEntry| $ 54)) + |deriv|) + (|getShellEntry| $ 30)) + (|getShellEntry| $ 66))))))) + +(DEFUN |UPOLYC-;ncdiff| (|n| |x'| $) + (PROG (#0=#:G1591 |n1|) + (RETURN + (COND + ((ZEROP |n|) (|spadConstant| $ 61)) + ((ZEROP (LETT |n1| + (PROG1 (LETT #0# (- |n| 1) |UPOLYC-;ncdiff|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + |UPOLYC-;ncdiff|)) + |x'|) + ('T + (SPADCALL + (SPADCALL |x'| + (SPADCALL (|spadConstant| $ 49) |n1| + (|getShellEntry| $ 50)) + (|getShellEntry| $ 72)) + (SPADCALL + (SPADCALL (|spadConstant| $ 49) 1 + (|getShellEntry| $ 50)) + (|UPOLYC-;ncdiff| |n1| |x'| $) (|getShellEntry| $ 72)) + (|getShellEntry| $ 66))))))) + +(DEFUN |UPOLYC-;differentiate;SM2S;35| (|x| |deriv| |x'| $) + (PROG (|dg| |lc| |d|) + (RETURN + (SEQ (LETT |d| (|spadConstant| $ 61) + |UPOLYC-;differentiate;SM2S;35|) + (SEQ G190 + (COND + ((NULL (< 0 + (LETT |dg| + (SPADCALL |x| (|getShellEntry| $ 11)) + |UPOLYC-;differentiate;SM2S;35|))) + (GO G191))) + (SEQ (LETT |lc| (SPADCALL |x| (|getShellEntry| $ 54)) + |UPOLYC-;differentiate;SM2S;35|) + (LETT |d| + (SPADCALL + (SPADCALL |d| + (SPADCALL (SPADCALL |lc| |deriv|) + |dg| (|getShellEntry| $ 50)) + (|getShellEntry| $ 66)) + (SPADCALL |lc| + (|UPOLYC-;ncdiff| |dg| |x'| $) + (|getShellEntry| $ 135)) + (|getShellEntry| $ 66)) + |UPOLYC-;differentiate;SM2S;35|) + (EXIT (LETT |x| + (SPADCALL |x| (|getShellEntry| $ 56)) + |UPOLYC-;differentiate;SM2S;35|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |d| + (SPADCALL + (SPADCALL + (SPADCALL |x| (|getShellEntry| $ 54)) + |deriv|) + (|getShellEntry| $ 30)) + (|getShellEntry| $ 66))))))) + +(DEFUN |UPOLYC-;differentiate;SMS;36| (|x| |deriv| $) + (SPADCALL |x| |deriv| (|spadConstant| $ 48) (|getShellEntry| $ 136))) + +(DEFUN |UPOLYC-;differentiate;2S;37| (|x| $) + (PROG (|dg| #0=#:G1600 |d|) + (RETURN + (SEQ (LETT |d| (|spadConstant| $ 61) + |UPOLYC-;differentiate;2S;37|) + (SEQ G190 + (COND + ((NULL (< 0 + (LETT |dg| + (SPADCALL |x| (|getShellEntry| $ 11)) + |UPOLYC-;differentiate;2S;37|))) + (GO G191))) + (SEQ (LETT |d| + (SPADCALL |d| + (SPADCALL + (SPADCALL |dg| + (SPADCALL |x| + (|getShellEntry| $ 54)) + (|getShellEntry| $ 132)) + (PROG1 + (LETT #0# (- |dg| 1) + |UPOLYC-;differentiate;2S;37|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 50)) + (|getShellEntry| $ 66)) + |UPOLYC-;differentiate;2S;37|) + (EXIT (LETT |x| + (SPADCALL |x| (|getShellEntry| $ 56)) + |UPOLYC-;differentiate;2S;37|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |d|))))) + +(DEFUN |UPOLYC-;differentiate;SSaosS;38| (|x| |v| $) + (SPADCALL |x| (|getShellEntry| $ 139))) + +(DEFUN |UPOLYC-;elt;3F;39| (|g| |f| $) + (SPADCALL + (SPADCALL (SPADCALL |g| (|getShellEntry| $ 142)) |f| + (|getShellEntry| $ 144)) + (SPADCALL (SPADCALL |g| (|getShellEntry| $ 145)) |f| + (|getShellEntry| $ 144)) + (|getShellEntry| $ 146))) + +(DEFUN |UPOLYC-;pseudoQuotient;3S;40| (|p| |q| $) + (PROG (|n| #0=#:G1646 #1=#:G1648) + (RETURN + (SEQ (LETT |n| + (+ (- (SPADCALL |p| (|getShellEntry| $ 11)) + (SPADCALL |q| (|getShellEntry| $ 11))) + 1) + |UPOLYC-;pseudoQuotient;3S;40|) + (EXIT (COND + ((< |n| 1) (|spadConstant| $ 61)) + ('T + (PROG2 (LETT #1# + (SPADCALL + (SPADCALL + (SPADCALL + (SPADCALL + (SPADCALL |q| + (|getShellEntry| $ 54)) + (PROG1 + (LETT #0# |n| + |UPOLYC-;pseudoQuotient;3S;40|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 148)) + |p| (|getShellEntry| $ 135)) + (SPADCALL |p| |q| + (|getShellEntry| $ 149)) + (|getShellEntry| $ 150)) + |q| (|getShellEntry| $ 127)) + |UPOLYC-;pseudoQuotient;3S;40|) + (QCDR #1#) + (|check-union| (QEQCAR #1# 0) + (|getShellEntry| $ 6) #1#))))))))) + +(DEFUN |UPOLYC-;pseudoDivide;2SR;41| (|p| |q| $) + (PROG (|n| |prem| #0=#:G1654 |lc| #1=#:G1656) + (RETURN + (SEQ (LETT |n| + (+ (- (SPADCALL |p| (|getShellEntry| $ 11)) + (SPADCALL |q| (|getShellEntry| $ 11))) + 1) + |UPOLYC-;pseudoDivide;2SR;41|) + (EXIT (COND + ((< |n| 1) + (VECTOR (|spadConstant| $ 49) (|spadConstant| $ 61) + |p|)) + ('T + (SEQ (LETT |prem| + (SPADCALL |p| |q| + (|getShellEntry| $ 149)) + |UPOLYC-;pseudoDivide;2SR;41|) + (LETT |lc| + (SPADCALL + (SPADCALL |q| + (|getShellEntry| $ 54)) + (PROG1 + (LETT #0# |n| + |UPOLYC-;pseudoDivide;2SR;41|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 148)) + |UPOLYC-;pseudoDivide;2SR;41|) + (EXIT (VECTOR |lc| + (PROG2 + (LETT #1# + (SPADCALL + (SPADCALL + (SPADCALL |lc| |p| + (|getShellEntry| $ 135)) + |prem| + (|getShellEntry| $ 150)) + |q| (|getShellEntry| $ 127)) + |UPOLYC-;pseudoDivide;2SR;41|) + (QCDR #1#) + (|check-union| (QEQCAR #1# 0) + (|getShellEntry| $ 6) #1#)) + |prem|)))))))))) + +(DEFUN |UPOLYC-;composite;FSU;42| (|f| |q| $) + (PROG (|n| |d|) + (RETURN + (SEQ (LETT |n| + (SPADCALL (SPADCALL |f| (|getShellEntry| $ 142)) |q| + (|getShellEntry| $ 154)) + |UPOLYC-;composite;FSU;42|) + (EXIT (COND + ((QEQCAR |n| 1) (CONS 1 "failed")) + ('T + (SEQ (LETT |d| + (SPADCALL + (SPADCALL |f| + (|getShellEntry| $ 145)) + |q| (|getShellEntry| $ 154)) + |UPOLYC-;composite;FSU;42|) + (EXIT (COND + ((QEQCAR |d| 1) (CONS 1 "failed")) + ('T + (CONS 0 + (SPADCALL (QCDR |n|) (QCDR |d|) + (|getShellEntry| $ 155)))))))))))))) + +(DEFUN |UPOLYC-;composite;2SU;43| (|p| |q| $) + (PROG (|cqr| |v| |u| |w| #0=#:G1682) + (RETURN + (SEQ (COND + ((SPADCALL |p| (|getShellEntry| $ 158)) (CONS 0 |p|)) + ('T + (SEQ (EXIT (SEQ (LETT |cqr| + (SPADCALL |p| |q| + (|getShellEntry| $ 159)) + |UPOLYC-;composite;2SU;43|) + (COND + ((SPADCALL (QVELT |cqr| 2) + (|getShellEntry| $ 158)) + (SEQ (LETT |v| + (SPADCALL (QVELT |cqr| 2) + (QVELT |cqr| 0) + (|getShellEntry| $ 160)) + |UPOLYC-;composite;2SU;43|) + (EXIT + (COND + ((QEQCAR |v| 0) + (SEQ + (LETT |u| + (SPADCALL (QVELT |cqr| 1) + |q| + (|getShellEntry| $ 154)) + |UPOLYC-;composite;2SU;43|) + (EXIT + (COND + ((QEQCAR |u| 0) + (SEQ + (LETT |w| + (SPADCALL (QCDR |u|) + (QVELT |cqr| 0) + (|getShellEntry| $ + 160)) + |UPOLYC-;composite;2SU;43|) + (EXIT + (COND + ((QEQCAR |w| 0) + (PROGN + (LETT #0# + (CONS 0 + (SPADCALL + (QCDR |v|) + (SPADCALL + (SPADCALL + (|spadConstant| + $ 49) + 1 + (|getShellEntry| + $ 50)) + (QCDR |w|) + (|getShellEntry| + $ 72)) + (|getShellEntry| + $ 66))) + |UPOLYC-;composite;2SU;43|) + (GO #0#)))))))))))))))) + (EXIT (CONS 1 "failed")))) + #0# (EXIT #0#)))))))) + +(DEFUN |UPOLYC-;elt;S2F;44| (|p| |f| $) + (PROG (|n| #0=#:G1688 |ans|) + (RETURN + (SEQ (COND + ((SPADCALL |p| (|getShellEntry| $ 9)) + (|spadConstant| $ 162)) + ('T + (SEQ (LETT |ans| + (SPADCALL + (SPADCALL + (SPADCALL |p| (|getShellEntry| $ 54)) + (|getShellEntry| $ 30)) + (|getShellEntry| $ 163)) + |UPOLYC-;elt;S2F;44|) + (LETT |n| (SPADCALL |p| (|getShellEntry| $ 11)) + |UPOLYC-;elt;S2F;44|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL + (LETT |p| + (SPADCALL |p| + (|getShellEntry| $ 56)) + |UPOLYC-;elt;S2F;44|) + (|getShellEntry| $ 9)) + (|getShellEntry| $ 164))) + (GO G191))) + (SEQ (EXIT (LETT |ans| + (SPADCALL + (SPADCALL |ans| + (SPADCALL |f| + (PROG1 + (LETT #0# + (- |n| + (LETT |n| + (SPADCALL |p| + (|getShellEntry| $ 11)) + |UPOLYC-;elt;S2F;44|)) + |UPOLYC-;elt;S2F;44|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 165)) + (|getShellEntry| $ 166)) + (SPADCALL + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 54)) + (|getShellEntry| $ 30)) + (|getShellEntry| $ 163)) + (|getShellEntry| $ 167)) + |UPOLYC-;elt;S2F;44|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((ZEROP |n|) |ans|) + ('T + (SPADCALL |ans| + (SPADCALL |f| |n| + (|getShellEntry| $ 168)) + (|getShellEntry| $ 166)))))))))))) + +(DEFUN |UPOLYC-;order;2SNni;45| (|p| |q| $) + (PROG (|u| #0=#:G1702 |ans|) + (RETURN + (SEQ (EXIT (COND + ((SPADCALL |p| (|getShellEntry| $ 9)) + (|error| "order: arguments must be nonzero")) + ((< (SPADCALL |q| (|getShellEntry| $ 11)) 1) + (|error| "order: place must be non-trivial")) + ('T + (SEQ (LETT |ans| 0 |UPOLYC-;order;2SNni;45|) + (EXIT (SEQ G190 NIL + (SEQ + (LETT |u| + (SPADCALL |p| |q| + (|getShellEntry| $ 127)) + |UPOLYC-;order;2SNni;45|) + (EXIT + (COND + ((QEQCAR |u| 1) + (PROGN + (LETT #0# |ans| + |UPOLYC-;order;2SNni;45|) + (GO #0#))) + ('T + (SEQ + (LETT |p| (QCDR |u|) + |UPOLYC-;order;2SNni;45|) + (EXIT + (LETT |ans| (+ |ans| 1) + |UPOLYC-;order;2SNni;45|))))))) + NIL (GO G190) G191 (EXIT NIL))))))) + #0# (EXIT #0#))))) + +(DEFUN |UPOLYC-;squareFree;SF;46| (|p| $) + (SPADCALL |p| (|getShellEntry| $ 172))) + +(DEFUN |UPOLYC-;squareFreePart;2S;47| (|p| $) + (SPADCALL |p| (|getShellEntry| $ 174))) + +(DEFUN |UPOLYC-;gcdPolynomial;3Sup;48| (|pp| |qq| $) + (COND + ((SPADCALL |pp| (|getShellEntry| $ 176)) + (SPADCALL |qq| (|getShellEntry| $ 177))) + ((SPADCALL |qq| (|getShellEntry| $ 176)) + (SPADCALL |pp| (|getShellEntry| $ 177))) + ('T + (SPADCALL + (SPADCALL + (SPADCALL (SPADCALL |pp| (|getShellEntry| $ 178)) + (SPADCALL |qq| (|getShellEntry| $ 178)) + (|getShellEntry| $ 126)) + (SPADCALL + (SPADCALL (SPADCALL |pp| (|getShellEntry| $ 179)) + (SPADCALL |qq| (|getShellEntry| $ 179)) + (|getShellEntry| $ 180)) + (|getShellEntry| $ 179)) + (|getShellEntry| $ 181)) + (|getShellEntry| $ 177))))) + +(DEFUN |UPOLYC-;squareFreePolynomial;SupF;49| (|pp| $) + (SPADCALL |pp| (|getShellEntry| $ 184))) + +(DEFUN |UPOLYC-;elt;F2R;50| (|f| |r| $) + (SPADCALL + (SPADCALL (SPADCALL |f| (|getShellEntry| $ 142)) |r| + (|getShellEntry| $ 29)) + (SPADCALL (SPADCALL |f| (|getShellEntry| $ 145)) |r| + (|getShellEntry| $ 29)) + (|getShellEntry| $ 186))) + +(DEFUN |UPOLYC-;euclideanSize;SNni;51| (|x| $) + (COND + ((SPADCALL |x| (|getShellEntry| $ 9)) + (|error| "euclideanSize called on 0 in Univariate Polynomial")) + ('T (SPADCALL |x| (|getShellEntry| $ 11))))) + +(DEFUN |UPOLYC-;divide;2SR;52| (|x| |y| $) + (PROG (|lc| |f| #0=#:G1714 |n| |quot|) + (RETURN + (SEQ (COND + ((SPADCALL |y| (|getShellEntry| $ 9)) + (|error| "division by 0 in Univariate Polynomials")) + ('T + (SEQ (LETT |quot| (|spadConstant| $ 61) + |UPOLYC-;divide;2SR;52|) + (LETT |lc| + (SPADCALL + (SPADCALL |y| (|getShellEntry| $ 54)) + (|getShellEntry| $ 189)) + |UPOLYC-;divide;2SR;52|) + (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |x| + (|getShellEntry| $ 9)) + 'NIL) + ('T + (SPADCALL + (< + (SPADCALL |x| + (|getShellEntry| $ 11)) + (SPADCALL |y| + (|getShellEntry| $ 11))) + (|getShellEntry| $ 164))))) + (GO G191))) + (SEQ (LETT |f| + (SPADCALL |lc| + (SPADCALL |x| + (|getShellEntry| $ 54)) + (|getShellEntry| $ 190)) + |UPOLYC-;divide;2SR;52|) + (LETT |n| + (PROG1 + (LETT #0# + (- + (SPADCALL |x| + (|getShellEntry| $ 11)) + (SPADCALL |y| + (|getShellEntry| $ 11))) + |UPOLYC-;divide;2SR;52|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + |UPOLYC-;divide;2SR;52|) + (LETT |quot| + (SPADCALL |quot| + (SPADCALL |f| |n| + (|getShellEntry| $ 50)) + (|getShellEntry| $ 66)) + |UPOLYC-;divide;2SR;52|) + (EXIT (LETT |x| + (SPADCALL |x| + (SPADCALL + (SPADCALL |f| |n| + (|getShellEntry| $ 50)) + |y| (|getShellEntry| $ 72)) + (|getShellEntry| $ 150)) + |UPOLYC-;divide;2SR;52|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (CONS |quot| |x|))))))))) + +(DEFUN |UPOLYC-;integrate;2S;53| (|p| $) + (PROG (|l| |d| |ans|) + (RETURN + (SEQ (LETT |ans| (|spadConstant| $ 61) |UPOLYC-;integrate;2S;53|) + (SEQ G190 + (COND + ((NULL (SPADCALL |p| (|spadConstant| $ 61) + (|getShellEntry| $ 192))) + (GO G191))) + (SEQ (LETT |l| (SPADCALL |p| (|getShellEntry| $ 54)) + |UPOLYC-;integrate;2S;53|) + (LETT |d| + (+ 1 (SPADCALL |p| (|getShellEntry| $ 11))) + |UPOLYC-;integrate;2S;53|) + (LETT |ans| + (SPADCALL |ans| + (SPADCALL + (SPADCALL + (SPADCALL |d| + (|getShellEntry| $ 194)) + (|getShellEntry| $ 195)) + (SPADCALL |l| |d| + (|getShellEntry| $ 50)) + (|getShellEntry| $ 196)) + (|getShellEntry| $ 66)) + |UPOLYC-;integrate;2S;53|) + (EXIT (LETT |p| + (SPADCALL |p| (|getShellEntry| $ 56)) + |UPOLYC-;integrate;2S;53|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |ans|))))) + +(DEFUN |UnivariatePolynomialCategory&| (|#1| |#2|) + (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) + . #0=(|UnivariatePolynomialCategory&|)) + (LETT |dv$2| (|devaluate| |#2|) . #0#) + (LETT |dv$| + (LIST '|UnivariatePolynomialCategory&| |dv$1| |dv$2|) . #0#) + (LETT $ (|newShell| 203) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#2| + '(|Algebra| (|Fraction| (|Integer|)))) + (|HasCategory| |#2| '(|Field|)) + (|HasCategory| |#2| '(|GcdDomain|)) + (|HasCategory| |#2| '(|IntegralDomain|)) + (|HasCategory| |#2| '(|CommutativeRing|)) + (|HasCategory| |#2| '(|StepThrough|)))) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + (|setShellEntry| $ 7 |#2|) + (COND + ((|HasCategory| |#2| '(|PolynomialFactorizationExplicit|)) + (PROGN + (|setShellEntry| $ 82 + (CONS (|dispatchFunction| + |UPOLYC-;solveLinearPolynomialEquation;LSupU;20|) + $)) + (|setShellEntry| $ 86 + (CONS (|dispatchFunction| + |UPOLYC-;factorPolynomial;SupF;21|) + $)) + (|setShellEntry| $ 88 + (CONS (|dispatchFunction| + |UPOLYC-;factorSquareFreePolynomial;SupF;22|) + $)) + (|setShellEntry| $ 107 + (CONS (|dispatchFunction| |UPOLYC-;factor;SF;23|) $))))) + (COND + ((|testBitVector| |pv$| 6) + (PROGN + (|setShellEntry| $ 119 + (CONS (|dispatchFunction| |UPOLYC-;init;S;27|) $)) + NIL + (|setShellEntry| $ 123 + (CONS (|dispatchFunction| |UPOLYC-;nextItem;SU;29|) $))))) + (COND + ((|testBitVector| |pv$| 3) + (PROGN + (|setShellEntry| $ 125 + (CONS (|dispatchFunction| |UPOLYC-;content;SSaosS;30|) + $)) + NIL + (|setShellEntry| $ 130 + (CONS (|dispatchFunction| |UPOLYC-;separate;2SR;32|) + $))))) + (COND + ((|testBitVector| |pv$| 5) + (|setShellEntry| $ 134 + (CONS (|dispatchFunction| + |UPOLYC-;differentiate;SM2S;33|) + $))) + ('T + (PROGN + (|setShellEntry| $ 134 + (CONS (|dispatchFunction| + |UPOLYC-;differentiate;SM2S;35|) + $))))) + (COND + ((|testBitVector| |pv$| 4) + (PROGN + (|setShellEntry| $ 147 + (CONS (|dispatchFunction| |UPOLYC-;elt;3F;39|) $)) + (|setShellEntry| $ 151 + (CONS (|dispatchFunction| + |UPOLYC-;pseudoQuotient;3S;40|) + $)) + (|setShellEntry| $ 153 + (CONS (|dispatchFunction| + |UPOLYC-;pseudoDivide;2SR;41|) + $)) + (|setShellEntry| $ 157 + (CONS (|dispatchFunction| |UPOLYC-;composite;FSU;42|) + $)) + (|setShellEntry| $ 161 + (CONS (|dispatchFunction| |UPOLYC-;composite;2SU;43|) + $)) + (|setShellEntry| $ 169 + (CONS (|dispatchFunction| |UPOLYC-;elt;S2F;44|) $)) + (|setShellEntry| $ 170 + (CONS (|dispatchFunction| |UPOLYC-;order;2SNni;45|) $))))) + (COND + ((|testBitVector| |pv$| 3) + (PROGN + (|setShellEntry| $ 173 + (CONS (|dispatchFunction| |UPOLYC-;squareFree;SF;46|) + $)) + (|setShellEntry| $ 175 + (CONS (|dispatchFunction| + |UPOLYC-;squareFreePart;2S;47|) + $))))) + (COND + ((|HasCategory| |#2| '(|PolynomialFactorizationExplicit|)) + (PROGN + (|setShellEntry| $ 182 + (CONS (|dispatchFunction| + |UPOLYC-;gcdPolynomial;3Sup;48|) + $)) + (|setShellEntry| $ 185 + (CONS (|dispatchFunction| + |UPOLYC-;squareFreePolynomial;SupF;49|) + $))))) + (COND + ((|testBitVector| |pv$| 2) + (PROGN + (|setShellEntry| $ 187 + (CONS (|dispatchFunction| |UPOLYC-;elt;F2R;50|) $)) + (|setShellEntry| $ 188 + (CONS (|dispatchFunction| + |UPOLYC-;euclideanSize;SNni;51|) + $)) + (|setShellEntry| $ 191 + (CONS (|dispatchFunction| |UPOLYC-;divide;2SR;52|) $))))) + (COND + ((|testBitVector| |pv$| 1) + (|setShellEntry| $ 197 + (CONS (|dispatchFunction| |UPOLYC-;integrate;2S;53|) $)))) + $)))) + +(MAKEPROP '|UnivariatePolynomialCategory&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|Boolean|) (0 . |zero?|) (|NonNegativeInteger|) + (5 . |degree|) (|SingletonAsOrderedSet|) (10 . |create|) + (|List| 12) |UPOLYC-;variables;SL;1| + |UPOLYC-;degree;SSaosNni;2| (14 . |totalDegree|) + |UPOLYC-;totalDegree;SLNni;3| (|List| 10) + |UPOLYC-;degree;SLL;4| (19 . |eval|) (|List| $) + |UPOLYC-;eval;SLLS;5| (26 . |elt|) + |UPOLYC-;eval;SSaos2S;6| (32 . |eval|) (|List| 7) + |UPOLYC-;eval;SLLS;7| (39 . |elt|) (45 . |coerce|) + |UPOLYC-;eval;SSaosRS;8| (|Equation| 6) (50 . |lhs|) + (|Union| 12 '"failed") (55 . |mainVariable|) (60 . |rhs|) + (|Equation| $) (|List| 37) |UPOLYC-;eval;SLS;9| + |UPOLYC-;mainVariable;SU;10| (65 . |minimumDegree|) + |UPOLYC-;minimumDegree;SSaosNni;11| + |UPOLYC-;minimumDegree;SLL;12| (70 . +) (|Mapping| 10 10) + (76 . |mapExponents|) |UPOLYC-;monomial;SSaosNniS;13| + (82 . |One|) (86 . |One|) (90 . |monomial|) + |UPOLYC-;coerce;SaosS;14| (|SparseUnivariatePolynomial| 7) + (96 . |Zero|) (100 . |leadingCoefficient|) + (105 . |monomial|) (111 . |reductum|) (116 . |makeSUP|) + (121 . +) |UPOLYC-;makeSUP;SSup;15| (127 . |zero?|) + (132 . |Zero|) (136 . |leadingCoefficient|) + (141 . |degree|) (146 . |reductum|) (151 . |unmakeSUP|) + (156 . +) |UPOLYC-;unmakeSUP;SupS;16| + (|Record| (|:| |quotient| $) (|:| |remainder| $)) + (162 . |monicDivide|) |UPOLYC-;karatsubaDivide;SNniR;17| + |UPOLYC-;shiftRight;SNniS;18| (168 . *) + |UPOLYC-;shiftLeft;SNniS;19| + (|SparseUnivariatePolynomial| 6) (|List| 74) + (|Union| 75 '"failed") + (|PolynomialFactorizationByRecursionUnivariate| 7 6) + (174 . |solveLinearPolynomialEquationByRecursion|) + (|SparseUnivariatePolynomial| $) (|List| 79) + (|Union| 80 '"failed") + (180 . |solveLinearPolynomialEquation|) (|Factored| 74) + (186 . |factorByRecursion|) (|Factored| 79) + (191 . |factorPolynomial|) + (196 . |factorSquareFreeByRecursion|) + (201 . |factorSquareFreePolynomial|) (|Factored| $) + (206 . |factor|) (|Factored| 7) (211 . |unit|) + (|Union| '"nil" '"sqfr" '"irred" '"prime") (|Integer|) + (|Record| (|:| |flg| 93) (|:| |fctr| 7) (|:| |xpnt| 94)) + (|List| 95) (216 . |factorList|) + (|Record| (|:| |flg| 93) (|:| |fctr| 6) (|:| |xpnt| 94)) + (|List| 98) (|Factored| 6) (221 . |makeFR|) + (227 . |factorPolynomial|) (|Mapping| 6 52) + (|Factored| 52) (|FactoredFunctions2| 52 6) (232 . |map|) + (238 . |factor|) (243 . |Zero|) (|Vector| 7) (247 . |new|) + (253 . |minIndex|) (258 . |coefficient|) + (264 . |qsetelt!|) |UPOLYC-;vectorise;SNniV;24| + |UPOLYC-;retract;SR;25| (|Union| 7 '"failed") + |UPOLYC-;retractIfCan;SU;26| (271 . |init|) (275 . |init|) + (|Union| $ '"failed") (279 . |nextItem|) (284 . |One|) + (288 . |nextItem|) (293 . |content|) (298 . |content|) + (304 . |gcd|) (310 . |exquo|) (316 . =) + (|Record| (|:| |primePart| $) (|:| |commonPart| $)) + (322 . |separate|) (328 . |Zero|) (332 . *) + (|Mapping| 7 7) (338 . |differentiate|) (345 . *) + (351 . |differentiate|) |UPOLYC-;differentiate;SMS;36| + |UPOLYC-;differentiate;2S;37| (358 . |differentiate|) + |UPOLYC-;differentiate;SSaosS;38| (|Fraction| 6) + (363 . |numer|) (|Fraction| $) (368 . |elt|) + (374 . |denom|) (379 . /) (385 . |elt|) (391 . **) + (397 . |pseudoRemainder|) (403 . -) + (409 . |pseudoQuotient|) + (|Record| (|:| |coef| 7) (|:| |quotient| $) + (|:| |remainder| $)) + (415 . |pseudoDivide|) (421 . |composite|) (427 . /) + (|Union| 143 '"failed") (433 . |composite|) + (439 . |ground?|) (444 . |pseudoDivide|) (450 . |exquo|) + (456 . |composite|) (462 . |Zero|) (466 . |coerce|) + (471 . |not|) (476 . **) (482 . *) (488 . +) (494 . **) + (500 . |elt|) (506 . |order|) + (|UnivariatePolynomialSquareFree| 7 6) + (512 . |squareFree|) (517 . |squareFree|) + (522 . |squareFreePart|) (527 . |squareFreePart|) + (532 . |zero?|) (537 . |unitCanonical|) (542 . |content|) + (547 . |primitivePart|) (552 . |subResultantGcd|) + (558 . *) (564 . |gcdPolynomial|) + (|UnivariatePolynomialSquareFree| 6 74) + (570 . |squareFree|) (575 . |squareFreePolynomial|) + (580 . /) (586 . |elt|) (592 . |euclideanSize|) + (597 . |inv|) (602 . *) (608 . |divide|) (614 . ~=) + (|Fraction| 94) (620 . |coerce|) (625 . |inv|) (630 . *) + (636 . |integrate|) (|Symbol|) (|List| 198) + (|Union| 94 '"failed") (|Union| 193 '"failed") + (|OutputForm|)) + '#(|vectorise| 641 |variables| 647 |unmakeSUP| 652 + |totalDegree| 657 |squareFreePolynomial| 663 + |squareFreePart| 668 |squareFree| 673 + |solveLinearPolynomialEquation| 678 |shiftRight| 684 + |shiftLeft| 690 |separate| 696 |retractIfCan| 702 + |retract| 707 |pseudoQuotient| 712 |pseudoDivide| 718 + |order| 724 |nextItem| 730 |monomial| 735 |minimumDegree| + 742 |makeSUP| 754 |mainVariable| 759 |karatsubaDivide| 764 + |integrate| 770 |init| 775 |gcdPolynomial| 779 + |factorSquareFreePolynomial| 785 |factorPolynomial| 790 + |factor| 795 |eval| 800 |euclideanSize| 834 |elt| 839 + |divide| 857 |differentiate| 863 |degree| 887 |content| + 899 |composite| 905 |coerce| 917) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 197 + '(1 6 8 0 9 1 6 10 0 11 0 12 0 13 1 6 + 10 0 17 3 6 0 0 12 0 21 2 6 0 0 0 24 + 3 6 0 0 12 7 26 2 6 7 0 7 29 1 6 0 7 + 30 1 32 6 0 33 1 6 34 0 35 1 32 6 0 + 36 1 6 10 0 41 2 10 0 0 0 44 2 6 0 45 + 0 46 0 6 0 48 0 7 0 49 2 6 0 7 10 50 + 0 52 0 53 1 6 7 0 54 2 52 0 7 10 55 1 + 6 0 0 56 1 6 52 0 57 2 52 0 0 0 58 1 + 52 8 0 60 0 6 0 61 1 52 7 0 62 1 52 + 10 0 63 1 52 0 0 64 1 6 0 52 65 2 6 0 + 0 0 66 2 6 68 0 0 69 2 6 0 0 0 72 2 + 77 76 75 74 78 2 0 81 80 79 82 1 77 + 83 74 84 1 0 85 79 86 1 77 83 74 87 1 + 0 85 79 88 1 7 89 0 90 1 91 7 0 92 1 + 91 96 0 97 2 100 0 6 99 101 1 7 85 79 + 102 2 105 100 103 104 106 1 0 89 0 + 107 0 7 0 108 2 109 0 10 7 110 1 109 + 94 0 111 2 6 7 0 10 112 3 109 7 0 94 + 7 113 0 7 0 118 0 0 0 119 1 7 120 0 + 121 0 74 0 122 1 0 120 0 123 1 6 7 0 + 124 2 0 0 0 12 125 2 6 0 0 0 126 2 6 + 120 0 0 127 2 6 8 0 0 128 2 0 129 0 0 + 130 0 74 0 131 2 7 0 10 0 132 3 0 0 0 + 133 0 134 2 6 0 7 0 135 3 6 0 0 133 0 + 136 1 6 0 0 139 1 141 6 0 142 2 6 143 + 0 143 144 1 141 6 0 145 2 141 0 0 0 + 146 2 0 143 143 143 147 2 7 0 0 10 + 148 2 6 0 0 0 149 2 6 0 0 0 150 2 0 0 + 0 0 151 2 0 152 0 0 153 2 6 120 0 0 + 154 2 141 0 6 6 155 2 0 156 143 0 157 + 1 6 8 0 158 2 6 152 0 0 159 2 6 120 0 + 7 160 2 0 120 0 0 161 0 141 0 162 1 + 141 0 6 163 1 8 0 0 164 2 141 0 0 94 + 165 2 141 0 0 0 166 2 141 0 0 0 167 2 + 141 0 0 10 168 2 0 143 0 143 169 2 0 + 10 0 0 170 1 171 100 6 172 1 0 89 0 + 173 1 171 6 6 174 1 0 0 0 175 1 74 8 + 0 176 1 74 0 0 177 1 74 6 0 178 1 74 + 0 0 179 2 74 0 0 0 180 2 74 0 6 0 181 + 2 0 79 79 79 182 1 183 83 74 184 1 0 + 85 79 185 2 7 0 0 0 186 2 0 7 143 7 + 187 1 0 10 0 188 1 7 0 0 189 2 7 0 0 + 0 190 2 0 68 0 0 191 2 6 8 0 0 192 1 + 193 0 94 194 1 193 0 0 195 2 6 0 193 + 0 196 1 0 0 0 197 2 0 109 0 10 114 1 + 0 14 0 15 1 0 0 52 67 2 0 10 0 14 18 + 1 0 85 79 185 1 0 0 0 175 1 0 89 0 + 173 2 0 81 80 79 82 2 0 0 0 10 71 2 0 + 0 0 10 73 2 0 129 0 0 130 1 0 116 0 + 117 1 0 7 0 115 2 0 0 0 0 151 2 0 152 + 0 0 153 2 0 10 0 0 170 1 0 120 0 123 + 3 0 0 0 12 10 47 2 0 19 0 14 43 2 0 + 10 0 12 42 1 0 52 0 59 1 0 34 0 40 2 + 0 68 0 10 70 1 0 0 0 197 0 0 0 119 2 + 0 79 79 79 182 1 0 85 79 88 1 0 85 79 + 86 1 0 89 0 107 3 0 0 0 12 0 25 3 0 0 + 0 14 22 23 3 0 0 0 14 27 28 3 0 0 0 + 12 7 31 2 0 0 0 38 39 1 0 10 0 188 2 + 0 143 0 143 169 2 0 7 143 7 187 2 0 + 143 143 143 147 2 0 68 0 0 191 3 0 0 + 0 133 0 134 2 0 0 0 133 137 1 0 0 0 + 138 2 0 0 0 12 140 2 0 10 0 12 16 2 0 + 19 0 14 20 2 0 0 0 12 125 2 0 120 0 0 + 161 2 0 156 143 0 157 1 0 0 12 51))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/UPOLYC.lsp b/src/algebra/strap/UPOLYC.lsp new file mode 100644 index 00000000..895e13e4 --- /dev/null +++ b/src/algebra/strap/UPOLYC.lsp @@ -0,0 +1,158 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |UnivariatePolynomialCategory;CAT| 'NIL) + +(DEFPARAMETER |UnivariatePolynomialCategory;AL| 'NIL) + +(DEFUN |UnivariatePolynomialCategory| (#0=#:G1424) + (LET (#1=#:G1425) + (COND + ((SETQ #1# + (|assoc| (|devaluate| #0#) + |UnivariatePolynomialCategory;AL|)) + (CDR #1#)) + (T (SETQ |UnivariatePolynomialCategory;AL| + (|cons5| (CONS (|devaluate| #0#) + (SETQ #1# + (|UnivariatePolynomialCategory;| + #0#))) + |UnivariatePolynomialCategory;AL|)) + #1#)))) + +(DEFUN |UnivariatePolynomialCategory;| (|t#1|) + (PROG (#0=#:G1423) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) + (|sublisV| + (PAIR '(#1=#:G1421 #2=#:G1422) + (LIST '(|NonNegativeInteger|) + '(|SingletonAsOrderedSet|))) + (COND + (|UnivariatePolynomialCategory;CAT|) + ('T + (LETT |UnivariatePolynomialCategory;CAT| + (|Join| + (|PolynomialCategory| '|t#1| '#1# + '#2#) + (|Eltable| '|t#1| '|t#1|) + (|Eltable| '$ '$) + (|DifferentialRing|) + (|DifferentialExtension| '|t#1|) + (|mkCategory| '|domain| + '(((|vectorise| + ((|Vector| |t#1|) $ + (|NonNegativeInteger|))) + T) + ((|makeSUP| + ((|SparseUnivariatePolynomial| + |t#1|) + $)) + T) + ((|unmakeSUP| + ($ + (|SparseUnivariatePolynomial| + |t#1|))) + T) + ((|multiplyExponents| + ($ $ (|NonNegativeInteger|))) + T) + ((|divideExponents| + ((|Union| $ "failed") $ + (|NonNegativeInteger|))) + T) + ((|monicDivide| + ((|Record| (|:| |quotient| $) + (|:| |remainder| $)) + $ $)) + T) + ((|karatsubaDivide| + ((|Record| (|:| |quotient| $) + (|:| |remainder| $)) + $ (|NonNegativeInteger|))) + T) + ((|shiftRight| + ($ $ (|NonNegativeInteger|))) + T) + ((|shiftLeft| + ($ $ (|NonNegativeInteger|))) + T) + ((|pseudoRemainder| ($ $ $)) T) + ((|differentiate| + ($ $ (|Mapping| |t#1| |t#1|) + $)) + T) + ((|discriminant| (|t#1| $)) + (|has| |t#1| + (|CommutativeRing|))) + ((|resultant| (|t#1| $ $)) + (|has| |t#1| + (|CommutativeRing|))) + ((|elt| + ((|Fraction| $) + (|Fraction| $) + (|Fraction| $))) + (|has| |t#1| + (|IntegralDomain|))) + ((|order| + ((|NonNegativeInteger|) $ $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|subResultantGcd| ($ $ $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|composite| + ((|Union| $ "failed") $ $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|composite| + ((|Union| (|Fraction| $) + "failed") + (|Fraction| $) $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|pseudoQuotient| ($ $ $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|pseudoDivide| + ((|Record| (|:| |coef| |t#1|) + (|:| |quotient| $) + (|:| |remainder| $)) + $ $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|separate| + ((|Record| + (|:| |primePart| $) + (|:| |commonPart| $)) + $ $)) + (|has| |t#1| (|GcdDomain|))) + ((|elt| + (|t#1| (|Fraction| $) |t#1|)) + (|has| |t#1| (|Field|))) + ((|integrate| ($ $)) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|)))))) + '(((|StepThrough|) + (|has| |t#1| (|StepThrough|))) + ((|Eltable| (|Fraction| $) + (|Fraction| $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|EuclideanDomain|) + (|has| |t#1| (|Field|))) + (|additiveValuation| + (|has| |t#1| (|Field|)))) + '((|Fraction| $) + (|NonNegativeInteger|) + (|SparseUnivariatePolynomial| + |t#1|) + (|Vector| |t#1|)) + NIL)) + . #3=(|UnivariatePolynomialCategory|)))))) . #3#) + (SETELT #0# 0 + (LIST '|UnivariatePolynomialCategory| + (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp new file mode 100644 index 00000000..06ae51f1 --- /dev/null +++ b/src/algebra/strap/URAGG-.lsp @@ -0,0 +1,612 @@ + +(/VERSIONCHECK 2) + +(DEFUN |URAGG-;elt;AfirstS;1| (|x| T0 $) (SPADCALL |x| (QREFELT $ 8))) + +(DEFUN |URAGG-;elt;AlastS;2| (|x| T1 $) (SPADCALL |x| (QREFELT $ 11))) + +(DEFUN |URAGG-;elt;ArestA;3| (|x| T2 $) (SPADCALL |x| (QREFELT $ 14))) + +(DEFUN |URAGG-;second;AS;4| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 14)) (QREFELT $ 8))) + +(DEFUN |URAGG-;third;AS;5| (|x| $) + (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT $ 14)) (QREFELT $ 14)) + (QREFELT $ 8))) + +(DEFUN |URAGG-;cyclic?;AB;6| (|x| $) + (COND + ((SPADCALL |x| (QREFELT $ 20)) 'NIL) + ('T + (SPADCALL (SPADCALL (|URAGG-;findCycle| |x| $) (QREFELT $ 20)) + (QREFELT $ 21))))) + +(DEFUN |URAGG-;last;AS;7| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 23)) (QREFELT $ 8))) + +(DEFUN |URAGG-;nodes;AL;8| (|x| $) + (PROG (|l|) + (RETURN + (SEQ (LETT |l| NIL |URAGG-;nodes;AL;8|) + (SEQ G190 + (COND + ((NULL (SPADCALL (SPADCALL |x| (QREFELT $ 20)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (LETT |l| (CONS |x| |l|) |URAGG-;nodes;AL;8|) + (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;nodes;AL;8|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (NREVERSE |l|)))))) + +(DEFUN |URAGG-;children;AL;9| (|x| $) + (PROG (|l|) + (RETURN + (SEQ (LETT |l| NIL |URAGG-;children;AL;9|) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 20)) |l|) + ('T (CONS (SPADCALL |x| (QREFELT $ 14)) |l|)))))))) + +(DEFUN |URAGG-;leaf?;AB;10| (|x| $) (SPADCALL |x| (QREFELT $ 20))) + +(DEFUN |URAGG-;value;AS;11| (|x| $) + (COND + ((SPADCALL |x| (QREFELT $ 20)) (|error| "value of empty object")) + ('T (SPADCALL |x| (QREFELT $ 8))))) + +(DEFUN |URAGG-;less?;ANniB;12| (|l| |n| $) + (PROG (|i|) + (RETURN + (SEQ (LETT |i| |n| |URAGG-;less?;ANniB;12|) + (SEQ G190 + (COND + ((NULL (COND + ((< 0 |i|) + (SPADCALL (SPADCALL |l| (QREFELT $ 20)) + (QREFELT $ 21))) + ('T 'NIL))) + (GO G191))) + (SEQ (LETT |l| (SPADCALL |l| (QREFELT $ 14)) + |URAGG-;less?;ANniB;12|) + (EXIT (LETT |i| (- |i| 1) |URAGG-;less?;ANniB;12|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (< 0 |i|)))))) + +(DEFUN |URAGG-;more?;ANniB;13| (|l| |n| $) + (PROG (|i|) + (RETURN + (SEQ (LETT |i| |n| |URAGG-;more?;ANniB;13|) + (SEQ G190 + (COND + ((NULL (COND + ((< 0 |i|) + (SPADCALL (SPADCALL |l| (QREFELT $ 20)) + (QREFELT $ 21))) + ('T 'NIL))) + (GO G191))) + (SEQ (LETT |l| (SPADCALL |l| (QREFELT $ 14)) + |URAGG-;more?;ANniB;13|) + (EXIT (LETT |i| (- |i| 1) |URAGG-;more?;ANniB;13|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((ZEROP |i|) + (SPADCALL (SPADCALL |l| (QREFELT $ 20)) + (QREFELT $ 21))) + ('T 'NIL))))))) + +(DEFUN |URAGG-;size?;ANniB;14| (|l| |n| $) + (PROG (|i|) + (RETURN + (SEQ (LETT |i| |n| |URAGG-;size?;ANniB;14|) + (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |l| (QREFELT $ 20)) 'NIL) + ('T (< 0 |i|)))) + (GO G191))) + (SEQ (LETT |l| (SPADCALL |l| (QREFELT $ 14)) + |URAGG-;size?;ANniB;14|) + (EXIT (LETT |i| (- |i| 1) |URAGG-;size?;ANniB;14|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |l| (QREFELT $ 20)) (ZEROP |i|)) + ('T 'NIL))))))) + +(DEFUN |URAGG-;#;ANni;15| (|x| $) + (PROG (|k|) + (RETURN + (SEQ (SEQ (LETT |k| 0 |URAGG-;#;ANni;15|) G190 + (COND + ((NULL (SPADCALL (SPADCALL |x| (QREFELT $ 20)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |x| (QREFELT $ 34)) + (EXIT (|error| "cyclic list")))))) + (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;#;ANni;15|))) + (LETT |k| (QSADD1 |k|) |URAGG-;#;ANni;15|) (GO G190) + G191 (EXIT NIL)) + (EXIT |k|))))) + +(DEFUN |URAGG-;tail;2A;16| (|x| $) + (PROG (|k| |y|) + (RETURN + (SEQ (COND + ((SPADCALL |x| (QREFELT $ 20)) (|error| "empty list")) + ('T + (SEQ (LETT |y| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;tail;2A;16|) + (SEQ (LETT |k| 0 |URAGG-;tail;2A;16|) G190 + (COND + ((NULL (SPADCALL + (SPADCALL |y| (QREFELT $ 20)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |x| (QREFELT $ 34)) + (EXIT (|error| "cyclic list")))))) + (EXIT (LETT |y| + (SPADCALL + (LETT |x| |y| |URAGG-;tail;2A;16|) + (QREFELT $ 14)) + |URAGG-;tail;2A;16|))) + (LETT |k| (QSADD1 |k|) |URAGG-;tail;2A;16|) + (GO G190) G191 (EXIT NIL)) + (EXIT |x|)))))))) + +(DEFUN |URAGG-;findCycle| (|x| $) + (PROG (#0=#:G1475 |y|) + (RETURN + (SEQ (EXIT (SEQ (LETT |y| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;findCycle|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL |y| (QREFELT $ 20)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (COND + ((SPADCALL |x| |y| (QREFELT $ 37)) + (PROGN + (LETT #0# |x| |URAGG-;findCycle|) + (GO #0#)))) + (LETT |x| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;findCycle|) + (LETT |y| (SPADCALL |y| (QREFELT $ 14)) + |URAGG-;findCycle|) + (COND + ((SPADCALL |y| (QREFELT $ 20)) + (PROGN + (LETT #0# |y| |URAGG-;findCycle|) + (GO #0#)))) + (COND + ((SPADCALL |x| |y| (QREFELT $ 37)) + (PROGN + (LETT #0# |y| |URAGG-;findCycle|) + (GO #0#)))) + (EXIT (LETT |y| + (SPADCALL |y| (QREFELT $ 14)) + |URAGG-;findCycle|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |y|))) + #0# (EXIT #0#))))) + +(DEFUN |URAGG-;cycleTail;2A;18| (|x| $) + (PROG (|y| |z|) + (RETURN + (SEQ (COND + ((SPADCALL + (LETT |y| + (LETT |x| (SPADCALL |x| (QREFELT $ 38)) + |URAGG-;cycleTail;2A;18|) + |URAGG-;cycleTail;2A;18|) + (QREFELT $ 20)) + |x|) + ('T + (SEQ (LETT |z| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;cycleTail;2A;18|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL |x| |z| (QREFELT $ 37)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (LETT |y| |z| |URAGG-;cycleTail;2A;18|) + (EXIT (LETT |z| + (SPADCALL |z| (QREFELT $ 14)) + |URAGG-;cycleTail;2A;18|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |y|)))))))) + +(DEFUN |URAGG-;cycleEntry;2A;19| (|x| $) + (PROG (|l| |z| |k| |y|) + (RETURN + (SEQ (COND + ((SPADCALL |x| (QREFELT $ 20)) |x|) + ((SPADCALL + (LETT |y| (|URAGG-;findCycle| |x| $) + |URAGG-;cycleEntry;2A;19|) + (QREFELT $ 20)) + |y|) + ('T + (SEQ (LETT |z| (SPADCALL |y| (QREFELT $ 14)) + |URAGG-;cycleEntry;2A;19|) + (SEQ (LETT |l| 1 |URAGG-;cycleEntry;2A;19|) G190 + (COND + ((NULL (SPADCALL + (SPADCALL |y| |z| (QREFELT $ 37)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (EXIT (LETT |z| + (SPADCALL |z| (QREFELT $ 14)) + |URAGG-;cycleEntry;2A;19|))) + (LETT |l| (QSADD1 |l|) + |URAGG-;cycleEntry;2A;19|) + (GO G190) G191 (EXIT NIL)) + (LETT |y| |x| |URAGG-;cycleEntry;2A;19|) + (SEQ (LETT |k| 1 |URAGG-;cycleEntry;2A;19|) G190 + (COND ((QSGREATERP |k| |l|) (GO G191))) + (SEQ (EXIT (LETT |y| + (SPADCALL |y| (QREFELT $ 14)) + |URAGG-;cycleEntry;2A;19|))) + (LETT |k| (QSADD1 |k|) + |URAGG-;cycleEntry;2A;19|) + (GO G190) G191 (EXIT NIL)) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL |x| |y| (QREFELT $ 37)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (LETT |x| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;cycleEntry;2A;19|) + (EXIT (LETT |y| + (SPADCALL |y| (QREFELT $ 14)) + |URAGG-;cycleEntry;2A;19|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |x|)))))))) + +(DEFUN |URAGG-;cycleLength;ANni;20| (|x| $) + (PROG (|k| |y|) + (RETURN + (SEQ (COND + ((OR (SPADCALL |x| (QREFELT $ 20)) + (SPADCALL + (LETT |x| (|URAGG-;findCycle| |x| $) + |URAGG-;cycleLength;ANni;20|) + (QREFELT $ 20))) + 0) + ('T + (SEQ (LETT |y| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;cycleLength;ANni;20|) + (SEQ (LETT |k| 1 |URAGG-;cycleLength;ANni;20|) G190 + (COND + ((NULL (SPADCALL + (SPADCALL |x| |y| (QREFELT $ 37)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (EXIT (LETT |y| + (SPADCALL |y| (QREFELT $ 14)) + |URAGG-;cycleLength;ANni;20|))) + (LETT |k| (QSADD1 |k|) + |URAGG-;cycleLength;ANni;20|) + (GO G190) G191 (EXIT NIL)) + (EXIT |k|)))))))) + +(DEFUN |URAGG-;rest;ANniA;21| (|x| |n| $) + (PROG (|i|) + (RETURN + (SEQ (SEQ (LETT |i| 1 |URAGG-;rest;ANniA;21|) G190 + (COND ((QSGREATERP |i| |n|) (GO G191))) + (SEQ (EXIT (COND + ((SPADCALL |x| (QREFELT $ 20)) + (|error| "Index out of range")) + ('T + (LETT |x| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;rest;ANniA;21|))))) + (LETT |i| (QSADD1 |i|) |URAGG-;rest;ANniA;21|) + (GO G190) G191 (EXIT NIL)) + (EXIT |x|))))) + +(DEFUN |URAGG-;last;ANniA;22| (|x| |n| $) + (PROG (|m| #0=#:G1498) + (RETURN + (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 43)) + |URAGG-;last;ANniA;22|) + (EXIT (COND + ((< |m| |n|) (|error| "index out of range")) + ('T + (SPADCALL + (SPADCALL |x| + (PROG1 (LETT #0# (- |m| |n|) + |URAGG-;last;ANniA;22|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 44)) + (QREFELT $ 45))))))))) + +(DEFUN |URAGG-;=;2AB;23| (|x| |y| $) + (PROG (|k| #0=#:G1508) + (RETURN + (SEQ (EXIT (COND + ((SPADCALL |x| |y| (QREFELT $ 37)) 'T) + ('T + (SEQ (SEQ (LETT |k| 0 |URAGG-;=;2AB;23|) G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 20)) + 'NIL) + ('T + (SPADCALL + (SPADCALL |y| + (QREFELT $ 20)) + (QREFELT $ 21))))) + (GO G191))) + (SEQ (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |x| (QREFELT $ 34)) + (EXIT (|error| "cyclic list")))))) + (COND + ((NULL + (SPADCALL + (SPADCALL |x| (QREFELT $ 8)) + (SPADCALL |y| (QREFELT $ 8)) + (QREFELT $ 47))) + (EXIT + (PROGN + (LETT #0# 'NIL + |URAGG-;=;2AB;23|) + (GO #0#))))) + (LETT |x| + (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;=;2AB;23|) + (EXIT + (LETT |y| + (SPADCALL |y| (QREFELT $ 14)) + |URAGG-;=;2AB;23|))) + (LETT |k| (QSADD1 |k|) |URAGG-;=;2AB;23|) + (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 20)) + (SPADCALL |y| (QREFELT $ 20))) + ('T 'NIL))))))) + #0# (EXIT #0#))))) + +(DEFUN |URAGG-;node?;2AB;24| (|u| |v| $) + (PROG (|k| #0=#:G1513) + (RETURN + (SEQ (EXIT (SEQ (SEQ (LETT |k| 0 |URAGG-;node?;2AB;24|) G190 + (COND + ((NULL (SPADCALL + (SPADCALL |v| (QREFELT $ 20)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (EXIT (COND + ((SPADCALL |u| |v| + (QREFELT $ 49)) + (PROGN + (LETT #0# 'T + |URAGG-;node?;2AB;24|) + (GO #0#))) + ('T + (SEQ + (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |v| + (QREFELT $ 34)) + (EXIT + (|error| + "cyclic list")))))) + (EXIT + (LETT |v| + (SPADCALL |v| + (QREFELT $ 14)) + |URAGG-;node?;2AB;24|))))))) + (LETT |k| (QSADD1 |k|) + |URAGG-;node?;2AB;24|) + (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |u| |v| (QREFELT $ 49))))) + #0# (EXIT #0#))))) + +(DEFUN |URAGG-;setelt;Afirst2S;25| (|x| T3 |a| $) + (SPADCALL |x| |a| (QREFELT $ 51))) + +(DEFUN |URAGG-;setelt;Alast2S;26| (|x| T4 |a| $) + (SPADCALL |x| |a| (QREFELT $ 53))) + +(DEFUN |URAGG-;setelt;Arest2A;27| (|x| T5 |a| $) + (SPADCALL |x| |a| (QREFELT $ 55))) + +(DEFUN |URAGG-;concat;3A;28| (|x| |y| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 45)) |y| (QREFELT $ 57))) + +(DEFUN |URAGG-;setlast!;A2S;29| (|x| |s| $) + (SEQ (COND + ((SPADCALL |x| (QREFELT $ 20)) + (|error| "setlast: empty list")) + ('T + (SEQ (SPADCALL (SPADCALL |x| (QREFELT $ 23)) |s| + (QREFELT $ 51)) + (EXIT |s|)))))) + +(DEFUN |URAGG-;setchildren!;ALA;30| (|u| |lv| $) + (COND + ((EQL (LENGTH |lv|) 1) + (SPADCALL |u| (|SPADfirst| |lv|) (QREFELT $ 55))) + ('T (|error| "wrong number of children specified")))) + +(DEFUN |URAGG-;setvalue!;A2S;31| (|u| |s| $) + (SPADCALL |u| |s| (QREFELT $ 51))) + +(DEFUN |URAGG-;split!;AIA;32| (|p| |n| $) + (PROG (#0=#:G1524 |q|) + (RETURN + (SEQ (COND + ((< |n| 1) (|error| "index out of range")) + ('T + (SEQ (LETT |p| + (SPADCALL |p| + (PROG1 (LETT #0# (- |n| 1) + |URAGG-;split!;AIA;32|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 44)) + |URAGG-;split!;AIA;32|) + (LETT |q| (SPADCALL |p| (QREFELT $ 14)) + |URAGG-;split!;AIA;32|) + (SPADCALL |p| (SPADCALL (QREFELT $ 62)) + (QREFELT $ 55)) + (EXIT |q|)))))))) + +(DEFUN |URAGG-;cycleSplit!;2A;33| (|x| $) + (PROG (|y| |z|) + (RETURN + (SEQ (COND + ((OR (SPADCALL + (LETT |y| (SPADCALL |x| (QREFELT $ 38)) + |URAGG-;cycleSplit!;2A;33|) + (QREFELT $ 20)) + (SPADCALL |x| |y| (QREFELT $ 37))) + |y|) + ('T + (SEQ (LETT |z| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;cycleSplit!;2A;33|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL |z| |y| (QREFELT $ 37)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (LETT |x| |z| |URAGG-;cycleSplit!;2A;33|) + (EXIT (LETT |z| + (SPADCALL |z| (QREFELT $ 14)) + |URAGG-;cycleSplit!;2A;33|))) + NIL (GO G190) G191 (EXIT NIL)) + (SPADCALL |x| (SPADCALL (QREFELT $ 62)) + (QREFELT $ 55)) + (EXIT |y|)))))))) + +(DEFUN |UnaryRecursiveAggregate&| (|#1| |#2|) + (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) + . #0=(|UnaryRecursiveAggregate&|)) + (LETT |dv$2| (|devaluate| |#2|) . #0#) + (LETT |dv$| + (LIST '|UnaryRecursiveAggregate&| |dv$1| |dv$2|) . #0#) + (LETT $ (GETREFV 67) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasAttribute| |#1| '|shallowlyMutable|))) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (QSETREFV $ 7 |#2|) + (COND + ((|HasAttribute| |#1| '|finiteAggregate|) + (QSETREFV $ 46 + (CONS (|dispatchFunction| |URAGG-;last;ANniA;22|) $)))) + (COND + ((|HasCategory| |#2| '(|SetCategory|)) + (PROGN + (QSETREFV $ 48 + (CONS (|dispatchFunction| |URAGG-;=;2AB;23|) $)) + (QSETREFV $ 50 + (CONS (|dispatchFunction| |URAGG-;node?;2AB;24|) $))))) + (COND + ((|testBitVector| |pv$| 1) + (PROGN + (QSETREFV $ 52 + (CONS (|dispatchFunction| |URAGG-;setelt;Afirst2S;25|) + $)) + (QSETREFV $ 54 + (CONS (|dispatchFunction| |URAGG-;setelt;Alast2S;26|) + $)) + (QSETREFV $ 56 + (CONS (|dispatchFunction| |URAGG-;setelt;Arest2A;27|) + $)) + (QSETREFV $ 58 + (CONS (|dispatchFunction| |URAGG-;concat;3A;28|) $)) + (QSETREFV $ 59 + (CONS (|dispatchFunction| |URAGG-;setlast!;A2S;29|) $)) + (QSETREFV $ 60 + (CONS (|dispatchFunction| + |URAGG-;setchildren!;ALA;30|) + $)) + (QSETREFV $ 61 + (CONS (|dispatchFunction| |URAGG-;setvalue!;A2S;31|) + $)) + (QSETREFV $ 64 + (CONS (|dispatchFunction| |URAGG-;split!;AIA;32|) $)) + (QSETREFV $ 65 + (CONS (|dispatchFunction| |URAGG-;cycleSplit!;2A;33|) + $))))) + $)))) + +(MAKEPROP '|UnaryRecursiveAggregate&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (0 . |first|) '"first" |URAGG-;elt;AfirstS;1| (5 . |last|) + '"last" |URAGG-;elt;AlastS;2| (10 . |rest|) '"rest" + |URAGG-;elt;ArestA;3| |URAGG-;second;AS;4| + |URAGG-;third;AS;5| (|Boolean|) (15 . |empty?|) + (20 . |not|) |URAGG-;cyclic?;AB;6| (25 . |tail|) + |URAGG-;last;AS;7| (|List| $) |URAGG-;nodes;AL;8| + |URAGG-;children;AL;9| |URAGG-;leaf?;AB;10| + |URAGG-;value;AS;11| (|NonNegativeInteger|) + |URAGG-;less?;ANniB;12| |URAGG-;more?;ANniB;13| + |URAGG-;size?;ANniB;14| (30 . |cyclic?|) + |URAGG-;#;ANni;15| |URAGG-;tail;2A;16| (35 . |eq?|) + (41 . |cycleEntry|) |URAGG-;cycleTail;2A;18| + |URAGG-;cycleEntry;2A;19| |URAGG-;cycleLength;ANni;20| + |URAGG-;rest;ANniA;21| (46 . |#|) (51 . |rest|) + (57 . |copy|) (62 . |last|) (68 . =) (74 . =) (80 . =) + (86 . |node?|) (92 . |setfirst!|) (98 . |setelt|) + (105 . |setlast!|) (111 . |setelt|) (118 . |setrest!|) + (124 . |setelt|) (131 . |concat!|) (137 . |concat|) + (143 . |setlast!|) (149 . |setchildren!|) + (155 . |setvalue!|) (161 . |empty|) (|Integer|) + (165 . |split!|) (171 . |cycleSplit!|) '"value") + '#(|value| 176 |third| 181 |tail| 186 |split!| 191 |size?| + 197 |setvalue!| 203 |setlast!| 209 |setelt| 215 + |setchildren!| 236 |second| 242 |rest| 247 |nodes| 253 + |node?| 258 |more?| 264 |less?| 270 |leaf?| 276 |last| 281 + |elt| 292 |cyclic?| 310 |cycleTail| 315 |cycleSplit!| 320 + |cycleLength| 325 |cycleEntry| 330 |concat| 335 |children| + 341 = 346 |#| 352) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 65 + '(1 6 7 0 8 1 6 7 0 11 1 6 0 0 14 1 6 + 19 0 20 1 19 0 0 21 1 6 0 0 23 1 6 19 + 0 34 2 6 19 0 0 37 1 6 0 0 38 1 6 30 + 0 43 2 6 0 0 30 44 1 6 0 0 45 2 0 0 0 + 30 46 2 7 19 0 0 47 2 0 19 0 0 48 2 6 + 19 0 0 49 2 0 19 0 0 50 2 6 7 0 7 51 + 3 0 7 0 9 7 52 2 6 7 0 7 53 3 0 7 0 + 12 7 54 2 6 0 0 0 55 3 0 0 0 15 0 56 + 2 6 0 0 0 57 2 0 0 0 0 58 2 0 7 0 7 + 59 2 0 0 0 25 60 2 0 7 0 7 61 0 6 0 + 62 2 0 0 0 63 64 1 0 0 0 65 1 0 7 0 + 29 1 0 7 0 18 1 0 0 0 36 2 0 0 0 63 + 64 2 0 19 0 30 33 2 0 7 0 7 61 2 0 7 + 0 7 59 3 0 7 0 12 7 54 3 0 0 0 15 0 + 56 3 0 7 0 9 7 52 2 0 0 0 25 60 1 0 7 + 0 17 2 0 0 0 30 42 1 0 25 0 26 2 0 19 + 0 0 50 2 0 19 0 30 32 2 0 19 0 30 31 + 1 0 19 0 28 2 0 0 0 30 46 1 0 7 0 24 + 2 0 7 0 12 13 2 0 0 0 15 16 2 0 7 0 9 + 10 1 0 19 0 22 1 0 0 0 39 1 0 0 0 65 + 1 0 30 0 41 1 0 0 0 40 2 0 0 0 0 58 1 + 0 25 0 27 2 0 19 0 0 48 1 0 30 0 35))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/URAGG.lsp b/src/algebra/strap/URAGG.lsp new file mode 100644 index 00000000..e6d16cf0 --- /dev/null +++ b/src/algebra/strap/URAGG.lsp @@ -0,0 +1,113 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |UnaryRecursiveAggregate;CAT| 'NIL) + +(DEFPARAMETER |UnaryRecursiveAggregate;AL| 'NIL) + +(DEFUN |UnaryRecursiveAggregate| (#0=#:G1426) + (LET (#1=#:G1427) + (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#)))) + +(DEFUN |UnaryRecursiveAggregate;| (|t#1|) + (PROG (#0=#:G1425) + (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#) + (SETELT #0# 0 + (LIST '|UnaryRecursiveAggregate| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/VECTOR.lsp b/src/algebra/strap/VECTOR.lsp new file mode 100644 index 00000000..7de3d0c1 --- /dev/null +++ b/src/algebra/strap/VECTOR.lsp @@ -0,0 +1,133 @@ + +(/VERSIONCHECK 2) + +(DEFUN |VECTOR;vector;L$;1| (|l| $) + (SPADCALL |l| (|getShellEntry| $ 8))) + +(DEFUN |VECTOR;convert;$If;2| (|x| $) + (SPADCALL + (LIST (SPADCALL (SPADCALL "vector" (|getShellEntry| $ 12)) + (|getShellEntry| $ 14)) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 15)) + (|getShellEntry| $ 16))) + (|getShellEntry| $ 18))) + +(DEFUN |Vector| (#0=#:G1402) + (PROG () + (RETURN + (PROG (#1=#:G1403) + (RETURN + (COND + ((LETT #1# + (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) + (HGET |$ConstructorCache| '|Vector|) + '|domainEqualList|) + |Vector|) + (|CDRwithIncrement| #1#)) + ('T + (UNWIND-PROTECT + (PROG1 (|Vector;| #0#) (LETT #1# T |Vector|)) + (COND ((NOT #1#) (HREM |$ConstructorCache| '|Vector|))))))))))) + +(DEFUN |Vector;| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|Vector|)) + (LETT |dv$| (LIST '|Vector| |dv$1|) . #0#) + (LETT $ (|newShell| 36) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (OR (AND (|HasCategory| |#1| + '(|OrderedSet|)) + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + (AND (|HasCategory| |#1| + '(|SetCategory|)) + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|))))) + (OR (AND (|HasCategory| |#1| + '(|SetCategory|)) + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + (|HasCategory| |#1| + '(|CoercibleTo| (|OutputForm|)))) + (|HasCategory| |#1| + '(|ConvertibleTo| (|InputForm|))) + (OR (|HasCategory| |#1| '(|OrderedSet|)) + (|HasCategory| |#1| '(|SetCategory|))) + (|HasCategory| |#1| '(|OrderedSet|)) + (|HasCategory| (|Integer|) '(|OrderedSet|)) + (|HasCategory| |#1| '(|SetCategory|)) + (|HasCategory| |#1| '(|AbelianSemiGroup|)) + (|HasCategory| |#1| '(|AbelianMonoid|)) + (|HasCategory| |#1| '(|AbelianGroup|)) + (|HasCategory| |#1| '(|Monoid|)) + (|HasCategory| |#1| '(|Ring|)) + (AND (|HasCategory| |#1| + '(|RadicalCategory|)) + (|HasCategory| |#1| '(|Ring|))) + (AND (|HasCategory| |#1| '(|SetCategory|)) + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + (|HasCategory| |#1| + '(|CoercibleTo| (|OutputForm|))))) . #0#)) + (|haddProp| |$ConstructorCache| '|Vector| (LIST |dv$1|) + (CONS 1 $)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + (COND + ((|testBitVector| |pv$| 3) + (|setShellEntry| $ 19 + (CONS (|dispatchFunction| |VECTOR;convert;$If;2|) $)))) + $)))) + +(MAKEPROP '|Vector| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL (|IndexedVector| 6 (NRTEVAL 1)) + (|local| |#1|) (|List| 6) (0 . |construct|) + |VECTOR;vector;L$;1| (|String|) (|Symbol|) (5 . |coerce|) + (|InputForm|) (10 . |convert|) (15 . |parts|) + (20 . |convert|) (|List| $) (25 . |convert|) + (30 . |convert|) (|Mapping| 6 6 6) (|Boolean|) + (|NonNegativeInteger|) (|Equation| 6) (|List| 23) + (|Integer|) (|Mapping| 21 6) (|Mapping| 21 6 6) + (|UniversalSegment| 25) (|Void|) (|Mapping| 6 6) + (|OutputForm|) (|Matrix| 6) (|SingleInteger|) + (|Union| 6 '"failed") (|List| 25)) + '#(|vector| 35 |parts| 40 |convert| 45 |construct| 50) + '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) + (CONS (|makeByteWordVec2| 5 + '(0 0 0 0 0 0 0 5 0 0 1 4 0 0 1 2 3 4)) + (CONS '#(|VectorCategory&| + |OneDimensionalArrayAggregate&| + |FiniteLinearAggregate&| |LinearAggregate&| + |IndexedAggregate&| |Collection&| + |HomogeneousAggregate&| |OrderedSet&| + |Aggregate&| |EltableAggregate&| |Evalable&| + |SetCategory&| NIL NIL |InnerEvalable&| NIL + NIL |BasicType&|) + (CONS '#((|VectorCategory| 6) + (|OneDimensionalArrayAggregate| 6) + (|FiniteLinearAggregate| 6) + (|LinearAggregate| 6) + (|IndexedAggregate| 25 6) + (|Collection| 6) + (|HomogeneousAggregate| 6) + (|OrderedSet|) (|Aggregate|) + (|EltableAggregate| 25 6) (|Evalable| 6) + (|SetCategory|) (|Type|) + (|Eltable| 25 6) (|InnerEvalable| 6 6) + (|CoercibleTo| 31) (|ConvertibleTo| 13) + (|BasicType|)) + (|makeByteWordVec2| 19 + '(1 0 0 7 8 1 11 0 10 12 1 13 0 11 14 1 + 0 7 0 15 1 7 13 0 16 1 13 0 17 18 1 0 + 13 0 19 1 0 0 7 9 1 0 7 0 15 1 3 13 0 + 19 1 0 0 7 8))))) + '|lookupIncomplete|)) diff --git a/src/algebra/string.spad.pamphlet b/src/algebra/string.spad.pamphlet index d5b13181..0b155aae 100644 --- a/src/algebra/string.spad.pamphlet +++ b/src/algebra/string.spad.pamphlet @@ -114,186 +114,7 @@ Character: OrderedFinite() with CHAR_-DOWNCASE(c)$Lisp : % @ -\section{CHAR.lsp BOOTSTRAP} -{\bf CHAR} depends on a chain of -files. We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf CHAR} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf CHAR.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. -Note that this code is not included in the generated catdef.spad file. - -<<CHAR.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(PUT '|CHAR;=;2$B;1| '|SPADreplace| 'CHAR=) - -(DEFUN |CHAR;=;2$B;1| (|a| |b| $) (CHAR= |a| |b|)) - -(PUT '|CHAR;<;2$B;2| '|SPADreplace| 'CHAR<) - -(DEFUN |CHAR;<;2$B;2| (|a| |b| $) (CHAR< |a| |b|)) - -(PUT '|CHAR;size;Nni;3| '|SPADreplace| '(XLAM NIL 256)) - -(DEFUN |CHAR;size;Nni;3| ($) 256) - -(DEFUN |CHAR;index;Pi$;4| (|n| $) - (PROG (#0=#:G1389) - (RETURN - (SPADCALL - (PROG1 (LETT #0# (- |n| 1) |CHAR;index;Pi$;4|) - (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)) - (QREFELT $ 11))))) - -(DEFUN |CHAR;lookup;$Pi;5| (|c| $) - (PROG (#0=#:G1391) - (RETURN - (PROG1 (LETT #0# (+ 1 (SPADCALL |c| (QREFELT $ 14))) - |CHAR;lookup;$Pi;5|) - (|check-subtype| (> #0# 0) '(|PositiveInteger|) #0#))))) - -(PUT '|CHAR;char;Nni$;6| '|SPADreplace| 'CODE-CHAR) - -(DEFUN |CHAR;char;Nni$;6| (|n| $) (CODE-CHAR |n|)) - -(PUT '|CHAR;ord;$Nni;7| '|SPADreplace| 'CHAR-CODE) - -(DEFUN |CHAR;ord;$Nni;7| (|c| $) (CHAR-CODE |c|)) - -(DEFUN |CHAR;random;$;8| ($) - (SPADCALL (RANDOM (SPADCALL (QREFELT $ 10))) (QREFELT $ 11))) - -(PUT '|CHAR;space;$;9| '|SPADreplace| '(XLAM NIL (CHAR " " 0))) - -(DEFUN |CHAR;space;$;9| ($) (CHAR " " 0)) - -(PUT '|CHAR;quote;$;10| '|SPADreplace| '(XLAM NIL (CHAR "\" " 0))) - -(DEFUN |CHAR;quote;$;10| ($) (CHAR "\" " 0)) - -(PUT '|CHAR;escape;$;11| '|SPADreplace| '(XLAM NIL (CHAR "_ " 0))) - -(DEFUN |CHAR;escape;$;11| ($) (CHAR "_ " 0)) - -(PUT '|CHAR;coerce;$Of;12| '|SPADreplace| '(XLAM (|c|) |c|)) - -(DEFUN |CHAR;coerce;$Of;12| (|c| $) |c|) - -(DEFUN |CHAR;digit?;$B;13| (|c| $) - (SPADCALL |c| (|spadConstant| $ 23) (QREFELT $ 25))) - -(DEFUN |CHAR;hexDigit?;$B;14| (|c| $) - (SPADCALL |c| (|spadConstant| $ 27) (QREFELT $ 25))) - -(DEFUN |CHAR;upperCase?;$B;15| (|c| $) - (SPADCALL |c| (|spadConstant| $ 29) (QREFELT $ 25))) - -(DEFUN |CHAR;lowerCase?;$B;16| (|c| $) - (SPADCALL |c| (|spadConstant| $ 31) (QREFELT $ 25))) - -(DEFUN |CHAR;alphabetic?;$B;17| (|c| $) - (SPADCALL |c| (|spadConstant| $ 33) (QREFELT $ 25))) - -(DEFUN |CHAR;alphanumeric?;$B;18| (|c| $) - (SPADCALL |c| (|spadConstant| $ 35) (QREFELT $ 25))) - -(DEFUN |CHAR;latex;$S;19| (|c| $) - (STRCONC "\\mbox{`" (STRCONC (MAKE-FULL-CVEC 1 |c|) "'}"))) - -(DEFUN |CHAR;char;S$;20| (|s| $) - (COND - ((EQL (QCSIZE |s|) 1) - (SPADCALL |s| (SPADCALL |s| (QREFELT $ 40)) (QREFELT $ 41))) - ('T (|userError| "String is not a single character")))) - -(PUT '|CHAR;upperCase;2$;21| '|SPADreplace| 'CHAR-UPCASE) - -(DEFUN |CHAR;upperCase;2$;21| (|c| $) (CHAR-UPCASE |c|)) - -(PUT '|CHAR;lowerCase;2$;22| '|SPADreplace| 'CHAR-DOWNCASE) - -(DEFUN |CHAR;lowerCase;2$;22| (|c| $) (CHAR-DOWNCASE |c|)) - -(DEFUN |Character| () - (PROG () - (RETURN - (PROG (#0=#:G1412) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|Character|) - |Character|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Character| - (LIST - (CONS NIL (CONS 1 (|Character;|)))))) - (LETT #0# T |Character|)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|Character|))))))))))) - -(DEFUN |Character;| () - (PROG (|dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$| '(|Character|) . #0=(|Character|)) - (LETT $ (|newShell| 46) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|haddProp| |$ConstructorCache| '|Character| NIL (CONS 1 $)) - (|stuffDomainSlots| $) - $)))) - -(MAKEPROP '|Character| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|Boolean|) |CHAR;=;2$B;1| - |CHAR;<;2$B;2| (|NonNegativeInteger|) |CHAR;size;Nni;3| - |CHAR;char;Nni$;6| (|PositiveInteger|) |CHAR;index;Pi$;4| - |CHAR;ord;$Nni;7| |CHAR;lookup;$Pi;5| |CHAR;random;$;8| - |CHAR;space;$;9| |CHAR;quote;$;10| |CHAR;escape;$;11| - (|OutputForm|) |CHAR;coerce;$Of;12| (|CharacterClass|) - (0 . |digit|) (|Character|) (4 . |member?|) - |CHAR;digit?;$B;13| (10 . |hexDigit|) - |CHAR;hexDigit?;$B;14| (14 . |upperCase|) - |CHAR;upperCase?;$B;15| (18 . |lowerCase|) - |CHAR;lowerCase?;$B;16| (22 . |alphabetic|) - |CHAR;alphabetic?;$B;17| (26 . |alphanumeric|) - |CHAR;alphanumeric?;$B;18| (|String|) |CHAR;latex;$S;19| - (|Integer|) (30 . |minIndex|) (35 . |elt|) - |CHAR;char;S$;20| |CHAR;upperCase;2$;21| - |CHAR;lowerCase;2$;22| (|SingleInteger|)) - '#(~= 41 |upperCase?| 47 |upperCase| 52 |space| 57 |size| 61 - |random| 65 |quote| 69 |ord| 73 |min| 78 |max| 84 - |lowerCase?| 90 |lowerCase| 95 |lookup| 100 |latex| 105 - |index| 110 |hexDigit?| 115 |hash| 120 |escape| 125 - |digit?| 129 |coerce| 134 |char| 139 |alphanumeric?| 149 - |alphabetic?| 154 >= 159 > 165 = 171 <= 177 < 183) - 'NIL - (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0)) - (CONS '#(NIL |OrderedSet&| NIL |SetCategory&| - |BasicType&| NIL) - (CONS '#((|OrderedFinite|) (|OrderedSet|) - (|Finite|) (|SetCategory|) (|BasicType|) - (|CoercibleTo| 20)) - (|makeByteWordVec2| 45 - '(0 22 0 23 2 22 6 24 0 25 0 22 0 27 0 - 22 0 29 0 22 0 31 0 22 0 33 0 22 0 35 - 1 37 39 0 40 2 37 24 0 39 41 2 0 6 0 - 0 1 1 0 6 0 30 1 0 0 0 43 0 0 0 17 0 - 0 9 10 0 0 0 16 0 0 0 18 1 0 9 0 14 2 - 0 0 0 0 1 2 0 0 0 0 1 1 0 6 0 32 1 0 - 0 0 44 1 0 12 0 15 1 0 37 0 38 1 0 0 - 12 13 1 0 6 0 28 1 0 45 0 1 0 0 0 19 - 1 0 6 0 26 1 0 20 0 21 1 0 0 37 42 1 - 0 0 9 11 1 0 6 0 36 1 0 6 0 34 2 0 6 - 0 0 1 2 0 6 0 0 1 2 0 6 0 0 7 2 0 6 0 - 0 1 2 0 6 0 0 8))))) - '|lookupComplete|)) - -(MAKEPROP '|Character| 'NILADIC T) -@ \section{domain CCLASS CharacterClass} <<domain CCLASS CharacterClass>>= )abbrev domain CCLASS CharacterClass @@ -623,909 +444,7 @@ the coercion. true @ -\section{ISTRING.lsp BOOTSTRAP} -{\bf ISTRING} depends on a chain of -files. We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf ISTRING} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf ISTRING.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<ISTRING.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(PUT '|ISTRING;new;NniC$;1| '|SPADreplace| 'MAKE-FULL-CVEC) - -(DEFUN |ISTRING;new;NniC$;1| (|n| |c| $) (MAKE-FULL-CVEC |n| |c|)) - -(PUT '|ISTRING;empty;$;2| '|SPADreplace| - '(XLAM NIL (MAKE-FULL-CVEC 0))) - -(DEFUN |ISTRING;empty;$;2| ($) (MAKE-FULL-CVEC 0)) - -(DEFUN |ISTRING;empty?;$B;3| (|s| $) (EQL (QCSIZE |s|) 0)) - -(PUT '|ISTRING;#;$Nni;4| '|SPADreplace| 'QCSIZE) - -(DEFUN |ISTRING;#;$Nni;4| (|s| $) (QCSIZE |s|)) - -(PUT '|ISTRING;=;2$B;5| '|SPADreplace| 'EQUAL) - -(DEFUN |ISTRING;=;2$B;5| (|s| |t| $) (EQUAL |s| |t|)) - -(PUT '|ISTRING;<;2$B;6| '|SPADreplace| - '(XLAM (|s| |t|) (CGREATERP |t| |s|))) - -(DEFUN |ISTRING;<;2$B;6| (|s| |t| $) (CGREATERP |t| |s|)) - -(PUT '|ISTRING;concat;3$;7| '|SPADreplace| 'STRCONC) - -(DEFUN |ISTRING;concat;3$;7| (|s| |t| $) (STRCONC |s| |t|)) - -(PUT '|ISTRING;copy;2$;8| '|SPADreplace| 'COPY-SEQ) - -(DEFUN |ISTRING;copy;2$;8| (|s| $) (COPY-SEQ |s|)) - -(DEFUN |ISTRING;insert;2$I$;9| (|s| |t| |i| $) - (SPADCALL - (SPADCALL - (SPADCALL |s| - (SPADCALL (QREFELT $ 6) (- |i| 1) (QREFELT $ 20)) - (QREFELT $ 21)) - |t| (QREFELT $ 16)) - (SPADCALL |s| (SPADCALL |i| (QREFELT $ 22)) (QREFELT $ 21)) - (QREFELT $ 16))) - -(DEFUN |ISTRING;coerce;$Of;10| (|s| $) (SPADCALL |s| (QREFELT $ 26))) - -(DEFUN |ISTRING;minIndex;$I;11| (|s| $) (QREFELT $ 6)) - -(DEFUN |ISTRING;upperCase!;2$;12| (|s| $) - (SPADCALL (ELT $ 31) |s| (QREFELT $ 33))) - -(DEFUN |ISTRING;lowerCase!;2$;13| (|s| $) - (SPADCALL (ELT $ 36) |s| (QREFELT $ 33))) - -(DEFUN |ISTRING;latex;$S;14| (|s| $) - (STRCONC "\\mbox{``" (STRCONC |s| "''}"))) - -(DEFUN |ISTRING;replace;$Us2$;15| (|s| |sg| |t| $) - (PROG (|l| |m| |n| |h| #0=#:G1770 |r| #1=#:G1776 #2=#:G1777 |i| - #3=#:G1778 |k|) - (RETURN - (SEQ (LETT |l| (- (SPADCALL |sg| (QREFELT $ 39)) (QREFELT $ 6)) - |ISTRING;replace;$Us2$;15|) - (LETT |m| (SPADCALL |s| (QREFELT $ 13)) - |ISTRING;replace;$Us2$;15|) - (LETT |n| (SPADCALL |t| (QREFELT $ 13)) - |ISTRING;replace;$Us2$;15|) - (LETT |h| - (COND - ((SPADCALL |sg| (QREFELT $ 40)) - (- (SPADCALL |sg| (QREFELT $ 41)) (QREFELT $ 6))) - ('T (- (SPADCALL |s| (QREFELT $ 42)) (QREFELT $ 6)))) - |ISTRING;replace;$Us2$;15|) - (COND - ((OR (OR (< |l| 0) (NULL (< |h| |m|))) (< |h| (- |l| 1))) - (EXIT (|error| "index out of range")))) - (LETT |r| - (SPADCALL - (PROG1 (LETT #0# (+ (- |m| (+ (- |h| |l|) 1)) |n|) - |ISTRING;replace;$Us2$;15|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (SPADCALL (QREFELT $ 43)) (QREFELT $ 9)) - |ISTRING;replace;$Us2$;15|) - (SEQ (LETT |i| 0 |ISTRING;replace;$Us2$;15|) - (LETT #1# (- |l| 1) |ISTRING;replace;$Us2$;15|) - (LETT |k| 0 |ISTRING;replace;$Us2$;15|) G190 - (COND ((QSGREATERP |i| #1#) (GO G191))) - (SEQ (EXIT (QESET |r| |k| (CHAR |s| |i|)))) - (LETT |k| - (PROG1 (QSADD1 |k|) - (LETT |i| (QSADD1 |i|) - |ISTRING;replace;$Us2$;15|)) - |ISTRING;replace;$Us2$;15|) - (GO G190) G191 (EXIT NIL)) - (SEQ (LETT |i| 0 |ISTRING;replace;$Us2$;15|) - (LETT #2# (- |n| 1) |ISTRING;replace;$Us2$;15|) - (LETT |k| |k| |ISTRING;replace;$Us2$;15|) G190 - (COND ((QSGREATERP |i| #2#) (GO G191))) - (SEQ (EXIT (QESET |r| |k| (CHAR |t| |i|)))) - (LETT |k| - (PROG1 (+ |k| 1) - (LETT |i| (QSADD1 |i|) - |ISTRING;replace;$Us2$;15|)) - |ISTRING;replace;$Us2$;15|) - (GO G190) G191 (EXIT NIL)) - (SEQ (LETT |i| (+ |h| 1) |ISTRING;replace;$Us2$;15|) - (LETT #3# (- |m| 1) |ISTRING;replace;$Us2$;15|) - (LETT |k| |k| |ISTRING;replace;$Us2$;15|) G190 - (COND ((> |i| #3#) (GO G191))) - (SEQ (EXIT (QESET |r| |k| (CHAR |s| |i|)))) - (LETT |k| - (PROG1 (+ |k| 1) - (LETT |i| (+ |i| 1) |ISTRING;replace;$Us2$;15|)) - |ISTRING;replace;$Us2$;15|) - (GO G190) G191 (EXIT NIL)) - (EXIT |r|))))) - -(DEFUN |ISTRING;setelt;$I2C;16| (|s| |i| |c| $) - (SEQ (COND - ((OR (< |i| (QREFELT $ 6)) - (< (SPADCALL |s| (QREFELT $ 42)) |i|)) - (|error| "index out of range")) - ('T (SEQ (QESET |s| (- |i| (QREFELT $ 6)) |c|) (EXIT |c|)))))) - -(DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $) - (PROG (|np| |nw| |iw| |ip| #0=#:G1788 #1=#:G1787 #2=#:G1783) - (RETURN - (SEQ (EXIT (SEQ (LETT |np| (QCSIZE |part|) - |ISTRING;substring?;2$IB;17|) - (LETT |nw| (QCSIZE |whole|) - |ISTRING;substring?;2$IB;17|) - (LETT |startpos| (- |startpos| (QREFELT $ 6)) - |ISTRING;substring?;2$IB;17|) - (EXIT (COND - ((< |startpos| 0) - (|error| "index out of bounds")) - ((< (- |nw| |startpos|) |np|) 'NIL) - ('T - (SEQ (SEQ - (EXIT - (SEQ - (LETT |iw| |startpos| - |ISTRING;substring?;2$IB;17|) - (LETT |ip| 0 - |ISTRING;substring?;2$IB;17|) - (LETT #0# (- |np| 1) - |ISTRING;substring?;2$IB;17|) - G190 - (COND - ((QSGREATERP |ip| #0#) - (GO G191))) - (SEQ - (EXIT - (COND - ((NULL - (CHAR= (CHAR |part| |ip|) - (CHAR |whole| |iw|))) - (PROGN - (LETT #2# - (PROGN - (LETT #1# 'NIL - |ISTRING;substring?;2$IB;17|) - (GO #1#)) - |ISTRING;substring?;2$IB;17|) - (GO #2#)))))) - (LETT |ip| - (PROG1 (QSADD1 |ip|) - (LETT |iw| (+ |iw| 1) - |ISTRING;substring?;2$IB;17|)) - |ISTRING;substring?;2$IB;17|) - (GO G190) G191 (EXIT NIL))) - #2# (EXIT #2#)) - (EXIT 'T))))))) - #1# (EXIT #1#))))) - -(DEFUN |ISTRING;position;2$2I;18| (|s| |t| |startpos| $) - (PROG (|r|) - (RETURN - (SEQ (LETT |startpos| (- |startpos| (QREFELT $ 6)) - |ISTRING;position;2$2I;18|) - (EXIT (COND - ((< |startpos| 0) (|error| "index out of bounds")) - ((NULL (< |startpos| (QCSIZE |t|))) - (- (QREFELT $ 6) 1)) - ('T - (SEQ (LETT |r| (STRPOS |s| |t| |startpos| NIL) - |ISTRING;position;2$2I;18|) - (EXIT (COND - ((EQ |r| NIL) (- (QREFELT $ 6) 1)) - ('T (+ |r| (QREFELT $ 6))))))))))))) - -(DEFUN |ISTRING;position;C$2I;19| (|c| |t| |startpos| $) - (PROG (|r| #0=#:G1799 #1=#:G1798) - (RETURN - (SEQ (EXIT (SEQ (LETT |startpos| (- |startpos| (QREFELT $ 6)) - |ISTRING;position;C$2I;19|) - (EXIT (COND - ((< |startpos| 0) - (|error| "index out of bounds")) - ((NULL (< |startpos| (QCSIZE |t|))) - (- (QREFELT $ 6) 1)) - ('T - (SEQ (SEQ - (LETT |r| |startpos| - |ISTRING;position;C$2I;19|) - (LETT #0# - (QSDIFFERENCE (QCSIZE |t|) 1) - |ISTRING;position;C$2I;19|) - G190 - (COND ((> |r| #0#) (GO G191))) - (SEQ - (EXIT - (COND - ((CHAR= (CHAR |t| |r|) |c|) - (PROGN - (LETT #1# - (+ |r| (QREFELT $ 6)) - |ISTRING;position;C$2I;19|) - (GO #1#)))))) - (LETT |r| (+ |r| 1) - |ISTRING;position;C$2I;19|) - (GO G190) G191 (EXIT NIL)) - (EXIT (- (QREFELT $ 6) 1)))))))) - #1# (EXIT #1#))))) - -(DEFUN |ISTRING;position;Cc$2I;20| (|cc| |t| |startpos| $) - (PROG (|r| #0=#:G1806 #1=#:G1805) - (RETURN - (SEQ (EXIT (SEQ (LETT |startpos| (- |startpos| (QREFELT $ 6)) - |ISTRING;position;Cc$2I;20|) - (EXIT (COND - ((< |startpos| 0) - (|error| "index out of bounds")) - ((NULL (< |startpos| (QCSIZE |t|))) - (- (QREFELT $ 6) 1)) - ('T - (SEQ (SEQ - (LETT |r| |startpos| - |ISTRING;position;Cc$2I;20|) - (LETT #0# - (QSDIFFERENCE (QCSIZE |t|) 1) - |ISTRING;position;Cc$2I;20|) - G190 - (COND ((> |r| #0#) (GO G191))) - (SEQ - (EXIT - (COND - ((SPADCALL (CHAR |t| |r|) |cc| - (QREFELT $ 49)) - (PROGN - (LETT #1# - (+ |r| (QREFELT $ 6)) - |ISTRING;position;Cc$2I;20|) - (GO #1#)))))) - (LETT |r| (+ |r| 1) - |ISTRING;position;Cc$2I;20|) - (GO G190) G191 (EXIT NIL)) - (EXIT (- (QREFELT $ 6) 1)))))))) - #1# (EXIT #1#))))) - -(DEFUN |ISTRING;suffix?;2$B;21| (|s| |t| $) - (PROG (|n| |m|) - (RETURN - (SEQ (LETT |n| (SPADCALL |t| (QREFELT $ 42)) - |ISTRING;suffix?;2$B;21|) - (LETT |m| (SPADCALL |s| (QREFELT $ 42)) - |ISTRING;suffix?;2$B;21|) - (EXIT (COND - ((< |n| |m|) 'NIL) - ('T - (SPADCALL |s| |t| (- (+ (QREFELT $ 6) |n|) |m|) - (QREFELT $ 46))))))))) - -(DEFUN |ISTRING;split;$CL;22| (|s| |c| $) - (PROG (|n| |j| |i| |l|) - (RETURN - (SEQ (LETT |n| (SPADCALL |s| (QREFELT $ 42)) - |ISTRING;split;$CL;22|) - (SEQ (LETT |i| (QREFELT $ 6) |ISTRING;split;$CL;22|) G190 - (COND - ((OR (> |i| |n|) - (NULL (SPADCALL - (SPADCALL |s| |i| (QREFELT $ 52)) |c| - (QREFELT $ 53)))) - (GO G191))) - (SEQ (EXIT 0)) - (LETT |i| (+ |i| 1) |ISTRING;split;$CL;22|) (GO G190) - G191 (EXIT NIL)) - (LETT |l| (SPADCALL (QREFELT $ 55)) |ISTRING;split;$CL;22|) - (SEQ G190 - (COND - ((NULL (COND - ((< |n| |i|) 'NIL) - ('T - (SPADCALL - (< (LETT |j| - (SPADCALL |c| |s| |i| - (QREFELT $ 48)) - |ISTRING;split;$CL;22|) - (QREFELT $ 6)) - (QREFELT $ 56))))) - (GO G191))) - (SEQ (LETT |l| - (SPADCALL - (SPADCALL |s| - (SPADCALL |i| (- |j| 1) - (QREFELT $ 20)) - (QREFELT $ 21)) - |l| (QREFELT $ 57)) - |ISTRING;split;$CL;22|) - (EXIT (SEQ (LETT |i| |j| |ISTRING;split;$CL;22|) - G190 - (COND - ((OR (> |i| |n|) - (NULL - (SPADCALL - (SPADCALL |s| |i| (QREFELT $ 52)) - |c| (QREFELT $ 53)))) - (GO G191))) - (SEQ (EXIT 0)) - (LETT |i| (+ |i| 1) - |ISTRING;split;$CL;22|) - (GO G190) G191 (EXIT NIL)))) - NIL (GO G190) G191 (EXIT NIL)) - (COND - ((NULL (< |n| |i|)) - (LETT |l| - (SPADCALL - (SPADCALL |s| (SPADCALL |i| |n| (QREFELT $ 20)) - (QREFELT $ 21)) - |l| (QREFELT $ 57)) - |ISTRING;split;$CL;22|))) - (EXIT (SPADCALL |l| (QREFELT $ 58))))))) - -(DEFUN |ISTRING;split;$CcL;23| (|s| |cc| $) - (PROG (|n| |j| |i| |l|) - (RETURN - (SEQ (LETT |n| (SPADCALL |s| (QREFELT $ 42)) - |ISTRING;split;$CcL;23|) - (SEQ (LETT |i| (QREFELT $ 6) |ISTRING;split;$CcL;23|) G190 - (COND - ((OR (> |i| |n|) - (NULL (SPADCALL - (SPADCALL |s| |i| (QREFELT $ 52)) |cc| - (QREFELT $ 49)))) - (GO G191))) - (SEQ (EXIT 0)) - (LETT |i| (+ |i| 1) |ISTRING;split;$CcL;23|) (GO G190) - G191 (EXIT NIL)) - (LETT |l| (SPADCALL (QREFELT $ 55)) |ISTRING;split;$CcL;23|) - (SEQ G190 - (COND - ((NULL (COND - ((< |n| |i|) 'NIL) - ('T - (SPADCALL - (< (LETT |j| - (SPADCALL |cc| |s| |i| - (QREFELT $ 50)) - |ISTRING;split;$CcL;23|) - (QREFELT $ 6)) - (QREFELT $ 56))))) - (GO G191))) - (SEQ (LETT |l| - (SPADCALL - (SPADCALL |s| - (SPADCALL |i| (- |j| 1) - (QREFELT $ 20)) - (QREFELT $ 21)) - |l| (QREFELT $ 57)) - |ISTRING;split;$CcL;23|) - (EXIT (SEQ (LETT |i| |j| |ISTRING;split;$CcL;23|) - G190 - (COND - ((OR (> |i| |n|) - (NULL - (SPADCALL - (SPADCALL |s| |i| (QREFELT $ 52)) - |cc| (QREFELT $ 49)))) - (GO G191))) - (SEQ (EXIT 0)) - (LETT |i| (+ |i| 1) - |ISTRING;split;$CcL;23|) - (GO G190) G191 (EXIT NIL)))) - NIL (GO G190) G191 (EXIT NIL)) - (COND - ((NULL (< |n| |i|)) - (LETT |l| - (SPADCALL - (SPADCALL |s| (SPADCALL |i| |n| (QREFELT $ 20)) - (QREFELT $ 21)) - |l| (QREFELT $ 57)) - |ISTRING;split;$CcL;23|))) - (EXIT (SPADCALL |l| (QREFELT $ 58))))))) - -(DEFUN |ISTRING;leftTrim;$C$;24| (|s| |c| $) - (PROG (|n| |i|) - (RETURN - (SEQ (LETT |n| (SPADCALL |s| (QREFELT $ 42)) - |ISTRING;leftTrim;$C$;24|) - (SEQ (LETT |i| (QREFELT $ 6) |ISTRING;leftTrim;$C$;24|) G190 - (COND - ((OR (> |i| |n|) - (NULL (SPADCALL - (SPADCALL |s| |i| (QREFELT $ 52)) |c| - (QREFELT $ 53)))) - (GO G191))) - (SEQ (EXIT 0)) - (LETT |i| (+ |i| 1) |ISTRING;leftTrim;$C$;24|) - (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |s| (SPADCALL |i| |n| (QREFELT $ 20)) - (QREFELT $ 21))))))) - -(DEFUN |ISTRING;leftTrim;$Cc$;25| (|s| |cc| $) - (PROG (|n| |i|) - (RETURN - (SEQ (LETT |n| (SPADCALL |s| (QREFELT $ 42)) - |ISTRING;leftTrim;$Cc$;25|) - (SEQ (LETT |i| (QREFELT $ 6) |ISTRING;leftTrim;$Cc$;25|) - G190 - (COND - ((OR (> |i| |n|) - (NULL (SPADCALL - (SPADCALL |s| |i| (QREFELT $ 52)) |cc| - (QREFELT $ 49)))) - (GO G191))) - (SEQ (EXIT 0)) - (LETT |i| (+ |i| 1) |ISTRING;leftTrim;$Cc$;25|) - (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |s| (SPADCALL |i| |n| (QREFELT $ 20)) - (QREFELT $ 21))))))) - -(DEFUN |ISTRING;rightTrim;$C$;26| (|s| |c| $) - (PROG (|j| #0=#:G1830) - (RETURN - (SEQ (SEQ (LETT |j| (SPADCALL |s| (QREFELT $ 42)) - |ISTRING;rightTrim;$C$;26|) - (LETT #0# (QREFELT $ 6) |ISTRING;rightTrim;$C$;26|) - G190 - (COND - ((OR (< |j| #0#) - (NULL (SPADCALL - (SPADCALL |s| |j| (QREFELT $ 52)) |c| - (QREFELT $ 53)))) - (GO G191))) - (SEQ (EXIT 0)) - (LETT |j| (+ |j| -1) |ISTRING;rightTrim;$C$;26|) - (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |s| - (SPADCALL (SPADCALL |s| (QREFELT $ 28)) |j| - (QREFELT $ 20)) - (QREFELT $ 21))))))) - -(DEFUN |ISTRING;rightTrim;$Cc$;27| (|s| |cc| $) - (PROG (|j| #0=#:G1834) - (RETURN - (SEQ (SEQ (LETT |j| (SPADCALL |s| (QREFELT $ 42)) - |ISTRING;rightTrim;$Cc$;27|) - (LETT #0# (QREFELT $ 6) |ISTRING;rightTrim;$Cc$;27|) - G190 - (COND - ((OR (< |j| #0#) - (NULL (SPADCALL - (SPADCALL |s| |j| (QREFELT $ 52)) |cc| - (QREFELT $ 49)))) - (GO G191))) - (SEQ (EXIT 0)) - (LETT |j| (+ |j| -1) |ISTRING;rightTrim;$Cc$;27|) - (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |s| - (SPADCALL (SPADCALL |s| (QREFELT $ 28)) |j| - (QREFELT $ 20)) - (QREFELT $ 21))))))) - -(DEFUN |ISTRING;concat;L$;28| (|l| $) - (PROG (#0=#:G1842 #1=#:G1837 #2=#:G1835 #3=#:G1836 |t| |s| #4=#:G1843 - |i|) - (RETURN - (SEQ (LETT |t| - (SPADCALL - (PROGN - (LETT #3# NIL |ISTRING;concat;L$;28|) - (SEQ (LETT |s| NIL |ISTRING;concat;L$;28|) - (LETT #0# |l| |ISTRING;concat;L$;28|) G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |s| (CAR #0#) - |ISTRING;concat;L$;28|) - NIL)) - (GO G191))) - (SEQ (EXIT (PROGN - (LETT #1# - (SPADCALL |s| (QREFELT $ 13)) - |ISTRING;concat;L$;28|) - (COND - (#3# - (LETT #2# (+ #2# #1#) - |ISTRING;concat;L$;28|)) - ('T - (PROGN - (LETT #2# #1# - |ISTRING;concat;L$;28|) - (LETT #3# 'T - |ISTRING;concat;L$;28|))))))) - (LETT #0# (CDR #0#) |ISTRING;concat;L$;28|) - (GO G190) G191 (EXIT NIL)) - (COND (#3# #2#) ('T 0))) - (SPADCALL (QREFELT $ 43)) (QREFELT $ 9)) - |ISTRING;concat;L$;28|) - (LETT |i| (QREFELT $ 6) |ISTRING;concat;L$;28|) - (SEQ (LETT |s| NIL |ISTRING;concat;L$;28|) - (LETT #4# |l| |ISTRING;concat;L$;28|) G190 - (COND - ((OR (ATOM #4#) - (PROGN - (LETT |s| (CAR #4#) |ISTRING;concat;L$;28|) - NIL)) - (GO G191))) - (SEQ (SPADCALL |t| |s| |i| (QREFELT $ 66)) - (EXIT (LETT |i| - (+ |i| (SPADCALL |s| (QREFELT $ 13))) - |ISTRING;concat;L$;28|))) - (LETT #4# (CDR #4#) |ISTRING;concat;L$;28|) (GO G190) - G191 (EXIT NIL)) - (EXIT |t|))))) - -(DEFUN |ISTRING;copyInto!;2$I$;29| (|y| |x| |s| $) - (PROG (|m| |n|) - (RETURN - (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 13)) - |ISTRING;copyInto!;2$I$;29|) - (LETT |n| (SPADCALL |y| (QREFELT $ 13)) - |ISTRING;copyInto!;2$I$;29|) - (LETT |s| (- |s| (QREFELT $ 6)) |ISTRING;copyInto!;2$I$;29|) - (COND - ((OR (< |s| 0) (< |n| (+ |s| |m|))) - (EXIT (|error| "index out of range")))) - (RPLACSTR |y| |s| |m| |x| 0 |m|) (EXIT |y|))))) - -(DEFUN |ISTRING;elt;$IC;30| (|s| |i| $) - (COND - ((OR (< |i| (QREFELT $ 6)) (< (SPADCALL |s| (QREFELT $ 42)) |i|)) - (|error| "index out of range")) - ('T (CHAR |s| (- |i| (QREFELT $ 6)))))) - -(DEFUN |ISTRING;elt;$Us$;31| (|s| |sg| $) - (PROG (|l| |h|) - (RETURN - (SEQ (LETT |l| (- (SPADCALL |sg| (QREFELT $ 39)) (QREFELT $ 6)) - |ISTRING;elt;$Us$;31|) - (LETT |h| - (COND - ((SPADCALL |sg| (QREFELT $ 40)) - (- (SPADCALL |sg| (QREFELT $ 41)) (QREFELT $ 6))) - ('T (- (SPADCALL |s| (QREFELT $ 42)) (QREFELT $ 6)))) - |ISTRING;elt;$Us$;31|) - (COND - ((OR (< |l| 0) - (NULL (< |h| (SPADCALL |s| (QREFELT $ 13))))) - (EXIT (|error| "index out of bound")))) - (EXIT (SUBSTRING |s| |l| (MAX 0 (+ (- |h| |l|) 1)))))))) - -(DEFUN |ISTRING;hash;$I;32| (|s| $) - (PROG (|n|) - (RETURN - (SEQ (LETT |n| (QCSIZE |s|) |ISTRING;hash;$I;32|) - (EXIT (COND - ((ZEROP |n|) 0) - ((EQL |n| 1) - (SPADCALL - (SPADCALL |s| (QREFELT $ 6) (QREFELT $ 52)) - (QREFELT $ 68))) - ('T - (* (* (SPADCALL - (SPADCALL |s| (QREFELT $ 6) - (QREFELT $ 52)) - (QREFELT $ 68)) - (SPADCALL - (SPADCALL |s| (- (+ (QREFELT $ 6) |n|) 1) - (QREFELT $ 52)) - (QREFELT $ 68))) - (SPADCALL - (SPADCALL |s| - (+ (QREFELT $ 6) (QUOTIENT2 |n| 2)) - (QREFELT $ 52)) - (QREFELT $ 68)))))))))) - -(DEFUN |ISTRING;match;2$CNni;33| (|pattern| |target| |wildcard| $) - (|stringMatch| |pattern| |target| (CHARACTER |wildcard|))) - -(DEFUN |ISTRING;match?;2$CB;34| (|pattern| |target| |dontcare| $) - (PROG (|n| |m| #0=#:G1857 #1=#:G1859 |s| #2=#:G1860 #3=#:G1868 |i| - |p| #4=#:G1861 |q|) - (RETURN - (SEQ (EXIT (SEQ (LETT |n| (SPADCALL |pattern| (QREFELT $ 42)) - |ISTRING;match?;2$CB;34|) - (LETT |p| - (PROG1 (LETT #0# - (SPADCALL |dontcare| |pattern| - (LETT |m| - (SPADCALL |pattern| - (QREFELT $ 28)) - |ISTRING;match?;2$CB;34|) - (QREFELT $ 48)) - |ISTRING;match?;2$CB;34|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - |ISTRING;match?;2$CB;34|) - (EXIT (COND - ((EQL |p| (- |m| 1)) - (SPADCALL |pattern| |target| - (QREFELT $ 14))) - ('T - (SEQ (COND - ((NULL (EQL |p| |m|)) - (COND - ((NULL - (SPADCALL - (SPADCALL |pattern| - (SPADCALL |m| (- |p| 1) - (QREFELT $ 20)) - (QREFELT $ 21)) - |target| (QREFELT $ 71))) - (EXIT 'NIL))))) - (LETT |i| |p| - |ISTRING;match?;2$CB;34|) - (LETT |q| - (PROG1 - (LETT #1# - (SPADCALL |dontcare| |pattern| - (+ |p| 1) (QREFELT $ 48)) - |ISTRING;match?;2$CB;34|) - (|check-subtype| (>= #1# 0) - '(|NonNegativeInteger|) #1#)) - |ISTRING;match?;2$CB;34|) - (SEQ G190 - (COND - ((NULL - (SPADCALL (EQL |q| (- |m| 1)) - (QREFELT $ 56))) - (GO G191))) - (SEQ - (LETT |s| - (SPADCALL |pattern| - (SPADCALL (+ |p| 1) (- |q| 1) - (QREFELT $ 20)) - (QREFELT $ 21)) - |ISTRING;match?;2$CB;34|) - (LETT |i| - (PROG1 - (LETT #2# - (SPADCALL |s| |target| |i| - (QREFELT $ 47)) - |ISTRING;match?;2$CB;34|) - (|check-subtype| (>= #2# 0) - '(|NonNegativeInteger|) #2#)) - |ISTRING;match?;2$CB;34|) - (EXIT - (COND - ((EQL |i| (- |m| 1)) - (PROGN - (LETT #3# 'NIL - |ISTRING;match?;2$CB;34|) - (GO #3#))) - ('T - (SEQ - (LETT |i| - (+ |i| - (SPADCALL |s| - (QREFELT $ 13))) - |ISTRING;match?;2$CB;34|) - (LETT |p| |q| - |ISTRING;match?;2$CB;34|) - (EXIT - (LETT |q| - (PROG1 - (LETT #4# - (SPADCALL |dontcare| - |pattern| (+ |q| 1) - (QREFELT $ 48)) - |ISTRING;match?;2$CB;34|) - (|check-subtype| - (>= #4# 0) - '(|NonNegativeInteger|) - #4#)) - |ISTRING;match?;2$CB;34|))))))) - NIL (GO G190) G191 (EXIT NIL)) - (COND - ((NULL (EQL |p| |n|)) - (COND - ((NULL - (SPADCALL - (SPADCALL |pattern| - (SPADCALL (+ |p| 1) |n| - (QREFELT $ 20)) - (QREFELT $ 21)) - |target| (QREFELT $ 51))) - (EXIT 'NIL))))) - (EXIT 'T))))))) - #3# (EXIT #3#))))) - -(DEFUN |IndexedString| (#0=#:G1875) - (PROG () - (RETURN - (PROG (#1=#:G1876) - (RETURN - (COND - ((LETT #1# - (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) - (HGET |$ConstructorCache| '|IndexedString|) - '|domainEqualList|) - |IndexedString|) - (|CDRwithIncrement| #1#)) - ('T - (UNWIND-PROTECT - (PROG1 (|IndexedString;| #0#) - (LETT #1# T |IndexedString|)) - (COND - ((NOT #1#) - (HREM |$ConstructorCache| '|IndexedString|))))))))))) - -(DEFUN |IndexedString;| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|IndexedString|)) - (LETT |dv$| (LIST '|IndexedString| |dv$1|) . #0#) - (LETT $ (|newShell| 84) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (OR (AND (|HasCategory| (|Character|) - '(|OrderedSet|)) - (|HasCategory| (|Character|) - '(|Evalable| (|Character|)))) - (AND (|HasCategory| (|Character|) - '(|SetCategory|)) - (|HasCategory| (|Character|) - '(|Evalable| (|Character|))))) - (OR (|HasCategory| (|Character|) - '(|CoercibleTo| (|OutputForm|))) - (AND (|HasCategory| (|Character|) - '(|SetCategory|)) - (|HasCategory| (|Character|) - '(|Evalable| (|Character|))))) - (|HasCategory| (|Character|) - '(|ConvertibleTo| (|InputForm|))) - (OR (|HasCategory| (|Character|) - '(|OrderedSet|)) - (|HasCategory| (|Character|) - '(|SetCategory|))) - (|HasCategory| (|Character|) - '(|OrderedSet|)) - (|HasCategory| (|Integer|) '(|OrderedSet|)) - (|HasCategory| (|Character|) - '(|SetCategory|)) - (AND (|HasCategory| (|Character|) - '(|SetCategory|)) - (|HasCategory| (|Character|) - '(|Evalable| (|Character|)))) - (|HasCategory| (|Character|) - '(|CoercibleTo| (|OutputForm|))))) . #0#)) - (|haddProp| |$ConstructorCache| '|IndexedString| (LIST |dv$1|) - (CONS 1 $)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) - -(MAKEPROP '|IndexedString| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) - (|NonNegativeInteger|) (|Character|) |ISTRING;new;NniC$;1| - |ISTRING;empty;$;2| (|Boolean|) |ISTRING;empty?;$B;3| - |ISTRING;#;$Nni;4| |ISTRING;=;2$B;5| |ISTRING;<;2$B;6| - |ISTRING;concat;3$;7| |ISTRING;copy;2$;8| (|Integer|) - (|UniversalSegment| 18) (0 . SEGMENT) - |ISTRING;elt;$Us$;31| (6 . SEGMENT) - |ISTRING;insert;2$I$;9| (|String|) (|OutputForm|) - (11 . |outputForm|) |ISTRING;coerce;$Of;10| - |ISTRING;minIndex;$I;11| (|CharacterClass|) - (16 . |upperCase|) (20 . |upperCase|) (|Mapping| 8 8) - (25 . |map!|) |ISTRING;upperCase!;2$;12| - (31 . |lowerCase|) (35 . |lowerCase|) - |ISTRING;lowerCase!;2$;13| |ISTRING;latex;$S;14| - (40 . |lo|) (45 . |hasHi|) (50 . |hi|) (55 . |maxIndex|) - (60 . |space|) |ISTRING;replace;$Us2$;15| - |ISTRING;setelt;$I2C;16| |ISTRING;substring?;2$IB;17| - |ISTRING;position;2$2I;18| |ISTRING;position;C$2I;19| - (64 . |member?|) |ISTRING;position;Cc$2I;20| - |ISTRING;suffix?;2$B;21| |ISTRING;elt;$IC;30| (70 . =) - (|List| $$) (76 . |empty|) (80 . |not|) (85 . |concat|) - (91 . |reverse!|) (|List| $) |ISTRING;split;$CL;22| - |ISTRING;split;$CcL;23| |ISTRING;leftTrim;$C$;24| - |ISTRING;leftTrim;$Cc$;25| |ISTRING;rightTrim;$C$;26| - |ISTRING;rightTrim;$Cc$;27| |ISTRING;copyInto!;2$I$;29| - |ISTRING;concat;L$;28| (96 . |ord|) |ISTRING;hash;$I;32| - |ISTRING;match;2$CNni;33| (101 . |prefix?|) - |ISTRING;match?;2$CB;34| (|List| 8) (|List| 75) - (|Equation| 8) (|Mapping| 8 8 8) (|InputForm|) - (|SingleInteger|) (|Mapping| 11 8) (|Mapping| 11 8 8) - (|Void|) (|Union| 8 '"failed") (|List| 18)) - '#(~= 107 |upperCase!| 113 |upperCase| 118 |trim| 123 |swap!| - 135 |suffix?| 142 |substring?| 148 |split| 155 |sorted?| - 167 |sort!| 178 |sort| 189 |size?| 200 |setelt| 206 - |select| 220 |sample| 226 |rightTrim| 230 |reverse!| 242 - |reverse| 247 |replace| 252 |removeDuplicates| 259 - |remove| 264 |reduce| 276 |qsetelt!| 297 |qelt| 304 - |prefix?| 310 |position| 316 |parts| 349 |new| 354 |more?| - 360 |minIndex| 366 |min| 371 |merge| 377 |members| 390 - |member?| 395 |maxIndex| 401 |max| 406 |match?| 412 - |match| 419 |map!| 426 |map| 432 |lowerCase!| 445 - |lowerCase| 450 |less?| 455 |leftTrim| 461 |latex| 473 - |insert| 478 |indices| 492 |index?| 497 |hash| 503 |first| - 513 |find| 518 |fill!| 524 |every?| 530 |eval| 536 |eq?| - 562 |entry?| 568 |entries| 574 |empty?| 579 |empty| 584 - |elt| 588 |delete| 613 |count| 625 |copyInto!| 637 |copy| - 644 |convert| 649 |construct| 654 |concat| 659 |coerce| - 682 |any?| 692 >= 698 > 704 = 710 <= 716 < 722 |#| 728) - '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) - (CONS (|makeByteWordVec2| 5 - '(0 0 0 0 0 0 0 5 0 0 1 4 0 0 1 2 3 4)) - (CONS '#(|StringAggregate&| - |OneDimensionalArrayAggregate&| - |FiniteLinearAggregate&| |LinearAggregate&| - |IndexedAggregate&| |Collection&| - |HomogeneousAggregate&| |OrderedSet&| - |Aggregate&| |EltableAggregate&| |Evalable&| - |SetCategory&| NIL NIL |InnerEvalable&| NIL - NIL |BasicType&|) - (CONS '#((|StringAggregate|) - (|OneDimensionalArrayAggregate| 8) - (|FiniteLinearAggregate| 8) - (|LinearAggregate| 8) - (|IndexedAggregate| 18 8) - (|Collection| 8) - (|HomogeneousAggregate| 8) - (|OrderedSet|) (|Aggregate|) - (|EltableAggregate| 18 8) (|Evalable| 8) - (|SetCategory|) (|Type|) - (|Eltable| 18 8) (|InnerEvalable| 8 8) - (|CoercibleTo| 25) (|ConvertibleTo| 77) - (|BasicType|)) - (|makeByteWordVec2| 83 - '(2 19 0 18 18 20 1 19 0 18 22 1 25 0 - 24 26 0 29 0 30 1 8 0 0 31 2 0 0 32 0 - 33 0 29 0 35 1 8 0 0 36 1 19 18 0 39 - 1 19 11 0 40 1 19 18 0 41 1 0 18 0 42 - 0 8 0 43 2 29 11 8 0 49 2 8 11 0 0 53 - 0 54 0 55 1 11 0 0 56 2 54 0 2 0 57 1 - 54 0 0 58 1 8 7 0 68 2 0 11 0 0 71 2 - 7 11 0 0 1 1 0 0 0 34 1 0 0 0 1 2 0 0 - 0 8 1 2 0 0 0 29 1 3 0 81 0 18 18 1 2 - 0 11 0 0 51 3 0 11 0 0 18 46 2 0 59 0 - 29 61 2 0 59 0 8 60 1 5 11 0 1 2 0 11 - 80 0 1 1 5 0 0 1 2 0 0 80 0 1 1 5 0 0 - 1 2 0 0 80 0 1 2 0 11 0 7 1 3 0 8 0 - 19 8 1 3 0 8 0 18 8 45 2 0 0 79 0 1 0 - 0 0 1 2 0 0 0 8 64 2 0 0 0 29 65 1 0 - 0 0 1 1 0 0 0 1 3 0 0 0 19 0 44 1 7 0 - 0 1 2 7 0 8 0 1 2 0 0 79 0 1 4 7 8 76 - 0 8 8 1 3 0 8 76 0 8 1 2 0 8 76 0 1 3 - 0 8 0 18 8 1 2 0 8 0 18 1 2 0 11 0 0 - 71 3 7 18 8 0 18 48 2 7 18 8 0 1 3 0 - 18 29 0 18 50 3 0 18 0 0 18 47 2 0 18 - 79 0 1 1 0 73 0 1 2 0 0 7 8 9 2 0 11 - 0 7 1 1 6 18 0 28 2 5 0 0 0 1 2 5 0 0 - 0 1 3 0 0 80 0 0 1 1 0 73 0 1 2 7 11 - 8 0 1 1 6 18 0 42 2 5 0 0 0 1 3 0 11 - 0 0 8 72 3 0 7 0 0 8 70 2 0 0 32 0 33 - 3 0 0 76 0 0 1 2 0 0 32 0 1 1 0 0 0 - 37 1 0 0 0 1 2 0 11 0 7 1 2 0 0 0 8 - 62 2 0 0 0 29 63 1 7 24 0 38 3 0 0 8 - 0 18 1 3 0 0 0 0 18 23 1 0 83 0 1 2 0 - 11 18 0 1 1 7 78 0 1 1 0 18 0 69 1 6 - 8 0 1 2 0 82 79 0 1 2 0 0 0 8 1 2 0 - 11 79 0 1 3 8 0 0 73 73 1 3 8 0 0 8 8 - 1 2 8 0 0 74 1 2 8 0 0 75 1 2 0 11 0 - 0 1 2 7 11 8 0 1 1 0 73 0 1 1 0 11 0 - 12 0 0 0 10 2 0 0 0 0 1 2 0 0 0 19 21 - 2 0 8 0 18 52 3 0 8 0 18 8 1 2 0 0 0 - 18 1 2 0 0 0 19 1 2 7 7 8 0 1 2 0 7 - 79 0 1 3 0 0 0 0 18 66 1 0 0 0 17 1 3 - 77 0 1 1 0 0 73 1 1 0 0 59 67 2 0 0 0 - 0 16 2 0 0 0 8 1 2 0 0 8 0 1 1 9 25 0 - 27 1 0 0 8 1 2 0 11 79 0 1 2 5 11 0 0 - 1 2 5 11 0 0 1 2 7 11 0 0 14 2 5 11 0 - 0 1 2 5 11 0 0 15 1 0 7 0 13))))) - '|lookupComplete|)) -@ + \section{domain STRING String} <<domain STRING String>>= )abbrev domain STRING String diff --git a/src/algebra/symbol.spad.pamphlet b/src/algebra/symbol.spad.pamphlet index 5966fc76..8367da5c 100644 --- a/src/algebra/symbol.spad.pamphlet +++ b/src/algebra/symbol.spad.pamphlet @@ -319,834 +319,6 @@ Symbol(): Exports == Implementation where sample() == "aSymbol"::% @ -\section{SYMBOL.lsp BOOTSTRAP} -{\bf SYMBOL} depends on a chain of -files. We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf SYMBOL} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf SYMBOL.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<SYMBOL.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |SYMBOL;writeOMSym| (|dev| |x| $) - (COND - ((SPADCALL |x| (|getShellEntry| $ 22)) - (|error| "Cannot convert a scripted symbol to OpenMath")) - ('T (SPADCALL |dev| |x| (|getShellEntry| $ 26))))) - -(DEFUN |SYMBOL;OMwrite;$S;2| (|x| $) - (PROG (|sp| |dev| |s|) - (RETURN - (SEQ (LETT |s| "" |SYMBOL;OMwrite;$S;2|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SYMBOL;OMwrite;$S;2|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 28)) - (|getShellEntry| $ 29)) - |SYMBOL;OMwrite;$S;2|) - (SPADCALL |dev| (|getShellEntry| $ 30)) - (|SYMBOL;writeOMSym| |dev| |x| $) - (SPADCALL |dev| (|getShellEntry| $ 31)) - (SPADCALL |dev| (|getShellEntry| $ 32)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |SYMBOL;OMwrite;$S;2|) - (EXIT |s|))))) - -(DEFUN |SYMBOL;OMwrite;$BS;3| (|x| |wholeObj| $) - (PROG (|sp| |dev| |s|) - (RETURN - (SEQ (LETT |s| "" |SYMBOL;OMwrite;$BS;3|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) - |SYMBOL;OMwrite;$BS;3|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 28)) - (|getShellEntry| $ 29)) - |SYMBOL;OMwrite;$BS;3|) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 30)))) - (|SYMBOL;writeOMSym| |dev| |x| $) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 31)))) - (SPADCALL |dev| (|getShellEntry| $ 32)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) - |SYMBOL;OMwrite;$BS;3|) - (EXIT |s|))))) - -(DEFUN |SYMBOL;OMwrite;Omd$V;4| (|dev| |x| $) - (SEQ (SPADCALL |dev| (|getShellEntry| $ 30)) - (|SYMBOL;writeOMSym| |dev| |x| $) - (EXIT (SPADCALL |dev| (|getShellEntry| $ 31))))) - -(DEFUN |SYMBOL;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 30)))) - (|SYMBOL;writeOMSym| |dev| |x| $) - (EXIT (COND - (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 31))))))) - -(DEFUN |SYMBOL;convert;$If;6| (|s| $) - (SPADCALL |s| (|getShellEntry| $ 45))) - -(PUT '|SYMBOL;convert;$S;7| '|SPADreplace| '(XLAM (|s|) |s|)) - -(DEFUN |SYMBOL;convert;$S;7| (|s| $) |s|) - -(DEFUN |SYMBOL;coerce;S$;8| (|s| $) (VALUES (INTERN |s|))) - -(PUT '|SYMBOL;=;2$B;9| '|SPADreplace| 'EQUAL) - -(DEFUN |SYMBOL;=;2$B;9| (|x| |y| $) (EQUAL |x| |y|)) - -(PUT '|SYMBOL;<;2$B;10| '|SPADreplace| - '(XLAM (|x| |y|) (GGREATERP |y| |x|))) - -(DEFUN |SYMBOL;<;2$B;10| (|x| |y| $) (GGREATERP |y| |x|)) - -(DEFUN |SYMBOL;coerce;$Of;11| (|x| $) - (SPADCALL |x| (|getShellEntry| $ 52))) - -(DEFUN |SYMBOL;subscript;$L$;12| (|sy| |lx| $) - (SPADCALL |sy| (LIST |lx| NIL NIL NIL NIL) (|getShellEntry| $ 56))) - -(DEFUN |SYMBOL;elt;$L$;13| (|sy| |lx| $) - (SPADCALL |sy| |lx| (|getShellEntry| $ 57))) - -(DEFUN |SYMBOL;superscript;$L$;14| (|sy| |lx| $) - (SPADCALL |sy| (LIST NIL |lx| NIL NIL NIL) (|getShellEntry| $ 56))) - -(DEFUN |SYMBOL;argscript;$L$;15| (|sy| |lx| $) - (SPADCALL |sy| (LIST NIL NIL NIL NIL |lx|) (|getShellEntry| $ 56))) - -(DEFUN |SYMBOL;patternMatch;$P2Pmr;16| (|x| |p| |l| $) - (SPADCALL |x| |p| |l| (|getShellEntry| $ 64))) - -(DEFUN |SYMBOL;patternMatch;$P2Pmr;17| (|x| |p| |l| $) - (SPADCALL |x| |p| |l| (|getShellEntry| $ 71))) - -(DEFUN |SYMBOL;convert;$P;18| (|x| $) - (SPADCALL |x| (|getShellEntry| $ 74))) - -(DEFUN |SYMBOL;convert;$P;19| (|x| $) - (SPADCALL |x| (|getShellEntry| $ 76))) - -(DEFUN |SYMBOL;syprefix| (|sc| $) - (PROG (|ns| #0=#:G1449 |n| #1=#:G1450) - (RETURN - (SEQ (LETT |ns| - (LIST (LENGTH (QVELT |sc| 3)) (LENGTH (QVELT |sc| 2)) - (LENGTH (QVELT |sc| 1)) (LENGTH (QVELT |sc| 0))) - |SYMBOL;syprefix|) - (SEQ G190 - (COND - ((NULL (COND - ((< (LENGTH |ns|) 2) 'NIL) - ('T (ZEROP (|SPADfirst| |ns|))))) - (GO G191))) - (SEQ (EXIT (LETT |ns| (CDR |ns|) |SYMBOL;syprefix|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL - (CONS (STRCONC (|getShellEntry| $ 37) - (|SYMBOL;istring| - (LENGTH (QVELT |sc| 4)) $)) - (PROGN - (LETT #0# NIL |SYMBOL;syprefix|) - (SEQ (LETT |n| NIL |SYMBOL;syprefix|) - (LETT #1# (NREVERSE |ns|) - |SYMBOL;syprefix|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |n| (CAR #1#) - |SYMBOL;syprefix|) - NIL)) - (GO G191))) - (SEQ (EXIT - (LETT #0# - (CONS (|SYMBOL;istring| |n| $) - #0#) - |SYMBOL;syprefix|))) - (LETT #1# (CDR #1#) - |SYMBOL;syprefix|) - (GO G190) G191 - (EXIT (NREVERSE0 #0#))))) - (|getShellEntry| $ 79))))))) - -(DEFUN |SYMBOL;syscripts| (|sc| $) - (PROG (|all|) - (RETURN - (SEQ (LETT |all| (QVELT |sc| 3) |SYMBOL;syscripts|) - (LETT |all| - (SPADCALL (QVELT |sc| 2) |all| (|getShellEntry| $ 80)) - |SYMBOL;syscripts|) - (LETT |all| - (SPADCALL (QVELT |sc| 1) |all| (|getShellEntry| $ 80)) - |SYMBOL;syscripts|) - (LETT |all| - (SPADCALL (QVELT |sc| 0) |all| (|getShellEntry| $ 80)) - |SYMBOL;syscripts|) - (EXIT (SPADCALL |all| (QVELT |sc| 4) (|getShellEntry| $ 80))))))) - -(DEFUN |SYMBOL;script;$L$;22| (|sy| |ls| $) - (PROG (|sc|) - (RETURN - (SEQ (LETT |sc| (VECTOR NIL NIL NIL NIL NIL) - |SYMBOL;script;$L$;22|) - (COND - ((NULL (NULL |ls|)) - (SEQ (QSETVELT |sc| 0 (|SPADfirst| |ls|)) - (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) - (COND - ((NULL (NULL |ls|)) - (SEQ (QSETVELT |sc| 1 (|SPADfirst| |ls|)) - (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) - (COND - ((NULL (NULL |ls|)) - (SEQ (QSETVELT |sc| 2 (|SPADfirst| |ls|)) - (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) - (COND - ((NULL (NULL |ls|)) - (SEQ (QSETVELT |sc| 3 (|SPADfirst| |ls|)) - (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) - (COND - ((NULL (NULL |ls|)) - (SEQ (QSETVELT |sc| 4 (|SPADfirst| |ls|)) - (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) - (EXIT (SPADCALL |sy| |sc| (|getShellEntry| $ 82))))))) - -(DEFUN |SYMBOL;script;$R$;23| (|sy| |sc| $) - (COND - ((SPADCALL |sy| (|getShellEntry| $ 22)) - (|error| "Cannot add scripts to a scripted symbol")) - ('T - (CONS (SPADCALL - (SPADCALL - (STRCONC (|SYMBOL;syprefix| |sc| $) - (SPADCALL - (SPADCALL |sy| (|getShellEntry| $ 83)) - (|getShellEntry| $ 84))) - (|getShellEntry| $ 48)) - (|getShellEntry| $ 53)) - (|SYMBOL;syscripts| |sc| $))))) - -(DEFUN |SYMBOL;string;$S;24| (|e| $) - (COND - ((NULL (SPADCALL |e| (|getShellEntry| $ 22))) (PNAME |e|)) - ('T (|error| "Cannot form string from non-atomic symbols.")))) - -(DEFUN |SYMBOL;latex;$S;25| (|e| $) - (PROG (|ss| |lo| |sc| |s|) - (RETURN - (SEQ (LETT |s| (PNAME (SPADCALL |e| (|getShellEntry| $ 83))) - |SYMBOL;latex;$S;25|) - (COND - ((< 1 (QCSIZE |s|)) - (COND - ((SPADCALL (SPADCALL |s| 1 (|getShellEntry| $ 85)) - (SPADCALL "\\" (|getShellEntry| $ 40)) - (|getShellEntry| $ 86)) - (LETT |s| (STRCONC "\\mbox{\\it " (STRCONC |s| "}")) - |SYMBOL;latex;$S;25|))))) - (COND - ((NULL (SPADCALL |e| (|getShellEntry| $ 22))) (EXIT |s|))) - (LETT |ss| (SPADCALL |e| (|getShellEntry| $ 87)) - |SYMBOL;latex;$S;25|) - (LETT |lo| (QVELT |ss| 0) |SYMBOL;latex;$S;25|) - (COND - ((NULL (NULL |lo|)) - (SEQ (LETT |sc| "_{" |SYMBOL;latex;$S;25|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |lo|) - (|getShellEntry| $ 88))) - (GO G191))) - (SEQ (LETT |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 89))) - |SYMBOL;latex;$S;25|) - (LETT |lo| (CDR |lo|) - |SYMBOL;latex;$S;25|) - (EXIT (COND - ((NULL (NULL |lo|)) - (LETT |sc| (STRCONC |sc| ", ") - |SYMBOL;latex;$S;25|))))) - NIL (GO G190) G191 (EXIT NIL)) - (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) - (EXIT (LETT |s| (STRCONC |s| |sc|) - |SYMBOL;latex;$S;25|))))) - (LETT |lo| (QVELT |ss| 1) |SYMBOL;latex;$S;25|) - (COND - ((NULL (NULL |lo|)) - (SEQ (LETT |sc| "^{" |SYMBOL;latex;$S;25|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |lo|) - (|getShellEntry| $ 88))) - (GO G191))) - (SEQ (LETT |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 89))) - |SYMBOL;latex;$S;25|) - (LETT |lo| (CDR |lo|) - |SYMBOL;latex;$S;25|) - (EXIT (COND - ((NULL (NULL |lo|)) - (LETT |sc| (STRCONC |sc| ", ") - |SYMBOL;latex;$S;25|))))) - NIL (GO G190) G191 (EXIT NIL)) - (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) - (EXIT (LETT |s| (STRCONC |s| |sc|) - |SYMBOL;latex;$S;25|))))) - (LETT |lo| (QVELT |ss| 2) |SYMBOL;latex;$S;25|) - (COND - ((NULL (NULL |lo|)) - (SEQ (LETT |sc| "{}^{" |SYMBOL;latex;$S;25|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |lo|) - (|getShellEntry| $ 88))) - (GO G191))) - (SEQ (LETT |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 89))) - |SYMBOL;latex;$S;25|) - (LETT |lo| (CDR |lo|) - |SYMBOL;latex;$S;25|) - (EXIT (COND - ((NULL (NULL |lo|)) - (LETT |sc| (STRCONC |sc| ", ") - |SYMBOL;latex;$S;25|))))) - NIL (GO G190) G191 (EXIT NIL)) - (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) - (EXIT (LETT |s| (STRCONC |sc| |s|) - |SYMBOL;latex;$S;25|))))) - (LETT |lo| (QVELT |ss| 3) |SYMBOL;latex;$S;25|) - (COND - ((NULL (NULL |lo|)) - (SEQ (LETT |sc| "{}_{" |SYMBOL;latex;$S;25|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |lo|) - (|getShellEntry| $ 88))) - (GO G191))) - (SEQ (LETT |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 89))) - |SYMBOL;latex;$S;25|) - (LETT |lo| (CDR |lo|) - |SYMBOL;latex;$S;25|) - (EXIT (COND - ((NULL (NULL |lo|)) - (LETT |sc| (STRCONC |sc| ", ") - |SYMBOL;latex;$S;25|))))) - NIL (GO G190) G191 (EXIT NIL)) - (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) - (EXIT (LETT |s| (STRCONC |sc| |s|) - |SYMBOL;latex;$S;25|))))) - (LETT |lo| (QVELT |ss| 4) |SYMBOL;latex;$S;25|) - (COND - ((NULL (NULL |lo|)) - (SEQ (LETT |sc| "\\left( {" |SYMBOL;latex;$S;25|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |lo|) - (|getShellEntry| $ 88))) - (GO G191))) - (SEQ (LETT |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 89))) - |SYMBOL;latex;$S;25|) - (LETT |lo| (CDR |lo|) - |SYMBOL;latex;$S;25|) - (EXIT (COND - ((NULL (NULL |lo|)) - (LETT |sc| (STRCONC |sc| ", ") - |SYMBOL;latex;$S;25|))))) - NIL (GO G190) G191 (EXIT NIL)) - (LETT |sc| (STRCONC |sc| "} \\right)") - |SYMBOL;latex;$S;25|) - (EXIT (LETT |s| (STRCONC |s| |sc|) - |SYMBOL;latex;$S;25|))))) - (EXIT |s|))))) - -(DEFUN |SYMBOL;anyRadix| (|n| |s| $) - (PROG (|qr| |ns| #0=#:G1500) - (RETURN - (SEQ (EXIT (SEQ (LETT |ns| "" |SYMBOL;anyRadix|) - (EXIT (SEQ G190 NIL - (SEQ (LETT |qr| - (DIVIDE2 |n| (QCSIZE |s|)) - |SYMBOL;anyRadix|) - (LETT |n| (QCAR |qr|) - |SYMBOL;anyRadix|) - (LETT |ns| - (SPADCALL - (SPADCALL |s| - (+ (QCDR |qr|) - (SPADCALL |s| - (|getShellEntry| $ 91))) - (|getShellEntry| $ 85)) - |ns| (|getShellEntry| $ 92)) - |SYMBOL;anyRadix|) - (EXIT - (COND - ((ZEROP |n|) - (PROGN - (LETT #0# |ns| - |SYMBOL;anyRadix|) - (GO #0#)))))) - NIL (GO G190) G191 (EXIT NIL))))) - #0# (EXIT #0#))))) - -(DEFUN |SYMBOL;new;$;27| ($) - (PROG (|sym|) - (RETURN - (SEQ (LETT |sym| - (|SYMBOL;anyRadix| - (SPADCALL (|getShellEntry| $ 9) - (|getShellEntry| $ 93)) - (|getShellEntry| $ 19) $) - |SYMBOL;new;$;27|) - (SPADCALL (|getShellEntry| $ 9) - (+ (SPADCALL (|getShellEntry| $ 9) - (|getShellEntry| $ 93)) - 1) - (|getShellEntry| $ 94)) - (EXIT (SPADCALL (STRCONC "%" |sym|) (|getShellEntry| $ 48))))))) - -(DEFUN |SYMBOL;new;2$;28| (|x| $) - (PROG (|u| |n| |xx|) - (RETURN - (SEQ (LETT |n| - (SEQ (LETT |u| - (SPADCALL |x| (|getShellEntry| $ 12) - (|getShellEntry| $ 97)) - |SYMBOL;new;2$;28|) - (EXIT (COND - ((QEQCAR |u| 1) 0) - ('T (+ (QCDR |u|) 1))))) - |SYMBOL;new;2$;28|) - (SPADCALL (|getShellEntry| $ 12) |x| |n| - (|getShellEntry| $ 98)) - (LETT |xx| - (COND - ((NULL (SPADCALL |x| (|getShellEntry| $ 22))) - (SPADCALL |x| (|getShellEntry| $ 84))) - ('T - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 83)) - (|getShellEntry| $ 84)))) - |SYMBOL;new;2$;28|) - (LETT |xx| (STRCONC "%" |xx|) |SYMBOL;new;2$;28|) - (LETT |xx| - (COND - ((NULL (< (SPADCALL - (SPADCALL |xx| - (SPADCALL |xx| - (|getShellEntry| $ 99)) - (|getShellEntry| $ 85)) - (|getShellEntry| $ 18) - (|getShellEntry| $ 100)) - (SPADCALL (|getShellEntry| $ 18) - (|getShellEntry| $ 91)))) - (STRCONC |xx| - (|SYMBOL;anyRadix| |n| - (|getShellEntry| $ 20) $))) - ('T - (STRCONC |xx| - (|SYMBOL;anyRadix| |n| - (|getShellEntry| $ 18) $)))) - |SYMBOL;new;2$;28|) - (COND - ((NULL (SPADCALL |x| (|getShellEntry| $ 22))) - (EXIT (SPADCALL |xx| (|getShellEntry| $ 48))))) - (EXIT (SPADCALL (SPADCALL |xx| (|getShellEntry| $ 48)) - (SPADCALL |x| (|getShellEntry| $ 87)) - (|getShellEntry| $ 82))))))) - -(DEFUN |SYMBOL;resetNew;V;29| ($) - (PROG (|k| #0=#:G1523) - (RETURN - (SEQ (SPADCALL (|getShellEntry| $ 9) 0 (|getShellEntry| $ 94)) - (SEQ (LETT |k| NIL |SYMBOL;resetNew;V;29|) - (LETT #0# - (SPADCALL (|getShellEntry| $ 12) - (|getShellEntry| $ 103)) - |SYMBOL;resetNew;V;29|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |k| (CAR #0#) |SYMBOL;resetNew;V;29|) - NIL)) - (GO G191))) - (SEQ (EXIT (SPADCALL |k| (|getShellEntry| $ 12) - (|getShellEntry| $ 104)))) - (LETT #0# (CDR #0#) |SYMBOL;resetNew;V;29|) (GO G190) - G191 (EXIT NIL)) - (EXIT (SPADCALL (|getShellEntry| $ 105))))))) - -(DEFUN |SYMBOL;scripted?;$B;30| (|sy| $) - (SPADCALL (ATOM |sy|) (|getShellEntry| $ 88))) - -(DEFUN |SYMBOL;name;2$;31| (|sy| $) - (PROG (|str| |i| #0=#:G1530 #1=#:G1529 #2=#:G1527) - (RETURN - (SEQ (EXIT (COND - ((NULL (SPADCALL |sy| (|getShellEntry| $ 22))) |sy|) - ('T - (SEQ (LETT |str| - (SPADCALL - (SPADCALL - (SPADCALL |sy| - (|getShellEntry| $ 107)) - (|getShellEntry| $ 108)) - (|getShellEntry| $ 84)) - |SYMBOL;name;2$;31|) - (SEQ (EXIT (SEQ - (LETT |i| - (+ (|getShellEntry| $ 38) 1) - |SYMBOL;name;2$;31|) - (LETT #0# (QCSIZE |str|) - |SYMBOL;name;2$;31|) - G190 - (COND ((> |i| #0#) (GO G191))) - (SEQ - (EXIT - (COND - ((NULL - (SPADCALL - (SPADCALL |str| |i| - (|getShellEntry| $ 85)) - (|getShellEntry| $ 109))) - (PROGN - (LETT #2# - (PROGN - (LETT #1# - (SPADCALL - (SPADCALL |str| - (SPADCALL |i| - (QCSIZE |str|) - (|getShellEntry| $ - 111)) - (|getShellEntry| $ - 112)) - (|getShellEntry| $ 48)) - |SYMBOL;name;2$;31|) - (GO #1#)) - |SYMBOL;name;2$;31|) - (GO #2#)))))) - (LETT |i| (+ |i| 1) - |SYMBOL;name;2$;31|) - (GO G190) G191 (EXIT NIL))) - #2# (EXIT #2#)) - (EXIT (|error| "Improper scripted symbol")))))) - #1# (EXIT #1#))))) - -(DEFUN |SYMBOL;scripts;$R;32| (|sy| $) - (PROG (|lscripts| |str| |nstr| |j| #0=#:G1533 |nscripts| |m| |n| - #1=#:G1542 |i| #2=#:G1543 |a| #3=#:G1544 |allscripts|) - (RETURN - (SEQ (COND - ((NULL (SPADCALL |sy| (|getShellEntry| $ 22))) - (VECTOR NIL NIL NIL NIL NIL)) - ('T - (SEQ (LETT |nscripts| (LIST 0 0 0 0 0) - |SYMBOL;scripts;$R;32|) - (LETT |lscripts| (LIST NIL NIL NIL NIL NIL) - |SYMBOL;scripts;$R;32|) - (LETT |str| - (SPADCALL - (SPADCALL - (SPADCALL |sy| - (|getShellEntry| $ 107)) - (|getShellEntry| $ 108)) - (|getShellEntry| $ 84)) - |SYMBOL;scripts;$R;32|) - (LETT |nstr| (QCSIZE |str|) |SYMBOL;scripts;$R;32|) - (LETT |m| - (SPADCALL |nscripts| (|getShellEntry| $ 114)) - |SYMBOL;scripts;$R;32|) - (SEQ (LETT |j| (+ (|getShellEntry| $ 38) 1) - |SYMBOL;scripts;$R;32|) - (LETT |i| |m| |SYMBOL;scripts;$R;32|) G190 - (COND - ((OR (> |j| |nstr|) - (NULL (SPADCALL - (SPADCALL |str| |j| - (|getShellEntry| $ 85)) - (|getShellEntry| $ 109)))) - (GO G191))) - (SEQ (EXIT (SPADCALL |nscripts| |i| - (PROG1 - (LETT #0# - (- - (SPADCALL - (SPADCALL |str| |j| - (|getShellEntry| $ 85)) - (|getShellEntry| $ 42)) - (|getShellEntry| $ 43)) - |SYMBOL;scripts;$R;32|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 115)))) - (LETT |i| - (PROG1 (+ |i| 1) - (LETT |j| (+ |j| 1) - |SYMBOL;scripts;$R;32|)) - |SYMBOL;scripts;$R;32|) - (GO G190) G191 (EXIT NIL)) - (LETT |nscripts| - (SPADCALL (CDR |nscripts|) - (|SPADfirst| |nscripts|) - (|getShellEntry| $ 116)) - |SYMBOL;scripts;$R;32|) - (LETT |allscripts| - (SPADCALL - (SPADCALL |sy| (|getShellEntry| $ 107)) - (|getShellEntry| $ 117)) - |SYMBOL;scripts;$R;32|) - (LETT |m| - (SPADCALL |lscripts| (|getShellEntry| $ 118)) - |SYMBOL;scripts;$R;32|) - (SEQ (LETT |n| NIL |SYMBOL;scripts;$R;32|) - (LETT #1# |nscripts| |SYMBOL;scripts;$R;32|) - (LETT |i| |m| |SYMBOL;scripts;$R;32|) G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |n| (CAR #1#) - |SYMBOL;scripts;$R;32|) - NIL)) - (GO G191))) - (SEQ (EXIT (COND - ((< - (SPADCALL |allscripts| - (|getShellEntry| $ 119)) - |n|) - (|error| - "Improper script count in symbol")) - ('T - (SEQ - (SPADCALL |lscripts| |i| - (PROGN - (LETT #2# NIL - |SYMBOL;scripts;$R;32|) - (SEQ - (LETT |a| NIL - |SYMBOL;scripts;$R;32|) - (LETT #3# - (SPADCALL |allscripts| |n| - (|getShellEntry| $ 120)) - |SYMBOL;scripts;$R;32|) - G190 - (COND - ((OR (ATOM #3#) - (PROGN - (LETT |a| (CAR #3#) - |SYMBOL;scripts;$R;32|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (LETT #2# - (CONS - (SPADCALL |a| - (|getShellEntry| $ 53)) - #2#) - |SYMBOL;scripts;$R;32|))) - (LETT #3# (CDR #3#) - |SYMBOL;scripts;$R;32|) - (GO G190) G191 - (EXIT (NREVERSE0 #2#)))) - (|getShellEntry| $ 121)) - (EXIT - (LETT |allscripts| - (SPADCALL |allscripts| |n| - (|getShellEntry| $ 122)) - |SYMBOL;scripts;$R;32|))))))) - (LETT |i| - (PROG1 (+ |i| 1) - (LETT #1# (CDR #1#) - |SYMBOL;scripts;$R;32|)) - |SYMBOL;scripts;$R;32|) - (GO G190) G191 (EXIT NIL)) - (EXIT (VECTOR (SPADCALL |lscripts| |m| - (|getShellEntry| $ 123)) - (SPADCALL |lscripts| (+ |m| 1) - (|getShellEntry| $ 123)) - (SPADCALL |lscripts| (+ |m| 2) - (|getShellEntry| $ 123)) - (SPADCALL |lscripts| (+ |m| 3) - (|getShellEntry| $ 123)) - (SPADCALL |lscripts| (+ |m| 4) - (|getShellEntry| $ 123))))))))))) - -(DEFUN |SYMBOL;istring| (|n| $) - (COND - ((< 9 |n|) (|error| "Can have at most 9 scripts of each kind")) - ('T (ELT (|getShellEntry| $ 17) (+ |n| 0))))) - -(DEFUN |SYMBOL;list;$L;34| (|sy| $) - (COND - ((NULL (SPADCALL |sy| (|getShellEntry| $ 22))) - (|error| "Cannot convert a symbol to a list if it is not subscripted")) - ('T |sy|))) - -(DEFUN |SYMBOL;sample;$;35| ($) - (SPADCALL "aSymbol" (|getShellEntry| $ 48))) - -(DEFUN |Symbol| () - (PROG () - (RETURN - (PROG (#0=#:G1551) - (RETURN - (COND - ((LETT #0# (HGET |$ConstructorCache| '|Symbol|) |Symbol|) - (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Symbol| - (LIST - (CONS NIL (CONS 1 (|Symbol;|)))))) - (LETT #0# T |Symbol|)) - (COND ((NOT #0#) (HREM |$ConstructorCache| '|Symbol|))))))))))) - -(DEFUN |Symbol;| () - (PROG (|dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$| '(|Symbol|) . #0=(|Symbol|)) - (LETT $ (|newShell| 126) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|haddProp| |$ConstructorCache| '|Symbol| NIL (CONS 1 $)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 9 (SPADCALL 0 (|getShellEntry| $ 8))) - (|setShellEntry| $ 12 (SPADCALL (|getShellEntry| $ 11))) - (|setShellEntry| $ 17 - (SPADCALL (LIST "0" "1" "2" "3" "4" "5" "6" "7" "8" "9") - (|getShellEntry| $ 16))) - (|setShellEntry| $ 18 "0123456789") - (|setShellEntry| $ 19 "ABCDEFGHIJKLMNOPQRSTUVWXYZ") - (|setShellEntry| $ 20 "abcdefghijklmnopqrstuvwxyz") - (|setShellEntry| $ 37 "*") - (|setShellEntry| $ 38 (QCSIZE (|getShellEntry| $ 37))) - (|setShellEntry| $ 43 - (SPADCALL (SPADCALL "0" (|getShellEntry| $ 40)) - (|getShellEntry| $ 42))) - $)))) - -(MAKEPROP '|Symbol| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|Integer|) (|Reference| 6) - (0 . |ref|) '|count| (|AssociationList| $$ 6) - (5 . |empty|) '|xcount| (|String|) (|List| 13) - (|PrimitiveArray| 13) (9 . |construct|) '|istrings| - '|nums| 'ALPHAS '|alphas| (|Boolean|) - |SYMBOL;scripted?;$B;30| (|Void|) (|Symbol|) - (|OpenMathDevice|) (14 . |OMputVariable|) - (|OpenMathEncoding|) (20 . |OMencodingXML|) - (24 . |OMopenString|) (30 . |OMputObject|) - (35 . |OMputEndObject|) (40 . |OMclose|) - |SYMBOL;OMwrite;$S;2| |SYMBOL;OMwrite;$BS;3| - |SYMBOL;OMwrite;Omd$V;4| |SYMBOL;OMwrite;Omd$BV;5| '|hd| - '|lhd| (|Character|) (45 . |char|) (|NonNegativeInteger|) - (50 . |ord|) '|ord0| (|InputForm|) (55 . |convert|) - |SYMBOL;convert;$If;6| |SYMBOL;convert;$S;7| - |SYMBOL;coerce;S$;8| |SYMBOL;=;2$B;9| |SYMBOL;<;2$B;10| - (|OutputForm|) (60 . |outputForm|) |SYMBOL;coerce;$Of;11| - (|List| 51) (|List| 54) |SYMBOL;script;$L$;22| - |SYMBOL;subscript;$L$;12| |SYMBOL;elt;$L$;13| - |SYMBOL;superscript;$L$;14| |SYMBOL;argscript;$L$;15| - (|PatternMatchResult| 6 24) (|Pattern| 6) - (|PatternMatchSymbol| 6) (65 . |patternMatch|) - (|PatternMatchResult| 6 $) |SYMBOL;patternMatch;$P2Pmr;16| - (|Float|) (|PatternMatchResult| 67 24) (|Pattern| 67) - (|PatternMatchSymbol| 67) (72 . |patternMatch|) - (|PatternMatchResult| 67 $) - |SYMBOL;patternMatch;$P2Pmr;17| (79 . |coerce|) - |SYMBOL;convert;$P;18| (84 . |coerce|) - |SYMBOL;convert;$P;19| (|List| $) (89 . |concat|) - (94 . |concat|) - (|Record| (|:| |sub| 54) (|:| |sup| 54) (|:| |presup| 54) - (|:| |presub| 54) (|:| |args| 54)) - |SYMBOL;script;$R$;23| |SYMBOL;name;2$;31| - |SYMBOL;string;$S;24| (100 . |elt|) (106 . ~=) - |SYMBOL;scripts;$R;32| (112 . |not|) (117 . |latex|) - |SYMBOL;latex;$S;25| (122 . |minIndex|) (127 . |concat|) - (133 . |elt|) (138 . |setelt|) |SYMBOL;new;$;27| - (|Union| 6 '"failed") (144 . |search|) (150 . |setelt|) - (157 . |maxIndex|) (162 . |position|) |SYMBOL;new;2$;28| - (|List| $$) (168 . |keys|) (173 . |remove!|) - (179 . |void|) |SYMBOL;resetNew;V;29| |SYMBOL;list;$L;34| - (183 . |first|) (188 . |digit?|) (|UniversalSegment| 6) - (193 . SEGMENT) (199 . |elt|) (|List| 41) - (205 . |minIndex|) (210 . |setelt|) (217 . |concat|) - (223 . |rest|) (228 . |minIndex|) (233 . |#|) - (238 . |first|) (244 . |setelt|) (251 . |rest|) - (257 . |elt|) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |SYMBOL;sample;$;35|) - $)) - (|SingleInteger|)) - '#(~= 263 |superscript| 269 |subscript| 275 |string| 281 - |scripts| 286 |scripted?| 291 |script| 296 |sample| 308 - |resetNew| 312 |patternMatch| 316 |new| 330 |name| 339 - |min| 344 |max| 350 |list| 356 |latex| 361 |hash| 366 - |elt| 371 |convert| 377 |coerce| 397 |argscript| 407 - |OMwrite| 413 >= 437 > 443 = 449 <= 455 < 461) - 'NIL - (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0 0 0 0 0 0)) - (CONS '#(|OrderedSet&| NIL NIL |SetCategory&| - |BasicType&| NIL NIL NIL NIL NIL NIL) - (CONS '#((|OrderedSet|) (|PatternMatchable| 67) - (|PatternMatchable| 6) (|SetCategory|) - (|BasicType|) (|ConvertibleTo| 69) - (|ConvertibleTo| 62) - (|ConvertibleTo| 24) (|OpenMath|) - (|ConvertibleTo| 44) (|CoercibleTo| 51)) - (|makeByteWordVec2| 125 - '(1 7 0 6 8 0 10 0 11 1 15 0 14 16 2 25 - 23 0 24 26 0 27 0 28 2 25 0 13 27 29 - 1 25 23 0 30 1 25 23 0 31 1 25 23 0 - 32 1 39 0 13 40 1 39 41 0 42 1 44 0 - 24 45 1 51 0 24 52 3 63 61 24 62 61 - 64 3 70 68 24 69 68 71 1 69 0 24 74 1 - 62 0 24 76 1 13 0 78 79 2 54 0 0 0 80 - 2 13 39 0 6 85 2 39 21 0 0 86 1 21 0 - 0 88 1 51 13 0 89 1 13 6 0 91 2 13 0 - 39 0 92 1 7 6 0 93 2 7 6 0 6 94 2 10 - 96 2 0 97 3 10 6 0 2 6 98 1 13 6 0 99 - 2 13 6 39 0 100 1 10 102 0 103 2 10 - 96 2 0 104 0 23 0 105 1 102 2 0 108 1 - 39 21 0 109 2 110 0 6 6 111 2 13 0 0 - 110 112 1 113 6 0 114 3 113 41 0 6 41 - 115 2 113 0 0 41 116 1 102 0 0 117 1 - 55 6 0 118 1 102 41 0 119 2 102 0 0 - 41 120 3 55 54 0 6 54 121 2 102 0 0 - 41 122 2 55 54 0 6 123 2 0 21 0 0 1 2 - 0 0 0 54 59 2 0 0 0 54 57 1 0 13 0 84 - 1 0 81 0 87 1 0 21 0 22 2 0 0 0 55 56 - 2 0 0 0 81 82 0 0 0 124 0 0 23 106 3 - 0 65 0 62 65 66 3 0 72 0 69 72 73 1 0 - 0 0 101 0 0 0 95 1 0 0 0 83 2 0 0 0 0 - 1 2 0 0 0 0 1 1 0 78 0 107 1 0 13 0 - 90 1 0 125 0 1 2 0 0 0 54 58 1 0 62 0 - 77 1 0 69 0 75 1 0 24 0 47 1 0 44 0 - 46 1 0 0 13 48 1 0 51 0 53 2 0 0 0 54 - 60 3 0 23 25 0 21 36 2 0 13 0 21 34 2 - 0 23 25 0 35 1 0 13 0 33 2 0 21 0 0 1 - 2 0 21 0 0 1 2 0 21 0 0 49 2 0 21 0 0 - 1 2 0 21 0 0 50))))) - '|lookupComplete|)) - -(MAKEPROP '|Symbol| 'NILADIC T) -@ \section{License} diff --git a/src/algebra/triset.spad.pamphlet b/src/algebra/triset.spad.pamphlet index 0d4f93ca..2fa126c0 100644 --- a/src/algebra/triset.spad.pamphlet +++ b/src/algebra/triset.spad.pamphlet @@ -483,1261 +483,6 @@ TriangularSetCategory(R:IntegralDomain,E:OrderedAbelianMonoidSup,_ subtractIfCan(n,m)$NonNegativeInteger::NonNegativeInteger @ -\section{TSETCAT.lsp BOOTSTRAP} -{\bf TSETCAT} depends on a chain of -files. We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf TSETCAT} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf TSETCAT.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<TSETCAT.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |TriangularSetCategory;CAT| 'NIL) - -(DEFPARAMETER |TriangularSetCategory;AL| 'NIL) - -(DEFUN |TriangularSetCategory| (&REST #0=#:G1439 &AUX #1=#:G1437) - (DSETQ #1# #0#) - (LET (#2=#:G1438) - (COND - ((SETQ #2# - (|assoc| (|devaluateList| #1#) |TriangularSetCategory;AL|)) - (CDR #2#)) - (T (SETQ |TriangularSetCategory;AL| - (|cons5| (CONS (|devaluateList| #1#) - (SETQ #2# - (APPLY #'|TriangularSetCategory;| - #1#))) - |TriangularSetCategory;AL|)) - #2#)))) - -(DEFUN |TriangularSetCategory;| (|t#1| |t#2| |t#3| |t#4|) - (PROG (#0=#:G1436) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(|t#1| |t#2| |t#3| |t#4|) - (LIST (|devaluate| |t#1|) - (|devaluate| |t#2|) - (|devaluate| |t#3|) - (|devaluate| |t#4|))) - (COND - (|TriangularSetCategory;CAT|) - ('T - (LETT |TriangularSetCategory;CAT| - (|Join| (|PolynomialSetCategory| '|t#1| - '|t#2| '|t#3| '|t#4|) - (|mkCategory| '|domain| - '(((|infRittWu?| - ((|Boolean|) $ $)) - T) - ((|basicSet| - ((|Union| - (|Record| (|:| |bas| $) - (|:| |top| - (|List| |t#4|))) - "failed") - (|List| |t#4|) - (|Mapping| (|Boolean|) - |t#4| |t#4|))) - T) - ((|basicSet| - ((|Union| - (|Record| (|:| |bas| $) - (|:| |top| - (|List| |t#4|))) - "failed") - (|List| |t#4|) - (|Mapping| (|Boolean|) - |t#4|) - (|Mapping| (|Boolean|) - |t#4| |t#4|))) - T) - ((|initials| - ((|List| |t#4|) $)) - T) - ((|degree| - ((|NonNegativeInteger|) $)) - T) - ((|quasiComponent| - ((|Record| - (|:| |close| - (|List| |t#4|)) - (|:| |open| - (|List| |t#4|))) - $)) - T) - ((|normalized?| - ((|Boolean|) |t#4| $)) - T) - ((|normalized?| - ((|Boolean|) $)) - T) - ((|reduced?| - ((|Boolean|) |t#4| $ - (|Mapping| (|Boolean|) - |t#4| |t#4|))) - T) - ((|stronglyReduced?| - ((|Boolean|) |t#4| $)) - T) - ((|headReduced?| - ((|Boolean|) |t#4| $)) - T) - ((|initiallyReduced?| - ((|Boolean|) |t#4| $)) - T) - ((|autoReduced?| - ((|Boolean|) $ - (|Mapping| (|Boolean|) - |t#4| (|List| |t#4|)))) - T) - ((|stronglyReduced?| - ((|Boolean|) $)) - T) - ((|headReduced?| - ((|Boolean|) $)) - T) - ((|initiallyReduced?| - ((|Boolean|) $)) - T) - ((|reduce| - (|t#4| |t#4| $ - (|Mapping| |t#4| |t#4| - |t#4|) - (|Mapping| (|Boolean|) - |t#4| |t#4|))) - T) - ((|rewriteSetWithReduction| - ((|List| |t#4|) - (|List| |t#4|) $ - (|Mapping| |t#4| |t#4| - |t#4|) - (|Mapping| (|Boolean|) - |t#4| |t#4|))) - T) - ((|stronglyReduce| - (|t#4| |t#4| $)) - T) - ((|headReduce| - (|t#4| |t#4| $)) - T) - ((|initiallyReduce| - (|t#4| |t#4| $)) - T) - ((|removeZero| - (|t#4| |t#4| $)) - T) - ((|collectQuasiMonic| ($ $)) - T) - ((|reduceByQuasiMonic| - (|t#4| |t#4| $)) - T) - ((|zeroSetSplit| - ((|List| $) - (|List| |t#4|))) - T) - ((|zeroSetSplitIntoTriangularSystems| - ((|List| - (|Record| - (|:| |close| $) - (|:| |open| - (|List| |t#4|)))) - (|List| |t#4|))) - T) - ((|first| - ((|Union| |t#4| "failed") - $)) - T) - ((|last| - ((|Union| |t#4| "failed") - $)) - T) - ((|rest| - ((|Union| $ "failed") $)) - T) - ((|algebraicVariables| - ((|List| |t#3|) $)) - T) - ((|algebraic?| - ((|Boolean|) |t#3| $)) - T) - ((|select| - ((|Union| |t#4| "failed") - $ |t#3|)) - T) - ((|extendIfCan| - ((|Union| $ "failed") $ - |t#4|)) - T) - ((|extend| ($ $ |t#4|)) T) - ((|coHeight| - ((|NonNegativeInteger|) $)) - (|has| |t#3| (|Finite|)))) - '((|finiteAggregate| T) - (|shallowlyMutable| T)) - '((|NonNegativeInteger|) - (|Boolean|) (|List| |t#3|) - (|List| - (|Record| (|:| |close| $) - (|:| |open| - (|List| |t#4|)))) - (|List| |t#4|) (|List| $)) - NIL)) - . #1=(|TriangularSetCategory|))))) . #1#) - (SETELT #0# 0 - (LIST '|TriangularSetCategory| (|devaluate| |t#1|) - (|devaluate| |t#2|) (|devaluate| |t#3|) - (|devaluate| |t#4|))))))) -@ -\section{TSETCAT-.lsp BOOTSTRAP} -{\bf TSETCAT-} depends on a chain of files. -We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf TSETCAT-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf TSETCAT-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<TSETCAT-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |TSETCAT-;=;2SB;1| (|ts| |us| $) - (PROG (#0=#:G1451 #1=#:G1457) - (RETURN - (COND - ((SPADCALL |ts| (|getShellEntry| $ 12)) - (SPADCALL |us| (|getShellEntry| $ 12))) - ((OR (SPADCALL |us| (|getShellEntry| $ 12)) - (NULL (SPADCALL - (PROG2 (LETT #0# - (SPADCALL |ts| - (|getShellEntry| $ 14)) - |TSETCAT-;=;2SB;1|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|getShellEntry| $ 10) #0#)) - (PROG2 (LETT #0# - (SPADCALL |us| - (|getShellEntry| $ 14)) - |TSETCAT-;=;2SB;1|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|getShellEntry| $ 10) #0#)) - (|getShellEntry| $ 15)))) - 'NIL) - ('T - (SPADCALL - (PROG2 (LETT #1# (SPADCALL |ts| (|getShellEntry| $ 17)) - |TSETCAT-;=;2SB;1|) - (QCDR #1#) - (|check-union| (QEQCAR #1# 0) (|getShellEntry| $ 6) #1#)) - (PROG2 (LETT #1# (SPADCALL |us| (|getShellEntry| $ 17)) - |TSETCAT-;=;2SB;1|) - (QCDR #1#) - (|check-union| (QEQCAR #1# 0) (|getShellEntry| $ 6) #1#)) - (|getShellEntry| $ 18))))))) - -(DEFUN |TSETCAT-;infRittWu?;2SB;2| (|ts| |us| $) - (PROG (|p| #0=#:G1464 |q| |v|) - (RETURN - (SEQ (COND - ((SPADCALL |us| (|getShellEntry| $ 12)) - (SPADCALL (SPADCALL |ts| (|getShellEntry| $ 12)) - (|getShellEntry| $ 20))) - ((SPADCALL |ts| (|getShellEntry| $ 12)) 'NIL) - ('T - (SEQ (LETT |p| - (PROG2 (LETT #0# - (SPADCALL |ts| - (|getShellEntry| $ 21)) - |TSETCAT-;infRittWu?;2SB;2|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|getShellEntry| $ 10) #0#)) - |TSETCAT-;infRittWu?;2SB;2|) - (LETT |q| - (PROG2 (LETT #0# - (SPADCALL |us| - (|getShellEntry| $ 21)) - |TSETCAT-;infRittWu?;2SB;2|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|getShellEntry| $ 10) #0#)) - |TSETCAT-;infRittWu?;2SB;2|) - (EXIT (COND - ((SPADCALL |p| |q| (|getShellEntry| $ 22)) - 'T) - ((SPADCALL |p| |q| (|getShellEntry| $ 23)) - 'NIL) - ('T - (SEQ (LETT |v| - (SPADCALL |p| - (|getShellEntry| $ 24)) - |TSETCAT-;infRittWu?;2SB;2|) - (EXIT (SPADCALL - (SPADCALL |ts| |v| - (|getShellEntry| $ 25)) - (SPADCALL |us| |v| - (|getShellEntry| $ 25)) - (|getShellEntry| $ 26)))))))))))))) - -(DEFUN |TSETCAT-;reduced?;PSMB;3| (|p| |ts| |redOp?| $) - (PROG (|lp|) - (RETURN - (SEQ (LETT |lp| (SPADCALL |ts| (|getShellEntry| $ 29)) - |TSETCAT-;reduced?;PSMB;3|) - (SEQ G190 - (COND - ((NULL (COND - ((NULL |lp|) 'NIL) - ('T - (SPADCALL |p| (|SPADfirst| |lp|) |redOp?|)))) - (GO G191))) - (SEQ (EXIT (LETT |lp| (CDR |lp|) - |TSETCAT-;reduced?;PSMB;3|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (NULL |lp|)))))) - -(DEFUN |TSETCAT-;basicSet;LMU;4| (|ps| |redOp?| $) - (PROG (|b| |bs| |p| |ts|) - (RETURN - (SEQ (LETT |ps| (SPADCALL (ELT $ 32) |ps| (|getShellEntry| $ 34)) - |TSETCAT-;basicSet;LMU;4|) - (EXIT (COND - ((SPADCALL (ELT $ 35) |ps| (|getShellEntry| $ 36)) - (CONS 1 "failed")) - ('T - (SEQ (LETT |ps| - (SPADCALL (ELT $ 22) |ps| - (|getShellEntry| $ 37)) - |TSETCAT-;basicSet;LMU;4|) - (LETT |bs| (SPADCALL (|getShellEntry| $ 38)) - |TSETCAT-;basicSet;LMU;4|) - (LETT |ts| NIL |TSETCAT-;basicSet;LMU;4|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |ps|) - (|getShellEntry| $ 20))) - (GO G191))) - (SEQ (LETT |b| (|SPADfirst| |ps|) - |TSETCAT-;basicSet;LMU;4|) - (LETT |bs| - (SPADCALL |bs| |b| - (|getShellEntry| $ 39)) - |TSETCAT-;basicSet;LMU;4|) - (LETT |ps| (CDR |ps|) - |TSETCAT-;basicSet;LMU;4|) - (EXIT - (SEQ G190 - (COND - ((NULL - (COND - ((NULL |ps|) 'NIL) - ('T - (SPADCALL - (SPADCALL - (LETT |p| - (|SPADfirst| |ps|) - |TSETCAT-;basicSet;LMU;4|) - |bs| |redOp?| - (|getShellEntry| $ 40)) - (|getShellEntry| $ 20))))) - (GO G191))) - (SEQ - (LETT |ts| (CONS |p| |ts|) - |TSETCAT-;basicSet;LMU;4|) - (EXIT - (LETT |ps| (CDR |ps|) - |TSETCAT-;basicSet;LMU;4|))) - NIL (GO G190) G191 (EXIT NIL)))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (CONS 0 (CONS |bs| |ts|))))))))))) - -(DEFUN |TSETCAT-;basicSet;LMMU;5| (|ps| |pred?| |redOp?| $) - (PROG (|bps| |b| |bs| |p| |gps| |ts|) - (RETURN - (SEQ (LETT |ps| (SPADCALL (ELT $ 32) |ps| (|getShellEntry| $ 34)) - |TSETCAT-;basicSet;LMMU;5|) - (EXIT (COND - ((SPADCALL (ELT $ 35) |ps| (|getShellEntry| $ 36)) - (CONS 1 "failed")) - ('T - (SEQ (LETT |gps| NIL |TSETCAT-;basicSet;LMMU;5|) - (LETT |bps| NIL |TSETCAT-;basicSet;LMMU;5|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |ps|) - (|getShellEntry| $ 20))) - (GO G191))) - (SEQ (LETT |p| (|SPADfirst| |ps|) - |TSETCAT-;basicSet;LMMU;5|) - (LETT |ps| (CDR |ps|) - |TSETCAT-;basicSet;LMMU;5|) - (EXIT - (COND - ((SPADCALL |p| |pred?|) - (LETT |gps| (CONS |p| |gps|) - |TSETCAT-;basicSet;LMMU;5|)) - ('T - (LETT |bps| (CONS |p| |bps|) - |TSETCAT-;basicSet;LMMU;5|))))) - NIL (GO G190) G191 (EXIT NIL)) - (LETT |gps| - (SPADCALL (ELT $ 22) |gps| - (|getShellEntry| $ 37)) - |TSETCAT-;basicSet;LMMU;5|) - (LETT |bs| (SPADCALL (|getShellEntry| $ 38)) - |TSETCAT-;basicSet;LMMU;5|) - (LETT |ts| NIL |TSETCAT-;basicSet;LMMU;5|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |gps|) - (|getShellEntry| $ 20))) - (GO G191))) - (SEQ (LETT |b| (|SPADfirst| |gps|) - |TSETCAT-;basicSet;LMMU;5|) - (LETT |bs| - (SPADCALL |bs| |b| - (|getShellEntry| $ 39)) - |TSETCAT-;basicSet;LMMU;5|) - (LETT |gps| (CDR |gps|) - |TSETCAT-;basicSet;LMMU;5|) - (EXIT - (SEQ G190 - (COND - ((NULL - (COND - ((NULL |gps|) 'NIL) - ('T - (SPADCALL - (SPADCALL - (LETT |p| - (|SPADfirst| |gps|) - |TSETCAT-;basicSet;LMMU;5|) - |bs| |redOp?| - (|getShellEntry| $ 40)) - (|getShellEntry| $ 20))))) - (GO G191))) - (SEQ - (LETT |ts| (CONS |p| |ts|) - |TSETCAT-;basicSet;LMMU;5|) - (EXIT - (LETT |gps| (CDR |gps|) - |TSETCAT-;basicSet;LMMU;5|))) - NIL (GO G190) G191 (EXIT NIL)))) - NIL (GO G190) G191 (EXIT NIL)) - (LETT |ts| - (SPADCALL (ELT $ 22) - (SPADCALL |ts| |bps| - (|getShellEntry| $ 44)) - (|getShellEntry| $ 37)) - |TSETCAT-;basicSet;LMMU;5|) - (EXIT (CONS 0 (CONS |bs| |ts|))))))))))) - -(DEFUN |TSETCAT-;initials;SL;6| (|ts| $) - (PROG (|p| |ip| |lip| |lp|) - (RETURN - (SEQ (LETT |lip| NIL |TSETCAT-;initials;SL;6|) - (EXIT (COND - ((SPADCALL |ts| (|getShellEntry| $ 12)) |lip|) - ('T - (SEQ (LETT |lp| - (SPADCALL |ts| (|getShellEntry| $ 29)) - |TSETCAT-;initials;SL;6|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |lp|) - (|getShellEntry| $ 20))) - (GO G191))) - (SEQ (LETT |p| (|SPADfirst| |lp|) - |TSETCAT-;initials;SL;6|) - (COND - ((NULL - (SPADCALL - (LETT |ip| - (SPADCALL |p| - (|getShellEntry| $ 46)) - |TSETCAT-;initials;SL;6|) - (|getShellEntry| $ 35))) - (LETT |lip| - (CONS - (SPADCALL |ip| - (|getShellEntry| $ 47)) - |lip|) - |TSETCAT-;initials;SL;6|))) - (EXIT - (LETT |lp| (CDR |lp|) - |TSETCAT-;initials;SL;6|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |lip| (|getShellEntry| $ 48))))))))))) - -(DEFUN |TSETCAT-;degree;SNni;7| (|ts| $) - (PROG (|lp| |d|) - (RETURN - (SEQ (COND - ((SPADCALL |ts| (|getShellEntry| $ 12)) 0) - ('T - (SEQ (LETT |lp| (SPADCALL |ts| (|getShellEntry| $ 29)) - |TSETCAT-;degree;SNni;7|) - (LETT |d| - (SPADCALL (|SPADfirst| |lp|) - (|getShellEntry| $ 51)) - |TSETCAT-;degree;SNni;7|) - (SEQ G190 - (COND - ((NULL (SPADCALL - (NULL - (LETT |lp| (CDR |lp|) - |TSETCAT-;degree;SNni;7|)) - (|getShellEntry| $ 20))) - (GO G191))) - (SEQ (EXIT (LETT |d| - (* |d| - (SPADCALL (|SPADfirst| |lp|) - (|getShellEntry| $ 51))) - |TSETCAT-;degree;SNni;7|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |d|)))))))) - -(DEFUN |TSETCAT-;quasiComponent;SR;8| (|ts| $) - (CONS (SPADCALL |ts| (|getShellEntry| $ 29)) - (SPADCALL |ts| (|getShellEntry| $ 53)))) - -(DEFUN |TSETCAT-;normalized?;PSB;9| (|p| |ts| $) - (SPADCALL |p| (SPADCALL |ts| (|getShellEntry| $ 29)) - (|getShellEntry| $ 57))) - -(DEFUN |TSETCAT-;stronglyReduced?;PSB;10| (|p| |ts| $) - (SPADCALL |p| (SPADCALL |ts| (|getShellEntry| $ 29)) - (|getShellEntry| $ 59))) - -(DEFUN |TSETCAT-;headReduced?;PSB;11| (|p| |ts| $) - (SPADCALL (SPADCALL |p| (|getShellEntry| $ 61)) |ts| - (|getShellEntry| $ 62))) - -(DEFUN |TSETCAT-;initiallyReduced?;PSB;12| (|p| |ts| $) - (PROG (|lp| |red|) - (RETURN - (SEQ (LETT |lp| (SPADCALL |ts| (|getShellEntry| $ 29)) - |TSETCAT-;initiallyReduced?;PSB;12|) - (LETT |red| 'T |TSETCAT-;initiallyReduced?;PSB;12|) - (SEQ G190 - (COND - ((NULL (COND - ((OR (NULL |lp|) - (SPADCALL |p| (|getShellEntry| $ 35))) - 'NIL) - ('T |red|))) - (GO G191))) - (SEQ (SEQ G190 - (COND - ((NULL (COND - ((NULL |lp|) 'NIL) - ('T - (SPADCALL - (SPADCALL |p| - (|getShellEntry| $ 24)) - (SPADCALL (|SPADfirst| |lp|) - (|getShellEntry| $ 24)) - (|getShellEntry| $ 64))))) - (GO G191))) - (SEQ (EXIT (LETT |lp| (CDR |lp|) - |TSETCAT-;initiallyReduced?;PSB;12|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((NULL (NULL |lp|)) - (COND - ((SPADCALL - (SPADCALL (|SPADfirst| |lp|) - (|getShellEntry| $ 24)) - (SPADCALL |p| - (|getShellEntry| $ 24)) - (|getShellEntry| $ 65)) - (COND - ((SPADCALL |p| (|SPADfirst| |lp|) - (|getShellEntry| $ 66)) - (SEQ - (LETT |lp| (CDR |lp|) - |TSETCAT-;initiallyReduced?;PSB;12|) - (EXIT - (LETT |p| - (SPADCALL |p| - (|getShellEntry| $ 46)) - |TSETCAT-;initiallyReduced?;PSB;12|)))) - ('T - (LETT |red| 'NIL - |TSETCAT-;initiallyReduced?;PSB;12|)))) - ('T - (LETT |p| - (SPADCALL |p| - (|getShellEntry| $ 46)) - |TSETCAT-;initiallyReduced?;PSB;12|))))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |red|))))) - -(DEFUN |TSETCAT-;reduce;PSMMP;13| (|p| |ts| |redOp| |redOp?| $) - (PROG (|ts0| #0=#:G1539 |reductor| #1=#:G1542) - (RETURN - (SEQ (COND - ((OR (SPADCALL |ts| (|getShellEntry| $ 12)) - (SPADCALL |p| (|getShellEntry| $ 35))) - |p|) - ('T - (SEQ (LETT |ts0| |ts| |TSETCAT-;reduce;PSMMP;13|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |ts| - (|getShellEntry| $ 12)) - 'NIL) - ('T - (SPADCALL - (SPADCALL |p| - (|getShellEntry| $ 35)) - (|getShellEntry| $ 20))))) - (GO G191))) - (SEQ (LETT |reductor| - (PROG2 - (LETT #0# - (SPADCALL |ts| - (|getShellEntry| $ 14)) - |TSETCAT-;reduce;PSMMP;13|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|getShellEntry| $ 10) #0#)) - |TSETCAT-;reduce;PSMMP;13|) - (LETT |ts| - (PROG2 - (LETT #1# - (SPADCALL |ts| - (|getShellEntry| $ 17)) - |TSETCAT-;reduce;PSMMP;13|) - (QCDR #1#) - (|check-union| (QEQCAR #1# 0) - (|getShellEntry| $ 6) #1#)) - |TSETCAT-;reduce;PSMMP;13|) - (EXIT (COND - ((NULL - (SPADCALL |p| |reductor| - |redOp?|)) - (SEQ - (LETT |p| - (SPADCALL |p| |reductor| - |redOp|) - |TSETCAT-;reduce;PSMMP;13|) - (EXIT - (LETT |ts| |ts0| - |TSETCAT-;reduce;PSMMP;13|))))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |p|)))))))) - -(DEFUN |TSETCAT-;rewriteSetWithReduction;LSMML;14| - (|lp| |ts| |redOp| |redOp?| $) - (PROG (|p| |rs|) - (RETURN - (SEQ (COND - ((SPADCALL |ts| (|getShellEntry| $ 70)) |lp|) - ('T - (SEQ (LETT |lp| - (SPADCALL (ELT $ 32) |lp| - (|getShellEntry| $ 34)) - |TSETCAT-;rewriteSetWithReduction;LSMML;14|) - (EXIT (COND - ((NULL |lp|) |lp|) - ((SPADCALL (ELT $ 35) |lp| - (|getShellEntry| $ 36)) - (LIST (|spadConstant| $ 71))) - ('T - (SEQ (LETT |rs| NIL - |TSETCAT-;rewriteSetWithReduction;LSMML;14|) - (SEQ G190 - (COND - ((NULL - (SPADCALL (NULL |lp|) - (|getShellEntry| $ 20))) - (GO G191))) - (SEQ - (LETT |p| (|SPADfirst| |lp|) - |TSETCAT-;rewriteSetWithReduction;LSMML;14|) - (LETT |lp| (CDR |lp|) - |TSETCAT-;rewriteSetWithReduction;LSMML;14|) - (LETT |p| - (SPADCALL - (SPADCALL |p| |ts| |redOp| - |redOp?| - (|getShellEntry| $ 72)) - (|getShellEntry| $ 47)) - |TSETCAT-;rewriteSetWithReduction;LSMML;14|) - (EXIT - (COND - ((NULL - (SPADCALL |p| - (|getShellEntry| $ 32))) - (COND - ((SPADCALL |p| - (|getShellEntry| $ 35)) - (SEQ - (LETT |lp| NIL - |TSETCAT-;rewriteSetWithReduction;LSMML;14|) - (EXIT - (LETT |rs| - (LIST - (|spadConstant| $ 71)) - |TSETCAT-;rewriteSetWithReduction;LSMML;14|)))) - ('T - (LETT |rs| - (CONS |p| |rs|) - |TSETCAT-;rewriteSetWithReduction;LSMML;14|))))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |rs| - (|getShellEntry| $ 48)))))))))))))) - -(DEFUN |TSETCAT-;stronglyReduce;PSP;15| (|p| |ts| $) - (SPADCALL |p| |ts| (ELT $ 74) (ELT $ 66) (|getShellEntry| $ 72))) - -(DEFUN |TSETCAT-;headReduce;PSP;16| (|p| |ts| $) - (SPADCALL |p| |ts| (ELT $ 76) (ELT $ 77) (|getShellEntry| $ 72))) - -(DEFUN |TSETCAT-;initiallyReduce;PSP;17| (|p| |ts| $) - (SPADCALL |p| |ts| (ELT $ 79) (ELT $ 80) (|getShellEntry| $ 72))) - -(DEFUN |TSETCAT-;removeZero;PSP;18| (|p| |ts| $) - (PROG (|v| |tsv-| #0=#:G1565 #1=#:G1574 |q|) - (RETURN - (SEQ (EXIT (COND - ((OR (SPADCALL |p| (|getShellEntry| $ 35)) - (SPADCALL |ts| (|getShellEntry| $ 12))) - |p|) - ('T - (SEQ (LETT |v| - (SPADCALL |p| (|getShellEntry| $ 24)) - |TSETCAT-;removeZero;PSP;18|) - (LETT |tsv-| - (SPADCALL |ts| |v| - (|getShellEntry| $ 82)) - |TSETCAT-;removeZero;PSP;18|) - (COND - ((SPADCALL |v| |ts| (|getShellEntry| $ 83)) - (SEQ (LETT |q| - (SPADCALL |p| - (PROG2 - (LETT #0# - (SPADCALL |ts| |v| - (|getShellEntry| $ 84)) - |TSETCAT-;removeZero;PSP;18|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|getShellEntry| $ 10) #0#)) - (|getShellEntry| $ 74)) - |TSETCAT-;removeZero;PSP;18|) - (EXIT (COND - ((SPADCALL |q| - (|getShellEntry| $ 32)) - (PROGN - (LETT #1# |q| - |TSETCAT-;removeZero;PSP;18|) - (GO #1#))) - ((SPADCALL - (SPADCALL |q| |tsv-| - (|getShellEntry| $ 85)) - (|getShellEntry| $ 32)) - (PROGN - (LETT #1# - (|spadConstant| $ 86) - |TSETCAT-;removeZero;PSP;18|) - (GO #1#)))))))) - (EXIT (COND - ((SPADCALL |tsv-| - (|getShellEntry| $ 12)) - |p|) - ('T - (SEQ (LETT |q| (|spadConstant| $ 86) - |TSETCAT-;removeZero;PSP;18|) - (SEQ G190 - (COND - ((NULL - (SPADCALL - (SPADCALL |p| |v| - (|getShellEntry| $ 87)) - (|getShellEntry| $ 89))) - (GO G191))) - (SEQ - (LETT |q| - (SPADCALL - (SPADCALL - (SPADCALL - (SPADCALL |p| - (|getShellEntry| $ 46)) - |tsv-| - (|getShellEntry| $ 85)) - (SPADCALL |p| - (|getShellEntry| $ 90)) - (|getShellEntry| $ 91)) - |q| (|getShellEntry| $ 92)) - |TSETCAT-;removeZero;PSP;18|) - (EXIT - (LETT |p| - (SPADCALL |p| - (|getShellEntry| $ 93)) - |TSETCAT-;removeZero;PSP;18|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT - (SPADCALL |q| - (SPADCALL |p| |tsv-| - (|getShellEntry| $ 85)) - (|getShellEntry| $ 92))))))))))) - #1# (EXIT #1#))))) - -(DEFUN |TSETCAT-;reduceByQuasiMonic;PSP;19| (|p| |ts| $) - (COND - ((OR (SPADCALL |p| (|getShellEntry| $ 35)) - (SPADCALL |ts| (|getShellEntry| $ 12))) - |p|) - ('T - (QVELT (SPADCALL |p| (SPADCALL |ts| (|getShellEntry| $ 95)) - (|getShellEntry| $ 97)) - 1)))) - -(DEFUN |TSETCAT-;autoReduced?;SMB;20| (|ts| |redOp?| $) - (PROG (|p| |lp|) - (RETURN - (SEQ (COND - ((SPADCALL |ts| (|getShellEntry| $ 12)) 'T) - ('T - (SEQ (LETT |lp| (SPADCALL |ts| (|getShellEntry| $ 29)) - |TSETCAT-;autoReduced?;SMB;20|) - (LETT |p| (|SPADfirst| |lp|) - |TSETCAT-;autoReduced?;SMB;20|) - (LETT |lp| (CDR |lp|) - |TSETCAT-;autoReduced?;SMB;20|) - (SEQ G190 - (COND - ((NULL (COND - ((NULL |lp|) 'NIL) - ('T (SPADCALL |p| |lp| |redOp?|)))) - (GO G191))) - (SEQ (LETT |p| (|SPADfirst| |lp|) - |TSETCAT-;autoReduced?;SMB;20|) - (EXIT (LETT |lp| (CDR |lp|) - |TSETCAT-;autoReduced?;SMB;20|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (NULL |lp|))))))))) - -(DEFUN |TSETCAT-;stronglyReduced?;SB;21| (|ts| $) - (SPADCALL |ts| (ELT $ 59) (|getShellEntry| $ 101))) - -(DEFUN |TSETCAT-;normalized?;SB;22| (|ts| $) - (SPADCALL |ts| (ELT $ 57) (|getShellEntry| $ 101))) - -(DEFUN |TSETCAT-;headReduced?;SB;23| (|ts| $) - (SPADCALL |ts| (ELT $ 104) (|getShellEntry| $ 101))) - -(DEFUN |TSETCAT-;initiallyReduced?;SB;24| (|ts| $) - (SPADCALL |ts| (ELT $ 106) (|getShellEntry| $ 101))) - -(DEFUN |TSETCAT-;mvar;SV;25| (|ts| $) - (PROG (#0=#:G1593) - (RETURN - (COND - ((SPADCALL |ts| (|getShellEntry| $ 12)) - (|error| "Error from TSETCAT in mvar : #1 is empty")) - ('T - (SPADCALL - (PROG2 (LETT #0# (SPADCALL |ts| (|getShellEntry| $ 14)) - |TSETCAT-;mvar;SV;25|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 10) - #0#)) - (|getShellEntry| $ 24))))))) - -(DEFUN |TSETCAT-;first;SU;26| (|ts| $) - (PROG (|lp|) - (RETURN - (SEQ (COND - ((SPADCALL |ts| (|getShellEntry| $ 12)) (CONS 1 "failed")) - ('T - (SEQ (LETT |lp| - (SPADCALL (ELT $ 23) - (SPADCALL |ts| (|getShellEntry| $ 29)) - (|getShellEntry| $ 37)) - |TSETCAT-;first;SU;26|) - (EXIT (CONS 0 (|SPADfirst| |lp|)))))))))) - -(DEFUN |TSETCAT-;last;SU;27| (|ts| $) - (PROG (|lp|) - (RETURN - (SEQ (COND - ((SPADCALL |ts| (|getShellEntry| $ 12)) (CONS 1 "failed")) - ('T - (SEQ (LETT |lp| - (SPADCALL (ELT $ 22) - (SPADCALL |ts| (|getShellEntry| $ 29)) - (|getShellEntry| $ 37)) - |TSETCAT-;last;SU;27|) - (EXIT (CONS 0 (|SPADfirst| |lp|)))))))))) - -(DEFUN |TSETCAT-;rest;SU;28| (|ts| $) - (PROG (|lp|) - (RETURN - (SEQ (COND - ((SPADCALL |ts| (|getShellEntry| $ 12)) (CONS 1 "failed")) - ('T - (SEQ (LETT |lp| - (SPADCALL (ELT $ 23) - (SPADCALL |ts| (|getShellEntry| $ 29)) - (|getShellEntry| $ 37)) - |TSETCAT-;rest;SU;28|) - (EXIT (CONS 0 - (SPADCALL (CDR |lp|) - (|getShellEntry| $ 111))))))))))) - -(DEFUN |TSETCAT-;coerce;SL;29| (|ts| $) - (SPADCALL (ELT $ 23) (SPADCALL |ts| (|getShellEntry| $ 29)) - (|getShellEntry| $ 37))) - -(DEFUN |TSETCAT-;algebraicVariables;SL;30| (|ts| $) - (PROG (#0=#:G1618 |p| #1=#:G1619) - (RETURN - (SEQ (PROGN - (LETT #0# NIL |TSETCAT-;algebraicVariables;SL;30|) - (SEQ (LETT |p| NIL |TSETCAT-;algebraicVariables;SL;30|) - (LETT #1# (SPADCALL |ts| (|getShellEntry| $ 29)) - |TSETCAT-;algebraicVariables;SL;30|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |p| (CAR #1#) - |TSETCAT-;algebraicVariables;SL;30|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (SPADCALL |p| - (|getShellEntry| $ 24)) - #0#) - |TSETCAT-;algebraicVariables;SL;30|))) - (LETT #1# (CDR #1#) - |TSETCAT-;algebraicVariables;SL;30|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))))))) - -(DEFUN |TSETCAT-;algebraic?;VSB;31| (|v| |ts| $) - (SPADCALL |v| (SPADCALL |ts| (|getShellEntry| $ 116)) - (|getShellEntry| $ 117))) - -(DEFUN |TSETCAT-;select;SVU;32| (|ts| |v| $) - (PROG (|lp|) - (RETURN - (SEQ (LETT |lp| - (SPADCALL (ELT $ 23) - (SPADCALL |ts| (|getShellEntry| $ 29)) - (|getShellEntry| $ 37)) - |TSETCAT-;select;SVU;32|) - (SEQ G190 - (COND - ((NULL (COND - ((NULL |lp|) 'NIL) - ('T - (SPADCALL - (SPADCALL |v| - (SPADCALL (|SPADfirst| |lp|) - (|getShellEntry| $ 24)) - (|getShellEntry| $ 65)) - (|getShellEntry| $ 20))))) - (GO G191))) - (SEQ (EXIT (LETT |lp| (CDR |lp|) - |TSETCAT-;select;SVU;32|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((NULL |lp|) (CONS 1 "failed")) - ('T (CONS 0 (|SPADfirst| |lp|))))))))) - -(DEFUN |TSETCAT-;collectQuasiMonic;2S;33| (|ts| $) - (PROG (|newlp| |lp|) - (RETURN - (SEQ (LETT |lp| (SPADCALL |ts| (|getShellEntry| $ 29)) - |TSETCAT-;collectQuasiMonic;2S;33|) - (LETT |newlp| NIL |TSETCAT-;collectQuasiMonic;2S;33|) - (SEQ G190 - (COND - ((NULL (SPADCALL (NULL |lp|) (|getShellEntry| $ 20))) - (GO G191))) - (SEQ (COND - ((SPADCALL - (SPADCALL (|SPADfirst| |lp|) - (|getShellEntry| $ 46)) - (|getShellEntry| $ 35)) - (LETT |newlp| (CONS (|SPADfirst| |lp|) |newlp|) - |TSETCAT-;collectQuasiMonic;2S;33|))) - (EXIT (LETT |lp| (CDR |lp|) - |TSETCAT-;collectQuasiMonic;2S;33|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |newlp| (|getShellEntry| $ 111))))))) - -(DEFUN |TSETCAT-;collectUnder;SVS;34| (|ts| |v| $) - (PROG (|lp|) - (RETURN - (SEQ (LETT |lp| - (SPADCALL (ELT $ 23) - (SPADCALL |ts| (|getShellEntry| $ 29)) - (|getShellEntry| $ 37)) - |TSETCAT-;collectUnder;SVS;34|) - (SEQ G190 - (COND - ((NULL (COND - ((NULL |lp|) 'NIL) - ('T - (SPADCALL - (SPADCALL - (SPADCALL (|SPADfirst| |lp|) - (|getShellEntry| $ 24)) - |v| (|getShellEntry| $ 64)) - (|getShellEntry| $ 20))))) - (GO G191))) - (SEQ (EXIT (LETT |lp| (CDR |lp|) - |TSETCAT-;collectUnder;SVS;34|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |lp| (|getShellEntry| $ 111))))))) - -(DEFUN |TSETCAT-;collectUpper;SVS;35| (|ts| |v| $) - (PROG (|lp2| |lp1|) - (RETURN - (SEQ (LETT |lp1| - (SPADCALL (ELT $ 23) - (SPADCALL |ts| (|getShellEntry| $ 29)) - (|getShellEntry| $ 37)) - |TSETCAT-;collectUpper;SVS;35|) - (LETT |lp2| NIL |TSETCAT-;collectUpper;SVS;35|) - (SEQ G190 - (COND - ((NULL (COND - ((NULL |lp1|) 'NIL) - ('T - (SPADCALL |v| - (SPADCALL (|SPADfirst| |lp1|) - (|getShellEntry| $ 24)) - (|getShellEntry| $ 64))))) - (GO G191))) - (SEQ (LETT |lp2| (CONS (|SPADfirst| |lp1|) |lp2|) - |TSETCAT-;collectUpper;SVS;35|) - (EXIT (LETT |lp1| (CDR |lp1|) - |TSETCAT-;collectUpper;SVS;35|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL (REVERSE |lp2|) (|getShellEntry| $ 111))))))) - -(DEFUN |TSETCAT-;construct;LS;36| (|lp| $) - (PROG (|rif|) - (RETURN - (SEQ (LETT |rif| (SPADCALL |lp| (|getShellEntry| $ 123)) - |TSETCAT-;construct;LS;36|) - (EXIT (COND - ((QEQCAR |rif| 0) (QCDR |rif|)) - ('T - (|error| "in construct : LP -> $ from TSETCAT : bad arg")))))))) - -(DEFUN |TSETCAT-;retractIfCan;LU;37| (|lp| $) - (PROG (|rif|) - (RETURN - (SEQ (COND - ((NULL |lp|) (CONS 0 (SPADCALL (|getShellEntry| $ 38)))) - ('T - (SEQ (LETT |lp| - (SPADCALL (ELT $ 23) |lp| - (|getShellEntry| $ 37)) - |TSETCAT-;retractIfCan;LU;37|) - (LETT |rif| - (SPADCALL (CDR |lp|) (|getShellEntry| $ 123)) - |TSETCAT-;retractIfCan;LU;37|) - (EXIT (COND - ((QEQCAR |rif| 0) - (SPADCALL (QCDR |rif|) (|SPADfirst| |lp|) - (|getShellEntry| $ 125))) - ('T - (|error| "in retractIfCan : LP -> ... from TSETCAT : bad arg"))))))))))) - -(DEFUN |TSETCAT-;extend;SPS;38| (|ts| |p| $) - (PROG (|eif|) - (RETURN - (SEQ (LETT |eif| (SPADCALL |ts| |p| (|getShellEntry| $ 125)) - |TSETCAT-;extend;SPS;38|) - (EXIT (COND - ((QEQCAR |eif| 0) (QCDR |eif|)) - ('T - (|error| "in extend : ($,P) -> $ from TSETCAT : bad ars")))))))) - -(DEFUN |TSETCAT-;coHeight;SNni;39| (|ts| $) - (PROG (|n| |m| #0=#:G1659) - (RETURN - (SEQ (LETT |n| (SPADCALL (|getShellEntry| $ 128)) - |TSETCAT-;coHeight;SNni;39|) - (LETT |m| (LENGTH (SPADCALL |ts| (|getShellEntry| $ 29))) - |TSETCAT-;coHeight;SNni;39|) - (EXIT (PROG2 (LETT #0# - (SPADCALL |n| |m| - (|getShellEntry| $ 129)) - |TSETCAT-;coHeight;SNni;39|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) (|NonNegativeInteger|) - #0#))))))) - -(DEFUN |TriangularSetCategory&| (|#1| |#2| |#3| |#4| |#5|) - (PROG (|dv$1| |dv$2| |dv$3| |dv$4| |dv$5| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) - . #0=(|TriangularSetCategory&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$3| (|devaluate| |#3|) . #0#) - (LETT |dv$4| (|devaluate| |#4|) . #0#) - (LETT |dv$5| (|devaluate| |#5|) . #0#) - (LETT |dv$| - (LIST '|TriangularSetCategory&| |dv$1| |dv$2| |dv$3| - |dv$4| |dv$5|) . #0#) - (LETT $ (|newShell| 132) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasCategory| |#4| '(|Finite|)))) . #0#)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 |#1|) - (|setShellEntry| $ 7 |#2|) - (|setShellEntry| $ 8 |#3|) - (|setShellEntry| $ 9 |#4|) - (|setShellEntry| $ 10 |#5|) - (COND - ((|testBitVector| |pv$| 1) - (|setShellEntry| $ 130 - (CONS (|dispatchFunction| |TSETCAT-;coHeight;SNni;39|) - $)))) - $)))) - -(MAKEPROP '|TriangularSetCategory&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|local| |#3|) (|local| |#4|) (|local| |#5|) (|Boolean|) - (0 . |empty?|) (|Union| 10 '"failed") (5 . |first|) - (10 . =) (|Union| $ '"failed") (16 . |rest|) (21 . =) - |TSETCAT-;=;2SB;1| (27 . |not|) (32 . |last|) - (37 . |infRittWu?|) (43 . |supRittWu?|) (49 . |mvar|) - (54 . |collectUpper|) (60 . |infRittWu?|) - |TSETCAT-;infRittWu?;2SB;2| (|List| 10) (66 . |members|) - (|Mapping| 11 10 10) |TSETCAT-;reduced?;PSMB;3| - (71 . |zero?|) (|Mapping| 11 10) (76 . |remove|) - (82 . |ground?|) (87 . |any?|) (93 . |sort|) - (99 . |empty|) (103 . |extend|) (109 . |reduced?|) - (|Record| (|:| |bas| $) (|:| |top| 28)) - (|Union| 41 '"failed") |TSETCAT-;basicSet;LMU;4| - (116 . |concat|) |TSETCAT-;basicSet;LMMU;5| (122 . |init|) - (127 . |primPartElseUnitCanonical|) - (132 . |removeDuplicates|) |TSETCAT-;initials;SL;6| - (|NonNegativeInteger|) (137 . |mdeg|) - |TSETCAT-;degree;SNni;7| (142 . |initials|) - (|Record| (|:| |close| 28) (|:| |open| 28)) - |TSETCAT-;quasiComponent;SR;8| (|List| $) - (147 . |normalized?|) |TSETCAT-;normalized?;PSB;9| - (153 . |reduced?|) |TSETCAT-;stronglyReduced?;PSB;10| - (159 . |head|) (164 . |stronglyReduced?|) - |TSETCAT-;headReduced?;PSB;11| (170 . <) (176 . =) - (182 . |reduced?|) |TSETCAT-;initiallyReduced?;PSB;12| - (|Mapping| 10 10 10) |TSETCAT-;reduce;PSMMP;13| - (188 . |trivialIdeal?|) (193 . |One|) (197 . |reduce|) - |TSETCAT-;rewriteSetWithReduction;LSMML;14| - (205 . |lazyPrem|) |TSETCAT-;stronglyReduce;PSP;15| - (211 . |headReduce|) (217 . |headReduced?|) - |TSETCAT-;headReduce;PSP;16| (223 . |initiallyReduce|) - (229 . |initiallyReduced?|) - |TSETCAT-;initiallyReduce;PSP;17| (235 . |collectUnder|) - (241 . |algebraic?|) (247 . |select|) (253 . |removeZero|) - (259 . |Zero|) (263 . |degree|) (|Integer|) - (269 . |positive?|) (274 . |mainMonomial|) (279 . *) - (285 . +) (291 . |tail|) |TSETCAT-;removeZero;PSP;18| - (296 . |collectQuasiMonic|) - (|Record| (|:| |rnum| 7) (|:| |polnum| 10) (|:| |den| 7)) - (301 . |remainder|) |TSETCAT-;reduceByQuasiMonic;PSP;19| - (|Mapping| 11 10 28) |TSETCAT-;autoReduced?;SMB;20| - (307 . |autoReduced?|) |TSETCAT-;stronglyReduced?;SB;21| - |TSETCAT-;normalized?;SB;22| (313 . |headReduced?|) - |TSETCAT-;headReduced?;SB;23| (319 . |initiallyReduced?|) - |TSETCAT-;initiallyReduced?;SB;24| |TSETCAT-;mvar;SV;25| - |TSETCAT-;first;SU;26| |TSETCAT-;last;SU;27| - (325 . |construct|) |TSETCAT-;rest;SU;28| - |TSETCAT-;coerce;SL;29| (|List| 9) - |TSETCAT-;algebraicVariables;SL;30| - (330 . |algebraicVariables|) (335 . |member?|) - |TSETCAT-;algebraic?;VSB;31| |TSETCAT-;select;SVU;32| - |TSETCAT-;collectQuasiMonic;2S;33| - |TSETCAT-;collectUnder;SVS;34| - |TSETCAT-;collectUpper;SVS;35| (341 . |retractIfCan|) - |TSETCAT-;construct;LS;36| (346 . |extendIfCan|) - |TSETCAT-;retractIfCan;LU;37| |TSETCAT-;extend;SPS;38| - (352 . |size|) (356 . |subtractIfCan|) (362 . |coHeight|) - (|OutputForm|)) - '#(|stronglyReduced?| 367 |stronglyReduce| 378 |select| 384 - |rewriteSetWithReduction| 390 |retractIfCan| 398 |rest| - 403 |removeZero| 408 |reduced?| 414 |reduceByQuasiMonic| - 421 |reduce| 427 |quasiComponent| 435 |normalized?| 440 - |mvar| 451 |last| 456 |initials| 461 |initiallyReduced?| - 466 |initiallyReduce| 477 |infRittWu?| 483 |headReduced?| - 489 |headReduce| 500 |first| 506 |extend| 511 |degree| 517 - |construct| 522 |collectUpper| 527 |collectUnder| 533 - |collectQuasiMonic| 539 |coerce| 544 |coHeight| 549 - |basicSet| 554 |autoReduced?| 567 |algebraicVariables| 573 - |algebraic?| 578 = 584) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 130 - '(1 6 11 0 12 1 6 13 0 14 2 10 11 0 0 - 15 1 6 16 0 17 2 6 11 0 0 18 1 11 0 0 - 20 1 6 13 0 21 2 10 11 0 0 22 2 10 11 - 0 0 23 1 10 9 0 24 2 6 0 0 9 25 2 6 - 11 0 0 26 1 6 28 0 29 1 10 11 0 32 2 - 28 0 33 0 34 1 10 11 0 35 2 28 11 33 - 0 36 2 28 0 30 0 37 0 6 0 38 2 6 0 0 - 10 39 3 6 11 10 0 30 40 2 28 0 0 0 44 - 1 10 0 0 46 1 10 0 0 47 1 28 0 0 48 1 - 10 50 0 51 1 6 28 0 53 2 10 11 0 56 - 57 2 10 11 0 56 59 1 10 0 0 61 2 6 11 - 10 0 62 2 9 11 0 0 64 2 9 11 0 0 65 2 - 10 11 0 0 66 1 6 11 0 70 0 10 0 71 4 - 6 10 10 0 68 30 72 2 10 0 0 0 74 2 10 - 0 0 0 76 2 10 11 0 0 77 2 10 0 0 0 79 - 2 10 11 0 0 80 2 6 0 0 9 82 2 6 11 9 - 0 83 2 6 13 0 9 84 2 6 10 10 0 85 0 - 10 0 86 2 10 50 0 9 87 1 88 11 0 89 1 - 10 0 0 90 2 10 0 0 0 91 2 10 0 0 0 92 - 1 10 0 0 93 1 6 0 0 95 2 6 96 10 0 97 - 2 6 11 0 99 101 2 10 11 0 56 104 2 10 - 11 0 56 106 1 6 0 28 111 1 6 114 0 - 116 2 114 11 9 0 117 1 6 16 28 123 2 - 6 16 0 10 125 0 9 50 128 2 50 16 0 0 - 129 1 0 50 0 130 1 0 11 0 102 2 0 11 - 10 0 60 2 0 10 10 0 75 2 0 13 0 9 119 - 4 0 28 28 0 68 30 73 1 0 16 28 126 1 - 0 16 0 112 2 0 10 10 0 94 3 0 11 10 0 - 30 31 2 0 10 10 0 98 4 0 10 10 0 68 - 30 69 1 0 54 0 55 1 0 11 0 103 2 0 11 - 10 0 58 1 0 9 0 108 1 0 13 0 110 1 0 - 28 0 49 1 0 11 0 107 2 0 11 10 0 67 2 - 0 10 10 0 81 2 0 11 0 0 27 1 0 11 0 - 105 2 0 11 10 0 63 2 0 10 10 0 78 1 0 - 13 0 109 2 0 0 0 10 127 1 0 50 0 52 1 - 0 0 28 124 2 0 0 0 9 122 2 0 0 0 9 - 121 1 0 0 0 120 1 0 28 0 113 1 0 50 0 - 130 3 0 42 28 33 30 45 2 0 42 28 30 - 43 2 0 11 0 99 100 1 0 114 0 115 2 0 - 11 9 0 118 2 0 11 0 0 19))))) - '|lookupComplete|)) -@ \section{domain GTSET GeneralTriangularSet} diff --git a/src/algebra/vector.spad.pamphlet b/src/algebra/vector.spad.pamphlet index d580afe1..97f743b5 100644 --- a/src/algebra/vector.spad.pamphlet +++ b/src/algebra/vector.spad.pamphlet @@ -154,151 +154,6 @@ Vector(R:Type): Exports == Implementation where convert(parts x)@InputForm] @ -\section{VECTOR.lsp BOOTSTRAP} -{\bf VECTOR} depends on itself. -We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf VECTOR} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf VECTOR.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<VECTOR.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |VECTOR;vector;L$;1| (|l| $) - (SPADCALL |l| (|getShellEntry| $ 8))) - -(DEFUN |VECTOR;convert;$If;2| (|x| $) - (SPADCALL - (LIST (SPADCALL (SPADCALL "vector" (|getShellEntry| $ 12)) - (|getShellEntry| $ 14)) - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 15)) - (|getShellEntry| $ 16))) - (|getShellEntry| $ 18))) - -(DEFUN |Vector| (#0=#:G1402) - (PROG () - (RETURN - (PROG (#1=#:G1403) - (RETURN - (COND - ((LETT #1# - (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) - (HGET |$ConstructorCache| '|Vector|) - '|domainEqualList|) - |Vector|) - (|CDRwithIncrement| #1#)) - ('T - (UNWIND-PROTECT - (PROG1 (|Vector;| #0#) (LETT #1# T |Vector|)) - (COND ((NOT #1#) (HREM |$ConstructorCache| '|Vector|))))))))))) - -(DEFUN |Vector;| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|Vector|)) - (LETT |dv$| (LIST '|Vector| |dv$1|) . #0#) - (LETT $ (|newShell| 36) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (OR (AND (|HasCategory| |#1| - '(|OrderedSet|)) - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|)))) - (AND (|HasCategory| |#1| - '(|SetCategory|)) - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|))))) - (OR (AND (|HasCategory| |#1| - '(|SetCategory|)) - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|)))) - (|HasCategory| |#1| - '(|CoercibleTo| (|OutputForm|)))) - (|HasCategory| |#1| - '(|ConvertibleTo| (|InputForm|))) - (OR (|HasCategory| |#1| '(|OrderedSet|)) - (|HasCategory| |#1| '(|SetCategory|))) - (|HasCategory| |#1| '(|OrderedSet|)) - (|HasCategory| (|Integer|) '(|OrderedSet|)) - (|HasCategory| |#1| '(|SetCategory|)) - (|HasCategory| |#1| '(|AbelianSemiGroup|)) - (|HasCategory| |#1| '(|AbelianMonoid|)) - (|HasCategory| |#1| '(|AbelianGroup|)) - (|HasCategory| |#1| '(|Monoid|)) - (|HasCategory| |#1| '(|Ring|)) - (AND (|HasCategory| |#1| - '(|RadicalCategory|)) - (|HasCategory| |#1| '(|Ring|))) - (AND (|HasCategory| |#1| '(|SetCategory|)) - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|)))) - (|HasCategory| |#1| - '(|CoercibleTo| (|OutputForm|))))) . #0#)) - (|haddProp| |$ConstructorCache| '|Vector| (LIST |dv$1|) - (CONS 1 $)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 |#1|) - (COND - ((|testBitVector| |pv$| 3) - (|setShellEntry| $ 19 - (CONS (|dispatchFunction| |VECTOR;convert;$If;2|) $)))) - $)))) - -(MAKEPROP '|Vector| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL (|IndexedVector| 6 (NRTEVAL 1)) - (|local| |#1|) (|List| 6) (0 . |construct|) - |VECTOR;vector;L$;1| (|String|) (|Symbol|) (5 . |coerce|) - (|InputForm|) (10 . |convert|) (15 . |parts|) - (20 . |convert|) (|List| $) (25 . |convert|) - (30 . |convert|) (|Mapping| 6 6 6) (|Boolean|) - (|NonNegativeInteger|) (|Equation| 6) (|List| 23) - (|Integer|) (|Mapping| 21 6) (|Mapping| 21 6 6) - (|UniversalSegment| 25) (|Void|) (|Mapping| 6 6) - (|OutputForm|) (|Matrix| 6) (|SingleInteger|) - (|Union| 6 '"failed") (|List| 25)) - '#(|vector| 35 |parts| 40 |convert| 45 |construct| 50) - '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) - (CONS (|makeByteWordVec2| 5 - '(0 0 0 0 0 0 0 5 0 0 1 4 0 0 1 2 3 4)) - (CONS '#(|VectorCategory&| - |OneDimensionalArrayAggregate&| - |FiniteLinearAggregate&| |LinearAggregate&| - |IndexedAggregate&| |Collection&| - |HomogeneousAggregate&| |OrderedSet&| - |Aggregate&| |EltableAggregate&| |Evalable&| - |SetCategory&| NIL NIL |InnerEvalable&| NIL - NIL |BasicType&|) - (CONS '#((|VectorCategory| 6) - (|OneDimensionalArrayAggregate| 6) - (|FiniteLinearAggregate| 6) - (|LinearAggregate| 6) - (|IndexedAggregate| 25 6) - (|Collection| 6) - (|HomogeneousAggregate| 6) - (|OrderedSet|) (|Aggregate|) - (|EltableAggregate| 25 6) (|Evalable| 6) - (|SetCategory|) (|Type|) - (|Eltable| 25 6) (|InnerEvalable| 6 6) - (|CoercibleTo| 31) (|ConvertibleTo| 13) - (|BasicType|)) - (|makeByteWordVec2| 19 - '(1 0 0 7 8 1 11 0 10 12 1 13 0 11 14 1 - 0 7 0 15 1 7 13 0 16 1 13 0 17 18 1 0 - 13 0 19 1 0 0 7 9 1 0 7 0 15 1 3 13 0 - 19 1 0 0 7 8))))) - '|lookupIncomplete|)) -@ \section{package VECTOR2 VectorFunctions2} |