diff options
| author | dos-reis <gdr@axiomatics.org> | 2011-03-07 05:49:53 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2011-03-07 05:49:53 +0000 |
| commit | a03b7716749e9fb997d99659967aa49ae6ca1569 (patch) | |
| tree | f9ea530df62ac41622e2180077fb4d07aebd7d64 | |
| parent | 13c00cb56547feb8cd6b5b3c6386a881072862f6 (diff) | |
| download | open-axiom-a03b7716749e9fb997d99659967aa49ae6ca1569.tar.gz | |
* interp/sys-utility.boot (getSystemModulePath): Use
systemAlgebraDirectory.
* interp/database.boot (pathToDatabase): Use systemDatabaseDirectory.
* algebra/integer.spad.pamphlet (Integer) [latex]: Tidy.
* algebra/string.spad.pamphlet (Character) [latex]: Likewise.
* algebra/Makefile.in: Rework bootstrapping set up.
(COMPILE_LISP): Remove.
(axiom_algebra_layer_strap): Likewise.
(axiom_algebra_layer_strap_objects): Likewise.
(axiom_algebra_bootstrap): Likewise.
(oa_strap_0_fasls): New.
(oa_strap_1_fasls): Likewise.
(oa_strap_2_fasls): Likewise.
(oa_strap_0_sources): Likewise.
(oa_strap_1_sources): Likewise.
(oa_strap_2_sources): Likewise.
* src/algerab/strap: Remove.
79 files changed, 317 insertions, 15156 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 14e497cb..de014395 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,25 @@ 2011-03-06 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/sys-utility.boot (getSystemModulePath): Use + systemAlgebraDirectory. + * interp/database.boot (pathToDatabase): Use systemDatabaseDirectory. + * algebra/integer.spad.pamphlet (Integer) [latex]: Tidy. + * algebra/string.spad.pamphlet (Character) [latex]: Likewise. + * algebra/Makefile.in: Rework bootstrapping set up. + (COMPILE_LISP): Remove. + (axiom_algebra_layer_strap): Likewise. + (axiom_algebra_layer_strap_objects): Likewise. + (axiom_algebra_bootstrap): Likewise. + (oa_strap_0_fasls): New. + (oa_strap_1_fasls): Likewise. + (oa_strap_2_fasls): Likewise. + (oa_strap_0_sources): Likewise. + (oa_strap_1_sources): Likewise. + (oa_strap_2_sources): Likewise. + * src/algerab/strap: Remove. + +2011-03-06 Gabriel Dos Reis <gdr@cs.tamu.edu> + * algebra/si.spad.pamphlet (SingleInteger): Logic is indirectly included through BooleanLogic. diff --git a/src/algebra/Makefile.in b/src/algebra/Makefile.in index d8502d43..fb2462a2 100644 --- a/src/algebra/Makefile.in +++ b/src/algebra/Makefile.in @@ -1,6 +1,6 @@ ## Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. ## All rights reserved. -## Copyright (C) 2007-2010, Gabriel Dos Reis. +## Copyright (C) 2007-2011, Gabriel Dos Reis. ## All rights reserved. ## ## Redistribution and use in source and binary forms, with or without @@ -101,16 +101,291 @@ INTERPSYS = ../interp/interpsys$(EXEEXT) COMPILE_SPAD = $(DRIVER) --execpath=$(INTERPSYS) \ --system="$(AXIOM)" \ - --sysalg="$(axiom_src_datadir)/algebra/" \ - --strap=strap --optimize=3 \ + --sysdb="$(axiom_src_datadir)/algebra/" \ + --strap=strap-2 --optimize=3 \ --system-algebra --compile $< -## We use interpsys, built from previous stage, to bootstrap the algebra -## files. In fact, we use interpsys to build everything. -COMPILE_LISP = $(DRIVER) --execpath=$(INTERPSYS) \ +BOOTSTRAP = $(DRIVER) --execpath=$(INTERPSYS) \ --system="$(AXIOM)" \ - --sysalg="$(axiom_src_datadir)/algebra/" \ - --compile --output=$@ $< + --sysdb="$(axiom_src_datadir)/algebra/" \ + --system-algebra --compile + +oa_strap_0_fasls = \ + $(addprefix strap-0/,$(addsuffix .$(FASLEXT),$(oa_strap_0_sources))) + + +oa_strap_1_fasls = \ + $(addprefix strap-1/,$(addsuffix .$(FASLEXT),$(oa_strap_1_sources))) + + +oa_strap_2_fasls = \ + $(addprefix strap-2/,$(addsuffix .$(FASLEXT),$(oa_strap_2_sources))) + +oa_strap_0_sources = \ + TYPE BASTYPE KOERCE KRCFROM KONVERT RETRACT FRETRCT SETCAT \ + FINITE ORDTYPE ORDSET ORDFIN \ + PROPLOG BOOLE LOGIC \ + ABELGRP LLINSET RLINSET LINSET CABMON ABELMON ABELSG \ + SGROUP MONOID OAMON OAMONS OASGP OCAMON OAGROUP \ + RNG RING ORDRING LMODULE RMODULE BMODULE \ + COMRING ENTIRER ALGEBRA MODULE DIVRING FIELD \ + DIFFSPC DIFFDOM DIFRING LINEXP PATMAB CFCAT REAL \ + INTDOM GCDDOM PID UFD OINTDOM INS OM \ + CHARZ CHARNZ STEP IEVALAB EVALAB \ + AGG HOAGG CLAGG ELTAB ELTAGG IXAGG LNAGG \ + FLAGG ELAGG RCAGG URAGG STAGG LSAGG A1AGG \ + BGAGG DIOPS DIAGG SETAGG FSAGG VECTCAT \ + FEVALAB PDDOM PDSPC DSEXT PDRING DIFEXT \ + RADCAT AMR FAMR FLINEXP POLYCAT UPOLYC PATAB FPATMAB PFECAT \ + RNS FPS \ + BOOLEAN INT NNI PI LIST VECTOR CHAR STRING + +oa_strap_1_sources = $(oa_strap_0_sources) \ + KVTFROM SEXCAT QFCAT \ + SRAGG AHYP HYPCAT ATRIG TRIGCAT TRANFUN \ + ILIST ISTRING DFLOAT SINT + + +oa_strap_2_sources = $(oa_strap_1_sources) \ + PRIMARR IARRAY1 IVECTOR SYMBOL + + +strap-0/BASTYPE.$(FASLEXT): strap-0/TYPE.$(FASLEXT) +strap-0/RETRACT.$(FASLEXT): strap-0/KRCFROM.$(FASLEXT) +strap-0/FRETRCT.$(FASLEXT): strap-0/RETRACT.$(FASLEXT) +strap-0/SECAT.$(FASLEXT): strap-0/BASTYPE.$(FASLEXT) strap-0/KOERCE.$(FASLEXT) +strap-0/ORDFIN.$(FASLEXT): strap-0/FINITE.$(FASLEXT) \ + strap-0/ORDSET.$(FASLEXT) strap-0/ORDTYPE.$(FASLEXT) +strap-0/PROPLOG.$(FASLEXT): strap-0/SETCAT.$(FASLEXT) strap-0/BOOLE.$(FASLEXT) +strap-0/BOOLE.$(FASLEXT): strap-0/LOGIC.$(FASLEXT) +strap-0/BOOLEAN.$(FASLEXT): strap-0/ORDFIN.$(FASLEXT) \ + strap-0/PROPLOG.$(FASLEXT) strap-0/KONVERT.$(FASLEXT) + +strap-0/LLINSET.$(FASLEXT): strap-0/SETCAT.$(FASLEXT) +strap-0/RLINSET.$(FASLEXT): strap-0/SETCAT.$(FASLEXT) +strap-0/LINSET.$(FASLEXT): strap-0/LLINSET.$(FASLEXT) \ + strap-0/RLINSET.$(FASLEXT) +strap-0/ABELSG.$(FASLEXT): strap-0/SETCAT.$(FASLEXT) +strap-0/ABELMON.$(FASLEXT): strap-0/ABELSG.$(FASLEXT) +strap-0/CABMON.$(FASLEXT): strap-0/ABELMON.$(FASLEXT) +strap-0/SGROUP.$(FASLEXT): strap-0/SETCAT.$(FASLEXT) +strap-0/MONOID.$(FASLEXT): strap-0/SGROUP.$(FASLEXT) +strap-0/ABELGRP.$(FASLEXT): strap-0/CABMON.$(FASLEXT) \ + strap-0/LLINSET.$(FASLEXT) +strap-0/RNG.$(FASLEXT): strap-0/ABELGRP.$(FASLEXT) +strap-0/RING.$(FASLEXT): strap-0/RNG.$(FASLEXT) strap-0/MONOID.$(FASLEXT) \ + strap-0/LMODULE.$(FASLEXT) strap-0/KRCFROM.$(FASLEXT) +strap-0/COMRING.$(FASLEXT): strap-0/RING.$(FASLEXT) +strap-0/GCDDOM.$(FASLEXT): strap-0/INTDOM.$(FASLEXT) +strap-0/MODULE.$(FASLEXT): strap-0/COMRING.$(FASLEXT) \ + strap-0/BMODULE.$(FASLEXT) strap-0/LINSET.$(FASLEXT) +strap-0/ALGEBRA.$(FASLEXT): strap-0/COMRING.$(FASLEXT) \ + strap-0/RING.$(FASLEXT) strap-0/MODULE.$(FASLEXT) \ + strap-0/KRCFROM.$(FASLEXT) + +strap-0/UFD.$(FASLEXT): strap-0/GCDDOM.$(FASLEXT) + +strap-0/DIFFSPC.$(FASLEXT): strap-0/DIFFDOM.$(FASLEXT) +strap-0/PATMAB.$(FASLEXT): strap-0/SETCAT.$(FASLEXT) +strap-0/OAMON.$(FASLEXT): strap-0/OASGP.$(FASLEXT) +strap-0/OAMONS.$(FASLEXT): strap-0/OAMON.$(FASLEXT) strap-0/OCAMON.$(FASLEXT) +strap-0/OCAMON.$(FASLEXT): strap-0/OAMON.$(FASLEXT) +strap-0/OAGROUP.$(FASLEXT): strap-0/OCAMON.$(FASLEXT) \ + strap-0/ABELGRP.$(FASLEXT) +strap-0/ORDRING.$(FASLEXT): strap-0/OAGROUP.$(FASLEXT) \ + strap-0/RING.$(FASLEXT) strap-0/MONOID.$(FASLEXT) +strap-0/OINTDOM.$(FASLEXT): strap-0/ORDRING.$(FASLEXT) + +strap-0/PID.$(FASLEXT): strap-0/GCDDOM.$(FASLEXT) + +strap-0/EUCDOM.$(FASLEXT): strap-0/PID.$(FASLEXT) +strap-0/FIELD.$(FASLEXT): strap-0/EUCDOM.$(FASLEXT) strap-0/UFD.$(FASLEXT) +strap-0/AMR.$(FASLEXT): strap-0/RING.$(FASLEXT) strap-0/OAMON.$(FASLEXT) \ + strap-0/BMODULE.$(FASLEXT) strap-0/CHARNZ.$(FASLEXT) +strap-0/FAMR.$(FASLEXT): strap-0/RING.$(FASLEXT) strap-0/OAMON.$(FASLEXT) \ + strap-0/AMR.$(FASLEXT) +strap-0/POLYCAT.$(FASLEXT): strap-0/PDRING.$(FASLEXT) strap-0/FAMR.$(FASLEXT) \ + strap-0/FLINEXP.$(FASLEXT) strap-0/PFECAT.$(FASLEXT) +strap-0/UPOLYC.$(FASLEXT): strap-0/POLYCAT.$(FASLEXT) + +strap-0/INS.$(FASLEXT): strap-0/UFD.$(FASLEXT) strap-0/EUCDOM.$(FASLEXT) \ + strap-0/OINTDOM.$(FASLEXT) strap-0/DIFRING.$(FASLEXT) \ + strap-0/LINEXP.$(FASLEXT) strap-0/PATMAB.$(FASLEXT) \ + strap-0/CFCAT.$(FASLEXT) strap-0/REAL.$(FASLEXT) \ + strap-0/CHARZ.$(FASLEXT) strap-0/STEP.$(FASLEXT) + +strap-0/INT.$(FASLEXT): strap-0/INS.$(FASLEXT) \ + strap-0/KONVERT.$(FASLEXT) strap-0/OM.$(FASLEXT) + +strap-0/NNI.$(Faslext): strap-0/INT.$(FASLEXT) + + +strap-0/AGG.$(FASLEXT): strap-0/TYPE.$(FASLEXT) +strap-0/HOAGG.$(FASLEXT): strap-0/AGG.$(FASLEXT) +strap-0/CLAGG.$(FASLEXT): strap-0/HOAGG.$(FASLEXT) +strap-0/IXAGG.$(FASLEXT): strap-0/SETCAT.$(FASLEXT) strap-0/ELTAGG.$(FASLEXT) +strap-0/FLAGG.$(FASLEXT): strap-0/LNAGG.$(FASLEXT) +strap-0/A1AGG.$(FASLEXT): strap-0/FLAGG.$(FASLEXT) +strap-0/SRAGG.$(FASLEXT): strap-0/A1AGG.$(FASLEXT) + +strap-0/STRING.$(FASLEXT): strap-0/SRAGG.$(FASLEXT) + +## Bootstrap stage 1 dependencies. +strap-1/PID.$(FASLEXT): strap-1/GCDDOM.$(FASLEXT) +strap-1/EUCDOM.$(FASLEXT): strap-1/PID.$(FASLEXT) + +strap-1/PDSPC.$(FASLEXT): strap-1/PDDOM.$(FASLEXT) + +strap-1/DSEXT.$(FASLEXT): strap-1/PDSPC.$(FASLEXT) + +strap-1/DIFEXT.$(FASLEXT): strap-1/RING.$(FASLEXT) strap-1/DSEXT.$(FASLEXT) \ + strap-1/PDRING.$(FASLEXT) + +strap-1/FLINEXP.$(FASLEXT): strap-1/LINEXP.$(FASLEXT) +strap-1/PATAB.$(FASLEXT): strap-1/KONVERT.$(FASLEXT) +strap-1/FPATMAB.$(FASLEXT): strap-1/PATAB.$(FASLEXT) +strap-1/CHARNZ.$(FASLEXT): strap-1/RING.$(FASLEXT) +strap-1/FPS.$(FASLEXT): strap-0/FIELD.$(FASLEXT) strap-1/ORDRING.$(FASLEXT) \ + strap-1/REAL.$(FASLEXT) strap-1/RETRACT.$(FASLEXT) \ + strap-1/CHARZ.$(FASLEXT) +strap-1/FPS.$(FASLEXT): strap-1/RNS.$(FASLEXT) +strap-1/HYPCAT.$(FASLEXT): strap-1/ELEMFUN.$(FASLEXT) +strap-1/TRANFUN.$(FASLEXT): strap-1/TRIGCAT.$(FASLEXT) \ + strap-1/ATRIG.$(FASLEXT) strap-1/HYPCAT.$(FASLEXT) \ + strap-1/AHYP.$(FASLEXT) +strap-1/DFLOAT.$(FASLEXT): strap-1/FPS.$(FASLEXT) strap-1/TRANFUN.$(FASLEXT) + +strap-1/SEXCAT.$(FASLEXT): strap-1/KVTFROM.$(FASLEXT) +strap-1/POLYCAT.$(FASLEXT): strap-1/SEXCAT.$(FASLEXT) +strap-1/QFCAT.$(FASLEXT): strap-1/FEVALAB.$(FASLEXT) \ + strap-1/EUCDOM.$(FASLEXT) strap-1/DIFEXT.$(FASLEXT) \ + strap-1/FLINEXP.$(FASLEXT) strap-1/FPATMAB.$(FASLEXT) \ + strap-1/CHARNZ.$(FASLEXT) strap-1/PFECAT.$(FASLEXT) \ + strap-1/DFLOAT.$(FASLEXT) + +strap-1/DIVRING.$(FASLEXT): strap-1/QFCAT.$(FASLEXT) + +strap-1/FIELD.$(FASLEXT): strap-1/EUCDOM.$(FASLEXT) \ + strap-1/EUCDOM.$(FASLEXT) strap-1/DIVRING.$(FASLEXT) + +strap-1/INTDOM.$(FASLEXT): strap-1/FIELD.$(FASLEXT) + +strap-1/A1AGG.$(FASLEXT): strap-1/BOOLE.$(FASLEXT) +strap-1/DIOPS.$(FASLEXT): strap-1/BGAGG.$(FASLEXT) \ + strap-1/CLAGG.$(FASLEXT) strap-1/CHAR.$(FASLEXT) +strap-1/DIAGG.$(FASLEXT): strap-1/DIOPS.$(FASLEXT) +strap-1/FSAGG.$(FASLEXT): strap-1/DIAGG.$(FASLEXT) +strap-1/CHAR.$(FASLEXT): strap-1/FSAGG.$(FASLEXT) +strap-1/STRING.$(FASLEXT): strap-1/SRAGG.$(FASLEXT) strap-1/CHAR.$(FASLEXT) \ + strap-1/ISTRING.$(FASLEXT) +strap-1/INT.$(FASLEXT): strap-1/STRING.$(FASLEXT) +strap-1/SINT.$(FASLEXT): strap-1/INT.$(FASLEXT) strap-1/ORDFIN.$(FASLEXT) \ + strap-1/BOOLE.$(FASLEXT) +strap-1/LIST.$(FASLEXT): strap-1/ILIST.$(FASLEXT) strap-1/STRING.$(FASLEXT) +strap-1/VECTOR.$(FASLEXT): strap-1/LIST.$(FASLEXT) + + +## Bootstrap stage 2 dependencies. +strap-2/PID.$(FASLEXT): strap-2/GCDDOM.$(FASLEXT) +strap-2/EUCDOM.$(FASLEXT): strap-2/PID.$(FASLEXT) + +strap-2/PDSPC.$(FASLEXT): strap-2/PDDOM.$(FASLEXT) + +strap-2/DSEXT.$(FASLEXT): strap-2/PDSPC.$(FASLEXT) + +strap-2/DIFEXT.$(FASLEXT): strap-2/RING.$(FASLEXT) strap-2/DSEXT.$(FASLEXT) \ + strap-2/PDRING.$(FASLEXT) + +strap-2/FLINEXP.$(FASLEXT): strap-2/LINEXP.$(FASLEXT) +strap-2/PATAB.$(FASLEXT): strap-2/KONVERT.$(FASLEXT) +strap-2/FPATMAB.$(FASLEXT): strap-2/PATAB.$(FASLEXT) +strap-2/CHARNZ.$(FASLEXT): strap-2/RING.$(FASLEXT) +strap-2/FPS.$(FASLEXT): strap-1/FIELD.$(FASLEXT) strap-2/ORDRING.$(FASLEXT) \ + strap-2/REAL.$(FASLEXT) strap-2/RETRACT.$(FASLEXT) \ + strap-2/CHARZ.$(FASLEXT) +strap-2/FPS.$(FASLEXT): strap-2/RNS.$(FASLEXT) +strap-2/HYPCAT.$(FASLEXT): strap-2/ELEMFUN.$(FASLEXT) +strap-2/TRANFUN.$(FASLEXT): strap-2/TRIGCAT.$(FASLEXT) \ + strap-2/ATRIG.$(FASLEXT) strap-2/HYPCAT.$(FASLEXT) \ + strap-2/AHYP.$(FASLEXT) +strap-2/DFLOAT.$(FASLEXT): strap-2/FPS.$(FASLEXT) strap-2/TRANFUN.$(FASLEXT) + +strap-2/PRIMARR.$(FASLEXT): strap-2/A1AGG.$(FASLEXT) +strap-2/IARRAY1.$(FASLEXT): strap-2/PRIMARR.$(FASLEXT) +strap-2/IVECTOR.$(FASLEXT): strap-2/IARRAY1.$(FASLEXT) +strap-2/PFECAT.$(FASLEXT): strap-2/IVECTOR.$(FASLEXT) +strap-2/SEXCAT.$(FASLEXT): strap-2/KVTFROM.$(FASLEXT) +strap-2/POLYCAT.$(FASLEXT): strap-2/SEXCAT.$(FASLEXT) +strap-2/QFCAT.$(FASLEXT): strap-2/FEVALAB.$(FASLEXT) \ + strap-2/EUCDOM.$(FASLEXT) strap-2/DIFEXT.$(FASLEXT) \ + strap-2/FLINEXP.$(FASLEXT) strap-2/FPATMAB.$(FASLEXT) \ + strap-2/CHARNZ.$(FASLEXT) strap-2/PFECAT.$(FASLEXT) \ + strap-2/DFLOAT.$(FASLEXT) + +strap-2/DIVRING.$(FASLEXT): strap-2/QFCAT.$(FASLEXT) + +strap-2/FIELD.$(FASLEXT): strap-2/EUCDOM.$(FASLEXT) \ + strap-2/EUCDOM.$(FASLEXT) strap-2/DIVRING.$(FASLEXT) + +strap-2/INTDOM.$(FASLEXT): strap-2/FIELD.$(FASLEXT) + +strap-2/A1AGG.$(FASLEXT): strap-2/BOOLE.$(FASLEXT) +strap-2/DIOPS.$(FASLEXT): strap-2/BGAGG.$(FASLEXT) \ + strap-2/CLAGG.$(FASLEXT) strap-2/CHAR.$(FASLEXT) +strap-2/DIAGG.$(FASLEXT): strap-2/DIOPS.$(FASLEXT) +strap-2/FSAGG.$(FASLEXT): strap-2/DIAGG.$(FASLEXT) +strap-2/CHAR.$(FASLEXT): strap-2/FSAGG.$(FASLEXT) +strap-2/STRING.$(FASLEXT): strap-2/SRAGG.$(FASLEXT) strap-2/CHAR.$(FASLEXT) \ + strap-2/ISTRING.$(FASLEXT) +strap-2/INT.$(FASLEXT): strap-2/STRING.$(FASLEXT) +strap-2/SINT.$(FASLEXT): strap-2/INT.$(FASLEXT) strap-2/ORDFIN.$(FASLEXT) \ + strap-2/BOOLE.$(FASLEXT) +strap-2/LIST.$(FASLEXT): strap-2/ILIST.$(FASLEXT) strap-2/STRING.$(FASLEXT) +strap-2/VECTOR.$(FASLEXT): strap-2/LIST.$(FASLEXT) +strap-2/SYMBOL.$(FASLEXT): strap-2/ORDSET.$(FASLEXT) \ + strap-2/KONVERT.$(FASLEXT) strap-2/OM.$(FASLEXT) \ + strap-2/PATAB.$(FASLEXT) + + +strap-0/.started: + $(mkdir_p) strap-0 && $(TOUCH) $@ + +strap-0/.finished: $(oa_strap_0_fasls) + rm -f $@ + rm -rf $(addprefix .NRLIB,$(oa_strap_0_sources)) + $(TOUCH) $@ + +strap-1/.started: strap-0/.finished + $(mkdir_p) strap-1 && $(TOUCH) $@ + +strap-1/.finished: $(oa_strap_1_fasls) + rm -f $@ + rm -rf $(addprefix .NRLIB,$(oa_strap_1_sources)) + $(TOUCH) $@ + +strap-2/.started: $(oa_strap_1_fasls) + $(mkdir_p) strap-2 && $(TOUCH) $@ + +strap-2/.finished: $(oa_strap_2_fasls) + rm -f $@ + rm -rf $(addprefix .NRLIB,$(oa_strap_2_sources)) + $(TOUCH) $@ + +strap-0/%.$(FASLEXT): %.spad strap-0/.started + $(BOOTSTRAP) --sysalg=strap-0 --bootstrap $< \ + && cp $*.NRLIB/code.$(FASLEXT) $@ + +strap-1/%.$(FASLEXT): %.spad strap-1/.started + $(BOOTSTRAP) --strap=strap-0 --sysalg=strap-1 --optimize=3 $< && \ + cp $*.NRLIB/code.$(FASLEXT) $@ && \ + if test -d $*-.NRLIB; then cp $*-.NRLIB/code.$(FASLEXT) \ + strap-1/$*-.$(FASLEXT); else : ; fi + +strap-2/%.$(FASLEXT): %.spad strap-2/.started + $(BOOTSTRAP) --strap=strap-1 --sysalg=strap-2 --optimize=3 $< && \ + cp $*.NRLIB/code.$(FASLEXT) $@ && \ + if test -d $*-.NRLIB; then cp $*-.NRLIB/code.$(FASLEXT) \ + strap-2/$*-.$(FASLEXT); else : ; fi SPADFILES= \ @@ -273,37 +548,6 @@ TESTS=${INPUT}/INTHEORY.input ${INPUT}/VIEW2D.input ${INPUT}/TESTFR.input subdir = src/algebra/ -# The list of objects necessary to bootstrap the whole algebra library. -axiom_algebra_layer_strap = \ - $(addprefix strap/,$(axiom_algebra_bootstrap)) - -axiom_algebra_layer_strap_objects = \ - $(addsuffix .$(FASLEXT),$(axiom_algebra_layer_strap)) - - -axiom_algebra_bootstrap = \ - ABELGRP ABELGRP- ABELMON ABELMON- \ - ABELSG ABELSG- ALAGG BOOLEAN \ - CABMON CHAR CLAGG CLAGG- \ - COMRING DFLOAT DIFRING \ - DIVRING DIVRING- ENTIRER \ - EUCDOM EUCDOM- FFIELDC \ - FFIELDC- FPS FPS- GCDDOM \ - GCDDOM- HOAGG HOAGG- ILIST \ - INS INS- INT INTDOM \ - INTDOM- ISTRING LIST LNAGG \ - LNAGG- LSAGG LSAGG- MONOID \ - MONOID- MTSCAT NNI OINTDOM \ - ORDRING ORDRING- OUTFORM PI \ - POLYCAT POLYCAT- \ - QFCAT QFCAT- RCAGG \ - RCAGG- RING RING- \ - RNG RNS RNS- SETAGG \ - SETAGG- SINT \ - STAGG STAGG- SYMBOL \ - UFD UFD- \ - URAGG URAGG- \ - VECTOR axiom_algebra_bootstrap_last_layer = \ DFLOAT \ @@ -321,9 +565,6 @@ axiom_algebra_bootstrap_last_layer = \ VECTOR -axiom_algebra_bootstrap_nrlibs = \ - $(addsuffix .NRLIB/code.$(FASLEXT),$(axiom_algebra_bootstrap)) - axiom_algebra_bootstrap_last_layer_objects = \ $(addprefix $(OUT)/, \ $(addsuffix .$(FASLEXT), $(axiom_algebra_bootstrap_last_layer))) @@ -476,7 +717,7 @@ axiom_algebra_layer_0 = \ LINEXP PATMAB REAL CHARZ LOGIC LOGIC- \ RTVALUE SYSPTR PDDOM PDDOM- PDSPC PDSPC- \ DSEXT DSEXT- ORDTYPE ORDTYPE- ORDSTRCT \ - BOOLE BOOLE- REF ALIST PRIMARR + BOOLE BOOLE- REF ALIST PRIMARR axiom_algebra_layer_0_nrlibs = \ $(addsuffix .NRLIB/code.$(FASLEXT),$(axiom_algebra_layer_0)) @@ -544,7 +785,7 @@ axiom_algebra_layer_1 = \ DIFRING ENTIRER INTDOM INTDOM- OINTDOM \ GCDDOM GCDDOM- UFD UFD- ES ES- \ PATAB PPCURVE PSCURVE CACHSET RESLATC \ - IDENT BINDING BOOLEAN \ + IDENT OUTFORM BINDING BOOLEAN \ ORDRING ORDRING- FEVALAB FEVALAB- IARRAY1 \ OSGROUP MAYBE DATAARY PROPLOG HOMOTOP BYTEORD \ FIELD FIELD- VECTCAT VECTCAT- \ @@ -740,7 +981,7 @@ axiom_algebra_layer_10 = \ PINTERP PLOTTOOL PFR PMDOWN \ PRTITION PMINS PMLSAGG PMTOOLS \ PSCAT PSCAT- QFORM QUEUE \ - SQMATRIX SEG SEG2 \ + SQMATRIX SEG SEG2 MTSCAT \ STACK STTAYLOR TABLBUMP TABLEAU \ TOPSP TRANFUN TRANFUN- TUBE \ UDPO UNISEG VIEW VSPACE \ @@ -748,7 +989,7 @@ axiom_algebra_layer_10 = \ FUNDESC XPBWPOLY SMATCAT SMATCAT- \ RMATRIX RMATCAT RMATCAT- DIRPROD \ DIRPCAT DIRPCAT- IVECTOR MATRIX \ - MATCAT MATCAT- IIARRAY2 + MATCAT MATCAT- IIARRAY2 FFIELDC FFIELDC- axiom_algebra_layer_10_nrlibs = \ @@ -1223,12 +1464,6 @@ ${OUT}/%.$(FASLEXT): %.NRLIB/code.$(FASLEXT) %.NRLIB/code.$(FASLEXT): %.spad $(COMPILE_SPAD) -# Compile bootstrap file to machine object code, and the result -# immediately available for AXIOMsys consumption. -strap/%.$(FASLEXT): $(srcdir)/strap/%.lsp - $(COMPILE_LISP) - - $(OUTSRC)/%.spad: mk-target-src-algabra-dir ${OUTSRC}/%.spad: $(srcdir)/%.spad.pamphlet @@ -1309,7 +1544,7 @@ $(axiom_algebra_layer_23_objects): 22-stamp $(axiom_algebra_bootstrap_last_layer_objects): 23-stamp $(axiom_algebra_layer_user_objects): bootstrap-stamp -strap-stamp: $(axiom_algebra_layer_strap_objects) +strap-stamp: $(oa_strap_2_fasls) @ rm -f strap-stamp @ $(STAMP) strap-stamp @ echo ===================================== @@ -1498,18 +1733,11 @@ user-stamp: $(axiom_algebra_layer_user_objects) -.PHONY: all-algstrap -all-algstrap: $(addsuffix .NRLIB/code.lsp,$(axiom_algebra_bootstrap)) - for a in $(axiom_algebra_bootstrap); do \ - old=$(srcdir)/strap/$$a.lsp; new=$$a.NRLIB/code.lsp; \ - cmp -s $$new $$old || cp -p $$new $$old || exit 1; \ - done - mostlyclean-local: @rm -f $(OUT)/*.$(FASLEXT) $(OUT)/*.daase @rm -rf *.NRLIB @rm -rf *.DAASE *.daase libdb.text - @rm -rf strap + @rm -rf strap* @rm -f *stamp clean-local: mostlyclean-local diff --git a/src/algebra/integer.spad.pamphlet b/src/algebra/integer.spad.pamphlet index 1ca330b1..f660ec96 100644 --- a/src/algebra/integer.spad.pamphlet +++ b/src/algebra/integer.spad.pamphlet @@ -103,6 +103,7 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with import %ige: (%,%) -> Boolean from Foreign Builtin import %ilength: % -> % from Foreign Builtin import %i2s: % -> String from Foreign Builtin + import %strconc: (String,String) -> String from Foreign Builtin x,y: % n: NonNegativeInteger @@ -181,7 +182,7 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with latex(x:%):String == s : String := convert x -1 < x and x < 10 => s - concat("{", concat(s, "}")$String)$String + %strconc("{", %strconc(s, "}")) positiveRemainder(a, b) == negative?(r := a rem b) => diff --git a/src/algebra/strap/ABELGRP-.lsp b/src/algebra/strap/ABELGRP-.lsp deleted file mode 100644 index 66b5ec1f..00000000 --- a/src/algebra/strap/ABELGRP-.lsp +++ /dev/null @@ -1,66 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |ABELGRP-;-;3S;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Pair|) - |ABELGRP-;subtractIfCan;2SU;2|)) - -(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) |%Thing| |%Shell|) - |%Thing|) - |ABELGRP-;*;Nni2S;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Thing| |%Shell|) |%Thing|) - |ABELGRP-;*;I2S;4|)) - -(DEFUN |ABELGRP-;-;3S;1| (|x| |y| $) - (SPADCALL |x| (SPADCALL |y| (|shellEntry| $ 7)) (|shellEntry| $ 8))) - -(DEFUN |ABELGRP-;subtractIfCan;2SU;2| (|x| |y| $) - (CONS 0 (SPADCALL |x| |y| (|shellEntry| $ 10)))) - -(DEFUN |ABELGRP-;*;Nni2S;3| (|n| |x| $) - (SPADCALL |n| |x| (|shellEntry| $ 14))) - -(DEFUN |ABELGRP-;*;I2S;4| (|n| |x| $) - (COND - ((ZEROP |n|) (|spadConstant| $ 19)) - ((PLUSP |n|) (SPADCALL |n| |x| (|shellEntry| $ 24))) - (T (SPADCALL (- |n|) (SPADCALL |x| (|shellEntry| $ 7)) - (|shellEntry| $ 24))))) - -(DEFUN |AbelianGroup&| (|#1|) - (LET* ((|dv$1| (|devaluate| |#1|)) - (|dv$| (LIST '|AbelianGroup&| |dv$1|)) ($ (|newShell| 27)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (COND - ((|HasCategory| |#1| '(|Ring|))) - (T (SETF (|shellEntry| $ 26) - (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| (|Boolean|) - (23 . |zero?|) (28 . |Zero|) (32 . |Zero|) (36 . >) - (|PositiveInteger|) (|RepeatedDoubling| 6) (42 . |double|) - (48 . -) (53 . *)) - '#(|subtractIfCan| 59 - 65 * 71) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 26 - '(1 6 0 0 7 2 6 0 0 0 8 2 6 0 0 0 10 2 - 6 0 13 0 14 1 13 17 0 18 0 6 0 19 0 - 13 0 20 2 13 17 0 0 21 2 23 6 22 6 24 - 1 13 0 0 25 2 0 0 13 0 26 2 0 11 0 0 - 12 2 0 0 0 0 9 2 0 0 13 0 26 2 0 0 15 - 0 16))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/ABELGRP.lsp b/src/algebra/strap/ABELGRP.lsp deleted file mode 100644 index a089f569..00000000 --- a/src/algebra/strap/ABELGRP.lsp +++ /dev/null @@ -1,22 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |AbelianGroup;AL| 'NIL) - -(DEFUN |AbelianGroup;| () - (LET ((#0=#:G1374 - (|sublisV| (PAIR '(#1=#:G1373) '((|Integer|))) - (|Join| (|CancellationAbelianMonoid|) - (|LeftLinearSet| '#1#) - (|mkCategory| '|domain| - '(((- ($ $)) T) ((- ($ $ $)) T)) NIL 'NIL - NIL))))) - (SETF (|shellEntry| #0# 0) '(|AbelianGroup|)) - #0#)) - -(DEFUN |AbelianGroup| () - (COND - (|AbelianGroup;AL|) - (T (SETQ |AbelianGroup;AL| (|AbelianGroup;|))))) - -(MAKEPROP '|AbelianGroup| 'NILADIC T) diff --git a/src/algebra/strap/ABELMON-.lsp b/src/algebra/strap/ABELMON-.lsp deleted file mode 100644 index 762d1b3d..00000000 --- a/src/algebra/strap/ABELMON-.lsp +++ /dev/null @@ -1,59 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |ABELMON-;zero?;SB;1|)) - -(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 1) |%Thing| |%Shell|) - |%Thing|) - |ABELMON-;*;Pi2S;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |ABELMON-;sample;S;3|)) - -(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) |%Thing| |%Shell|) - |%Thing|) - |ABELMON-;*;Nni2S;4|)) - -(DEFUN |ABELMON-;zero?;SB;1| (|x| $) - (SPADCALL |x| (|spadConstant| $ 7) (|shellEntry| $ 9))) - -(DEFUN |ABELMON-;*;Pi2S;2| (|n| |x| $) - (SPADCALL |n| |x| (|shellEntry| $ 12))) - -(DEFUN |ABELMON-;sample;S;3| ($) (|spadConstant| $ 7)) - -(DEFUN |ABELMON-;*;Nni2S;4| (|n| |x| $) - (COND - ((ZEROP |n|) (|spadConstant| $ 7)) - (T (SPADCALL |n| |x| (|shellEntry| $ 18))))) - -(DEFUN |AbelianMonoid&| (|#1|) - (LET* ((|dv$1| (|devaluate| |#1|)) - (|dv$| (LIST '|AbelianMonoid&| |dv$1|)) ($ (|newShell| 20)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (COND - ((|HasCategory| |#1| '(|Ring|))) - (T (SETF (|shellEntry| $ 19) - (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| (16 . |zero?|) - (|RepeatedDoubling| 6) (21 . |double|) (27 . *)) - '#(|zero?| 33 |sample| 38 * 42) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 19 - '(0 6 0 7 2 6 8 0 0 9 2 6 0 11 0 12 1 - 11 8 0 16 2 17 6 13 6 18 2 0 0 11 0 - 19 1 0 8 0 10 0 0 0 15 2 0 0 11 0 19 - 2 0 0 13 0 14))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/ABELMON.lsp b/src/algebra/strap/ABELMON.lsp deleted file mode 100644 index 6d804db3..00000000 --- a/src/algebra/strap/ABELMON.lsp +++ /dev/null @@ -1,23 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |AbelianMonoid;AL| 'NIL) - -(DEFUN |AbelianMonoid;| () - (LET ((#0=#:G1373 - (|Join| (|AbelianSemiGroup|) - (|mkCategory| '|domain| - '(((|Zero| ($) |constant|) T) - ((|sample| ($) |constant|) T) - ((|zero?| ((|Boolean|) $)) T) - ((* ($ (|NonNegativeInteger|) $)) T)) - NIL '((|NonNegativeInteger|) (|Boolean|)) NIL)))) - (SETF (|shellEntry| #0# 0) '(|AbelianMonoid|)) - #0#)) - -(DEFUN |AbelianMonoid| () - (COND - (|AbelianMonoid;AL|) - (T (SETQ |AbelianMonoid;AL| (|AbelianMonoid;|))))) - -(MAKEPROP '|AbelianMonoid| 'NILADIC T) diff --git a/src/algebra/strap/ABELSG-.lsp b/src/algebra/strap/ABELSG-.lsp deleted file mode 100644 index c901d63f..00000000 --- a/src/algebra/strap/ABELSG-.lsp +++ /dev/null @@ -1,35 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 1) |%Thing| |%Shell|) - |%Thing|) - |ABELSG-;*;Pi2S;1|)) - -(DEFUN |ABELSG-;*;Pi2S;1| (|n| |x| $) - (SPADCALL |n| |x| (|shellEntry| $ 9))) - -(DEFUN |AbelianSemiGroup&| (|#1|) - (LET* ((|dv$1| (|devaluate| |#1|)) - (|dv$| (LIST '|AbelianSemiGroup&| |dv$1|)) ($ (|newShell| 11)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (COND - ((|HasCategory| |#1| '(|Ring|))) - (T (SETF (|shellEntry| $ 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 deleted file mode 100644 index 5a89a18f..00000000 --- a/src/algebra/strap/ABELSG.lsp +++ /dev/null @@ -1,21 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |AbelianSemiGroup;AL| 'NIL) - -(DEFUN |AbelianSemiGroup;| () - (LET ((#0=#:G1372 - (|Join| (|SetCategory|) - (|mkCategory| '|domain| - '(((+ ($ $ $)) T) - ((* ($ (|PositiveInteger|) $)) T)) - NIL '((|PositiveInteger|)) NIL)))) - (SETF (|shellEntry| #0# 0) '(|AbelianSemiGroup|)) - #0#)) - -(DEFUN |AbelianSemiGroup| () - (COND - (|AbelianSemiGroup;AL|) - (T (SETQ |AbelianSemiGroup;AL| (|AbelianSemiGroup;|))))) - -(MAKEPROP '|AbelianSemiGroup| 'NILADIC T) diff --git a/src/algebra/strap/ALAGG.lsp b/src/algebra/strap/ALAGG.lsp deleted file mode 100644 index 738a2062..00000000 --- a/src/algebra/strap/ALAGG.lsp +++ /dev/null @@ -1,49 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |AssociationListAggregate;CAT| 'NIL) - -(DEFPARAMETER |AssociationListAggregate;AL| 'NIL) - -(DEFUN |AssociationListAggregate;| (|t#1| |t#2|) - (LET ((#0=#:G1374 - (|sublisV| - (PAIR '(|t#1| |t#2|) - (LIST (|devaluate| |t#1|) (|devaluate| |t#2|))) - (|sublisV| - (PAIR '(#1=#:G1373) - '((|Record| (|:| |key| |t#1|) - (|:| |entry| |t#2|)))) - (COND - (|AssociationListAggregate;CAT|) - (T (SETQ |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))))))))) - (SETF (|shellEntry| #0# 0) - (LIST '|AssociationListAggregate| (|devaluate| |t#1|) - (|devaluate| |t#2|))) - #0#)) - -(DEFUN |AssociationListAggregate| (&REST #0=#:G1377 &AUX #1=#:G1375) - (DSETQ #1# #0#) - (LET ((#2=#:G1376 - (|assoc| (|devaluateList| #1#) - |AssociationListAggregate;AL|))) - (COND - (#2# (CDR #2#)) - (T (PROGN - (SETQ #2# (APPLY #'|AssociationListAggregate;| #1#)) - (SETQ |AssociationListAggregate;AL| - (|cons5| (CONS (|devaluateList| #1#) #2#) - |AssociationListAggregate;AL|)) - #2#))))) diff --git a/src/algebra/strap/BOOLEAN.lsp b/src/algebra/strap/BOOLEAN.lsp deleted file mode 100644 index f8e98842..00000000 --- a/src/algebra/strap/BOOLEAN.lsp +++ /dev/null @@ -1,242 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Shell|) |%Boolean|) - |BOOLEAN;test;2$;1|)) - -(PUT '|BOOLEAN;test;2$;1| '|SPADreplace| '(XLAM (|a|) |a|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Boolean|) |BOOLEAN;true;$;2|)) - -(PUT '|BOOLEAN;true;$;2| '|SPADreplace| '(XLAM NIL |%true|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Boolean|) |BOOLEAN;false;$;3|)) - -(PUT '|BOOLEAN;false;$;3| '|SPADreplace| '(XLAM NIL |%false|)) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Shell|) |%Boolean|) - |BOOLEAN;not;2$;4|)) - -(PUT '|BOOLEAN;not;2$;4| '|SPADreplace| '|%not|) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Shell|) |%Boolean|) - |BOOLEAN;~;2$;5|)) - -(PUT '|BOOLEAN;~;2$;5| '|SPADreplace| '|%not|) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) - |BOOLEAN;and;3$;6|)) - -(PUT '|BOOLEAN;and;3$;6| '|SPADreplace| '|%and|) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) - |BOOLEAN;/\\;3$;7|)) - -(PUT '|BOOLEAN;/\\;3$;7| '|SPADreplace| '|%and|) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) - |BOOLEAN;or;3$;8|)) - -(PUT '|BOOLEAN;or;3$;8| '|SPADreplace| '|%or|) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) - |BOOLEAN;\\/;3$;9|)) - -(PUT '|BOOLEAN;\\/;3$;9| '|SPADreplace| '|%or|) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) - |BOOLEAN;xor;3$;10|)) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) - |BOOLEAN;nor;3$;11|)) - -(PUT '|BOOLEAN;nor;3$;11| '|SPADreplace| - '(XLAM (|a| |b|) (|%and| (|%not| |a|) (|%not| |b|)))) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) - |BOOLEAN;nand;3$;12|)) - -(PUT '|BOOLEAN;nand;3$;12| '|SPADreplace| - '(XLAM (|a| |b|) (|%or| (|%not| |a|) (|%not| |b|)))) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) - |BOOLEAN;=;3$;13|)) - -(PUT '|BOOLEAN;=;3$;13| '|SPADreplace| '|%peq|) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) - |BOOLEAN;implies;3$;14|)) - -(PUT '|BOOLEAN;implies;3$;14| '|SPADreplace| - '(XLAM (|a| |b|) (|%or| (|%not| |a|) |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) - |BOOLEAN;equiv;3$;15|)) - -(PUT '|BOOLEAN;equiv;3$;15| '|SPADreplace| '|%peq|) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|) - |BOOLEAN;<;3$;16|)) - -(PUT '|BOOLEAN;<;3$;16| '|SPADreplace| - '(XLAM (|a| |b|) (|%and| |b| (|%not| |a|)))) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 0)) - |BOOLEAN;size;Nni;17|)) - -(PUT '|BOOLEAN;size;Nni;17| '|SPADreplace| '(XLAM NIL 2)) - -(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 1) |%Shell|) |%Boolean|) - |BOOLEAN;index;Pi$;18|)) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Shell|) (|%IntegerSection| 1)) - |BOOLEAN;lookup;$Pi;19|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Boolean|) |BOOLEAN;random;$;20|)) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Shell|) |%Thing|) - |BOOLEAN;convert;$If;21|)) - -(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Shell|) |%Thing|) - |BOOLEAN;coerce;$Of;22|)) - -(DEFUN |BOOLEAN;test;2$;1| (|a| $) (DECLARE (IGNORE $)) |a|) - -(DEFUN |BOOLEAN;true;$;2| ($) (DECLARE (IGNORE $)) T) - -(DEFUN |BOOLEAN;false;$;3| ($) (DECLARE (IGNORE $)) NIL) - -(DEFUN |BOOLEAN;not;2$;4| (|b| $) (DECLARE (IGNORE $)) (NOT |b|)) - -(DEFUN |BOOLEAN;~;2$;5| (|b| $) (DECLARE (IGNORE $)) (NOT |b|)) - -(DEFUN |BOOLEAN;and;3$;6| (|a| |b| $) - (DECLARE (IGNORE $)) - (AND |a| |b|)) - -(DEFUN |BOOLEAN;/\\;3$;7| (|a| |b| $) - (DECLARE (IGNORE $)) - (AND |a| |b|)) - -(DEFUN |BOOLEAN;or;3$;8| (|a| |b| $) - (DECLARE (IGNORE $)) - (OR |a| |b|)) - -(DEFUN |BOOLEAN;\\/;3$;9| (|a| |b| $) - (DECLARE (IGNORE $)) - (OR |a| |b|)) - -(DEFUN |BOOLEAN;xor;3$;10| (|a| |b| $) (COND (|a| (NOT |b|)) (T |b|))) - -(DEFUN |BOOLEAN;nor;3$;11| (|a| |b| $) - (DECLARE (IGNORE $)) - (AND (NOT |a|) (NOT |b|))) - -(DEFUN |BOOLEAN;nand;3$;12| (|a| |b| $) - (DECLARE (IGNORE $)) - (OR (NOT |a|) (NOT |b|))) - -(DEFUN |BOOLEAN;=;3$;13| (|a| |b| $) - (DECLARE (IGNORE $)) - (EQ |a| |b|)) - -(DEFUN |BOOLEAN;implies;3$;14| (|a| |b| $) - (DECLARE (IGNORE $)) - (OR (NOT |a|) |b|)) - -(DEFUN |BOOLEAN;equiv;3$;15| (|a| |b| $) - (DECLARE (IGNORE $)) - (EQ |a| |b|)) - -(DEFUN |BOOLEAN;<;3$;16| (|a| |b| $) - (DECLARE (IGNORE $)) - (AND |b| (NOT |a|))) - -(DEFUN |BOOLEAN;size;Nni;17| ($) (DECLARE (IGNORE $)) 2) - -(DEFUN |BOOLEAN;index;Pi$;18| (|i| $) - (NOT (SPADCALL |i| (|shellEntry| $ 26)))) - -(DEFUN |BOOLEAN;lookup;$Pi;19| (|a| $) (COND (|a| 1) (T 2))) - -(DEFUN |BOOLEAN;random;$;20| ($) - (NOT (SPADCALL (|random|) (|shellEntry| $ 26)))) - -(DEFUN |BOOLEAN;convert;$If;21| (|x| $) - (COND (|x| '|true|) (T '|false|))) - -(DEFUN |BOOLEAN;coerce;$Of;22| (|x| $) - (COND (|x| '|true|) (T '|false|))) - -(DEFUN |Boolean| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((#0=#:G1399 (HGET |$ConstructorCache| '|Boolean|))) - (COND - (#0# (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Boolean| - (LIST (CONS NIL (CONS 1 (|Boolean;|)))))) - (SETQ #0# T)) - (COND ((NOT #0#) (HREM |$ConstructorCache| '|Boolean|)))))))) - -(DEFUN |Boolean;| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((|dv$| '(|Boolean|)) ($ (|newShell| 39)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|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;$;2|) $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |BOOLEAN;false;$;3|) $)) - |BOOLEAN;not;2$;4| |BOOLEAN;~;2$;5| |BOOLEAN;and;3$;6| - |BOOLEAN;/\\;3$;7| |BOOLEAN;or;3$;8| |BOOLEAN;\\/;3$;9| - |BOOLEAN;xor;3$;10| |BOOLEAN;nor;3$;11| - |BOOLEAN;nand;3$;12| (|Boolean|) |BOOLEAN;=;3$;13| - |BOOLEAN;implies;3$;14| |BOOLEAN;equiv;3$;15| - |BOOLEAN;<;3$;16| (|NonNegativeInteger|) - |BOOLEAN;size;Nni;17| (|Integer|) (0 . |even?|) - (|PositiveInteger|) |BOOLEAN;index;Pi$;18| (5 . |One|) - |BOOLEAN;lookup;$Pi;19| (9 . |random|) - |BOOLEAN;random;$;20| (|InputForm|) - |BOOLEAN;convert;$If;21| (|OutputForm|) - |BOOLEAN;coerce;$Of;22| (|String|) (|SingleInteger|)) - '#(~= 13 ~ 19 |xor| 24 |true| 30 |test| 34 |size| 39 |random| - 43 |or| 47 |not| 53 |nor| 58 |nand| 64 |min| 70 |max| 80 - |lookup| 90 |latex| 95 |index| 100 |implies| 105 |hash| - 111 |false| 116 |equiv| 120 |convert| 126 |coerce| 131 - |before?| 136 |and| 142 |\\/| 148 >= 154 > 160 = 166 <= - 172 < 178 |/\\| 184) - 'NIL - (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0 0 0 0 0 0 0)) - (CONS '#(NIL NIL NIL NIL |BooleanLogic&| |SetCategory&| - |OrderedType&| |Logic&| |BasicType&| NIL NIL - NIL) - (CONS '#((|OrderedFinite|) (|OrderedSet|) - (|PropositionalLogic|) (|Finite|) - (|BooleanLogic|) (|SetCategory|) - (|OrderedType|) (|Logic|) (|BasicType|) - (|ConvertibleTo| 33) (|Type|) - (|CoercibleTo| 35)) - (|makeByteWordVec2| 38 - '(1 25 18 0 26 0 27 0 29 0 25 0 31 2 0 - 18 0 0 1 1 0 0 0 10 2 0 0 0 0 15 0 0 - 0 7 1 0 0 0 6 0 0 23 24 0 0 0 32 2 0 - 0 0 0 13 1 0 0 0 9 2 0 0 0 0 16 2 0 0 - 0 0 17 0 0 0 1 2 0 0 0 0 1 0 0 0 1 2 - 0 0 0 0 1 1 0 27 0 30 1 0 37 0 1 1 0 - 0 27 28 2 0 0 0 0 20 1 0 38 0 1 0 0 0 - 8 2 0 0 0 0 21 1 0 33 0 34 1 0 35 0 - 36 2 0 18 0 0 1 2 0 0 0 0 11 2 0 0 0 - 0 14 2 0 18 0 0 1 2 0 18 0 0 1 2 0 18 - 0 0 19 2 0 18 0 0 1 2 0 18 0 0 22 2 0 - 0 0 0 12))))) - '|lookupComplete|)) - -(MAKEPROP '|Boolean| 'NILADIC T) diff --git a/src/algebra/strap/CABMON.lsp b/src/algebra/strap/CABMON.lsp deleted file mode 100644 index d1719927..00000000 --- a/src/algebra/strap/CABMON.lsp +++ /dev/null @@ -1,22 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |CancellationAbelianMonoid;AL| 'NIL) - -(DEFUN |CancellationAbelianMonoid;| () - (LET ((#0=#:G1372 - (|Join| (|AbelianMonoid|) - (|mkCategory| '|domain| - '(((|subtractIfCan| ((|Union| $ "failed") $ $)) - T)) - NIL 'NIL NIL)))) - (SETF (|shellEntry| #0# 0) '(|CancellationAbelianMonoid|)) - #0#)) - -(DEFUN |CancellationAbelianMonoid| () - (COND - (|CancellationAbelianMonoid;AL|) - (T (SETQ |CancellationAbelianMonoid;AL| - (|CancellationAbelianMonoid;|))))) - -(MAKEPROP '|CancellationAbelianMonoid| 'NILADIC T) diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp deleted file mode 100644 index 34d8594d..00000000 --- a/src/algebra/strap/CHAR.lsp +++ /dev/null @@ -1,357 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Char| |%Shell|) |%Boolean|) - |CHAR;=;2$B;1|)) - -(PUT '|CHAR;=;2$B;1| '|SPADreplace| '|%ceq|) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Char| |%Shell|) |%Boolean|) - |CHAR;<;2$B;2|)) - -(PUT '|CHAR;<;2$B;2| '|SPADreplace| '|%clt|) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Char| |%Shell|) |%Boolean|) - |CHAR;>;2$B;3|)) - -(PUT '|CHAR;>;2$B;3| '|SPADreplace| '|%cgt|) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Char| |%Shell|) |%Boolean|) - |CHAR;<=;2$B;4|)) - -(PUT '|CHAR;<=;2$B;4| '|SPADreplace| '|%cle|) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Char| |%Shell|) |%Boolean|) - |CHAR;>=;2$B;5|)) - -(PUT '|CHAR;>=;2$B;5| '|SPADreplace| '|%cge|) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 0)) - |CHAR;size;Nni;6|)) - -(PUT '|CHAR;size;Nni;6| '|SPADreplace| '(XLAM NIL 256)) - -(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 1) |%Shell|) |%Char|) - |CHAR;index;Pi$;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) (|%IntegerSection| 1)) - |CHAR;lookup;$Pi;8|)) - -(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) |%Shell|) |%Char|) - |CHAR;char;Nni$;9|)) - -(PUT '|CHAR;char;Nni$;9| '|SPADreplace| '|%i2c|) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) (|%IntegerSection| 0)) - |CHAR;ord;$Nni;10|)) - -(PUT '|CHAR;ord;$Nni;10| '|SPADreplace| '|%c2i|) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;random;$;11|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;space;$;12|)) - -(PUT '|CHAR;space;$;12| '|SPADreplace| '(XLAM NIL (|%ccst| " "))) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;quote;$;13|)) - -(PUT '|CHAR;quote;$;13| '|SPADreplace| '(XLAM NIL (|%ccst| "\""))) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;underscore;$;14|)) - -(PUT '|CHAR;underscore;$;14| '|SPADreplace| '(XLAM NIL (|%ccst| "_"))) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;newline;$;15|)) - -(PUT '|CHAR;newline;$;15| '|SPADreplace| '(XLAM NIL (|%ccst| "\\n"))) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) - |CHAR;carriageReturn;$;16|)) - -(PUT '|CHAR;carriageReturn;$;16| '|SPADreplace| - '(XLAM NIL (|%i2c| 13))) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;linefeed;$;17|)) - -(PUT '|CHAR;linefeed;$;17| '|SPADreplace| '(XLAM NIL (|%i2c| 10))) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;formfeed;$;18|)) - -(PUT '|CHAR;formfeed;$;18| '|SPADreplace| '(XLAM NIL (|%i2c| 12))) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;backspace;$;19|)) - -(PUT '|CHAR;backspace;$;19| '|SPADreplace| '(XLAM NIL (|%i2c| 8))) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) - |CHAR;horizontalTab;$;20|)) - -(PUT '|CHAR;horizontalTab;$;20| '|SPADreplace| '(XLAM NIL (|%i2c| 9))) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;verticalTab;$;21|)) - -(PUT '|CHAR;verticalTab;$;21| '|SPADreplace| '(XLAM NIL (|%i2c| 11))) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;escape;$;22|)) - -(PUT '|CHAR;escape;$;22| '|SPADreplace| '(XLAM NIL (|%i2c| 27))) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Thing|) - |CHAR;coerce;$Of;23|)) - -(PUT '|CHAR;coerce;$Of;23| '|SPADreplace| '(XLAM (|c|) |c|)) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|) - |CHAR;digit?;$B;24|)) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|) - |CHAR;hexDigit?;$B;25|)) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|) - |CHAR;upperCase?;$B;26|)) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|) - |CHAR;lowerCase?;$B;27|)) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|) - |CHAR;alphabetic?;$B;28|)) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|) - |CHAR;alphanumeric?;$B;29|)) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%String|) - |CHAR;latex;$S;30|)) - -(PUT '|CHAR;latex;$S;30| '|SPADreplace| - '(XLAM (|c|) - (|%strconc| "\\mbox{`" (|%strconc| (|%c2s| |c|) "'}")))) - -(DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%Char|) - |CHAR;char;S$;31|)) - -(PUT '|CHAR;char;S$;31| '|SPADreplace| '|%s2c|) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Char|) - |CHAR;upperCase;2$;32|)) - -(PUT '|CHAR;upperCase;2$;32| '|SPADreplace| '|%cup|) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Char|) - |CHAR;lowerCase;2$;33|)) - -(PUT '|CHAR;lowerCase;2$;33| '|SPADreplace| '|%cdown|) - -(DEFUN |CHAR;=;2$B;1| (|a| |b| $) - (DECLARE (IGNORE $)) - (CHAR= |a| |b|)) - -(DEFUN |CHAR;<;2$B;2| (|a| |b| $) - (DECLARE (IGNORE $)) - (CHAR< |a| |b|)) - -(DEFUN |CHAR;>;2$B;3| (|a| |b| $) - (DECLARE (IGNORE $)) - (CHAR> |a| |b|)) - -(DEFUN |CHAR;<=;2$B;4| (|a| |b| $) - (DECLARE (IGNORE $)) - (CHAR<= |a| |b|)) - -(DEFUN |CHAR;>=;2$B;5| (|a| |b| $) - (DECLARE (IGNORE $)) - (CHAR>= |a| |b|)) - -(DEFUN |CHAR;size;Nni;6| ($) (DECLARE (IGNORE $)) 256) - -(DEFUN |CHAR;index;Pi$;7| (|n| $) - (CODE-CHAR (LET ((#0=#:G1379 (- |n| 1))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)))) - -(DEFUN |CHAR;lookup;$Pi;8| (|c| $) - (LET ((#0=#:G1381 (+ 1 (CHAR-CODE |c|)))) - (|check-subtype| (PLUSP #0#) '(|PositiveInteger|) #0#))) - -(DEFUN |CHAR;char;Nni$;9| (|n| $) - (DECLARE (IGNORE $)) - (CODE-CHAR |n|)) - -(DEFUN |CHAR;ord;$Nni;10| (|c| $) - (DECLARE (IGNORE $)) - (CHAR-CODE |c|)) - -(DEFUN |CHAR;random;$;11| ($) (CODE-CHAR (RANDOM 256))) - -(DEFUN |CHAR;space;$;12| ($) (DECLARE (IGNORE $)) #\Space) - -(DEFUN |CHAR;quote;$;13| ($) (DECLARE (IGNORE $)) #\") - -(DEFUN |CHAR;underscore;$;14| ($) (DECLARE (IGNORE $)) #\_) - -(DEFUN |CHAR;newline;$;15| ($) (DECLARE (IGNORE $)) #\Newline) - -(DEFUN |CHAR;carriageReturn;$;16| ($) - (DECLARE (IGNORE $)) - (CODE-CHAR 13)) - -(DEFUN |CHAR;linefeed;$;17| ($) (DECLARE (IGNORE $)) (CODE-CHAR 10)) - -(DEFUN |CHAR;formfeed;$;18| ($) (DECLARE (IGNORE $)) (CODE-CHAR 12)) - -(DEFUN |CHAR;backspace;$;19| ($) (DECLARE (IGNORE $)) (CODE-CHAR 8)) - -(DEFUN |CHAR;horizontalTab;$;20| ($) - (DECLARE (IGNORE $)) - (CODE-CHAR 9)) - -(DEFUN |CHAR;verticalTab;$;21| ($) - (DECLARE (IGNORE $)) - (CODE-CHAR 11)) - -(DEFUN |CHAR;escape;$;22| ($) (DECLARE (IGNORE $)) (CODE-CHAR 27)) - -(DEFUN |CHAR;coerce;$Of;23| (|c| $) (DECLARE (IGNORE $)) |c|) - -(DEFUN |CHAR;digit?;$B;24| (|c| $) - (SPADCALL |c| (|spadConstant| $ 40) (|shellEntry| $ 42))) - -(DEFUN |CHAR;hexDigit?;$B;25| (|c| $) - (SPADCALL |c| (|spadConstant| $ 44) (|shellEntry| $ 42))) - -(DEFUN |CHAR;upperCase?;$B;26| (|c| $) - (SPADCALL |c| (|spadConstant| $ 46) (|shellEntry| $ 42))) - -(DEFUN |CHAR;lowerCase?;$B;27| (|c| $) - (SPADCALL |c| (|spadConstant| $ 48) (|shellEntry| $ 42))) - -(DEFUN |CHAR;alphabetic?;$B;28| (|c| $) - (SPADCALL |c| (|spadConstant| $ 50) (|shellEntry| $ 42))) - -(DEFUN |CHAR;alphanumeric?;$B;29| (|c| $) - (SPADCALL |c| (|spadConstant| $ 52) (|shellEntry| $ 42))) - -(DEFUN |CHAR;latex;$S;30| (|c| $) - (DECLARE (IGNORE $)) - (STRCONC "\\mbox{`" (STRCONC (STRING |c|) "'}"))) - -(DEFUN |CHAR;char;S$;31| (|s| $) - (DECLARE (IGNORE $)) - (|stringToChar| |s|)) - -(DEFUN |CHAR;upperCase;2$;32| (|c| $) - (DECLARE (IGNORE $)) - (CHAR-UPCASE |c|)) - -(DEFUN |CHAR;lowerCase;2$;33| (|c| $) - (DECLARE (IGNORE $)) - (CHAR-DOWNCASE |c|)) - -(DEFUN |Character| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((#0=#:G1408 (HGET |$ConstructorCache| '|Character|))) - (COND - (#0# (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Character| - (LIST (CONS NIL (CONS 1 (|Character;|)))))) - (SETQ #0# T)) - (COND ((NOT #0#) (HREM |$ConstructorCache| '|Character|)))))))) - -(DEFUN |Character;| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((|dv$| '(|Character|)) ($ (|newShell| 61)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|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| |CHAR;>;2$B;3| |CHAR;<=;2$B;4| - |CHAR;>=;2$B;5| (|NonNegativeInteger|) |CHAR;size;Nni;6| - (|PositiveInteger|) (0 . |One|) (4 . |One|) (|Integer|) - (8 . -) |CHAR;char;Nni$;9| |CHAR;index;Pi$;7| - |CHAR;ord;$Nni;10| (14 . +) |CHAR;lookup;$Pi;8| - (20 . |random|) |CHAR;random;$;11| - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |CHAR;space;$;12|) $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |CHAR;quote;$;13|) $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |CHAR;underscore;$;14|) - $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |CHAR;newline;$;15|) $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| - |CHAR;carriageReturn;$;16|) - $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |CHAR;linefeed;$;17|) - $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |CHAR;formfeed;$;18|) - $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |CHAR;backspace;$;19|) - $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| - |CHAR;horizontalTab;$;20|) - $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| - |CHAR;verticalTab;$;21|) - $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |CHAR;escape;$;22|) $)) - (|OutputForm|) |CHAR;coerce;$Of;23| (|CharacterClass|) - (25 . |digit|) (|Character|) (29 . |member?|) - |CHAR;digit?;$B;24| (35 . |hexDigit|) - |CHAR;hexDigit?;$B;25| (39 . |upperCase|) - |CHAR;upperCase?;$B;26| (43 . |lowerCase|) - |CHAR;lowerCase?;$B;27| (47 . |alphabetic|) - |CHAR;alphabetic?;$B;28| (51 . |alphanumeric|) - |CHAR;alphanumeric?;$B;29| (|String|) (55 . |concat|) - |CHAR;latex;$S;30| |CHAR;char;S$;31| - |CHAR;upperCase;2$;32| |CHAR;lowerCase;2$;33| - (|SingleInteger|)) - '#(~= 61 |verticalTab| 67 |upperCase?| 71 |upperCase| 76 - |underscore| 81 |space| 85 |size| 89 |random| 93 |quote| - 97 |ord| 101 |newline| 106 |min| 110 |max| 120 - |lowerCase?| 130 |lowerCase| 135 |lookup| 140 |linefeed| - 145 |latex| 149 |index| 154 |horizontalTab| 159 - |hexDigit?| 163 |hash| 168 |formfeed| 173 |escape| 177 - |digit?| 181 |coerce| 186 |char| 191 |carriageReturn| 201 - |before?| 205 |backspace| 211 |alphanumeric?| 215 - |alphabetic?| 220 >= 225 > 231 = 237 <= 243 < 249) - 'NIL - (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0 0 0)) - (CONS '#(NIL NIL NIL |SetCategory&| |OrderedType&| - |BasicType&| NIL NIL) - (CONS '#((|OrderedFinite|) (|OrderedSet|) - (|Finite|) (|SetCategory|) - (|OrderedType|) (|BasicType|) (|Type|) - (|CoercibleTo| 37)) - (|makeByteWordVec2| 60 - '(0 14 0 15 0 12 0 16 2 17 0 0 0 18 2 - 12 0 0 0 22 1 12 0 0 24 0 39 0 40 2 - 39 6 41 0 42 0 39 0 44 0 39 0 46 0 39 - 0 48 0 39 0 50 0 39 0 52 2 54 0 0 0 - 55 2 0 6 0 0 1 0 0 0 35 1 0 6 0 47 1 - 0 0 0 58 0 0 0 28 0 0 0 26 0 0 12 13 - 0 0 0 25 0 0 0 27 1 0 12 0 21 0 0 0 - 29 0 0 0 1 2 0 0 0 0 1 0 0 0 1 2 0 0 - 0 0 1 1 0 6 0 49 1 0 0 0 59 1 0 14 0 - 23 0 0 0 31 1 0 54 0 56 1 0 0 14 20 0 - 0 0 34 1 0 6 0 45 1 0 60 0 1 0 0 0 32 - 0 0 0 36 1 0 6 0 43 1 0 37 0 38 1 0 0 - 54 57 1 0 0 12 19 0 0 0 30 2 0 6 0 0 - 1 0 0 0 33 1 0 6 0 53 1 0 6 0 51 2 0 - 6 0 0 11 2 0 6 0 0 9 2 0 6 0 0 7 2 0 - 6 0 0 10 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 deleted file mode 100644 index 33c77f54..00000000 --- a/src/algebra/strap/CLAGG-.lsp +++ /dev/null @@ -1,211 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0)) - |CLAGG-;#;ANni;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) - (|%IntegerSection| 0)) - |CLAGG-;count;MANni;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |CLAGG-;any?;MAB;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |CLAGG-;every?;MAB;4|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Pair|) - |CLAGG-;find;MAU;5|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |CLAGG-;reduce;MAS;6|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |CLAGG-;reduce;MA2S;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |CLAGG-;remove;M2A;8|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |CLAGG-;select;M2A;9|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |CLAGG-;remove;S2A;10|)) - -(DECLAIM (FTYPE (FUNCTION - (|%Thing| |%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |CLAGG-;reduce;MA3S;11|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |CLAGG-;removeDuplicates;2A;12|)) - -(DEFUN |CLAGG-;#;ANni;1| (|c| $) - (LIST-LENGTH (SPADCALL |c| (|shellEntry| $ 9)))) - -(DEFUN |CLAGG-;count;MANni;2| (|f| |c| $) - (LET ((#0=#:G1377 NIL) (#1=#:G1378 T) - (#2=#:G1404 (SPADCALL |c| (|shellEntry| $ 9)))) - (LOOP - (COND - ((ATOM #2#) (RETURN (COND (#1# 0) (T #0#)))) - (T (LET ((|x| (CAR #2#))) - (AND (SPADCALL |x| |f|) - (LET ((#3=#:G1376 1)) - (COND - (#1# (SETQ #0# #3#)) - (T (SETQ #0# (+ #0# #3#)))) - (SETQ #1# NIL)))))) - (SETQ #2# (CDR #2#))))) - -(DEFUN |CLAGG-;any?;MAB;3| (|f| |c| $) - (LET ((#0=#:G1382 NIL) (#1=#:G1383 T) - (#2=#:G1405 (SPADCALL |c| (|shellEntry| $ 9)))) - (LOOP - (COND - ((ATOM #2#) (RETURN (AND (NOT #1#) #0#))) - (T (LET ((|x| (CAR #2#))) - (LET ((#3=#:G1381 (SPADCALL |x| |f|))) - (COND (#1# (SETQ #0# #3#)) (T (SETQ #0# (OR #0# #3#)))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#))))) - -(DEFUN |CLAGG-;every?;MAB;4| (|f| |c| $) - (LET ((#0=#:G1386 NIL) (#1=#:G1387 T) - (#2=#:G1406 (SPADCALL |c| (|shellEntry| $ 9)))) - (LOOP - (COND - ((ATOM #2#) (RETURN (OR #1# #0#))) - (T (LET ((|x| (CAR #2#))) - (LET ((#3=#:G1385 (SPADCALL |x| |f|))) - (COND - (#1# (SETQ #0# #3#)) - (T (SETQ #0# (AND #0# #3#)))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#))))) - -(DEFUN |CLAGG-;find;MAU;5| (|f| |c| $) - (SPADCALL |f| (SPADCALL |c| (|shellEntry| $ 9)) (|shellEntry| $ 26))) - -(DEFUN |CLAGG-;reduce;MAS;6| (|f| |x| $) - (SPADCALL |f| (SPADCALL |x| (|shellEntry| $ 9)) (|shellEntry| $ 29))) - -(DEFUN |CLAGG-;reduce;MA2S;7| (|f| |x| |s| $) - (SPADCALL |f| (SPADCALL |x| (|shellEntry| $ 9)) |s| - (|shellEntry| $ 31))) - -(DEFUN |CLAGG-;remove;M2A;8| (|f| |x| $) - (SPADCALL (SPADCALL |f| (SPADCALL |x| (|shellEntry| $ 9)) - (|shellEntry| $ 33)) - (|shellEntry| $ 34))) - -(DEFUN |CLAGG-;select;M2A;9| (|f| |x| $) - (SPADCALL (SPADCALL |f| (SPADCALL |x| (|shellEntry| $ 9)) - (|shellEntry| $ 36)) - (|shellEntry| $ 34))) - -(DEFUN |CLAGG-;remove;S2A;10| (|s| |x| $) - (SPADCALL (CONS #'|CLAGG-;remove;S2A;10!0| (VECTOR $ |s|)) |x| - (|shellEntry| $ 39))) - -(DEFUN |CLAGG-;remove;S2A;10!0| (|#1| $$) - (SPADCALL |#1| (SVREF $$ 1) (|shellEntry| (SVREF $$ 0) 38))) - -(DEFUN |CLAGG-;reduce;MA3S;11| (|f| |x| |s1| |s2| $) - (SPADCALL |f| (SPADCALL |x| (|shellEntry| $ 9)) |s1| |s2| - (|shellEntry| $ 41))) - -(DEFUN |CLAGG-;removeDuplicates;2A;12| (|x| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|shellEntry| $ 9)) (|shellEntry| $ 43)) - (|shellEntry| $ 34))) - -(DEFUN |Collection&| (|#1| |#2|) - (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) - (|dv$| (LIST '|Collection&| |dv$1| |dv$2|)) - ($ (|newShell| 45)) - (|pv$| (|buildPredVector| 0 0 - (LIST (|HasCategory| |#2| - '(|ConvertibleTo| (|InputForm|))) - (|HasCategory| |#2| '(|SetCategory|)) - (|HasAttribute| |#1| '|finiteAggregate|))))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (SETF (|shellEntry| $ 7) |#2|) - (COND - ((|testBitVector| |pv$| 3) - (PROGN - (SETF (|shellEntry| $ 12) - (CONS (|dispatchFunction| |CLAGG-;#;ANni;1|) $)) - (SETF (|shellEntry| $ 18) - (CONS (|dispatchFunction| |CLAGG-;count;MANni;2|) $)) - (SETF (|shellEntry| $ 21) - (CONS (|dispatchFunction| |CLAGG-;any?;MAB;3|) $)) - (SETF (|shellEntry| $ 24) - (CONS (|dispatchFunction| |CLAGG-;every?;MAB;4|) $)) - (SETF (|shellEntry| $ 27) - (CONS (|dispatchFunction| |CLAGG-;find;MAU;5|) $)) - (SETF (|shellEntry| $ 30) - (CONS (|dispatchFunction| |CLAGG-;reduce;MAS;6|) $)) - (SETF (|shellEntry| $ 32) - (CONS (|dispatchFunction| |CLAGG-;reduce;MA2S;7|) $)) - (SETF (|shellEntry| $ 35) - (CONS (|dispatchFunction| |CLAGG-;remove;M2A;8|) $)) - (SETF (|shellEntry| $ 37) - (CONS (|dispatchFunction| |CLAGG-;select;M2A;9|) $)) - (COND - ((|testBitVector| |pv$| 2) - (PROGN - (SETF (|shellEntry| $ 40) - (CONS (|dispatchFunction| |CLAGG-;remove;S2A;10|) - $)) - (SETF (|shellEntry| $ 42) - (CONS (|dispatchFunction| |CLAGG-;reduce;MA3S;11|) - $)) - (SETF (|shellEntry| $ 44) - (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 . |#|) - (10 . |#|) (15 . |One|) (19 . +) (25 . |Zero|) (|Boolean|) - (|Mapping| 16 7) (29 . |count|) (35 . |or|) (41 . |false|) - (45 . |any?|) (51 . |and|) (57 . |true|) (61 . |every?|) - (|Union| 7 '"failed") (67 . |find|) (73 . |find|) - (|Mapping| 7 7 7) (79 . |reduce|) (85 . |reduce|) - (91 . |reduce|) (98 . |reduce|) (105 . |remove|) - (111 . |construct|) (116 . |remove|) (122 . |select|) - (128 . |select|) (134 . =) (140 . |remove|) - (146 . |remove|) (152 . |reduce|) (160 . |reduce|) - (168 . |removeDuplicates|) (173 . |removeDuplicates|)) - '#(|select| 178 |removeDuplicates| 184 |remove| 189 |reduce| - 201 |find| 222 |every?| 228 |count| 234 |any?| 240 |#| - 246) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 44 - '(1 6 8 0 9 1 8 10 0 11 1 0 10 0 12 0 - 10 0 13 2 10 0 0 0 14 0 10 0 15 2 0 - 10 17 0 18 2 16 0 0 0 19 0 16 0 20 2 - 0 16 17 0 21 2 16 0 0 0 22 0 16 0 23 - 2 0 16 17 0 24 2 8 25 17 0 26 2 0 25 - 17 0 27 2 8 7 28 0 29 2 0 7 28 0 30 3 - 8 7 28 0 7 31 3 0 7 28 0 7 32 2 8 0 - 17 0 33 1 6 0 8 34 2 0 0 17 0 35 2 8 - 0 17 0 36 2 0 0 17 0 37 2 7 16 0 0 38 - 2 6 0 17 0 39 2 0 0 7 0 40 4 8 7 28 0 - 7 7 41 4 0 7 28 0 7 7 42 1 8 0 0 43 1 - 0 0 0 44 2 0 0 17 0 37 1 0 0 0 44 2 0 - 0 7 0 40 2 0 0 17 0 35 4 0 7 28 0 7 7 - 42 3 0 7 28 0 7 32 2 0 7 28 0 30 2 0 - 25 17 0 27 2 0 16 17 0 24 2 0 10 17 0 - 18 2 0 16 17 0 21 1 0 10 0 12))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/CLAGG.lsp b/src/algebra/strap/CLAGG.lsp deleted file mode 100644 index 3bc59621..00000000 --- a/src/algebra/strap/CLAGG.lsp +++ /dev/null @@ -1,81 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |Collection;CAT| 'NIL) - -(DEFPARAMETER |Collection;AL| 'NIL) - -(DEFUN |Collection;| (|t#1|) - (LET ((#0=#:G1372 - (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (COND - (|Collection;CAT|) - (T (SETQ |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)))))))) - (SETF (|shellEntry| #0# 0) - (LIST '|Collection| (|devaluate| |t#1|))) - #0#)) - -(DEFUN |Collection| (#0=#:G1373) - (LET ((#1=#:G1374 (|assoc| (|devaluate| #0#) |Collection;AL|))) - (COND - (#1# (CDR #1#)) - (T (PROGN - (SETQ #1# (|Collection;| #0#)) - (SETQ |Collection;AL| - (|cons5| (CONS (|devaluate| #0#) #1#) |Collection;AL|)) - #1#))))) diff --git a/src/algebra/strap/COMRING.lsp b/src/algebra/strap/COMRING.lsp deleted file mode 100644 index 2c90cf82..00000000 --- a/src/algebra/strap/COMRING.lsp +++ /dev/null @@ -1,19 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |CommutativeRing;AL| 'NIL) - -(DEFUN |CommutativeRing;| () - (LET ((#0=#:G1372 - (|Join| (|Ring|) (|BiModule| '$ '$) - (|mkCategory| '|package| NIL - '(((|commutative| "*") T)) 'NIL NIL)))) - (SETF (|shellEntry| #0# 0) '(|CommutativeRing|)) - #0#)) - -(DEFUN |CommutativeRing| () - (COND - (|CommutativeRing;AL|) - (T (SETQ |CommutativeRing;AL| (|CommutativeRing;|))))) - -(MAKEPROP '|CommutativeRing| 'NILADIC T) diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp deleted file mode 100644 index 91085f61..00000000 --- a/src/algebra/strap/DFLOAT.lsp +++ /dev/null @@ -1,1161 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%String|) - |DFLOAT;OMwrite;$S;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Boolean| |%Shell|) - |%String|) - |DFLOAT;OMwrite;$BS;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%DoubleFloat| |%Shell|) |%Void|) - |DFLOAT;OMwrite;Omd$V;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%DoubleFloat| |%Boolean| |%Shell|) - |%Void|) - |DFLOAT;OMwrite;Omd$BV;4|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 1)) - |DFLOAT;base;Pi;5|)) - -(PUT '|DFLOAT;base;Pi;5| '|SPADreplace| '|%fbase|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Integer|) - |DFLOAT;mantissa;$I;6|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Integer|) - |DFLOAT;exponent;$I;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 1)) - |DFLOAT;precision;Pi;8|)) - -(PUT '|DFLOAT;precision;Pi;8| '|SPADreplace| '|%fprec|) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 1)) - |DFLOAT;bits;Pi;9|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|) |DFLOAT;max;$;10|)) - -(PUT '|DFLOAT;max;$;10| '|SPADreplace| '|%fmaxval|) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|) |DFLOAT;min;$;11|)) - -(PUT '|DFLOAT;min;$;11| '|SPADreplace| '|%fminval|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Integer|) - |DFLOAT;order;$I;12|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|) - |DFLOAT;Zero;$;13|)) - -(PUT '|DFLOAT;Zero;$;13| '|SPADreplace| '(XLAM NIL (|%i2f| 0))) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|) |DFLOAT;One;$;14|)) - -(PUT '|DFLOAT;One;$;14| '|SPADreplace| '(XLAM NIL (|%i2f| 1))) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|) - |DFLOAT;exp1;$;15|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|) |DFLOAT;pi;$;16|)) - -(PUT '|DFLOAT;pi;$;16| '|SPADreplace| '|%fcstpi|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Thing|) - |DFLOAT;coerce;$Of;17|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Thing|) - |DFLOAT;convert;$If;18|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|) - |%Boolean|) - |DFLOAT;<;2$B;19|)) - -(PUT '|DFLOAT;<;2$B;19| '|SPADreplace| '|%flt|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|) - |%Boolean|) - |DFLOAT;>;2$B;20|)) - -(PUT '|DFLOAT;>;2$B;20| '|SPADreplace| '|%fgt|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|) - |%Boolean|) - |DFLOAT;<=;2$B;21|)) - -(PUT '|DFLOAT;<=;2$B;21| '|SPADreplace| '|%fle|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|) - |%Boolean|) - |DFLOAT;>=;2$B;22|)) - -(PUT '|DFLOAT;>=;2$B;22| '|SPADreplace| '|%fge|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;-;2$;23|)) - -(PUT '|DFLOAT;-;2$;23| '|SPADreplace| '|%fneg|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|) - |%DoubleFloat|) - |DFLOAT;+;3$;24|)) - -(PUT '|DFLOAT;+;3$;24| '|SPADreplace| '|%fadd|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|) - |%DoubleFloat|) - |DFLOAT;-;3$;25|)) - -(PUT '|DFLOAT;-;3$;25| '|SPADreplace| '|%fsub|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|) - |%DoubleFloat|) - |DFLOAT;*;3$;26|)) - -(PUT '|DFLOAT;*;3$;26| '|SPADreplace| '|%fmul|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%DoubleFloat| |%Shell|) - |%DoubleFloat|) - |DFLOAT;*;I2$;27|)) - -(PUT '|DFLOAT;*;I2$;27| '|SPADreplace| '|%imulf|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|) - |%DoubleFloat|) - |DFLOAT;max;3$;28|)) - -(PUT '|DFLOAT;max;3$;28| '|SPADreplace| '|%fmax|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|) - |%DoubleFloat|) - |DFLOAT;min;3$;29|)) - -(PUT '|DFLOAT;min;3$;29| '|SPADreplace| '|%fmin|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|) - |%Boolean|) - |DFLOAT;=;2$B;30|)) - -(PUT '|DFLOAT;=;2$B;30| '|SPADreplace| '|%feq|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Integer| |%Shell|) - |%DoubleFloat|) - |DFLOAT;/;$I$;31|)) - -(PUT '|DFLOAT;/;$I$;31| '|SPADreplace| '|%fdivi|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;sqrt;2$;32|)) - -(PUT '|DFLOAT;sqrt;2$;32| '|SPADreplace| '|%fsqrt|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;log10;2$;33|)) - -(PUT '|DFLOAT;log10;2$;33| '|SPADreplace| '|%flog10|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Integer| |%Shell|) - |%DoubleFloat|) - |DFLOAT;**;$I$;34|)) - -(PUT '|DFLOAT;**;$I$;34| '|SPADreplace| '|%fpowi|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|) - |%DoubleFloat|) - |DFLOAT;**;3$;35|)) - -(PUT '|DFLOAT;**;3$;35| '|SPADreplace| '|%fpowf|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%DoubleFloat|) - |DFLOAT;coerce;I$;36|)) - -(PUT '|DFLOAT;coerce;I$;36| '|SPADreplace| '|%i2f|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;exp;2$;37|)) - -(PUT '|DFLOAT;exp;2$;37| '|SPADreplace| '|%fexp|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;log;2$;38|)) - -(PUT '|DFLOAT;log;2$;38| '|SPADreplace| '|%flog|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;log2;2$;39|)) - -(PUT '|DFLOAT;log2;2$;39| '|SPADreplace| '|%flog2|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;sin;2$;40|)) - -(PUT '|DFLOAT;sin;2$;40| '|SPADreplace| '|%fsin|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;cos;2$;41|)) - -(PUT '|DFLOAT;cos;2$;41| '|SPADreplace| '|%fcos|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;tan;2$;42|)) - -(PUT '|DFLOAT;tan;2$;42| '|SPADreplace| '|%ftan|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;cot;2$;43|)) - -(PUT '|DFLOAT;cot;2$;43| '|SPADreplace| '|%fcot|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;sec;2$;44|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;csc;2$;45|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;asin;2$;46|)) - -(PUT '|DFLOAT;asin;2$;46| '|SPADreplace| '|%fasin|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;acos;2$;47|)) - -(PUT '|DFLOAT;acos;2$;47| '|SPADreplace| '|%facos|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;atan;2$;48|)) - -(PUT '|DFLOAT;atan;2$;48| '|SPADreplace| '|%fatan|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;acsc;2$;49|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;acot;2$;50|)) - -(PUT '|DFLOAT;acot;2$;50| '|SPADreplace| '|%facot|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;asec;2$;51|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;sinh;2$;52|)) - -(PUT '|DFLOAT;sinh;2$;52| '|SPADreplace| '|%fsinh|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;cosh;2$;53|)) - -(PUT '|DFLOAT;cosh;2$;53| '|SPADreplace| '|%fcosh|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;tanh;2$;54|)) - -(PUT '|DFLOAT;tanh;2$;54| '|SPADreplace| '|%ftanh|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;csch;2$;55|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;coth;2$;56|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;sech;2$;57|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;asinh;2$;58|)) - -(PUT '|DFLOAT;asinh;2$;58| '|SPADreplace| '|%fasinh|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;acosh;2$;59|)) - -(PUT '|DFLOAT;acosh;2$;59| '|SPADreplace| '|%facosh|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;atanh;2$;60|)) - -(PUT '|DFLOAT;atanh;2$;60| '|SPADreplace| '|%fatanh|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;acsch;2$;61|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;acoth;2$;62|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;asech;2$;63|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|) - |%DoubleFloat|) - |DFLOAT;/;3$;64|)) - -(PUT '|DFLOAT;/;3$;64| '|SPADreplace| '|%fdiv|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Boolean|) - |DFLOAT;negative?;$B;65|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Boolean|) - |DFLOAT;zero?;$B;66|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Boolean|) - |DFLOAT;one?;$B;67|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Short|) - |DFLOAT;hash;$Si;68|)) - -(PUT '|DFLOAT;hash;$Si;68| '|SPADreplace| '|%hash|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Pair|) - |DFLOAT;recip;$U;69|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;differentiate;2$;70|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;Gamma;2$;71|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|) - |%DoubleFloat|) - |DFLOAT;Beta;3$;72|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Integer|) - |DFLOAT;wholePart;$I;73|)) - -(PUT '|DFLOAT;wholePart;$I;73| '|SPADreplace| '|%ftrunc|) - -(DECLAIM (FTYPE (FUNCTION - (|%Integer| |%Integer| (|%IntegerSection| 1) - |%Shell|) - |%DoubleFloat|) - |DFLOAT;float;2IPi$;74|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;convert;2$;75|)) - -(PUT '|DFLOAT;convert;2$;75| '|SPADreplace| '(XLAM (|x|) |x|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Thing|) - |DFLOAT;convert;$F;76|)) - -(DECLAIM (FTYPE (FUNCTION - (|%DoubleFloat| (|%IntegerSection| 0) |%Shell|) - |%Thing|) - |DFLOAT;rationalApproximation;$NniF;77|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|) - |%DoubleFloat|) - |DFLOAT;atan;3$;78|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Thing|) - |DFLOAT;retract;$F;79|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Pair|) - |DFLOAT;retractIfCan;$U;80|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Integer|) - |DFLOAT;retract;$I;81|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Pair|) - |DFLOAT;retractIfCan;$U;82|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Integer|) - |DFLOAT;sign;$I;83|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|) - |DFLOAT;abs;2$;84|)) - -(PUT '|DFLOAT;abs;2$;84| '|SPADreplace| '|%fabs|) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Pair|) - |DFLOAT;manexp|)) - -(DECLAIM (FTYPE (FUNCTION - (|%DoubleFloat| (|%IntegerSection| 0) - (|%IntegerSection| 0) |%Shell|) - |%Thing|) - |DFLOAT;rationalApproximation;$2NniF;86|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Thing| |%Shell|) - |%DoubleFloat|) - |DFLOAT;**;$F$;87|)) - -(PUT '|DFLOAT;exp1;$;15| '|SPADreplace| - '(XLAM NIL (|%fdiv| (|%i2f| 534625820200) (|%i2f| 196677847971)))) - -(PUT '|DFLOAT;sec;2$;44| '|SPADreplace| - '(XLAM (|x|) (|%fdiv| (|%i2f| 1) (|%fcos| |x|)))) - -(PUT '|DFLOAT;csc;2$;45| '|SPADreplace| - '(XLAM (|x|) (|%fdiv| (|%i2f| 1) (|%fsin| |x|)))) - -(PUT '|DFLOAT;acsc;2$;49| '|SPADreplace| - '(XLAM (|x|) (|%fasin| (|%fdiv| (|%i2f| 1) |x|)))) - -(PUT '|DFLOAT;asec;2$;51| '|SPADreplace| - '(XLAM (|x|) (|%facos| (|%fdiv| (|%i2f| 1) |x|)))) - -(PUT '|DFLOAT;csch;2$;55| '|SPADreplace| - '(XLAM (|x|) (|%fdiv| (|%i2f| 1) (|%fsinh| |x|)))) - -(PUT '|DFLOAT;coth;2$;56| '|SPADreplace| - '(XLAM (|x|) (|%fdiv| (|%i2f| 1) (|%ftanh| |x|)))) - -(PUT '|DFLOAT;sech;2$;57| '|SPADreplace| - '(XLAM (|x|) (|%fdiv| (|%i2f| 1) (|%fcosh| |x|)))) - -(PUT '|DFLOAT;acsch;2$;61| '|SPADreplace| - '(XLAM (|x|) (|%fasinh| (|%fdiv| (|%i2f| 1) |x|)))) - -(PUT '|DFLOAT;acoth;2$;62| '|SPADreplace| - '(XLAM (|x|) (|%fatanh| (|%fdiv| (|%i2f| 1) |x|)))) - -(PUT '|DFLOAT;asech;2$;63| '|SPADreplace| - '(XLAM (|x|) (|%facosh| (|%fdiv| (|%i2f| 1) |x|)))) - -(PUT '|DFLOAT;negative?;$B;65| '|SPADreplace| - '(XLAM (|x|) (|%flt| |x| (|%i2f| 0)))) - -(PUT '|DFLOAT;zero?;$B;66| '|SPADreplace| - '(XLAM (|x|) (|%feq| |x| (|%i2f| 0)))) - -(PUT '|DFLOAT;one?;$B;67| '|SPADreplace| - '(XLAM (|x|) (|%feq| |x| (|%i2f| 1)))) - -(PUT '|DFLOAT;differentiate;2$;70| '|SPADreplace| - '(XLAM (|x|) (|%i2f| 0))) - -(DEFUN |DFLOAT;OMwrite;$S;1| (|x| $) - (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) - (|dev| (SPADCALL |sp| (SPADCALL (|shellEntry| $ 7)) - (|shellEntry| $ 10)))) - (SEQ (SPADCALL |dev| (|shellEntry| $ 12)) - (SPADCALL |dev| |x| (|shellEntry| $ 15)) - (SPADCALL |dev| (|shellEntry| $ 16)) - (SPADCALL |dev| (|shellEntry| $ 17)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) - -(DEFUN |DFLOAT;OMwrite;$BS;2| (|x| |wholeObj| $) - (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) - (|dev| (SPADCALL |sp| (SPADCALL (|shellEntry| $ 7)) - (|shellEntry| $ 10)))) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 12)))) - (SPADCALL |dev| |x| (|shellEntry| $ 15)) - (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 16)))) - (SPADCALL |dev| (|shellEntry| $ 17)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) - -(DEFUN |DFLOAT;OMwrite;Omd$V;3| (|dev| |x| $) - (SEQ (SPADCALL |dev| (|shellEntry| $ 12)) - (SPADCALL |dev| |x| (|shellEntry| $ 15)) - (EXIT (SPADCALL |dev| (|shellEntry| $ 16))))) - -(DEFUN |DFLOAT;OMwrite;Omd$BV;4| (|dev| |x| |wholeObj| $) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 12)))) - (SPADCALL |dev| |x| (|shellEntry| $ 15)) - (EXIT (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 16))))))) - -(DEFUN |DFLOAT;base;Pi;5| ($) (DECLARE (IGNORE $)) 2) - -(DEFUN |DFLOAT;mantissa;$I;6| (|x| $) (CAR (|DFLOAT;manexp| |x| $))) - -(DEFUN |DFLOAT;exponent;$I;7| (|x| $) (CDR (|DFLOAT;manexp| |x| $))) - -(DEFUN |DFLOAT;precision;Pi;8| ($) (DECLARE (IGNORE $)) 53) - -(DEFUN |DFLOAT;bits;Pi;9| ($) - (COND - ((EQL 2 2) 53) - ((EQL 2 16) (* 4 53)) - (T (LET ((#0=#:G1405 - (TRUNCATE - (SPADCALL 53 - (C-TO-R (LOG (FLOAT 2 |$DoubleFloatMaximum|) - 2)) - (|shellEntry| $ 32))))) - (|check-subtype| (AND (NOT (MINUSP #0#)) (PLUSP #0#)) - '(|PositiveInteger|) #0#))))) - -(DEFUN |DFLOAT;max;$;10| ($) - (DECLARE (IGNORE $)) - |$DoubleFloatMaximum|) - -(DEFUN |DFLOAT;min;$;11| ($) - (DECLARE (IGNORE $)) - |$DoubleFloatMinimum|) - -(DEFUN |DFLOAT;order;$I;12| (|a| $) - (- (+ 53 (|DFLOAT;exponent;$I;7| |a| $)) 1)) - -(DEFUN |DFLOAT;Zero;$;13| ($) (DECLARE (IGNORE $)) 0.0) - -(DEFUN |DFLOAT;One;$;14| ($) (DECLARE (IGNORE $)) 1.0) - -(DEFUN |DFLOAT;exp1;$;15| ($) - (DECLARE (IGNORE $)) - (/ (FLOAT 534625820200 |$DoubleFloatMaximum|) - (FLOAT 196677847971 |$DoubleFloatMaximum|))) - -(DEFUN |DFLOAT;pi;$;16| ($) - (DECLARE (IGNORE $)) - (COERCE PI '|%DoubleFloat|)) - -(DEFUN |DFLOAT;coerce;$Of;17| (|x| $) - (SPADCALL |x| (|shellEntry| $ 48))) - -(DEFUN |DFLOAT;convert;$If;18| (|x| $) - (SPADCALL |x| (|shellEntry| $ 51))) - -(DEFUN |DFLOAT;<;2$B;19| (|x| |y| $) (DECLARE (IGNORE $)) (< |x| |y|)) - -(DEFUN |DFLOAT;>;2$B;20| (|x| |y| $) (DECLARE (IGNORE $)) (< |y| |x|)) - -(DEFUN |DFLOAT;<=;2$B;21| (|x| |y| $) - (DECLARE (IGNORE $)) - (<= |x| |y|)) - -(DEFUN |DFLOAT;>=;2$B;22| (|x| |y| $) - (DECLARE (IGNORE $)) - (>= |x| |y|)) - -(DEFUN |DFLOAT;-;2$;23| (|x| $) (DECLARE (IGNORE $)) (- |x|)) - -(DEFUN |DFLOAT;+;3$;24| (|x| |y| $) (DECLARE (IGNORE $)) (+ |x| |y|)) - -(DEFUN |DFLOAT;-;3$;25| (|x| |y| $) (DECLARE (IGNORE $)) (- |x| |y|)) - -(DEFUN |DFLOAT;*;3$;26| (|x| |y| $) (DECLARE (IGNORE $)) (* |x| |y|)) - -(DEFUN |DFLOAT;*;I2$;27| (|i| |x| $) (DECLARE (IGNORE $)) (* |i| |x|)) - -(DEFUN |DFLOAT;max;3$;28| (|x| |y| $) - (DECLARE (IGNORE $)) - (MAX |x| |y|)) - -(DEFUN |DFLOAT;min;3$;29| (|x| |y| $) - (DECLARE (IGNORE $)) - (MIN |x| |y|)) - -(DEFUN |DFLOAT;=;2$B;30| (|x| |y| $) (DECLARE (IGNORE $)) (= |x| |y|)) - -(DEFUN |DFLOAT;/;$I$;31| (|x| |i| $) (DECLARE (IGNORE $)) (/ |x| |i|)) - -(DEFUN |DFLOAT;sqrt;2$;32| (|x| $) - (DECLARE (IGNORE $)) - (C-TO-R (SQRT |x|))) - -(DEFUN |DFLOAT;log10;2$;33| (|x| $) - (DECLARE (IGNORE $)) - (C-TO-R (LOG |x| 10))) - -(DEFUN |DFLOAT;**;$I$;34| (|x| |i| $) - (DECLARE (IGNORE $)) - (EXPT |x| |i|)) - -(DEFUN |DFLOAT;**;3$;35| (|x| |y| $) - (DECLARE (IGNORE $)) - (C-TO-R (EXPT |x| |y|))) - -(DEFUN |DFLOAT;coerce;I$;36| (|i| $) - (DECLARE (IGNORE $)) - (FLOAT |i| |$DoubleFloatMaximum|)) - -(DEFUN |DFLOAT;exp;2$;37| (|x| $) (DECLARE (IGNORE $)) (EXP |x|)) - -(DEFUN |DFLOAT;log;2$;38| (|x| $) - (DECLARE (IGNORE $)) - (C-TO-R (LOG |x|))) - -(DEFUN |DFLOAT;log2;2$;39| (|x| $) - (DECLARE (IGNORE $)) - (C-TO-R (LOG |x| 2))) - -(DEFUN |DFLOAT;sin;2$;40| (|x| $) (DECLARE (IGNORE $)) (SIN |x|)) - -(DEFUN |DFLOAT;cos;2$;41| (|x| $) (DECLARE (IGNORE $)) (COS |x|)) - -(DEFUN |DFLOAT;tan;2$;42| (|x| $) (DECLARE (IGNORE $)) (TAN |x|)) - -(DEFUN |DFLOAT;cot;2$;43| (|x| $) (DECLARE (IGNORE $)) (COT |x|)) - -(DEFUN |DFLOAT;sec;2$;44| (|x| $) - (DECLARE (IGNORE $)) - (/ 1.0 (COS |x|))) - -(DEFUN |DFLOAT;csc;2$;45| (|x| $) - (DECLARE (IGNORE $)) - (/ 1.0 (SIN |x|))) - -(DEFUN |DFLOAT;asin;2$;46| (|x| $) - (DECLARE (IGNORE $)) - (C-TO-R (ASIN |x|))) - -(DEFUN |DFLOAT;acos;2$;47| (|x| $) - (DECLARE (IGNORE $)) - (C-TO-R (ACOS |x|))) - -(DEFUN |DFLOAT;atan;2$;48| (|x| $) (DECLARE (IGNORE $)) (ATAN |x|)) - -(DEFUN |DFLOAT;acsc;2$;49| (|x| $) - (DECLARE (IGNORE $)) - (C-TO-R (ASIN (/ 1.0 |x|)))) - -(DEFUN |DFLOAT;acot;2$;50| (|x| $) (DECLARE (IGNORE $)) (ACOT |x|)) - -(DEFUN |DFLOAT;asec;2$;51| (|x| $) - (DECLARE (IGNORE $)) - (C-TO-R (ACOS (/ 1.0 |x|)))) - -(DEFUN |DFLOAT;sinh;2$;52| (|x| $) (DECLARE (IGNORE $)) (SINH |x|)) - -(DEFUN |DFLOAT;cosh;2$;53| (|x| $) (DECLARE (IGNORE $)) (COSH |x|)) - -(DEFUN |DFLOAT;tanh;2$;54| (|x| $) (DECLARE (IGNORE $)) (TANH |x|)) - -(DEFUN |DFLOAT;csch;2$;55| (|x| $) - (DECLARE (IGNORE $)) - (/ 1.0 (SINH |x|))) - -(DEFUN |DFLOAT;coth;2$;56| (|x| $) - (DECLARE (IGNORE $)) - (/ 1.0 (TANH |x|))) - -(DEFUN |DFLOAT;sech;2$;57| (|x| $) - (DECLARE (IGNORE $)) - (/ 1.0 (COSH |x|))) - -(DEFUN |DFLOAT;asinh;2$;58| (|x| $) (DECLARE (IGNORE $)) (ASINH |x|)) - -(DEFUN |DFLOAT;acosh;2$;59| (|x| $) - (DECLARE (IGNORE $)) - (C-TO-R (ACOSH |x|))) - -(DEFUN |DFLOAT;atanh;2$;60| (|x| $) - (DECLARE (IGNORE $)) - (C-TO-R (ATANH |x|))) - -(DEFUN |DFLOAT;acsch;2$;61| (|x| $) - (DECLARE (IGNORE $)) - (ASINH (/ 1.0 |x|))) - -(DEFUN |DFLOAT;acoth;2$;62| (|x| $) - (DECLARE (IGNORE $)) - (C-TO-R (ATANH (/ 1.0 |x|)))) - -(DEFUN |DFLOAT;asech;2$;63| (|x| $) - (DECLARE (IGNORE $)) - (C-TO-R (ACOSH (/ 1.0 |x|)))) - -(DEFUN |DFLOAT;/;3$;64| (|x| |y| $) (DECLARE (IGNORE $)) (/ |x| |y|)) - -(DEFUN |DFLOAT;negative?;$B;65| (|x| $) - (DECLARE (IGNORE $)) - (MINUSP |x|)) - -(DEFUN |DFLOAT;zero?;$B;66| (|x| $) (DECLARE (IGNORE $)) (ZEROP |x|)) - -(DEFUN |DFLOAT;one?;$B;67| (|x| $) (DECLARE (IGNORE $)) (= |x| 1.0)) - -(DEFUN |DFLOAT;hash;$Si;68| (|x| $) (DECLARE (IGNORE $)) (SXHASH |x|)) - -(DEFUN |DFLOAT;recip;$U;69| (|x| $) - (COND ((ZEROP |x|) (CONS 1 "failed")) (T (CONS 0 (/ 1.0 |x|))))) - -(DEFUN |DFLOAT;differentiate;2$;70| (|x| $) (DECLARE (IGNORE $)) 0.0) - -(DEFUN |DFLOAT;Gamma;2$;71| (|x| $) - (SPADCALL |x| (|shellEntry| $ 106))) - -(DEFUN |DFLOAT;Beta;3$;72| (|x| |y| $) - (SPADCALL |x| |y| (|shellEntry| $ 108))) - -(DEFUN |DFLOAT;wholePart;$I;73| (|x| $) - (DECLARE (IGNORE $)) - (TRUNCATE |x|)) - -(DEFUN |DFLOAT;float;2IPi$;74| (|ma| |ex| |b| $) - (* |ma| (EXPT (FLOAT |b| |$DoubleFloatMaximum|) |ex|))) - -(DEFUN |DFLOAT;convert;2$;75| (|x| $) (DECLARE (IGNORE $)) |x|) - -(DEFUN |DFLOAT;convert;$F;76| (|x| $) - (SPADCALL |x| (|shellEntry| $ 112))) - -(DEFUN |DFLOAT;rationalApproximation;$NniF;77| (|x| |d| $) - (|DFLOAT;rationalApproximation;$2NniF;86| |x| |d| 10 $)) - -(DEFUN |DFLOAT;atan;3$;78| (|x| |y| $) - (COND - ((ZEROP |x|) - (COND - ((PLUSP |y|) (/ (COERCE PI '|%DoubleFloat|) 2)) - ((MINUSP |y|) (- (/ (COERCE PI '|%DoubleFloat|) 2))) - (T 0.0))) - (T (LET ((|theta| (ATAN (ABS (/ |y| |x|))))) - (SEQ (COND - ((MINUSP |x|) - (SETQ |theta| (- (COERCE PI '|%DoubleFloat|) |theta|)))) - (COND ((MINUSP |y|) (SETQ |theta| (- |theta|)))) - (EXIT |theta|)))))) - -(DEFUN |DFLOAT;retract;$F;79| (|x| $) - (|DFLOAT;rationalApproximation;$2NniF;86| |x| - (LET ((#0=#:G1488 (- 53 1))) - (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) - #0#)) - 2 $)) - -(DEFUN |DFLOAT;retractIfCan;$U;80| (|x| $) - (CONS 0 - (|DFLOAT;rationalApproximation;$2NniF;86| |x| - (LET ((#0=#:G1496 (- 53 1))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - 2 $))) - -(DEFUN |DFLOAT;retract;$I;81| (|x| $) - (PROG (|n|) - (RETURN - (COND - ((= |x| - (FLOAT (LETT |n| (TRUNCATE |x|) |DFLOAT;retract;$I;81|) - |$DoubleFloatMaximum|)) - |n|) - (T (|error| "Not an integer")))))) - -(DEFUN |DFLOAT;retractIfCan;$U;82| (|x| $) - (PROG (|n|) - (RETURN - (COND - ((= |x| - (FLOAT (LETT |n| (TRUNCATE |x|) - |DFLOAT;retractIfCan;$U;82|) - |$DoubleFloatMaximum|)) - (CONS 0 |n|)) - (T (CONS 1 "failed")))))) - -(DEFUN |DFLOAT;sign;$I;83| (|x| $) - (|DFLOAT;retract;$I;81| (FLOAT-SIGN |x| 1.0) $)) - -(DEFUN |DFLOAT;abs;2$;84| (|x| $) (DECLARE (IGNORE $)) (ABS |x|)) - -(DEFUN |DFLOAT;manexp| (|x| $) - (PROG (|me| |two53|) - (RETURN - (COND - ((ZEROP |x|) (CONS 0 0)) - (T (LET ((|s| (|DFLOAT;sign;$I;83| |x| $))) - (SEQ (SETQ |x| (ABS |x|)) - (COND - ((< |$DoubleFloatMaximum| |x|) - (RETURN-FROM |DFLOAT;manexp| - (CONS (+ (* |s| - (|DFLOAT;mantissa;$I;6| - |$DoubleFloatMaximum| $)) - 1) - (|DFLOAT;exponent;$I;7| - |$DoubleFloatMaximum| $))))) - (LETT |me| (MANEXP |x|) |DFLOAT;manexp|) - (LETT |two53| (EXPT 2 53) |DFLOAT;manexp|) - (EXIT (CONS (* |s| (TRUNCATE (* |two53| (CAR |me|)))) - (- (CDR |me|) 53)))))))))) - -(DEFUN |DFLOAT;rationalApproximation;$2NniF;86| (|f| |d| |b| $) - (PROG (BASE |de| |tol| |s| |t| |p0| |p1| |q0| |q1| |#G106| |q| |r| - |p2| |q2| |#G107| |#G108| |#G109| |#G110| |#G111| - |#G112|) - (RETURN - (LET* ((|#G105| (|DFLOAT;manexp| |f| $)) (|nu| (CAR |#G105|)) - (|ex| (CDR |#G105|))) - (SEQ |#G105| - (LETT BASE 2 |DFLOAT;rationalApproximation;$2NniF;86|) - (EXIT (COND - ((NOT (MINUSP |ex|)) - (SPADCALL - (* |nu| - (EXPT BASE - (|check-subtype| (NOT (MINUSP |ex|)) - '(|NonNegativeInteger|) |ex|))) - (|shellEntry| $ 134))) - (T (SEQ (LETT |de| - (EXPT BASE - (LET ((#0=#:G1525 (- |ex|))) - (|check-subtype| - (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#))) - |DFLOAT;rationalApproximation;$2NniF;86|) - (EXIT (COND - ((< |b| 2) - (|error| "base must be > 1")) - (T - (SEQ - (LETT |tol| (EXPT |b| |d|) - |DFLOAT;rationalApproximation;$2NniF;86|) - (LETT |s| |nu| - |DFLOAT;rationalApproximation;$2NniF;86|) - (LETT |t| |de| - |DFLOAT;rationalApproximation;$2NniF;86|) - (LETT |p0| 0 - |DFLOAT;rationalApproximation;$2NniF;86|) - (LETT |p1| 1 - |DFLOAT;rationalApproximation;$2NniF;86|) - (LETT |q0| 1 - |DFLOAT;rationalApproximation;$2NniF;86|) - (LETT |q1| 0 - |DFLOAT;rationalApproximation;$2NniF;86|) - (EXIT - (LOOP - (COND - (NIL (RETURN NIL)) - (T - (SEQ - (LETT |#G106| - (MULTIPLE-VALUE-CALL - #'CONS - (TRUNCATE |s| |t|)) - |DFLOAT;rationalApproximation;$2NniF;86|) - (LETT |q| (CAR |#G106|) - |DFLOAT;rationalApproximation;$2NniF;86|) - (LETT |r| (CDR |#G106|) - |DFLOAT;rationalApproximation;$2NniF;86|) - |#G106| - (LETT |p2| - (+ (* |q| |p1|) |p0|) - |DFLOAT;rationalApproximation;$2NniF;86|) - (LETT |q2| - (+ (* |q| |q1|) |q0|) - |DFLOAT;rationalApproximation;$2NniF;86|) - (EXIT - (COND - ((OR (ZEROP |r|) - (< - (SPADCALL |tol| - (ABS - (- (* |nu| |q2|) - (* |de| |p2|))) - (|shellEntry| $ - 143)) - (* |de| (ABS |p2|)))) - (RETURN-FROM - |DFLOAT;rationalApproximation;$2NniF;86| - (SPADCALL |p2| |q2| - (|shellEntry| $ - 141)))) - (T - (SEQ - (LETT |#G107| |p1| - |DFLOAT;rationalApproximation;$2NniF;86|) - (LETT |#G108| |p2| - |DFLOAT;rationalApproximation;$2NniF;86|) - (SETQ |p0| |#G107|) - (SETQ |p1| |#G108|) - (LETT |#G109| |q1| - |DFLOAT;rationalApproximation;$2NniF;86|) - (LETT |#G110| |q2| - |DFLOAT;rationalApproximation;$2NniF;86|) - (SETQ |q0| |#G109|) - (SETQ |q1| |#G110|) - (EXIT - (PROGN - (LETT |#G111| |t| - |DFLOAT;rationalApproximation;$2NniF;86|) - (LETT |#G112| |r| - |DFLOAT;rationalApproximation;$2NniF;86|) - (SETQ |s| - |#G111|) - (SETQ |t| - |#G112|))))))))))))))))))))))))) - -(DEFUN |DFLOAT;**;$F$;87| (|x| |r| $) - (COND - ((ZEROP |x|) - (COND - ((SPADCALL |r| (|shellEntry| $ 145)) - (|error| "0**0 is undefined")) - ((SPADCALL |r| (|shellEntry| $ 146)) (|error| "division by 0")) - (T 0.0))) - ((OR (SPADCALL |r| (|shellEntry| $ 145)) (= |x| 1.0)) 1.0) - ((SPADCALL |r| (|shellEntry| $ 147)) |x|) - (T (LET ((|n| (SPADCALL |r| (|shellEntry| $ 148))) - (|d| (SPADCALL |r| (|shellEntry| $ 149)))) - (COND - ((MINUSP |x|) - (COND - ((ODDP |d|) - (COND - ((ODDP |n|) - (RETURN-FROM |DFLOAT;**;$F$;87| - (- (|DFLOAT;**;$F$;87| (- |x|) |r| $)))) - (T (RETURN-FROM |DFLOAT;**;$F$;87| - (|DFLOAT;**;$F$;87| (- |x|) |r| $))))) - (T (|error| "negative root")))) - ((EQL |d| 2) (EXPT (C-TO-R (SQRT |x|)) |n|)) - (T (C-TO-R (EXPT |x| - (/ (FLOAT |n| |$DoubleFloatMaximum|) - (FLOAT |d| |$DoubleFloatMaximum|)))))))))) - -(DEFUN |DoubleFloat| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((#0=#:G1556 (HGET |$ConstructorCache| '|DoubleFloat|))) - (COND - (#0# (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|DoubleFloat| - (LIST (CONS NIL - (CONS 1 (|DoubleFloat;|)))))) - (SETQ #0# T)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|DoubleFloat|)))))))) - -(DEFUN |DoubleFloat;| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((|dv$| '(|DoubleFloat|)) ($ (|newShell| 164)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|haddProp| |$ConstructorCache| '|DoubleFloat| NIL (CONS 1 $)) - (|stuffDomainSlots| $) - $)) - -(MAKEPROP '|DoubleFloat| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|OpenMathEncoding|) - (0 . |OMencodingXML|) (|String|) (|OpenMathDevice|) - (4 . |OMopenString|) (|Void|) (10 . |OMputObject|) - (|DoubleFloat|) |DFLOAT;convert;2$;75| (15 . |OMputFloat|) - (21 . |OMputEndObject|) (26 . |OMclose|) - |DFLOAT;OMwrite;$S;1| (|Boolean|) |DFLOAT;OMwrite;$BS;2| - |DFLOAT;OMwrite;Omd$V;3| |DFLOAT;OMwrite;Omd$BV;4| - (|PositiveInteger|) |DFLOAT;base;Pi;5| (|Integer|) - |DFLOAT;mantissa;$I;6| |DFLOAT;exponent;$I;7| - |DFLOAT;precision;Pi;8| (31 . =) (37 . *) - |DFLOAT;log2;2$;39| (43 . *) |DFLOAT;wholePart;$I;73| - |DFLOAT;bits;Pi;9| |DFLOAT;max;$;10| |DFLOAT;min;$;11| - (49 . +) (55 . |One|) (59 . -) |DFLOAT;order;$I;12| - (65 . |Zero|) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |DFLOAT;Zero;$;13|) $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |DFLOAT;One;$;14|) $)) - |DFLOAT;/;3$;64| |DFLOAT;exp1;$;15| |DFLOAT;pi;$;16| - (|OutputForm|) (69 . |outputForm|) |DFLOAT;coerce;$Of;17| - (|InputForm|) (74 . |convert|) |DFLOAT;convert;$If;18| - |DFLOAT;<;2$B;19| |DFLOAT;>;2$B;20| |DFLOAT;<=;2$B;21| - |DFLOAT;>=;2$B;22| |DFLOAT;-;2$;23| |DFLOAT;+;3$;24| - |DFLOAT;-;3$;25| |DFLOAT;*;3$;26| |DFLOAT;*;I2$;27| - |DFLOAT;max;3$;28| |DFLOAT;min;3$;29| |DFLOAT;=;2$B;30| - |DFLOAT;/;$I$;31| |DFLOAT;sqrt;2$;32| |DFLOAT;log10;2$;33| - |DFLOAT;**;$I$;34| |DFLOAT;**;3$;35| (79 . |coerce|) - |DFLOAT;exp;2$;37| |DFLOAT;log;2$;38| |DFLOAT;sin;2$;40| - |DFLOAT;cos;2$;41| |DFLOAT;tan;2$;42| |DFLOAT;cot;2$;43| - |DFLOAT;sec;2$;44| |DFLOAT;csc;2$;45| |DFLOAT;asin;2$;46| - |DFLOAT;acos;2$;47| |DFLOAT;atan;2$;48| - |DFLOAT;acsc;2$;49| |DFLOAT;acot;2$;50| - |DFLOAT;asec;2$;51| |DFLOAT;sinh;2$;52| - |DFLOAT;cosh;2$;53| |DFLOAT;tanh;2$;54| - |DFLOAT;csch;2$;55| |DFLOAT;coth;2$;56| - |DFLOAT;sech;2$;57| |DFLOAT;asinh;2$;58| - |DFLOAT;acosh;2$;59| |DFLOAT;atanh;2$;60| - |DFLOAT;acsch;2$;61| |DFLOAT;acoth;2$;62| - |DFLOAT;asech;2$;63| |DFLOAT;negative?;$B;65| - |DFLOAT;zero?;$B;66| |DFLOAT;one?;$B;67| (|SingleInteger|) - |DFLOAT;hash;$Si;68| (|Union| $ '"failed") - |DFLOAT;recip;$U;69| |DFLOAT;differentiate;2$;70| - (|DoubleFloatSpecialFunctions|) (84 . |Gamma|) - |DFLOAT;Gamma;2$;71| (89 . |Beta|) |DFLOAT;Beta;3$;72| - |DFLOAT;float;2IPi$;74| (|Float|) (95 . |convert|) - |DFLOAT;convert;$F;76| (|Fraction| 25) - (|NonNegativeInteger|) - |DFLOAT;rationalApproximation;$2NniF;86| - |DFLOAT;rationalApproximation;$NniF;77| |DFLOAT;abs;2$;84| - |DFLOAT;atan;3$;78| (100 . |One|) |DFLOAT;retract;$F;79| - (|Union| 114 '"failed") |DFLOAT;retractIfCan;$U;80| - |DFLOAT;retract;$I;81| (|Union| 25 '"failed") - |DFLOAT;retractIfCan;$U;82| |DFLOAT;sign;$I;83| (104 . *) - (110 . **) (116 . |Zero|) (120 . |Zero|) (124 . >=) - (130 . **) (136 . |coerce|) (141 . -) (146 . <) (152 . **) - (|Record| (|:| |quotient| $) (|:| |remainder| $)) - (158 . |divide|) (164 . =) (170 . /) (176 . |abs|) - (181 . *) (187 . <) (193 . |zero?|) (198 . |negative?|) - (203 . |one?|) (208 . |numer|) (213 . |denom|) - (218 . |odd?|) |DFLOAT;**;$F$;87| |DFLOAT;coerce;I$;36| - (|PatternMatchResult| 111 $) (|Pattern| 111) - (|Factored| $) (|List| $) (|Union| 156 '"failed") - (|Record| (|:| |coef1| $) (|:| |coef2| $) - (|:| |generator| $)) - (|Record| (|:| |coef1| $) (|:| |coef2| $)) - (|Union| 159 '"failed") - (|Record| (|:| |coef| 156) (|:| |generator| $)) - (|SparseUnivariatePolynomial| $) - (|Record| (|:| |unit| $) (|:| |canonical| $) - (|:| |associate| $))) - '#(~= 223 |zero?| 229 |wholePart| 234 |unitNormal| 239 - |unitCanonical| 244 |unit?| 249 |truncate| 254 |tanh| 259 - |tan| 264 |subtractIfCan| 269 |squareFreePart| 275 - |squareFree| 280 |sqrt| 285 |sizeLess?| 290 |sinh| 296 - |sin| 301 |sign| 306 |sech| 311 |sec| 316 |sample| 321 - |round| 325 |retractIfCan| 330 |retract| 340 |rem| 350 - |recip| 356 |rationalApproximation| 361 |quo| 374 - |principalIdeal| 380 |prime?| 385 |precision| 390 - |positive?| 394 |pi| 399 |patternMatch| 403 |order| 410 - |one?| 415 |nthRoot| 420 |norm| 426 |negative?| 431 - |multiEuclidean| 436 |min| 442 |max| 452 |mantissa| 462 - |log2| 467 |log10| 472 |log| 477 |lcm| 482 |latex| 493 - |inv| 498 |hash| 503 |gcdPolynomial| 508 |gcd| 514 - |fractionPart| 525 |floor| 530 |float| 535 |factor| 548 - |extendedEuclidean| 553 |exquo| 566 |expressIdealMember| - 572 |exponent| 578 |exp1| 583 |exp| 587 |euclideanSize| - 592 |divide| 597 |digits| 603 |differentiate| 607 |csch| - 618 |csc| 623 |coth| 628 |cot| 633 |cosh| 638 |cos| 643 - |convert| 648 |coerce| 668 |characteristic| 698 |ceiling| - 702 |bits| 707 |before?| 711 |base| 717 |atanh| 721 |atan| - 726 |associates?| 737 |asinh| 743 |asin| 748 |asech| 753 - |asec| 758 |acsch| 763 |acsc| 768 |acoth| 773 |acot| 778 - |acosh| 783 |acos| 788 |abs| 793 |Zero| 798 |One| 802 - |OMwrite| 806 |Gamma| 830 D 835 |Beta| 846 >= 852 > 858 = - 864 <= 870 < 876 / 882 - 894 + 905 ** 911 * 941) - '((|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 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&| NIL NIL |OrderedRing&| |Module&| - NIL NIL |Module&| NIL NIL |Ring&| NIL NIL NIL - NIL NIL NIL NIL |AbelianGroup&| NIL NIL NIL - NIL NIL |AbelianMonoid&| |Monoid&| NIL NIL NIL - NIL NIL NIL |AbelianSemiGroup&| |SemiGroup&| - NIL |DifferentialSpace&| |OrderedType&| - |SetCategory&| - |TranscendentalFunctionCategory&| - |DifferentialDomain&| |RetractableTo&| - |RetractableTo&| NIL |BasicType&| NIL - |ElementaryFunctionCategory&| NIL - |HyperbolicFunctionCategory&| - |ArcTrigonometricFunctionCategory&| - |TrigonometricFunctionCategory&| NIL NIL - |RadicalCategory&| NIL NIL NIL NIL NIL NIL - NIL) - (CONS '#((|FloatingPointSystem|) - (|RealNumberSystem|) (|Field|) - (|EuclideanDomain|) - (|PrincipalIdealDomain|) - (|UniqueFactorizationDomain|) - (|GcdDomain|) (|DivisionRing|) - (|IntegralDomain|) (|Algebra| 114) - (|Algebra| $$) (|DifferentialRing|) - (|CharacteristicZero|) (|OrderedRing|) - (|Module| 114) (|EntireRing|) - (|CommutativeRing|) (|Module| $$) - (|BiModule| 114 114) (|BiModule| $$ $$) - (|Ring|) (|OrderedAbelianGroup|) - (|RightModule| 114) (|LeftModule| 114) - (|LeftModule| $$) (|Rng|) - (|RightModule| $$) - (|OrderedCancellationAbelianMonoid|) - (|AbelianGroup|) - (|OrderedAbelianMonoid|) - (|CancellationAbelianMonoid|) - (|OrderedAbelianSemiGroup|) - (|LinearSet| 114) (|LinearSet| $$) - (|AbelianMonoid|) (|Monoid|) - (|PatternMatchable| 111) (|OrderedSet|) - (|LeftLinearSet| 114) - (|RightLinearSet| 114) - (|LeftLinearSet| $$) - (|RightLinearSet| $$) - (|AbelianSemiGroup|) (|SemiGroup|) - (|LeftLinearSet| 25) - (|DifferentialSpace|) (|OrderedType|) - (|SetCategory|) - (|TranscendentalFunctionCategory|) - (|DifferentialDomain| $$) - (|RetractableTo| 114) - (|RetractableTo| 25) (|RealConstant|) - (|BasicType|) (|ConvertibleTo| 50) - (|ElementaryFunctionCategory|) - (|ArcHyperbolicFunctionCategory|) - (|HyperbolicFunctionCategory|) - (|ArcTrigonometricFunctionCategory|) - (|TrigonometricFunctionCategory|) - (|OpenMath|) (|ConvertibleTo| 154) - (|RadicalCategory|) - (|ConvertibleTo| 111) - (|ConvertibleTo| 13) - (|CoercibleFrom| 114) - (|CoercibleFrom| $$) - (|CoercibleFrom| 25) (|Type|) - (|CoercibleTo| 47)) - (|makeByteWordVec2| 163 - '(0 6 0 7 2 9 0 8 6 10 1 9 11 0 12 2 9 - 11 0 13 15 1 9 11 0 16 1 9 11 0 17 2 - 23 19 0 0 29 2 23 0 23 0 30 2 0 0 23 - 0 32 2 25 0 0 0 37 0 25 0 38 2 25 0 0 - 0 39 0 25 0 41 1 47 0 13 48 1 50 0 13 - 51 1 0 0 25 70 1 105 13 13 106 2 105 - 13 13 13 108 1 111 0 13 112 0 23 0 - 120 2 25 0 25 0 128 2 25 0 0 115 129 - 0 114 0 130 0 115 0 131 2 25 19 0 0 - 132 2 23 0 0 115 133 1 114 0 25 134 1 - 25 0 0 135 2 115 19 0 0 136 2 115 0 0 - 115 137 2 25 138 0 0 139 2 25 19 0 0 - 140 2 114 0 25 25 141 1 25 0 0 142 2 - 25 0 115 0 143 2 25 19 0 0 144 1 114 - 19 0 145 1 114 19 0 146 1 114 19 0 - 147 1 114 25 0 148 1 114 25 0 149 1 - 25 19 0 150 2 0 19 0 0 1 1 0 19 0 98 - 1 0 25 0 33 1 0 163 0 1 1 0 0 0 1 1 0 - 19 0 1 1 0 0 0 1 1 0 0 0 87 1 0 0 0 - 75 2 0 102 0 0 1 1 0 0 0 1 1 0 155 0 - 1 1 0 0 0 66 2 0 19 0 0 1 1 0 0 0 85 - 1 0 0 0 73 1 0 25 0 127 1 0 0 0 90 1 - 0 0 0 77 0 0 0 1 1 0 0 0 1 1 0 122 0 - 123 1 0 125 0 126 1 0 114 0 121 1 0 - 25 0 124 2 0 0 0 0 1 1 0 102 0 103 2 - 0 114 0 115 117 3 0 114 0 115 115 116 - 2 0 0 0 0 1 1 0 161 156 1 1 0 19 0 1 - 0 0 23 28 1 0 19 0 1 0 0 0 46 3 0 153 - 0 154 153 1 1 0 25 0 40 1 0 19 0 99 2 - 0 0 0 25 1 1 0 0 0 1 1 0 19 0 97 2 0 - 157 156 0 1 0 0 0 36 2 0 0 0 0 63 0 0 - 0 35 2 0 0 0 0 62 1 0 25 0 26 1 0 0 0 - 31 1 0 0 0 67 1 0 0 0 72 1 0 0 156 1 - 2 0 0 0 0 1 1 0 8 0 1 1 0 0 0 1 1 0 - 100 0 101 2 0 162 162 162 1 1 0 0 156 - 1 2 0 0 0 0 1 1 0 0 0 1 1 0 0 0 1 3 0 - 0 25 25 23 110 2 0 0 25 25 1 1 0 155 - 0 1 2 0 158 0 0 1 3 0 160 0 0 0 1 2 0 - 102 0 0 1 2 0 157 156 0 1 1 0 25 0 27 - 0 0 0 45 1 0 0 0 71 1 0 115 0 1 2 0 - 138 0 0 1 0 0 23 1 2 0 0 0 115 1 1 0 - 0 0 104 1 0 0 0 88 1 0 0 0 78 1 0 0 0 - 89 1 0 0 0 76 1 0 0 0 86 1 0 0 0 74 1 - 0 50 0 52 1 0 154 0 1 1 0 111 0 113 1 - 0 13 0 14 1 0 0 114 1 1 0 0 25 152 1 - 0 0 114 1 1 0 0 0 1 1 0 0 25 152 1 0 - 47 0 49 0 0 115 1 1 0 0 0 1 0 0 23 34 - 2 0 19 0 0 1 0 0 23 24 1 0 0 0 93 2 0 - 0 0 0 119 1 0 0 0 81 2 0 19 0 0 1 1 0 - 0 0 91 1 0 0 0 79 1 0 0 0 96 1 0 0 0 - 84 1 0 0 0 94 1 0 0 0 82 1 0 0 0 95 1 - 0 0 0 83 1 0 0 0 92 1 0 0 0 80 1 0 0 - 0 118 0 0 0 42 0 0 0 43 2 0 11 9 0 21 - 3 0 11 9 0 19 22 1 0 8 0 18 2 0 8 0 - 19 20 1 0 0 0 107 2 0 0 0 115 1 1 0 0 - 0 1 2 0 0 0 0 109 2 0 19 0 0 56 2 0 - 19 0 0 54 2 0 19 0 0 64 2 0 19 0 0 55 - 2 0 19 0 0 53 2 0 0 0 25 65 2 0 0 0 0 - 44 2 0 0 0 0 59 1 0 0 0 57 2 0 0 0 0 - 58 2 0 0 0 0 69 2 0 0 0 114 151 2 0 0 - 0 25 68 2 0 0 0 115 1 2 0 0 0 23 1 2 - 0 0 114 0 1 2 0 0 0 114 1 2 0 0 0 0 - 60 2 0 0 25 0 61 2 0 0 115 0 1 2 0 0 - 23 0 32))))) - '|lookupComplete|)) - -(MAKEPROP '|DoubleFloat| 'NILADIC T) diff --git a/src/algebra/strap/DIFRING.lsp b/src/algebra/strap/DIFRING.lsp deleted file mode 100644 index b9b784d8..00000000 --- a/src/algebra/strap/DIFRING.lsp +++ /dev/null @@ -1,16 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |DifferentialRing;AL| 'NIL) - -(DEFUN |DifferentialRing;| () - (LET ((#0=#:G1372 (|Join| (|Ring|) (|DifferentialSpace|)))) - (SETF (|shellEntry| #0# 0) '(|DifferentialRing|)) - #0#)) - -(DEFUN |DifferentialRing| () - (COND - (|DifferentialRing;AL|) - (T (SETQ |DifferentialRing;AL| (|DifferentialRing;|))))) - -(MAKEPROP '|DifferentialRing| 'NILADIC T) diff --git a/src/algebra/strap/DIVRING-.lsp b/src/algebra/strap/DIVRING-.lsp deleted file mode 100644 index 8f00ceb9..00000000 --- a/src/algebra/strap/DIVRING-.lsp +++ /dev/null @@ -1,58 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Thing|) - |DIVRING-;**;SIS;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |DIVRING-;*;F2S;2|)) - -(DEFUN |DIVRING-;**;SIS;1| (|x| |n| $) - (COND - ((ZEROP |n|) (|spadConstant| $ 10)) - ((SPADCALL |x| (|shellEntry| $ 11)) - (COND ((MINUSP |n|) (|error| "division by zero")) (T |x|))) - ((MINUSP |n|) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 15)) (- |n|) - (|shellEntry| $ 19))) - (T (SPADCALL |x| |n| (|shellEntry| $ 19))))) - -(DEFUN |DIVRING-;*;F2S;2| (|q| |x| $) - (SPADCALL - (SPADCALL (SPADCALL |q| (|shellEntry| $ 22)) - (SPADCALL - (SPADCALL (SPADCALL |q| (|shellEntry| $ 23)) - (|shellEntry| $ 24)) - (|shellEntry| $ 15)) - (|shellEntry| $ 25)) - |x| (|shellEntry| $ 26))) - -(DEFUN |DivisionRing&| (|#1|) - (LET* ((|dv$1| (|devaluate| |#1|)) - (|dv$| (LIST '|DivisionRing&| |dv$1|)) ($ (|newShell| 29)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - $)) - -(MAKEPROP '|DivisionRing&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Boolean|) - (|Integer|) (0 . |zero?|) (5 . |One|) (9 . |zero?|) - (14 . |Zero|) (18 . |Zero|) (22 . <) (28 . |inv|) (33 . -) - (|PositiveInteger|) (|RepeatedSquaring| 6) (38 . |expt|) - |DIVRING-;**;SIS;1| (|Fraction| 8) (44 . |numer|) - (49 . |denom|) (54 . |coerce|) (59 . *) (65 . *) - |DIVRING-;*;F2S;2| (|NonNegativeInteger|)) - '#(** 71 * 77) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 27 - '(1 8 7 0 9 0 6 0 10 1 6 7 0 11 0 6 0 - 12 0 8 0 13 2 8 7 0 0 14 1 6 0 0 15 1 - 8 0 0 16 2 18 6 6 17 19 1 21 8 0 22 1 - 21 8 0 23 1 6 0 8 24 2 6 0 8 0 25 2 6 - 0 0 0 26 2 0 0 0 8 20 2 0 0 21 0 27))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/DIVRING.lsp b/src/algebra/strap/DIVRING.lsp deleted file mode 100644 index 13f9c32f..00000000 --- a/src/algebra/strap/DIVRING.lsp +++ /dev/null @@ -1,22 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |DivisionRing;AL| 'NIL) - -(DEFUN |DivisionRing;| () - (LET ((#0=#:G1375 - (|sublisV| (PAIR '(#1=#:G1374) '((|Fraction| (|Integer|)))) - (|Join| (|EntireRing|) (|Algebra| '#1#) - (|mkCategory| '|domain| - '(((** ($ $ (|Integer|))) T) - ((|inv| ($ $)) T)) - NIL '((|Integer|)) NIL))))) - (SETF (|shellEntry| #0# 0) '(|DivisionRing|)) - #0#)) - -(DEFUN |DivisionRing| () - (COND - (|DivisionRing;AL|) - (T (SETQ |DivisionRing;AL| (|DivisionRing;|))))) - -(MAKEPROP '|DivisionRing| 'NILADIC T) diff --git a/src/algebra/strap/ENTIRER.lsp b/src/algebra/strap/ENTIRER.lsp deleted file mode 100644 index fa02fa3d..00000000 --- a/src/algebra/strap/ENTIRER.lsp +++ /dev/null @@ -1,17 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |EntireRing;AL| 'NIL) - -(DEFUN |EntireRing;| () - (LET ((#0=#:G1372 - (|Join| (|Ring|) (|BiModule| '$ '$) - (|mkCategory| '|package| NIL - '((|noZeroDivisors| T)) 'NIL NIL)))) - (SETF (|shellEntry| #0# 0) '(|EntireRing|)) - #0#)) - -(DEFUN |EntireRing| () - (COND (|EntireRing;AL|) (T (SETQ |EntireRing;AL| (|EntireRing;|))))) - -(MAKEPROP '|EntireRing| 'NILADIC T) diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp deleted file mode 100644 index 2df9a4ab..00000000 --- a/src/algebra/strap/EUCDOM-.lsp +++ /dev/null @@ -1,385 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |EUCDOM-;sizeLess?;2SB;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |EUCDOM-;quo;3S;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |EUCDOM-;rem;3S;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Pair|) - |EUCDOM-;exquo;2SU;4|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |EUCDOM-;gcd;3S;5|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell| |%Shell|) |%Shell|) - |EUCDOM-;unitNormalizeIdealElt|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Shell|) - |EUCDOM-;extendedEuclidean;2SR;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Pair|) - |EUCDOM-;extendedEuclidean;3SU;8|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Pair|) - |EUCDOM-;principalIdeal;LR;9|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%Pair|) - |EUCDOM-;expressIdealMember;LSU;10|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%Pair|) - |EUCDOM-;multiEuclidean;LSU;11|)) - -(DEFUN |EUCDOM-;sizeLess?;2SB;1| (|x| |y| $) - (AND (NOT (SPADCALL |y| (|shellEntry| $ 8))) - (OR (SPADCALL |x| (|shellEntry| $ 8)) - (< (SPADCALL |x| (|shellEntry| $ 12)) - (SPADCALL |y| (|shellEntry| $ 12)))))) - -(DEFUN |EUCDOM-;quo;3S;2| (|x| |y| $) - (CAR (SPADCALL |x| |y| (|shellEntry| $ 16)))) - -(DEFUN |EUCDOM-;rem;3S;3| (|x| |y| $) - (CDR (SPADCALL |x| |y| (|shellEntry| $ 16)))) - -(DEFUN |EUCDOM-;exquo;2SU;4| (|x| |y| $) - (COND - ((SPADCALL |x| (|shellEntry| $ 8)) (CONS 0 (|spadConstant| $ 19))) - ((SPADCALL |y| (|shellEntry| $ 8)) (CONS 1 "failed")) - (T (LET ((|qr| (SPADCALL |x| |y| (|shellEntry| $ 16)))) - (COND - ((SPADCALL (CDR |qr|) (|shellEntry| $ 8)) - (CONS 0 (CAR |qr|))) - (T (CONS 1 "failed"))))))) - -(DEFUN |EUCDOM-;gcd;3S;5| (|x| |y| $) - (PROG (|#G13| |#G14|) - (RETURN - (SEQ (SETQ |x| (SPADCALL |x| (|shellEntry| $ 22))) - (SETQ |y| (SPADCALL |y| (|shellEntry| $ 22))) - (LOOP - (COND - ((NOT (NOT (SPADCALL |y| (|shellEntry| $ 8)))) - (RETURN NIL)) - (T (SEQ (LETT |#G13| |y| |EUCDOM-;gcd;3S;5|) - (LETT |#G14| - (SPADCALL |x| |y| (|shellEntry| $ 24)) - |EUCDOM-;gcd;3S;5|) - (SETQ |x| |#G13|) (SETQ |y| |#G14|) - (EXIT (SETQ |y| - (SPADCALL |y| (|shellEntry| $ 22)))))))) - (EXIT |x|))))) - -(DEFUN |EUCDOM-;unitNormalizeIdealElt| (|s| $) - (LET* ((|#G16| (SPADCALL (SVREF |s| 2) (|shellEntry| $ 27))) - (|u| (SVREF |#G16| 0)) (|c| (SVREF |#G16| 1)) - (|a| (SVREF |#G16| 2))) - (SEQ |#G16| - (EXIT (COND - ((SPADCALL |a| (|shellEntry| $ 28)) |s|) - (T (VECTOR (SPADCALL |a| (SVREF |s| 0) - (|shellEntry| $ 29)) - (SPADCALL |a| (SVREF |s| 1) - (|shellEntry| $ 29)) - |c|))))))) - -(DEFUN |EUCDOM-;extendedEuclidean;2SR;7| (|x| |y| $) - (PROG (|qr| |s3|) - (RETURN - (LET ((|s1| (|EUCDOM-;unitNormalizeIdealElt| - (VECTOR (|spadConstant| $ 30) - (|spadConstant| $ 19) |x|) - $)) - (|s2| (|EUCDOM-;unitNormalizeIdealElt| - (VECTOR (|spadConstant| $ 19) - (|spadConstant| $ 30) |y|) - $))) - (COND - ((SPADCALL |y| (|shellEntry| $ 8)) |s1|) - ((SPADCALL |x| (|shellEntry| $ 8)) |s2|) - (T (SEQ (LOOP - (COND - ((NOT (NOT (SPADCALL (SVREF |s2| 2) - (|shellEntry| $ 8)))) - (RETURN NIL)) - (T (SEQ (LETT |qr| - (SPADCALL (SVREF |s1| 2) - (SVREF |s2| 2) - (|shellEntry| $ 16)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (LETT |s3| - (VECTOR - (SPADCALL (SVREF |s1| 0) - (SPADCALL (CAR |qr|) - (SVREF |s2| 0) - (|shellEntry| $ 29)) - (|shellEntry| $ 31)) - (SPADCALL (SVREF |s1| 1) - (SPADCALL (CAR |qr|) - (SVREF |s2| 1) - (|shellEntry| $ 29)) - (|shellEntry| $ 31)) - (CDR |qr|)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (SETQ |s1| |s2|) - (EXIT (SETQ |s2| - (|EUCDOM-;unitNormalizeIdealElt| - |s3| $))))))) - (COND - ((AND (NOT (SPADCALL (SVREF |s1| 0) - (|shellEntry| $ 8))) - (NOT (SPADCALL (SVREF |s1| 0) |y| - (|shellEntry| $ 32)))) - (SEQ (SETQ |qr| - (SPADCALL (SVREF |s1| 0) |y| - (|shellEntry| $ 16))) - (SETF (SVREF |s1| 0) (CDR |qr|)) - (SETF (SVREF |s1| 1) - (SPADCALL (SVREF |s1| 1) - (SPADCALL (CAR |qr|) |x| - (|shellEntry| $ 29)) - (|shellEntry| $ 33))) - (EXIT (SETQ |s1| - (|EUCDOM-;unitNormalizeIdealElt| - |s1| $)))))) - (EXIT |s1|)))))))) - -(DEFUN |EUCDOM-;extendedEuclidean;3SU;8| (|x| |y| |z| $) - (PROG (|qr|) - (RETURN - (COND - ((SPADCALL |z| (|shellEntry| $ 8)) - (CONS 0 (CONS (|spadConstant| $ 19) (|spadConstant| $ 19)))) - (T (LET* ((|s| (SPADCALL |x| |y| (|shellEntry| $ 36))) - (|w| (SPADCALL |z| (SVREF |s| 2) (|shellEntry| $ 37)))) - (COND - ((EQL (CAR |w|) 1) (CONS 1 "failed")) - ((SPADCALL |y| (|shellEntry| $ 8)) - (CONS 0 - (CONS (SPADCALL (SVREF |s| 0) (CDR |w|) - (|shellEntry| $ 29)) - (SPADCALL (SVREF |s| 1) (CDR |w|) - (|shellEntry| $ 29))))) - (T (SEQ (LETT |qr| - (SPADCALL - (SPADCALL (SVREF |s| 0) (CDR |w|) - (|shellEntry| $ 29)) - |y| (|shellEntry| $ 16)) - |EUCDOM-;extendedEuclidean;3SU;8|) - (EXIT (CONS 0 - (CONS (CDR |qr|) - (SPADCALL - (SPADCALL (SVREF |s| 1) (CDR |w|) - (|shellEntry| $ 29)) - (SPADCALL (CAR |qr|) |x| - (|shellEntry| $ 29)) - (|shellEntry| $ 33)))))))))))))) - -(DEFUN |EUCDOM-;principalIdeal;LR;9| (|l| $) - (COND - ((SPADCALL |l| NIL (|shellEntry| $ 42)) - (|error| "empty list passed to principalIdeal")) - ((SPADCALL (CDR |l|) NIL (|shellEntry| $ 42)) - (LET ((|uca| (SPADCALL (|SPADfirst| |l|) (|shellEntry| $ 27)))) - (CONS (LIST (SVREF |uca| 0)) (SVREF |uca| 1)))) - ((SPADCALL (CDR (CDR |l|)) NIL (|shellEntry| $ 42)) - (LET ((|u| (SPADCALL (|SPADfirst| |l|) - (SPADCALL |l| (|shellEntry| $ 45)) - (|shellEntry| $ 36)))) - (CONS (LIST (SVREF |u| 0) (SVREF |u| 1)) (SVREF |u| 2)))) - (T (LET* ((|v| (SPADCALL (CDR |l|) (|shellEntry| $ 48))) - (|u| (SPADCALL (|SPADfirst| |l|) (CDR |v|) - (|shellEntry| $ 36)))) - (CONS (CONS (SVREF |u| 0) - (LET ((#0=#:G1494 (CAR |v|)) (#1=#:G1493 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|vv| (CAR #0#))) - (SETQ #1# - (CONS - (SPADCALL (SVREF |u| 1) |vv| - (|shellEntry| $ 29)) - #1#))))) - (SETQ #0# (CDR #0#))))) - (SVREF |u| 2)))))) - -(DEFUN |EUCDOM-;expressIdealMember;LSU;10| (|l| |z| $) - (COND - ((SPADCALL |z| (|spadConstant| $ 19) (|shellEntry| $ 51)) - (CONS 0 - (LET ((#0=#:G1496 |l|) (#1=#:G1495 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|v| (CAR #0#))) - (SETQ #1# (CONS (|spadConstant| $ 19) #1#))))) - (SETQ #0# (CDR #0#)))))) - (T (LET* ((|pid| (SPADCALL |l| (|shellEntry| $ 48))) - (|q| (SPADCALL |z| (CDR |pid|) (|shellEntry| $ 37)))) - (COND - ((EQL (CAR |q|) 1) (CONS 1 "failed")) - (T (CONS 0 - (LET ((#2=#:G1498 (CAR |pid|)) (#3=#:G1497 NIL)) - (LOOP - (COND - ((ATOM #2#) (RETURN (NREVERSE #3#))) - (T (LET ((|v| (CAR #2#))) - (SETQ #3# - (CONS - (SPADCALL (CDR |q|) |v| - (|shellEntry| $ 29)) - #3#))))) - (SETQ #2# (CDR #2#))))))))))) - -(DEFUN |EUCDOM-;multiEuclidean;LSU;11| (|l| |z| $) - (PROG (|l1| |l2| |u| |v1| |v2|) - (RETURN - (LET ((|n| (LIST-LENGTH |l|))) - (COND - ((ZEROP |n|) (|error| "empty list passed to multiEuclidean")) - ((EQL |n| 1) (CONS 0 (LIST |z|))) - (T (SEQ (LETT |l1| (SPADCALL |l| (|shellEntry| $ 58)) - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT |l2| - (SPADCALL |l1| (TRUNCATE |n| 2) - (|shellEntry| $ 61)) - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT |u| - (SPADCALL - (LET ((#0=#:G1479 NIL) (#1=#:G1480 T) - (#2=#:G1499 |l1|)) - (LOOP - (COND - ((ATOM #2#) - (RETURN - (COND - (#1# (|spadConstant| $ 30)) - (T #0#)))) - (T (LET ((#3=#:G1372 (CAR #2#))) - (LET ((#4=#:G1478 #3#)) - (COND - (#1# (SETQ #0# #4#)) - (T - (SETQ #0# - (SPADCALL #0# #4# - (|shellEntry| $ 29))))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#)))) - (LET ((#5=#:G1482 NIL) (#6=#:G1483 T) - (#7=#:G1500 |l2|)) - (LOOP - (COND - ((ATOM #7#) - (RETURN - (COND - (#6# (|spadConstant| $ 30)) - (T #5#)))) - (T (LET ((#8=#:G1373 (CAR #7#))) - (LET ((#9=#:G1481 #8#)) - (COND - (#6# (SETQ #5# #9#)) - (T - (SETQ #5# - (SPADCALL #5# #9# - (|shellEntry| $ 29))))) - (SETQ #6# NIL))))) - (SETQ #7# (CDR #7#)))) - |z| (|shellEntry| $ 62)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT (COND - ((EQL (CAR |u|) 1) (CONS 1 "failed")) - (T (SEQ (LETT |v1| - (SPADCALL |l1| (CDR (CDR |u|)) - (|shellEntry| $ 63)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT (COND - ((EQL (CAR |v1|) 1) - (CONS 1 "failed")) - (T - (SEQ - (LETT |v2| - (SPADCALL |l2| - (CAR (CDR |u|)) - (|shellEntry| $ 63)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT - (COND - ((EQL (CAR |v2|) 1) - (CONS 1 "failed")) - (T - (CONS 0 - (SPADCALL (CDR |v1|) - (CDR |v2|) - (|shellEntry| $ 64))))))))))))))))))))) - -(DEFUN |EuclideanDomain&| (|#1|) - (LET* ((|dv$1| (|devaluate| |#1|)) - (|dv$| (LIST '|EuclideanDomain&| |dv$1|)) ($ (|newShell| 66)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - $)) - -(MAKEPROP '|EuclideanDomain&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Boolean|) - (0 . |zero?|) (5 . |false|) (9 . |true|) - (|NonNegativeInteger|) (13 . |euclideanSize|) (18 . <) - |EUCDOM-;sizeLess?;2SB;1| - (|Record| (|:| |quotient| $) (|:| |remainder| $)) - (24 . |divide|) |EUCDOM-;quo;3S;2| |EUCDOM-;rem;3S;3| - (30 . |Zero|) (|Union| $ '"failed") |EUCDOM-;exquo;2SU;4| - (34 . |unitCanonical|) (39 . |not|) (44 . |rem|) - |EUCDOM-;gcd;3S;5| - (|Record| (|:| |unit| $) (|:| |canonical| $) - (|:| |associate| $)) - (50 . |unitNormal|) (55 . |one?|) (60 . *) (66 . |One|) - (70 . -) (76 . |sizeLess?|) (82 . +) - (|Record| (|:| |coef1| $) (|:| |coef2| $) - (|:| |generator| $)) - |EUCDOM-;extendedEuclidean;2SR;7| - (88 . |extendedEuclidean|) (94 . |exquo|) - (|Record| (|:| |coef1| $) (|:| |coef2| $)) - (|Union| 38 '"failed") |EUCDOM-;extendedEuclidean;3SU;8| - (|List| 6) (100 . =) (106 . |rest|) (111 . |first|) - (116 . |second|) (|List| $) - (|Record| (|:| |coef| 46) (|:| |generator| $)) - (121 . |principalIdeal|) (126 . |cons|) - |EUCDOM-;principalIdeal;LR;9| (132 . =) - (|Union| 46 '"failed") |EUCDOM-;expressIdealMember;LSU;10| - (138 . |#|) (143 . |zero?|) (148 . |One|) (152 . =) - (158 . |copy|) (163 . |quo|) (|Integer|) (169 . |split!|) - (175 . |extendedEuclidean|) (182 . |multiEuclidean|) - (188 . |concat|) |EUCDOM-;multiEuclidean;LSU;11|) - '#(|sizeLess?| 194 |rem| 200 |quo| 206 |principalIdeal| 212 - |multiEuclidean| 217 |gcd| 223 |extendedEuclidean| 229 - |exquo| 242 |expressIdealMember| 248) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 65 - '(1 6 7 0 8 0 7 0 9 0 7 0 10 1 6 11 0 - 12 2 11 7 0 0 13 2 6 15 0 0 16 0 6 0 - 19 1 6 0 0 22 1 7 0 0 23 2 6 0 0 0 24 - 1 6 26 0 27 1 6 7 0 28 2 6 0 0 0 29 0 - 6 0 30 2 6 0 0 0 31 2 6 7 0 0 32 2 6 - 0 0 0 33 2 6 34 0 0 36 2 6 20 0 0 37 - 2 41 7 0 0 42 1 41 0 0 43 1 41 6 0 44 - 1 41 6 0 45 1 6 47 46 48 2 41 0 6 0 - 49 2 6 7 0 0 51 1 41 11 0 54 1 11 7 0 - 55 0 11 0 56 2 11 7 0 0 57 1 41 0 0 - 58 2 11 0 0 0 59 2 41 0 0 60 61 3 6 - 39 0 0 0 62 2 6 52 46 0 63 2 41 0 0 0 - 64 2 0 7 0 0 14 2 0 0 0 0 18 2 0 0 0 - 0 17 1 0 47 46 50 2 0 52 46 0 65 2 0 - 0 0 0 25 3 0 39 0 0 0 40 2 0 34 0 0 - 35 2 0 20 0 0 21 2 0 52 46 0 53))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/EUCDOM.lsp b/src/algebra/strap/EUCDOM.lsp deleted file mode 100644 index 8a9e63ef..00000000 --- a/src/algebra/strap/EUCDOM.lsp +++ /dev/null @@ -1,47 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |EuclideanDomain;AL| 'NIL) - -(DEFUN |EuclideanDomain;| () - (LET ((#0=#:G1389 - (|Join| (|PrincipalIdealDomain|) - (|mkCategory| '|domain| - '(((|sizeLess?| ((|Boolean|) $ $)) T) - ((|euclideanSize| ((|NonNegativeInteger|) $)) - T) - ((|divide| - ((|Record| (|:| |quotient| $) - (|:| |remainder| $)) - $ $)) - T) - ((|quo| ($ $ $)) T) ((|rem| ($ $ $)) T) - ((|extendedEuclidean| - ((|Record| (|:| |coef1| $) - (|:| |coef2| $) - (|:| |generator| $)) - $ $)) - T) - ((|extendedEuclidean| - ((|Union| (|Record| (|:| |coef1| $) - (|:| |coef2| $)) - "failed") - $ $ $)) - T) - ((|multiEuclidean| - ((|Union| (|List| $) "failed") - (|List| $) $)) - T)) - NIL - '((|List| $) (|NonNegativeInteger|) - (|Boolean|)) - NIL)))) - (SETF (|shellEntry| #0# 0) '(|EuclideanDomain|)) - #0#)) - -(DEFUN |EuclideanDomain| () - (COND - (|EuclideanDomain;AL|) - (T (SETQ |EuclideanDomain;AL| (|EuclideanDomain;|))))) - -(MAKEPROP '|EuclideanDomain| 'NILADIC T) diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp deleted file mode 100644 index 81b79b54..00000000 --- a/src/algebra/strap/FFIELDC-.lsp +++ /dev/null @@ -1,554 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |FFIELDC-;differentiate;2S;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |FFIELDC-;init;S;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |FFIELDC-;nextItem;SU;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |FFIELDC-;order;SOpc;4|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |FFIELDC-;conditionP;MU;5|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |FFIELDC-;charthRoot;2S;6|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |FFIELDC-;charthRoot;SU;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) - |FFIELDC-;createPrimitiveElement;S;8|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |FFIELDC-;primitive?;SB;9|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 1)) - |FFIELDC-;order;SPi;10|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0)) - |FFIELDC-;discreteLog;SNni;11|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Pair|) - |FFIELDC-;discreteLog;2SU;12|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |FFIELDC-;squareFreePolynomial|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |FFIELDC-;factorPolynomial|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |FFIELDC-;factorSquareFreePolynomial|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |FFIELDC-;gcdPolynomial;3Sup;16|)) - -(DEFUN |FFIELDC-;differentiate;2S;1| (|x| $) (|spadConstant| $ 7)) - -(DEFUN |FFIELDC-;init;S;2| ($) (|spadConstant| $ 7)) - -(DEFUN |FFIELDC-;nextItem;SU;3| (|a| $) - (COND - ((SPADCALL - (SETQ |a| - (SPADCALL (+ (SPADCALL |a| (|shellEntry| $ 11)) 1) - (|shellEntry| $ 14))) - (|shellEntry| $ 16)) - (CONS 1 "failed")) - (T (CONS 0 |a|)))) - -(DEFUN |FFIELDC-;order;SOpc;4| (|e| $) - (SPADCALL (SPADCALL |e| (|shellEntry| $ 19)) (|shellEntry| $ 22))) - -(DEFUN |FFIELDC-;conditionP;MU;5| (|mat| $) - (LET ((|l| (SPADCALL |mat| (|shellEntry| $ 27)))) - (SEQ (COND - ((OR (NULL |l|) - (SPADCALL (ELT $ 16) (|SPADfirst| |l|) - (|shellEntry| $ 31))) - (EXIT (CONS 1 "failed")))) - (EXIT (CONS 0 - (SPADCALL (ELT $ 32) (|SPADfirst| |l|) - (|shellEntry| $ 34))))))) - -(DEFUN |FFIELDC-;charthRoot;2S;6| (|x| $) - (SPADCALL |x| - (TRUNCATE (SPADCALL (|shellEntry| $ 40)) (|spadConstant| $ 41)) - (|shellEntry| $ 43))) - -(DEFUN |FFIELDC-;charthRoot;SU;7| (|x| $) - (CONS 0 (SPADCALL |x| (|shellEntry| $ 32)))) - -(DEFUN |FFIELDC-;createPrimitiveElement;S;8| ($) - (PROG (|e|) - (RETURN - (LET ((|sm1| (- (SPADCALL (|shellEntry| $ 40)) 1)) - (|start| (COND - ((SPADCALL (SPADCALL (|shellEntry| $ 48)) - (CONS 1 "polynomial") (|shellEntry| $ 49)) - (|spadConstant| $ 41)) - (T 1))) - (|found| NIL)) - (SEQ (LET ((|i| |start|)) - (LOOP - (COND - ((NOT (NOT |found|)) (RETURN NIL)) - (T (SEQ (LETT |e| - (SPADCALL - (|check-subtype| - (AND (NOT (MINUSP |i|)) - (PLUSP |i|)) - '(|PositiveInteger|) |i|) - (|shellEntry| $ 14)) - |FFIELDC-;createPrimitiveElement;S;8|) - (EXIT (SETQ |found| - (EQL - (SPADCALL |e| - (|shellEntry| $ 19)) - |sm1|)))))) - (SETQ |i| (+ |i| 1)))) - (EXIT |e|)))))) - -(DEFUN |FFIELDC-;primitive?;SB;9| (|a| $) - (PROG (|explist| |q| |equalone|) - (RETURN - (AND (NOT (SPADCALL |a| (|shellEntry| $ 16))) - (SEQ (LETT |explist| (SPADCALL (|shellEntry| $ 56)) - |FFIELDC-;primitive?;SB;9|) - (LETT |q| (- (SPADCALL (|shellEntry| $ 40)) 1) - |FFIELDC-;primitive?;SB;9|) - (LETT |equalone| NIL |FFIELDC-;primitive?;SB;9|) - (LET ((#0=#:G1488 |explist|) (|exp| NIL)) - (LOOP - (COND - ((OR (ATOM #0#) - (PROGN (SETQ |exp| (CAR #0#)) NIL) - (NOT (NOT |equalone|))) - (RETURN NIL)) - (T (SETQ |equalone| - (SPADCALL - (SPADCALL |a| - (TRUNCATE |q| (CAR |exp|)) - (|shellEntry| $ 58)) - (|shellEntry| $ 59))))) - (SETQ #0# (CDR #0#)))) - (EXIT (NOT |equalone|))))))) - -(DEFUN |FFIELDC-;order;SPi;10| (|e| $) - (PROG (|primeDivisor| |a| |goon|) - (RETURN - (COND - ((SPADCALL |e| (|spadConstant| $ 7) (|shellEntry| $ 63)) - (|error| "order(0) is not defined ")) - (T (LET ((|ord| (- (SPADCALL (|shellEntry| $ 40)) 1)) - (|lof| (SPADCALL (|shellEntry| $ 56)))) - (SEQ (LET ((#0=#:G1489 |lof|)) - (LOOP - (COND - ((ATOM #0#) (RETURN NIL)) - (T (LET ((|rec| (CAR #0#))) - (SEQ (LETT |a| - (TRUNCATE |ord| - (LETT |primeDivisor| - (CAR |rec|) - |FFIELDC-;order;SPi;10|)) - |FFIELDC-;order;SPi;10|) - (LETT |goon| - (SPADCALL - (SPADCALL |e| |a| - (|shellEntry| $ 58)) - (|shellEntry| $ 59)) - |FFIELDC-;order;SPi;10|) - (LET ((|j| 0) - (#1=#:G1490 (- (CDR |rec|) 2))) - (LOOP - (COND - ((OR (> |j| #1#) (NOT |goon|)) - (RETURN NIL)) - (T - (SEQ (SETQ |ord| |a|) - (SETQ |a| - (TRUNCATE |ord| - |primeDivisor|)) - (EXIT - (SETQ |goon| - (SPADCALL - (SPADCALL |e| |a| - (|shellEntry| $ 58)) - (|shellEntry| $ 59))))))) - (SETQ |j| (+ |j| 1)))) - (EXIT (COND - (|goon| (SETQ |ord| |a|)))))))) - (SETQ #0# (CDR #0#)))) - (EXIT |ord|)))))))) - -(DEFUN |FFIELDC-;discreteLog;SNni;11| (|b| $) - (PROG (|rho| |exptable| |n| |c| |end| |found| |disc1| |fac| |disclog| - |mult| |groupord| |exp|) - (RETURN - (COND - ((SPADCALL |b| (|shellEntry| $ 16)) - (|error| "discreteLog: logarithm of zero")) - (T (LET ((|faclist| (SPADCALL (|shellEntry| $ 56))) (|a| |b|) - (|gen| (SPADCALL (|shellEntry| $ 65)))) - (COND - ((SPADCALL |b| |gen| (|shellEntry| $ 63)) 1) - (T (SEQ (LETT |disclog| 0 - |FFIELDC-;discreteLog;SNni;11|) - (LETT |mult| 1 |FFIELDC-;discreteLog;SNni;11|) - (LETT |groupord| - (- (SPADCALL (|shellEntry| $ 40)) 1) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |exp| |groupord| - |FFIELDC-;discreteLog;SNni;11|) - (LET ((#0=#:G1491 |faclist|)) - (LOOP - (COND - ((ATOM #0#) (RETURN NIL)) - (T (LET ((|f| (CAR #0#))) - (SEQ (LETT |fac| (CAR |f|) - |FFIELDC-;discreteLog;SNni;11|) - (EXIT - (LET - ((|t| 0) - (#1=#:G1492 (- (CDR |f|) 1))) - (LOOP - (COND - ((> |t| #1#) - (RETURN NIL)) - (T - (SEQ - (SETQ |exp| - (TRUNCATE |exp| |fac|)) - (LETT |exptable| - (SPADCALL |fac| - (|shellEntry| $ 67)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |n| - (SPADCALL |exptable| - (|shellEntry| $ 68)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |c| - (SPADCALL |a| |exp| - (|shellEntry| $ 58)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |end| - (TRUNCATE (- |fac| 1) - |n|) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |found| NIL - |FFIELDC-;discreteLog;SNni;11|) - (LETT |disc1| 0 - |FFIELDC-;discreteLog;SNni;11|) - (LET ((|i| 0)) - (LOOP - (COND - ((OR - (> |i| |end|) - (NOT - (NOT |found|))) - (RETURN NIL)) - (T - (SEQ - (LETT |rho| - (SPADCALL - (SPADCALL |c| - (|shellEntry| - $ 11)) - |exptable| - (|shellEntry| - $ 71)) - |FFIELDC-;discreteLog;SNni;11|) - (EXIT - (COND - ((ZEROP - (CAR - |rho|)) - (SEQ - (SETQ - |found| - T) - (EXIT - (SETQ - |disc1| - (* - (+ - (* |n| - |i|) - (CDR - |rho|)) - |mult|))))) - (T - (SETQ |c| - (SPADCALL - |c| - (SPADCALL - |gen| - (* - (TRUNCATE - |groupord| - |fac|) - (- |n|)) - (|shellEntry| - $ 58)) - (|shellEntry| - $ 77))))))))) - (SETQ |i| - (+ |i| 1)))) - (EXIT - (COND - (|found| - (SEQ - (SETQ |mult| - (* |mult| |fac|)) - (SETQ |disclog| - (+ |disclog| - |disc1|)) - (EXIT - (SETQ |a| - (SPADCALL |a| - (SPADCALL |gen| - (- |disc1|) - (|shellEntry| - $ 58)) - (|shellEntry| $ - 77)))))) - (T - (|error| - "discreteLog: ?? discrete logarithm"))))))) - (SETQ |t| (+ |t| 1))))))))) - (SETQ #0# (CDR #0#)))) - (EXIT |disclog|)))))))))) - -(DEFUN |FFIELDC-;discreteLog;2SU;12| (|logbase| |b| $) - (PROG (|rhoHelp| |rho| |fac| |primroot| |groupord| |faclist| |a| - |disclog| |mult| |exp|) - (RETURN - (COND - ((SPADCALL |b| (|shellEntry| $ 16)) - (SEQ (SPADCALL "discreteLog: logarithm of zero" - (|shellEntry| $ 83)) - (EXIT (CONS 1 "failed")))) - ((SPADCALL |logbase| (|shellEntry| $ 16)) - (SEQ (SPADCALL "discreteLog: logarithm to base zero" - (|shellEntry| $ 83)) - (EXIT (CONS 1 "failed")))) - ((SPADCALL |b| |logbase| (|shellEntry| $ 63)) (CONS 0 1)) - (T (COND - ((NOT (ZEROP (REM (LETT |groupord| - (SPADCALL |logbase| - (|shellEntry| $ 19)) - |FFIELDC-;discreteLog;2SU;12|) - (SPADCALL |b| (|shellEntry| $ 19))))) - (SEQ (SPADCALL - "discreteLog: second argument not in cyclic group generated by first argument" - (|shellEntry| $ 83)) - (EXIT (CONS 1 "failed")))) - (T (SEQ (LETT |faclist| - (SPADCALL - (SPADCALL |groupord| - (|shellEntry| $ 87)) - (|shellEntry| $ 89)) - |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|) - (LET ((#0=#:G1493 |faclist|)) - (LOOP - (COND - ((ATOM #0#) (RETURN NIL)) - (T (LET ((|f| (CAR #0#))) - (SEQ (LETT |fac| (CAR |f|) - |FFIELDC-;discreteLog;2SU;12|) - (LETT |primroot| - (SPADCALL |logbase| - (TRUNCATE |groupord| |fac|) - (|shellEntry| $ 58)) - |FFIELDC-;discreteLog;2SU;12|) - (EXIT - (LET - ((|t| 0) - (#1=#:G1494 (- (CDR |f|) 1))) - (LOOP - (COND - ((> |t| #1#) (RETURN NIL)) - (T - (SEQ - (SETQ |exp| - (TRUNCATE |exp| |fac|)) - (LETT |rhoHelp| - (SPADCALL |primroot| - (SPADCALL |a| |exp| - (|shellEntry| $ 58)) - |fac| - (|shellEntry| $ 91)) - |FFIELDC-;discreteLog;2SU;12|) - (EXIT - (COND - ((EQL (CAR |rhoHelp|) - 1) - (RETURN-FROM - |FFIELDC-;discreteLog;2SU;12| - (CONS 1 "failed"))) - (T - (SEQ - (LETT |rho| - (SPADCALL - (CDR |rhoHelp|) - |mult| - (|shellEntry| $ - 92)) - |FFIELDC-;discreteLog;2SU;12|) - (SETQ |disclog| - (+ |disclog| |rho|)) - (SETQ |mult| - (* |mult| |fac|)) - (EXIT - (SETQ |a| - (SPADCALL |a| - (SPADCALL - |logbase| - (- |rho|) - (|shellEntry| $ - 58)) - (|shellEntry| $ - 77))))))))))) - (SETQ |t| (+ |t| 1))))))))) - (SETQ #0# (CDR #0#)))) - (EXIT (CONS 0 |disclog|)))))))))) - -(DEFUN |FFIELDC-;squareFreePolynomial| (|f| $) - (SPADCALL |f| (|shellEntry| $ 97))) - -(DEFUN |FFIELDC-;factorPolynomial| (|f| $) - (SPADCALL |f| (|shellEntry| $ 99))) - -(DEFUN |FFIELDC-;factorSquareFreePolynomial| (|f| $) - (COND - ((SPADCALL |f| (|spadConstant| $ 100) (|shellEntry| $ 101)) - (|spadConstant| $ 102)) - (T (LET ((|flist| (SPADCALL |f| T (|shellEntry| $ 106)))) - (SPADCALL (SPADCALL (CAR |flist|) (|shellEntry| $ 107)) - (LET ((#0=#:G1483 NIL) (#1=#:G1484 T) - (#2=#:G1495 (CDR |flist|))) - (LOOP - (COND - ((ATOM #2#) - (RETURN - (COND (#1# (|spadConstant| $ 110)) (T #0#)))) - (T (LET ((|u| (CAR #2#))) - (LET ((#3=#:G1482 - (SPADCALL (CAR |u|) (CDR |u|) - (|shellEntry| $ 108)))) - (COND - (#1# (SETQ #0# #3#)) - (T (SETQ #0# - (SPADCALL #0# #3# - (|shellEntry| $ 109))))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#)))) - (|shellEntry| $ 111)))))) - -(DEFUN |FFIELDC-;gcdPolynomial;3Sup;16| (|f| |g| $) - (SPADCALL |f| |g| (|shellEntry| $ 113))) - -(DEFUN |FiniteFieldCategory&| (|#1|) - (LET* ((|dv$1| (|devaluate| |#1|)) - (|dv$| (LIST '|FiniteFieldCategory&| |dv$1|)) - ($ (|newShell| 116)) (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 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 . |One|) (13 . +) - (19 . |index|) (|Boolean|) (24 . |zero?|) - (|Union| $ '"failed") |FFIELDC-;nextItem;SU;3| - (29 . |order|) (|Integer|) (|OnePointCompletion| 10) - (34 . |coerce|) |FFIELDC-;order;SOpc;4| (|Vector| 6) - (|List| 24) (|Matrix| 6) (39 . |nullSpace|) - (44 . |empty?|) (49 . |first|) (|Mapping| 15 6) - (54 . |every?|) (60 . |charthRoot|) (|Mapping| 6 6) - (65 . |map|) (|Vector| $) (|Union| 35 '"failed") - (|Matrix| $) |FFIELDC-;conditionP;MU;5| - (|NonNegativeInteger|) (71 . |size|) - (75 . |characteristic|) (79 . |quo|) (85 . **) - |FFIELDC-;charthRoot;2S;6| |FFIELDC-;charthRoot;SU;7| - (91 . -) - (|Union| '"prime" '"polynomial" '"normal" '"cyclic") - (97 . |representationType|) (101 . =) (107 . |false|) - (111 . |not|) (116 . =) - |FFIELDC-;createPrimitiveElement;S;8| - (|Record| (|:| |factor| 20) (|:| |exponent| 20)) - (|List| 54) (122 . |factorsOfCyclicGroupSize|) - (126 . |quo|) (132 . **) (138 . |one?|) - |FFIELDC-;primitive?;SB;9| (143 . |Zero|) (147 . |Zero|) - (151 . =) |FFIELDC-;order;SPi;10| - (157 . |primitiveElement|) (|Table| 10 39) - (161 . |tableForDiscreteLogarithm|) (166 . |#|) - (171 . |One|) (|Union| 39 '"failed") (175 . |search|) - (181 . |true|) (185 . *) (191 . +) (197 . *) (203 . -) - (208 . *) (214 . +) |FFIELDC-;discreteLog;SNni;11| - (|Void|) (|String|) (|OutputForm|) (220 . |messagePrint|) - (225 . |rem|) (231 . |zero?|) (|Factored| $) - (236 . |factor|) (|Factored| 20) (241 . |factors|) - (|DiscreteLogarithmPackage| 6) - (246 . |shanksDiscLogAlgorithm|) (253 . *) - |FFIELDC-;discreteLog;2SU;12| - (|SparseUnivariatePolynomial| 6) (|Factored| 94) - (|UnivariatePolynomialSquareFree| 6 94) - (259 . |squareFree|) (|DistinctDegreeFactorize| 6 94) - (264 . |factor|) (269 . |Zero|) (273 . =) (279 . |Zero|) - (|Record| (|:| |irr| 94) (|:| |pow| 20)) (|List| 103) - (|Record| (|:| |cont| 6) (|:| |factors| 104)) - (283 . |distdfact|) (289 . |coerce|) (294 . |primeFactor|) - (300 . *) (306 . |One|) (310 . *) (|EuclideanDomain&| 94) - (316 . |gcd|) (|SparseUnivariatePolynomial| $) - |FFIELDC-;gcdPolynomial;3Sup;16|) - '#(|primitive?| 322 |order| 327 |nextItem| 337 |init| 342 - |gcdPolynomial| 346 |discreteLog| 352 |differentiate| 363 - |createPrimitiveElement| 368 |conditionP| 372 |charthRoot| - 377) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 115 - '(0 6 0 7 1 6 10 0 11 0 10 0 12 2 10 0 - 0 0 13 1 6 0 10 14 1 6 15 0 16 1 6 10 - 0 19 1 21 0 20 22 1 26 25 0 27 1 25 - 15 0 28 1 25 24 0 29 2 24 15 30 0 31 - 1 6 0 0 32 2 24 0 33 0 34 0 6 39 40 0 - 6 39 41 2 39 0 0 0 42 2 6 0 0 39 43 2 - 20 0 0 0 46 0 6 47 48 2 47 15 0 0 49 - 0 15 0 50 1 15 0 0 51 2 10 15 0 0 52 - 0 6 55 56 2 20 0 0 0 57 2 6 0 0 20 58 - 1 6 15 0 59 0 39 0 61 0 20 0 62 2 6 - 15 0 0 63 0 6 0 65 1 6 66 20 67 1 66 - 39 0 68 0 39 0 69 2 66 70 10 0 71 0 - 15 0 72 2 39 0 39 0 73 2 39 0 0 0 74 - 2 20 0 20 0 75 1 20 0 0 76 2 6 0 0 0 - 77 2 20 0 0 0 78 1 82 80 81 83 2 39 0 - 0 0 84 1 39 15 0 85 1 20 86 0 87 1 88 - 55 0 89 3 90 70 6 6 39 91 2 20 0 39 0 - 92 1 96 95 94 97 1 98 95 94 99 0 94 0 - 100 2 94 15 0 0 101 0 95 0 102 2 98 - 105 94 15 106 1 94 0 6 107 2 95 0 94 - 20 108 2 95 0 0 0 109 0 95 0 110 2 95 - 0 94 0 111 2 112 0 0 0 113 1 0 15 0 - 60 1 0 10 0 64 1 0 21 0 23 1 0 17 0 - 18 0 0 0 9 2 0 114 114 114 115 1 0 39 - 0 79 2 0 70 0 0 93 1 0 0 0 8 0 0 0 53 - 1 0 36 37 38 1 0 0 0 44 1 0 17 0 45))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/FFIELDC.lsp b/src/algebra/strap/FFIELDC.lsp deleted file mode 100644 index e4904d9d..00000000 --- a/src/algebra/strap/FFIELDC.lsp +++ /dev/null @@ -1,54 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |FiniteFieldCategory;AL| 'NIL) - -(DEFUN |FiniteFieldCategory;| () - (LET ((#0=#:G1380 - (|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)))) - (SETF (|shellEntry| #0# 0) '(|FiniteFieldCategory|)) - #0#)) - -(DEFUN |FiniteFieldCategory| () - (COND - (|FiniteFieldCategory;AL|) - (T (SETQ |FiniteFieldCategory;AL| (|FiniteFieldCategory;|))))) - -(MAKEPROP '|FiniteFieldCategory| 'NILADIC T) diff --git a/src/algebra/strap/FPS-.lsp b/src/algebra/strap/FPS-.lsp deleted file mode 100644 index 430b15c9..00000000 --- a/src/algebra/strap/FPS-.lsp +++ /dev/null @@ -1,52 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Thing|) - |FPS-;float;2IS;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 1)) - |FPS-;digits;Pi;2|)) - -(DEFUN |FPS-;float;2IS;1| (|ma| |ex| $) - (SPADCALL |ma| |ex| (SPADCALL (|shellEntry| $ 8)) - (|shellEntry| $ 10))) - -(DEFUN |FPS-;digits;Pi;2| ($) - (LET ((#0=#:G1377 - (MAX 1 - (TRUNCATE - (SPADCALL 4004 - (- (SPADCALL (|shellEntry| $ 14)) 1) - (|shellEntry| $ 16)) - 13301)))) - (|check-subtype| (AND (NOT (MINUSP #0#)) (PLUSP #0#)) - '(|PositiveInteger|) #0#))) - -(DEFUN |FloatingPointSystem&| (|#1|) - (LET* ((|dv$1| (|devaluate| |#1|)) - (|dv$| (LIST '|FloatingPointSystem&| |dv$1|)) - ($ (|newShell| 20)) - (|pv$| (|buildPredVector| 0 0 - (LIST (|HasAttribute| |#1| '|arbitraryExponent|) - (|HasAttribute| |#1| '|arbitraryPrecision|))))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 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 . |One|) (19 . |bits|) (23 . -) (29 . *) - (35 . |quo|) (41 . |max|) |FPS-;digits;Pi;2|) - '#(|float| 47 |digits| 53) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 19 - '(0 6 7 8 3 6 0 9 9 7 10 0 6 0 12 0 7 0 - 13 0 6 7 14 2 9 0 0 0 15 2 9 0 7 0 16 - 2 9 0 0 0 17 2 9 0 0 0 18 2 0 0 9 9 - 11 0 0 7 19))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/FPS.lsp b/src/algebra/strap/FPS.lsp deleted file mode 100644 index 51f60a2b..00000000 --- a/src/algebra/strap/FPS.lsp +++ /dev/null @@ -1,60 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |FloatingPointSystem;AL| 'NIL) - -(DEFUN |FloatingPointSystem;| () - (LET ((#0=#:G1372 - (|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)))) - (SETF (|shellEntry| #0# 0) '(|FloatingPointSystem|)) - #0#)) - -(DEFUN |FloatingPointSystem| () - (COND - (|FloatingPointSystem;AL|) - (T (SETQ |FloatingPointSystem;AL| (|FloatingPointSystem;|))))) - -(MAKEPROP '|FloatingPointSystem| 'NILADIC T) diff --git a/src/algebra/strap/GCDDOM-.lsp b/src/algebra/strap/GCDDOM-.lsp deleted file mode 100644 index 5cc1e7f5..00000000 --- a/src/algebra/strap/GCDDOM-.lsp +++ /dev/null @@ -1,199 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |GCDDOM-;lcm;3S;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |GCDDOM-;lcm;LS;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |GCDDOM-;gcd;LS;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |GCDDOM-;gcdPolynomial;3Sup;4|)) - -(DEFUN |GCDDOM-;lcm;3S;1| (|x| |y| $) - (COND - ((OR (SPADCALL |y| (|spadConstant| $ 7) (|shellEntry| $ 9)) - (SPADCALL |x| (|spadConstant| $ 7) (|shellEntry| $ 9))) - (|spadConstant| $ 7)) - (T (LET ((LCM (SPADCALL |y| (SPADCALL |x| |y| (|shellEntry| $ 10)) - (|shellEntry| $ 12)))) - (COND - ((ZEROP (CAR LCM)) - (SPADCALL |x| (CDR LCM) (|shellEntry| $ 13))) - (T (|error| "bad gcd in lcm computation"))))))) - -(DEFUN |GCDDOM-;lcm;LS;2| (|l| $) - (SPADCALL (ELT $ 15) |l| (|spadConstant| $ 16) (|spadConstant| $ 7) - (|shellEntry| $ 19))) - -(DEFUN |GCDDOM-;gcd;LS;3| (|l| $) - (SPADCALL (ELT $ 10) |l| (|spadConstant| $ 7) (|spadConstant| $ 16) - (|shellEntry| $ 19))) - -(DEFUN |GCDDOM-;gcdPolynomial;3Sup;4| (|p1| |p2| $) - (PROG (|e1| |e2| |p|) - (RETURN - (COND - ((SPADCALL |p1| (|shellEntry| $ 24)) - (SPADCALL |p2| (|shellEntry| $ 25))) - ((SPADCALL |p2| (|shellEntry| $ 24)) - (SPADCALL |p1| (|shellEntry| $ 25))) - (T (LET ((|c1| (SPADCALL |p1| (|shellEntry| $ 26))) - (|c2| (SPADCALL |p2| (|shellEntry| $ 26)))) - (SEQ (SETQ |p1| - (LET ((#0=#:G1393 - (SPADCALL |p1| |c1| - (|shellEntry| $ 27)))) - (|check-union| (ZEROP (CAR #0#)) - (|SparseUnivariatePolynomial| - (SVREF $ 6)) - #0#) - (CDR #0#))) - (SETQ |p2| - (LET ((#0# (SPADCALL |p2| |c2| - (|shellEntry| $ 27)))) - (|check-union| (ZEROP (CAR #0#)) - (|SparseUnivariatePolynomial| - (SVREF $ 6)) - #0#) - (CDR #0#))) - (SEQ (LETT |e1| (SPADCALL |p1| (|shellEntry| $ 29)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((PLUSP |e1|) - (SETQ |p1| - (LET - ((#0# - (SPADCALL |p1| - (SPADCALL - (|spadConstant| $ 16) |e1| - (|shellEntry| $ 34)) - (|shellEntry| $ 35)))) - (|check-union| - (ZEROP (CAR #0#)) - (|SparseUnivariatePolynomial| - (SVREF $ 6)) - #0#) - (CDR #0#))))))) - (SEQ (LETT |e2| (SPADCALL |p2| (|shellEntry| $ 29)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((PLUSP |e2|) - (SETQ |p2| - (LET - ((#0# - (SPADCALL |p2| - (SPADCALL - (|spadConstant| $ 16) |e2| - (|shellEntry| $ 34)) - (|shellEntry| $ 35)))) - (|check-union| - (ZEROP (CAR #0#)) - (|SparseUnivariatePolynomial| - (SVREF $ 6)) - #0#) - (CDR #0#))))))) - (SETQ |e1| (MIN |e1| |e2|)) - (SETQ |c1| (SPADCALL |c1| |c2| (|shellEntry| $ 10))) - (SETQ |p1| - (COND - ((OR (ZEROP (SPADCALL |p1| - (|shellEntry| $ 37))) - (ZEROP (SPADCALL |p2| - (|shellEntry| $ 37)))) - (SPADCALL |c1| 0 (|shellEntry| $ 34))) - (T (SEQ (LETT |p| - (SPADCALL |p1| |p2| - (|shellEntry| $ 39)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((ZEROP - (SPADCALL |p| - (|shellEntry| $ 37))) - (SPADCALL |c1| 0 - (|shellEntry| $ 34))) - (T - (SEQ - (SETQ |c2| - (SPADCALL - (SPADCALL |p1| - (|shellEntry| $ 40)) - (SPADCALL |p2| - (|shellEntry| $ 40)) - (|shellEntry| $ 10))) - (EXIT - (SPADCALL - (SPADCALL |c1| - (SPADCALL - (LET - ((#0# - (SPADCALL - (SPADCALL |c2| |p| - (|shellEntry| $ - 41)) - (SPADCALL |p| - (|shellEntry| $ - 40)) - (|shellEntry| $ 27)))) - (|check-union| - (ZEROP (CAR #0#)) - (|SparseUnivariatePolynomial| - (SVREF $ 6)) - #0#) - (CDR #0#)) - (|shellEntry| $ 42)) - (|shellEntry| $ 41)) - (|shellEntry| $ 25))))))))))) - (EXIT (COND - ((ZEROP |e1|) |p1|) - (T (SPADCALL - (SPADCALL (|spadConstant| $ 16) |e1| - (|shellEntry| $ 34)) - |p1| (|shellEntry| $ 44)))))))))))) - -(DEFUN |GcdDomain&| (|#1|) - (LET* ((|dv$1| (|devaluate| |#1|)) - (|dv$| (LIST '|GcdDomain&| |dv$1|)) ($ (|newShell| 47)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 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 . |Zero|) (80 . >) (86 . |One|) - (90 . |monomial|) (96 . |exquo|) (102 . |min|) - (108 . |degree|) (113 . =) (119 . |subResultantGcd|) - (125 . |leadingCoefficient|) (130 . *) - (136 . |primitivePart|) (141 . |zero?|) (146 . *) - (|SparseUnivariatePolynomial| $) - |GCDDOM-;gcdPolynomial;3Sup;4|) - '#(|lcm| 152 |gcdPolynomial| 163 |gcd| 169) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 46 - '(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 28 0 31 2 - 28 8 0 0 32 0 23 0 33 2 23 0 6 28 34 - 2 23 11 0 0 35 2 28 0 0 0 36 1 23 28 - 0 37 2 28 8 0 0 38 2 23 0 0 0 39 1 23 - 6 0 40 2 23 0 6 0 41 1 23 0 0 42 1 28 - 8 0 43 2 23 0 0 0 44 1 0 0 20 21 2 0 - 0 0 0 14 2 0 45 45 45 46 1 0 0 20 22))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/GCDDOM.lsp b/src/algebra/strap/GCDDOM.lsp deleted file mode 100644 index 51447060..00000000 --- a/src/algebra/strap/GCDDOM.lsp +++ /dev/null @@ -1,28 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |GcdDomain;AL| 'NIL) - -(DEFUN |GcdDomain;| () - (LET ((#0=#:G1378 - (|Join| (|IntegralDomain|) - (|mkCategory| '|domain| - '(((|gcd| ($ $ $)) T) - ((|gcd| ($ (|List| $))) T) - ((|lcm| ($ $ $)) T) - ((|lcm| ($ (|List| $))) T) - ((|gcdPolynomial| - ((|SparseUnivariatePolynomial| $) - (|SparseUnivariatePolynomial| $) - (|SparseUnivariatePolynomial| $))) - T)) - NIL - '((|SparseUnivariatePolynomial| $) (|List| $)) - NIL)))) - (SETF (|shellEntry| #0# 0) '(|GcdDomain|)) - #0#)) - -(DEFUN |GcdDomain| () - (COND (|GcdDomain;AL|) (T (SETQ |GcdDomain;AL| (|GcdDomain;|))))) - -(MAKEPROP '|GcdDomain| 'NILADIC T) diff --git a/src/algebra/strap/HOAGG-.lsp b/src/algebra/strap/HOAGG-.lsp deleted file mode 100644 index e501fcf8..00000000 --- a/src/algebra/strap/HOAGG-.lsp +++ /dev/null @@ -1,227 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|) - |HOAGG-;eval;ALA;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0)) - |HOAGG-;#;ANni;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |HOAGG-;any?;MAB;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |HOAGG-;every?;MAB;4|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) - (|%IntegerSection| 0)) - |HOAGG-;count;MANni;5|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|) - |HOAGG-;members;AL;6|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |HOAGG-;=;2AB;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) - (|%IntegerSection| 0)) - |HOAGG-;count;SANni;8|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |HOAGG-;member?;SAB;9|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |HOAGG-;coerce;AOf;10|)) - -(DEFUN |HOAGG-;eval;ALA;1| (|u| |l| $) - (SPADCALL (CONS #'|HOAGG-;eval;ALA;1!0| (VECTOR $ |l|)) |u| - (|shellEntry| $ 12))) - -(DEFUN |HOAGG-;eval;ALA;1!0| (|#1| $$) - (SPADCALL |#1| (SVREF $$ 1) (|shellEntry| (SVREF $$ 0) 10))) - -(DEFUN |HOAGG-;#;ANni;2| (|c| $) - (LIST-LENGTH (SPADCALL |c| (|shellEntry| $ 15)))) - -(DEFUN |HOAGG-;any?;MAB;3| (|f| |c| $) - (LET ((#0=#:G1380 NIL) (#1=#:G1381 T) - (#2=#:G1403 (SPADCALL |c| (|shellEntry| $ 15)))) - (LOOP - (COND - ((ATOM #2#) (RETURN (AND (NOT #1#) #0#))) - (T (LET ((|x| (CAR #2#))) - (LET ((#3=#:G1379 (SPADCALL |x| |f|))) - (COND (#1# (SETQ #0# #3#)) (T (SETQ #0# (OR #0# #3#)))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#))))) - -(DEFUN |HOAGG-;every?;MAB;4| (|f| |c| $) - (LET ((#0=#:G1385 NIL) (#1=#:G1386 T) - (#2=#:G1404 (SPADCALL |c| (|shellEntry| $ 15)))) - (LOOP - (COND - ((ATOM #2#) (RETURN (OR #1# #0#))) - (T (LET ((|x| (CAR #2#))) - (LET ((#3=#:G1384 (SPADCALL |x| |f|))) - (COND - (#1# (SETQ #0# #3#)) - (T (SETQ #0# (AND #0# #3#)))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#))))) - -(DEFUN |HOAGG-;count;MANni;5| (|f| |c| $) - (LET ((#0=#:G1389 NIL) (#1=#:G1390 T) - (#2=#:G1405 (SPADCALL |c| (|shellEntry| $ 15)))) - (LOOP - (COND - ((ATOM #2#) (RETURN (COND (#1# 0) (T #0#)))) - (T (LET ((|x| (CAR #2#))) - (AND (SPADCALL |x| |f|) - (LET ((#3=#:G1388 1)) - (COND - (#1# (SETQ #0# #3#)) - (T (SETQ #0# (+ #0# #3#)))) - (SETQ #1# NIL)))))) - (SETQ #2# (CDR #2#))))) - -(DEFUN |HOAGG-;members;AL;6| (|x| $) - (SPADCALL |x| (|shellEntry| $ 15))) - -(DEFUN |HOAGG-;=;2AB;7| (|x| |y| $) - (AND (SPADCALL |x| (SPADCALL |y| (|shellEntry| $ 32)) - (|shellEntry| $ 33)) - (LET ((#0=#:G1394 NIL) (#1=#:G1395 T) - (#2=#:G1406 (SPADCALL |x| (|shellEntry| $ 15))) - (#3=#:G1407 (SPADCALL |y| (|shellEntry| $ 15)))) - (LOOP - (COND - ((OR (ATOM #2#) (ATOM #3#)) (RETURN (OR #1# #0#))) - (T (LET ((|a| (CAR #2#)) (|b| (CAR #3#))) - (LET ((#4=#:G1393 - (SPADCALL |a| |b| (|shellEntry| $ 34)))) - (COND - (#1# (SETQ #0# #4#)) - (T (SETQ #0# (AND #0# #4#)))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#)) - (SETQ #3# (CDR #3#)))))) - -(DEFUN |HOAGG-;count;SANni;8| (|s| |x| $) - (SPADCALL (CONS #'|HOAGG-;count;SANni;8!0| (VECTOR $ |s|)) |x| - (|shellEntry| $ 36))) - -(DEFUN |HOAGG-;count;SANni;8!0| (|#1| $$) - (SPADCALL (SVREF $$ 1) |#1| (|shellEntry| (SVREF $$ 0) 34))) - -(DEFUN |HOAGG-;member?;SAB;9| (|e| |c| $) - (SPADCALL (CONS #'|HOAGG-;member?;SAB;9!0| (VECTOR $ |e|)) |c| - (|shellEntry| $ 38))) - -(DEFUN |HOAGG-;member?;SAB;9!0| (|#1| $$) - (SPADCALL (SVREF $$ 1) |#1| (|shellEntry| (SVREF $$ 0) 34))) - -(DEFUN |HOAGG-;coerce;AOf;10| (|x| $) - (SPADCALL - (SPADCALL - (LET ((#0=#:G1409 (SPADCALL |x| (|shellEntry| $ 15))) - (#1=#:G1408 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|a| (CAR #0#))) - (SETQ #1# - (CONS (SPADCALL |a| (|shellEntry| $ 41)) - #1#))))) - (SETQ #0# (CDR #0#)))) - (|shellEntry| $ 43)) - (|shellEntry| $ 44))) - -(DEFUN |HomogeneousAggregate&| (|#1| |#2|) - (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) - (|dv$| (LIST '|HomogeneousAggregate&| |dv$1| |dv$2|)) - ($ (|newShell| 46)) - (|pv$| (|buildPredVector| 0 0 - (LIST (|HasAttribute| |#1| '|finiteAggregate|) - (|HasAttribute| |#1| '|shallowlyMutable|) - (|HasCategory| |#2| - (LIST '|Evalable| (|devaluate| |#2|))) - (|HasCategory| |#2| '(|SetCategory|)) - (|HasCategory| |#2| '(|BasicType|)) - (|HasCategory| |#2| - '(|CoercibleTo| (|OutputForm|))))))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (SETF (|shellEntry| $ 7) |#2|) - (COND - ((|testBitVector| |pv$| 3) - (SETF (|shellEntry| $ 13) - (CONS (|dispatchFunction| |HOAGG-;eval;ALA;1|) $)))) - (COND - ((|testBitVector| |pv$| 1) - (PROGN - (SETF (|shellEntry| $ 18) - (CONS (|dispatchFunction| |HOAGG-;#;ANni;2|) $)) - (SETF (|shellEntry| $ 23) - (CONS (|dispatchFunction| |HOAGG-;any?;MAB;3|) $)) - (SETF (|shellEntry| $ 26) - (CONS (|dispatchFunction| |HOAGG-;every?;MAB;4|) $)) - (SETF (|shellEntry| $ 30) - (CONS (|dispatchFunction| |HOAGG-;count;MANni;5|) $)) - (SETF (|shellEntry| $ 31) - (CONS (|dispatchFunction| |HOAGG-;members;AL;6|) $)) - (COND - ((|testBitVector| |pv$| 5) - (SETF (|shellEntry| $ 35) - (CONS (|dispatchFunction| |HOAGG-;=;2AB;7|) $)))) - (COND - ((|testBitVector| |pv$| 4) - (PROGN - (SETF (|shellEntry| $ 37) - (CONS (|dispatchFunction| |HOAGG-;count;SANni;8|) - $)) - (SETF (|shellEntry| $ 39) - (CONS (|dispatchFunction| |HOAGG-;member?;SAB;9|) - $))))) - (COND - ((|testBitVector| |pv$| 6) - (SETF (|shellEntry| $ 45) - (CONS (|dispatchFunction| |HOAGG-;coerce;AOf;10|) $))))))) - $)) - -(MAKEPROP '|HomogeneousAggregate&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|Equation| 7) (|List| 8) (0 . |eval|) (|Mapping| 7 7) - (6 . |map|) (12 . |eval|) (|List| 7) (18 . |parts|) - (|NonNegativeInteger|) (23 . |#|) (28 . |#|) (|Boolean|) - (33 . |or|) (39 . |false|) (|Mapping| 19 7) (43 . |any?|) - (49 . |and|) (55 . |true|) (59 . |every?|) (65 . |One|) - (69 . +) (75 . |Zero|) (79 . |count|) (85 . |members|) - (90 . |#|) (95 . |size?|) (101 . =) (107 . =) - (113 . |count|) (119 . |count|) (125 . |any?|) - (131 . |member?|) (|OutputForm|) (137 . |coerce|) - (|List| $) (142 . |commaSeparate|) (147 . |bracket|) - (152 . |coerce|)) - '#(|members| 157 |member?| 162 |every?| 168 |eval| 174 - |count| 180 |coerce| 192 |any?| 197 = 203 |#| 209) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 45 - '(2 7 0 0 9 10 2 6 0 11 0 12 2 0 0 0 9 - 13 1 6 14 0 15 1 14 16 0 17 1 0 16 0 - 18 2 19 0 0 0 20 0 19 0 21 2 0 19 22 - 0 23 2 19 0 0 0 24 0 19 0 25 2 0 19 - 22 0 26 0 16 0 27 2 16 0 0 0 28 0 16 - 0 29 2 0 16 22 0 30 1 0 14 0 31 1 6 - 16 0 32 2 6 19 0 16 33 2 7 19 0 0 34 - 2 0 19 0 0 35 2 6 16 22 0 36 2 0 16 7 - 0 37 2 6 19 22 0 38 2 0 19 7 0 39 1 7 - 40 0 41 1 40 0 42 43 1 40 0 0 44 1 0 - 40 0 45 1 0 14 0 31 2 0 19 7 0 39 2 0 - 19 22 0 26 2 0 0 0 9 13 2 0 16 7 0 37 - 2 0 16 22 0 30 1 0 40 0 45 2 0 19 22 - 0 23 2 0 19 0 0 35 1 0 16 0 18))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/HOAGG.lsp b/src/algebra/strap/HOAGG.lsp deleted file mode 100644 index 05925366..00000000 --- a/src/algebra/strap/HOAGG.lsp +++ /dev/null @@ -1,90 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |HomogeneousAggregate;CAT| 'NIL) - -(DEFPARAMETER |HomogeneousAggregate;AL| 'NIL) - -(DEFUN |HomogeneousAggregate;| (|t#1|) - (LET ((#0=#:G1373 - (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (COND - (|HomogeneousAggregate;CAT|) - (T (SETQ |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|)))) - ((|BasicType|) - (|has| |t#1| (|BasicType|))) - ((|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)))))))) - (SETF (|shellEntry| #0# 0) - (LIST '|HomogeneousAggregate| (|devaluate| |t#1|))) - #0#)) - -(DEFUN |HomogeneousAggregate| (#0=#:G1374) - (LET ((#1=#:G1375 - (|assoc| (|devaluate| #0#) |HomogeneousAggregate;AL|))) - (COND - (#1# (CDR #1#)) - (T (PROGN - (SETQ #1# (|HomogeneousAggregate;| #0#)) - (SETQ |HomogeneousAggregate;AL| - (|cons5| (CONS (|devaluate| #0#) #1#) - |HomogeneousAggregate;AL|)) - #1#))))) diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp deleted file mode 100644 index 6efd96a6..00000000 --- a/src/algebra/strap/ILIST.lsp +++ /dev/null @@ -1,623 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) (|%IntegerSection| 0)) - |ILIST;#;$Nni;1|)) - -(PUT '|ILIST;#;$Nni;1| '|SPADreplace| '|%llength|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%List|) - |ILIST;concat;S2$;2|)) - -(PUT '|ILIST;concat;S2$;2| '|SPADreplace| '|%pair|) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%List| |%Shell|) |%Boolean|) - |ILIST;eq?;2$B;3|)) - -(PUT '|ILIST;eq?;2$B;3| '|SPADreplace| '|%peq|) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |ILIST;first;$S;4|)) - -(PUT '|ILIST;first;$S;4| '|SPADreplace| '|SPADfirst|) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%Thing|) - |ILIST;elt;$firstS;5|)) - -(PUT '|ILIST;elt;$firstS;5| '|SPADreplace| - '(XLAM (|x| "first") (|SPADfirst| |x|))) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%List|) |ILIST;empty;$;6|)) - -(PUT '|ILIST;empty;$;6| '|SPADreplace| '(XLAM NIL |%nil|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Boolean|) - |ILIST;empty?;$B;7|)) - -(PUT '|ILIST;empty?;$B;7| '|SPADreplace| '|%lempty?|) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%List|) - |ILIST;rest;2$;8|)) - -(PUT '|ILIST;rest;2$;8| '|SPADreplace| '|%tail|) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%List|) - |ILIST;elt;$rest$;9|)) - -(PUT '|ILIST;elt;$rest$;9| '|SPADreplace| - '(XLAM (|x| "rest") (|%tail| |x|))) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%Thing|) - |ILIST;setfirst!;$2S;10|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |ILIST;setelt;$first2S;11|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%List| |%Shell|) |%List|) - |ILIST;setrest!;3$;12|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%List| |%Shell|) |%List|) - |ILIST;setelt;$rest2$;13|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%List|) - |ILIST;construct;L$;14|)) - -(PUT '|ILIST;construct;L$;14| '|SPADreplace| '(XLAM (|l|) |l|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%List|) - |ILIST;parts;$L;15|)) - -(PUT '|ILIST;parts;$L;15| '|SPADreplace| '(XLAM (|s|) |s|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%List|) - |ILIST;reverse!;2$;16|)) - -(PUT '|ILIST;reverse!;2$;16| '|SPADreplace| '|%lreverse!|) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%List|) - |ILIST;reverse;2$;17|)) - -(PUT '|ILIST;reverse;2$;17| '|SPADreplace| '|%lreverse|) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Integer|) - |ILIST;minIndex;$I;18|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| (|%IntegerSection| 0) |%Shell|) - |%List|) - |ILIST;rest;$Nni$;19|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%List|) - |ILIST;copy;2$;20|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |ILIST;coerce;$Of;21|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%List| |%Shell|) |%Boolean|) - |ILIST;=;2$B;22|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%String|) - |ILIST;latex;$S;23|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Boolean|) - |ILIST;member?;S$B;24|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%List| |%Shell|) |%List|) - |ILIST;concat!;3$;25|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%List|) - |ILIST;removeDuplicates!;2$;26|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%List|) - |ILIST;sort!;M2$;27|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%List| |%Shell|) |%List|) - |ILIST;merge!;M3$;28|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Integer| |%Shell|) |%List|) - |ILIST;split!;$I$;29|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Integer| |%Shell|) - |%List|) - |ILIST;mergeSort|)) - -(DEFUN |ILIST;#;$Nni;1| (|x| $) - (DECLARE (IGNORE $)) - (LIST-LENGTH |x|)) - -(DEFUN |ILIST;concat;S2$;2| (|s| |x| $) - (DECLARE (IGNORE $)) - (CONS |s| |x|)) - -(DEFUN |ILIST;eq?;2$B;3| (|x| |y| $) - (DECLARE (IGNORE $)) - (EQ |x| |y|)) - -(DEFUN |ILIST;first;$S;4| (|x| $) - (DECLARE (IGNORE $)) - (|SPADfirst| |x|)) - -(DEFUN |ILIST;elt;$firstS;5| (|x| T0 $) - (DECLARE (IGNORE $)) - (|SPADfirst| |x|)) - -(DEFUN |ILIST;empty;$;6| ($) (DECLARE (IGNORE $)) NIL) - -(DEFUN |ILIST;empty?;$B;7| (|x| $) (DECLARE (IGNORE $)) (NULL |x|)) - -(DEFUN |ILIST;rest;2$;8| (|x| $) (DECLARE (IGNORE $)) (CDR |x|)) - -(DEFUN |ILIST;elt;$rest$;9| (|x| T1 $) (DECLARE (IGNORE $)) (CDR |x|)) - -(DEFUN |ILIST;setfirst!;$2S;10| (|x| |s| $) - (COND - ((NULL |x|) (|error| "Cannot update an empty list")) - (T (SEQ (RPLACA |x| |s|) (EXIT |s|))))) - -(DEFUN |ILIST;setelt;$first2S;11| (|x| T2 |s| $) - (COND - ((NULL |x|) (|error| "Cannot update an empty list")) - (T (SEQ (RPLACA |x| |s|) (EXIT |s|))))) - -(DEFUN |ILIST;setrest!;3$;12| (|x| |y| $) - (COND - ((NULL |x|) (|error| "Cannot update an empty list")) - (T (SEQ (RPLACD |x| |y|) (EXIT (CDR |x|)))))) - -(DEFUN |ILIST;setelt;$rest2$;13| (|x| T3 |y| $) - (COND - ((NULL |x|) (|error| "Cannot update an empty list")) - (T (SEQ (RPLACD |x| |y|) (EXIT (CDR |x|)))))) - -(DEFUN |ILIST;construct;L$;14| (|l| $) (DECLARE (IGNORE $)) |l|) - -(DEFUN |ILIST;parts;$L;15| (|s| $) (DECLARE (IGNORE $)) |s|) - -(DEFUN |ILIST;reverse!;2$;16| (|x| $) - (DECLARE (IGNORE $)) - (NREVERSE |x|)) - -(DEFUN |ILIST;reverse;2$;17| (|x| $) - (DECLARE (IGNORE $)) - (REVERSE |x|)) - -(DEFUN |ILIST;minIndex;$I;18| (|x| $) (SVREF $ 7)) - -(DEFUN |ILIST;rest;$Nni$;19| (|x| |n| $) - (SEQ (LET ((|i| 1)) - (LOOP - (COND - ((> |i| |n|) (RETURN NIL)) - (T (SEQ (COND - ((NULL |x|) (|error| "index out of range"))) - (EXIT (SETQ |x| (CDR |x|)))))) - (SETQ |i| (+ |i| 1)))) - (EXIT |x|))) - -(DEFUN |ILIST;copy;2$;20| (|x| $) - (LET ((|y| NIL)) - (SEQ (LET ((|i| 0)) - (LOOP - (COND - ((NOT (NOT (NULL |x|))) (RETURN NIL)) - (T (SEQ (COND - ((AND (EQL |i| 1000) - (SPADCALL |x| (|shellEntry| $ 35))) - (|error| "cyclic list"))) - (SETQ |y| (CONS (CAR |x|) |y|)) - (EXIT (SETQ |x| (CDR |x|)))))) - (SETQ |i| (+ |i| 1)))) - (EXIT (NREVERSE |y|))))) - -(DEFUN |ILIST;coerce;$Of;21| (|x| $) - (PROG (|z|) - (RETURN - (LET ((|y| NIL) (|s| (SPADCALL |x| (|shellEntry| $ 40)))) - (SEQ (LOOP - (COND - ((NOT (NOT (EQ |x| |s|))) (RETURN NIL)) - (T (SEQ (SETQ |y| - (CONS (SPADCALL (|SPADfirst| |x|) - (|shellEntry| $ 41)) - |y|)) - (EXIT (SETQ |x| (CDR |x|))))))) - (SETQ |y| (NREVERSE |y|)) - (EXIT (COND - ((NULL |s|) (SPADCALL |y| (|shellEntry| $ 45))) - (T (SEQ (LETT |z| - (SPADCALL - (SPADCALL (|SPADfirst| |x|) - (|shellEntry| $ 41)) - (|shellEntry| $ 46)) - |ILIST;coerce;$Of;21|) - (LOOP - (COND - ((NOT (NOT (EQ |s| (CDR |x|)))) - (RETURN NIL)) - (T (SEQ (SETQ |x| (CDR |x|)) - (EXIT - (SETQ |z| - (CONS - (SPADCALL (|SPADfirst| |x|) - (|shellEntry| $ 41)) - |z|))))))) - (EXIT (SPADCALL - (SPADCALL |y| - (SPADCALL - (SPADCALL (NREVERSE |z|) - (|shellEntry| $ 47)) - (|shellEntry| $ 48)) - (|shellEntry| $ 49)) - (|shellEntry| $ 45)))))))))))) - -(DEFUN |ILIST;=;2$B;22| (|x| |y| $) - (OR (EQ |x| |y|) - (SEQ (LOOP - (COND - ((NOT (AND (NOT (NULL |x|)) (NOT (NULL |y|)))) - (RETURN NIL)) - (T (COND - ((SPADCALL (CAR |x|) (CAR |y|) (|shellEntry| $ 53)) - (RETURN-FROM |ILIST;=;2$B;22| NIL)) - (T (SEQ (SETQ |x| (CDR |x|)) - (EXIT (SETQ |y| (CDR |y|))))))))) - (EXIT (AND (NULL |x|) (NULL |y|)))))) - -(DEFUN |ILIST;latex;$S;23| (|x| $) - (LET ((|s| "\\left[")) - (SEQ (LOOP - (COND - ((NOT (NOT (NULL |x|))) (RETURN NIL)) - (T (SEQ (SETQ |s| - (STRCONC |s| - (SPADCALL (CAR |x|) - (|shellEntry| $ 56)))) - (SETQ |x| (CDR |x|)) - (EXIT (COND - ((NOT (NULL |x|)) - (SETQ |s| (STRCONC |s| ", "))))))))) - (EXIT (STRCONC |s| " \\right]"))))) - -(DEFUN |ILIST;member?;S$B;24| (|s| |x| $) - (SEQ (LOOP - (COND - ((NOT (NOT (NULL |x|))) (RETURN NIL)) - (T (COND - ((SPADCALL |s| (CAR |x|) (|shellEntry| $ 59)) - (RETURN-FROM |ILIST;member?;S$B;24| T)) - (T (SETQ |x| (CDR |x|))))))) - (EXIT NIL))) - -(DEFUN |ILIST;concat!;3$;25| (|x| |y| $) - (COND - ((NULL |x|) - (COND - ((NULL |y|) |x|) - (T (SEQ (PUSH (|SPADfirst| |y|) |x|) (RPLACD |x| (CDR |y|)) - (EXIT |x|))))) - (T (LET ((|z| |x|)) - (SEQ (LOOP - (COND - ((NOT (NOT (NULL (CDR |z|)))) (RETURN NIL)) - (T (SETQ |z| (CDR |z|))))) - (RPLACD |z| |y|) (EXIT |x|)))))) - -(DEFUN |ILIST;removeDuplicates!;2$;26| (|l| $) - (PROG (|pp| |f| |pr|) - (RETURN - (LET ((|p| |l|)) - (SEQ (LOOP - (COND - ((NOT (NOT (NULL |p|))) (RETURN NIL)) - (T (SEQ (LETT |pp| |p| - |ILIST;removeDuplicates!;2$;26|) - (LETT |f| (CAR |p|) - |ILIST;removeDuplicates!;2$;26|) - (SETQ |p| (CDR |p|)) - (EXIT (LOOP - (COND - ((NOT - (NOT - (NULL - (LETT |pr| (CDR |pp|) - |ILIST;removeDuplicates!;2$;26|)))) - (RETURN NIL)) - (T - (COND - ((SPADCALL (CAR |pr|) |f| - (|shellEntry| $ 59)) - (RPLACD |pp| (CDR |pr|))) - (T (SETQ |pp| |pr|))))))))))) - (EXIT |l|)))))) - -(DEFUN |ILIST;sort!;M2$;27| (|f| |l| $) - (|ILIST;mergeSort| |f| |l| (LIST-LENGTH |l|) $)) - -(DEFUN |ILIST;merge!;M3$;28| (|f| |p| |q| $) - (PROG (|r| |t|) - (RETURN - (COND - ((NULL |p|) |q|) - ((NULL |q|) |p|) - ((EQ |p| |q|) (|error| "cannot merge a list into itself")) - (T (SEQ (COND - ((SPADCALL (CAR |p|) (CAR |q|) |f|) - (SEQ (LETT |r| (LETT |t| |p| |ILIST;merge!;M3$;28|) - |ILIST;merge!;M3$;28|) - (EXIT (SETQ |p| (CDR |p|))))) - (T (SEQ (LETT |r| - (LETT |t| |q| |ILIST;merge!;M3$;28|) - |ILIST;merge!;M3$;28|) - (EXIT (SETQ |q| (CDR |q|)))))) - (LOOP - (COND - ((NOT (AND (NOT (NULL |p|)) (NOT (NULL |q|)))) - (RETURN NIL)) - (T (COND - ((SPADCALL (CAR |p|) (CAR |q|) |f|) - (SEQ (RPLACD |t| |p|) - (LETT |t| |p| |ILIST;merge!;M3$;28|) - (EXIT (SETQ |p| (CDR |p|))))) - (T (SEQ (RPLACD |t| |q|) - (LETT |t| |q| |ILIST;merge!;M3$;28|) - (EXIT (SETQ |q| (CDR |q|))))))))) - (RPLACD |t| (COND ((NULL |p|) |q|) (T |p|))) - (EXIT |r|))))))) - -(DEFUN |ILIST;split!;$I$;29| (|p| |n| $) - (PROG (|q|) - (RETURN - (COND - ((< |n| 1) (|error| "index out of range")) - (T (SEQ (SETQ |p| - (|ILIST;rest;$Nni$;19| |p| - (LET ((#0=#:G1485 (- |n| 1))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - $)) - (LETT |q| (CDR |p|) |ILIST;split!;$I$;29|) - (RPLACD |p| NIL) (EXIT |q|))))))) - -(DEFUN |ILIST;mergeSort| (|f| |p| |n| $) - (PROG (|l| |q|) - (RETURN - (SEQ (COND - ((AND (EQL |n| 2) - (SPADCALL (|SPADfirst| (CDR |p|)) (|SPADfirst| |p|) - |f|)) - (SETQ |p| (NREVERSE |p|)))) - (EXIT (COND - ((< |n| 3) |p|) - (T (SEQ (LETT |l| - (LET ((#0=#:G1490 (TRUNCATE |n| 2))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - |ILIST;mergeSort|) - (LETT |q| (|ILIST;split!;$I$;29| |p| |l| $) - |ILIST;mergeSort|) - (SETQ |p| (|ILIST;mergeSort| |f| |p| |l| $)) - (SETQ |q| - (|ILIST;mergeSort| |f| |q| (- |n| |l|) - $)) - (EXIT (|ILIST;merge!;M3$;28| |f| |p| |q| $)))))))))) - -(DEFUN |IndexedList| (&REST #0=#:G1499 &AUX #1=#:G1497) - (DECLARE (SPECIAL |$ConstructorCache|)) - (DSETQ #1# #0#) - (LET ((#2=#:G1498 - (|lassocShiftWithFunction| (|devaluateList| #1#) - (HGET |$ConstructorCache| '|IndexedList|) - '|domainEqualList|))) - (COND - (#2# (|CDRwithIncrement| #2#)) - (T (UNWIND-PROTECT - (PROG1 (APPLY (|function| |IndexedList;|) #1#) - (SETQ #2# T)) - (COND - ((NOT #2#) (HREM |$ConstructorCache| '|IndexedList|)))))))) - -(DEFUN |IndexedList;| (|#1| |#2|) - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) - (|dv$| (LIST '|IndexedList| |dv$1| |dv$2|)) - ($ (|newShell| 86)) - (|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|)) - (OR (|HasCategory| |#1| '(|BasicType|)) - (|HasCategory| |#1| '(|OrderedSet|)) - (|HasCategory| |#1| '(|SetCategory|))) - (|HasCategory| (|Integer|) '(|OrderedSet|)) - (|HasCategory| |#1| '(|SetCategory|)) - (|HasCategory| |#1| - '(|CoercibleTo| (|OutputForm|))) - (|HasCategory| |#1| '(|BasicType|)) - (AND (|HasCategory| |#1| '(|SetCategory|)) - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|)))))))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|haddProp| |$ConstructorCache| '|IndexedList| (LIST |dv$1| |dv$2|) - (CONS 1 $)) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (SETF (|shellEntry| $ 7) |#2|) - (COND - ((|testBitVector| |pv$| 9) - (SETF (|shellEntry| $ 50) - (CONS (|dispatchFunction| |ILIST;coerce;$Of;21|) $)))) - (COND - ((|testBitVector| |pv$| 8) - (PROGN - (SETF (|shellEntry| $ 54) - (CONS (|dispatchFunction| |ILIST;=;2$B;22|) $)) - (SETF (|shellEntry| $ 58) - (CONS (|dispatchFunction| |ILIST;latex;$S;23|) $)) - (SETF (|shellEntry| $ 60) - (CONS (|dispatchFunction| |ILIST;member?;S$B;24|) $))))) - (COND - ((|testBitVector| |pv$| 8) - (SETF (|shellEntry| $ 62) - (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 . =) (11 . |cyclic?|) |ILIST;copy;2$;20| (|OutputForm|) - (|List| 37) (16 . |empty|) (20 . |cycleEntry|) - (25 . |coerce|) (30 . |concat|) (36 . |reverse!|) - (|List| $) (41 . |bracket|) (46 . |list|) - (51 . |commaSeparate|) (56 . |overbar|) (61 . |concat!|) - (67 . |coerce|) (72 . |true|) (76 . |false|) (80 . ~=) - (86 . =) (|String|) (92 . |latex|) (97 . |concat|) - (103 . |latex|) (108 . =) (114 . |member?|) - |ILIST;concat!;3$;25| (120 . |removeDuplicates!|) - (|Mapping| 11 6 6) |ILIST;sort!;M2$;27| - |ILIST;merge!;M3$;28| (125 . |One|) (129 . <) - (135 . |One|) (139 . -) |ILIST;split!;$I$;29| (145 . =) - (151 . |quo|) (|Mapping| 6 6 6) (|Equation| 6) (|List| 74) - (|Mapping| 11 6) (|Void|) (|UniversalSegment| 30) '"last" - '"value" (|Mapping| 6 6) (|InputForm|) (|SingleInteger|) - (|List| 30) (|Union| 6 '"failed")) - '#(~= 157 |value| 163 |third| 168 |tail| 173 |swap!| 178 - |split!| 185 |sorted?| 191 |sort!| 202 |sort| 213 |size?| - 224 |setvalue!| 230 |setrest!| 236 |setlast!| 242 - |setfirst!| 248 |setelt| 254 |setchildren!| 296 |select!| - 302 |select| 308 |second| 314 |sample| 319 |reverse!| 323 - |reverse| 328 |rest| 333 |removeDuplicates!| 344 - |removeDuplicates| 349 |remove!| 354 |remove| 366 |reduce| - 378 |qsetelt!| 399 |qelt| 406 |possiblyInfinite?| 412 - |position| 417 |parts| 436 |nodes| 441 |node?| 446 |new| - 452 |more?| 458 |minIndex| 464 |min| 469 |merge!| 475 - |merge| 488 |members| 501 |member?| 506 |maxIndex| 512 - |max| 517 |map!| 523 |map| 529 |list| 542 |less?| 547 - |leaves| 553 |leaf?| 558 |latex| 563 |last| 568 |insert!| - 579 |insert| 593 |indices| 607 |index?| 612 |hash| 618 - |first| 623 |find| 634 |fill!| 640 |explicitlyFinite?| 646 - |every?| 651 |eval| 657 |eq?| 683 |entry?| 689 |entries| - 695 |empty?| 700 |empty| 705 |elt| 709 |distance| 752 - |delete!| 758 |delete| 770 |cyclic?| 782 |cycleTail| 787 - |cycleSplit!| 792 |cycleLength| 797 |cycleEntry| 802 - |count| 807 |copyInto!| 819 |copy| 826 |convert| 831 - |construct| 836 |concat!| 841 |concat| 853 |coerce| 876 - |children| 881 |child?| 886 |before?| 892 |any?| 898 >= - 904 > 910 = 916 <= 922 < 928 |#| 934) - '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) - (CONS (|makeByteWordVec2| 6 - '(0 0 0 0 0 0 0 0 0 0 5 0 4 5 0 0 0 1 6 0 1 2 3)) - (CONS '#(|ListAggregate&| |StreamAggregate&| - |ExtensibleLinearAggregate&| - |FiniteLinearAggregate&| - |UnaryRecursiveAggregate&| |LinearAggregate&| - |RecursiveAggregate&| |IndexedAggregate&| - |Collection&| |HomogeneousAggregate&| NIL - |EltableAggregate&| |SetCategory&| - |OrderedType&| NIL |Aggregate&| NIL - |Evalable&| |BasicType&| NIL |InnerEvalable&| - NIL NIL) - (CONS '#((|ListAggregate| 6) - (|StreamAggregate| 6) - (|ExtensibleLinearAggregate| 6) - (|FiniteLinearAggregate| 6) - (|UnaryRecursiveAggregate| 6) - (|LinearAggregate| 6) - (|RecursiveAggregate| 6) - (|IndexedAggregate| 30 6) - (|Collection| 6) - (|HomogeneousAggregate| 6) - (|OrderedSet|) (|EltableAggregate| 30 6) - (|SetCategory|) (|OrderedType|) - (|Eltable| 78 $$) (|Aggregate|) - (|Eltable| 30 6) (|Evalable| 6) - (|BasicType|) (|Type|) - (|InnerEvalable| 6 6) (|CoercibleTo| 37) - (|ConvertibleTo| 82)) - (|makeByteWordVec2| 85 - '(1 11 0 0 33 2 8 11 0 0 34 1 0 11 0 35 - 0 38 0 39 1 0 0 0 40 1 6 37 0 41 2 38 - 0 37 0 42 1 38 0 0 43 1 37 0 44 45 1 - 38 0 37 46 1 37 0 44 47 1 37 0 0 48 2 - 38 0 0 37 49 1 0 37 0 50 0 11 0 51 0 - 11 0 52 2 6 11 0 0 53 2 0 11 0 0 54 1 - 6 55 0 56 2 55 0 0 0 57 1 0 55 0 58 2 - 6 11 0 0 59 2 0 11 6 0 60 1 0 0 0 62 - 0 30 0 66 2 30 11 0 0 67 0 8 0 68 2 - 30 0 0 0 69 2 30 11 0 0 71 2 30 0 0 0 - 72 2 10 11 0 0 1 1 0 6 0 1 1 0 6 0 1 - 1 0 0 0 1 3 0 77 0 30 30 1 2 0 0 0 30 - 70 1 5 11 0 1 2 0 11 63 0 1 1 5 0 0 1 - 2 0 0 63 0 64 1 5 0 0 1 2 0 0 63 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 78 6 1 3 0 6 0 79 6 1 3 0 0 - 0 19 0 24 3 0 6 0 14 6 22 3 0 6 0 80 - 6 1 2 0 0 0 44 1 2 0 0 76 0 1 2 0 0 - 76 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 8 - 0 0 62 1 8 0 0 1 2 8 0 6 0 1 2 0 0 76 - 0 1 2 8 0 6 0 1 2 0 0 76 0 1 4 8 6 73 - 0 6 6 1 2 0 6 73 0 1 3 0 6 73 0 6 1 3 - 0 6 0 30 6 1 2 0 6 0 30 1 1 0 11 0 1 - 3 8 30 6 0 30 1 2 8 30 6 0 1 2 0 30 - 76 0 1 1 0 25 0 27 1 0 44 0 1 2 8 11 - 0 0 1 2 0 0 8 6 1 2 0 11 0 8 1 1 7 30 - 0 31 2 5 0 0 0 1 2 5 0 0 0 1 3 0 0 63 - 0 0 65 2 5 0 0 0 1 3 0 0 63 0 0 1 1 0 - 25 0 1 2 8 11 6 0 60 1 7 30 0 1 2 5 0 - 0 0 1 2 0 0 81 0 1 3 0 0 73 0 0 1 2 0 - 0 81 0 1 1 0 0 6 1 2 0 11 0 8 1 1 0 - 25 0 1 1 0 11 0 1 1 8 55 0 58 2 0 0 0 - 8 1 1 0 6 0 1 3 0 0 0 0 30 1 3 0 0 6 - 0 30 1 3 0 0 0 0 30 1 3 0 0 6 0 30 1 - 1 0 84 0 1 2 0 11 30 0 1 1 8 83 0 1 2 - 0 0 0 8 1 1 0 6 0 13 2 0 85 76 0 1 2 - 0 0 0 6 1 1 0 11 0 1 2 0 11 76 0 1 3 - 11 0 0 6 6 1 3 11 0 0 25 25 1 2 11 0 - 0 74 1 2 11 0 0 75 1 2 0 11 0 0 12 2 - 8 11 6 0 1 1 0 25 0 1 1 0 11 0 17 0 0 - 0 16 3 0 6 0 30 6 1 2 0 6 0 30 1 2 0 - 0 0 78 1 2 0 6 0 79 1 2 0 0 0 19 20 2 - 0 6 0 14 15 2 0 6 0 80 1 2 0 30 0 0 1 - 2 0 0 0 30 1 2 0 0 0 78 1 2 0 0 0 78 - 1 2 0 0 0 30 1 1 0 11 0 35 1 0 0 0 1 - 1 0 0 0 1 1 0 8 0 1 1 0 0 0 40 2 8 8 - 6 0 1 2 0 8 76 0 1 3 0 0 0 0 30 1 1 0 - 0 0 36 1 3 82 0 1 1 0 0 25 26 2 0 0 0 - 6 1 2 0 0 0 0 61 2 0 0 0 6 1 1 0 0 44 - 1 2 0 0 6 0 10 2 0 0 0 0 1 1 9 37 0 - 50 1 0 44 0 1 2 8 11 0 0 1 2 10 11 0 - 0 1 2 0 11 76 0 1 2 5 11 0 0 1 2 5 11 - 0 0 1 2 10 11 0 0 54 2 5 11 0 0 1 2 5 - 11 0 0 1 1 0 8 0 9))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/INS-.lsp b/src/algebra/strap/INS-.lsp deleted file mode 100644 index da35ba66..00000000 --- a/src/algebra/strap/INS-.lsp +++ /dev/null @@ -1,375 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 0)) - |INS-;characteristic;Nni;1|)) - -(PUT '|INS-;characteristic;Nni;1| '|SPADreplace| '(XLAM NIL 0)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |INS-;differentiate;2S;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |INS-;even?;SB;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |INS-;positive?;SB;4|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |INS-;copy;2S;5|)) - -(PUT '|INS-;copy;2S;5| '|SPADreplace| '(XLAM (|x|) |x|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |INS-;bit?;2SB;6|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |INS-;mask;2S;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |INS-;rational?;SB;8|)) - -(PUT '|INS-;rational?;SB;8| '|SPADreplace| '(XLAM (|x|) |%true|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0)) - |INS-;euclideanSize;SNni;9|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |INS-;convert;SF;10|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%DoubleFloat|) - |INS-;convert;SDf;11|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |INS-;convert;SIf;12|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|) - |INS-;retract;SI;13|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |INS-;convert;SP;14|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |INS-;factor;SF;15|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |INS-;squareFree;SF;16|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |INS-;prime?;SB;17|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |INS-;factorial;2S;18|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |INS-;binomial;3S;19|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |INS-;permutation;3S;20|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |INS-;retractIfCan;SU;21|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |INS-;init;S;22|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |INS-;nextItem;SU;23|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |INS-;patternMatch;SP2Pmr;24|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |INS-;rational;SF;25|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |INS-;rationalIfCan;SU;26|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |INS-;symmetricRemainder;3S;27|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |INS-;invmod;3S;28|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |INS-;powmod;4S;29|)) - -(DEFUN |INS-;characteristic;Nni;1| ($) (DECLARE (IGNORE $)) 0) - -(DEFUN |INS-;differentiate;2S;2| (|x| $) (|spadConstant| $ 10)) - -(DEFUN |INS-;even?;SB;3| (|x| $) - (NOT (SPADCALL |x| (|shellEntry| $ 13)))) - -(DEFUN |INS-;positive?;SB;4| (|x| $) - (SPADCALL |x| (|spadConstant| $ 10) (|shellEntry| $ 16))) - -(DEFUN |INS-;copy;2S;5| (|x| $) (DECLARE (IGNORE $)) |x|) - -(DEFUN |INS-;bit?;2SB;6| (|x| |i| $) - (SPADCALL - (SPADCALL |x| (SPADCALL |i| (|shellEntry| $ 19)) - (|shellEntry| $ 20)) - (|shellEntry| $ 13))) - -(DEFUN |INS-;mask;2S;7| (|n| $) - (SPADCALL (SPADCALL (|spadConstant| $ 22) |n| (|shellEntry| $ 20)) - (|shellEntry| $ 23))) - -(DEFUN |INS-;rational?;SB;8| (|x| $) (DECLARE (IGNORE $)) T) - -(DEFUN |INS-;euclideanSize;SNni;9| (|x| $) - (COND - ((SPADCALL |x| (|spadConstant| $ 10) (|shellEntry| $ 27)) - (|error| "euclideanSize called on zero")) - ((SPADCALL |x| (|spadConstant| $ 10) (|shellEntry| $ 28)) - (LET ((#0=#:G1401 (- (SPADCALL |x| (|shellEntry| $ 30))))) - (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#))) - (T (LET ((#1=#:G1402 (SPADCALL |x| (|shellEntry| $ 30)))) - (|check-subtype| (NOT (MINUSP #1#)) '(|NonNegativeInteger|) - #1#))))) - -(DEFUN |INS-;convert;SF;10| (|x| $) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 30)) (|shellEntry| $ 34))) - -(DEFUN |INS-;convert;SDf;11| (|x| $) - (FLOAT (SPADCALL |x| (|shellEntry| $ 30)) |$DoubleFloatMaximum|)) - -(DEFUN |INS-;convert;SIf;12| (|x| $) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 30)) (|shellEntry| $ 40))) - -(DEFUN |INS-;retract;SI;13| (|x| $) - (SPADCALL |x| (|shellEntry| $ 30))) - -(DEFUN |INS-;convert;SP;14| (|x| $) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 30)) (|shellEntry| $ 44))) - -(DEFUN |INS-;factor;SF;15| (|x| $) (SPADCALL |x| (|shellEntry| $ 48))) - -(DEFUN |INS-;squareFree;SF;16| (|x| $) - (SPADCALL |x| (|shellEntry| $ 51))) - -(DEFUN |INS-;prime?;SB;17| (|x| $) (SPADCALL |x| (|shellEntry| $ 54))) - -(DEFUN |INS-;factorial;2S;18| (|x| $) - (SPADCALL |x| (|shellEntry| $ 57))) - -(DEFUN |INS-;binomial;3S;19| (|n| |m| $) - (SPADCALL |n| |m| (|shellEntry| $ 59))) - -(DEFUN |INS-;permutation;3S;20| (|n| |m| $) - (SPADCALL |n| |m| (|shellEntry| $ 61))) - -(DEFUN |INS-;retractIfCan;SU;21| (|x| $) - (CONS 0 (SPADCALL |x| (|shellEntry| $ 30)))) - -(DEFUN |INS-;init;S;22| ($) (|spadConstant| $ 10)) - -(DEFUN |INS-;nextItem;SU;23| (|n| $) - (COND - ((SPADCALL |n| (|shellEntry| $ 66)) (CONS 0 (|spadConstant| $ 22))) - ((SPADCALL |n| (|spadConstant| $ 10) (|shellEntry| $ 16)) - (CONS 0 (SPADCALL |n| (|shellEntry| $ 19)))) - (T (CONS 0 - (SPADCALL (|spadConstant| $ 22) |n| (|shellEntry| $ 67)))))) - -(DEFUN |INS-;patternMatch;SP2Pmr;24| (|x| |p| |l| $) - (SPADCALL |x| |p| |l| (|shellEntry| $ 72))) - -(DEFUN |INS-;rational;SF;25| (|x| $) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 30)) (|shellEntry| $ 76))) - -(DEFUN |INS-;rationalIfCan;SU;26| (|x| $) - (CONS 0 - (SPADCALL (SPADCALL |x| (|shellEntry| $ 30)) - (|shellEntry| $ 76)))) - -(DEFUN |INS-;symmetricRemainder;3S;27| (|x| |n| $) - (LET ((|r| (SPADCALL |x| |n| (|shellEntry| $ 80)))) - (COND - ((SPADCALL |r| (|spadConstant| $ 10) (|shellEntry| $ 27)) |r|) - (T (SEQ (COND - ((SPADCALL |n| (|spadConstant| $ 10) - (|shellEntry| $ 28)) - (SETQ |n| (SPADCALL |n| (|shellEntry| $ 19))))) - (EXIT (COND - ((SPADCALL |r| (|spadConstant| $ 10) - (|shellEntry| $ 16)) - (COND - ((SPADCALL - (SPADCALL 2 |r| (|shellEntry| $ 82)) |n| - (|shellEntry| $ 16)) - (SPADCALL |r| |n| (|shellEntry| $ 67))) - (T |r|))) - ((SPADCALL - (SPADCALL (SPADCALL 2 |r| - (|shellEntry| $ 82)) - |n| (|shellEntry| $ 83)) - (|spadConstant| $ 10) (|shellEntry| $ 84)) - (SPADCALL |r| |n| (|shellEntry| $ 83))) - (T |r|)))))))) - -(DEFUN |INS-;invmod;3S;28| (|a| |b| $) - (PROG (|c| |c1| |d| |d1| |q| |r| |r1|) - (RETURN - (SEQ (COND - ((SPADCALL |a| (|shellEntry| $ 86)) - (SETQ |a| (SPADCALL |a| |b| (|shellEntry| $ 87))))) - (LETT |c| |a| |INS-;invmod;3S;28|) - (LETT |c1| (|spadConstant| $ 22) |INS-;invmod;3S;28|) - (LETT |d| |b| |INS-;invmod;3S;28|) - (LETT |d1| (|spadConstant| $ 10) |INS-;invmod;3S;28|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |d| (|shellEntry| $ 66)))) - (RETURN NIL)) - (T (SEQ (LETT |q| (SPADCALL |c| |d| (|shellEntry| $ 88)) - |INS-;invmod;3S;28|) - (LETT |r| - (SPADCALL |c| - (SPADCALL |q| |d| (|shellEntry| $ 89)) - (|shellEntry| $ 67)) - |INS-;invmod;3S;28|) - (LETT |r1| - (SPADCALL |c1| - (SPADCALL |q| |d1| - (|shellEntry| $ 89)) - (|shellEntry| $ 67)) - |INS-;invmod;3S;28|) - (SETQ |c| |d|) (SETQ |c1| |d1|) (SETQ |d| |r|) - (EXIT (SETQ |d1| |r1|)))))) - (COND - ((NOT (SPADCALL |c| (|shellEntry| $ 90))) - (EXIT (|error| "inverse does not exist")))) - (EXIT (COND - ((SPADCALL |c1| (|shellEntry| $ 86)) - (SPADCALL |c1| |b| (|shellEntry| $ 83))) - (T |c1|))))))) - -(DEFUN |INS-;powmod;4S;29| (|x| |n| |p| $) - (PROG (|y| |z|) - (RETURN - (SEQ (COND - ((SPADCALL |x| (|shellEntry| $ 86)) - (SETQ |x| (SPADCALL |x| |p| (|shellEntry| $ 87))))) - (EXIT (COND - ((SPADCALL |x| (|shellEntry| $ 66)) - (|spadConstant| $ 10)) - ((SPADCALL |n| (|shellEntry| $ 66)) - (|spadConstant| $ 22)) - (T (SEQ (LETT |y| (|spadConstant| $ 22) - |INS-;powmod;4S;29|) - (LETT |z| |x| |INS-;powmod;4S;29|) - (EXIT (LOOP - (COND - (NIL (RETURN NIL)) - (T - (SEQ - (COND - ((SPADCALL |n| - (|shellEntry| $ 13)) - (SETQ |y| - (SPADCALL |y| |z| |p| - (|shellEntry| $ 92))))) - (EXIT - (COND - ((SPADCALL - (SETQ |n| - (SPADCALL |n| - (SPADCALL - (|spadConstant| $ 22) - (|shellEntry| $ 19)) - (|shellEntry| $ 20))) - (|shellEntry| $ 66)) - (RETURN-FROM - |INS-;powmod;4S;29| - |y|)) - (T - (SETQ |z| - (SPADCALL |z| |z| |p| - (|shellEntry| $ 92))))))))))))))))))) - -(DEFUN |IntegerNumberSystem&| (|#1|) - (LET* ((|dv$1| (|devaluate| |#1|)) - (|dv$| (LIST '|IntegerNumberSystem&| |dv$1|)) - ($ (|newShell| 94)) (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - $)) - -(MAKEPROP '|IntegerNumberSystem&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) - (|NonNegativeInteger|) (0 . |Zero|) - |INS-;characteristic;Nni;1| (4 . |Zero|) - |INS-;differentiate;2S;2| (|Boolean|) (8 . |odd?|) - (13 . |not|) |INS-;even?;SB;3| (18 . >) - |INS-;positive?;SB;4| |INS-;copy;2S;5| (24 . -) - (29 . |shift|) |INS-;bit?;2SB;6| (35 . |One|) (39 . |dec|) - |INS-;mask;2S;7| (44 . |true|) |INS-;rational?;SB;8| - (48 . =) (54 . <) (|Integer|) (60 . |convert|) (65 . -) - |INS-;euclideanSize;SNni;9| (|Float|) (70 . |coerce|) - |INS-;convert;SF;10| (|DoubleFloat|) (75 . |coerce|) - |INS-;convert;SDf;11| (|InputForm|) (80 . |convert|) - |INS-;convert;SIf;12| |INS-;retract;SI;13| (|Pattern| 29) - (85 . |coerce|) |INS-;convert;SP;14| (|Factored| 6) - (|IntegerFactorizationPackage| 6) (90 . |factor|) - (|Factored| $) |INS-;factor;SF;15| (95 . |squareFree|) - |INS-;squareFree;SF;16| (|IntegerPrimesPackage| 6) - (100 . |prime?|) |INS-;prime?;SB;17| - (|IntegerCombinatoricFunctions| 6) (105 . |factorial|) - |INS-;factorial;2S;18| (110 . |binomial|) - |INS-;binomial;3S;19| (116 . |permutation|) - |INS-;permutation;3S;20| (|Union| 29 '"failed") - |INS-;retractIfCan;SU;21| |INS-;init;S;22| (122 . |zero?|) - (127 . -) (|Union| $ '"failed") |INS-;nextItem;SU;23| - (|PatternMatchResult| 29 6) - (|PatternMatchIntegerNumberSystem| 6) - (133 . |patternMatch|) (|PatternMatchResult| 29 $) - |INS-;patternMatch;SP2Pmr;24| (|Fraction| 29) - (140 . |coerce|) |INS-;rational;SF;25| - (|Union| 75 '"failed") |INS-;rationalIfCan;SU;26| - (145 . |rem|) (|PositiveInteger|) (151 . *) (157 . +) - (163 . <=) |INS-;symmetricRemainder;3S;27| - (169 . |negative?|) (174 . |positiveRemainder|) - (180 . |quo|) (186 . *) (192 . |one?|) |INS-;invmod;3S;28| - (197 . |mulmod|) |INS-;powmod;4S;29|) - '#(|symmetricRemainder| 204 |squareFree| 210 |retractIfCan| - 215 |retract| 220 |rationalIfCan| 225 |rational?| 230 - |rational| 235 |prime?| 240 |powmod| 245 |positive?| 252 - |permutation| 257 |patternMatch| 263 |nextItem| 270 |mask| - 275 |invmod| 280 |init| 286 |factorial| 290 |factor| 295 - |even?| 300 |euclideanSize| 305 |differentiate| 310 |copy| - 315 |convert| 320 |characteristic| 340 |bit?| 344 - |binomial| 350) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 93 - '(0 7 0 8 0 6 0 10 1 6 12 0 13 1 12 0 0 - 14 2 6 12 0 0 16 1 6 0 0 19 2 6 0 0 0 - 20 0 6 0 22 1 6 0 0 23 0 12 0 25 2 6 - 12 0 0 27 2 6 12 0 0 28 1 6 29 0 30 1 - 29 0 0 31 1 33 0 29 34 1 36 0 29 37 1 - 39 0 29 40 1 43 0 29 44 1 47 46 6 48 - 1 47 46 6 51 1 53 12 6 54 1 56 6 6 57 - 2 56 6 6 6 59 2 56 6 6 6 61 1 6 12 0 - 66 2 6 0 0 0 67 3 71 70 6 43 70 72 1 - 75 0 29 76 2 6 0 0 0 80 2 6 0 81 0 82 - 2 6 0 0 0 83 2 6 12 0 0 84 1 6 12 0 - 86 2 6 0 0 0 87 2 6 0 0 0 88 2 6 0 0 - 0 89 1 6 12 0 90 3 6 0 0 0 0 92 2 0 0 - 0 0 85 1 0 49 0 52 1 0 63 0 64 1 0 29 - 0 42 1 0 78 0 79 1 0 12 0 26 1 0 75 0 - 77 1 0 12 0 55 3 0 0 0 0 0 93 1 0 12 - 0 17 2 0 0 0 0 62 3 0 73 0 43 73 74 1 - 0 68 0 69 1 0 0 0 24 2 0 0 0 0 91 0 0 - 0 65 1 0 0 0 58 1 0 49 0 50 1 0 12 0 - 15 1 0 7 0 32 1 0 0 0 11 1 0 0 0 18 1 - 0 36 0 38 1 0 33 0 35 1 0 43 0 45 1 0 - 39 0 41 0 0 7 9 2 0 12 0 0 21 2 0 0 0 - 0 60))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/INS.lsp b/src/algebra/strap/INS.lsp deleted file mode 100644 index 5c3260e3..00000000 --- a/src/algebra/strap/INS.lsp +++ /dev/null @@ -1,61 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |IntegerNumberSystem;AL| 'NIL) - -(DEFUN |IntegerNumberSystem;| () - (LET ((#0=#:G1389 - (|sublisV| - (PAIR '(#1=#:G1383 #2=#:G1384 #3=#:G1385 #4=#:G1386 - #5=#:G1387 #6=#:G1388) - '((|Integer|) (|Integer|) (|Integer|) - (|InputForm|) (|Pattern| (|Integer|)) - (|Integer|))) - (|Join| (|UniqueFactorizationDomain|) - (|EuclideanDomain|) (|OrderedIntegralDomain|) - (|DifferentialRing|) (|ConvertibleTo| '#1#) - (|RetractableTo| '#2#) - (|LinearlyExplicitRingOver| '#3#) - (|ConvertibleTo| '#4#) (|ConvertibleTo| '#5#) - (|PatternMatchable| '#6#) - (|CombinatorialFunctionCategory|) - (|RealConstant|) (|CharacteristicZero|) - (|StepThrough|) - (|mkCategory| '|domain| - '(((|odd?| ((|Boolean|) $)) T) - ((|even?| ((|Boolean|) $)) T) - ((|base| ($)) T) ((|length| ($ $)) T) - ((|shift| ($ $ $)) T) - ((|bit?| ((|Boolean|) $ $)) T) - ((|positiveRemainder| ($ $ $)) T) - ((|symmetricRemainder| ($ $ $)) T) - ((|rational?| ((|Boolean|) $)) T) - ((|rational| - ((|Fraction| (|Integer|)) $)) - T) - ((|rationalIfCan| - ((|Union| (|Fraction| (|Integer|)) - "failed") - $)) - T) - ((|random| ($)) T) ((|random| ($ $)) T) - ((|copy| ($ $)) T) ((|inc| ($ $)) T) - ((|dec| ($ $)) T) ((|mask| ($ $)) T) - ((|addmod| ($ $ $ $)) T) - ((|submod| ($ $ $ $)) T) - ((|mulmod| ($ $ $ $)) T) - ((|powmod| ($ $ $ $)) T) - ((|invmod| ($ $ $)) T)) - '((|multiplicativeValuation| T) - (|canonicalUnitNormal| T)) - '((|Fraction| (|Integer|)) (|Boolean|)) - NIL))))) - (SETF (|shellEntry| #0# 0) '(|IntegerNumberSystem|)) - #0#)) - -(DEFUN |IntegerNumberSystem| () - (COND - (|IntegerNumberSystem;AL|) - (T (SETQ |IntegerNumberSystem;AL| (|IntegerNumberSystem;|))))) - -(MAKEPROP '|IntegerNumberSystem| 'NILADIC T) diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp deleted file mode 100644 index 5e31c889..00000000 --- a/src/algebra/strap/INT.lsp +++ /dev/null @@ -1,720 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Void|) - |INT;writeOMInt|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%String|) - |INT;OMwrite;$S;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Boolean| |%Shell|) |%String|) - |INT;OMwrite;$BS;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Void|) - |INT;OMwrite;Omd$V;4|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Boolean| |%Shell|) - |%Void|) - |INT;OMwrite;Omd$BV;5|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Boolean|) - |INT;zero?;$B;6|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Boolean|) - |INT;one?;$B;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Integer|) |INT;Zero;$;8|)) - -(PUT '|INT;Zero;$;8| '|SPADreplace| '(XLAM NIL 0)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Integer|) |INT;One;$;9|)) - -(PUT '|INT;One;$;9| '|SPADreplace| '(XLAM NIL 1)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Integer|) |INT;base;$;10|)) - -(PUT '|INT;base;$;10| '|SPADreplace| '(XLAM NIL 2)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|) - |INT;copy;2$;11|)) - -(PUT '|INT;copy;2$;11| '|SPADreplace| '(XLAM (|x|) |x|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|) - |INT;inc;2$;12|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|) - |INT;dec;2$;13|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Short|) - |INT;hash;$Si;14|)) - -(PUT '|INT;hash;$Si;14| '|SPADreplace| '|%hash|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Boolean|) - |INT;negative?;$B;15|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|) - |INT;coerce;$Of;16|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|) - |INT;coerce;2$;17|)) - -(PUT '|INT;coerce;2$;17| '|SPADreplace| '(XLAM (|m|) |m|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|) - |INT;convert;2$;18|)) - -(PUT '|INT;convert;2$;18| '|SPADreplace| '(XLAM (|x|) |x|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|) - |INT;length;2$;19|)) - -(PUT '|INT;length;2$;19| '|SPADreplace| '|%ilength|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Integer| |%Shell|) - |%Integer|) - |INT;addmod;4$;20|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Integer| |%Shell|) - |%Integer|) - |INT;submod;4$;21|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Integer| |%Shell|) - |%Integer|) - |INT;mulmod;4$;22|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|) - |INT;convert;$F;23|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%DoubleFloat|) - |INT;convert;$Df;24|)) - -(PUT '|INT;convert;$Df;24| '|SPADreplace| '|%i2f|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|) - |INT;convert;$If;25|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%String|) - |INT;convert;$S;26|)) - -(PUT '|INT;convert;$S;26| '|SPADreplace| '|%i2s|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%String|) - |INT;latex;$S;27|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|) - |INT;positiveRemainder;3$;28|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |INT;reducedSystem;2M;29|)) - -(PUT '|INT;reducedSystem;2M;29| '|SPADreplace| '(XLAM (|m|) |m|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%Vector| *) |%Shell|) |%Pair|) - |INT;reducedSystem;MVR;30|)) - -(PUT '|INT;reducedSystem;MVR;30| '|SPADreplace| - '(XLAM (|m| |v|) (|%pair| |m| '|vec|))) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|) - |INT;abs;2$;31|)) - -(PUT '|INT;abs;2$;31| '|SPADreplace| '|%iabs|) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Integer|) |INT;random;$;32|)) - -(PUT '|INT;random;$;32| '|SPADreplace| '|random|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|) - |INT;random;2$;33|)) - -(PUT '|INT;random;2$;33| '|SPADreplace| 'RANDOM) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Boolean|) - |INT;=;2$B;34|)) - -(PUT '|INT;=;2$B;34| '|SPADreplace| '|%ieq|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Boolean|) - |INT;<;2$B;35|)) - -(PUT '|INT;<;2$B;35| '|SPADreplace| '|%ilt|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Boolean|) - |INT;>;2$B;36|)) - -(PUT '|INT;>;2$B;36| '|SPADreplace| '(XLAM (|x| |y|) (|%ilt| |y| |x|))) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Boolean|) - |INT;<=;2$B;37|)) - -(PUT '|INT;<=;2$B;37| '|SPADreplace| - '(XLAM (|x| |y|) (|%not| (|%ilt| |y| |x|)))) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Boolean|) - |INT;>=;2$B;38|)) - -(PUT '|INT;>=;2$B;38| '|SPADreplace| - '(XLAM (|x| |y|) (|%not| (|%ilt| |x| |y|)))) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|) - |INT;-;2$;39|)) - -(PUT '|INT;-;2$;39| '|SPADreplace| '|%ineg|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|) - |INT;+;3$;40|)) - -(PUT '|INT;+;3$;40| '|SPADreplace| '|%iadd|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|) - |INT;-;3$;41|)) - -(PUT '|INT;-;3$;41| '|SPADreplace| '|%isub|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|) - |INT;*;3$;42|)) - -(PUT '|INT;*;3$;42| '|SPADreplace| '|%imul|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|) - |INT;*;3$;43|)) - -(PUT '|INT;*;3$;43| '|SPADreplace| '|%imul|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| (|%IntegerSection| 0) |%Shell|) - |%Integer|) - |INT;**;$Nni$;44|)) - -(PUT '|INT;**;$Nni$;44| '|SPADreplace| '|%ipow|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Boolean|) - |INT;odd?;$B;45|)) - -(PUT '|INT;odd?;$B;45| '|SPADreplace| '|%iodd?|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|) - |INT;max;3$;46|)) - -(PUT '|INT;max;3$;46| '|SPADreplace| '|%imax|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|) - |INT;min;3$;47|)) - -(PUT '|INT;min;3$;47| '|SPADreplace| '|%imin|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Pair|) - |INT;divide;2$R;48|)) - -(PUT '|INT;divide;2$R;48| '|SPADreplace| '|%idivide|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|) - |INT;quo;3$;49|)) - -(PUT '|INT;quo;3$;49| '|SPADreplace| '|%iquo|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|) - |INT;rem;3$;50|)) - -(PUT '|INT;rem;3$;50| '|SPADreplace| '|%irem|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|) - |INT;shift;3$;51|)) - -(PUT '|INT;shift;3$;51| '|SPADreplace| 'ASH) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Pair|) - |INT;recip;$U;52|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|) - |INT;gcd;3$;53|)) - -(PUT '|INT;gcd;3$;53| '|SPADreplace| '|%igcd|) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Shell|) - |INT;unitNormal;$R;54|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|) - |INT;unitCanonical;2$;55|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%Pair|) - |INT;solveLinearPolynomialEquation|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |INT;squareFreePolynomial|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |INT;factorPolynomial|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |INT;factorSquareFreePolynomial|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |INT;gcdPolynomial;3Sup;60|)) - -(PUT '|INT;zero?;$B;6| '|SPADreplace| '(XLAM (|x|) (|%ieq| |x| 0))) - -(PUT '|INT;one?;$B;7| '|SPADreplace| '(XLAM (|x|) (|%ieq| |x| 1))) - -(PUT '|INT;inc;2$;12| '|SPADreplace| '(XLAM (|x|) (|%iadd| |x| 1))) - -(PUT '|INT;dec;2$;13| '|SPADreplace| '(XLAM (|x|) (|%isub| |x| 1))) - -(PUT '|INT;negative?;$B;15| '|SPADreplace| - '(XLAM (|x|) (|%ilt| |x| 0))) - -(PUT '|INT;mulmod;4$;22| '|SPADreplace| - '(XLAM (|a| |b| |p|) (|%irem| (|%imul| |a| |b|) |p|))) - -(PUT '|INT;unitCanonical;2$;55| '|SPADreplace| '|%iabs|) - -(DEFUN |INT;writeOMInt| (|dev| |x| $) - (COND - ((MINUSP |x|) - (SEQ (SPADCALL |dev| (|shellEntry| $ 10)) - (SPADCALL |dev| "arith1" "unary_minus" (|shellEntry| $ 12)) - (SPADCALL |dev| (- |x|) (|shellEntry| $ 15)) - (EXIT (SPADCALL |dev| (|shellEntry| $ 16))))) - (T (SPADCALL |dev| |x| (|shellEntry| $ 15))))) - -(DEFUN |INT;OMwrite;$S;2| (|x| $) - (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) - (|dev| (SPADCALL |sp| (SPADCALL (|shellEntry| $ 18)) - (|shellEntry| $ 19)))) - (SEQ (SPADCALL |dev| (|shellEntry| $ 20)) - (|INT;writeOMInt| |dev| |x| $) - (SPADCALL |dev| (|shellEntry| $ 21)) - (SPADCALL |dev| (|shellEntry| $ 22)) - (EXIT (OM-STRINGPTRTOSTRING |sp|))))) - -(DEFUN |INT;OMwrite;$BS;3| (|x| |wholeObj| $) - (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) - (|dev| (SPADCALL |sp| (SPADCALL (|shellEntry| $ 18)) - (|shellEntry| $ 19)))) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 20)))) - (|INT;writeOMInt| |dev| |x| $) - (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 21)))) - (SPADCALL |dev| (|shellEntry| $ 22)) - (EXIT (OM-STRINGPTRTOSTRING |sp|))))) - -(DEFUN |INT;OMwrite;Omd$V;4| (|dev| |x| $) - (SEQ (SPADCALL |dev| (|shellEntry| $ 20)) - (|INT;writeOMInt| |dev| |x| $) - (EXIT (SPADCALL |dev| (|shellEntry| $ 21))))) - -(DEFUN |INT;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 20)))) - (|INT;writeOMInt| |dev| |x| $) - (EXIT (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 21))))))) - -(DEFUN |INT;zero?;$B;6| (|x| $) (DECLARE (IGNORE $)) (ZEROP |x|)) - -(DEFUN |INT;one?;$B;7| (|x| $) (DECLARE (IGNORE $)) (EQL |x| 1)) - -(DEFUN |INT;Zero;$;8| ($) (DECLARE (IGNORE $)) 0) - -(DEFUN |INT;One;$;9| ($) (DECLARE (IGNORE $)) 1) - -(DEFUN |INT;base;$;10| ($) (DECLARE (IGNORE $)) 2) - -(DEFUN |INT;copy;2$;11| (|x| $) (DECLARE (IGNORE $)) |x|) - -(DEFUN |INT;inc;2$;12| (|x| $) (DECLARE (IGNORE $)) (+ |x| 1)) - -(DEFUN |INT;dec;2$;13| (|x| $) (DECLARE (IGNORE $)) (- |x| 1)) - -(DEFUN |INT;hash;$Si;14| (|x| $) (DECLARE (IGNORE $)) (SXHASH |x|)) - -(DEFUN |INT;negative?;$B;15| (|x| $) - (DECLARE (IGNORE $)) - (MINUSP |x|)) - -(DEFUN |INT;coerce;$Of;16| (|x| $) (SPADCALL |x| (|shellEntry| $ 42))) - -(DEFUN |INT;coerce;2$;17| (|m| $) (DECLARE (IGNORE $)) |m|) - -(DEFUN |INT;convert;2$;18| (|x| $) (DECLARE (IGNORE $)) |x|) - -(DEFUN |INT;length;2$;19| (|a| $) - (DECLARE (IGNORE $)) - (INTEGER-LENGTH |a|)) - -(DEFUN |INT;addmod;4$;20| (|a| |b| |p| $) - (LET ((|c| (+ |a| |b|))) - (COND ((NOT (< |c| |p|)) (- |c| |p|)) (T |c|)))) - -(DEFUN |INT;submod;4$;21| (|a| |b| |p| $) - (LET ((|c| (- |a| |b|))) (COND ((MINUSP |c|) (+ |c| |p|)) (T |c|)))) - -(DEFUN |INT;mulmod;4$;22| (|a| |b| |p| $) - (DECLARE (IGNORE $)) - (REM (* |a| |b|) |p|)) - -(DEFUN |INT;convert;$F;23| (|x| $) (SPADCALL |x| (|shellEntry| $ 53))) - -(DEFUN |INT;convert;$Df;24| (|x| $) - (DECLARE (IGNORE $)) - (FLOAT |x| |$DoubleFloatMaximum|)) - -(DEFUN |INT;convert;$If;25| (|x| $) - (SPADCALL |x| (|shellEntry| $ 59))) - -(DEFUN |INT;convert;$S;26| (|x| $) - (DECLARE (IGNORE $)) - (WRITE-TO-STRING |x|)) - -(DEFUN |INT;latex;$S;27| (|x| $) - (LET ((|s| (WRITE-TO-STRING |x|))) - (SEQ (COND ((AND (< -1 |x|) (< |x| 10)) (EXIT |s|))) - (EXIT (STRCONC "{" (STRCONC |s| "}")))))) - -(DEFUN |INT;positiveRemainder;3$;28| (|a| |b| $) - (PROG (|r|) - (RETURN - (COND - ((|INT;negative?;$B;15| - (LETT |r| (REM |a| |b|) |INT;positiveRemainder;3$;28|) $) - (COND ((MINUSP |b|) (- |r| |b|)) (T (+ |r| |b|)))) - (T |r|))))) - -(DEFUN |INT;reducedSystem;2M;29| (|m| $) (DECLARE (IGNORE $)) |m|) - -(DEFUN |INT;reducedSystem;MVR;30| (|m| |v| $) - (DECLARE (IGNORE $)) - (CONS |m| '|vec|)) - -(DEFUN |INT;abs;2$;31| (|x| $) (DECLARE (IGNORE $)) (ABS |x|)) - -(DEFUN |INT;random;$;32| ($) (DECLARE (IGNORE $)) (|random|)) - -(DEFUN |INT;random;2$;33| (|x| $) (DECLARE (IGNORE $)) (RANDOM |x|)) - -(DEFUN |INT;=;2$B;34| (|x| |y| $) (DECLARE (IGNORE $)) (EQL |x| |y|)) - -(DEFUN |INT;<;2$B;35| (|x| |y| $) (DECLARE (IGNORE $)) (< |x| |y|)) - -(DEFUN |INT;>;2$B;36| (|x| |y| $) (DECLARE (IGNORE $)) (< |y| |x|)) - -(DEFUN |INT;<=;2$B;37| (|x| |y| $) - (DECLARE (IGNORE $)) - (NOT (< |y| |x|))) - -(DEFUN |INT;>=;2$B;38| (|x| |y| $) - (DECLARE (IGNORE $)) - (NOT (< |x| |y|))) - -(DEFUN |INT;-;2$;39| (|x| $) (DECLARE (IGNORE $)) (- |x|)) - -(DEFUN |INT;+;3$;40| (|x| |y| $) (DECLARE (IGNORE $)) (+ |x| |y|)) - -(DEFUN |INT;-;3$;41| (|x| |y| $) (DECLARE (IGNORE $)) (- |x| |y|)) - -(DEFUN |INT;*;3$;42| (|x| |y| $) (DECLARE (IGNORE $)) (* |x| |y|)) - -(DEFUN |INT;*;3$;43| (|m| |y| $) (DECLARE (IGNORE $)) (* |m| |y|)) - -(DEFUN |INT;**;$Nni$;44| (|x| |n| $) - (DECLARE (IGNORE $)) - (EXPT |x| |n|)) - -(DEFUN |INT;odd?;$B;45| (|x| $) (DECLARE (IGNORE $)) (ODDP |x|)) - -(DEFUN |INT;max;3$;46| (|x| |y| $) (DECLARE (IGNORE $)) (MAX |x| |y|)) - -(DEFUN |INT;min;3$;47| (|x| |y| $) (DECLARE (IGNORE $)) (MIN |x| |y|)) - -(DEFUN |INT;divide;2$R;48| (|x| |y| $) - (DECLARE (IGNORE $)) - (MULTIPLE-VALUE-CALL #'CONS (TRUNCATE |x| |y|))) - -(DEFUN |INT;quo;3$;49| (|x| |y| $) - (DECLARE (IGNORE $)) - (TRUNCATE |x| |y|)) - -(DEFUN |INT;rem;3$;50| (|x| |y| $) (DECLARE (IGNORE $)) (REM |x| |y|)) - -(DEFUN |INT;shift;3$;51| (|x| |y| $) - (DECLARE (IGNORE $)) - (ASH |x| |y|)) - -(DEFUN |INT;recip;$U;52| (|x| $) - (COND - ((OR (EQL |x| 1) (EQL |x| -1)) (CONS 0 |x|)) - (T (CONS 1 "failed")))) - -(DEFUN |INT;gcd;3$;53| (|x| |y| $) (DECLARE (IGNORE $)) (GCD |x| |y|)) - -(DEFUN |INT;unitNormal;$R;54| (|x| $) - (COND ((MINUSP |x|) (VECTOR -1 (- |x|) -1)) (T (VECTOR 1 |x| 1)))) - -(DEFUN |INT;unitCanonical;2$;55| (|x| $) - (DECLARE (IGNORE $)) - (ABS |x|)) - -(DEFUN |INT;solveLinearPolynomialEquation| (|lp| |p| $) - (SPADCALL |lp| |p| (|shellEntry| $ 100))) - -(DEFUN |INT;squareFreePolynomial| (|p| $) - (SPADCALL |p| (|shellEntry| $ 104))) - -(DEFUN |INT;factorPolynomial| (|p| $) - (LET ((|pp| (SPADCALL |p| (|shellEntry| $ 105)))) - (COND - ((EQL (SPADCALL |pp| (|shellEntry| $ 106)) - (SPADCALL |p| (|shellEntry| $ 106))) - (SPADCALL |p| (|shellEntry| $ 108))) - (T (SPADCALL (SPADCALL |pp| (|shellEntry| $ 108)) - (SPADCALL (CONS #'|INT;factorPolynomial!0| $) - (SPADCALL - (LET ((#0=#:G1477 - (SPADCALL - (SPADCALL |p| (|shellEntry| $ 106)) - (SPADCALL |pp| (|shellEntry| $ 106)) - (|shellEntry| $ 110)))) - (|check-union| (ZEROP (CAR #0#)) $ #0#) - (CDR #0#)) - (|shellEntry| $ 112)) - (|shellEntry| $ 116)) - (|shellEntry| $ 118)))))) - -(DEFUN |INT;factorPolynomial!0| (|#1| $) - (SPADCALL |#1| (|shellEntry| $ 109))) - -(DEFUN |INT;factorSquareFreePolynomial| (|p| $) - (SPADCALL |p| (|shellEntry| $ 119))) - -(DEFUN |INT;gcdPolynomial;3Sup;60| (|p| |q| $) - (COND - ((SPADCALL |p| (|shellEntry| $ 120)) - (SPADCALL |q| (|shellEntry| $ 121))) - ((SPADCALL |q| (|shellEntry| $ 120)) - (SPADCALL |p| (|shellEntry| $ 121))) - (T (SPADCALL (LIST |p| |q|) (|shellEntry| $ 124))))) - -(DEFUN |Integer| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((#0=#:G1509 (HGET |$ConstructorCache| '|Integer|))) - (COND - (#0# (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Integer| - (LIST (CONS NIL (CONS 1 (|Integer;|)))))) - (SETQ #0# T)) - (COND ((NOT #0#) (HREM |$ConstructorCache| '|Integer|)))))))) - -(DEFUN |Integer;| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((|dv$| '(|Integer|)) ($ (|newShell| 139)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|haddProp| |$ConstructorCache| '|Integer| NIL (CONS 1 $)) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 81) - (SETF (|shellEntry| $ 80) - (CONS (|dispatchFunction| |INT;*;3$;43|) $))) - $)) - -(MAKEPROP '|Integer| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|Boolean|) |INT;negative?;$B;15| - (|Void|) (|OpenMathDevice|) (0 . |OMputApp|) (|String|) - (5 . |OMputSymbol|) |INT;-;2$;39| (|Integer|) - (12 . |OMputInteger|) (18 . |OMputEndApp|) - (|OpenMathEncoding|) (23 . |OMencodingXML|) - (27 . |OMopenString|) (33 . |OMputObject|) - (38 . |OMputEndObject|) (43 . |OMclose|) - |INT;OMwrite;$S;2| |INT;OMwrite;$BS;3| - |INT;OMwrite;Omd$V;4| |INT;OMwrite;Omd$BV;5| - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |INT;Zero;$;8|) $)) - |INT;=;2$B;34| |INT;zero?;$B;6| - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |INT;One;$;9|) $)) - |INT;one?;$B;7| |INT;base;$;10| |INT;copy;2$;11| - |INT;+;3$;40| |INT;inc;2$;12| |INT;-;3$;41| - |INT;dec;2$;13| (|SingleInteger|) |INT;hash;$Si;14| - |INT;<;2$B;35| (|OutputForm|) (48 . |outputForm|) - |INT;coerce;$Of;16| |INT;coerce;2$;17| |INT;convert;2$;18| - |INT;length;2$;19| |INT;>=;2$B;38| |INT;addmod;4$;20| - |INT;submod;4$;21| |INT;rem;3$;50| |INT;mulmod;4$;22| - (|Float|) (53 . |coerce|) |INT;convert;$F;23| - (|DoubleFloat|) (58 . |coerce|) |INT;convert;$Df;24| - (|InputForm|) (63 . |convert|) |INT;convert;$If;25| - |INT;convert;$S;26| (|NonNegativeInteger|) (68 . |One|) - (72 . <) (78 . |concat|) |INT;latex;$S;27| - |INT;positiveRemainder;3$;28| (|Matrix| 14) (|Matrix| $) - |INT;reducedSystem;2M;29| (|Vector| 14) - (|Record| (|:| |mat| 68) (|:| |vec| 71)) (|Vector| $) - |INT;reducedSystem;MVR;30| |INT;abs;2$;31| - |INT;random;$;32| |INT;random;2$;33| |INT;>;2$B;36| - |INT;<=;2$B;37| NIL NIL |INT;**;$Nni$;44| |INT;odd?;$B;45| - |INT;max;3$;46| |INT;min;3$;47| - (|Record| (|:| |quotient| $) (|:| |remainder| $)) - |INT;divide;2$R;48| |INT;quo;3$;49| |INT;shift;3$;51| - (|Union| $ '"failed") |INT;recip;$U;52| |INT;gcd;3$;53| - (|Record| (|:| |unit| $) (|:| |canonical| $) - (|:| |associate| $)) - |INT;unitNormal;$R;54| |INT;unitCanonical;2$;55| - (|SparseUnivariatePolynomial| 14) (|List| 96) - (|Union| 97 '"failed") - (|IntegerSolveLinearPolynomialEquation|) - (84 . |solveLinearPolynomialEquation|) - (|SparseUnivariatePolynomial| $$) (|Factored| 101) - (|UnivariatePolynomialSquareFree| $$ 101) - (90 . |squareFree|) (95 . |primitivePart|) - (100 . |leadingCoefficient|) (|GaloisGroupFactorizer| 101) - (105 . |factor|) (110 . |coerce|) (115 . |exquo|) - (|Factored| $) (121 . |factor|) (|Mapping| 101 $$) - (|Factored| $$) (|FactoredFunctions2| $$ 101) - (126 . |map|) (|FactoredFunctionUtilities| 101) - (132 . |mergeFactors|) (138 . |factorSquareFree|) - (143 . |zero?|) (148 . |unitCanonical|) (|List| 101) - (|HeuGcd| 101) (153 . |gcd|) - (|SparseUnivariatePolynomial| $) - |INT;gcdPolynomial;3Sup;60| (|Fraction| 14) - (|Union| 127 '"failed") (|Pattern| 14) - (|PatternMatchResult| 14 $) (|Union| 14 '"failed") - (|List| $) (|Record| (|:| |coef| 132) (|:| |generator| $)) - (|Union| 132 '"failed") - (|Record| (|:| |coef1| $) (|:| |coef2| $) - (|:| |generator| $)) - (|Record| (|:| |coef1| $) (|:| |coef2| $)) - (|Union| 136 '"failed") (|PositiveInteger|)) - '#(~= 158 |zero?| 164 |unitNormal| 169 |unitCanonical| 174 - |unit?| 179 |symmetricRemainder| 184 |subtractIfCan| 190 - |submod| 196 |squareFreePart| 203 |squareFree| 208 - |sizeLess?| 213 |sign| 219 |shift| 224 |sample| 230 - |retractIfCan| 234 |retract| 239 |rem| 244 |reducedSystem| - 250 |recip| 261 |rationalIfCan| 266 |rational?| 271 - |rational| 276 |random| 281 |quo| 290 |principalIdeal| 296 - |prime?| 301 |powmod| 306 |positiveRemainder| 313 - |positive?| 319 |permutation| 324 |patternMatch| 330 - |one?| 337 |odd?| 342 |nextItem| 347 |negative?| 352 - |multiEuclidean| 357 |mulmod| 363 |min| 370 |max| 376 - |mask| 382 |length| 387 |leftReducedSystem| 392 |lcm| 403 - |latex| 414 |invmod| 419 |init| 425 |inc| 429 |hash| 434 - |gcdPolynomial| 439 |gcd| 445 |factorial| 456 |factor| 461 - |extendedEuclidean| 466 |exquo| 479 |expressIdealMember| - 485 |even?| 491 |euclideanSize| 496 |divide| 501 - |differentiate| 507 |dec| 518 |copy| 523 |convert| 528 - |coerce| 558 |characteristic| 578 |bit?| 582 |binomial| - 588 |before?| 594 |base| 600 |associates?| 604 |addmod| - 610 |abs| 617 |Zero| 622 |One| 626 |OMwrite| 630 D 654 >= - 665 > 671 = 677 <= 683 < 689 - 695 + 706 ** 712 * 724) - '((|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 0 0 0 0 - 0 0 0 0 0 0 0)) - (CONS '#(|IntegerNumberSystem&| |EuclideanDomain&| - |UniqueFactorizationDomain&| NIL NIL - |GcdDomain&| |IntegralDomain&| |Algebra&| NIL - NIL |OrderedRing&| NIL NIL |Module&| NIL NIL - |Ring&| NIL NIL NIL NIL NIL NIL - |AbelianGroup&| NIL NIL NIL NIL - |AbelianMonoid&| |Monoid&| NIL NIL NIL NIL NIL - |AbelianSemiGroup&| |SemiGroup&| NIL - |DifferentialSpace&| |OrderedType&| - |SetCategory&| NIL |RetractableTo&| - |DifferentialDomain&| |BasicType&| NIL NIL NIL - NIL NIL NIL NIL NIL NIL NIL NIL NIL) - (CONS '#((|IntegerNumberSystem|) - (|EuclideanDomain|) - (|UniqueFactorizationDomain|) - (|PrincipalIdealDomain|) - (|OrderedIntegralDomain|) (|GcdDomain|) - (|IntegralDomain|) (|Algebra| $$) - (|CharacteristicZero|) - (|DifferentialRing|) (|OrderedRing|) - (|CommutativeRing|) (|EntireRing|) - (|Module| $$) - (|LinearlyExplicitRingOver| 14) - (|BiModule| $$ $$) (|Ring|) - (|LeftModule| 14) - (|OrderedAbelianGroup|) - (|LeftModule| $$) (|Rng|) - (|RightModule| $$) - (|OrderedCancellationAbelianMonoid|) - (|AbelianGroup|) - (|OrderedAbelianMonoid|) - (|CancellationAbelianMonoid|) - (|OrderedAbelianSemiGroup|) - (|LinearSet| $$) (|AbelianMonoid|) - (|Monoid|) (|StepThrough|) - (|PatternMatchable| 14) (|OrderedSet|) - (|LeftLinearSet| $$) - (|RightLinearSet| $$) - (|AbelianSemiGroup|) (|SemiGroup|) - (|LeftLinearSet| 14) - (|DifferentialSpace|) (|OrderedType|) - (|SetCategory|) (|RealConstant|) - (|RetractableTo| 14) - (|DifferentialDomain| $$) (|BasicType|) - (|OpenMath|) (|ConvertibleTo| 11) - (|ConvertibleTo| 52) - (|ConvertibleTo| 55) - (|CombinatorialFunctionCategory|) - (|ConvertibleTo| 129) - (|ConvertibleTo| 58) - (|ConvertibleTo| 14) - (|CoercibleFrom| $$) - (|CoercibleFrom| 14) (|Type|) - (|CoercibleTo| 41)) - (|makeByteWordVec2| 138 - '(1 9 8 0 10 3 9 8 0 11 11 12 2 9 8 0 - 14 15 1 9 8 0 16 0 17 0 18 2 9 0 11 - 17 19 1 9 8 0 20 1 9 8 0 21 1 9 8 0 - 22 1 41 0 14 42 1 52 0 14 53 1 55 0 - 14 56 1 58 0 14 59 0 62 0 63 2 14 6 0 - 0 64 2 11 0 0 0 65 2 99 98 97 96 100 - 1 103 102 101 104 1 101 0 0 105 1 101 - 2 0 106 1 107 102 101 108 1 101 0 2 - 109 2 0 90 0 0 110 1 0 111 0 112 2 - 115 102 113 114 116 2 117 102 102 102 - 118 1 107 102 101 119 1 101 6 0 120 1 - 101 0 0 121 1 123 101 122 124 2 0 6 0 - 0 1 1 0 6 0 29 1 0 93 0 94 1 0 0 0 95 - 1 0 6 0 1 2 0 0 0 0 1 2 0 90 0 0 1 3 - 0 0 0 0 0 49 1 0 0 0 1 1 0 111 0 1 2 - 0 6 0 0 1 1 0 14 0 1 2 0 0 0 0 89 0 0 - 0 1 1 0 131 0 1 1 0 14 0 1 2 0 0 0 0 - 50 1 0 68 69 70 2 0 72 69 73 74 1 0 - 90 0 91 1 0 128 0 1 1 0 6 0 1 1 0 127 - 0 1 0 0 0 76 1 0 0 0 77 2 0 0 0 0 88 - 1 0 133 132 1 1 0 6 0 1 3 0 0 0 0 0 1 - 2 0 0 0 0 67 1 0 6 0 1 2 0 0 0 0 1 3 - 0 130 0 129 130 1 1 0 6 0 31 1 0 6 0 - 83 1 0 90 0 1 1 0 6 0 7 2 0 134 132 0 - 1 3 0 0 0 0 0 51 2 0 0 0 0 85 2 0 0 0 - 0 84 1 0 0 0 1 1 0 0 0 46 2 0 72 73 0 - 1 1 0 68 73 1 2 0 0 0 0 1 1 0 0 132 1 - 1 0 11 0 66 2 0 0 0 0 1 0 0 0 1 1 0 0 - 0 35 1 0 38 0 39 2 0 125 125 125 126 - 2 0 0 0 0 92 1 0 0 132 1 1 0 0 0 1 1 - 0 111 0 112 2 0 135 0 0 1 3 0 137 0 0 - 0 1 2 0 90 0 0 110 2 0 134 132 0 1 1 - 0 6 0 1 1 0 62 0 1 2 0 86 0 0 87 2 0 - 0 0 62 1 1 0 0 0 1 1 0 0 0 37 1 0 0 0 - 33 1 0 11 0 61 1 0 55 0 57 1 0 52 0 - 54 1 0 129 0 1 1 0 58 0 60 1 0 14 0 - 45 1 0 0 14 44 1 0 0 0 1 1 0 0 14 44 - 1 0 41 0 43 0 0 62 1 2 0 6 0 0 1 2 0 - 0 0 0 1 2 0 6 0 0 1 0 0 0 32 2 0 6 0 - 0 1 3 0 0 0 0 0 48 1 0 0 0 75 0 0 0 - 27 0 0 0 30 3 0 8 9 0 6 26 2 0 11 0 6 - 24 2 0 8 9 0 25 1 0 11 0 23 2 0 0 0 - 62 1 1 0 0 0 1 2 0 6 0 0 47 2 0 6 0 0 - 78 2 0 6 0 0 28 2 0 6 0 0 79 2 0 6 0 - 0 40 1 0 0 0 13 2 0 0 0 0 36 2 0 0 0 - 0 34 2 0 0 0 62 82 2 0 0 0 138 1 2 0 - 0 14 0 81 2 0 0 0 0 80 2 0 0 14 0 81 - 2 0 0 62 0 1 2 0 0 138 0 1))))) - '|lookupComplete|)) - -(MAKEPROP '|Integer| 'NILADIC T) diff --git a/src/algebra/strap/INTDOM-.lsp b/src/algebra/strap/INTDOM-.lsp deleted file mode 100644 index ccb1ee57..00000000 --- a/src/algebra/strap/INTDOM-.lsp +++ /dev/null @@ -1,92 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Shell|) - |INTDOM-;unitNormal;SR;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |INTDOM-;unitCanonical;2S;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |INTDOM-;recip;SU;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |INTDOM-;unit?;SB;4|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |INTDOM-;associates?;2SB;5|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |INTDOM-;associates?;2SB;6|)) - -(DEFUN |INTDOM-;unitNormal;SR;1| (|x| $) - (VECTOR (|spadConstant| $ 7) |x| (|spadConstant| $ 7))) - -(DEFUN |INTDOM-;unitCanonical;2S;2| (|x| $) - (SVREF (SPADCALL |x| (|shellEntry| $ 10)) 1)) - -(DEFUN |INTDOM-;recip;SU;3| (|x| $) - (COND - ((SPADCALL |x| (|shellEntry| $ 13)) (CONS 1 "failed")) - (T (SPADCALL (|spadConstant| $ 7) |x| (|shellEntry| $ 15))))) - -(DEFUN |INTDOM-;unit?;SB;4| (|x| $) - (NOT (EQL (CAR (SPADCALL |x| (|shellEntry| $ 17))) 1))) - -(DEFUN |INTDOM-;associates?;2SB;5| (|x| |y| $) - (SPADCALL (SVREF (SPADCALL |x| (|shellEntry| $ 10)) 1) - (SVREF (SPADCALL |y| (|shellEntry| $ 10)) 1) (|shellEntry| $ 21))) - -(DEFUN |INTDOM-;associates?;2SB;6| (|x| |y| $) - (COND - ((SPADCALL |x| (|shellEntry| $ 13)) - (SPADCALL |y| (|shellEntry| $ 13))) - (T (AND (NOT (SPADCALL |y| (|shellEntry| $ 13))) - (AND (NOT (EQL (CAR (SPADCALL |x| |y| (|shellEntry| $ 15))) - 1)) - (NOT (EQL (CAR (SPADCALL |y| |x| (|shellEntry| $ 15))) - 1))))))) - -(DEFUN |IntegralDomain&| (|#1|) - (LET* ((|dv$1| (|devaluate| |#1|)) - (|dv$| (LIST '|IntegralDomain&| |dv$1|)) ($ (|newShell| 23)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (COND - ((|HasCategory| |#1| '(|Field|))) - (T (SETF (|shellEntry| $ 9) - (CONS (|dispatchFunction| |INTDOM-;unitNormal;SR;1|) $)))) - (COND - ((|HasAttribute| |#1| '|canonicalUnitNormal|) - (SETF (|shellEntry| $ 22) - (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;5|) $))) - (T (SETF (|shellEntry| $ 22) - (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|) (30 . |false|) (34 . |true|) - |INTDOM-;unit?;SB;4| (38 . =) (44 . |associates?|)) - '#(|unitNormal| 50 |unitCanonical| 55 |unit?| 60 |recip| 65 - |associates?| 70) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 22 - '(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 0 12 0 - 18 0 12 0 19 2 6 12 0 0 21 2 0 12 0 0 - 22 1 0 8 0 9 1 0 0 0 11 1 0 12 0 20 1 - 0 14 0 16 2 0 12 0 0 22))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/INTDOM.lsp b/src/algebra/strap/INTDOM.lsp deleted file mode 100644 index 4efcfa2d..00000000 --- a/src/algebra/strap/INTDOM.lsp +++ /dev/null @@ -1,29 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |IntegralDomain;AL| 'NIL) - -(DEFUN |IntegralDomain;| () - (LET ((#0=#:G1378 - (|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)))) - (SETF (|shellEntry| #0# 0) '(|IntegralDomain|)) - #0#)) - -(DEFUN |IntegralDomain| () - (COND - (|IntegralDomain;AL|) - (T (SETQ |IntegralDomain;AL| (|IntegralDomain;|))))) - -(MAKEPROP '|IntegralDomain| 'NILADIC T) diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp deleted file mode 100644 index cbb527db..00000000 --- a/src/algebra/strap/ISTRING.lsp +++ /dev/null @@ -1,824 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) |%Char| |%Shell|) - |%Thing|) - |ISTRING;new;NniC$;1|)) - -(PUT '|ISTRING;new;NniC$;1| '|SPADreplace| 'MAKE-FULL-CVEC) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |ISTRING;empty;$;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |ISTRING;empty?;$B;3|)) - -(PUT '|ISTRING;empty?;$B;3| '|SPADreplace| - '(XLAM (|s|) (|%ieq| (|%strlength| |s|) 0))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0)) - |ISTRING;#;$Nni;4|)) - -(PUT '|ISTRING;#;$Nni;4| '|SPADreplace| '|%strlength|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |ISTRING;=;2$B;5|)) - -(PUT '|ISTRING;=;2$B;5| '|SPADreplace| '|%streq|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |ISTRING;<;2$B;6|)) - -(PUT '|ISTRING;<;2$B;6| '|SPADreplace| '|%strlt|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |ISTRING;concat;3$;7|)) - -(PUT '|ISTRING;concat;3$;7| '|SPADreplace| '|%strconc|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |ISTRING;copy;2$;8|)) - -(PUT '|ISTRING;copy;2$;8| '|SPADreplace| '|%strcopy|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|) - |%Thing|) - |ISTRING;insert;2$I$;9|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |ISTRING;coerce;$Of;10|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|) - |ISTRING;minIndex;$I;11|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |ISTRING;upperCase!;2$;12|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |ISTRING;lowerCase!;2$;13|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%String|) - |ISTRING;latex;$S;14|)) - -(PUT '|ISTRING;latex;$S;14| '|SPADreplace| - '(XLAM (|s|) (|%strconc| "\\mbox{``" (|%strconc| |s| "''}")))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |ISTRING;replace;$Us2$;15|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Char| |%Shell|) - |%Char|) - |ISTRING;setelt;$I2C;16|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|) - |%Boolean|) - |ISTRING;substring?;2$IB;17|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|) - |%Integer|) - |ISTRING;position;2$2I;18|)) - -(DECLAIM (FTYPE (FUNCTION (|%Char| |%Thing| |%Integer| |%Shell|) - |%Integer|) - |ISTRING;position;C$2I;19|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|) - |%Integer|) - |ISTRING;position;Cc$2I;20|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |ISTRING;suffix?;2$B;21|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Char| |%Shell|) |%List|) - |ISTRING;split;$CL;22|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%List|) - |ISTRING;split;$CcL;23|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Char| |%Shell|) |%Thing|) - |ISTRING;leftTrim;$C$;24|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |ISTRING;leftTrim;$Cc$;25|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Char| |%Shell|) |%Thing|) - |ISTRING;rightTrim;$C$;26|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |ISTRING;rightTrim;$Cc$;27|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |ISTRING;concat;L$;28|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|) - |%Thing|) - |ISTRING;copyInto!;2$I$;29|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Char|) - |ISTRING;elt;$IC;30|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |ISTRING;elt;$Us$;31|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Short|) - |ISTRING;hash;$Si;32|)) - -(PUT '|ISTRING;hash;$Si;32| '|SPADreplace| '|%hash|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Char| |%Shell|) - (|%IntegerSection| 0)) - |ISTRING;match;2$CNni;33|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Char| |%Shell|) - |%Boolean|) - |ISTRING;match?;2$CB;34|)) - -(DEFUN |ISTRING;new;NniC$;1| (|n| |c| $) - (DECLARE (IGNORE $)) - (MAKE-FULL-CVEC |n| |c|)) - -(DEFUN |ISTRING;empty;$;2| ($) (MAKE-FULL-CVEC 0)) - -(DEFUN |ISTRING;empty?;$B;3| (|s| $) - (DECLARE (IGNORE $)) - (ZEROP (LENGTH |s|))) - -(DEFUN |ISTRING;#;$Nni;4| (|s| $) (DECLARE (IGNORE $)) (LENGTH |s|)) - -(DEFUN |ISTRING;=;2$B;5| (|s| |t| $) - (DECLARE (IGNORE $)) - (NOT (NULL (STRING= |s| |t|)))) - -(DEFUN |ISTRING;<;2$B;6| (|s| |t| $) - (DECLARE (IGNORE $)) - (NOT (NULL (STRING< |s| |t|)))) - -(DEFUN |ISTRING;concat;3$;7| (|s| |t| $) - (DECLARE (IGNORE $)) - (STRCONC |s| |t|)) - -(DEFUN |ISTRING;copy;2$;8| (|s| $) - (DECLARE (IGNORE $)) - (COPY-SEQ |s|)) - -(DEFUN |ISTRING;insert;2$I$;9| (|s| |t| |i| $) - (STRCONC (STRCONC (|ISTRING;elt;$Us$;31| |s| - (SPADCALL (SVREF $ 6) (- |i| 1) - (|shellEntry| $ 24)) - $) - |t|) - (|ISTRING;elt;$Us$;31| |s| - (SPADCALL |i| (|shellEntry| $ 26)) $))) - -(DEFUN |ISTRING;coerce;$Of;10| (|s| $) - (SPADCALL |s| (|shellEntry| $ 30))) - -(DEFUN |ISTRING;minIndex;$I;11| (|s| $) (SVREF $ 6)) - -(DEFUN |ISTRING;upperCase!;2$;12| (|s| $) - (SPADCALL (ELT $ 35) |s| (|shellEntry| $ 37))) - -(DEFUN |ISTRING;lowerCase!;2$;13| (|s| $) - (SPADCALL (ELT $ 40) |s| (|shellEntry| $ 37))) - -(DEFUN |ISTRING;latex;$S;14| (|s| $) - (DECLARE (IGNORE $)) - (STRCONC "\\mbox{``" (STRCONC |s| "''}"))) - -(DEFUN |ISTRING;replace;$Us2$;15| (|s| |sg| |t| $) - (PROG (|r| |k|) - (RETURN - (LET ((|l| (- (SPADCALL |sg| (|shellEntry| $ 44)) (SVREF $ 6))) - (|m| (LENGTH |s|)) (|n| (LENGTH |t|)) - (|h| (COND - ((SPADCALL |sg| (|shellEntry| $ 45)) - (- (SPADCALL |sg| (|shellEntry| $ 46)) (SVREF $ 6))) - (T (- (SPADCALL |s| (|shellEntry| $ 47)) - (SVREF $ 6)))))) - (COND - ((OR (OR (MINUSP |l|) (NOT (< |h| |m|))) (< |h| (- |l| 1))) - (|error| "index out of range")) - (T (SEQ (LETT |r| - (MAKE-FULL-CVEC - (LET ((#0=#:G1420 - (+ (- |m| (+ (- |h| |l|) 1)) |n|))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|spadConstant| $ 53)) - |ISTRING;replace;$Us2$;15|) - (LETT |k| 0 |ISTRING;replace;$Us2$;15|) - (LET ((|i| 0) (#1=#:G1511 (- |l| 1))) - (LOOP - (COND - ((> |i| #1#) (RETURN NIL)) - (T (SEQ (SETF (CHAR |r| |k|) (CHAR |s| |i|)) - (EXIT (SETQ |k| (+ |k| 1)))))) - (SETQ |i| (+ |i| 1)))) - (LET ((|i| 0) (#2=#:G1512 (- |n| 1))) - (LOOP - (COND - ((> |i| #2#) (RETURN NIL)) - (T (SEQ (SETF (CHAR |r| |k|) (CHAR |t| |i|)) - (EXIT (SETQ |k| (+ |k| 1)))))) - (SETQ |i| (+ |i| 1)))) - (LET ((|i| (+ |h| 1)) (#3=#:G1513 (- |m| 1))) - (LOOP - (COND - ((> |i| #3#) (RETURN NIL)) - (T (SEQ (SETF (CHAR |r| |k|) (CHAR |s| |i|)) - (EXIT (SETQ |k| (+ |k| 1)))))) - (SETQ |i| (+ |i| 1)))) - (EXIT |r|)))))))) - -(DEFUN |ISTRING;setelt;$I2C;16| (|s| |i| |c| $) - (COND - ((OR (< |i| (SVREF $ 6)) - (< (SPADCALL |s| (|shellEntry| $ 47)) |i|)) - (|error| "index out of range")) - (T (SEQ (SETF (CHAR |s| (- |i| (SVREF $ 6))) |c|) (EXIT |c|))))) - -(DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $) - (LET ((|np| (LENGTH |part|)) (|nw| (LENGTH |whole|))) - (SEQ (SETQ |startpos| (- |startpos| (SVREF $ 6))) - (EXIT (COND - ((MINUSP |startpos|) (|error| "index out of bounds")) - (T (AND (NOT (< (- |nw| |startpos|) |np|)) - (SEQ (LET ((|ip| 0) (#0=#:G1514 (- |np| 1)) - (|iw| |startpos|)) - (LOOP - (COND - ((> |ip| #0#) (RETURN NIL)) - (T - (COND - ((NOT - (CHAR= (CHAR |part| |ip|) - (CHAR |whole| |iw|))) - (RETURN-FROM - |ISTRING;substring?;2$IB;17| - NIL))))) - (SETQ |ip| (+ |ip| 1)) - (SETQ |iw| (+ |iw| 1)))) - (EXIT T))))))))) - -(DEFUN |ISTRING;position;2$2I;18| (|s| |t| |startpos| $) - (PROG (|r|) - (RETURN - (SEQ (SETQ |startpos| (- |startpos| (SVREF $ 6))) - (EXIT (COND - ((MINUSP |startpos|) - (|error| "index out of bounds")) - ((NOT (< |startpos| (LENGTH |t|))) - (- (SVREF $ 6) 1)) - (T (SEQ (LETT |r| (STRPOS |s| |t| |startpos| NIL) - |ISTRING;position;2$2I;18|) - (EXIT (COND - ((EQ |r| NIL) (- (SVREF $ 6) 1)) - (T (+ |r| (SVREF $ 6))))))))))))) - -(DEFUN |ISTRING;position;C$2I;19| (|c| |t| |startpos| $) - (SEQ (SETQ |startpos| (- |startpos| (SVREF $ 6))) - (EXIT (COND - ((MINUSP |startpos|) (|error| "index out of bounds")) - ((NOT (< |startpos| (LENGTH |t|))) (- (SVREF $ 6) 1)) - (T (SEQ (LET ((|r| |startpos|) - (#0=#:G1515 (- (LENGTH |t|) 1))) - (LOOP - (COND - ((> |r| #0#) (RETURN NIL)) - (T (COND - ((CHAR= (CHAR |t| |r|) |c|) - (RETURN-FROM - |ISTRING;position;C$2I;19| - (+ |r| (SVREF $ 6))))))) - (SETQ |r| (+ |r| 1)))) - (EXIT (- (SVREF $ 6) 1)))))))) - -(DEFUN |ISTRING;position;Cc$2I;20| (|cc| |t| |startpos| $) - (SEQ (SETQ |startpos| (- |startpos| (SVREF $ 6))) - (EXIT (COND - ((MINUSP |startpos|) (|error| "index out of bounds")) - ((NOT (< |startpos| (LENGTH |t|))) (- (SVREF $ 6) 1)) - (T (SEQ (LET ((|r| |startpos|) - (#0=#:G1516 (- (LENGTH |t|) 1))) - (LOOP - (COND - ((> |r| #0#) (RETURN NIL)) - (T (COND - ((SPADCALL (CHAR |t| |r|) |cc| - (|shellEntry| $ 65)) - (RETURN-FROM - |ISTRING;position;Cc$2I;20| - (+ |r| (SVREF $ 6))))))) - (SETQ |r| (+ |r| 1)))) - (EXIT (- (SVREF $ 6) 1)))))))) - -(DEFUN |ISTRING;suffix?;2$B;21| (|s| |t| $) - (LET ((|m| (SPADCALL |s| (|shellEntry| $ 47))) - (|n| (SPADCALL |t| (|shellEntry| $ 47)))) - (AND (NOT (< |n| |m|)) - (|ISTRING;substring?;2$IB;17| |s| |t| - (- (+ (SVREF $ 6) |n|) |m|) $)))) - -(DEFUN |ISTRING;split;$CL;22| (|s| |c| $) - (PROG (|l| |j|) - (RETURN - (LET ((|n| (SPADCALL |s| (|shellEntry| $ 47))) (|i| (SVREF $ 6))) - (SEQ (LOOP - (COND - ((NOT (AND (NOT (< |n| |i|)) - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) - |c| (|shellEntry| $ 70)))) - (RETURN NIL)) - (T (SETQ |i| (+ |i| 1))))) - (LETT |l| NIL |ISTRING;split;$CL;22|) - (LOOP - (COND - ((NOT (AND (NOT (< |n| |i|)) - (NOT (< (LETT |j| - (|ISTRING;position;C$2I;19| |c| - |s| |i| $) - |ISTRING;split;$CL;22|) - (SVREF $ 6))))) - (RETURN NIL)) - (T (SEQ (SETQ |l| - (SPADCALL - (|ISTRING;elt;$Us$;31| |s| - (SPADCALL |i| (- |j| 1) - (|shellEntry| $ 24)) - $) - |l| (|shellEntry| $ 73))) - (SETQ |i| |j|) - (EXIT (LOOP - (COND - ((NOT - (AND (NOT (< |n| |i|)) - (SPADCALL - (|ISTRING;elt;$IC;30| |s| |i| $) - |c| (|shellEntry| $ 70)))) - (RETURN NIL)) - (T (SETQ |i| (+ |i| 1)))))))))) - (COND - ((NOT (< |n| |i|)) - (SETQ |l| - (SPADCALL - (|ISTRING;elt;$Us$;31| |s| - (SPADCALL |i| |n| (|shellEntry| $ 24)) $) - |l| (|shellEntry| $ 73))))) - (EXIT (NREVERSE |l|))))))) - -(DEFUN |ISTRING;split;$CcL;23| (|s| |cc| $) - (PROG (|l| |j|) - (RETURN - (LET ((|n| (SPADCALL |s| (|shellEntry| $ 47))) (|i| (SVREF $ 6))) - (SEQ (LOOP - (COND - ((NOT (AND (NOT (< |n| |i|)) - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) - |cc| (|shellEntry| $ 65)))) - (RETURN NIL)) - (T (SETQ |i| (+ |i| 1))))) - (LETT |l| NIL |ISTRING;split;$CcL;23|) - (LOOP - (COND - ((NOT (AND (NOT (< |n| |i|)) - (NOT (< (LETT |j| - (|ISTRING;position;Cc$2I;20| |cc| - |s| |i| $) - |ISTRING;split;$CcL;23|) - (SVREF $ 6))))) - (RETURN NIL)) - (T (SEQ (SETQ |l| - (SPADCALL - (|ISTRING;elt;$Us$;31| |s| - (SPADCALL |i| (- |j| 1) - (|shellEntry| $ 24)) - $) - |l| (|shellEntry| $ 73))) - (SETQ |i| |j|) - (EXIT (LOOP - (COND - ((NOT - (AND (NOT (< |n| |i|)) - (SPADCALL - (|ISTRING;elt;$IC;30| |s| |i| $) - |cc| (|shellEntry| $ 65)))) - (RETURN NIL)) - (T (SETQ |i| (+ |i| 1)))))))))) - (COND - ((NOT (< |n| |i|)) - (SETQ |l| - (SPADCALL - (|ISTRING;elt;$Us$;31| |s| - (SPADCALL |i| |n| (|shellEntry| $ 24)) $) - |l| (|shellEntry| $ 73))))) - (EXIT (NREVERSE |l|))))))) - -(DEFUN |ISTRING;leftTrim;$C$;24| (|s| |c| $) - (LET ((|n| (SPADCALL |s| (|shellEntry| $ 47))) (|i| (SVREF $ 6))) - (SEQ (LOOP - (COND - ((NOT (AND (NOT (< |n| |i|)) - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |c| - (|shellEntry| $ 70)))) - (RETURN NIL)) - (T (SETQ |i| (+ |i| 1))))) - (EXIT (|ISTRING;elt;$Us$;31| |s| - (SPADCALL |i| |n| (|shellEntry| $ 24)) $))))) - -(DEFUN |ISTRING;leftTrim;$Cc$;25| (|s| |cc| $) - (LET ((|n| (SPADCALL |s| (|shellEntry| $ 47))) (|i| (SVREF $ 6))) - (SEQ (LOOP - (COND - ((NOT (AND (NOT (< |n| |i|)) - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |cc| - (|shellEntry| $ 65)))) - (RETURN NIL)) - (T (SETQ |i| (+ |i| 1))))) - (EXIT (|ISTRING;elt;$Us$;31| |s| - (SPADCALL |i| |n| (|shellEntry| $ 24)) $))))) - -(DEFUN |ISTRING;rightTrim;$C$;26| (|s| |c| $) - (LET ((|j| (SPADCALL |s| (|shellEntry| $ 47)))) - (SEQ (LOOP - (COND - ((NOT (AND (NOT (< |j| (SVREF $ 6))) - (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) |c| - (|shellEntry| $ 70)))) - (RETURN NIL)) - (T (SETQ |j| (- |j| 1))))) - (EXIT (|ISTRING;elt;$Us$;31| |s| - (SPADCALL (|ISTRING;minIndex;$I;11| |s| $) |j| - (|shellEntry| $ 24)) - $))))) - -(DEFUN |ISTRING;rightTrim;$Cc$;27| (|s| |cc| $) - (LET ((|j| (SPADCALL |s| (|shellEntry| $ 47)))) - (SEQ (LOOP - (COND - ((NOT (AND (NOT (< |j| (SVREF $ 6))) - (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) |cc| - (|shellEntry| $ 65)))) - (RETURN NIL)) - (T (SETQ |j| (- |j| 1))))) - (EXIT (|ISTRING;elt;$Us$;31| |s| - (SPADCALL (|ISTRING;minIndex;$I;11| |s| $) |j| - (|shellEntry| $ 24)) - $))))) - -(DEFUN |ISTRING;concat;L$;28| (|l| $) - (LET ((|t| (MAKE-FULL-CVEC - (LET ((#0=#:G1473 NIL) (#1=#:G1474 T) - (#2=#:G1518 |l|)) - (LOOP - (COND - ((ATOM #2#) (RETURN (COND (#1# 0) (T #0#)))) - (T (LET ((|s| (CAR #2#))) - (LET ((#3=#:G1472 (LENGTH |s|))) - (COND - (#1# (SETQ #0# #3#)) - (T (SETQ #0# (+ #0# #3#)))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#)))) - (|spadConstant| $ 53))) - (|i| (SVREF $ 6))) - (SEQ (LET ((#4=#:G1517 |l|)) - (LOOP - (COND - ((ATOM #4#) (RETURN NIL)) - (T (LET ((|s| (CAR #4#))) - (SEQ (|ISTRING;copyInto!;2$I$;29| |t| |s| |i| $) - (EXIT (SETQ |i| (+ |i| (LENGTH |s|)))))))) - (SETQ #4# (CDR #4#)))) - (EXIT |t|)))) - -(DEFUN |ISTRING;copyInto!;2$I$;29| (|y| |x| |s| $) - (LET ((|m| (LENGTH |x|)) (|n| (LENGTH |y|))) - (SEQ (SETQ |s| (- |s| (SVREF $ 6))) - (EXIT (COND - ((OR (MINUSP |s|) (< |n| (+ |s| |m|))) - (|error| "index out of range")) - (T (SEQ (RPLACSTR |y| |s| |m| |x| 0 |m|) (EXIT |y|)))))))) - -(DEFUN |ISTRING;elt;$IC;30| (|s| |i| $) - (COND - ((OR (< |i| (SVREF $ 6)) - (< (SPADCALL |s| (|shellEntry| $ 47)) |i|)) - (|error| "index out of range")) - (T (CHAR |s| (- |i| (SVREF $ 6)))))) - -(DEFUN |ISTRING;elt;$Us$;31| (|s| |sg| $) - (LET ((|l| (- (SPADCALL |sg| (|shellEntry| $ 44)) (SVREF $ 6))) - (|h| (COND - ((SPADCALL |sg| (|shellEntry| $ 45)) - (- (SPADCALL |sg| (|shellEntry| $ 46)) (SVREF $ 6))) - (T (- (SPADCALL |s| (|shellEntry| $ 47)) (SVREF $ 6)))))) - (COND - ((OR (MINUSP |l|) (NOT (< |h| (LENGTH |s|)))) - (|error| "index out of bound")) - (T (SUBSTRING |s| |l| (MAX 0 (+ (- |h| |l|) 1))))))) - -(DEFUN |ISTRING;hash;$Si;32| (|s| $) - (DECLARE (IGNORE $)) - (SXHASH |s|)) - -(DEFUN |ISTRING;match;2$CNni;33| (|pattern| |target| |wildcard| $) - (|stringMatch| |pattern| |target| (CHARACTER |wildcard|))) - -(DEFUN |ISTRING;match?;2$CB;34| (|pattern| |target| |dontcare| $) - (PROG (|m| |p| |i| |q| |s|) - (RETURN - (LET ((|n| (SPADCALL |pattern| (|shellEntry| $ 47)))) - (SEQ (LETT |p| - (LET ((#0=#:G1501 - (|ISTRING;position;C$2I;19| |dontcare| - |pattern| - (LETT |m| - (|ISTRING;minIndex;$I;11| - |pattern| $) - |ISTRING;match?;2$CB;34|) - $))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - |ISTRING;match?;2$CB;34|) - (EXIT (COND - ((EQL |p| (- |m| 1)) - (NOT (NULL (STRING= |pattern| |target|)))) - (T (AND (NOT (AND (SPADCALL |p| |m| - (|shellEntry| $ 88)) - (NOT - (SPADCALL - (|ISTRING;elt;$Us$;31| - |pattern| - (SPADCALL |m| (- |p| 1) - (|shellEntry| $ 24)) - $) - |target| (|shellEntry| $ 89))))) - (SEQ (LETT |i| |p| - |ISTRING;match?;2$CB;34|) - (LETT |q| - (LET - ((#1=#:G1502 - (|ISTRING;position;C$2I;19| - |dontcare| |pattern| - (+ |p| 1) $))) - (|check-subtype| - (NOT (MINUSP #1#)) - '(|NonNegativeInteger|) #1#)) - |ISTRING;match?;2$CB;34|) - (LOOP - (COND - ((NOT - (SPADCALL |q| (- |m| 1) - (|shellEntry| $ 88))) - (RETURN NIL)) - (T - (SEQ - (LETT |s| - (|ISTRING;elt;$Us$;31| - |pattern| - (SPADCALL (+ |p| 1) (- |q| 1) - (|shellEntry| $ 24)) - $) - |ISTRING;match?;2$CB;34|) - (SETQ |i| - (LET - ((#2=#:G1503 - (|ISTRING;position;2$2I;18| - |s| |target| |i| $))) - (|check-subtype| - (NOT (MINUSP #2#)) - '(|NonNegativeInteger|) - #2#))) - (EXIT - (COND - ((EQL |i| (- |m| 1)) - (RETURN-FROM - |ISTRING;match?;2$CB;34| - NIL)) - (T - (SEQ - (SETQ |i| - (+ |i| (LENGTH |s|))) - (SETQ |p| |q|) - (EXIT - (SETQ |q| - (LET - ((#3=#:G1504 - (|ISTRING;position;C$2I;19| - |dontcare| |pattern| - (+ |q| 1) $))) - (|check-subtype| - (NOT (MINUSP #3#)) - '(|NonNegativeInteger|) - #3#)))))))))))) - (COND - ((AND - (SPADCALL |p| |n| - (|shellEntry| $ 88)) - (NOT - (|ISTRING;suffix?;2$B;21| - (|ISTRING;elt;$Us$;31| - |pattern| - (SPADCALL (+ |p| 1) |n| - (|shellEntry| $ 24)) - $) - |target| $))) - (EXIT NIL))) - (EXIT T))))))))))) - -(DEFUN |IndexedString| (#0=#:G1519) - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((#1=#:G1520 - (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) - (HGET |$ConstructorCache| '|IndexedString|) - '|domainEqualList|))) - (COND - (#1# (|CDRwithIncrement| #1#)) - (T (UNWIND-PROTECT - (PROG1 (|IndexedString;| #0#) (SETQ #1# T)) - (COND - ((NOT #1#) (HREM |$ConstructorCache| '|IndexedString|)))))))) - -(DEFUN |IndexedString;| (|#1|) - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET* ((|dv$1| (|devaluate| |#1|)) - (|dv$| (LIST '|IndexedString| |dv$1|)) ($ (|newShell| 101)) - (|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|)) - (OR (|HasCategory| (|Character|) - '(|BasicType|)) - (|HasCategory| (|Character|) - '(|OrderedSet|)) - (|HasCategory| (|Character|) - '(|SetCategory|))) - (|HasCategory| (|Integer|) '(|OrderedSet|)) - (|HasCategory| (|Character|) - '(|SetCategory|)) - (|HasCategory| (|Character|) - '(|CoercibleTo| (|OutputForm|))) - (|HasCategory| (|Character|) '(|BasicType|)) - (AND (|HasCategory| (|Character|) - '(|SetCategory|)) - (|HasCategory| (|Character|) - '(|Evalable| (|Character|)))))))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|haddProp| |$ConstructorCache| '|IndexedString| (LIST |dv$1|) - (CONS 1 $)) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - $)) - -(MAKEPROP '|IndexedString| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) - (|NonNegativeInteger|) (|Character|) |ISTRING;new;NniC$;1| - (|Integer|) (0 . |Zero|) |ISTRING;empty;$;2| (|Boolean|) - (4 . =) |ISTRING;empty?;$B;3| |ISTRING;#;$Nni;4| - |ISTRING;=;2$B;5| |ISTRING;<;2$B;6| |ISTRING;concat;3$;7| - |ISTRING;copy;2$;8| (10 . |One|) (14 . -) - (|UniversalSegment| 10) (20 . SEGMENT) - |ISTRING;elt;$Us$;31| (26 . SEGMENT) - |ISTRING;insert;2$I$;9| (|String|) (|OutputForm|) - (31 . |outputForm|) |ISTRING;coerce;$Of;10| - |ISTRING;minIndex;$I;11| (|CharacterClass|) - (36 . |upperCase|) (40 . |upperCase|) (|Mapping| 8 8) - (45 . |map!|) |ISTRING;upperCase!;2$;12| - (51 . |lowerCase|) (55 . |lowerCase|) - |ISTRING;lowerCase!;2$;13| (60 . |concat|) - |ISTRING;latex;$S;14| (66 . |lo|) (71 . |hasHi|) - (76 . |hi|) (81 . |maxIndex|) (86 . |Zero|) (90 . <) - (96 . >=) (102 . |One|) (106 . +) (112 . |space|) - (|PositiveInteger|) (116 . |One|) (120 . +) - |ISTRING;replace;$Us2$;15| (126 . >) - |ISTRING;setelt;$I2C;16| (132 . |false|) (136 . |true|) - |ISTRING;substring?;2$IB;17| |ISTRING;position;2$2I;18| - |ISTRING;position;C$2I;19| (140 . |member?|) - |ISTRING;position;Cc$2I;20| |ISTRING;suffix?;2$B;21| - (146 . <=) |ISTRING;elt;$IC;30| (152 . =) (|List| $$) - (158 . |empty|) (162 . |concat|) (168 . |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| - (173 . |max|) (|SingleInteger|) |ISTRING;hash;$Si;32| - |ISTRING;match;2$CNni;33| (179 . ~=) (185 . |prefix?|) - |ISTRING;match?;2$CB;34| (|List| 8) (|Equation| 8) - (|List| 92) (|Mapping| 8 8 8) (|InputForm|) - (|Mapping| 13 8) (|Mapping| 13 8 8) (|Void|) - (|Union| 8 '"failed") (|List| 10)) - '#(~= 191 |upperCase!| 197 |upperCase| 202 |trim| 207 |swap!| - 219 |suffix?| 226 |substring?| 232 |split| 239 |sorted?| - 251 |sort!| 262 |sort| 273 |size?| 284 |setelt| 290 - |select| 304 |sample| 310 |rightTrim| 314 |reverse!| 326 - |reverse| 331 |replace| 336 |removeDuplicates| 343 - |remove| 348 |reduce| 360 |qsetelt!| 381 |qelt| 388 - |prefix?| 394 |position| 400 |parts| 433 |new| 438 |more?| - 444 |minIndex| 450 |min| 455 |merge| 461 |members| 474 - |member?| 479 |maxIndex| 485 |max| 490 |match?| 496 - |match| 503 |map!| 510 |map| 516 |lowerCase!| 529 - |lowerCase| 534 |less?| 539 |leftTrim| 545 |latex| 557 - |insert| 562 |indices| 576 |index?| 581 |hash| 587 |first| - 592 |find| 597 |fill!| 603 |every?| 609 |eval| 615 |eq?| - 641 |entry?| 647 |entries| 653 |empty?| 658 |empty| 663 - |elt| 667 |delete| 692 |count| 704 |copyInto!| 716 |copy| - 723 |convert| 728 |construct| 733 |concat| 738 |coerce| - 761 |before?| 771 |any?| 777 >= 783 > 789 = 795 <= 801 < - 807 |#| 813) - '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) - (CONS (|makeByteWordVec2| 6 - '(0 0 0 0 0 0 0 5 0 4 5 0 0 0 1 6 0 1 2 3)) - (CONS '#(|StringAggregate&| - |OneDimensionalArrayAggregate&| - |FiniteLinearAggregate&| |LinearAggregate&| - |IndexedAggregate&| |Collection&| - |HomogeneousAggregate&| NIL - |EltableAggregate&| |SetCategory&| - |OrderedType&| NIL |Aggregate&| NIL - |Evalable&| |BasicType&| NIL |InnerEvalable&| - NIL NIL) - (CONS '#((|StringAggregate|) - (|OneDimensionalArrayAggregate| 8) - (|FiniteLinearAggregate| 8) - (|LinearAggregate| 8) - (|IndexedAggregate| 10 8) - (|Collection| 8) - (|HomogeneousAggregate| 8) - (|OrderedSet|) (|EltableAggregate| 10 8) - (|SetCategory|) (|OrderedType|) - (|Eltable| 23 $$) (|Aggregate|) - (|Eltable| 10 8) (|Evalable| 8) - (|BasicType|) (|Type|) - (|InnerEvalable| 8 8) (|CoercibleTo| 29) - (|ConvertibleTo| 95)) - (|makeByteWordVec2| 100 - '(0 10 0 11 2 10 13 0 0 14 0 10 0 21 2 - 10 0 0 0 22 2 23 0 10 10 24 1 23 0 10 - 26 1 29 0 28 30 0 33 0 34 1 8 0 0 35 - 2 0 0 36 0 37 0 33 0 39 1 8 0 0 40 2 - 28 0 0 0 42 1 23 10 0 44 1 23 13 0 45 - 1 23 10 0 46 1 0 10 0 47 0 7 0 48 2 - 10 13 0 0 49 2 10 13 0 0 50 0 7 0 51 - 2 10 0 0 0 52 0 8 0 53 0 54 0 55 2 7 - 0 0 0 56 2 10 13 0 0 58 0 13 0 60 0 - 13 0 61 2 33 13 8 0 65 2 10 13 0 0 68 - 2 8 13 0 0 70 0 71 0 72 2 71 0 2 0 73 - 1 71 0 0 74 2 10 0 0 0 84 2 10 13 0 0 - 88 2 0 13 0 0 89 2 10 13 0 0 1 1 0 0 - 0 38 1 0 0 0 1 2 0 0 0 8 1 2 0 0 0 33 - 1 3 0 98 0 10 10 1 2 0 13 0 0 67 3 0 - 13 0 0 10 62 2 0 75 0 33 77 2 0 75 0 - 8 76 1 5 13 0 1 2 0 13 97 0 1 1 5 0 0 - 1 2 0 0 97 0 1 1 5 0 0 1 2 0 0 97 0 1 - 2 0 13 0 7 1 3 0 8 0 23 8 1 3 0 8 0 - 10 8 59 2 0 0 96 0 1 0 0 0 1 2 0 0 0 - 8 80 2 0 0 0 33 81 1 0 0 0 1 1 0 0 0 - 1 3 0 0 0 23 0 57 1 8 0 0 1 2 8 0 8 0 - 1 2 0 0 96 0 1 4 8 8 94 0 8 8 1 3 0 8 - 94 0 8 1 2 0 8 94 0 1 3 0 8 0 10 8 1 - 2 0 8 0 10 1 2 0 13 0 0 89 3 8 10 8 0 - 10 64 2 8 10 8 0 1 3 0 10 33 0 10 66 - 3 0 10 0 0 10 63 2 0 10 96 0 1 1 0 91 - 0 1 2 0 0 7 8 9 2 0 13 0 7 1 1 7 10 0 - 32 2 5 0 0 0 1 2 5 0 0 0 1 3 0 0 97 0 - 0 1 1 0 91 0 1 2 8 13 8 0 1 1 7 10 0 - 47 2 5 0 0 0 1 3 0 13 0 0 8 90 3 0 7 - 0 0 8 87 2 0 0 36 0 37 3 0 0 94 0 0 1 - 2 0 0 36 0 1 1 0 0 0 41 1 0 0 0 1 2 0 - 13 0 7 1 2 0 0 0 8 78 2 0 0 0 33 79 1 - 8 28 0 43 3 0 0 8 0 10 1 3 0 0 0 0 10 - 27 1 0 100 0 1 2 0 13 10 0 1 1 8 85 0 - 86 1 7 8 0 1 2 0 99 96 0 1 2 0 0 0 8 - 1 2 0 13 96 0 1 3 11 0 0 91 91 1 3 11 - 0 0 8 8 1 2 11 0 0 93 1 2 11 0 0 92 1 - 2 0 13 0 0 1 2 8 13 8 0 1 1 0 91 0 1 - 1 0 13 0 15 0 0 0 12 2 0 0 0 0 1 2 0 - 0 0 23 25 2 0 8 0 10 69 3 0 8 0 10 8 - 1 2 0 0 0 10 1 2 0 0 0 23 1 2 8 7 8 0 - 1 2 0 7 96 0 1 3 0 0 0 0 10 82 1 0 0 - 0 20 1 3 95 0 1 1 0 0 91 1 2 0 0 0 0 - 19 1 0 0 75 83 2 0 0 8 0 1 2 0 0 0 8 - 1 1 9 29 0 31 1 0 0 8 1 2 10 13 0 0 1 - 2 0 13 96 0 1 2 5 13 0 0 1 2 5 13 0 0 - 1 2 10 13 0 0 17 2 5 13 0 0 1 2 5 13 - 0 0 18 1 0 7 0 16))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp deleted file mode 100644 index f224231a..00000000 --- a/src/algebra/strap/LIST.lsp +++ /dev/null @@ -1,325 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%List|) |LIST;nil;$;1|)) - -(PUT '|LIST;nil;$;1| '|SPADreplace| '(XLAM NIL |%nil|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Boolean|) - |LIST;null;$B;2|)) - -(PUT '|LIST;null;$B;2| '|SPADreplace| - '(XLAM (|l|) (|%peq| |l| |%nil|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%List|) - |LIST;cons;S2$;3|)) - -(PUT '|LIST;cons;S2$;3| '|SPADreplace| '|%pair|) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%List| |%Shell|) |%List|) - |LIST;append;3$;4|)) - -(PUT '|LIST;append;3$;4| '|SPADreplace| '|%lconcat|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Void|) - |LIST;writeOMList|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%String|) - |LIST;OMwrite;$S;6|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Boolean| |%Shell|) |%String|) - |LIST;OMwrite;$BS;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Void|) - |LIST;OMwrite;Omd$V;8|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Boolean| |%Shell|) - |%Void|) - |LIST;OMwrite;Omd$BV;9|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%List| |%Shell|) |%List|) - |LIST;setUnion;3$;10|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%List| |%Shell|) |%List|) - |LIST;setIntersection;3$;11|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%List| |%Shell|) |%List|) - |LIST;setDifference;3$;12|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |LIST;convert;$If;13|)) - -(DEFUN |LIST;nil;$;1| ($) (DECLARE (IGNORE $)) NIL) - -(DEFUN |LIST;null;$B;2| (|l| $) (DECLARE (IGNORE $)) (NULL |l|)) - -(DEFUN |LIST;cons;S2$;3| (|s| |l| $) - (DECLARE (IGNORE $)) - (CONS |s| |l|)) - -(DEFUN |LIST;append;3$;4| (|l| |t| $) - (DECLARE (IGNORE $)) - (APPEND |l| |t|)) - -(DEFUN |LIST;writeOMList| (|dev| |x| $) - (SEQ (SPADCALL |dev| (|shellEntry| $ 16)) - (SPADCALL |dev| "list1" "list" (|shellEntry| $ 18)) - (LOOP - (COND - ((NOT (NOT (NULL |x|))) (RETURN NIL)) - (T (SEQ (SPADCALL |dev| (SPADCALL |x| (|shellEntry| $ 20)) - NIL (|shellEntry| $ 22)) - (EXIT (SETQ |x| (SPADCALL |x| (|shellEntry| $ 23)))))))) - (EXIT (SPADCALL |dev| (|shellEntry| $ 24))))) - -(DEFUN |LIST;OMwrite;$S;6| (|x| $) - (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) - (|dev| (SPADCALL |sp| (SPADCALL (|shellEntry| $ 26)) - (|shellEntry| $ 27)))) - (SEQ (SPADCALL |dev| (|shellEntry| $ 28)) - (|LIST;writeOMList| |dev| |x| $) - (SPADCALL |dev| (|shellEntry| $ 29)) - (SPADCALL |dev| (|shellEntry| $ 30)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) - -(DEFUN |LIST;OMwrite;$BS;7| (|x| |wholeObj| $) - (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) - (|dev| (SPADCALL |sp| (SPADCALL (|shellEntry| $ 26)) - (|shellEntry| $ 27)))) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 28)))) - (|LIST;writeOMList| |dev| |x| $) - (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 29)))) - (SPADCALL |dev| (|shellEntry| $ 30)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) - -(DEFUN |LIST;OMwrite;Omd$V;8| (|dev| |x| $) - (SEQ (SPADCALL |dev| (|shellEntry| $ 28)) - (|LIST;writeOMList| |dev| |x| $) - (EXIT (SPADCALL |dev| (|shellEntry| $ 29))))) - -(DEFUN |LIST;OMwrite;Omd$BV;9| (|dev| |x| |wholeObj| $) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 28)))) - (|LIST;writeOMList| |dev| |x| $) - (EXIT (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 29))))))) - -(DEFUN |LIST;setUnion;3$;10| (|l1| |l2| $) - (SPADCALL (SPADCALL |l1| |l2| (|shellEntry| $ 35)) - (|shellEntry| $ 36))) - -(DEFUN |LIST;setIntersection;3$;11| (|l1| |l2| $) - (LET ((|u| (SPADCALL (|shellEntry| $ 38)))) - (SEQ (SETQ |l1| (SPADCALL |l1| (|shellEntry| $ 36))) - (LOOP - (COND - ((NOT (NOT (SPADCALL |l1| (|shellEntry| $ 39)))) - (RETURN NIL)) - (T (SEQ (COND - ((SPADCALL (SPADCALL |l1| (|shellEntry| $ 20)) - |l2| (|shellEntry| $ 40)) - (SETQ |u| - (CONS (SPADCALL |l1| (|shellEntry| $ 20)) - |u|)))) - (EXIT (SETQ |l1| - (SPADCALL |l1| (|shellEntry| $ 23)))))))) - (EXIT |u|)))) - -(DEFUN |LIST;setDifference;3$;12| (|l1| |l2| $) - (PROG (|lu| |l11|) - (RETURN - (SEQ (SETQ |l1| (SPADCALL |l1| (|shellEntry| $ 36))) - (LETT |lu| (SPADCALL (|shellEntry| $ 38)) - |LIST;setDifference;3$;12|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |l1| (|shellEntry| $ 39)))) - (RETURN NIL)) - (T (SEQ (LETT |l11| - (SPADCALL |l1| 1 (|shellEntry| $ 42)) - |LIST;setDifference;3$;12|) - (COND - ((NOT (SPADCALL |l11| |l2| - (|shellEntry| $ 40))) - (SETQ |lu| - (SPADCALL |l11| |lu| - (|shellEntry| $ 43))))) - (EXIT (SETQ |l1| - (SPADCALL |l1| (|shellEntry| $ 23)))))))) - (EXIT |lu|))))) - -(DEFUN |LIST;convert;$If;13| (|x| $) - (SPADCALL (CONS (SPADCALL '|construct| (|shellEntry| $ 47)) - (LET ((#0=#:G1420 |x|) (#1=#:G1419 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|a| (CAR #0#))) - (SETQ #1# - (CONS - (SPADCALL |a| (|shellEntry| $ 48)) - #1#))))) - (SETQ #0# (CDR #0#))))) - (|shellEntry| $ 52))) - -(DEFUN |List| (#0=#:G1421) - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((#1=#:G1422 - (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) - (HGET |$ConstructorCache| '|List|) '|domainEqualList|))) - (COND - (#1# (|CDRwithIncrement| #1#)) - (T (UNWIND-PROTECT - (PROG1 (|List;| #0#) (SETQ #1# T)) - (COND ((NOT #1#) (HREM |$ConstructorCache| '|List|)))))))) - -(DEFUN |List;| (|#1|) - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$| (LIST '|List| |dv$1|)) - ($ (|newShell| 71)) - (|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|)) - (OR (|HasCategory| |#1| '(|BasicType|)) - (|HasCategory| |#1| '(|OrderedSet|)) - (|HasCategory| |#1| '(|SetCategory|))) - (|HasCategory| |#1| '(|OpenMath|)) - (|HasCategory| (|Integer|) '(|OrderedSet|)) - (|HasCategory| |#1| '(|SetCategory|)) - (|HasCategory| |#1| - '(|CoercibleTo| (|OutputForm|))) - (|HasCategory| |#1| '(|BasicType|)) - (AND (|HasCategory| |#1| '(|SetCategory|)) - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|)))))))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|haddProp| |$ConstructorCache| '|List| (LIST |dv$1|) (CONS 1 $)) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (COND - ((|testBitVector| |pv$| 7) - (PROGN - (SETF (|shellEntry| $ 31) - (CONS (|dispatchFunction| |LIST;OMwrite;$S;6|) $)) - (SETF (|shellEntry| $ 32) - (CONS (|dispatchFunction| |LIST;OMwrite;$BS;7|) $)) - (SETF (|shellEntry| $ 33) - (CONS (|dispatchFunction| |LIST;OMwrite;Omd$V;8|) $)) - (SETF (|shellEntry| $ 34) - (CONS (|dispatchFunction| |LIST;OMwrite;Omd$BV;9|) $))))) - (COND - ((|testBitVector| |pv$| 9) - (PROGN - (SETF (|shellEntry| $ 37) - (CONS (|dispatchFunction| |LIST;setUnion;3$;10|) $)) - (SETF (|shellEntry| $ 41) - (CONS (|dispatchFunction| |LIST;setIntersection;3$;11|) - $)) - (SETF (|shellEntry| $ 44) - (CONS (|dispatchFunction| |LIST;setDifference;3$;12|) $))))) - (COND - ((|testBitVector| |pv$| 3) - (SETF (|shellEntry| $ 53) - (CONS (|dispatchFunction| |LIST;convert;$If;13|) $)))) - $)) - -(MAKEPROP '|List| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL (|IndexedList| 6 (NRTEVAL 1)) - (|local| |#1|) (|Integer|) (0 . |One|) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |LIST;nil;$;1|) $)) - (|Boolean|) |LIST;null;$B;2| |LIST;cons;S2$;3| - |LIST;append;3$;4| (|Void|) (|OpenMathDevice|) - (4 . |OMputApp|) (|String|) (9 . |OMputSymbol|) - (16 . |not|) (21 . |first|) (26 . |false|) - (30 . |OMwrite|) (37 . |rest|) (42 . |OMputEndApp|) - (|OpenMathEncoding|) (47 . |OMencodingXML|) - (51 . |OMopenString|) (57 . |OMputObject|) - (62 . |OMputEndObject|) (67 . |OMclose|) (72 . |OMwrite|) - (77 . |OMwrite|) (83 . |OMwrite|) (89 . |OMwrite|) - (96 . |concat|) (102 . |removeDuplicates|) - (107 . |setUnion|) (113 . |empty|) (117 . |empty?|) - (122 . |member?|) (128 . |setIntersection|) (134 . |elt|) - (140 . |concat|) (146 . |setDifference|) (|Symbol|) - (|InputForm|) (152 . |convert|) (157 . |convert|) - (|List| 46) (162 . |concat|) (|List| $) (168 . |convert|) - (173 . |convert|) (|Mapping| 6 6 6) (|NonNegativeInteger|) - (|List| 6) (|Equation| 6) (|List| 57) (|Mapping| 10 6) - (|Mapping| 10 6 6) (|UniversalSegment| 7) '"last" '"rest" - '"first" '"value" (|Mapping| 6 6) (|OutputForm|) - (|SingleInteger|) (|List| 7) (|Union| 6 '"failed")) - '#(|setUnion| 178 |setIntersection| 184 |setDifference| 190 - |rest| 196 |removeDuplicates| 201 |null| 206 |nil| 211 - |member?| 215 |first| 221 |empty?| 226 |empty| 231 |elt| - 235 |convert| 241 |cons| 246 |concat| 252 |append| 264 - |OMwrite| 270) - '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) - (CONS (|makeByteWordVec2| 7 - '(0 0 0 0 0 0 0 0 0 0 5 0 4 5 0 0 0 1 6 0 1 2 3 7)) - (CONS '#(|ListAggregate&| |StreamAggregate&| - |ExtensibleLinearAggregate&| - |FiniteLinearAggregate&| - |UnaryRecursiveAggregate&| |LinearAggregate&| - |RecursiveAggregate&| |IndexedAggregate&| - |Collection&| |HomogeneousAggregate&| NIL - |EltableAggregate&| |SetCategory&| - |OrderedType&| NIL |Aggregate&| NIL - |Evalable&| |BasicType&| NIL |InnerEvalable&| - NIL NIL NIL) - (CONS '#((|ListAggregate| 6) - (|StreamAggregate| 6) - (|ExtensibleLinearAggregate| 6) - (|FiniteLinearAggregate| 6) - (|UnaryRecursiveAggregate| 6) - (|LinearAggregate| 6) - (|RecursiveAggregate| 6) - (|IndexedAggregate| 7 6) - (|Collection| 6) - (|HomogeneousAggregate| 6) - (|OrderedSet|) (|EltableAggregate| 7 6) - (|SetCategory|) (|OrderedType|) - (|Eltable| 61 $$) (|Aggregate|) - (|Eltable| 7 6) (|Evalable| 6) - (|BasicType|) (|Type|) - (|InnerEvalable| 6 6) (|CoercibleTo| 67) - (|ConvertibleTo| 46) (|OpenMath|)) - (|makeByteWordVec2| 53 - '(0 7 0 8 1 15 14 0 16 3 15 14 0 17 17 - 18 1 10 0 0 19 1 0 6 0 20 0 10 0 21 3 - 6 14 15 0 10 22 1 0 0 0 23 1 15 14 0 - 24 0 25 0 26 2 15 0 17 25 27 1 15 14 - 0 28 1 15 14 0 29 1 15 14 0 30 1 0 17 - 0 31 2 0 17 0 10 32 2 0 14 15 0 33 3 - 0 14 15 0 10 34 2 0 0 0 0 35 1 0 0 0 - 36 2 0 0 0 0 37 0 0 0 38 1 0 10 0 39 - 2 0 10 6 0 40 2 0 0 0 0 41 2 0 6 0 7 - 42 2 0 0 6 0 43 2 0 0 0 0 44 1 46 0 - 45 47 1 6 46 0 48 2 49 0 46 0 50 1 46 - 0 51 52 1 0 46 0 53 2 9 0 0 0 37 2 9 - 0 0 0 41 2 9 0 0 0 44 1 0 0 0 23 1 9 - 0 0 36 1 0 10 0 11 0 0 0 9 2 9 10 6 0 - 40 1 0 6 0 20 1 0 10 0 39 0 0 0 38 2 - 0 6 0 7 42 1 3 46 0 53 2 0 0 6 0 12 2 - 0 0 0 0 35 2 0 0 6 0 43 2 0 0 0 0 13 - 3 7 14 15 0 10 34 2 7 17 0 10 32 2 7 - 14 15 0 33 1 7 17 0 31))))) - '|lookupIncomplete|)) diff --git a/src/algebra/strap/LNAGG-.lsp b/src/algebra/strap/LNAGG-.lsp deleted file mode 100644 index 52b5f081..00000000 --- a/src/algebra/strap/LNAGG-.lsp +++ /dev/null @@ -1,94 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|) - |LNAGG-;indices;AL;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Thing| |%Shell|) |%Boolean|) - |LNAGG-;index?;IAB;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |LNAGG-;concat;ASA;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |LNAGG-;concat;S2A;4|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|) - |%Thing|) - |LNAGG-;insert;SAIA;5|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|) - |LNAGG-;maxIndex;AI;6|)) - -(DEFUN |LNAGG-;indices;AL;1| (|a| $) - (LET ((|i| (SPADCALL |a| (|shellEntry| $ 9))) - (#0=#:G1387 (SPADCALL |a| (|shellEntry| $ 10))) - (#1=#:G1386 NIL)) - (LOOP - (COND - ((> |i| #0#) (RETURN (NREVERSE #1#))) - (T (SETQ #1# (CONS |i| #1#)))) - (SETQ |i| (+ |i| 1))))) - -(DEFUN |LNAGG-;index?;IAB;2| (|i| |a| $) - (AND (NOT (< |i| (SPADCALL |a| (|shellEntry| $ 9)))) - (NOT (< (SPADCALL |a| (|shellEntry| $ 10)) |i|)))) - -(DEFUN |LNAGG-;concat;ASA;3| (|a| |x| $) - (SPADCALL |a| (SPADCALL 1 |x| (|shellEntry| $ 21)) - (|shellEntry| $ 22))) - -(DEFUN |LNAGG-;concat;S2A;4| (|x| |y| $) - (SPADCALL (SPADCALL 1 |x| (|shellEntry| $ 21)) |y| - (|shellEntry| $ 22))) - -(DEFUN |LNAGG-;insert;SAIA;5| (|x| |a| |i| $) - (SPADCALL (SPADCALL 1 |x| (|shellEntry| $ 21)) |a| |i| - (|shellEntry| $ 25))) - -(DEFUN |LNAGG-;maxIndex;AI;6| (|l| $) - (+ (- (SPADCALL |l| (|shellEntry| $ 27)) 1) - (SPADCALL |l| (|shellEntry| $ 9)))) - -(DEFUN |LinearAggregate&| (|#1| |#2|) - (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) - (|dv$| (LIST '|LinearAggregate&| |dv$1| |dv$2|)) - ($ (|newShell| 32)) - (|pv$| (|buildPredVector| 0 0 - (LIST (|HasAttribute| |#1| '|shallowlyMutable|))))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (SETF (|shellEntry| $ 7) |#2|) - (COND - ((|HasAttribute| |#1| '|finiteAggregate|) - (SETF (|shellEntry| $ 30) - (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 . >=) (16 . <=) - (22 . |false|) |LNAGG-;index?;IAB;2| - (|NonNegativeInteger|) (26 . |One|) (30 . |One|) - (34 . |new|) (40 . |concat|) |LNAGG-;concat;ASA;3| - |LNAGG-;concat;S2A;4| (46 . |insert|) - |LNAGG-;insert;SAIA;5| (53 . |#|) (58 . -) (64 . +) - (70 . |maxIndex|) (|List| $)) - '#(|maxIndex| 75 |insert| 80 |indices| 87 |index?| 92 - |concat| 98) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 30 - '(1 6 8 0 9 1 6 8 0 10 2 8 13 0 0 14 2 - 8 13 0 0 15 0 13 0 16 0 18 0 19 0 8 0 - 20 2 6 0 18 7 21 2 6 0 0 0 22 3 6 0 0 - 0 8 25 1 6 18 0 27 2 8 0 0 0 28 2 8 0 - 0 0 29 1 0 8 0 30 1 0 8 0 30 3 0 0 7 - 0 8 26 1 0 11 0 12 2 0 13 8 0 17 2 0 - 0 0 7 23 2 0 0 7 0 24))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/LNAGG.lsp b/src/algebra/strap/LNAGG.lsp deleted file mode 100644 index 960e24fd..00000000 --- a/src/algebra/strap/LNAGG.lsp +++ /dev/null @@ -1,76 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |LinearAggregate;CAT| 'NIL) - -(DEFPARAMETER |LinearAggregate;AL| 'NIL) - -(DEFUN |LinearAggregate;| (|t#1|) - (LET ((#0=#:G1375 - (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (|sublisV| - (PAIR '(#1=#:G1373 #2=#:G1374) - '((|Integer|) - (|UniversalSegment| (|Integer|)))) - (COND - (|LinearAggregate;CAT|) - (T (SETQ |LinearAggregate;CAT| - (|Join| (|IndexedAggregate| '#1# '|t#1|) - (|Collection| '|t#1|) - (|Eltable| '#2# '$) - (|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) - ((|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))))))))) - (SETF (|shellEntry| #0# 0) - (LIST '|LinearAggregate| (|devaluate| |t#1|))) - #0#)) - -(DEFUN |LinearAggregate| (#0=#:G1376) - (LET ((#1=#:G1377 (|assoc| (|devaluate| #0#) |LinearAggregate;AL|))) - (COND - (#1# (CDR #1#)) - (T (PROGN - (SETQ #1# (|LinearAggregate;| #0#)) - (SETQ |LinearAggregate;AL| - (|cons5| (CONS (|devaluate| #0#) #1#) - |LinearAggregate;AL|)) - #1#))))) diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp deleted file mode 100644 index a71dae77..00000000 --- a/src/algebra/strap/LSAGG-.lsp +++ /dev/null @@ -1,702 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |LSAGG-;sort!;M2A;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |LSAGG-;list;SA;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |LSAGG-;reduce;MAS;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |LSAGG-;merge;M3A;4|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |LSAGG-;select!;M2A;5|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |LSAGG-;merge!;M3A;6|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|) - |%Thing|) - |LSAGG-;insert!;SAIA;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|) - |%Thing|) - |LSAGG-;insert!;2AIA;8|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |LSAGG-;remove!;M2A;9|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Thing|) - |LSAGG-;delete!;AIA;10|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |LSAGG-;delete!;AUsA;11|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Pair|) - |LSAGG-;find;MAU;12|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Integer|) - |LSAGG-;position;MAI;13|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|) - |%Thing|) - |LSAGG-;mergeSort|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |LSAGG-;sorted?;MAB;15|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |LSAGG-;reduce;MA2S;16|)) - -(DECLAIM (FTYPE (FUNCTION - (|%Thing| |%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |LSAGG-;reduce;MA3S;17|)) - -(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) |%Thing| |%Shell|) - |%Thing|) - |LSAGG-;new;NniSA;18|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |LSAGG-;map;M3A;19|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |LSAGG-;reverse!;2A;20|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |LSAGG-;copy;2A;21|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|) - |%Thing|) - |LSAGG-;copyInto!;2AIA;22|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|) - |%Integer|) - |LSAGG-;position;SA2I;23|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |LSAGG-;removeDuplicates!;2A;24|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |LSAGG-;<;2AB;25|)) - -(DEFUN |LSAGG-;sort!;M2A;1| (|f| |l| $) - (|LSAGG-;mergeSort| |f| |l| (SPADCALL |l| (|shellEntry| $ 9)) $)) - -(DEFUN |LSAGG-;list;SA;2| (|x| $) - (SPADCALL |x| (SPADCALL (|shellEntry| $ 13)) (|shellEntry| $ 14))) - -(DEFUN |LSAGG-;reduce;MAS;3| (|f| |x| $) - (COND - ((SPADCALL |x| (|shellEntry| $ 16)) - (|error| "reducing over an empty list needs the 3 argument form")) - (T (SPADCALL |f| (SPADCALL |x| (|shellEntry| $ 17)) - (SPADCALL |x| (|shellEntry| $ 18)) (|shellEntry| $ 20))))) - -(DEFUN |LSAGG-;merge;M3A;4| (|f| |p| |q| $) - (SPADCALL |f| (SPADCALL |p| (|shellEntry| $ 22)) - (SPADCALL |q| (|shellEntry| $ 22)) (|shellEntry| $ 23))) - -(DEFUN |LSAGG-;select!;M2A;5| (|f| |x| $) - (PROG (|y| |z|) - (RETURN - (SEQ (LOOP - (COND - ((NOT (AND (NOT (SPADCALL |x| (|shellEntry| $ 16))) - (NOT (SPADCALL - (SPADCALL |x| (|shellEntry| $ 18)) - |f|)))) - (RETURN NIL)) - (T (SETQ |x| (SPADCALL |x| (|shellEntry| $ 17)))))) - (EXIT (COND - ((SPADCALL |x| (|shellEntry| $ 16)) |x|) - (T (SEQ (LETT |y| |x| |LSAGG-;select!;M2A;5|) - (LETT |z| (SPADCALL |y| (|shellEntry| $ 17)) - |LSAGG-;select!;M2A;5|) - (LOOP - (COND - ((NOT (NOT - (SPADCALL |z| - (|shellEntry| $ 16)))) - (RETURN NIL)) - (T (COND - ((SPADCALL - (SPADCALL |z| - (|shellEntry| $ 18)) - |f|) - (SEQ (SETQ |y| |z|) - (EXIT - (SETQ |z| - (SPADCALL |z| - (|shellEntry| $ 17)))))) - (T - (SEQ - (SETQ |z| - (SPADCALL |z| - (|shellEntry| $ 17))) - (EXIT - (SPADCALL |y| |z| - (|shellEntry| $ 27))))))))) - (EXIT |x|))))))))) - -(DEFUN |LSAGG-;merge!;M3A;6| (|f| |p| |q| $) - (PROG (|r| |t|) - (RETURN - (COND - ((SPADCALL |p| (|shellEntry| $ 16)) |q|) - ((SPADCALL |q| (|shellEntry| $ 16)) |p|) - ((SPADCALL |p| |q| (|shellEntry| $ 30)) - (|error| "cannot merge a list into itself")) - (T (SEQ (COND - ((SPADCALL (SPADCALL |p| (|shellEntry| $ 18)) - (SPADCALL |q| (|shellEntry| $ 18)) |f|) - (SEQ (LETT |r| (LETT |t| |p| |LSAGG-;merge!;M3A;6|) - |LSAGG-;merge!;M3A;6|) - (EXIT (SETQ |p| - (SPADCALL |p| (|shellEntry| $ 17)))))) - (T (SEQ (LETT |r| - (LETT |t| |q| |LSAGG-;merge!;M3A;6|) - |LSAGG-;merge!;M3A;6|) - (EXIT (SETQ |q| - (SPADCALL |q| - (|shellEntry| $ 17))))))) - (LOOP - (COND - ((NOT (AND (NOT (SPADCALL |p| (|shellEntry| $ 16))) - (NOT (SPADCALL |q| (|shellEntry| $ 16))))) - (RETURN NIL)) - (T (COND - ((SPADCALL (SPADCALL |p| (|shellEntry| $ 18)) - (SPADCALL |q| (|shellEntry| $ 18)) |f|) - (SEQ (SPADCALL |t| |p| (|shellEntry| $ 27)) - (LETT |t| |p| |LSAGG-;merge!;M3A;6|) - (EXIT (SETQ |p| - (SPADCALL |p| - (|shellEntry| $ 17)))))) - (T (SEQ (SPADCALL |t| |q| (|shellEntry| $ 27)) - (LETT |t| |q| |LSAGG-;merge!;M3A;6|) - (EXIT (SETQ |q| - (SPADCALL |q| - (|shellEntry| $ 17)))))))))) - (SPADCALL |t| - (COND - ((SPADCALL |p| (|shellEntry| $ 16)) |q|) - (T |p|)) - (|shellEntry| $ 27)) - (EXIT |r|))))))) - -(DEFUN |LSAGG-;insert!;SAIA;7| (|s| |x| |i| $) - (PROG (|y| |z|) - (RETURN - (LET ((|m| (SPADCALL |x| (|shellEntry| $ 33)))) - (COND - ((< |i| |m|) (|error| "index out of range")) - ((EQL |i| |m|) (SPADCALL |s| |x| (|shellEntry| $ 14))) - (T (SEQ (LETT |y| - (SPADCALL |x| - (LET ((#0=#:G1442 (- (- |i| 1) |m|))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|shellEntry| $ 39)) - |LSAGG-;insert!;SAIA;7|) - (LETT |z| (SPADCALL |y| (|shellEntry| $ 17)) - |LSAGG-;insert!;SAIA;7|) - (SPADCALL |y| (SPADCALL |s| |z| (|shellEntry| $ 14)) - (|shellEntry| $ 27)) - (EXIT |x|)))))))) - -(DEFUN |LSAGG-;insert!;2AIA;8| (|w| |x| |i| $) - (PROG (|y| |z|) - (RETURN - (LET ((|m| (SPADCALL |x| (|shellEntry| $ 33)))) - (COND - ((< |i| |m|) (|error| "index out of range")) - ((EQL |i| |m|) (SPADCALL |w| |x| (|shellEntry| $ 41))) - (T (SEQ (LETT |y| - (SPADCALL |x| - (LET ((#0=#:G1446 (- (- |i| 1) |m|))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|shellEntry| $ 39)) - |LSAGG-;insert!;2AIA;8|) - (LETT |z| (SPADCALL |y| (|shellEntry| $ 17)) - |LSAGG-;insert!;2AIA;8|) - (SPADCALL |y| |w| (|shellEntry| $ 27)) - (SPADCALL |y| |z| (|shellEntry| $ 41)) (EXIT |x|)))))))) - -(DEFUN |LSAGG-;remove!;M2A;9| (|f| |x| $) - (PROG (|p| |q|) - (RETURN - (SEQ (LOOP - (COND - ((NOT (AND (NOT (SPADCALL |x| (|shellEntry| $ 16))) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 18)) - |f|))) - (RETURN NIL)) - (T (SETQ |x| (SPADCALL |x| (|shellEntry| $ 17)))))) - (EXIT (COND - ((SPADCALL |x| (|shellEntry| $ 16)) |x|) - (T (SEQ (LETT |p| |x| |LSAGG-;remove!;M2A;9|) - (LETT |q| (SPADCALL |x| (|shellEntry| $ 17)) - |LSAGG-;remove!;M2A;9|) - (LOOP - (COND - ((NOT (NOT - (SPADCALL |q| - (|shellEntry| $ 16)))) - (RETURN NIL)) - (T (COND - ((SPADCALL - (SPADCALL |q| - (|shellEntry| $ 18)) - |f|) - (SETQ |q| - (SPADCALL |p| - (SPADCALL |q| - (|shellEntry| $ 17)) - (|shellEntry| $ 27)))) - (T - (SEQ (SETQ |p| |q|) - (EXIT - (SETQ |q| - (SPADCALL |q| - (|shellEntry| $ 17)))))))))) - (EXIT |x|))))))))) - -(DEFUN |LSAGG-;delete!;AIA;10| (|x| |i| $) - (PROG (|y|) - (RETURN - (LET ((|m| (SPADCALL |x| (|shellEntry| $ 33)))) - (COND - ((< |i| |m|) (|error| "index out of range")) - ((EQL |i| |m|) (SPADCALL |x| (|shellEntry| $ 17))) - (T (SEQ (LETT |y| - (SPADCALL |x| - (LET ((#0=#:G1458 (- (- |i| 1) |m|))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|shellEntry| $ 39)) - |LSAGG-;delete!;AIA;10|) - (SPADCALL |y| (SPADCALL |y| 2 (|shellEntry| $ 39)) - (|shellEntry| $ 27)) - (EXIT |x|)))))))) - -(DEFUN |LSAGG-;delete!;AUsA;11| (|x| |i| $) - (PROG (|h| |t|) - (RETURN - (LET ((|l| (SPADCALL |i| (|shellEntry| $ 46))) - (|m| (SPADCALL |x| (|shellEntry| $ 33)))) - (COND - ((< |l| |m|) (|error| "index out of range")) - (T (SEQ (LETT |h| - (COND - ((SPADCALL |i| (|shellEntry| $ 47)) - (SPADCALL |i| (|shellEntry| $ 48))) - (T (SPADCALL |x| (|shellEntry| $ 49)))) - |LSAGG-;delete!;AUsA;11|) - (EXIT (COND - ((< |h| |l|) |x|) - ((EQL |l| |m|) - (SPADCALL |x| - (LET ((#0=#:G1464 (- (+ |h| 1) |m|))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|shellEntry| $ 39))) - (T (SEQ (LETT |t| - (SPADCALL |x| - (LET - ((#1=#:G1465 - (- (- |l| 1) |m|))) - (|check-subtype| - (NOT (MINUSP #1#)) - '(|NonNegativeInteger|) - #1#)) - (|shellEntry| $ 39)) - |LSAGG-;delete!;AUsA;11|) - (SPADCALL |t| - (SPADCALL |t| - (LET - ((#2=#:G1466 (+ (- |h| |l|) 2))) - (|check-subtype| - (NOT (MINUSP #2#)) - '(|NonNegativeInteger|) #2#)) - (|shellEntry| $ 39)) - (|shellEntry| $ 27)) - (EXIT |x|)))))))))))) - -(DEFUN |LSAGG-;find;MAU;12| (|f| |x| $) - (SEQ (LOOP - (COND - ((NOT (AND (NOT (SPADCALL |x| (|shellEntry| $ 16))) - (NOT (SPADCALL (SPADCALL |x| (|shellEntry| $ 18)) - |f|)))) - (RETURN NIL)) - (T (SETQ |x| (SPADCALL |x| (|shellEntry| $ 17)))))) - (EXIT (COND - ((SPADCALL |x| (|shellEntry| $ 16)) (CONS 1 "failed")) - (T (CONS 0 (SPADCALL |x| (|shellEntry| $ 18)))))))) - -(DEFUN |LSAGG-;position;MAI;13| (|f| |x| $) - (LET ((|k| (SPADCALL |x| (|shellEntry| $ 33)))) - (SEQ (LOOP - (COND - ((NOT (AND (NOT (SPADCALL |x| (|shellEntry| $ 16))) - (NOT (SPADCALL - (SPADCALL |x| (|shellEntry| $ 18)) - |f|)))) - (RETURN NIL)) - (T (SEQ (SETQ |x| (SPADCALL |x| (|shellEntry| $ 17))) - (EXIT (SETQ |k| (+ |k| 1))))))) - (EXIT (COND - ((SPADCALL |x| (|shellEntry| $ 16)) - (- (SPADCALL |x| (|shellEntry| $ 33)) 1)) - (T |k|)))))) - -(DEFUN |LSAGG-;mergeSort| (|f| |p| |n| $) - (PROG (|l| |q|) - (RETURN - (SEQ (COND - ((AND (EQL |n| 2) - (SPADCALL - (SPADCALL (SPADCALL |p| (|shellEntry| $ 17)) - (|shellEntry| $ 18)) - (SPADCALL |p| (|shellEntry| $ 18)) |f|)) - (SETQ |p| (SPADCALL |p| (|shellEntry| $ 55))))) - (EXIT (COND - ((< |n| 3) |p|) - (T (SEQ (LETT |l| - (LET ((#0=#:G1486 (TRUNCATE |n| 2))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - |LSAGG-;mergeSort|) - (LETT |q| - (SPADCALL |p| |l| (|shellEntry| $ 57)) - |LSAGG-;mergeSort|) - (SETQ |p| - (|LSAGG-;mergeSort| |f| |p| |l| $)) - (SETQ |q| - (|LSAGG-;mergeSort| |f| |q| - (- |n| |l|) $)) - (EXIT (SPADCALL |f| |p| |q| - (|shellEntry| $ 23))))))))))) - -(DEFUN |LSAGG-;sorted?;MAB;15| (|f| |l| $) - (PROG (|p|) - (RETURN - (OR (SPADCALL |l| (|shellEntry| $ 16)) - (SEQ (LETT |p| (SPADCALL |l| (|shellEntry| $ 17)) - |LSAGG-;sorted?;MAB;15|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |p| (|shellEntry| $ 16)))) - (RETURN NIL)) - (T (SEQ (COND - ((NOT (SPADCALL - (SPADCALL |l| (|shellEntry| $ 18)) - (SPADCALL |p| (|shellEntry| $ 18)) - |f|)) - (RETURN-FROM |LSAGG-;sorted?;MAB;15| - NIL))) - (EXIT (SETQ |p| - (SPADCALL (SETQ |l| |p|) - (|shellEntry| $ 17)))))))) - (EXIT T)))))) - -(DEFUN |LSAGG-;reduce;MA2S;16| (|f| |x| |i| $) - (LET ((|r| |i|)) - (SEQ (LOOP - (COND - ((NOT (NOT (SPADCALL |x| (|shellEntry| $ 16)))) - (RETURN NIL)) - (T (SEQ (SETQ |r| - (SPADCALL |r| - (SPADCALL |x| (|shellEntry| $ 18)) |f|)) - (EXIT (SETQ |x| - (SPADCALL |x| (|shellEntry| $ 17)))))))) - (EXIT |r|)))) - -(DEFUN |LSAGG-;reduce;MA3S;17| (|f| |x| |i| |a| $) - (LET ((|r| |i|)) - (SEQ (LOOP - (COND - ((NOT (AND (NOT (SPADCALL |x| (|shellEntry| $ 16))) - (SPADCALL |r| |a| (|shellEntry| $ 61)))) - (RETURN NIL)) - (T (SEQ (SETQ |r| - (SPADCALL |r| - (SPADCALL |x| (|shellEntry| $ 18)) |f|)) - (EXIT (SETQ |x| - (SPADCALL |x| (|shellEntry| $ 17)))))))) - (EXIT |r|)))) - -(DEFUN |LSAGG-;new;NniSA;18| (|n| |s| $) - (LET ((|l| (SPADCALL (|shellEntry| $ 13)))) - (SEQ (LET ((|k| 1)) - (LOOP - (COND - ((> |k| |n|) (RETURN NIL)) - (T (SETQ |l| (SPADCALL |s| |l| (|shellEntry| $ 14))))) - (SETQ |k| (+ |k| 1)))) - (EXIT |l|)))) - -(DEFUN |LSAGG-;map;M3A;19| (|f| |x| |y| $) - (LET ((|z| (SPADCALL (|shellEntry| $ 13)))) - (SEQ (LOOP - (COND - ((NOT (AND (NOT (SPADCALL |x| (|shellEntry| $ 16))) - (NOT (SPADCALL |y| (|shellEntry| $ 16))))) - (RETURN NIL)) - (T (SEQ (SETQ |z| - (SPADCALL - (SPADCALL - (SPADCALL |x| (|shellEntry| $ 18)) - (SPADCALL |y| (|shellEntry| $ 18)) - |f|) - |z| (|shellEntry| $ 14))) - (SETQ |x| (SPADCALL |x| (|shellEntry| $ 17))) - (EXIT (SETQ |y| - (SPADCALL |y| (|shellEntry| $ 17)))))))) - (EXIT (SPADCALL |z| (|shellEntry| $ 55)))))) - -(DEFUN |LSAGG-;reverse!;2A;20| (|x| $) - (PROG (|y| |z|) - (RETURN - (COND - ((OR (SPADCALL |x| (|shellEntry| $ 16)) - (SPADCALL - (LETT |y| (SPADCALL |x| (|shellEntry| $ 17)) - |LSAGG-;reverse!;2A;20|) - (|shellEntry| $ 16))) - |x|) - (T (SEQ (SPADCALL |x| (SPADCALL (|shellEntry| $ 13)) - (|shellEntry| $ 27)) - (LOOP - (COND - ((NOT (NOT (SPADCALL |y| (|shellEntry| $ 16)))) - (RETURN NIL)) - (T (SEQ (LETT |z| - (SPADCALL |y| (|shellEntry| $ 17)) - |LSAGG-;reverse!;2A;20|) - (SPADCALL |y| |x| (|shellEntry| $ 27)) - (SETQ |x| |y|) (EXIT (SETQ |y| |z|)))))) - (EXIT |x|))))))) - -(DEFUN |LSAGG-;copy;2A;21| (|x| $) - (LET ((|y| (SPADCALL (|shellEntry| $ 13)))) - (SEQ (LET ((|k| 0)) - (LOOP - (COND - ((NOT (NOT (SPADCALL |x| (|shellEntry| $ 16)))) - (RETURN NIL)) - (T (COND - ((AND (EQL |k| 1000) - (SPADCALL |x| (|shellEntry| $ 67))) - (|error| "cyclic list")) - (T (SEQ (SETQ |y| - (SPADCALL - (SPADCALL |x| - (|shellEntry| $ 18)) - |y| (|shellEntry| $ 14))) - (EXIT (SETQ |x| - (SPADCALL |x| - (|shellEntry| $ 17))))))))) - (SETQ |k| (+ |k| 1)))) - (EXIT (SPADCALL |y| (|shellEntry| $ 55)))))) - -(DEFUN |LSAGG-;copyInto!;2AIA;22| (|y| |x| |s| $) - (PROG (|z|) - (RETURN - (LET ((|m| (SPADCALL |y| (|shellEntry| $ 33)))) - (COND - ((< |s| |m|) (|error| "index out of range")) - (T (SEQ (LETT |z| - (SPADCALL |y| - (LET ((#0=#:G1527 (- |s| |m|))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|shellEntry| $ 39)) - |LSAGG-;copyInto!;2AIA;22|) - (LOOP - (COND - ((NOT (AND (NOT (SPADCALL |z| - (|shellEntry| $ 16))) - (NOT (SPADCALL |x| - (|shellEntry| $ 16))))) - (RETURN NIL)) - (T (SEQ (SPADCALL |z| - (SPADCALL |x| (|shellEntry| $ 18)) - (|shellEntry| $ 69)) - (SETQ |x| - (SPADCALL |x| (|shellEntry| $ 17))) - (EXIT (SETQ |z| - (SPADCALL |z| (|shellEntry| $ 17)))))))) - (EXIT |y|)))))))) - -(DEFUN |LSAGG-;position;SA2I;23| (|w| |x| |s| $) - (PROG (|k|) - (RETURN - (LET ((|m| (SPADCALL |x| (|shellEntry| $ 33)))) - (COND - ((< |s| |m|) (|error| "index out of range")) - (T (SEQ (SETQ |x| - (SPADCALL |x| - (LET ((#0=#:G1534 (- |s| |m|))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|shellEntry| $ 39))) - (LETT |k| |s| |LSAGG-;position;SA2I;23|) - (LOOP - (COND - ((NOT (AND (NOT (SPADCALL |x| - (|shellEntry| $ 16))) - (SPADCALL |w| - (SPADCALL |x| (|shellEntry| $ 18)) - (|shellEntry| $ 61)))) - (RETURN NIL)) - (T (SEQ (SETQ |x| - (SPADCALL |x| (|shellEntry| $ 17))) - (EXIT (SETQ |k| (+ |k| 1))))))) - (EXIT (COND - ((SPADCALL |x| (|shellEntry| $ 16)) - (- (SPADCALL |x| (|shellEntry| $ 33)) 1)) - (T |k|)))))))))) - -(DEFUN |LSAGG-;removeDuplicates!;2A;24| (|l| $) - (LET ((|p| |l|)) - (SEQ (LOOP - (COND - ((NOT (NOT (SPADCALL |p| (|shellEntry| $ 16)))) - (RETURN NIL)) - (T (SETQ |p| - (SPADCALL |p| - (SPADCALL - (CONS #'|LSAGG-;removeDuplicates!;2A;24!0| - (VECTOR $ |p|)) - (SPADCALL |p| (|shellEntry| $ 17)) - (|shellEntry| $ 73)) - (|shellEntry| $ 27)))))) - (EXIT |l|)))) - -(DEFUN |LSAGG-;removeDuplicates!;2A;24!0| (|#1| $$) - (LET (($ (SVREF $$ 0))) - (SPADCALL |#1| (SPADCALL (SVREF $$ 1) (|shellEntry| $ 18)) - (|shellEntry| $ 72)))) - -(DEFUN |LSAGG-;<;2AB;25| (|x| |y| $) - (SEQ (LOOP - (COND - ((NOT (AND (NOT (SPADCALL |x| (|shellEntry| $ 16))) - (NOT (SPADCALL |y| (|shellEntry| $ 16))))) - (RETURN NIL)) - (T (COND - ((SPADCALL (SPADCALL |x| (|shellEntry| $ 18)) - (SPADCALL |y| (|shellEntry| $ 18)) - (|shellEntry| $ 61)) - (RETURN-FROM |LSAGG-;<;2AB;25| - (SPADCALL (SPADCALL |x| (|shellEntry| $ 18)) - (SPADCALL |y| (|shellEntry| $ 18)) - (|shellEntry| $ 75)))) - (T (SEQ (SETQ |x| (SPADCALL |x| (|shellEntry| $ 17))) - (EXIT (SETQ |y| - (SPADCALL |y| (|shellEntry| $ 17)))))))))) - (EXIT (AND (SPADCALL |x| (|shellEntry| $ 16)) - (NOT (SPADCALL |y| (|shellEntry| $ 16))))))) - -(DEFUN |ListAggregate&| (|#1| |#2|) - (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) - (|dv$| (LIST '|ListAggregate&| |dv$1| |dv$2|)) - ($ (|newShell| 78)) (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (SETF (|shellEntry| $ 7) |#2|) - (COND - ((|HasCategory| |#2| '(|SetCategory|)) - (SETF (|shellEntry| $ 62) - (CONS (|dispatchFunction| |LSAGG-;reduce;MA3S;17|) $)))) - (COND - ((|HasCategory| |#2| '(|SetCategory|)) - (PROGN - (SETF (|shellEntry| $ 71) - (CONS (|dispatchFunction| |LSAGG-;position;SA2I;23|) $)) - (SETF (|shellEntry| $ 74) - (CONS (|dispatchFunction| - |LSAGG-;removeDuplicates!;2A;24|) - $))))) - (COND - ((|HasCategory| |#2| '(|OrderedSet|)) - (SETF (|shellEntry| $ 76) - (CONS (|dispatchFunction| |LSAGG-;<;2AB;25|) $)))) - $)) - -(MAKEPROP '|ListAggregate&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|NonNegativeInteger|) (0 . |#|) (|Boolean|) - (|Mapping| 10 7 7) |LSAGG-;sort!;M2A;1| (5 . |empty|) - (9 . |concat|) |LSAGG-;list;SA;2| (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 . |false|) - (53 . |not|) (58 . |setrest!|) (|Mapping| 10 7) - |LSAGG-;select!;M2A;5| (64 . |eq?|) |LSAGG-;merge!;M3A;6| - (|Integer|) (70 . |minIndex|) (75 . <) (81 . =) - (87 . |One|) (91 . |One|) (95 . -) (101 . |rest|) - |LSAGG-;insert!;SAIA;7| (107 . |concat!|) - |LSAGG-;insert!;2AIA;8| |LSAGG-;remove!;M2A;9| - |LSAGG-;delete!;AIA;10| (|UniversalSegment| 32) - (113 . |lo|) (118 . |hasHi|) (123 . |hi|) - (128 . |maxIndex|) (133 . +) |LSAGG-;delete!;AUsA;11| - (|Union| 7 '"failed") |LSAGG-;find;MAU;12| - |LSAGG-;position;MAI;13| (139 . |reverse!|) (144 . |quo|) - (150 . |split!|) (156 . |true|) |LSAGG-;sorted?;MAB;15| - |LSAGG-;reduce;MA2S;16| (160 . ~=) (166 . |reduce|) - |LSAGG-;new;NniSA;18| |LSAGG-;map;M3A;19| - |LSAGG-;reverse!;2A;20| (174 . =) (180 . |cyclic?|) - |LSAGG-;copy;2A;21| (185 . |setfirst!|) - |LSAGG-;copyInto!;2AIA;22| (191 . |position|) (198 . =) - (204 . |remove!|) (210 . |removeDuplicates!|) (215 . <) - (221 . <) (|Mapping| 7 7)) - '#(|sorted?| 227 |sort!| 233 |select!| 239 |reverse!| 245 - |removeDuplicates!| 250 |remove!| 255 |reduce| 261 - |position| 282 |new| 295 |merge!| 301 |merge| 308 |map| - 315 |list| 322 |insert!| 327 |find| 341 |delete!| 347 - |copyInto!| 359 |copy| 366 < 371) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 76 - '(1 6 8 0 9 0 6 0 13 2 6 0 7 0 14 1 6 - 10 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 11 0 0 23 - 0 10 0 25 1 10 0 0 26 2 6 0 0 0 27 2 - 6 10 0 0 30 1 6 32 0 33 2 32 10 0 0 - 34 2 32 10 0 0 35 0 8 0 36 0 32 0 37 - 2 32 0 0 0 38 2 6 0 0 8 39 2 6 0 0 0 - 41 1 45 32 0 46 1 45 10 0 47 1 45 32 - 0 48 1 6 32 0 49 2 32 0 0 0 50 1 6 0 - 0 55 2 32 0 0 0 56 2 6 0 0 32 57 0 10 - 0 58 2 7 10 0 0 61 4 0 7 19 0 7 7 62 - 2 8 10 0 0 66 1 6 10 0 67 2 6 7 0 7 - 69 3 0 32 7 0 32 71 2 7 10 0 0 72 2 6 - 0 28 0 73 1 0 0 0 74 2 7 10 0 0 75 2 - 0 10 0 0 76 2 0 10 11 0 59 2 0 0 11 0 - 12 2 0 0 28 0 29 1 0 0 0 65 1 0 0 0 - 74 2 0 0 28 0 43 3 0 7 19 0 7 60 4 0 - 7 19 0 7 7 62 2 0 7 19 0 21 2 0 32 28 - 0 54 3 0 32 7 0 32 71 2 0 0 8 7 63 3 - 0 0 11 0 0 31 3 0 0 11 0 0 24 3 0 0 - 19 0 0 64 1 0 0 7 15 3 0 0 7 0 32 40 - 3 0 0 0 0 32 42 2 0 52 28 0 53 2 0 0 - 0 45 51 2 0 0 0 32 44 3 0 0 0 0 32 70 - 1 0 0 0 68 2 0 10 0 0 76))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/LSAGG.lsp b/src/algebra/strap/LSAGG.lsp deleted file mode 100644 index e84a2d74..00000000 --- a/src/algebra/strap/LSAGG.lsp +++ /dev/null @@ -1,33 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |ListAggregate;CAT| 'NIL) - -(DEFPARAMETER |ListAggregate;AL| 'NIL) - -(DEFUN |ListAggregate;| (|t#1|) - (LET ((#0=#:G1405 - (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (COND - (|ListAggregate;CAT|) - (T (SETQ |ListAggregate;CAT| - (|Join| (|StreamAggregate| '|t#1|) - (|FiniteLinearAggregate| '|t#1|) - (|ExtensibleLinearAggregate| '|t#1|) - (|mkCategory| '|domain| - '(((|list| ($ |t#1|)) T)) NIL 'NIL - NIL)))))))) - (SETF (|shellEntry| #0# 0) - (LIST '|ListAggregate| (|devaluate| |t#1|))) - #0#)) - -(DEFUN |ListAggregate| (#0=#:G1406) - (LET ((#1=#:G1407 (|assoc| (|devaluate| #0#) |ListAggregate;AL|))) - (COND - (#1# (CDR #1#)) - (T (PROGN - (SETQ #1# (|ListAggregate;| #0#)) - (SETQ |ListAggregate;AL| - (|cons5| (CONS (|devaluate| #0#) #1#) - |ListAggregate;AL|)) - #1#))))) diff --git a/src/algebra/strap/MONOID-.lsp b/src/algebra/strap/MONOID-.lsp deleted file mode 100644 index e04b7bc3..00000000 --- a/src/algebra/strap/MONOID-.lsp +++ /dev/null @@ -1,55 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |MONOID-;one?;SB;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |MONOID-;sample;S;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |MONOID-;recip;SU;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|) - |%Thing|) - |MONOID-;**;SNniS;4|)) - -(DEFUN |MONOID-;one?;SB;1| (|x| $) - (SPADCALL |x| (|spadConstant| $ 7) (|shellEntry| $ 9))) - -(DEFUN |MONOID-;sample;S;2| ($) (|spadConstant| $ 7)) - -(DEFUN |MONOID-;recip;SU;3| (|x| $) - (COND - ((SPADCALL |x| (|shellEntry| $ 12)) (CONS 0 |x|)) - (T (CONS 1 "failed")))) - -(DEFUN |MONOID-;**;SNniS;4| (|x| |n| $) - (COND - ((ZEROP |n|) (|spadConstant| $ 7)) - (T (SPADCALL |x| |n| (|shellEntry| $ 19))))) - -(DEFUN |Monoid&| (|#1|) - (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$| (LIST '|Monoid&| |dv$1|)) - ($ (|newShell| 21)) (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - $)) - -(MAKEPROP '|Monoid&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |One|) - (|Boolean|) (4 . =) |MONOID-;one?;SB;1| - |MONOID-;sample;S;2| (10 . |one?|) (|Union| $ '"failed") - |MONOID-;recip;SU;3| (|NonNegativeInteger|) (15 . |zero?|) - (|PositiveInteger|) (|RepeatedSquaring| 6) (20 . |expt|) - |MONOID-;**;SNniS;4|) - '#(|sample| 26 |recip| 30 |one?| 35 ** 40) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 20 - '(0 6 0 7 2 6 8 0 0 9 1 6 8 0 12 1 15 8 - 0 16 2 18 6 6 17 19 0 0 0 11 1 0 13 0 - 14 1 0 8 0 10 2 0 0 0 15 20))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/MONOID.lsp b/src/algebra/strap/MONOID.lsp deleted file mode 100644 index b5ddece3..00000000 --- a/src/algebra/strap/MONOID.lsp +++ /dev/null @@ -1,22 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |Monoid;AL| 'NIL) - -(DEFUN |Monoid;| () - (LET ((#0=#:G1374 - (|Join| (|SemiGroup|) - (|mkCategory| '|domain| - '(((|One| ($) |constant|) T) - ((|sample| ($) |constant|) T) - ((|one?| ((|Boolean|) $)) T) - ((** ($ $ (|NonNegativeInteger|))) T) - ((|recip| ((|Union| $ "failed") $)) T)) - NIL '((|NonNegativeInteger|) (|Boolean|)) NIL)))) - (SETF (|shellEntry| #0# 0) '(|Monoid|)) - #0#)) - -(DEFUN |Monoid| () - (COND (|Monoid;AL|) (T (SETQ |Monoid;AL| (|Monoid;|))))) - -(MAKEPROP '|Monoid| 'NILADIC T) diff --git a/src/algebra/strap/MTSCAT.lsp b/src/algebra/strap/MTSCAT.lsp deleted file mode 100644 index 29c3f959..00000000 --- a/src/algebra/strap/MTSCAT.lsp +++ /dev/null @@ -1,101 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |MultivariateTaylorSeriesCategory;CAT| 'NIL) - -(DEFPARAMETER |MultivariateTaylorSeriesCategory;AL| 'NIL) - -(DEFUN |MultivariateTaylorSeriesCategory;| (|t#1| |t#2|) - (LET ((#0=#:G1374 - (|sublisV| - (PAIR '(|t#1| |t#2|) - (LIST (|devaluate| |t#1|) (|devaluate| |t#2|))) - (|sublisV| - (PAIR '(#1=#:G1373) '((|IndexedExponents| |t#2|))) - (COND - (|MultivariateTaylorSeriesCategory;CAT|) - (T (SETQ |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))))))))) - (SETF (|shellEntry| #0# 0) - (LIST '|MultivariateTaylorSeriesCategory| (|devaluate| |t#1|) - (|devaluate| |t#2|))) - #0#)) - -(DEFUN |MultivariateTaylorSeriesCategory| - (&REST #0=#:G1377 &AUX #1=#:G1375) - (DSETQ #1# #0#) - (LET ((#2=#:G1376 - (|assoc| (|devaluateList| #1#) - |MultivariateTaylorSeriesCategory;AL|))) - (COND - (#2# (CDR #2#)) - (T (PROGN - (SETQ #2# (APPLY #'|MultivariateTaylorSeriesCategory;| #1#)) - (SETQ |MultivariateTaylorSeriesCategory;AL| - (|cons5| (CONS (|devaluateList| #1#) #2#) - |MultivariateTaylorSeriesCategory;AL|)) - #2#))))) diff --git a/src/algebra/strap/NNI.lsp b/src/algebra/strap/NNI.lsp deleted file mode 100644 index 0419b586..00000000 --- a/src/algebra/strap/NNI.lsp +++ /dev/null @@ -1,112 +0,0 @@ - -(/VERSIONCHECK 2) - -(|noteSubDomainInfo| '|NonNegativeInteger| '(|Integer|) - '(|%not| (|%ilt| |#1| 0))) - -(DECLAIM (FTYPE (FUNCTION - ((|%IntegerSection| 0) (|%IntegerSection| 0) - |%Shell|) - (|%IntegerSection| 0)) - |NNI;sup;3$;1|)) - -(PUT '|NNI;sup;3$;1| '|SPADreplace| '|%imax|) - -(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) |%Integer| |%Shell|) - (|%IntegerSection| 0)) - |NNI;shift;$I$;2|)) - -(PUT '|NNI;shift;$I$;2| '|SPADreplace| 'ASH) - -(DECLAIM (FTYPE (FUNCTION - ((|%IntegerSection| 0) (|%IntegerSection| 0) - |%Shell|) - |%Pair|) - |NNI;subtractIfCan;2$U;3|)) - -(DEFUN |NNI;sup;3$;1| (|x| |y| $) (DECLARE (IGNORE $)) (MAX |x| |y|)) - -(DEFUN |NNI;shift;$I$;2| (|x| |n| $) - (DECLARE (IGNORE $)) - (ASH |x| |n|)) - -(DEFUN |NNI;subtractIfCan;2$U;3| (|x| |y| $) - (LET ((|c| (- |x| |y|))) - (COND - ((MINUSP |c|) (CONS 1 "failed")) - (T (CONS 0 - (|check-subtype| (NOT (MINUSP |c|)) - '(|NonNegativeInteger|) |c|)))))) - -(DEFUN |NonNegativeInteger| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((#0=#:G1384 (HGET |$ConstructorCache| '|NonNegativeInteger|))) - (COND - (#0# (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| - '|NonNegativeInteger| - (LIST (CONS NIL - (CONS 1 (|NonNegativeInteger;|)))))) - (SETQ #0# T)) - (COND - ((NOT #0#) - (HREM |$ConstructorCache| '|NonNegativeInteger|)))))))) - -(DEFUN |NonNegativeInteger;| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((|dv$| '(|NonNegativeInteger|)) ($ (|newShell| 22)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|haddProp| |$ConstructorCache| '|NonNegativeInteger| NIL - (CONS 1 $)) - (|stuffDomainSlots| $) - $)) - -(MAKEPROP '|NonNegativeInteger| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL (|Integer|) (0 . |Zero|) (4 . |Zero|) - (|Boolean|) (8 . >=) |NNI;sup;3$;1| |NNI;shift;$I$;2| - (14 . -) (20 . <) (|Union| $ '"failed") - |NNI;subtractIfCan;2$U;3| - (|Record| (|:| |quotient| $) (|:| |remainder| $)) - (|PositiveInteger|) (|NonNegativeInteger|) (|String|) - (|OutputForm|) (|SingleInteger|)) - '#(~= 26 |zero?| 32 |sup| 37 |subtractIfCan| 43 |shift| 49 - |sample| 55 |rem| 59 |recip| 65 |random| 70 |quo| 75 - |one?| 81 |min| 86 |max| 92 |latex| 98 |hash| 103 |gcd| - 108 |exquo| 114 |divide| 120 |coerce| 126 |before?| 131 - |Zero| 137 |One| 141 >= 145 > 151 = 157 <= 163 < 169 + 175 - ** 181 * 193) - '(((|commutative| "*") . 0)) - (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)) - (CONS '#(NIL NIL NIL NIL NIL |Monoid&| |AbelianMonoid&| - NIL |SemiGroup&| |AbelianSemiGroup&| - |SetCategory&| |OrderedType&| |BasicType&| NIL - NIL) - (CONS '#((|OrderedAbelianMonoidSup|) - (|OrderedCancellationAbelianMonoid|) - (|OrderedAbelianMonoid|) - (|CancellationAbelianMonoid|) - (|OrderedAbelianSemiGroup|) (|Monoid|) - (|AbelianMonoid|) (|OrderedSet|) - (|SemiGroup|) (|AbelianSemiGroup|) - (|SetCategory|) (|OrderedType|) - (|BasicType|) (|Type|) - (|CoercibleTo| 20)) - (|makeByteWordVec2| 21 - '(0 0 0 6 0 5 0 7 2 5 8 0 0 9 2 5 0 0 0 - 12 2 5 8 0 0 13 2 0 8 0 0 1 1 0 8 0 1 - 2 0 0 0 0 10 2 0 14 0 0 15 2 0 0 0 5 - 11 0 0 0 1 2 0 0 0 0 1 1 0 14 0 1 1 0 - 0 0 1 2 0 0 0 0 1 1 0 8 0 1 2 0 0 0 0 - 1 2 0 0 0 0 1 1 0 19 0 1 1 0 21 0 1 2 - 0 0 0 0 1 2 0 14 0 0 1 2 0 16 0 0 1 1 - 0 20 0 1 2 0 8 0 0 1 0 0 0 6 0 0 0 1 - 2 0 8 0 0 1 2 0 8 0 0 1 2 0 8 0 0 1 2 - 0 8 0 0 1 2 0 8 0 0 1 2 0 0 0 0 1 2 0 - 0 0 17 1 2 0 0 0 18 1 2 0 0 0 0 1 2 0 - 0 18 0 1 2 0 0 17 0 1))))) - '|lookupComplete|)) - -(MAKEPROP '|NonNegativeInteger| 'NILADIC T) diff --git a/src/algebra/strap/OINTDOM.lsp b/src/algebra/strap/OINTDOM.lsp deleted file mode 100644 index 60badcf6..00000000 --- a/src/algebra/strap/OINTDOM.lsp +++ /dev/null @@ -1,16 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |OrderedIntegralDomain;AL| 'NIL) - -(DEFUN |OrderedIntegralDomain;| () - (LET ((#0=#:G1372 (|Join| (|IntegralDomain|) (|OrderedRing|)))) - (SETF (|shellEntry| #0# 0) '(|OrderedIntegralDomain|)) - #0#)) - -(DEFUN |OrderedIntegralDomain| () - (COND - (|OrderedIntegralDomain;AL|) - (T (SETQ |OrderedIntegralDomain;AL| (|OrderedIntegralDomain;|))))) - -(MAKEPROP '|OrderedIntegralDomain| 'NILADIC T) diff --git a/src/algebra/strap/ORDRING-.lsp b/src/algebra/strap/ORDRING-.lsp deleted file mode 100644 index c50c7657..00000000 --- a/src/algebra/strap/ORDRING-.lsp +++ /dev/null @@ -1,64 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |ORDRING-;positive?;SB;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |ORDRING-;negative?;SB;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|) - |ORDRING-;sign;SI;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |ORDRING-;abs;2S;4|)) - -(DEFUN |ORDRING-;positive?;SB;1| (|x| $) - (SPADCALL |x| (|spadConstant| $ 7) (|shellEntry| $ 9))) - -(DEFUN |ORDRING-;negative?;SB;2| (|x| $) - (SPADCALL |x| (|spadConstant| $ 7) (|shellEntry| $ 11))) - -(DEFUN |ORDRING-;sign;SI;3| (|x| $) - (COND - ((SPADCALL |x| (|shellEntry| $ 13)) 1) - ((SPADCALL |x| (|shellEntry| $ 16)) -1) - ((SPADCALL |x| (|shellEntry| $ 19)) 0) - (T (|error| "x satisfies neither positive?, negative? or zero?")))) - -(DEFUN |ORDRING-;abs;2S;4| (|x| $) - (COND - ((SPADCALL |x| (|shellEntry| $ 13)) |x|) - ((SPADCALL |x| (|shellEntry| $ 16)) - (SPADCALL |x| (|shellEntry| $ 22))) - ((SPADCALL |x| (|shellEntry| $ 19)) (|spadConstant| $ 7)) - (T (|error| "x satisfies neither positive?, negative? or zero?")))) - -(DEFUN |OrderedRing&| (|#1|) - (LET* ((|dv$1| (|devaluate| |#1|)) - (|dv$| (LIST '|OrderedRing&| |dv$1|)) ($ (|newShell| 24)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - $)) - -(MAKEPROP '|OrderedRing&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|) - (|Boolean|) (4 . >) |ORDRING-;positive?;SB;1| (10 . <) - |ORDRING-;negative?;SB;2| (16 . |positive?|) (|Integer|) - (21 . |One|) (25 . |negative?|) (30 . |One|) (34 . -) - (39 . |zero?|) (44 . |Zero|) |ORDRING-;sign;SI;3| (48 . -) - |ORDRING-;abs;2S;4|) - '#(|sign| 53 |positive?| 58 |negative?| 63 |abs| 68) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 23 - '(0 6 0 7 2 6 8 0 0 9 2 6 8 0 0 11 1 6 - 8 0 13 0 14 0 15 1 6 8 0 16 0 6 0 17 - 1 14 0 0 18 1 6 8 0 19 0 14 0 20 1 6 - 0 0 22 1 0 14 0 21 1 0 8 0 10 1 0 8 0 - 12 1 0 0 0 23))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/ORDRING.lsp b/src/algebra/strap/ORDRING.lsp deleted file mode 100644 index db9f9682..00000000 --- a/src/algebra/strap/ORDRING.lsp +++ /dev/null @@ -1,23 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |OrderedRing;AL| 'NIL) - -(DEFUN |OrderedRing;| () - (LET ((#0=#:G1378 - (|Join| (|OrderedAbelianGroup|) (|Ring|) (|Monoid|) - (|mkCategory| '|domain| - '(((|positive?| ((|Boolean|) $)) T) - ((|negative?| ((|Boolean|) $)) T) - ((|sign| ((|Integer|) $)) T) - ((|abs| ($ $)) T)) - NIL '((|Integer|) (|Boolean|)) NIL)))) - (SETF (|shellEntry| #0# 0) '(|OrderedRing|)) - #0#)) - -(DEFUN |OrderedRing| () - (COND - (|OrderedRing;AL|) - (T (SETQ |OrderedRing;AL| (|OrderedRing;|))))) - -(MAKEPROP '|OrderedRing| 'NILADIC T) diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp deleted file mode 100644 index bd58216a..00000000 --- a/src/algebra/strap/OUTFORM.lsp +++ /dev/null @@ -1,1126 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%String|) - |OUTFORM;doubleFloatFormat;2S;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%Thing|) - |OUTFORM;sform|)) - -(PUT '|OUTFORM;sform| '|SPADreplace| '(XLAM (|s|) |s|)) - -(DECLAIM (FTYPE (FUNCTION (|%Symbol| |%Shell|) |%Thing|) - |OUTFORM;eform|)) - -(PUT '|OUTFORM;eform| '|SPADreplace| '(XLAM (|e|) |e|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|) - |OUTFORM;iform|)) - -(PUT '|OUTFORM;iform| '|SPADreplace| '(XLAM (|i|) |i|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) |OUTFORM;bless|)) - -(PUT '|OUTFORM;bless| '|SPADreplace| '(XLAM (|x|) |x|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Void|) - |OUTFORM;print;$V;6|)) - -(PUT '|OUTFORM;print;$V;6| '|SPADreplace| '|mathprint|) - -(DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%Thing|) - |OUTFORM;message;S$;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%Void|) - |OUTFORM;messagePrint;SV;8|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |OUTFORM;=;2$B;9|)) - -(PUT '|OUTFORM;=;2$B;9| '|SPADreplace| '|%equal|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;=;3$;10|)) - -(PUT '|OUTFORM;=;3$;10| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '= |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;coerce;2$;11|)) - -(PUT '|OUTFORM;coerce;2$;11| '|SPADreplace| '(XLAM (|a|) |a|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|) - |OUTFORM;outputForm;I$;12|)) - -(PUT '|OUTFORM;outputForm;I$;12| '|SPADreplace| '(XLAM (|n|) |n|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;outputForm;S$;13|)) - -(PUT '|OUTFORM;outputForm;S$;13| '|SPADreplace| '(XLAM (|e|) |e|)) - -(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Thing|) - |OUTFORM;outputForm;Df$;14|)) - -(PUT '|OUTFORM;outputForm;Df$;14| '|SPADreplace| - 'DFLOAT-FORMAT-GENERAL) - -(DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%Thing|) - |OUTFORM;outputForm;S$;15|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|) - |OUTFORM;width;$I;16|)) - -(PUT '|OUTFORM;width;$I;16| '|SPADreplace| '|outformWidth|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|) - |OUTFORM;height;$I;17|)) - -(PUT '|OUTFORM;height;$I;17| '|SPADreplace| '|height|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|) - |OUTFORM;subHeight;$I;18|)) - -(PUT '|OUTFORM;subHeight;$I;18| '|SPADreplace| '|subspan|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|) - |OUTFORM;superHeight;$I;19|)) - -(PUT '|OUTFORM;superHeight;$I;19| '|SPADreplace| '|superspan|) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Integer|) |OUTFORM;height;I;20|)) - -(PUT '|OUTFORM;height;I;20| '|SPADreplace| '(XLAM NIL 20)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Integer|) |OUTFORM;width;I;21|)) - -(PUT '|OUTFORM;width;I;21| '|SPADreplace| '(XLAM NIL 66)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Thing|) - |OUTFORM;center;$I$;22|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Thing|) - |OUTFORM;left;$I$;23|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Thing|) - |OUTFORM;right;$I$;24|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;center;2$;25|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;left;2$;26|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;right;2$;27|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|) - |OUTFORM;vspace;I$;28|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|) - |OUTFORM;hspace;I$;29|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Thing|) - |OUTFORM;rspace;2I$;30|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |OUTFORM;matrix;L$;31|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |OUTFORM;pile;L$;32|)) - -(PUT '|OUTFORM;pile;L$;32| '|SPADreplace| - '(XLAM (|l|) (|%pair| 'SC |l|))) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |OUTFORM;commaSeparate;L$;33|)) - -(PUT '|OUTFORM;commaSeparate;L$;33| '|SPADreplace| - '(XLAM (|l|) (|%pair| 'AGGLST |l|))) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |OUTFORM;semicolonSeparate;L$;34|)) - -(PUT '|OUTFORM;semicolonSeparate;L$;34| '|SPADreplace| - '(XLAM (|l|) (|%pair| 'AGGSET |l|))) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |OUTFORM;blankSeparate;L$;35|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;brace;2$;36|)) - -(PUT '|OUTFORM;brace;2$;36| '|SPADreplace| - '(XLAM (|a|) (|%list| 'BRACE |a|))) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |OUTFORM;brace;L$;37|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;bracket;2$;38|)) - -(PUT '|OUTFORM;bracket;2$;38| '|SPADreplace| - '(XLAM (|a|) (|%list| 'BRACKET |a|))) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |OUTFORM;bracket;L$;39|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;paren;2$;40|)) - -(PUT '|OUTFORM;paren;2$;40| '|SPADreplace| - '(XLAM (|a|) (|%list| 'PAREN |a|))) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |OUTFORM;paren;L$;41|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;sub;3$;42|)) - -(PUT '|OUTFORM;sub;3$;42| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'SUB |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;super;3$;43|)) - -(PUT '|OUTFORM;super;3$;43| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'SUPERSUB |a| " " |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;presub;3$;44|)) - -(PUT '|OUTFORM;presub;3$;44| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'SUPERSUB |a| " " " " " " |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;presuper;3$;45|)) - -(PUT '|OUTFORM;presuper;3$;45| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'SUPERSUB |a| " " " " |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|) - |OUTFORM;scripts;$L$;46|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|) - |OUTFORM;supersub;$L$;47|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;hconcat;3$;48|)) - -(PUT '|OUTFORM;hconcat;3$;48| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'CONCAT |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |OUTFORM;hconcat;L$;49|)) - -(PUT '|OUTFORM;hconcat;L$;49| '|SPADreplace| - '(XLAM (|l|) (|%pair| 'CONCAT |l|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;vconcat;3$;50|)) - -(PUT '|OUTFORM;vconcat;3$;50| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'VCONCAT |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |OUTFORM;vconcat;L$;51|)) - -(PUT '|OUTFORM;vconcat;L$;51| '|SPADreplace| - '(XLAM (|l|) (|%pair| 'VCONCAT |l|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;~=;3$;52|)) - -(PUT '|OUTFORM;~=;3$;52| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '~= |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;<;3$;53|)) - -(PUT '|OUTFORM;<;3$;53| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '< |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;>;3$;54|)) - -(PUT '|OUTFORM;>;3$;54| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '> |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;<=;3$;55|)) - -(PUT '|OUTFORM;<=;3$;55| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '<= |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;>=;3$;56|)) - -(PUT '|OUTFORM;>=;3$;56| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '>= |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;+;3$;57|)) - -(PUT '|OUTFORM;+;3$;57| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '+ |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;-;3$;58|)) - -(PUT '|OUTFORM;-;3$;58| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '- |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;-;2$;59|)) - -(PUT '|OUTFORM;-;2$;59| '|SPADreplace| '(XLAM (|a|) (|%list| '- |a|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;*;3$;60|)) - -(PUT '|OUTFORM;*;3$;60| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '* |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;/;3$;61|)) - -(PUT '|OUTFORM;/;3$;61| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '/ |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;**;3$;62|)) - -(PUT '|OUTFORM;**;3$;62| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '** |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;div;3$;63|)) - -(PUT '|OUTFORM;div;3$;63| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '|div| |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;rem;3$;64|)) - -(PUT '|OUTFORM;rem;3$;64| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '|rem| |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;quo;3$;65|)) - -(PUT '|OUTFORM;quo;3$;65| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '|quo| |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;exquo;3$;66|)) - -(PUT '|OUTFORM;exquo;3$;66| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '|exquo| |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;and;3$;67|)) - -(PUT '|OUTFORM;and;3$;67| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '|and| |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;or;3$;68|)) - -(PUT '|OUTFORM;or;3$;68| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '|or| |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;not;2$;69|)) - -(PUT '|OUTFORM;not;2$;69| '|SPADreplace| - '(XLAM (|a|) (|%list| '|not| |a|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;SEGMENT;3$;70|)) - -(PUT '|OUTFORM;SEGMENT;3$;70| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'SEGMENT |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;SEGMENT;2$;71|)) - -(PUT '|OUTFORM;SEGMENT;2$;71| '|SPADreplace| - '(XLAM (|a|) (|%list| 'SEGMENT |a|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;binomial;3$;72|)) - -(PUT '|OUTFORM;binomial;3$;72| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'BINOMIAL |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |OUTFORM;empty;$;73|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |OUTFORM;infix?;$B;74|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|) - |OUTFORM;elt;$L$;75|)) - -(PUT '|OUTFORM;elt;$L$;75| '|SPADreplace| '|%pair|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|) - |OUTFORM;prefix;$L$;76|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|) - |OUTFORM;infix;$L$;77|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |OUTFORM;infix;4$;78|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;postfix;3$;79|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;string;2$;80|)) - -(PUT '|OUTFORM;string;2$;80| '|SPADreplace| - '(XLAM (|a|) (|%list| 'STRING |a|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;quote;2$;81|)) - -(PUT '|OUTFORM;quote;2$;81| '|SPADreplace| - '(XLAM (|a|) (|%list| 'QUOTE |a|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;overbar;2$;82|)) - -(PUT '|OUTFORM;overbar;2$;82| '|SPADreplace| - '(XLAM (|a|) (|%list| 'OVERBAR |a|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;dot;2$;83|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;prime;2$;84|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|) - |%Thing|) - |OUTFORM;dot;$Nni$;85|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|) - |%Thing|) - |OUTFORM;prime;$Nni$;86|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;overlabel;3$;87|)) - -(PUT '|OUTFORM;overlabel;3$;87| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'OVERLABEL |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;box;2$;88|)) - -(PUT '|OUTFORM;box;2$;88| '|SPADreplace| - '(XLAM (|a|) (|%list| 'BOX |a|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;zag;3$;89|)) - -(PUT '|OUTFORM;zag;3$;89| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'ZAG |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;root;2$;90|)) - -(PUT '|OUTFORM;root;2$;90| '|SPADreplace| - '(XLAM (|a|) (|%list| 'ROOT |a|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;root;3$;91|)) - -(PUT '|OUTFORM;root;3$;91| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'ROOT |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;over;3$;92|)) - -(PUT '|OUTFORM;over;3$;92| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'OVER |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;slash;3$;93|)) - -(PUT '|OUTFORM;slash;3$;93| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'SLASH |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;assign;3$;94|)) - -(PUT '|OUTFORM;assign;3$;94| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| '%LET |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;label;3$;95|)) - -(PUT '|OUTFORM;label;3$;95| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'EQUATNUM |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;rarrow;3$;96|)) - -(PUT '|OUTFORM;rarrow;3$;96| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'RARROW |a| |b|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|) - |%Thing|) - |OUTFORM;differentiate;$Nni$;97|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;sum;2$;98|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;sum;3$;99|)) - -(PUT '|OUTFORM;sum;3$;99| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'SIGMA |b| |a|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |OUTFORM;sum;4$;100|)) - -(PUT '|OUTFORM;sum;4$;100| '|SPADreplace| - '(XLAM (|a| |b| |c|) (|%list| 'SIGMA2 |b| |c| |a|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;prod;2$;101|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;prod;3$;102|)) - -(PUT '|OUTFORM;prod;3$;102| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'PI |b| |a|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |OUTFORM;prod;4$;103|)) - -(PUT '|OUTFORM;prod;4$;103| '|SPADreplace| - '(XLAM (|a| |b| |c|) (|%list| 'PI2 |b| |c| |a|))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |OUTFORM;int;2$;104|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |OUTFORM;int;3$;105|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |OUTFORM;int;4$;106|)) - -(PUT '|OUTFORM;int;4$;106| '|SPADreplace| - '(XLAM (|a| |b| |c|) (|%list| 'INTSIGN |b| |c| |a|))) - -(PUT '|OUTFORM;postfix;3$;79| '|SPADreplace| - '(XLAM (|a| |b|) (|%list| 'CONCAT |b| |a|))) - -(PUT '|OUTFORM;dot;2$;83| '|SPADreplace| - '(XLAM (|a|) (|%list| 'SUPERSUB |a| " " '|.|))) - -(PUT '|OUTFORM;prime;2$;84| '|SPADreplace| - '(XLAM (|a|) (|%list| 'SUPERSUB |a| " " '|,|))) - -(DEFUN |OUTFORM;doubleFloatFormat;2S;1| (|s| $) - (LET ((|ss| (SVREF $ 6))) - (SEQ (SETF (|shellEntry| $ 6) |s|) (EXIT |ss|)))) - -(DEFUN |OUTFORM;sform| (|s| $) (DECLARE (IGNORE $)) |s|) - -(DEFUN |OUTFORM;eform| (|e| $) (DECLARE (IGNORE $)) |e|) - -(DEFUN |OUTFORM;iform| (|i| $) (DECLARE (IGNORE $)) |i|) - -(DEFUN |OUTFORM;bless| (|x| $) (DECLARE (IGNORE $)) |x|) - -(DEFUN |OUTFORM;print;$V;6| (|x| $) - (DECLARE (IGNORE $)) - (|mathprint| |x|)) - -(DEFUN |OUTFORM;message;S$;7| (|s| $) - (COND ((ZEROP (LENGTH |s|)) (|OUTFORM;empty;$;73| $)) (T |s|))) - -(DEFUN |OUTFORM;messagePrint;SV;8| (|s| $) - (|mathprint| (|OUTFORM;message;S$;7| |s| $))) - -(DEFUN |OUTFORM;=;2$B;9| (|a| |b| $) - (DECLARE (IGNORE $)) - (EQUAL |a| |b|)) - -(DEFUN |OUTFORM;=;3$;10| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '= |a| |b|)) - -(DEFUN |OUTFORM;coerce;2$;11| (|a| $) (DECLARE (IGNORE $)) |a|) - -(DEFUN |OUTFORM;outputForm;I$;12| (|n| $) (DECLARE (IGNORE $)) |n|) - -(DEFUN |OUTFORM;outputForm;S$;13| (|e| $) (DECLARE (IGNORE $)) |e|) - -(DEFUN |OUTFORM;outputForm;Df$;14| (|f| $) - (DECLARE (IGNORE $)) - (DFLOAT-FORMAT-GENERAL |f|)) - -(DEFUN |OUTFORM;outputForm;S$;15| (|s| $) - (SPADCALL (|spadConstant| $ 27) - (SPADCALL |s| (|spadConstant| $ 27) (|shellEntry| $ 28)) - (|shellEntry| $ 29))) - -(DEFUN |OUTFORM;width;$I;16| (|a| $) - (DECLARE (IGNORE $)) - (|outformWidth| |a|)) - -(DEFUN |OUTFORM;height;$I;17| (|a| $) - (DECLARE (IGNORE $)) - (|height| |a|)) - -(DEFUN |OUTFORM;subHeight;$I;18| (|a| $) - (DECLARE (IGNORE $)) - (|subspan| |a|)) - -(DEFUN |OUTFORM;superHeight;$I;19| (|a| $) - (DECLARE (IGNORE $)) - (|superspan| |a|)) - -(DEFUN |OUTFORM;height;I;20| ($) (DECLARE (IGNORE $)) 20) - -(DEFUN |OUTFORM;width;I;21| ($) (DECLARE (IGNORE $)) 66) - -(DEFUN |OUTFORM;center;$I$;22| (|a| |w| $) - (|OUTFORM;hconcat;3$;48| - (|OUTFORM;hspace;I$;29| (TRUNCATE (- |w| (|outformWidth| |a|)) 2) - $) - |a| $)) - -(DEFUN |OUTFORM;left;$I$;23| (|a| |w| $) - (|OUTFORM;hconcat;3$;48| |a| - (|OUTFORM;hspace;I$;29| (- |w| (|outformWidth| |a|)) $) $)) - -(DEFUN |OUTFORM;right;$I$;24| (|a| |w| $) - (|OUTFORM;hconcat;3$;48| - (|OUTFORM;hspace;I$;29| (- |w| (|outformWidth| |a|)) $) |a| $)) - -(DEFUN |OUTFORM;center;2$;25| (|a| $) - (|OUTFORM;center;$I$;22| |a| 66 $)) - -(DEFUN |OUTFORM;left;2$;26| (|a| $) (|OUTFORM;left;$I$;23| |a| 66 $)) - -(DEFUN |OUTFORM;right;2$;27| (|a| $) - (|OUTFORM;right;$I$;24| |a| 66 $)) - -(DEFUN |OUTFORM;vspace;I$;28| (|n| $) - (COND - ((NOT (PLUSP |n|)) (|OUTFORM;empty;$;73| $)) - (T (|OUTFORM;vconcat;3$;50| " " - (|OUTFORM;vspace;I$;28| (- |n| 1) $) $)))) - -(DEFUN |OUTFORM;hspace;I$;29| (|n| $) - (COND - ((NOT (PLUSP |n|)) (|OUTFORM;empty;$;73| $)) - (T (|fillerSpaces| |n|)))) - -(DEFUN |OUTFORM;rspace;2I$;30| (|n| |m| $) - (COND - ((OR (NOT (PLUSP |n|)) (NOT (PLUSP |m|))) (|OUTFORM;empty;$;73| $)) - (T (|OUTFORM;vconcat;3$;50| (|OUTFORM;hspace;I$;29| |n| $) - (|OUTFORM;rspace;2I$;30| |n| (- |m| 1) $) $)))) - -(DEFUN |OUTFORM;matrix;L$;31| (|ll| $) - (LET ((|lv| (LET ((#0=#:G1527 |ll|) (#1=#:G1526 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|l| (CAR #0#))) - (SETQ #1# (CONS (LIST2VEC |l|) #1#))))) - (SETQ #0# (CDR #0#)))))) - (CONS 'MATRIX (LIST2VEC |lv|)))) - -(DEFUN |OUTFORM;pile;L$;32| (|l| $) - (DECLARE (IGNORE $)) - (CONS 'SC |l|)) - -(DEFUN |OUTFORM;commaSeparate;L$;33| (|l| $) - (DECLARE (IGNORE $)) - (CONS 'AGGLST |l|)) - -(DEFUN |OUTFORM;semicolonSeparate;L$;34| (|l| $) - (DECLARE (IGNORE $)) - (CONS 'AGGSET |l|)) - -(DEFUN |OUTFORM;blankSeparate;L$;35| (|l| $) - (LET ((|c| 'CONCATB) (|l1| NIL)) - (SEQ (LET ((#0=#:G1528 (REVERSE |l|))) - (LOOP - (COND - ((ATOM #0#) (RETURN NIL)) - (T (LET ((|u| (CAR #0#))) - (COND - ((EQCAR |u| |c|) - (SETQ |l1| (APPEND (CDR |u|) |l1|))) - (T (SETQ |l1| (CONS |u| |l1|))))))) - (SETQ #0# (CDR #0#)))) - (EXIT (CONS |c| |l1|))))) - -(DEFUN |OUTFORM;brace;2$;36| (|a| $) - (DECLARE (IGNORE $)) - (LIST 'BRACE |a|)) - -(DEFUN |OUTFORM;brace;L$;37| (|l| $) - (|OUTFORM;brace;2$;36| (CONS 'AGGLST |l|) $)) - -(DEFUN |OUTFORM;bracket;2$;38| (|a| $) - (DECLARE (IGNORE $)) - (LIST 'BRACKET |a|)) - -(DEFUN |OUTFORM;bracket;L$;39| (|l| $) - (|OUTFORM;bracket;2$;38| (CONS 'AGGLST |l|) $)) - -(DEFUN |OUTFORM;paren;2$;40| (|a| $) - (DECLARE (IGNORE $)) - (LIST 'PAREN |a|)) - -(DEFUN |OUTFORM;paren;L$;41| (|l| $) - (|OUTFORM;paren;2$;40| (CONS 'AGGLST |l|) $)) - -(DEFUN |OUTFORM;sub;3$;42| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'SUB |a| |b|)) - -(DEFUN |OUTFORM;super;3$;43| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'SUPERSUB |a| " " |b|)) - -(DEFUN |OUTFORM;presub;3$;44| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'SUPERSUB |a| " " " " " " |b|)) - -(DEFUN |OUTFORM;presuper;3$;45| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'SUPERSUB |a| " " " " |b|)) - -(DEFUN |OUTFORM;scripts;$L$;46| (|a| |l| $) - (COND - ((NULL |l|) |a|) - ((NULL (CDR |l|)) - (|OUTFORM;sub;3$;42| |a| (SPADCALL |l| (|shellEntry| $ 78)) $)) - (T (CONS 'SUPERSUB (CONS |a| |l|))))) - -(DEFUN |OUTFORM;supersub;$L$;47| (|a| |l| $) - (SEQ (COND - ((ODDP (LIST-LENGTH |l|)) - (SETQ |l| (APPEND |l| (LIST (|OUTFORM;empty;$;73| $)))))) - (EXIT (CONS 'ALTSUPERSUB (CONS |a| |l|))))) - -(DEFUN |OUTFORM;hconcat;3$;48| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'CONCAT |a| |b|)) - -(DEFUN |OUTFORM;hconcat;L$;49| (|l| $) - (DECLARE (IGNORE $)) - (CONS 'CONCAT |l|)) - -(DEFUN |OUTFORM;vconcat;3$;50| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'VCONCAT |a| |b|)) - -(DEFUN |OUTFORM;vconcat;L$;51| (|l| $) - (DECLARE (IGNORE $)) - (CONS 'VCONCAT |l|)) - -(DEFUN |OUTFORM;~=;3$;52| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '~= |a| |b|)) - -(DEFUN |OUTFORM;<;3$;53| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '< |a| |b|)) - -(DEFUN |OUTFORM;>;3$;54| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '> |a| |b|)) - -(DEFUN |OUTFORM;<=;3$;55| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '<= |a| |b|)) - -(DEFUN |OUTFORM;>=;3$;56| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '>= |a| |b|)) - -(DEFUN |OUTFORM;+;3$;57| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '+ |a| |b|)) - -(DEFUN |OUTFORM;-;3$;58| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '- |a| |b|)) - -(DEFUN |OUTFORM;-;2$;59| (|a| $) (DECLARE (IGNORE $)) (LIST '- |a|)) - -(DEFUN |OUTFORM;*;3$;60| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '* |a| |b|)) - -(DEFUN |OUTFORM;/;3$;61| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '/ |a| |b|)) - -(DEFUN |OUTFORM;**;3$;62| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '** |a| |b|)) - -(DEFUN |OUTFORM;div;3$;63| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '|div| |a| |b|)) - -(DEFUN |OUTFORM;rem;3$;64| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '|rem| |a| |b|)) - -(DEFUN |OUTFORM;quo;3$;65| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '|quo| |a| |b|)) - -(DEFUN |OUTFORM;exquo;3$;66| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '|exquo| |a| |b|)) - -(DEFUN |OUTFORM;and;3$;67| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '|and| |a| |b|)) - -(DEFUN |OUTFORM;or;3$;68| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '|or| |a| |b|)) - -(DEFUN |OUTFORM;not;2$;69| (|a| $) - (DECLARE (IGNORE $)) - (LIST '|not| |a|)) - -(DEFUN |OUTFORM;SEGMENT;3$;70| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'SEGMENT |a| |b|)) - -(DEFUN |OUTFORM;SEGMENT;2$;71| (|a| $) - (DECLARE (IGNORE $)) - (LIST 'SEGMENT |a|)) - -(DEFUN |OUTFORM;binomial;3$;72| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'BINOMIAL |a| |b|)) - -(DEFUN |OUTFORM;empty;$;73| ($) '(NOTHING)) - -(DEFUN |OUTFORM;infix?;$B;74| (|a| $) - (LET ((|e| (COND - ((IDENTP |a|) |a|) - ((STRINGP |a|) (INTERN |a|)) - (T (RETURN-FROM |OUTFORM;infix?;$B;74| NIL))))) - (NOT (NULL (GET |e| 'INFIXOP))))) - -(DEFUN |OUTFORM;elt;$L$;75| (|a| |l| $) - (DECLARE (IGNORE $)) - (CONS |a| |l|)) - -(DEFUN |OUTFORM;prefix;$L$;76| (|a| |l| $) - (COND - ((NOT (|OUTFORM;infix?;$B;74| |a| $)) (CONS |a| |l|)) - (T (|OUTFORM;hconcat;3$;48| |a| - (|OUTFORM;paren;2$;40| (CONS 'AGGLST |l|) $) $)))) - -(DEFUN |OUTFORM;infix;$L$;77| (|a| |l| $) - (COND - ((NULL |l|) (|OUTFORM;empty;$;73| $)) - ((NULL (CDR |l|)) (SPADCALL |l| (|shellEntry| $ 78))) - ((|OUTFORM;infix?;$B;74| |a| $) (CONS |a| |l|)) - (T (|OUTFORM;hconcat;L$;49| - (LIST (SPADCALL |l| (|shellEntry| $ 78)) |a| - (|OUTFORM;infix;$L$;77| |a| (CDR |l|) $)) - $)))) - -(DEFUN |OUTFORM;infix;4$;78| (|a| |b| |c| $) - (COND - ((|OUTFORM;infix?;$B;74| |a| $) (LIST |a| |b| |c|)) - (T (|OUTFORM;hconcat;L$;49| (LIST |b| |a| |c|) $)))) - -(DEFUN |OUTFORM;postfix;3$;79| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'CONCAT |b| |a|)) - -(DEFUN |OUTFORM;string;2$;80| (|a| $) - (DECLARE (IGNORE $)) - (LIST 'STRING |a|)) - -(DEFUN |OUTFORM;quote;2$;81| (|a| $) - (DECLARE (IGNORE $)) - (LIST 'QUOTE |a|)) - -(DEFUN |OUTFORM;overbar;2$;82| (|a| $) - (DECLARE (IGNORE $)) - (LIST 'OVERBAR |a|)) - -(DEFUN |OUTFORM;dot;2$;83| (|a| $) - (DECLARE (IGNORE $)) - (LIST 'SUPERSUB |a| " " '|.|)) - -(DEFUN |OUTFORM;prime;2$;84| (|a| $) - (DECLARE (IGNORE $)) - (LIST 'SUPERSUB |a| " " '|,|)) - -(DEFUN |OUTFORM;dot;$Nni$;85| (|a| |nn| $) - (LET ((|s| (MAKE-FULL-CVEC |nn| (SPADCALL "." (|shellEntry| $ 119))))) - (LIST 'SUPERSUB |a| " " |s|))) - -(DEFUN |OUTFORM;prime;$Nni$;86| (|a| |nn| $) - (LET ((|s| (MAKE-FULL-CVEC |nn| (SPADCALL "," (|shellEntry| $ 119))))) - (LIST 'SUPERSUB |a| " " |s|))) - -(DEFUN |OUTFORM;overlabel;3$;87| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'OVERLABEL |a| |b|)) - -(DEFUN |OUTFORM;box;2$;88| (|a| $) - (DECLARE (IGNORE $)) - (LIST 'BOX |a|)) - -(DEFUN |OUTFORM;zag;3$;89| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'ZAG |a| |b|)) - -(DEFUN |OUTFORM;root;2$;90| (|a| $) - (DECLARE (IGNORE $)) - (LIST 'ROOT |a|)) - -(DEFUN |OUTFORM;root;3$;91| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'ROOT |a| |b|)) - -(DEFUN |OUTFORM;over;3$;92| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'OVER |a| |b|)) - -(DEFUN |OUTFORM;slash;3$;93| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'SLASH |a| |b|)) - -(DEFUN |OUTFORM;assign;3$;94| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST '%LET |a| |b|)) - -(DEFUN |OUTFORM;label;3$;95| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'EQUATNUM |a| |b|)) - -(DEFUN |OUTFORM;rarrow;3$;96| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'RARROW |a| |b|)) - -(DEFUN |OUTFORM;differentiate;$Nni$;97| (|a| |nn| $) - (COND - ((ZEROP |nn|) |a|) - ((< |nn| 4) (|OUTFORM;prime;$Nni$;86| |a| |nn| $)) - (T (LET* ((|r| (SPADCALL - (|check-subtype| (PLUSP |nn|) - '(|PositiveInteger|) |nn|) - (|shellEntry| $ 137))) - (|s| (SPADCALL |r| (|shellEntry| $ 138)))) - (|OUTFORM;super;3$;43| |a| (LIST 'PAREN |s|) $))))) - -(DEFUN |OUTFORM;sum;2$;98| (|a| $) - (LIST 'SIGMA (|OUTFORM;empty;$;73| $) |a|)) - -(DEFUN |OUTFORM;sum;3$;99| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'SIGMA |b| |a|)) - -(DEFUN |OUTFORM;sum;4$;100| (|a| |b| |c| $) - (DECLARE (IGNORE $)) - (LIST 'SIGMA2 |b| |c| |a|)) - -(DEFUN |OUTFORM;prod;2$;101| (|a| $) - (LIST 'PI (|OUTFORM;empty;$;73| $) |a|)) - -(DEFUN |OUTFORM;prod;3$;102| (|a| |b| $) - (DECLARE (IGNORE $)) - (LIST 'PI |b| |a|)) - -(DEFUN |OUTFORM;prod;4$;103| (|a| |b| |c| $) - (DECLARE (IGNORE $)) - (LIST 'PI2 |b| |c| |a|)) - -(DEFUN |OUTFORM;int;2$;104| (|a| $) - (LIST 'INTSIGN (|OUTFORM;empty;$;73| $) (|OUTFORM;empty;$;73| $) |a|)) - -(DEFUN |OUTFORM;int;3$;105| (|a| |b| $) - (LIST 'INTSIGN |b| (|OUTFORM;empty;$;73| $) |a|)) - -(DEFUN |OUTFORM;int;4$;106| (|a| |b| |c| $) - (DECLARE (IGNORE $)) - (LIST 'INTSIGN |b| |c| |a|)) - -(DEFUN |OutputForm| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((#0=#:G1530 (HGET |$ConstructorCache| '|OutputForm|))) - (COND - (#0# (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|OutputForm| - (LIST (CONS NIL - (CONS 1 (|OutputForm;|)))))) - (SETQ #0# T)) - (COND ((NOT #0#) (HREM |$ConstructorCache| '|OutputForm|)))))))) - -(DEFUN |OutputForm;| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((|dv$| '(|OutputForm|)) ($ (|newShell| 150)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|haddProp| |$ConstructorCache| '|OutputForm| NIL (CONS 1 $)) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) "~G") - $)) - -(MAKEPROP '|OutputForm| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL '|format| (|String|) - |OUTFORM;doubleFloatFormat;2S;1| (|Void|) - |OUTFORM;print;$V;6| (|Boolean|) (0 . |empty?|) - |OUTFORM;empty;$;73| |OUTFORM;message;S$;7| - |OUTFORM;messagePrint;SV;8| |OUTFORM;=;2$B;9| - |OUTFORM;=;3$;10| (|OutputForm|) |OUTFORM;coerce;2$;11| - (|Integer|) |OUTFORM;outputForm;I$;12| (|Symbol|) - |OUTFORM;outputForm;S$;13| (|DoubleFloat|) - |OUTFORM;outputForm;Df$;14| (|Character|) (5 . |quote|) - (9 . |concat|) (15 . |concat|) |OUTFORM;outputForm;S$;15| - |OUTFORM;width;$I;16| |OUTFORM;height;$I;17| - |OUTFORM;subHeight;$I;18| |OUTFORM;superHeight;$I;19| - |OUTFORM;height;I;20| |OUTFORM;width;I;21| (21 . -) - (27 . |quo|) |OUTFORM;hspace;I$;29| - |OUTFORM;hconcat;3$;48| |OUTFORM;center;$I$;22| - |OUTFORM;left;$I$;23| |OUTFORM;right;$I$;24| - |OUTFORM;center;2$;25| |OUTFORM;left;2$;26| - |OUTFORM;right;2$;27| (|NonNegativeInteger|) (33 . |Zero|) - (37 . |Zero|) (41 . <=) (47 . |One|) (51 . |One|) - |OUTFORM;vspace;I$;28| |OUTFORM;vconcat;3$;50| - |OUTFORM;rspace;2I$;30| (|List| $) (|List| 56) - |OUTFORM;matrix;L$;31| |OUTFORM;pile;L$;32| - |OUTFORM;commaSeparate;L$;33| - |OUTFORM;semicolonSeparate;L$;34| (|List| $$) - (55 . |reverse|) (60 . |append|) - |OUTFORM;blankSeparate;L$;35| |OUTFORM;brace;2$;36| - |OUTFORM;brace;L$;37| |OUTFORM;bracket;2$;38| - |OUTFORM;bracket;L$;39| |OUTFORM;paren;2$;40| - |OUTFORM;paren;L$;41| |OUTFORM;sub;3$;42| - |OUTFORM;super;3$;43| |OUTFORM;presub;3$;44| - |OUTFORM;presuper;3$;45| (66 . |null|) (71 . |rest|) - (76 . |first|) |OUTFORM;scripts;$L$;46| (81 . |#|) - (86 . |odd?|) |OUTFORM;supersub;$L$;47| - |OUTFORM;hconcat;L$;49| |OUTFORM;vconcat;L$;51| - |OUTFORM;~=;3$;52| |OUTFORM;<;3$;53| |OUTFORM;>;3$;54| - |OUTFORM;<=;3$;55| |OUTFORM;>=;3$;56| |OUTFORM;+;3$;57| - |OUTFORM;-;3$;58| |OUTFORM;-;2$;59| |OUTFORM;*;3$;60| - |OUTFORM;/;3$;61| |OUTFORM;**;3$;62| |OUTFORM;div;3$;63| - |OUTFORM;rem;3$;64| |OUTFORM;quo;3$;65| - |OUTFORM;exquo;3$;66| |OUTFORM;and;3$;67| - |OUTFORM;or;3$;68| |OUTFORM;not;2$;69| - |OUTFORM;SEGMENT;3$;70| |OUTFORM;SEGMENT;2$;71| - |OUTFORM;binomial;3$;72| (91 . |false|) (95 . |not|) - |OUTFORM;infix?;$B;74| |OUTFORM;elt;$L$;75| - |OUTFORM;prefix;$L$;76| |OUTFORM;infix;$L$;77| - |OUTFORM;infix;4$;78| |OUTFORM;postfix;3$;79| - |OUTFORM;string;2$;80| |OUTFORM;quote;2$;81| - |OUTFORM;overbar;2$;82| |OUTFORM;dot;2$;83| - |OUTFORM;prime;2$;84| (100 . |char|) (105 . |new|) - |OUTFORM;dot;$Nni$;85| |OUTFORM;prime;$Nni$;86| - |OUTFORM;overlabel;3$;87| |OUTFORM;box;2$;88| - |OUTFORM;zag;3$;89| |OUTFORM;root;2$;90| - |OUTFORM;root;3$;91| |OUTFORM;over;3$;92| - |OUTFORM;slash;3$;93| |OUTFORM;assign;3$;94| - |OUTFORM;label;3$;95| |OUTFORM;rarrow;3$;96| - (111 . |zero?|) (116 . <) (|PositiveInteger|) - (|NumberFormats|) (122 . |FormatRoman|) - (127 . |lowerCase|) |OUTFORM;differentiate;$Nni$;97| - |OUTFORM;sum;2$;98| |OUTFORM;sum;3$;99| - |OUTFORM;sum;4$;100| |OUTFORM;prod;2$;101| - |OUTFORM;prod;3$;102| |OUTFORM;prod;4$;103| - |OUTFORM;int;2$;104| |OUTFORM;int;3$;105| - |OUTFORM;int;4$;106| (|SingleInteger|)) - '#(~= 132 |zag| 144 |width| 150 |vspace| 159 |vconcat| 164 - |supersub| 175 |superHeight| 181 |super| 186 |sum| 192 - |subHeight| 210 |sub| 215 |string| 221 |slash| 226 - |semicolonSeparate| 232 |scripts| 237 |rspace| 243 |root| - 249 |right| 260 |rem| 271 |rarrow| 277 |quote| 283 |quo| - 288 |prod| 294 |print| 312 |prime| 317 |presuper| 328 - |presub| 334 |prefix| 340 |postfix| 346 |pile| 352 |paren| - 357 |overlabel| 367 |overbar| 373 |over| 378 |outputForm| - 384 |or| 404 |not| 410 |messagePrint| 415 |message| 420 - |matrix| 425 |left| 430 |latex| 441 |label| 446 |int| 452 - |infix?| 470 |infix| 475 |hspace| 488 |height| 493 - |hconcat| 502 |hash| 513 |exquo| 518 |empty| 524 |elt| 528 - |doubleFloatFormat| 534 |dot| 539 |div| 550 - |differentiate| 556 |commaSeparate| 562 |coerce| 567 - |center| 572 |bracket| 583 |brace| 593 |box| 603 - |blankSeparate| 608 |binomial| 613 |before?| 619 |assign| - 625 |and| 631 SEGMENT 637 >= 648 > 654 = 660 <= 672 < 678 - / 684 - 690 + 701 ** 707 * 713) - 'NIL - (CONS (|makeByteWordVec2| 1 '(0 0 0 0)) - (CONS '#(|SetCategory&| |BasicType&| NIL NIL) - (CONS '#((|SetCategory|) (|BasicType|) (|Type|) - (|CoercibleTo| 18)) - (|makeByteWordVec2| 149 - '(1 7 11 0 12 0 26 0 27 2 7 0 0 26 28 2 - 7 0 26 0 29 2 20 0 0 0 37 2 20 0 0 0 - 38 0 47 0 48 0 20 0 49 2 20 11 0 0 50 - 0 47 0 51 0 20 0 52 1 62 0 0 63 2 62 - 0 0 0 64 1 62 11 0 76 1 62 0 0 77 1 - 62 2 0 78 1 62 47 0 80 1 20 11 0 81 0 - 11 0 106 1 11 0 0 107 1 26 0 7 119 2 - 7 0 47 26 120 1 47 11 0 133 2 47 11 0 - 0 134 1 136 7 135 137 1 7 0 0 138 2 0 - 0 0 0 85 2 0 11 0 0 1 2 0 0 0 0 125 0 - 0 20 36 1 0 20 0 31 1 0 0 20 53 1 0 0 - 56 84 2 0 0 0 0 54 2 0 0 0 56 82 1 0 - 20 0 34 2 0 0 0 0 73 2 0 0 0 0 141 3 - 0 0 0 0 0 142 1 0 0 0 140 1 0 20 0 33 - 2 0 0 0 0 72 1 0 0 0 114 2 0 0 0 0 - 129 1 0 0 56 61 2 0 0 0 56 79 2 0 0 - 20 20 55 2 0 0 0 0 127 1 0 0 0 126 1 - 0 0 0 46 2 0 0 0 20 43 2 0 0 0 0 97 2 - 0 0 0 0 132 1 0 0 0 115 2 0 0 0 0 98 - 3 0 0 0 0 0 145 1 0 0 0 143 2 0 0 0 0 - 144 1 0 9 0 10 1 0 0 0 118 2 0 0 0 47 - 122 2 0 0 0 0 75 2 0 0 0 0 74 2 0 0 0 - 56 110 2 0 0 0 0 113 1 0 0 56 59 1 0 - 0 56 71 1 0 0 0 70 2 0 0 0 0 123 1 0 - 0 0 116 2 0 0 0 0 128 1 0 0 7 30 1 0 - 0 24 25 1 0 0 20 21 1 0 0 22 23 2 0 0 - 0 0 101 1 0 0 0 102 1 0 9 7 15 1 0 0 - 7 14 1 0 0 57 58 1 0 0 0 45 2 0 0 0 - 20 42 1 0 7 0 1 2 0 0 0 0 131 3 0 0 0 - 0 0 148 2 0 0 0 0 147 1 0 0 0 146 1 0 - 11 0 108 3 0 0 0 0 0 112 2 0 0 0 56 - 111 1 0 0 20 39 0 0 20 35 1 0 20 0 32 - 1 0 0 56 83 2 0 0 0 0 40 1 0 149 0 1 - 2 0 0 0 0 99 0 0 0 13 2 0 0 0 56 109 - 1 0 7 7 8 1 0 0 0 117 2 0 0 0 47 121 - 2 0 0 0 0 96 2 0 0 0 47 139 1 0 0 56 - 60 1 0 18 0 19 1 0 0 0 44 2 0 0 0 20 - 41 1 0 0 0 68 1 0 0 56 69 1 0 0 56 67 - 1 0 0 0 66 1 0 0 0 124 1 0 0 56 65 2 - 0 0 0 0 105 2 0 11 0 0 1 2 0 0 0 0 - 130 2 0 0 0 0 100 1 0 0 0 104 2 0 0 0 - 0 103 2 0 0 0 0 89 2 0 0 0 0 87 2 0 0 - 0 0 17 2 0 11 0 0 16 2 0 0 0 0 88 2 0 - 0 0 0 86 2 0 0 0 0 94 1 0 0 0 92 2 0 - 0 0 0 91 2 0 0 0 0 90 2 0 0 0 0 95 2 - 0 0 0 0 93))))) - '|lookupComplete|)) - -(MAKEPROP '|OutputForm| 'NILADIC T) diff --git a/src/algebra/strap/PI.lsp b/src/algebra/strap/PI.lsp deleted file mode 100644 index 109f6a2a..00000000 --- a/src/algebra/strap/PI.lsp +++ /dev/null @@ -1,59 +0,0 @@ - -(/VERSIONCHECK 2) - -(|noteSubDomainInfo| '|PositiveInteger| '(|NonNegativeInteger|) - '(|%ilt| 0 |#1|)) - -(DEFUN |PositiveInteger| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((#0=#:G1376 (HGET |$ConstructorCache| '|PositiveInteger|))) - (COND - (#0# (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|PositiveInteger| - (LIST (CONS NIL - (CONS 1 (|PositiveInteger;|)))))) - (SETQ #0# T)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|PositiveInteger|)))))))) - -(DEFUN |PositiveInteger;| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((|dv$| '(|PositiveInteger|)) ($ (|newShell| 16)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|haddProp| |$ConstructorCache| '|PositiveInteger| NIL (CONS 1 $)) - (|stuffDomainSlots| $) - $)) - -(MAKEPROP '|PositiveInteger| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL (|NonNegativeInteger|) (0 . |Zero|) - (|Integer|) (4 . |Zero|) (|Boolean|) (8 . >) - (|PositiveInteger|) (|Union| $ '"failed") (|String|) - (|OutputForm|) (|SingleInteger|)) - '#(~= 14 |sample| 20 |recip| 24 |one?| 29 |min| 34 |max| 40 - |latex| 46 |hash| 51 |gcd| 56 |coerce| 62 |before?| 67 - |One| 73 >= 77 > 83 = 89 <= 95 < 101 + 107 ** 113 * 125) - '(((|commutative| "*") . 0)) - (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0 0 0 0 0)) - (CONS '#(NIL |Monoid&| NIL |SemiGroup&| - |AbelianSemiGroup&| |SetCategory&| - |OrderedType&| |BasicType&| NIL NIL) - (CONS '#((|OrderedAbelianSemiGroup|) (|Monoid|) - (|OrderedSet|) (|SemiGroup|) - (|AbelianSemiGroup|) (|SetCategory|) - (|OrderedType|) (|BasicType|) (|Type|) - (|CoercibleTo| 14)) - (|makeByteWordVec2| 15 - '(0 5 0 6 0 7 0 8 2 5 9 0 0 10 2 0 9 0 - 0 1 0 0 0 1 1 0 12 0 1 1 0 9 0 1 2 0 - 0 0 0 1 2 0 0 0 0 1 1 0 13 0 1 1 0 15 - 0 1 2 0 0 0 0 1 1 0 14 0 1 2 0 9 0 0 - 1 0 0 0 1 2 0 9 0 0 1 2 0 9 0 0 1 2 0 - 9 0 0 1 2 0 9 0 0 1 2 0 9 0 0 1 2 0 0 - 0 0 1 2 0 0 0 11 1 2 0 0 0 5 1 2 0 0 - 0 0 1 2 0 0 11 0 1))))) - '|lookupComplete|)) - -(MAKEPROP '|PositiveInteger| 'NILADIC T) diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp deleted file mode 100644 index faaf12c9..00000000 --- a/src/algebra/strap/POLYCAT-.lsp +++ /dev/null @@ -1,1420 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|) - |POLYCAT-;eval;SLS;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|) - |POLYCAT-;monomials;SL;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |POLYCAT-;isPlus;SU;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |POLYCAT-;isTimes;SU;4|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |POLYCAT-;isExpt;SU;5|)) - -(DECLAIM (FTYPE (FUNCTION - (|%Thing| |%Thing| (|%IntegerSection| 0) |%Shell|) - |%Thing|) - |POLYCAT-;coefficient;SVarSetNniS;6|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%List| |%Shell|) |%Thing|) - |POLYCAT-;coefficient;SLLS;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%List| |%Shell|) |%Thing|) - |POLYCAT-;monomial;SLLS;8|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |POLYCAT-;retract;SVarSet;9|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |POLYCAT-;retractIfCan;SU;10|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |POLYCAT-;mkPrim|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|) - |POLYCAT-;primitiveMonomials;SL;12|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0)) - |POLYCAT-;totalDegree;SNni;13|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) - (|%IntegerSection| 0)) - |POLYCAT-;totalDegree;SLNni;14|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |POLYCAT-;resultant;2SVarSetS;15|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |POLYCAT-;discriminant;SVarSetS;16|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%List|) - |POLYCAT-;allMonoms|)) - -(DECLAIM (FTYPE (FUNCTION - (|%Thing| |%List| (|%IntegerSection| 0) |%Shell|) - (|%Vector| *)) - |POLYCAT-;P2R|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%List| |%Shell|) |%Thing|) - |POLYCAT-;eq2R|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |POLYCAT-;reducedSystem;MM;20|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%Vector| *) |%Shell|) |%Pair|) - |POLYCAT-;reducedSystem;MVR;21|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |POLYCAT-;gcdPolynomial;3Sup;22|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%Pair|) - |POLYCAT-;solveLinearPolynomialEquation;LSupU;23|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |POLYCAT-;factorPolynomial;SupF;24|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |POLYCAT-;factorSquareFreePolynomial;SupF;25|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |POLYCAT-;factor;SF;26|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |POLYCAT-;conditionP;MU;27|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |POLYCAT-;charthRoot;SU;28|)) - -(DECLAIM (FTYPE (FUNCTION - (|%Thing| |%List| (|%IntegerSection| 0) |%Shell|) - |%Pair|) - |POLYCAT-;charthRootlv|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Pair|) - |POLYCAT-;monicDivide;2SVarSetR;30|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |POLYCAT-;squareFree;SF;31|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |POLYCAT-;squareFree;SF;32|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |POLYCAT-;squareFree;SF;33|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |POLYCAT-;squareFreePart;2S;34|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |POLYCAT-;content;SVarSetS;35|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |POLYCAT-;primitivePart;2S;36|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |POLYCAT-;primitivePart;SVarSetS;37|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |POLYCAT-;before?;2SB;38|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |POLYCAT-;patternMatch;SP2Pmr;39|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |POLYCAT-;patternMatch;SP2Pmr;40|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |POLYCAT-;convert;SP;41|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |POLYCAT-;convert;SP;42|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |POLYCAT-;convert;SIf;43|)) - -(DEFUN |POLYCAT-;eval;SLS;1| (|p| |l| $) - (PROG (|lvar|) - (RETURN - (COND - ((NULL |l|) |p|) - (T (SEQ (LET ((#0=#:G1666 |l|)) - (LOOP - (COND - ((ATOM #0#) (RETURN NIL)) - (T (LET ((|e| (CAR #0#))) - (COND - ((EQL (CAR - (SPADCALL - (SPADCALL |e| (|shellEntry| $ 14)) - (|shellEntry| $ 16))) - 1) - (RETURN - (|error| "cannot find a variable to evaluate"))))))) - (SETQ #0# (CDR #0#)))) - (LETT |lvar| - (LET ((#1=#:G1668 |l|) (#2=#:G1667 NIL)) - (LOOP - (COND - ((ATOM #1#) (RETURN (NREVERSE #2#))) - (T (LET ((|e| (CAR #1#))) - (SETQ #2# - (CONS - (SPADCALL - (SPADCALL |e| - (|shellEntry| $ 14)) - (|shellEntry| $ 17)) - #2#))))) - (SETQ #1# (CDR #1#)))) - |POLYCAT-;eval;SLS;1|) - (EXIT (SPADCALL |p| |lvar| - (LET ((#3=#:G1670 |l|) (#4=#:G1669 NIL)) - (LOOP - (COND - ((ATOM #3#) (RETURN (NREVERSE #4#))) - (T (LET ((|e| (CAR #3#))) - (SETQ #4# - (CONS - (SPADCALL |e| - (|shellEntry| $ 18)) - #4#))))) - (SETQ #3# (CDR #3#)))) - (|shellEntry| $ 21))))))))) - -(DEFUN |POLYCAT-;monomials;SL;2| (|p| $) - (LET ((|ml| NIL)) - (SEQ (LOOP - (COND - ((NOT (SPADCALL |p| (|spadConstant| $ 27) - (|shellEntry| $ 29))) - (RETURN NIL)) - (T (SEQ (SETQ |ml| - (CONS (SPADCALL |p| (|shellEntry| $ 30)) - |ml|)) - (EXIT (SETQ |p| - (SPADCALL |p| (|shellEntry| $ 32)))))))) - (EXIT (REVERSE |ml|))))) - -(DEFUN |POLYCAT-;isPlus;SU;3| (|p| $) - (PROG (|l|) - (RETURN - (COND - ((NULL (CDR (LETT |l| (SPADCALL |p| (|shellEntry| $ 35)) - |POLYCAT-;isPlus;SU;3|))) - (CONS 1 "failed")) - (T (CONS 0 |l|)))))) - -(DEFUN |POLYCAT-;isTimes;SU;4| (|p| $) - (PROG (|lv| |l| |r|) - (RETURN - (COND - ((OR (NULL (LETT |lv| (SPADCALL |p| (|shellEntry| $ 40)) - |POLYCAT-;isTimes;SU;4|)) - (NOT (SPADCALL |p| (|shellEntry| $ 42)))) - (CONS 1 "failed")) - (T (SEQ (LETT |l| - (LET ((#0=#:G1672 |lv|) (#1=#:G1671 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|v| (CAR #0#))) - (SETQ #1# - (CONS - (SPADCALL (|spadConstant| $ 43) - |v| - (SPADCALL |p| |v| - (|shellEntry| $ 46)) - (|shellEntry| $ 47)) - #1#))))) - (SETQ #0# (CDR #0#)))) - |POLYCAT-;isTimes;SU;4|) - (EXIT (COND - ((SPADCALL - (LETT |r| - (SPADCALL |p| (|shellEntry| $ 48)) - |POLYCAT-;isTimes;SU;4|) - (|shellEntry| $ 49)) - (COND - ((NULL (CDR |lv|)) (CONS 1 "failed")) - (T (CONS 0 |l|)))) - (T (CONS 0 - (CONS (SPADCALL |r| - (|shellEntry| $ 51)) - |l|))))))))))) - -(DEFUN |POLYCAT-;isExpt;SU;5| (|p| $) - (PROG (|d|) - (RETURN - (LET ((|u| (SPADCALL |p| (|shellEntry| $ 53)))) - (COND - ((OR (EQL (CAR |u|) 1) - (NOT (SPADCALL |p| - (SPADCALL (|spadConstant| $ 43) (CDR |u|) - (LETT |d| - (SPADCALL |p| (CDR |u|) - (|shellEntry| $ 46)) - |POLYCAT-;isExpt;SU;5|) - (|shellEntry| $ 47)) - (|shellEntry| $ 54)))) - (CONS 1 "failed")) - (T (CONS 0 (CONS (CDR |u|) |d|)))))))) - -(DEFUN |POLYCAT-;coefficient;SVarSetNniS;6| (|p| |v| |n| $) - (SPADCALL (SPADCALL |p| |v| (|shellEntry| $ 59)) |n| - (|shellEntry| $ 61))) - -(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|) (|shellEntry| $ 59)) - (|SPADfirst| |ln|) (|shellEntry| $ 61)) - (CDR |lv|) (CDR |ln|) (|shellEntry| $ 68))))) - -(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|) - (|shellEntry| $ 47)) - (CDR |lv|) (CDR |ln|) (|shellEntry| $ 70))))) - -(DEFUN |POLYCAT-;retract;SVarSet;9| (|p| $) - (LET ((|q| (LET ((#0=#:G1453 (SPADCALL |p| (|shellEntry| $ 53)))) - (|check-union| (ZEROP (CAR #0#)) (SVREF $ 9) #0#) - (CDR #0#)))) - (COND - ((SPADCALL (SPADCALL |q| (|shellEntry| $ 72)) |p| - (|shellEntry| $ 54)) - |q|) - (T (|error| "Polynomial is not a single variable"))))) - -(DEFUN |POLYCAT-;retractIfCan;SU;10| (|p| $) - (PROG (|q| #0=#:G1461) - (RETURN - (SEQ (EXIT (SEQ (SEQ (LETT |q| (SPADCALL |p| (|shellEntry| $ 53)) - |POLYCAT-;retractIfCan;SU;10|) - (EXIT (COND - ((AND (ZEROP (CAR |q|)) - (SPADCALL - (SPADCALL (CDR |q|) - (|shellEntry| $ 72)) - |p| (|shellEntry| $ 54))) - (PROGN - (LETT #0# |q| - |POLYCAT-;retractIfCan;SU;10|) - (GO #0#)))))) - (EXIT (CONS 1 "failed")))) - #0# (EXIT #0#))))) - -(DEFUN |POLYCAT-;mkPrim| (|p| $) - (SPADCALL (|spadConstant| $ 44) (SPADCALL |p| (|shellEntry| $ 75)) - (|shellEntry| $ 76))) - -(DEFUN |POLYCAT-;primitiveMonomials;SL;12| (|p| $) - (LET ((#0=#:G1674 (SPADCALL |p| (|shellEntry| $ 35))) - (#1=#:G1673 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|q| (CAR #0#))) - (SETQ #1# (CONS (|POLYCAT-;mkPrim| |q| $) #1#))))) - (SETQ #0# (CDR #0#))))) - -(DEFUN |POLYCAT-;totalDegree;SNni;13| (|p| $) - (COND - ((SPADCALL |p| (|shellEntry| $ 78)) 0) - (T (LET ((|u| (SPADCALL |p| - (LET ((#0=#:G1467 - (SPADCALL |p| (|shellEntry| $ 53)))) - (|check-union| (ZEROP (CAR #0#)) (SVREF $ 9) - #0#) - (CDR #0#)) - (|shellEntry| $ 59))) - (|d| 0)) - (SEQ (LOOP - (COND - ((NOT (SPADCALL |u| (|spadConstant| $ 80) - (|shellEntry| $ 81))) - (RETURN NIL)) - (T (SEQ (SETQ |d| - (MAX |d| - (+ - (SPADCALL |u| - (|shellEntry| $ 82)) - (SPADCALL - (SPADCALL |u| - (|shellEntry| $ 83)) - (|shellEntry| $ 84))))) - (EXIT (SETQ |u| - (SPADCALL |u| - (|shellEntry| $ 87)))))))) - (EXIT |d|)))))) - -(DEFUN |POLYCAT-;totalDegree;SLNni;14| (|p| |lv| $) - (PROG (|v| |u| |d| |w|) - (RETURN - (COND - ((SPADCALL |p| (|shellEntry| $ 78)) 0) - (T (SEQ (LETT |u| - (SPADCALL |p| - (LETT |v| - (LET ((#0=#:G1475 - (SPADCALL |p| - (|shellEntry| $ 53)))) - (|check-union| (ZEROP (CAR #0#)) - (SVREF $ 9) #0#) - (CDR #0#)) - |POLYCAT-;totalDegree;SLNni;14|) - (|shellEntry| $ 59)) - |POLYCAT-;totalDegree;SLNni;14|) - (LETT |d| 0 |POLYCAT-;totalDegree;SLNni;14|) - (LETT |w| 0 |POLYCAT-;totalDegree;SLNni;14|) - (COND - ((SPADCALL |v| |lv| (|shellEntry| $ 89)) - (SETQ |w| 1))) - (LOOP - (COND - ((NOT (SPADCALL |u| (|spadConstant| $ 80) - (|shellEntry| $ 81))) - (RETURN NIL)) - (T (SEQ (SETQ |d| - (MAX |d| - (+ - (* |w| - (SPADCALL |u| - (|shellEntry| $ 82))) - (SPADCALL - (SPADCALL |u| - (|shellEntry| $ 83)) - |lv| (|shellEntry| $ 92))))) - (EXIT (SETQ |u| - (SPADCALL |u| - (|shellEntry| $ 87)))))))) - (EXIT |d|))))))) - -(DEFUN |POLYCAT-;resultant;2SVarSetS;15| (|p1| |p2| |mvar| $) - (SPADCALL (SPADCALL |p1| |mvar| (|shellEntry| $ 59)) - (SPADCALL |p2| |mvar| (|shellEntry| $ 59)) (|shellEntry| $ 94))) - -(DEFUN |POLYCAT-;discriminant;SVarSetS;16| (|p| |var| $) - (SPADCALL (SPADCALL |p| |var| (|shellEntry| $ 59)) - (|shellEntry| $ 96))) - -(DEFUN |POLYCAT-;allMonoms| (|l| $) - (SPADCALL - (SPADCALL - (LET ((#0=#:G1676 |l|) (#1=#:G1675 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|p| (CAR #0#))) - (SETQ #1# - (CONS (SPADCALL |p| (|shellEntry| $ 98)) - #1#))))) - (SETQ #0# (CDR #0#)))) - (|shellEntry| $ 99)) - (|shellEntry| $ 100))) - -(DEFUN |POLYCAT-;P2R| (|p| |b| |n| $) - (LET ((|w| (SPADCALL |n| (|spadConstant| $ 28) (|shellEntry| $ 102)))) - (SEQ (LET ((|i| (SPADCALL |w| (|shellEntry| $ 104))) - (#0=#:G1677 (|sizeOfSimpleArray| |w|)) (#1=#:G1678 |b|)) - (LOOP - (COND - ((OR (> |i| #0#) (ATOM #1#)) (RETURN NIL)) - (T (LET ((|bj| (CAR #1#))) - (SPADCALL |w| |i| - (SPADCALL |p| |bj| (|shellEntry| $ 106)) - (|shellEntry| $ 107))))) - (SETQ |i| (+ |i| 1)) - (SETQ #1# (CDR #1#)))) - (EXIT |w|)))) - -(DEFUN |POLYCAT-;eq2R| (|l| |b| $) - (SPADCALL - (LET ((#0=#:G1682 |b|) (#1=#:G1679 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|bj| (CAR #0#))) - (SETQ #1# - (CONS (LET ((#2=#:G1681 |l|) (#3=#:G1680 NIL)) - (LOOP - (COND - ((ATOM #2#) (RETURN (NREVERSE #3#))) - (T - (LET ((|p| (CAR #2#))) - (SETQ #3# - (CONS - (SPADCALL |p| |bj| - (|shellEntry| $ 106)) - #3#))))) - (SETQ #2# (CDR #2#)))) - #1#))))) - (SETQ #0# (CDR #0#)))) - (|shellEntry| $ 111))) - -(DEFUN |POLYCAT-;reducedSystem;MM;20| (|m| $) - (LET* ((|l| (SPADCALL |m| (|shellEntry| $ 114))) - (|b| (SPADCALL - (SPADCALL - (LET ((#0=#:G1684 |l|) (#1=#:G1683 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|r| (CAR #0#))) - (SETQ #1# - (CONS - (|POLYCAT-;allMonoms| |r| $) - #1#))))) - (SETQ #0# (CDR #0#)))) - (|shellEntry| $ 99)) - (|shellEntry| $ 100))) - (|d| (LET ((#2=#:G1686 |b|) (#3=#:G1685 NIL)) - (LOOP - (COND - ((ATOM #2#) (RETURN (NREVERSE #3#))) - (T (LET ((|bj| (CAR #2#))) - (SETQ #3# - (CONS (SPADCALL |bj| - (|shellEntry| $ 75)) - #3#))))) - (SETQ #2# (CDR #2#))))) - (|mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $))) - (SEQ (SETQ |l| (CDR |l|)) - (LOOP - (COND - ((NOT (NOT (NULL |l|))) (RETURN NIL)) - (T (SEQ (SETQ |mm| - (SPADCALL |mm| - (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| - $) - (|shellEntry| $ 119))) - (EXIT (SETQ |l| (CDR |l|))))))) - (EXIT |mm|)))) - -(DEFUN |POLYCAT-;reducedSystem;MVR;21| (|m| |v| $) - (LET* ((|l| (SPADCALL |m| (|shellEntry| $ 114))) - (|r| (SPADCALL |v| (|shellEntry| $ 123))) - (|b| (SPADCALL - (SPADCALL (|POLYCAT-;allMonoms| |r| $) - (SPADCALL - (LET ((#0=#:G1688 |l|) (#1=#:G1687 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|s| (CAR #0#))) - (SETQ #1# - (CONS - (|POLYCAT-;allMonoms| |s| $) - #1#))))) - (SETQ #0# (CDR #0#)))) - (|shellEntry| $ 99)) - (|shellEntry| $ 124)) - (|shellEntry| $ 100))) - (|d| (LET ((#2=#:G1690 |b|) (#3=#:G1689 NIL)) - (LOOP - (COND - ((ATOM #2#) (RETURN (NREVERSE #3#))) - (T (LET ((|bj| (CAR #2#))) - (SETQ #3# - (CONS (SPADCALL |bj| - (|shellEntry| $ 75)) - #3#))))) - (SETQ #2# (CDR #2#))))) - (|n| (LIST-LENGTH |d|)) - (|mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $)) - (|w| (|POLYCAT-;P2R| (|SPADfirst| |r|) |d| |n| $))) - (SEQ (SETQ |l| (CDR |l|)) (SETQ |r| (CDR |r|)) - (LOOP - (COND - ((NOT (NOT (NULL |l|))) (RETURN NIL)) - (T (SEQ (SETQ |mm| - (SPADCALL |mm| - (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| - $) - (|shellEntry| $ 119))) - (SETQ |w| - (SPADCALL |w| - (|POLYCAT-;P2R| (|SPADfirst| |r|) |d| - |n| $) - (|shellEntry| $ 128))) - (SETQ |l| (CDR |l|)) (EXIT (SETQ |r| (CDR |r|))))))) - (EXIT (CONS |mm| |w|))))) - -(DEFUN |POLYCAT-;gcdPolynomial;3Sup;22| (|pp| |qq| $) - (SPADCALL |pp| |qq| (|shellEntry| $ 133))) - -(DEFUN |POLYCAT-;solveLinearPolynomialEquation;LSupU;23| (|lpp| |pp| $) - (SPADCALL |lpp| |pp| (|shellEntry| $ 138))) - -(DEFUN |POLYCAT-;factorPolynomial;SupF;24| (|pp| $) - (SPADCALL |pp| (|shellEntry| $ 143))) - -(DEFUN |POLYCAT-;factorSquareFreePolynomial;SupF;25| (|pp| $) - (SPADCALL |pp| (|shellEntry| $ 146))) - -(DEFUN |POLYCAT-;factor;SF;26| (|p| $) - (PROG (|ansR| |up| |ansSUP|) - (RETURN - (LET ((|v| (SPADCALL |p| (|shellEntry| $ 53)))) - (COND - ((EQL (CAR |v|) 1) - (SEQ (LETT |ansR| - (SPADCALL (SPADCALL |p| (|shellEntry| $ 48)) - (|shellEntry| $ 149)) - |POLYCAT-;factor;SF;26|) - (EXIT (SPADCALL - (SPADCALL - (SPADCALL |ansR| (|shellEntry| $ 151)) - (|shellEntry| $ 51)) - (LET ((#0=#:G1692 - (SPADCALL |ansR| - (|shellEntry| $ 155))) - (#1=#:G1691 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|w| (CAR #0#))) - (SETQ #1# - (CONS - (VECTOR (SVREF |w| 0) - (SPADCALL (SVREF |w| 1) - (|shellEntry| $ 51)) - (SVREF |w| 2)) - #1#))))) - (SETQ #0# (CDR #0#)))) - (|shellEntry| $ 159))))) - (T (SEQ (LETT |up| - (SPADCALL |p| (CDR |v|) (|shellEntry| $ 59)) - |POLYCAT-;factor;SF;26|) - (LETT |ansSUP| (SPADCALL |up| (|shellEntry| $ 143)) - |POLYCAT-;factor;SF;26|) - (EXIT (SPADCALL - (SPADCALL - (SPADCALL |ansSUP| - (|shellEntry| $ 160)) - (CDR |v|) (|shellEntry| $ 161)) - (LET ((#2=#:G1694 - (SPADCALL |ansSUP| - (|shellEntry| $ 164))) - (#3=#:G1693 NIL)) - (LOOP - (COND - ((ATOM #2#) (RETURN (NREVERSE #3#))) - (T (LET ((|ww| (CAR #2#))) - (SETQ #3# - (CONS - (VECTOR (SVREF |ww| 0) - (SPADCALL (SVREF |ww| 1) - (CDR |v|) - (|shellEntry| $ 161)) - (SVREF |ww| 2)) - #3#))))) - (SETQ #2# (CDR #2#)))) - (|shellEntry| $ 159)))))))))) - -(DEFUN |POLYCAT-;conditionP;MU;27| (|mat| $) - (PROG (|nd| |vars| |degs| |deg1| |mons| |redmons| |ans| |i|) - (RETURN - (LET* ((|ll| (SPADCALL (SPADCALL |mat| (|shellEntry| $ 166)) - (|shellEntry| $ 114))) - (|llR| (LET ((#0=#:G1706 (|SPADfirst| |ll|)) - (#1=#:G1705 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|z| (CAR #0#))) - (SETQ #1# (CONS NIL #1#))))) - (SETQ #0# (CDR #0#))))) - (|monslist| NIL) (|ch| (|spadConstant| $ 169))) - (SEQ (LET ((#2=#:G1695 |ll|)) - (LOOP - (COND - ((ATOM #2#) (RETURN NIL)) - (T (LET ((|l| (CAR #2#))) - (SEQ (LETT |mons| - (LET - ((#3=#:G1557 NIL) (#4=#:G1558 T) - (#5=#:G1696 |l|)) - (LOOP - (COND - ((ATOM #5#) - (RETURN - (COND - (#4# - (|IdentityError| - '|setUnion|)) - (T #3#)))) - (T - (LET ((|u| (CAR #5#))) - (LET - ((#6=#:G1556 - (SPADCALL |u| - (|shellEntry| $ 98)))) - (COND - (#4# (SETQ #3# #6#)) - (T - (SETQ #3# - (SPADCALL #3# #6# - (|shellEntry| $ 170))))) - (SETQ #4# NIL))))) - (SETQ #5# (CDR #5#)))) - |POLYCAT-;conditionP;MU;27|) - (LETT |redmons| NIL - |POLYCAT-;conditionP;MU;27|) - (LET ((#7=#:G1697 |mons|)) - (LOOP - (COND - ((ATOM #7#) (RETURN NIL)) - (T - (LET ((|m| (CAR #7#))) - (SEQ - (LETT |vars| - (SPADCALL |m| - (|shellEntry| $ 40)) - |POLYCAT-;conditionP;MU;27|) - (LETT |degs| - (SPADCALL |m| |vars| - (|shellEntry| $ 171)) - |POLYCAT-;conditionP;MU;27|) - (LETT |deg1| - (LET - ((#8=#:G1699 |degs|) - (#9=#:G1698 NIL)) - (LOOP - (COND - ((ATOM #8#) - (RETURN (NREVERSE #9#))) - (T - (LET ((|d| (CAR #8#))) - (SETQ #9# - (CONS - (SEQ - (LETT |nd| - (SPADCALL |d| |ch| - (|shellEntry| $ - 173)) - |POLYCAT-;conditionP;MU;27|) - (EXIT - (COND - ((EQL (CAR |nd|) - 1) - (RETURN-FROM - |POLYCAT-;conditionP;MU;27| - (CONS 1 - "failed"))) - (T - (LET - ((#10=#:G1585 - (CDR |nd|))) - (|check-subtype| - (NOT - (MINUSP - #10#)) - '(|NonNegativeInteger|) - #10#)))))) - #9#))))) - (SETQ #8# (CDR #8#)))) - |POLYCAT-;conditionP;MU;27|) - (SETQ |redmons| - (CONS - (SPADCALL - (|spadConstant| $ 43) |vars| - |deg1| (|shellEntry| $ 70)) - |redmons|)) - (EXIT - (SETQ |llR| - (LET - ((#11=#:G1701 |l|) - (#12=#:G1702 |llR|) - (#13=#:G1700 NIL)) - (LOOP - (COND - ((OR (ATOM #11#) - (ATOM #12#)) - (RETURN - (NREVERSE #13#))) - (T - (LET - ((|u| (CAR #11#)) - (|v| (CAR #12#))) - (SETQ #13# - (CONS - (CONS - (SPADCALL - (SPADCALL |u| - |vars| |degs| - (|shellEntry| $ - 68)) - (|shellEntry| $ - 175)) - |v|) - #13#))))) - (SETQ #11# (CDR #11#)) - (SETQ #12# (CDR #12#)))))))))) - (SETQ #7# (CDR #7#)))) - (EXIT (SETQ |monslist| - (CONS |redmons| |monslist|))))))) - (SETQ #2# (CDR #2#)))) - (LETT |ans| - (SPADCALL - (SPADCALL (SPADCALL |llR| (|shellEntry| $ 111)) - (|shellEntry| $ 178)) - (|shellEntry| $ 180)) - |POLYCAT-;conditionP;MU;27|) - (EXIT (COND - ((EQL (CAR |ans|) 1) (CONS 1 "failed")) - (T (SEQ (LETT |i| 0 |POLYCAT-;conditionP;MU;27|) - (EXIT (CONS 0 - (LET - ((#14=#:G1587 - (|makeSimpleArray| - (|getVMType| - (|shellEntry| $ 6)) - (SIZE |monslist|)))) - (LET - ((#15=#:G1703 |monslist|) - (#16=#:G1586 0)) - (LOOP - (COND - ((ATOM #15#) (RETURN #14#)) - (T - (LET ((|mons| (CAR #15#))) - (|setSimpleArrayEntry| - #14# #16# - (LET - ((#17=#:G1579 NIL) - (#18=#:G1580 T) - (#19=#:G1704 |mons|)) - (LOOP - (COND - ((ATOM #19#) - (RETURN - (COND - (#18# - (|spadConstant| - $ 27)) - (T #17#)))) - (T - (LET - ((|m| - (CAR #19#))) - (LET - ((#20=#:G1578 - (SPADCALL - |m| - (SPADCALL - (SPADCALL - (CDR - |ans|) - (SETQ - |i| - (+ |i| - 1)) - (|shellEntry| - $ 181)) - (|shellEntry| - $ 51)) - (|shellEntry| - $ 182)))) - (COND - (#18# - (SETQ - #17# - #20#)) - (T - (SETQ - #17# - (SPADCALL - #17# - #20# - (|shellEntry| - $ 183))))) - (SETQ #18# - NIL))))) - (SETQ #19# - (CDR #19#)))))))) - (SETQ #15# (CDR #15#)) - (SETQ #16# (+ #16# 1)))))))))))))))) - -(DEFUN |POLYCAT-;charthRoot;SU;28| (|p| $) - (PROG (|ans| |ch|) - (RETURN - (LET ((|vars| (SPADCALL |p| (|shellEntry| $ 40)))) - (COND - ((NULL |vars|) - (SEQ (LETT |ans| - (SPADCALL (SPADCALL |p| (|shellEntry| $ 175)) - (|shellEntry| $ 185)) - |POLYCAT-;charthRoot;SU;28|) - (EXIT (COND - ((EQL (CAR |ans|) 1) (CONS 1 "failed")) - (T (CONS 0 - (SPADCALL (CDR |ans|) - (|shellEntry| $ 51)))))))) - (T (SEQ (LETT |ch| (|spadConstant| $ 169) - |POLYCAT-;charthRoot;SU;28|) - (EXIT (|POLYCAT-;charthRootlv| |p| |vars| |ch| $))))))))) - -(DEFUN |POLYCAT-;charthRootlv| (|p| |vars| |ch| $) - (PROG (|d| |ans| |dd| |cp| |ansx|) - (RETURN - (COND - ((NULL |vars|) - (LET ((|ans| (SPADCALL (SPADCALL |p| (|shellEntry| $ 175)) - (|shellEntry| $ 185)))) - (COND - ((EQL (CAR |ans|) 1) (CONS 1 "failed")) - (T (CONS 0 (SPADCALL (CDR |ans|) (|shellEntry| $ 51))))))) - (T (LET ((|v| (|SPADfirst| |vars|))) - (SEQ (SETQ |vars| (CDR |vars|)) - (LETT |d| (SPADCALL |p| |v| (|shellEntry| $ 46)) - |POLYCAT-;charthRootlv|) - (LETT |ans| (|spadConstant| $ 27) - |POLYCAT-;charthRootlv|) - (LOOP - (COND - ((NOT (PLUSP |d|)) (RETURN NIL)) - (T (SEQ (LETT |dd| - (SPADCALL |d| |ch| - (|shellEntry| $ 173)) - |POLYCAT-;charthRootlv|) - (EXIT (COND - ((EQL (CAR |dd|) 1) - (RETURN-FROM - |POLYCAT-;charthRootlv| - (CONS 1 "failed"))) - (T - (SEQ - (LETT |cp| - (SPADCALL |p| |v| |d| - (|shellEntry| $ 188)) - |POLYCAT-;charthRootlv|) - (SETQ |p| - (SPADCALL |p| - (SPADCALL |cp| |v| |d| - (|shellEntry| $ 47)) - (|shellEntry| $ 189))) - (LETT |ansx| - (|POLYCAT-;charthRootlv| |cp| - |vars| |ch| $) - |POLYCAT-;charthRootlv|) - (EXIT - (COND - ((EQL (CAR |ansx|) 1) - (RETURN-FROM - |POLYCAT-;charthRootlv| - (CONS 1 "failed"))) - (T - (SEQ - (SETQ |d| - (SPADCALL |p| |v| - (|shellEntry| $ 46))) - (EXIT - (SETQ |ans| - (SPADCALL |ans| - (SPADCALL (CDR |ansx|) - |v| - (LET - ((#0=#:G1615 - (CDR |dd|))) - (|check-subtype| - (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) - #0#)) - (|shellEntry| $ 47)) - (|shellEntry| $ 183)))))))))))))))) - (LETT |ansx| - (|POLYCAT-;charthRootlv| |p| |vars| |ch| $) - |POLYCAT-;charthRootlv|) - (EXIT (COND - ((EQL (CAR |ansx|) 1) - (RETURN-FROM |POLYCAT-;charthRootlv| - (CONS 1 "failed"))) - (T (RETURN-FROM |POLYCAT-;charthRootlv| - (CONS 0 - (SPADCALL |ans| (CDR |ansx|) - (|shellEntry| $ 183)))))))))))))) - -(DEFUN |POLYCAT-;monicDivide;2SVarSetR;30| (|p1| |p2| |mvar| $) - (LET ((|result| - (SPADCALL (SPADCALL |p1| |mvar| (|shellEntry| $ 59)) - (SPADCALL |p2| |mvar| (|shellEntry| $ 59)) - (|shellEntry| $ 191)))) - (CONS (SPADCALL (CAR |result|) |mvar| (|shellEntry| $ 161)) - (SPADCALL (CDR |result|) |mvar| (|shellEntry| $ 161))))) - -(DEFUN |POLYCAT-;squareFree;SF;31| (|p| $) - (SPADCALL |p| (|shellEntry| $ 194))) - -(DEFUN |POLYCAT-;squareFree;SF;32| (|p| $) - (SPADCALL |p| (|shellEntry| $ 197))) - -(DEFUN |POLYCAT-;squareFree;SF;33| (|p| $) - (SPADCALL |p| (|shellEntry| $ 197))) - -(DEFUN |POLYCAT-;squareFreePart;2S;34| (|p| $) - (PROG (|s|) - (RETURN - (SPADCALL - (SPADCALL - (LETT |s| (SPADCALL |p| (|shellEntry| $ 198)) - |POLYCAT-;squareFreePart;2S;34|) - (|shellEntry| $ 199)) - (LET ((#0=#:G1628 NIL) (#1=#:G1629 T) - (#2=#:G1707 (SPADCALL |s| (|shellEntry| $ 202)))) - (LOOP - (COND - ((ATOM #2#) - (RETURN (COND (#1# (|spadConstant| $ 43)) (T #0#)))) - (T (LET ((|f| (CAR #2#))) - (LET ((#3=#:G1627 (CAR |f|))) - (COND - (#1# (SETQ #0# #3#)) - (T (SETQ #0# - (SPADCALL #0# #3# - (|shellEntry| $ 182))))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#)))) - (|shellEntry| $ 182))))) - -(DEFUN |POLYCAT-;content;SVarSetS;35| (|p| |v| $) - (SPADCALL (SPADCALL |p| |v| (|shellEntry| $ 59)) - (|shellEntry| $ 204))) - -(DEFUN |POLYCAT-;primitivePart;2S;36| (|p| $) - (SVREF (SPADCALL - (LET ((#0=#:G1633 - (SPADCALL |p| - (SPADCALL |p| (|shellEntry| $ 206)) - (|shellEntry| $ 207)))) - (|check-union| (ZEROP (CAR #0#)) (SVREF $ 6) #0#) - (CDR #0#)) - (|shellEntry| $ 209)) - 1)) - -(DEFUN |POLYCAT-;primitivePart;SVarSetS;37| (|p| |v| $) - (SVREF (SPADCALL - (LET ((#0=#:G1639 - (SPADCALL |p| - (SPADCALL |p| |v| (|shellEntry| $ 211)) - (|shellEntry| $ 212)))) - (|check-union| (ZEROP (CAR #0#)) (SVREF $ 6) #0#) - (CDR #0#)) - (|shellEntry| $ 209)) - 1)) - -(DEFUN |POLYCAT-;before?;2SB;38| (|p| |q| $) - (LET ((|dp| (SPADCALL |p| (|shellEntry| $ 75))) - (|dq| (SPADCALL |q| (|shellEntry| $ 75)))) - (COND - ((SPADCALL |dp| |dq| (|shellEntry| $ 214)) - (SPADCALL (|spadConstant| $ 28) - (SPADCALL |q| (|shellEntry| $ 48)) (|shellEntry| $ 215))) - ((SPADCALL |dq| |dp| (|shellEntry| $ 214)) - (SPADCALL (SPADCALL |p| (|shellEntry| $ 48)) - (|spadConstant| $ 28) (|shellEntry| $ 215))) - (T (SPADCALL - (SPADCALL (SPADCALL |p| |q| (|shellEntry| $ 189)) - (|shellEntry| $ 48)) - (|spadConstant| $ 28) (|shellEntry| $ 215)))))) - -(DEFUN |POLYCAT-;patternMatch;SP2Pmr;39| (|p| |pat| |l| $) - (SPADCALL |p| |pat| |l| (|shellEntry| $ 220))) - -(DEFUN |POLYCAT-;patternMatch;SP2Pmr;40| (|p| |pat| |l| $) - (SPADCALL |p| |pat| |l| (|shellEntry| $ 227))) - -(DEFUN |POLYCAT-;convert;SP;41| (|x| $) - (SPADCALL (ELT $ 230) (ELT $ 231) |x| (|shellEntry| $ 235))) - -(DEFUN |POLYCAT-;convert;SP;42| (|x| $) - (SPADCALL (ELT $ 237) (ELT $ 238) |x| (|shellEntry| $ 242))) - -(DEFUN |POLYCAT-;convert;SIf;43| (|p| $) - (SPADCALL (ELT $ 245) (ELT $ 246) |p| (|shellEntry| $ 250))) - -(DEFUN |PolynomialCategory&| (|#1| |#2| |#3| |#4|) - (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) - (|dv$3| (|devaluate| |#3|)) (|dv$4| (|devaluate| |#4|)) - (|dv$| (LIST '|PolynomialCategory&| |dv$1| |dv$2| |dv$3| - |dv$4|)) - ($ (|newShell| 259)) - (|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|))))))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (SETF (|shellEntry| $ 7) |#2|) - (SETF (|shellEntry| $ 8) |#3|) - (SETF (|shellEntry| $ 9) |#4|) - (COND - ((|testBitVector| |pv$| 4) - (PROGN - (SETF (|shellEntry| $ 95) - (CONS (|dispatchFunction| - |POLYCAT-;resultant;2SVarSetS;15|) - $)) - (SETF (|shellEntry| $ 97) - (CONS (|dispatchFunction| - |POLYCAT-;discriminant;SVarSetS;16|) - $))))) - (COND - ((|HasCategory| |#2| '(|IntegralDomain|)) - (PROGN - (SETF (|shellEntry| $ 121) - (CONS (|dispatchFunction| - |POLYCAT-;reducedSystem;MM;20|) - $)) - (SETF (|shellEntry| $ 131) - (CONS (|dispatchFunction| - |POLYCAT-;reducedSystem;MVR;21|) - $))))) - (COND - ((|testBitVector| |pv$| 1) - (PROGN - (SETF (|shellEntry| $ 134) - (CONS (|dispatchFunction| - |POLYCAT-;gcdPolynomial;3Sup;22|) - $)) - (SETF (|shellEntry| $ 141) - (CONS (|dispatchFunction| - |POLYCAT-;solveLinearPolynomialEquation;LSupU;23|) - $)) - (SETF (|shellEntry| $ 145) - (CONS (|dispatchFunction| - |POLYCAT-;factorPolynomial;SupF;24|) - $)) - (SETF (|shellEntry| $ 147) - (CONS (|dispatchFunction| - |POLYCAT-;factorSquareFreePolynomial;SupF;25|) - $)) - (SETF (|shellEntry| $ 165) - (CONS (|dispatchFunction| |POLYCAT-;factor;SF;26|) $)) - (COND - ((|HasCategory| |#2| '(|CharacteristicNonZero|)) - (PROGN - (SETF (|shellEntry| $ 184) - (CONS (|dispatchFunction| - |POLYCAT-;conditionP;MU;27|) - $)))))))) - (COND - ((|HasCategory| |#2| '(|CharacteristicNonZero|)) - (PROGN - (SETF (|shellEntry| $ 186) - (CONS (|dispatchFunction| |POLYCAT-;charthRoot;SU;28|) - $))))) - (COND - ((|testBitVector| |pv$| 3) - (PROGN - (COND - ((|HasCategory| |#2| '(|EuclideanDomain|)) - (COND - ((|HasCategory| |#2| '(|CharacteristicZero|)) - (SETF (|shellEntry| $ 195) - (CONS (|dispatchFunction| - |POLYCAT-;squareFree;SF;31|) - $))) - (T (SETF (|shellEntry| $ 195) - (CONS (|dispatchFunction| - |POLYCAT-;squareFree;SF;32|) - $))))) - (T (SETF (|shellEntry| $ 195) - (CONS (|dispatchFunction| - |POLYCAT-;squareFree;SF;33|) - $)))) - (SETF (|shellEntry| $ 203) - (CONS (|dispatchFunction| - |POLYCAT-;squareFreePart;2S;34|) - $)) - (SETF (|shellEntry| $ 205) - (CONS (|dispatchFunction| - |POLYCAT-;content;SVarSetS;35|) - $)) - (SETF (|shellEntry| $ 210) - (CONS (|dispatchFunction| - |POLYCAT-;primitivePart;2S;36|) - $)) - (SETF (|shellEntry| $ 213) - (CONS (|dispatchFunction| - |POLYCAT-;primitivePart;SVarSetS;37|) - $))))) - (COND - ((AND (|testBitVector| |pv$| 8) (|testBitVector| |pv$| 7)) - (SETF (|shellEntry| $ 222) - (CONS (|dispatchFunction| - |POLYCAT-;patternMatch;SP2Pmr;39|) - $)))) - (COND - ((AND (|testBitVector| |pv$| 6) (|testBitVector| |pv$| 5)) - (SETF (|shellEntry| $ 229) - (CONS (|dispatchFunction| - |POLYCAT-;patternMatch;SP2Pmr;40|) - $)))) - (COND - ((AND (|testBitVector| |pv$| 12) (|testBitVector| |pv$| 11)) - (SETF (|shellEntry| $ 236) - (CONS (|dispatchFunction| |POLYCAT-;convert;SP;41|) $)))) - (COND - ((AND (|testBitVector| |pv$| 10) (|testBitVector| |pv$| 9)) - (SETF (|shellEntry| $ 243) - (CONS (|dispatchFunction| |POLYCAT-;convert;SP;42|) $)))) - (COND - ((AND (|testBitVector| |pv$| 14) (|testBitVector| |pv$| 13)) - (SETF (|shellEntry| $ 251) - (CONS (|dispatchFunction| |POLYCAT-;convert;SIf;43|) $)))) - $)) - -(MAKEPROP '|PolynomialCategory&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|local| |#3|) (|local| |#4|) (|Boolean|) (|Equation| 6) - (|List| 11) (0 . |empty?|) (5 . |lhs|) - (|Union| 9 '"failed") (10 . |retractIfCan|) - (15 . |retract|) (20 . |rhs|) (|List| 9) (|List| $) - (25 . |eval|) (|Equation| $) (|List| 22) - |POLYCAT-;eval;SLS;1| (|List| 6) (32 . |empty|) - (36 . |Zero|) (40 . |Zero|) (44 . ~=) - (50 . |leadingMonomial|) (55 . |concat|) (61 . |reductum|) - (66 . |reverse|) |POLYCAT-;monomials;SL;2| - (71 . |monomials|) (76 . |rest|) (81 . |empty?|) - (|Union| 20 '"failed") |POLYCAT-;isPlus;SU;3| - (86 . |variables|) (91 . |empty?|) (96 . |monomial?|) - (101 . |One|) (105 . |One|) (|NonNegativeInteger|) - (109 . |degree|) (115 . |monomial|) - (122 . |leadingCoefficient|) (127 . |one?|) (132 . |rest|) - (137 . |coerce|) |POLYCAT-;isTimes;SU;4| - (142 . |mainVariable|) (147 . =) - (|Record| (|:| |var| 9) (|:| |exponent| 45)) - (|Union| 55 '"failed") |POLYCAT-;isExpt;SU;5| - (|SparseUnivariatePolynomial| $) (153 . |univariate|) - (|SparseUnivariatePolynomial| 6) (159 . |coefficient|) - |POLYCAT-;coefficient;SVarSetNniS;6| (|List| 45) - (165 . |empty?|) (170 . |first|) (175 . |first|) - (180 . |rest|) (185 . |coefficient|) - |POLYCAT-;coefficient;SLLS;7| (192 . |monomial|) - |POLYCAT-;monomial;SLLS;8| (199 . |coerce|) - |POLYCAT-;retract;SVarSet;9| |POLYCAT-;retractIfCan;SU;10| - (204 . |degree|) (209 . |monomial|) - |POLYCAT-;primitiveMonomials;SL;12| (215 . |ground?|) - (220 . |Zero|) (224 . |Zero|) (228 . ~=) (234 . |degree|) - (239 . |leadingCoefficient|) (244 . |totalDegree|) - (249 . +) (255 . |max|) (261 . |reductum|) - |POLYCAT-;totalDegree;SNni;13| (266 . |member?|) - (272 . |One|) (276 . *) (282 . |totalDegree|) - |POLYCAT-;totalDegree;SLNni;14| (288 . |resultant|) - (294 . |resultant|) (301 . |discriminant|) - (306 . |discriminant|) (312 . |primitiveMonomials|) - (317 . |concat|) (322 . |removeDuplicates!|) (|Vector| 7) - (327 . |new|) (|Integer|) (333 . |minIndex|) - (338 . |maxIndex|) (343 . |coefficient|) - (349 . |qsetelt!|) (|List| 7) (|List| 108) (|Matrix| 7) - (356 . |matrix|) (|List| 25) (|Matrix| 6) - (361 . |listOfLists|) (366 . |first|) (371 . |rest|) - (376 . |empty?|) (381 . |not|) (386 . |vertConcat|) - (|Matrix| $) (392 . |reducedSystem|) (|Vector| 6) - (397 . |entries|) (402 . |concat|) (|List| 8) (408 . |#|) - (413 . |first|) (418 . |concat|) - (|Record| (|:| |mat| 110) (|:| |vec| 101)) (|Vector| $) - (424 . |reducedSystem|) - (|GeneralPolynomialGcdPackage| 8 9 7 6) - (430 . |gcdPolynomial|) (436 . |gcdPolynomial|) - (|List| 60) (|Union| 135 '"failed") - (|PolynomialFactorizationByRecursion| 7 8 9 6) - (442 . |solveLinearPolynomialEquationByRecursion|) - (|List| 58) (|Union| 139 '"failed") - (448 . |solveLinearPolynomialEquation|) (|Factored| 60) - (454 . |factorByRecursion|) (|Factored| 58) - (459 . |factorPolynomial|) - (464 . |factorSquareFreeByRecursion|) - (469 . |factorSquareFreePolynomial|) (|Factored| $) - (474 . |factor|) (|Factored| 7) (479 . |unit|) - (|Union| '"nil" '"sqfr" '"irred" '"prime") - (|Record| (|:| |flg| 152) (|:| |fctr| 7) (|:| |xpnt| 103)) - (|List| 153) (484 . |factorList|) - (|Record| (|:| |flg| 152) (|:| |fctr| 6) (|:| |xpnt| 103)) - (|List| 156) (|Factored| 6) (489 . |makeFR|) - (495 . |unit|) (500 . |multivariate|) - (|Record| (|:| |flg| 152) (|:| |fctr| 60) - (|:| |xpnt| 103)) - (|List| 162) (506 . |factorList|) (511 . |factor|) - (516 . |transpose|) (521 . |empty|) (525 . |empty|) - (529 . |characteristic|) (533 . |setUnion|) - (539 . |degree|) (|Union| $ '"failed") (545 . |exquo|) - (551 . |cons|) (557 . |ground|) (562 . |cons|) - (568 . |cons|) (574 . |transpose|) (|Union| 130 '"failed") - (579 . |conditionP|) (584 . |elt|) (590 . *) (596 . +) - (602 . |conditionP|) (607 . |charthRoot|) - (612 . |charthRoot|) (617 . >) (623 . |coefficient|) - (630 . -) - (|Record| (|:| |quotient| $) (|:| |remainder| $)) - (636 . |monicDivide|) |POLYCAT-;monicDivide;2SVarSetR;30| - (|MultivariateSquareFree| 8 9 7 6) (642 . |squareFree|) - (647 . |squareFree|) (|PolynomialSquareFree| 9 8 7 6) - (652 . |squareFree|) (657 . |squareFree|) (662 . |unit|) - (|Record| (|:| |factor| 6) (|:| |exponent| 103)) - (|List| 200) (667 . |factors|) (672 . |squareFreePart|) - (677 . |content|) (682 . |content|) (688 . |content|) - (693 . |exquo|) - (|Record| (|:| |unit| $) (|:| |canonical| $) - (|:| |associate| $)) - (699 . |unitNormal|) (704 . |primitivePart|) - (709 . |content|) (715 . |exquo|) (721 . |primitivePart|) - (727 . <) (733 . |before?|) |POLYCAT-;before?;2SB;38| - (|PatternMatchResult| 103 6) (|Pattern| 103) - (|PatternMatchPolynomialCategory| 103 8 9 7 6) - (739 . |patternMatch|) (|PatternMatchResult| 103 $) - (746 . |patternMatch|) (|Float|) - (|PatternMatchResult| 223 6) (|Pattern| 223) - (|PatternMatchPolynomialCategory| 223 8 9 7 6) - (753 . |patternMatch|) (|PatternMatchResult| 223 $) - (760 . |patternMatch|) (767 . |convert|) (772 . |convert|) - (|Mapping| 218 9) (|Mapping| 218 7) - (|PolynomialCategoryLifting| 8 9 7 6 218) (777 . |map|) - (784 . |convert|) (789 . |convert|) (794 . |convert|) - (|Mapping| 225 9) (|Mapping| 225 7) - (|PolynomialCategoryLifting| 8 9 7 6 225) (799 . |map|) - (806 . |convert|) (|InputForm|) (811 . |convert|) - (816 . |convert|) (|Mapping| 244 9) (|Mapping| 244 7) - (|PolynomialCategoryLifting| 8 9 7 6 244) (821 . |map|) - (828 . |convert|) (|Matrix| 103) (|Vector| 103) - (|Record| (|:| |mat| 252) (|:| |vec| 253)) - (|Union| 103 '"failed") (|Fraction| 103) - (|Union| 256 '"failed") (|Union| 7 '"failed")) - '#(|totalDegree| 833 |squareFreePart| 844 |squareFree| 849 - |solveLinearPolynomialEquation| 854 |retractIfCan| 860 - |retract| 865 |resultant| 870 |reducedSystem| 877 - |primitivePart| 888 |primitiveMonomials| 899 - |patternMatch| 904 |monomials| 918 |monomial| 923 - |monicDivide| 930 |isTimes| 937 |isPlus| 942 |isExpt| 947 - |gcdPolynomial| 952 |factorSquareFreePolynomial| 958 - |factorPolynomial| 963 |factor| 968 |eval| 973 - |discriminant| 979 |convert| 985 |content| 1000 - |conditionP| 1006 |coefficient| 1011 |charthRoot| 1025 - |before?| 1030) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 251 - '(1 12 10 0 13 1 11 6 0 14 1 6 15 0 16 - 1 6 9 0 17 1 11 6 0 18 3 6 0 0 19 20 - 21 0 25 0 26 0 6 0 27 0 7 0 28 2 6 10 - 0 0 29 1 6 0 0 30 2 25 0 6 0 31 1 6 0 - 0 32 1 25 0 0 33 1 6 20 0 35 1 25 0 0 - 36 1 25 10 0 37 1 6 19 0 40 1 19 10 0 - 41 1 6 10 0 42 0 6 0 43 0 7 0 44 2 6 - 45 0 9 46 3 6 0 0 9 45 47 1 6 7 0 48 - 1 7 10 0 49 1 19 0 0 50 1 6 0 7 51 1 - 6 15 0 53 2 6 10 0 0 54 2 6 58 0 9 59 - 2 60 6 0 45 61 1 63 10 0 64 1 19 9 0 - 65 1 63 45 0 66 1 63 0 0 67 3 6 0 0 - 19 63 68 3 6 0 0 19 63 70 1 6 0 9 72 - 1 6 8 0 75 2 6 0 7 8 76 1 6 10 0 78 0 - 45 0 79 0 60 0 80 2 60 10 0 0 81 1 60 - 45 0 82 1 60 6 0 83 1 6 45 0 84 2 45 - 0 0 0 85 2 45 0 0 0 86 1 60 0 0 87 2 - 19 10 9 0 89 0 45 0 90 2 45 0 45 0 91 - 2 6 45 0 19 92 2 60 6 0 0 94 3 0 0 0 - 0 9 95 1 60 6 0 96 2 0 0 0 9 97 1 6 - 20 0 98 1 25 0 20 99 1 25 0 0 100 2 - 101 0 45 7 102 1 101 103 0 104 1 101 - 103 0 105 2 6 7 0 8 106 3 101 7 0 103 - 7 107 1 110 0 109 111 1 113 112 0 114 - 1 112 25 0 115 1 112 0 0 116 1 112 10 - 0 117 1 10 0 0 118 2 110 0 0 0 119 1 - 0 110 120 121 1 122 25 0 123 2 25 0 0 - 0 124 1 125 45 0 126 1 25 6 0 127 2 - 101 0 0 0 128 2 0 129 120 130 131 2 - 132 60 60 60 133 2 0 58 58 58 134 2 - 137 136 135 60 138 2 0 140 139 58 141 - 1 137 142 60 143 1 0 144 58 145 1 137 - 142 60 146 1 0 144 58 147 1 7 148 0 - 149 1 150 7 0 151 1 150 154 0 155 2 - 158 0 6 157 159 1 142 60 0 160 2 6 0 - 58 9 161 1 142 163 0 164 1 0 148 0 - 165 1 113 0 0 166 0 108 0 167 0 112 0 - 168 0 6 45 169 2 25 0 0 0 170 2 6 63 - 0 19 171 2 103 172 0 0 173 2 25 0 6 0 - 174 1 6 7 0 175 2 108 0 7 0 176 2 112 - 0 25 0 177 1 110 0 0 178 1 7 179 120 - 180 2 101 7 0 103 181 2 6 0 0 0 182 2 - 6 0 0 0 183 1 0 179 120 184 1 7 172 0 - 185 1 0 172 0 186 2 45 10 0 0 187 3 6 - 0 0 9 45 188 2 6 0 0 0 189 2 60 190 0 - 0 191 1 193 158 6 194 1 0 148 0 195 1 - 196 158 6 197 1 6 148 0 198 1 158 6 0 - 199 1 158 201 0 202 1 0 0 0 203 1 60 - 6 0 204 2 0 0 0 9 205 1 6 7 0 206 2 6 - 172 0 7 207 1 6 208 0 209 1 0 0 0 210 - 2 6 0 0 9 211 2 6 172 0 0 212 2 0 0 0 - 9 213 2 8 10 0 0 214 2 7 10 0 0 215 3 - 219 217 6 218 217 220 3 0 221 0 218 - 221 222 3 226 224 6 225 224 227 3 0 - 228 0 225 228 229 1 9 218 0 230 1 7 - 218 0 231 3 234 218 232 233 6 235 1 0 - 218 0 236 1 9 225 0 237 1 7 225 0 238 - 3 241 225 239 240 6 242 1 0 225 0 243 - 1 9 244 0 245 1 7 244 0 246 3 249 244 - 247 248 6 250 1 0 244 0 251 2 0 45 0 - 19 93 1 0 45 0 88 1 0 0 0 203 1 0 148 - 0 195 2 0 140 139 58 141 1 0 15 0 74 - 1 0 9 0 73 3 0 0 0 0 9 95 2 0 129 120 - 130 131 1 0 110 120 121 2 0 0 0 9 213 - 1 0 0 0 210 1 0 20 0 77 3 0 228 0 225 - 228 229 3 0 221 0 218 221 222 1 0 20 - 0 34 3 0 0 0 19 63 71 3 0 190 0 0 9 - 192 1 0 38 0 52 1 0 38 0 39 1 0 56 0 - 57 2 0 58 58 58 134 1 0 144 58 147 1 - 0 144 58 145 1 0 148 0 165 2 0 0 0 23 - 24 2 0 0 0 9 97 1 0 218 0 236 1 0 244 - 0 251 1 0 225 0 243 2 0 0 0 9 205 1 0 - 179 120 184 3 0 0 0 9 45 62 3 0 0 0 - 19 63 69 1 0 172 0 186 2 0 10 0 0 - 216))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/POLYCAT.lsp b/src/algebra/strap/POLYCAT.lsp deleted file mode 100644 index 98b3c254..00000000 --- a/src/algebra/strap/POLYCAT.lsp +++ /dev/null @@ -1,212 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |PolynomialCategory;CAT| 'NIL) - -(DEFPARAMETER |PolynomialCategory;AL| 'NIL) - -(DEFUN |PolynomialCategory;| (|t#1| |t#2| |t#3|) - (LET ((#0=#:G1391 - (|sublisV| - (PAIR '(|t#1| |t#2| |t#3|) - (LIST (|devaluate| |t#1|) (|devaluate| |t#2|) - (|devaluate| |t#3|))) - (COND - (|PolynomialCategory;CAT|) - (T (SETQ |PolynomialCategory;CAT| - (|Join| (|PartialDifferentialRing| '|t#3|) - (|FiniteAbelianMonoidRing| '|t#1| - '|t#2|) - (|Evalable| '$) - (|InnerEvalable| '|t#3| '|t#1|) - (|InnerEvalable| '|t#3| '$) - (|RetractableTo| '|t#3|) - (|FullyLinearlyExplicitRingOver| - '|t#1|) - (|mkCategory| '|domain| - '(((|degree| - ((|NonNegativeInteger|) $ - |t#3|)) - T) - ((|degree| - ((|List| - (|NonNegativeInteger|)) - $ (|List| |t#3|))) - T) - ((|coefficient| - ($ $ |t#3| - (|NonNegativeInteger|))) - T) - ((|coefficient| - ($ $ (|List| |t#3|) - (|List| - (|NonNegativeInteger|)))) - T) - ((|monomials| ((|List| $) $)) T) - ((|univariate| - ((|SparseUnivariatePolynomial| - $) - $ |t#3|)) - T) - ((|univariate| - ((|SparseUnivariatePolynomial| - |t#1|) - $)) - T) - ((|mainVariable| - ((|Union| |t#3| "failed") $)) - T) - ((|minimumDegree| - ((|NonNegativeInteger|) $ - |t#3|)) - T) - ((|minimumDegree| - ((|List| - (|NonNegativeInteger|)) - $ (|List| |t#3|))) - T) - ((|monicDivide| - ((|Record| (|:| |quotient| $) - (|:| |remainder| $)) - $ $ |t#3|)) - T) - ((|monomial| - ($ $ |t#3| - (|NonNegativeInteger|))) - T) - ((|monomial| - ($ $ (|List| |t#3|) - (|List| - (|NonNegativeInteger|)))) - T) - ((|multivariate| - ($ - (|SparseUnivariatePolynomial| - |t#1|) - |t#3|)) - T) - ((|multivariate| - ($ - (|SparseUnivariatePolynomial| - $) - |t#3|)) - T) - ((|isPlus| - ((|Union| (|List| $) "failed") - $)) - T) - ((|isTimes| - ((|Union| (|List| $) "failed") - $)) - T) - ((|isExpt| - ((|Union| - (|Record| (|:| |var| |t#3|) - (|:| |exponent| - (|NonNegativeInteger|))) - "failed") - $)) - T) - ((|totalDegree| - ((|NonNegativeInteger|) $)) - T) - ((|totalDegree| - ((|NonNegativeInteger|) $ - (|List| |t#3|))) - T) - ((|variables| ((|List| |t#3|) $)) - T) - ((|primitiveMonomials| - ((|List| $) $)) - T) - ((|resultant| ($ $ $ |t#3|)) - (|has| |t#1| - (|CommutativeRing|))) - ((|discriminant| ($ $ |t#3|)) - (|has| |t#1| - (|CommutativeRing|))) - ((|content| ($ $ |t#3|)) - (|has| |t#1| (|GcdDomain|))) - ((|primitivePart| ($ $)) - (|has| |t#1| (|GcdDomain|))) - ((|primitivePart| ($ $ |t#3|)) - (|has| |t#1| (|GcdDomain|))) - ((|squareFree| - ((|Factored| $) $)) - (|has| |t#1| (|GcdDomain|))) - ((|squareFreePart| ($ $)) - (|has| |t#1| (|GcdDomain|)))) - '(((|ConvertibleTo| (|InputForm|)) - (AND - (|has| |t#3| - (|ConvertibleTo| - (|InputForm|))) - (|has| |t#1| - (|ConvertibleTo| - (|InputForm|))))) - ((|ConvertibleTo| - (|Pattern| (|Integer|))) - (AND - (|has| |t#3| - (|ConvertibleTo| - (|Pattern| (|Integer|)))) - (|has| |t#1| - (|ConvertibleTo| - (|Pattern| (|Integer|)))))) - ((|ConvertibleTo| - (|Pattern| (|Float|))) - (AND - (|has| |t#3| - (|ConvertibleTo| - (|Pattern| (|Float|)))) - (|has| |t#1| - (|ConvertibleTo| - (|Pattern| (|Float|)))))) - ((|PatternMatchable| (|Integer|)) - (AND - (|has| |t#3| - (|PatternMatchable| - (|Integer|))) - (|has| |t#1| - (|PatternMatchable| - (|Integer|))))) - ((|PatternMatchable| (|Float|)) - (AND - (|has| |t#3| - (|PatternMatchable| (|Float|))) - (|has| |t#1| - (|PatternMatchable| (|Float|))))) - ((|GcdDomain|) - (|has| |t#1| (|GcdDomain|))) - (|canonicalUnitNormal| - (|has| |t#1| - (ATTRIBUTE - |canonicalUnitNormal|))) - ((|PolynomialFactorizationExplicit|) - (|has| |t#1| - (|PolynomialFactorizationExplicit|)))) - '((|Factored| $) (|List| $) - (|List| |t#3|) - (|NonNegativeInteger|) - (|SparseUnivariatePolynomial| $) - (|SparseUnivariatePolynomial| - |t#1|) - (|List| (|NonNegativeInteger|))) - NIL)))))))) - (SETF (|shellEntry| #0# 0) - (LIST '|PolynomialCategory| (|devaluate| |t#1|) - (|devaluate| |t#2|) (|devaluate| |t#3|))) - #0#)) - -(DEFUN |PolynomialCategory| (&REST #0=#:G1394 &AUX #1=#:G1392) - (DSETQ #1# #0#) - (LET ((#2=#:G1393 - (|assoc| (|devaluateList| #1#) |PolynomialCategory;AL|))) - (COND - (#2# (CDR #2#)) - (T (PROGN - (SETQ #2# (APPLY #'|PolynomialCategory;| #1#)) - (SETQ |PolynomialCategory;AL| - (|cons5| (CONS (|devaluateList| #1#) #2#) - |PolynomialCategory;AL|)) - #2#))))) diff --git a/src/algebra/strap/QFCAT-.lsp b/src/algebra/strap/QFCAT-.lsp deleted file mode 100644 index 844c206c..00000000 --- a/src/algebra/strap/QFCAT-.lsp +++ /dev/null @@ -1,463 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |QFCAT-;numerator;2A;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |QFCAT-;denominator;2A;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |QFCAT-;init;A;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |QFCAT-;nextItem;AU;4|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |QFCAT-;map;M2A;5|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |QFCAT-;reducedSystem;MM;6|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 0)) - |QFCAT-;characteristic;Nni;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |QFCAT-;differentiate;AMA;8|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |QFCAT-;convert;AIf;9|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |QFCAT-;convert;AF;10|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%DoubleFloat|) - |QFCAT-;convert;ADf;11|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |QFCAT-;<;2AB;12|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |QFCAT-;<;2AB;13|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |QFCAT-;<;2AB;14|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |QFCAT-;fractionPart;2A;15|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |QFCAT-;coerce;SA;16|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |QFCAT-;retract;AS;17|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |QFCAT-;retractIfCan;AU;18|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |QFCAT-;convert;AP;19|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |QFCAT-;patternMatch;AP2Pmr;20|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |QFCAT-;convert;AP;21|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |QFCAT-;patternMatch;AP2Pmr;22|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |QFCAT-;coerce;FA;23|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|) - |QFCAT-;retract;AI;24|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) - |QFCAT-;retractIfCan;AU;25|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |QFCAT-;random;A;26|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%Vector| *) |%Shell|) |%Pair|) - |QFCAT-;reducedSystem;MVR;27|)) - -(DEFUN |QFCAT-;numerator;2A;1| (|x| $) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 8)) (|shellEntry| $ 9))) - -(DEFUN |QFCAT-;denominator;2A;2| (|x| $) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 11)) (|shellEntry| $ 9))) - -(DEFUN |QFCAT-;init;A;3| ($) - (SPADCALL (|spadConstant| $ 13) (|spadConstant| $ 14) - (|shellEntry| $ 15))) - -(DEFUN |QFCAT-;nextItem;AU;4| (|n| $) - (LET ((|m| (SPADCALL (SPADCALL |n| (|shellEntry| $ 8)) - (|shellEntry| $ 18)))) - (COND - ((EQL (CAR |m|) 1) - (|error| "We seem to have a Fraction of a finite object")) - (T (CONS 0 - (SPADCALL (CDR |m|) (|spadConstant| $ 14) - (|shellEntry| $ 15))))))) - -(DEFUN |QFCAT-;map;M2A;5| (|fn| |x| $) - (SPADCALL (SPADCALL (SPADCALL |x| (|shellEntry| $ 8)) |fn|) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 11)) |fn|) - (|shellEntry| $ 15))) - -(DEFUN |QFCAT-;reducedSystem;MM;6| (|m| $) - (SPADCALL |m| (|shellEntry| $ 26))) - -(DEFUN |QFCAT-;characteristic;Nni;7| ($) (|spadConstant| $ 30)) - -(DEFUN |QFCAT-;differentiate;AMA;8| (|x| |deriv| $) - (LET ((|n| (SPADCALL |x| (|shellEntry| $ 8))) - (|d| (SPADCALL |x| (|shellEntry| $ 11)))) - (SPADCALL - (SPADCALL - (SPADCALL (SPADCALL |n| |deriv|) |d| (|shellEntry| $ 32)) - (SPADCALL |n| (SPADCALL |d| |deriv|) (|shellEntry| $ 32)) - (|shellEntry| $ 33)) - (SPADCALL |d| 2 (|shellEntry| $ 35)) (|shellEntry| $ 15)))) - -(DEFUN |QFCAT-;convert;AIf;9| (|x| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|shellEntry| $ 8)) (|shellEntry| $ 38)) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 11)) (|shellEntry| $ 38)) - (|shellEntry| $ 39))) - -(DEFUN |QFCAT-;convert;AF;10| (|x| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|shellEntry| $ 8)) (|shellEntry| $ 42)) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 11)) (|shellEntry| $ 42)) - (|shellEntry| $ 43))) - -(DEFUN |QFCAT-;convert;ADf;11| (|x| $) - (/ (SPADCALL (SPADCALL |x| (|shellEntry| $ 8)) (|shellEntry| $ 46)) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 11)) (|shellEntry| $ 46)))) - -(DEFUN |QFCAT-;<;2AB;12| (|x| |y| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|shellEntry| $ 8)) - (SPADCALL |y| (|shellEntry| $ 11)) (|shellEntry| $ 32)) - (SPADCALL (SPADCALL |y| (|shellEntry| $ 8)) - (SPADCALL |x| (|shellEntry| $ 11)) (|shellEntry| $ 32)) - (|shellEntry| $ 50))) - -(DEFUN |QFCAT-;<;2AB;13| (|x| |y| $) - (PROG (|#G19| |#G20| |#G21| |#G22|) - (RETURN - (SEQ (COND - ((SPADCALL (SPADCALL |x| (|shellEntry| $ 11)) - (|spadConstant| $ 52) (|shellEntry| $ 50)) - (PROGN - (LETT |#G19| |y| |QFCAT-;<;2AB;13|) - (LETT |#G20| |x| |QFCAT-;<;2AB;13|) - (SETQ |x| |#G19|) - (SETQ |y| |#G20|)))) - (COND - ((SPADCALL (SPADCALL |y| (|shellEntry| $ 11)) - (|spadConstant| $ 52) (|shellEntry| $ 50)) - (PROGN - (LETT |#G21| |y| |QFCAT-;<;2AB;13|) - (LETT |#G22| |x| |QFCAT-;<;2AB;13|) - (SETQ |x| |#G21|) - (SETQ |y| |#G22|)))) - (EXIT (SPADCALL - (SPADCALL (SPADCALL |x| (|shellEntry| $ 8)) - (SPADCALL |y| (|shellEntry| $ 11)) - (|shellEntry| $ 32)) - (SPADCALL (SPADCALL |y| (|shellEntry| $ 8)) - (SPADCALL |x| (|shellEntry| $ 11)) - (|shellEntry| $ 32)) - (|shellEntry| $ 50))))))) - -(DEFUN |QFCAT-;<;2AB;14| (|x| |y| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|shellEntry| $ 8)) - (SPADCALL |y| (|shellEntry| $ 11)) (|shellEntry| $ 32)) - (SPADCALL (SPADCALL |y| (|shellEntry| $ 8)) - (SPADCALL |x| (|shellEntry| $ 11)) (|shellEntry| $ 32)) - (|shellEntry| $ 50))) - -(DEFUN |QFCAT-;fractionPart;2A;15| (|x| $) - (SPADCALL |x| - (SPADCALL (SPADCALL |x| (|shellEntry| $ 53)) (|shellEntry| $ 9)) - (|shellEntry| $ 54))) - -(DEFUN |QFCAT-;coerce;SA;16| (|s| $) - (SPADCALL (SPADCALL |s| (|shellEntry| $ 57)) (|shellEntry| $ 9))) - -(DEFUN |QFCAT-;retract;AS;17| (|x| $) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 59)) (|shellEntry| $ 60))) - -(DEFUN |QFCAT-;retractIfCan;AU;18| (|x| $) - (LET ((|r| (SPADCALL |x| (|shellEntry| $ 63)))) - (COND - ((EQL (CAR |r|) 1) (CONS 1 "failed")) - (T (SPADCALL (CDR |r|) (|shellEntry| $ 65)))))) - -(DEFUN |QFCAT-;convert;AP;19| (|x| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|shellEntry| $ 8)) (|shellEntry| $ 69)) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 11)) (|shellEntry| $ 69)) - (|shellEntry| $ 70))) - -(DEFUN |QFCAT-;patternMatch;AP2Pmr;20| (|x| |p| |l| $) - (SPADCALL |x| |p| |l| (|shellEntry| $ 74))) - -(DEFUN |QFCAT-;convert;AP;21| (|x| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|shellEntry| $ 8)) (|shellEntry| $ 78)) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 11)) (|shellEntry| $ 78)) - (|shellEntry| $ 79))) - -(DEFUN |QFCAT-;patternMatch;AP2Pmr;22| (|x| |p| |l| $) - (SPADCALL |x| |p| |l| (|shellEntry| $ 83))) - -(DEFUN |QFCAT-;coerce;FA;23| (|x| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|shellEntry| $ 87)) (|shellEntry| $ 88)) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 89)) (|shellEntry| $ 88)) - (|shellEntry| $ 90))) - -(DEFUN |QFCAT-;retract;AI;24| (|x| $) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 59)) (|shellEntry| $ 92))) - -(DEFUN |QFCAT-;retractIfCan;AU;25| (|x| $) - (LET ((|u| (SPADCALL |x| (|shellEntry| $ 63)))) - (COND - ((EQL (CAR |u|) 1) (CONS 1 "failed")) - (T (SPADCALL (CDR |u|) (|shellEntry| $ 95)))))) - -(DEFUN |QFCAT-;random;A;26| ($) - (PROG (|d|) - (RETURN - (SEQ (LOOP - (COND - ((NOT (SPADCALL - (LETT |d| (SPADCALL (|shellEntry| $ 97)) - |QFCAT-;random;A;26|) - (|shellEntry| $ 98))) - (RETURN NIL)) - (T |d|))) - (EXIT (SPADCALL (SPADCALL (|shellEntry| $ 97)) |d| - (|shellEntry| $ 15))))))) - -(DEFUN |QFCAT-;reducedSystem;MVR;27| (|m| |v| $) - (LET ((|n| (SPADCALL - (SPADCALL (SPADCALL |v| (|shellEntry| $ 101)) |m| - (|shellEntry| $ 102)) - (|shellEntry| $ 103)))) - (CONS (SPADCALL |n| (SPADCALL |n| (|shellEntry| $ 104)) - (SPADCALL |n| (|shellEntry| $ 105)) - (+ 1 (SPADCALL |n| (|shellEntry| $ 107))) - (SPADCALL |n| (|shellEntry| $ 109)) (|shellEntry| $ 110)) - (SPADCALL |n| (SPADCALL |n| (|shellEntry| $ 107)) - (|shellEntry| $ 112))))) - -(DEFUN |QuotientFieldCategory&| (|#1| |#2|) - (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) - (|dv$| (LIST '|QuotientFieldCategory&| |dv$1| |dv$2|)) - ($ (|newShell| 123)) - (|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|)))))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (SETF (|shellEntry| $ 7) |#2|) - (COND - ((|testBitVector| |pv$| 12) - (PROGN - (SETF (|shellEntry| $ 16) - (CONS (|dispatchFunction| |QFCAT-;init;A;3|) $)) - (SETF (|shellEntry| $ 20) - (CONS (|dispatchFunction| |QFCAT-;nextItem;AU;4|) $))))) - (COND - ((|testBitVector| |pv$| 7) - (SETF (|shellEntry| $ 40) - (CONS (|dispatchFunction| |QFCAT-;convert;AIf;9|) $)))) - (COND - ((|testBitVector| |pv$| 8) - (PROGN - (SETF (|shellEntry| $ 44) - (CONS (|dispatchFunction| |QFCAT-;convert;AF;10|) $)) - (SETF (|shellEntry| $ 48) - (CONS (|dispatchFunction| |QFCAT-;convert;ADf;11|) $))))) - (COND - ((|testBitVector| |pv$| 9) - (COND - ((|HasAttribute| |#2| '|canonicalUnitNormal|) - (SETF (|shellEntry| $ 51) - (CONS (|dispatchFunction| |QFCAT-;<;2AB;12|) $))) - (T (SETF (|shellEntry| $ 51) - (CONS (|dispatchFunction| |QFCAT-;<;2AB;13|) $))))) - ((|testBitVector| |pv$| 10) - (SETF (|shellEntry| $ 51) - (CONS (|dispatchFunction| |QFCAT-;<;2AB;14|) $)))) - (COND - ((|testBitVector| |pv$| 3) - (SETF (|shellEntry| $ 55) - (CONS (|dispatchFunction| |QFCAT-;fractionPart;2A;15|) $)))) - (COND - ((|testBitVector| |pv$| 4) - (PROGN - (SETF (|shellEntry| $ 58) - (CONS (|dispatchFunction| |QFCAT-;coerce;SA;16|) $)) - (SETF (|shellEntry| $ 61) - (CONS (|dispatchFunction| |QFCAT-;retract;AS;17|) $)) - (SETF (|shellEntry| $ 66) - (CONS (|dispatchFunction| |QFCAT-;retractIfCan;AU;18|) - $))))) - (COND - ((|HasCategory| |#2| '(|ConvertibleTo| (|Pattern| (|Integer|)))) - (PROGN - (SETF (|shellEntry| $ 71) - (CONS (|dispatchFunction| |QFCAT-;convert;AP;19|) $)) - (COND - ((|HasCategory| |#2| '(|PatternMatchable| (|Integer|))) - (SETF (|shellEntry| $ 76) - (CONS (|dispatchFunction| - |QFCAT-;patternMatch;AP2Pmr;20|) - $))))))) - (COND - ((|HasCategory| |#2| '(|ConvertibleTo| (|Pattern| (|Float|)))) - (PROGN - (SETF (|shellEntry| $ 80) - (CONS (|dispatchFunction| |QFCAT-;convert;AP;21|) $)) - (COND - ((|HasCategory| |#2| '(|PatternMatchable| (|Float|))) - (SETF (|shellEntry| $ 85) - (CONS (|dispatchFunction| - |QFCAT-;patternMatch;AP2Pmr;22|) - $))))))) - (COND - ((|testBitVector| |pv$| 11) - (PROGN - (SETF (|shellEntry| $ 91) - (CONS (|dispatchFunction| |QFCAT-;coerce;FA;23|) $)) - (COND - ((|domainEqual| |#2| (|Integer|))) - (T (PROGN - (SETF (|shellEntry| $ 93) - (CONS (|dispatchFunction| |QFCAT-;retract;AI;24|) - $)) - (SETF (|shellEntry| $ 96) - (CONS (|dispatchFunction| - |QFCAT-;retractIfCan;AU;25|) - $)))))))) - (COND - ((|testBitVector| |pv$| 2) - (SETF (|shellEntry| $ 99) - (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 . /) - (117 . |convert|) (|Boolean|) (122 . <) (128 . <) - (134 . |Zero|) (138 . |wholePart|) (143 . -) - (149 . |fractionPart|) (|Symbol|) (154 . |coerce|) - (159 . |coerce|) (164 . |retract|) (169 . |retract|) - (174 . |retract|) (|Union| 7 '"failed") - (179 . |retractIfCan|) (|Union| 56 '"failed") - (184 . |retractIfCan|) (189 . |retractIfCan|) (|Integer|) - (|Pattern| 67) (194 . |convert|) (199 . /) - (205 . |convert|) (|PatternMatchResult| 67 6) - (|PatternMatchQuotientFieldCategory| 67 7 6) - (210 . |patternMatch|) (|PatternMatchResult| 67 $) - (217 . |patternMatch|) (|Pattern| 41) (224 . |convert|) - (229 . /) (235 . |convert|) (|PatternMatchResult| 41 6) - (|PatternMatchQuotientFieldCategory| 41 7 6) - (240 . |patternMatch|) (|PatternMatchResult| 41 $) - (247 . |patternMatch|) (|Fraction| 67) (254 . |numer|) - (259 . |coerce|) (264 . |denom|) (269 . /) - (275 . |coerce|) (280 . |retract|) (285 . |retract|) - (|Union| 67 '"failed") (290 . |retractIfCan|) - (295 . |retractIfCan|) (300 . |random|) (304 . |zero?|) - (309 . |random|) (|Vector| 6) (313 . |coerce|) - (318 . |horizConcat|) (324 . |reducedSystem|) - (329 . |minRowIndex|) (334 . |maxRowIndex|) (339 . |One|) - (343 . |minColIndex|) (348 . +) (354 . |maxColIndex|) - (359 . |subMatrix|) (|Vector| 7) (368 . |column|) - (|Record| (|:| |mat| 23) (|:| |vec| 111)) (|Vector| $) - |QFCAT-;reducedSystem;MVR;27| (|List| 56) (|List| 29) - (|Union| 86 '"failed") (|Matrix| 67) (|Vector| 67) - (|Record| (|:| |mat| 119) (|:| |vec| 120)) (|OutputForm|)) - '#(|retractIfCan| 374 |retract| 384 |reducedSystem| 394 - |random| 405 |patternMatch| 409 |numerator| 423 |nextItem| - 428 |map| 433 |init| 439 |fractionPart| 443 - |differentiate| 448 |denominator| 454 |convert| 459 - |coerce| 484 |characteristic| 494 < 498) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 115 - '(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 2 45 0 - 0 0 47 1 0 45 0 48 2 7 49 0 0 50 2 0 - 49 0 0 51 0 7 0 52 1 6 7 0 53 2 6 0 0 - 0 54 1 0 0 0 55 1 7 0 56 57 1 0 0 56 - 58 1 6 7 0 59 1 7 56 0 60 1 0 56 0 61 - 1 6 62 0 63 1 7 64 0 65 1 0 64 0 66 1 - 7 68 0 69 2 68 0 0 0 70 1 0 68 0 71 3 - 73 72 6 68 72 74 3 0 75 0 68 75 76 1 - 7 77 0 78 2 77 0 0 0 79 1 0 77 0 80 3 - 82 81 6 77 81 83 3 0 84 0 77 84 85 1 - 86 67 0 87 1 6 0 67 88 1 86 67 0 89 2 - 6 0 0 0 90 1 0 0 86 91 1 7 67 0 92 1 - 0 67 0 93 1 7 94 0 95 1 0 94 0 96 0 7 - 0 97 1 7 49 0 98 0 0 0 99 1 24 0 100 - 101 2 24 0 0 0 102 1 6 23 27 103 1 23 - 67 0 104 1 23 67 0 105 0 67 0 106 1 - 23 67 0 107 2 67 0 0 0 108 1 23 67 0 - 109 5 23 0 0 67 67 67 67 110 2 23 111 - 0 67 112 1 0 94 0 96 1 0 64 0 66 1 0 - 67 0 93 1 0 56 0 61 1 0 23 27 28 2 0 - 113 27 114 115 0 0 0 99 3 0 84 0 77 - 84 85 3 0 75 0 68 75 76 1 0 0 0 10 1 - 0 17 0 20 2 0 0 21 0 22 0 0 0 16 1 0 - 0 0 55 2 0 0 0 21 36 1 0 0 0 12 1 0 - 41 0 44 1 0 45 0 48 1 0 37 0 40 1 0 - 77 0 80 1 0 68 0 71 1 0 0 56 58 1 0 0 - 86 91 0 0 29 31 2 0 49 0 0 51))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/QFCAT.lsp b/src/algebra/strap/QFCAT.lsp deleted file mode 100644 index 913585d0..00000000 --- a/src/algebra/strap/QFCAT.lsp +++ /dev/null @@ -1,89 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |QuotientFieldCategory;CAT| 'NIL) - -(DEFPARAMETER |QuotientFieldCategory;AL| 'NIL) - -(DEFUN |QuotientFieldCategory;| (|t#1|) - (LET ((#0=#:G1374 - (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (COND - (|QuotientFieldCategory;CAT|) - (T (SETQ |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)))))))) - (SETF (|shellEntry| #0# 0) - (LIST '|QuotientFieldCategory| (|devaluate| |t#1|))) - #0#)) - -(DEFUN |QuotientFieldCategory| (#0=#:G1375) - (LET ((#1=#:G1376 - (|assoc| (|devaluate| #0#) |QuotientFieldCategory;AL|))) - (COND - (#1# (CDR #1#)) - (T (PROGN - (SETQ #1# (|QuotientFieldCategory;| #0#)) - (SETQ |QuotientFieldCategory;AL| - (|cons5| (CONS (|devaluate| #0#) #1#) - |QuotientFieldCategory;AL|)) - #1#))))) diff --git a/src/algebra/strap/RCAGG-.lsp b/src/algebra/strap/RCAGG-.lsp deleted file mode 100644 index 5bdb2577..00000000 --- a/src/algebra/strap/RCAGG-.lsp +++ /dev/null @@ -1,60 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |RCAGG-;elt;AvalueS;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |RCAGG-;setelt;Avalue2S;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |RCAGG-;child?;2AB;3|)) - -(DEFUN |RCAGG-;elt;AvalueS;1| (|x| T0 $) - (SPADCALL |x| (|shellEntry| $ 8))) - -(DEFUN |RCAGG-;setelt;Avalue2S;2| (|x| T1 |y| $) - (SPADCALL |x| |y| (|shellEntry| $ 11))) - -(DEFUN |RCAGG-;child?;2AB;3| (|x| |l| $) - (SPADCALL |x| (SPADCALL |l| (|shellEntry| $ 14)) (|shellEntry| $ 17))) - -(DEFUN |RecursiveAggregate&| (|#1| |#2|) - (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) - (|dv$| (LIST '|RecursiveAggregate&| |dv$1| |dv$2|)) - ($ (|newShell| 19)) - (|pv$| (|buildPredVector| 0 0 - (LIST (|HasAttribute| |#1| '|shallowlyMutable|) - (|HasCategory| |#2| '(|SetCategory|)))))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (SETF (|shellEntry| $ 7) |#2|) - (COND - ((|testBitVector| |pv$| 1) - (SETF (|shellEntry| $ 12) - (CONS (|dispatchFunction| |RCAGG-;setelt;Avalue2S;2|) $)))) - (COND - ((|testBitVector| |pv$| 2) - (SETF (|shellEntry| $ 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 deleted file mode 100644 index 21edd2b4..00000000 --- a/src/algebra/strap/RCAGG.lsp +++ /dev/null @@ -1,57 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |RecursiveAggregate;CAT| 'NIL) - -(DEFPARAMETER |RecursiveAggregate;AL| 'NIL) - -(DEFUN |RecursiveAggregate;| (|t#1|) - (LET ((#0=#:G1372 - (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (COND - (|RecursiveAggregate;CAT|) - (T (SETQ |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)))))))) - (SETF (|shellEntry| #0# 0) - (LIST '|RecursiveAggregate| (|devaluate| |t#1|))) - #0#)) - -(DEFUN |RecursiveAggregate| (#0=#:G1373) - (LET ((#1=#:G1374 (|assoc| (|devaluate| #0#) |RecursiveAggregate;AL|))) - (COND - (#1# (CDR #1#)) - (T (PROGN - (SETQ #1# (|RecursiveAggregate;| #0#)) - (SETQ |RecursiveAggregate;AL| - (|cons5| (CONS (|devaluate| #0#) #1#) - |RecursiveAggregate;AL|)) - #1#))))) diff --git a/src/algebra/strap/RING-.lsp b/src/algebra/strap/RING-.lsp deleted file mode 100644 index dac04c20..00000000 --- a/src/algebra/strap/RING-.lsp +++ /dev/null @@ -1,28 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|) - |RING-;coerce;IS;1|)) - -(DEFUN |RING-;coerce;IS;1| (|n| $) - (SPADCALL |n| (|spadConstant| $ 7) (|shellEntry| $ 9))) - -(DEFUN |Ring&| (|#1|) - (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$| (LIST '|Ring&| |dv$1|)) - ($ (|newShell| 12)) (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 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 deleted file mode 100644 index 5632415b..00000000 --- a/src/algebra/strap/RING.lsp +++ /dev/null @@ -1,22 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |Ring;AL| 'NIL) - -(DEFUN |Ring;| () - (LET ((#0=#:G1373 - (|sublisV| (PAIR '(#1=#:G1372) '((|Integer|))) - (|Join| (|Rng|) (|Monoid|) (|LeftModule| '$) - (|CoercibleFrom| '#1#) - (|mkCategory| '|package| - '(((|characteristic| - ((|NonNegativeInteger|)) |constant|) - T)) - '((|unitsKnown| T)) - '((|NonNegativeInteger|)) NIL))))) - (SETF (|shellEntry| #0# 0) '(|Ring|)) - #0#)) - -(DEFUN |Ring| () (COND (|Ring;AL|) (T (SETQ |Ring;AL| (|Ring;|))))) - -(MAKEPROP '|Ring| 'NILADIC T) diff --git a/src/algebra/strap/RNG.lsp b/src/algebra/strap/RNG.lsp deleted file mode 100644 index 43402373..00000000 --- a/src/algebra/strap/RNG.lsp +++ /dev/null @@ -1,13 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |Rng;AL| 'NIL) - -(DEFUN |Rng;| () - (LET ((#0=#:G1372 (|Join| (|AbelianGroup|) (|SemiGroup|)))) - (SETF (|shellEntry| #0# 0) '(|Rng|)) - #0#)) - -(DEFUN |Rng| () (COND (|Rng;AL|) (T (SETQ |Rng;AL| (|Rng;|))))) - -(MAKEPROP '|Rng| 'NILADIC T) diff --git a/src/algebra/strap/RNS-.lsp b/src/algebra/strap/RNS-.lsp deleted file mode 100644 index 8888a730..00000000 --- a/src/algebra/strap/RNS-.lsp +++ /dev/null @@ -1,164 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 0)) - |RNS-;characteristic;Nni;1|)) - -(PUT '|RNS-;characteristic;Nni;1| '|SPADreplace| '(XLAM NIL 0)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |RNS-;fractionPart;2S;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |RNS-;truncate;2S;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |RNS-;round;2S;4|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |RNS-;norm;2S;5|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |RNS-;coerce;FS;6|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |RNS-;convert;SP;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |RNS-;floor;2S;8|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |RNS-;ceiling;2S;9|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |RNS-;patternMatch;SP2Pmr;10|)) - -(DEFUN |RNS-;characteristic;Nni;1| ($) (DECLARE (IGNORE $)) 0) - -(DEFUN |RNS-;fractionPart;2S;2| (|x| $) - (SPADCALL |x| (SPADCALL |x| (|shellEntry| $ 10)) (|shellEntry| $ 11))) - -(DEFUN |RNS-;truncate;2S;3| (|x| $) - (COND - ((SPADCALL |x| (|shellEntry| $ 14)) - (SPADCALL - (SPADCALL (SPADCALL |x| (|shellEntry| $ 15)) - (|shellEntry| $ 16)) - (|shellEntry| $ 15))) - (T (SPADCALL |x| (|shellEntry| $ 16))))) - -(DEFUN |RNS-;round;2S;4| (|x| $) - (COND - ((SPADCALL |x| (|shellEntry| $ 14)) - (SPADCALL - (SPADCALL |x| - (SPADCALL (|spadConstant| $ 18) - (SPADCALL 2 (|shellEntry| $ 20)) (|shellEntry| $ 21)) - (|shellEntry| $ 11)) - (|shellEntry| $ 10))) - (T (SPADCALL - (SPADCALL |x| - (SPADCALL (|spadConstant| $ 18) - (SPADCALL 2 (|shellEntry| $ 20)) - (|shellEntry| $ 21)) - (|shellEntry| $ 24)) - (|shellEntry| $ 10))))) - -(DEFUN |RNS-;norm;2S;5| (|x| $) (SPADCALL |x| (|shellEntry| $ 26))) - -(DEFUN |RNS-;coerce;FS;6| (|x| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|shellEntry| $ 29)) (|shellEntry| $ 20)) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 30)) (|shellEntry| $ 20)) - (|shellEntry| $ 21))) - -(DEFUN |RNS-;convert;SP;7| (|x| $) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 33)) (|shellEntry| $ 35))) - -(DEFUN |RNS-;floor;2S;8| (|x| $) - (LET ((|x1| (SPADCALL (SPADCALL |x| (|shellEntry| $ 37)) - (|shellEntry| $ 20)))) - (COND - ((SPADCALL |x| |x1| (|shellEntry| $ 38)) |x|) - ((SPADCALL |x| (|spadConstant| $ 39) (|shellEntry| $ 41)) - (SPADCALL |x1| (|spadConstant| $ 18) (|shellEntry| $ 11))) - (T |x1|)))) - -(DEFUN |RNS-;ceiling;2S;9| (|x| $) - (LET ((|x1| (SPADCALL (SPADCALL |x| (|shellEntry| $ 37)) - (|shellEntry| $ 20)))) - (COND - ((SPADCALL |x| |x1| (|shellEntry| $ 38)) |x|) - ((SPADCALL |x| (|spadConstant| $ 39) (|shellEntry| $ 44)) - (SPADCALL |x1| (|spadConstant| $ 18) (|shellEntry| $ 24))) - (T |x1|)))) - -(DEFUN |RNS-;patternMatch;SP2Pmr;10| (|x| |p| |l| $) - (COND - ((SPADCALL |p| (|shellEntry| $ 46)) - (SPADCALL |p| |x| |l| (|shellEntry| $ 48))) - ((SPADCALL |p| (|shellEntry| $ 49)) - (LET ((|r| (SPADCALL |p| (|shellEntry| $ 51)))) - (COND - ((ZEROP (CAR |r|)) - (COND - ((SPADCALL (SPADCALL |x| (|shellEntry| $ 33)) (CDR |r|) - (|shellEntry| $ 52)) - |l|) - (T (SPADCALL (|shellEntry| $ 53))))) - (T (SPADCALL (|shellEntry| $ 53)))))) - (T (SPADCALL (|shellEntry| $ 53))))) - -(DEFUN |RealNumberSystem&| (|#1|) - (LET* ((|dv$1| (|devaluate| |#1|)) - (|dv$| (LIST '|RealNumberSystem&| |dv$1|)) ($ (|newShell| 58)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - $)) - -(MAKEPROP '|RealNumberSystem&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) - (|NonNegativeInteger|) (0 . |Zero|) - |RNS-;characteristic;Nni;1| (4 . |truncate|) (9 . -) - |RNS-;fractionPart;2S;2| (|Boolean|) (15 . |negative?|) - (20 . -) (25 . |floor|) |RNS-;truncate;2S;3| (30 . |One|) - (|Integer|) (34 . |coerce|) (39 . /) (|PositiveInteger|) - (45 . |One|) (49 . +) |RNS-;round;2S;4| (55 . |abs|) - |RNS-;norm;2S;5| (|Fraction| 19) (60 . |numer|) - (65 . |denom|) |RNS-;coerce;FS;6| (|Float|) - (70 . |convert|) (|Pattern| 32) (75 . |coerce|) - |RNS-;convert;SP;7| (80 . |wholePart|) (85 . =) - (91 . |Zero|) (95 . |Zero|) (99 . <) (105 . |One|) - |RNS-;floor;2S;8| (109 . >=) |RNS-;ceiling;2S;9| - (115 . |generic?|) (|PatternMatchResult| 32 6) - (120 . |addMatch|) (127 . |constant?|) - (|Union| 32 '"failed") (132 . |retractIfCan|) (137 . =) - (143 . |failed|) (|PatternMatchResult| 32 $) - |RNS-;patternMatch;SP2Pmr;10| (|DoubleFloat|) - (|OutputForm|)) - '#(|truncate| 147 |round| 152 |patternMatch| 157 |norm| 164 - |fractionPart| 169 |floor| 174 |convert| 179 |coerce| 184 - |characteristic| 194 |ceiling| 198) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 55 - '(0 7 0 8 1 6 0 0 10 2 6 0 0 0 11 1 6 - 13 0 14 1 6 0 0 15 1 6 0 0 16 0 6 0 - 18 1 6 0 19 20 2 6 0 0 0 21 0 22 0 23 - 2 6 0 0 0 24 1 6 0 0 26 1 28 19 0 29 - 1 28 19 0 30 1 6 32 0 33 1 34 0 32 35 - 1 6 19 0 37 2 6 13 0 0 38 0 6 0 39 0 - 19 0 40 2 6 13 0 0 41 0 19 0 42 2 6 - 13 0 0 44 1 34 13 0 46 3 47 0 34 6 0 - 48 1 34 13 0 49 1 34 50 0 51 2 32 13 - 0 0 52 0 47 0 53 1 0 0 0 17 1 0 0 0 - 25 3 0 54 0 34 54 55 1 0 0 0 27 1 0 0 - 0 12 1 0 0 0 43 1 0 34 0 36 1 0 0 28 - 31 1 0 0 28 31 0 0 7 9 1 0 0 0 45))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/RNS.lsp b/src/algebra/strap/RNS.lsp deleted file mode 100644 index 5dd2cd32..00000000 --- a/src/algebra/strap/RNS.lsp +++ /dev/null @@ -1,33 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |RealNumberSystem;AL| 'NIL) - -(DEFUN |RealNumberSystem;| () - (LET ((#0=#:G1381 - (|sublisV| - (PAIR '(#1=#:G1377 #2=#:G1378 #3=#:G1379 #4=#:G1380) - '((|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))))) - (SETF (|shellEntry| #0# 0) '(|RealNumberSystem|)) - #0#)) - -(DEFUN |RealNumberSystem| () - (COND - (|RealNumberSystem;AL|) - (T (SETQ |RealNumberSystem;AL| (|RealNumberSystem;|))))) - -(MAKEPROP '|RealNumberSystem| 'NILADIC T) diff --git a/src/algebra/strap/SETAGG-.lsp b/src/algebra/strap/SETAGG-.lsp deleted file mode 100644 index 18c5bc2b..00000000 --- a/src/algebra/strap/SETAGG-.lsp +++ /dev/null @@ -1,57 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |SETAGG-;symmetricDifference;3A;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |SETAGG-;union;ASA;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |SETAGG-;union;S2A;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |SETAGG-;difference;ASA;4|)) - -(DEFUN |SETAGG-;symmetricDifference;3A;1| (|x| |y| $) - (SPADCALL (SPADCALL |x| |y| (|shellEntry| $ 8)) - (SPADCALL |y| |x| (|shellEntry| $ 8)) (|shellEntry| $ 9))) - -(DEFUN |SETAGG-;union;ASA;2| (|s| |x| $) - (SPADCALL |s| (SPADCALL (LIST |x|) (|shellEntry| $ 12)) - (|shellEntry| $ 9))) - -(DEFUN |SETAGG-;union;S2A;3| (|x| |s| $) - (SPADCALL |s| (SPADCALL (LIST |x|) (|shellEntry| $ 12)) - (|shellEntry| $ 9))) - -(DEFUN |SETAGG-;difference;ASA;4| (|s| |x| $) - (SPADCALL |s| (SPADCALL (LIST |x|) (|shellEntry| $ 12)) - (|shellEntry| $ 8))) - -(DEFUN |SetAggregate&| (|#1| |#2|) - (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) - (|dv$| (LIST '|SetAggregate&| |dv$1| |dv$2|)) - ($ (|newShell| 16)) (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (SETF (|shellEntry| $ 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 deleted file mode 100644 index 3c8ad618..00000000 --- a/src/algebra/strap/SETAGG.lsp +++ /dev/null @@ -1,46 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |SetAggregate;CAT| 'NIL) - -(DEFPARAMETER |SetAggregate;AL| 'NIL) - -(DEFUN |SetAggregate;| (|t#1|) - (LET ((#0=#:G1372 - (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (COND - (|SetAggregate;CAT|) - (T (SETQ |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)))))))) - (SETF (|shellEntry| #0# 0) - (LIST '|SetAggregate| (|devaluate| |t#1|))) - #0#)) - -(DEFUN |SetAggregate| (#0=#:G1373) - (LET ((#1=#:G1374 (|assoc| (|devaluate| #0#) |SetAggregate;AL|))) - (COND - (#1# (CDR #1#)) - (T (PROGN - (SETQ #1# (|SetAggregate;| #0#)) - (SETQ |SetAggregate;AL| - (|cons5| (CONS (|devaluate| #0#) #1#) - |SetAggregate;AL|)) - #1#))))) diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp deleted file mode 100644 index 87b00200..00000000 --- a/src/algebra/strap/SINT.lsp +++ /dev/null @@ -1,719 +0,0 @@ - -(/VERSIONCHECK 2) - -(|noteSubDomainInfo| '|SingleInteger| '(|Integer|) '(|%ismall?| |#1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Short| |%Shell|) |%Void|) - |SINT;writeOMSingleInt|)) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%String|) - |SINT;OMwrite;$S;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Boolean| |%Shell|) |%String|) - |SINT;OMwrite;$BS;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Short| |%Shell|) |%Void|) - |SINT;OMwrite;Omd$V;4|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Short| |%Boolean| |%Shell|) - |%Void|) - |SINT;OMwrite;Omd$BV;5|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |SINT;reducedSystem;MM;6|)) - -(PUT '|SINT;reducedSystem;MM;6| '|SPADreplace| '(XLAM (|m|) |m|)) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Thing|) - |SINT;coerce;$Of;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Integer|) - |SINT;convert;$I;8|)) - -(PUT '|SINT;convert;$I;8| '|SPADreplace| '(XLAM (|x|) |x|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Short| |%Shell|) |%Short|) - |SINT;*;I2$;9|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Short|) |SINT;Zero;$;10|)) - -(PUT '|SINT;Zero;$;10| '|SPADreplace| '(XLAM NIL 0)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Short|) |SINT;One;$;11|)) - -(PUT '|SINT;One;$;11| '|SPADreplace| '(XLAM NIL 1)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Short|) |SINT;base;$;12|)) - -(PUT '|SINT;base;$;12| '|SPADreplace| '(XLAM NIL 2)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Short|) |SINT;max;$;13|)) - -(PUT '|SINT;max;$;13| '|SPADreplace| '(XLAM NIL |$ShortMaximum|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Short|) |SINT;min;$;14|)) - -(PUT '|SINT;min;$;14| '|SPADreplace| '(XLAM NIL |$ShortMinimum|)) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Boolean|) - |SINT;=;2$B;15|)) - -(PUT '|SINT;=;2$B;15| '|SPADreplace| '|%ieq|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|) |SINT;~;2$;16|)) - -(PUT '|SINT;~;2$;16| '|SPADreplace| '|%bitnot|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|) - |SINT;not;2$;17|)) - -(PUT '|SINT;not;2$;17| '|SPADreplace| '|%bitnot|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;/\\;3$;18|)) - -(PUT '|SINT;/\\;3$;18| '|SPADreplace| '|%bitand|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;\\/;3$;19|)) - -(PUT '|SINT;\\/;3$;19| '|SPADreplace| '|%bitior|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|) - |SINT;Not;2$;20|)) - -(PUT '|SINT;Not;2$;20| '|SPADreplace| '|%bitnot|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;And;3$;21|)) - -(PUT '|SINT;And;3$;21| '|SPADreplace| '|%bitand|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;and;3$;22|)) - -(PUT '|SINT;and;3$;22| '|SPADreplace| '|%bitand|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;Or;3$;23|)) - -(PUT '|SINT;Or;3$;23| '|SPADreplace| '|%bitior|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;or;3$;24|)) - -(PUT '|SINT;or;3$;24| '|SPADreplace| '|%bitior|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;xor;3$;25|)) - -(PUT '|SINT;xor;3$;25| '|SPADreplace| '|%bitxor|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Boolean|) - |SINT;<;2$B;26|)) - -(PUT '|SINT;<;2$B;26| '|SPADreplace| '|%ilt|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Boolean|) - |SINT;>;2$B;27|)) - -(PUT '|SINT;>;2$B;27| '|SPADreplace| - '(XLAM (|x| |y|) (|%ilt| |y| |x|))) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Boolean|) - |SINT;<=;2$B;28|)) - -(PUT '|SINT;<=;2$B;28| '|SPADreplace| - '(XLAM (|x| |y|) (|%not| (|%ilt| |y| |x|)))) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Boolean|) - |SINT;>=;2$B;29|)) - -(PUT '|SINT;>=;2$B;29| '|SPADreplace| - '(XLAM (|x| |y|) (|%not| (|%ilt| |x| |y|)))) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|) - |SINT;inc;2$;30|)) - -(PUT '|SINT;inc;2$;30| '|SPADreplace| '|%iinc|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|) - |SINT;dec;2$;31|)) - -(PUT '|SINT;dec;2$;31| '|SPADreplace| '|%idec|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|) |SINT;-;2$;32|)) - -(PUT '|SINT;-;2$;32| '|SPADreplace| '|%ineg|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;+;3$;33|)) - -(PUT '|SINT;+;3$;33| '|SPADreplace| '|%iadd|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;-;3$;34|)) - -(PUT '|SINT;-;3$;34| '|SPADreplace| '|%isub|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;*;3$;35|)) - -(PUT '|SINT;*;3$;35| '|SPADreplace| '|%imul|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| (|%IntegerSection| 0) |%Shell|) - |%Short|) - |SINT;**;$Nni$;36|)) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;quo;3$;37|)) - -(PUT '|SINT;quo;3$;37| '|SPADreplace| '|%iquo|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;rem;3$;38|)) - -(PUT '|SINT;rem;3$;38| '|SPADreplace| '|%irem|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Pair|) - |SINT;divide;2$R;39|)) - -(PUT '|SINT;divide;2$R;39| '|SPADreplace| '|%idivide|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;gcd;3$;40|)) - -(PUT '|SINT;gcd;3$;40| '|SPADreplace| '|%igcd|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|) - |SINT;abs;2$;41|)) - -(PUT '|SINT;abs;2$;41| '|SPADreplace| '|%iabs|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Boolean|) - |SINT;odd?;$B;42|)) - -(PUT '|SINT;odd?;$B;42| '|SPADreplace| '|%iodd?|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Boolean|) - |SINT;zero?;$B;43|)) - -(PUT '|SINT;zero?;$B;43| '|SPADreplace| '(XLAM (|x|) (|%ieq| |x| 0))) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Boolean|) - |SINT;one?;$B;44|)) - -(PUT '|SINT;one?;$B;44| '|SPADreplace| '(XLAM (|x|) (|%ieq| |x| 1))) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;max;3$;45|)) - -(PUT '|SINT;max;3$;45| '|SPADreplace| '|%imax|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;min;3$;46|)) - -(PUT '|SINT;min;3$;46| '|SPADreplace| '|%imin|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|) - |SINT;hash;2$;47|)) - -(PUT '|SINT;hash;2$;47| '|SPADreplace| '|%hash|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|) - |SINT;length;2$;48|)) - -(PUT '|SINT;length;2$;48| '|SPADreplace| '|%ilength|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;shift;3$;49|)) - -(PUT '|SINT;shift;3$;49| '|SPADreplace| 'QSLEFTSHIFT) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Short| |%Shell|) - |%Short|) - |SINT;mulmod;4$;50|)) - -(PUT '|SINT;mulmod;4$;50| '|SPADreplace| 'QSMULTMOD) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Short| |%Shell|) - |%Short|) - |SINT;addmod;4$;51|)) - -(PUT '|SINT;addmod;4$;51| '|SPADreplace| 'QSADDMOD) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Short| |%Shell|) - |%Short|) - |SINT;submod;4$;52|)) - -(PUT '|SINT;submod;4$;52| '|SPADreplace| 'QSDIFMOD) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Boolean|) - |SINT;negative?;$B;53|)) - -(PUT '|SINT;negative?;$B;53| '|SPADreplace| - '(XLAM (|x|) (|%ilt| |x| 0))) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 0)) - |SINT;size;Nni;54|)) - -(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 1) |%Shell|) |%Short|) - |SINT;index;Pi$;55|)) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) (|%IntegerSection| 1)) - |SINT;lookup;$Pi;56|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%Vector| *) |%Shell|) |%Pair|) - |SINT;reducedSystem;MVR;57|)) - -(PUT '|SINT;reducedSystem;MVR;57| '|SPADreplace| '|%pair|) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|) - |SINT;positiveRemainder;3$;58|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Short|) - |SINT;coerce;I$;59|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Short|) |SINT;random;$;60|)) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|) - |SINT;random;2$;61|)) - -(PUT '|SINT;random;2$;61| '|SPADreplace| 'RANDOM) - -(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Shell|) - |SINT;unitNormal;$R;62|)) - -(PUT '|SINT;size;Nni;54| '|SPADreplace| - '(XLAM NIL (|%iadd| (|%isub| |$ShortMaximum| |$ShortMinimum|) 1))) - -(PUT '|SINT;lookup;$Pi;56| '|SPADreplace| - '(XLAM (|x|) (|%iadd| (|%isub| |x| |$ShortMinimum|) 1))) - -(DEFUN |SINT;writeOMSingleInt| (|dev| |x| $) - (COND - ((MINUSP |x|) - (SEQ (SPADCALL |dev| (|shellEntry| $ 11)) - (SPADCALL |dev| "arith1" "unaryminus" (|shellEntry| $ 13)) - (SPADCALL |dev| (- |x|) (|shellEntry| $ 16)) - (EXIT (SPADCALL |dev| (|shellEntry| $ 17))))) - (T (SPADCALL |dev| |x| (|shellEntry| $ 16))))) - -(DEFUN |SINT;OMwrite;$S;2| (|x| $) - (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) - (|dev| (SPADCALL |sp| (SPADCALL (|shellEntry| $ 19)) - (|shellEntry| $ 20)))) - (SEQ (SPADCALL |dev| (|shellEntry| $ 21)) - (|SINT;writeOMSingleInt| |dev| |x| $) - (SPADCALL |dev| (|shellEntry| $ 22)) - (SPADCALL |dev| (|shellEntry| $ 23)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) - -(DEFUN |SINT;OMwrite;$BS;3| (|x| |wholeObj| $) - (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) - (|dev| (SPADCALL |sp| (SPADCALL (|shellEntry| $ 19)) - (|shellEntry| $ 20)))) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 21)))) - (|SINT;writeOMSingleInt| |dev| |x| $) - (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 22)))) - (SPADCALL |dev| (|shellEntry| $ 23)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) - -(DEFUN |SINT;OMwrite;Omd$V;4| (|dev| |x| $) - (SEQ (SPADCALL |dev| (|shellEntry| $ 21)) - (|SINT;writeOMSingleInt| |dev| |x| $) - (EXIT (SPADCALL |dev| (|shellEntry| $ 22))))) - -(DEFUN |SINT;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 21)))) - (|SINT;writeOMSingleInt| |dev| |x| $) - (EXIT (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 22))))))) - -(DEFUN |SINT;reducedSystem;MM;6| (|m| $) (DECLARE (IGNORE $)) |m|) - -(DEFUN |SINT;coerce;$Of;7| (|x| $) (SPADCALL |x| (|shellEntry| $ 32))) - -(DEFUN |SINT;convert;$I;8| (|x| $) (DECLARE (IGNORE $)) |x|) - -(DEFUN |SINT;*;I2$;9| (|i| |y| $) - (* (SPADCALL |i| (|shellEntry| $ 34)) |y|)) - -(DEFUN |SINT;Zero;$;10| ($) (DECLARE (IGNORE $)) 0) - -(DEFUN |SINT;One;$;11| ($) (DECLARE (IGNORE $)) 1) - -(DEFUN |SINT;base;$;12| ($) (DECLARE (IGNORE $)) 2) - -(DEFUN |SINT;max;$;13| ($) (DECLARE (IGNORE $)) |$ShortMaximum|) - -(DEFUN |SINT;min;$;14| ($) (DECLARE (IGNORE $)) |$ShortMinimum|) - -(DEFUN |SINT;=;2$B;15| (|x| |y| $) (DECLARE (IGNORE $)) (EQL |x| |y|)) - -(DEFUN |SINT;~;2$;16| (|x| $) (DECLARE (IGNORE $)) (LOGNOT |x|)) - -(DEFUN |SINT;not;2$;17| (|x| $) (DECLARE (IGNORE $)) (LOGNOT |x|)) - -(DEFUN |SINT;/\\;3$;18| (|x| |y| $) - (DECLARE (IGNORE $)) - (LOGAND |x| |y|)) - -(DEFUN |SINT;\\/;3$;19| (|x| |y| $) - (DECLARE (IGNORE $)) - (LOGIOR |x| |y|)) - -(DEFUN |SINT;Not;2$;20| (|x| $) (DECLARE (IGNORE $)) (LOGNOT |x|)) - -(DEFUN |SINT;And;3$;21| (|x| |y| $) - (DECLARE (IGNORE $)) - (LOGAND |x| |y|)) - -(DEFUN |SINT;and;3$;22| (|x| |y| $) - (DECLARE (IGNORE $)) - (LOGAND |x| |y|)) - -(DEFUN |SINT;Or;3$;23| (|x| |y| $) - (DECLARE (IGNORE $)) - (LOGIOR |x| |y|)) - -(DEFUN |SINT;or;3$;24| (|x| |y| $) - (DECLARE (IGNORE $)) - (LOGIOR |x| |y|)) - -(DEFUN |SINT;xor;3$;25| (|x| |y| $) - (DECLARE (IGNORE $)) - (LOGXOR |x| |y|)) - -(DEFUN |SINT;<;2$B;26| (|x| |y| $) (DECLARE (IGNORE $)) (< |x| |y|)) - -(DEFUN |SINT;>;2$B;27| (|x| |y| $) (DECLARE (IGNORE $)) (< |y| |x|)) - -(DEFUN |SINT;<=;2$B;28| (|x| |y| $) - (DECLARE (IGNORE $)) - (NOT (< |y| |x|))) - -(DEFUN |SINT;>=;2$B;29| (|x| |y| $) - (DECLARE (IGNORE $)) - (NOT (< |x| |y|))) - -(DEFUN |SINT;inc;2$;30| (|x| $) (DECLARE (IGNORE $)) (1+ |x|)) - -(DEFUN |SINT;dec;2$;31| (|x| $) (DECLARE (IGNORE $)) (1- |x|)) - -(DEFUN |SINT;-;2$;32| (|x| $) (DECLARE (IGNORE $)) (- |x|)) - -(DEFUN |SINT;+;3$;33| (|x| |y| $) (DECLARE (IGNORE $)) (+ |x| |y|)) - -(DEFUN |SINT;-;3$;34| (|x| |y| $) (DECLARE (IGNORE $)) (- |x| |y|)) - -(DEFUN |SINT;*;3$;35| (|x| |y| $) (DECLARE (IGNORE $)) (* |x| |y|)) - -(DEFUN |SINT;**;$Nni$;36| (|x| |n| $) - (SPADCALL (EXPT |x| |n|) (|shellEntry| $ 34))) - -(DEFUN |SINT;quo;3$;37| (|x| |y| $) - (DECLARE (IGNORE $)) - (TRUNCATE |x| |y|)) - -(DEFUN |SINT;rem;3$;38| (|x| |y| $) - (DECLARE (IGNORE $)) - (REM |x| |y|)) - -(DEFUN |SINT;divide;2$R;39| (|x| |y| $) - (DECLARE (IGNORE $)) - (MULTIPLE-VALUE-CALL #'CONS (TRUNCATE |x| |y|))) - -(DEFUN |SINT;gcd;3$;40| (|x| |y| $) - (DECLARE (IGNORE $)) - (GCD |x| |y|)) - -(DEFUN |SINT;abs;2$;41| (|x| $) (DECLARE (IGNORE $)) (ABS |x|)) - -(DEFUN |SINT;odd?;$B;42| (|x| $) (DECLARE (IGNORE $)) (ODDP |x|)) - -(DEFUN |SINT;zero?;$B;43| (|x| $) (DECLARE (IGNORE $)) (ZEROP |x|)) - -(DEFUN |SINT;one?;$B;44| (|x| $) (DECLARE (IGNORE $)) (EQL |x| 1)) - -(DEFUN |SINT;max;3$;45| (|x| |y| $) - (DECLARE (IGNORE $)) - (MAX |x| |y|)) - -(DEFUN |SINT;min;3$;46| (|x| |y| $) - (DECLARE (IGNORE $)) - (MIN |x| |y|)) - -(DEFUN |SINT;hash;2$;47| (|x| $) (DECLARE (IGNORE $)) (SXHASH |x|)) - -(DEFUN |SINT;length;2$;48| (|x| $) - (DECLARE (IGNORE $)) - (INTEGER-LENGTH |x|)) - -(DEFUN |SINT;shift;3$;49| (|x| |n| $) - (DECLARE (IGNORE $)) - (QSLEFTSHIFT |x| |n|)) - -(DEFUN |SINT;mulmod;4$;50| (|a| |b| |p| $) - (DECLARE (IGNORE $)) - (QSMULTMOD |a| |b| |p|)) - -(DEFUN |SINT;addmod;4$;51| (|a| |b| |p| $) - (DECLARE (IGNORE $)) - (QSADDMOD |a| |b| |p|)) - -(DEFUN |SINT;submod;4$;52| (|a| |b| |p| $) - (DECLARE (IGNORE $)) - (QSDIFMOD |a| |b| |p|)) - -(DEFUN |SINT;negative?;$B;53| (|x| $) - (DECLARE (IGNORE $)) - (MINUSP |x|)) - -(DEFUN |SINT;size;Nni;54| ($) - (DECLARE (IGNORE $)) - (+ (- |$ShortMaximum| |$ShortMinimum|) 1)) - -(DEFUN |SINT;index;Pi$;55| (|i| $) - (LET ((#0=#:G1439 (- (+ |i| |$ShortMinimum|) 1))) - (|check-subtype| (SMINTP #0#) '(|SingleInteger|) #0#))) - -(DEFUN |SINT;lookup;$Pi;56| (|x| $) - (DECLARE (IGNORE $)) - (+ (- |x| |$ShortMinimum|) 1)) - -(DEFUN |SINT;reducedSystem;MVR;57| (|m| |v| $) - (DECLARE (IGNORE $)) - (CONS |m| |v|)) - -(DEFUN |SINT;positiveRemainder;3$;58| (|x| |n| $) - (LET ((|r| (REM |x| |n|))) - (COND - ((MINUSP |r|) (COND ((MINUSP |n|) (- |x| |n|)) (T (+ |r| |n|)))) - (T |r|)))) - -(DEFUN |SINT;coerce;I$;59| (|x| $) - (|check-subtype| (SMINTP |x|) '(|SingleInteger|) |x|)) - -(DEFUN |SINT;random;$;60| ($) - (SEQ (SETF (|shellEntry| $ 6) - (REM (TIMES 314159269 (SVREF $ 6)) 2147483647)) - (EXIT (REM (SVREF $ 6) 67108864)))) - -(DEFUN |SINT;random;2$;61| (|n| $) (DECLARE (IGNORE $)) (RANDOM |n|)) - -(DEFUN |SINT;unitNormal;$R;62| (|x| $) - (COND ((MINUSP |x|) (VECTOR -1 (- |x|) -1)) (T (VECTOR 1 |x| 1)))) - -(DEFUN |SingleInteger| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((#0=#:G1478 (HGET |$ConstructorCache| '|SingleInteger|))) - (COND - (#0# (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|SingleInteger| - (LIST (CONS NIL - (CONS 1 (|SingleInteger;|)))))) - (SETQ #0# T)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|SingleInteger|)))))))) - -(DEFUN |SingleInteger;| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((|dv$| '(|SingleInteger|)) ($ (|newShell| 115)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|haddProp| |$ConstructorCache| '|SingleInteger| NIL (CONS 1 $)) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) 1) - $)) - -(MAKEPROP '|SingleInteger| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL (|Integer|) '|seed| (|Boolean|) - |SINT;negative?;$B;53| (|Void|) (|OpenMathDevice|) - (0 . |OMputApp|) (|String|) (5 . |OMputSymbol|) - |SINT;-;2$;32| |SINT;convert;$I;8| (12 . |OMputInteger|) - (18 . |OMputEndApp|) (|OpenMathEncoding|) - (23 . |OMencodingXML|) (27 . |OMopenString|) - (33 . |OMputObject|) (38 . |OMputEndObject|) - (43 . |OMclose|) |SINT;OMwrite;$S;2| |SINT;OMwrite;$BS;3| - |SINT;OMwrite;Omd$V;4| |SINT;OMwrite;Omd$BV;5| - (|Matrix| 5) (|Matrix| $) |SINT;reducedSystem;MM;6| - (|OutputForm|) (48 . |coerce|) |SINT;coerce;$Of;7| - (53 . |coerce|) |SINT;*;I2$;9| - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |SINT;Zero;$;10|) $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |SINT;One;$;11|) $)) - |SINT;base;$;12| - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |SINT;max;$;13|) $)) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |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;and;3$;22| |SINT;Or;3$;23| - |SINT;or;3$;24| |SINT;xor;3$;25| |SINT;<;2$B;26| - |SINT;>;2$B;27| |SINT;<=;2$B;28| |SINT;>=;2$B;29| - |SINT;inc;2$;30| |SINT;dec;2$;31| |SINT;+;3$;33| - |SINT;-;3$;34| |SINT;*;3$;35| (|NonNegativeInteger|) - |SINT;**;$Nni$;36| |SINT;quo;3$;37| |SINT;rem;3$;38| - (|Record| (|:| |quotient| $) (|:| |remainder| $)) - |SINT;divide;2$R;39| |SINT;gcd;3$;40| |SINT;abs;2$;41| - |SINT;odd?;$B;42| |SINT;zero?;$B;43| |SINT;one?;$B;44| - |SINT;max;3$;45| |SINT;min;3$;46| (|SingleInteger|) - |SINT;hash;2$;47| |SINT;length;2$;48| |SINT;shift;3$;49| - |SINT;mulmod;4$;50| |SINT;addmod;4$;51| - |SINT;submod;4$;52| |SINT;size;Nni;54| (|PositiveInteger|) - (58 . +) (64 . |One|) (68 . -) |SINT;index;Pi$;55| - |SINT;lookup;$Pi;56| (|Vector| 5) - (|Record| (|:| |mat| 28) (|:| |vec| 88)) (|Vector| $) - |SINT;reducedSystem;MVR;57| |SINT;positiveRemainder;3$;58| - |SINT;coerce;I$;59| |SINT;random;$;60| |SINT;random;2$;61| - (|Record| (|:| |unit| $) (|:| |canonical| $) - (|:| |associate| $)) - |SINT;unitNormal;$R;62| (|Fraction| 5) - (|Union| 98 '"failed") (|Union| $ '"failed") (|Float|) - (|DoubleFloat|) (|PatternMatchResult| 5 $) (|Pattern| 5) - (|InputForm|) (|Union| 5 '"failed") (|List| $) - (|Union| 107 '"failed") - (|Record| (|:| |coef| 107) (|:| |generator| $)) - (|Record| (|:| |coef1| $) (|:| |coef2| $) - (|:| |generator| $)) - (|Record| (|:| |coef1| $) (|:| |coef2| $)) - (|Union| 111 '"failed") (|Factored| $) - (|SparseUnivariatePolynomial| $)) - '#(~= 74 ~ 80 |zero?| 85 |xor| 90 |unitNormal| 96 - |unitCanonical| 101 |unit?| 106 |symmetricRemainder| 111 - |subtractIfCan| 117 |submod| 123 |squareFreePart| 130 - |squareFree| 135 |sizeLess?| 140 |size| 146 |sign| 150 - |shift| 155 |sample| 161 |retractIfCan| 165 |retract| 170 - |rem| 175 |reducedSystem| 181 |recip| 192 |rationalIfCan| - 197 |rational?| 202 |rational| 207 |random| 212 |quo| 221 - |principalIdeal| 227 |prime?| 232 |powmod| 237 - |positiveRemainder| 244 |positive?| 250 |permutation| 255 - |patternMatch| 261 |or| 268 |one?| 274 |odd?| 279 |not| - 284 |nextItem| 289 |negative?| 294 |multiEuclidean| 299 - |mulmod| 305 |min| 312 |max| 322 |mask| 332 |lookup| 337 - |length| 342 |leftReducedSystem| 347 |lcm| 358 |latex| 369 - |invmod| 374 |init| 380 |index| 384 |inc| 389 |hash| 394 - |gcdPolynomial| 399 |gcd| 405 |factorial| 416 |factor| 421 - |extendedEuclidean| 426 |exquo| 439 |expressIdealMember| - 445 |even?| 451 |euclideanSize| 456 |divide| 461 - |differentiate| 467 |dec| 478 |copy| 483 |convert| 488 - |coerce| 513 |characteristic| 533 |bit?| 537 |binomial| - 543 |before?| 549 |base| 555 |associates?| 559 |and| 565 - |addmod| 571 |abs| 578 |\\/| 583 |Zero| 589 |Or| 593 |One| - 599 |OMwrite| 603 |Not| 627 D 632 |And| 643 >= 649 > 655 = - 661 <= 667 < 673 |/\\| 679 - 685 + 696 ** 702 * 714) - '((|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 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 |OrderedRing&| NIL NIL |Module&| NIL NIL - |Ring&| NIL NIL NIL NIL NIL NIL - |AbelianGroup&| NIL NIL NIL NIL NIL - |AbelianMonoid&| |Monoid&| NIL NIL NIL NIL NIL - NIL |AbelianSemiGroup&| |SemiGroup&| NIL - |BooleanLogic&| |DifferentialSpace&| - |OrderedType&| |SetCategory&| |Logic&| NIL - |RetractableTo&| |DifferentialDomain&| - |BasicType&| NIL NIL NIL NIL NIL NIL NIL NIL - NIL NIL NIL) - (CONS '#((|IntegerNumberSystem|) - (|EuclideanDomain|) - (|UniqueFactorizationDomain|) - (|PrincipalIdealDomain|) - (|OrderedIntegralDomain|) (|GcdDomain|) - (|IntegralDomain|) (|Algebra| $$) - (|CharacteristicZero|) - (|DifferentialRing|) (|OrderedRing|) - (|CommutativeRing|) (|EntireRing|) - (|Module| $$) - (|LinearlyExplicitRingOver| 5) - (|BiModule| $$ $$) (|Ring|) - (|LeftModule| 5) (|OrderedAbelianGroup|) - (|LeftModule| $$) (|Rng|) - (|RightModule| $$) - (|OrderedCancellationAbelianMonoid|) - (|AbelianGroup|) - (|OrderedAbelianMonoid|) - (|CancellationAbelianMonoid|) - (|OrderedFinite|) - (|OrderedAbelianSemiGroup|) - (|LinearSet| $$) (|AbelianMonoid|) - (|Monoid|) (|Finite|) (|StepThrough|) - (|PatternMatchable| 5) (|OrderedSet|) - (|LeftLinearSet| $$) - (|RightLinearSet| $$) - (|AbelianSemiGroup|) (|SemiGroup|) - (|LeftLinearSet| 5) (|BooleanLogic|) - (|DifferentialSpace|) (|OrderedType|) - (|SetCategory|) (|Logic|) - (|RealConstant|) (|RetractableTo| 5) - (|DifferentialDomain| $$) (|BasicType|) - (|OpenMath|) (|ConvertibleTo| 101) - (|ConvertibleTo| 102) - (|CombinatorialFunctionCategory|) - (|ConvertibleTo| 104) - (|ConvertibleTo| 105) - (|ConvertibleTo| 5) (|CoercibleFrom| $$) - (|CoercibleFrom| 5) (|Type|) - (|CoercibleTo| 31)) - (|makeByteWordVec2| 114 - '(1 10 9 0 11 3 10 9 0 12 12 13 2 10 9 - 0 5 16 1 10 9 0 17 0 18 0 19 2 10 0 - 12 18 20 1 10 9 0 21 1 10 9 0 22 1 10 - 9 0 23 1 5 31 0 32 1 0 0 5 34 2 82 0 - 0 0 83 0 82 0 84 2 5 0 0 0 85 2 0 7 0 - 0 1 1 0 0 0 42 1 0 7 0 70 2 0 0 0 0 - 51 1 0 96 0 97 1 0 0 0 1 1 0 7 0 1 2 - 0 0 0 0 1 2 0 100 0 0 1 3 0 0 0 0 0 - 80 1 0 0 0 1 1 0 113 0 1 2 0 7 0 0 1 - 0 0 61 81 1 0 5 0 1 2 0 0 0 0 77 0 0 - 0 1 1 0 106 0 1 1 0 5 0 1 2 0 0 0 0 - 64 1 0 28 29 30 2 0 89 29 90 91 1 0 - 100 0 1 1 0 99 0 1 1 0 7 0 1 1 0 98 0 - 1 0 0 0 94 1 0 0 0 95 2 0 0 0 0 63 1 - 0 109 107 1 1 0 7 0 1 3 0 0 0 0 0 1 2 - 0 0 0 0 92 1 0 7 0 1 2 0 0 0 0 1 3 0 - 103 0 104 103 1 2 0 0 0 0 50 1 0 7 0 - 71 1 0 7 0 69 1 0 0 0 43 1 0 100 0 1 - 1 0 7 0 8 2 0 108 107 0 1 3 0 0 0 0 0 - 78 0 0 0 40 2 0 0 0 0 73 0 0 0 39 2 0 - 0 0 0 72 1 0 0 0 1 1 0 82 0 87 1 0 0 - 0 76 1 0 28 90 1 2 0 89 90 0 1 1 0 0 - 107 1 2 0 0 0 0 1 1 0 12 0 1 2 0 0 0 - 0 1 0 0 0 1 1 0 0 82 86 1 0 0 0 56 1 - 0 74 0 75 2 0 114 114 114 1 1 0 0 107 - 1 2 0 0 0 0 67 1 0 0 0 1 1 0 113 0 1 - 2 0 110 0 0 1 3 0 112 0 0 0 1 2 0 100 - 0 0 1 2 0 108 107 0 1 1 0 7 0 1 1 0 - 61 0 1 2 0 65 0 0 66 2 0 0 0 61 1 1 0 - 0 0 1 1 0 0 0 57 1 0 0 0 1 1 0 101 0 - 1 1 0 102 0 1 1 0 105 0 1 1 0 104 0 1 - 1 0 5 0 15 1 0 0 5 93 1 0 0 0 1 1 0 0 - 5 93 1 0 31 0 33 0 0 61 1 2 0 7 0 0 1 - 2 0 0 0 0 1 2 0 7 0 0 1 0 0 0 38 2 0 - 7 0 0 1 2 0 0 0 0 48 3 0 0 0 0 0 79 1 - 0 0 0 68 2 0 0 0 0 45 0 0 0 36 2 0 0 - 0 0 49 0 0 0 37 3 0 9 10 0 7 27 2 0 - 12 0 7 25 2 0 9 10 0 26 1 0 12 0 24 1 - 0 0 0 46 2 0 0 0 61 1 1 0 0 0 1 2 0 0 - 0 0 47 2 0 7 0 0 55 2 0 7 0 0 53 2 0 - 7 0 0 41 2 0 7 0 0 54 2 0 7 0 0 52 2 - 0 0 0 0 44 1 0 0 0 14 2 0 0 0 0 59 2 - 0 0 0 0 58 2 0 0 0 61 62 2 0 0 0 82 1 - 2 0 0 5 0 35 2 0 0 0 0 60 2 0 0 5 0 - 35 2 0 0 61 0 1 2 0 0 82 0 1))))) - '|lookupComplete|)) - -(MAKEPROP '|SingleInteger| 'NILADIC T) diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp deleted file mode 100644 index 15f0a80f..00000000 --- a/src/algebra/strap/STAGG-.lsp +++ /dev/null @@ -1,297 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |STAGG-;explicitlyFinite?;AB;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |STAGG-;possiblyInfinite?;AB;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|) - |%Thing|) - |STAGG-;first;ANniA;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |STAGG-;c2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Thing|) - |STAGG-;elt;AIS;5|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |STAGG-;elt;AUsA;6|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |STAGG-;concat;3A;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |STAGG-;concat;LA;8|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |STAGG-;map!;M2A;9|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |STAGG-;fill!;ASA;10|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Thing| |%Shell|) - |%Thing|) - |STAGG-;setelt;AI2S;11|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |STAGG-;setelt;AUs2S;12|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |STAGG-;concat!;3A;13|)) - -(DEFUN |STAGG-;explicitlyFinite?;AB;1| (|x| $) - (NOT (SPADCALL |x| (|shellEntry| $ 9)))) - -(DEFUN |STAGG-;possiblyInfinite?;AB;2| (|x| $) - (SPADCALL |x| (|shellEntry| $ 9))) - -(DEFUN |STAGG-;first;ANniA;3| (|x| |n| $) - (SPADCALL - (LET ((|i| 1) (#0=#:G1422 NIL)) - (LOOP - (COND - ((> |i| |n|) (RETURN (NREVERSE #0#))) - (T (SETQ #0# - (CONS (|STAGG-;c2| |x| - (SETQ |x| - (SPADCALL |x| (|shellEntry| $ 13))) - $) - #0#)))) - (SETQ |i| (+ |i| 1)))) - (|shellEntry| $ 15))) - -(DEFUN |STAGG-;c2| (|x| |r| $) - (COND - ((SPADCALL |x| (|shellEntry| $ 18)) (|error| "Index out of range")) - (T (SPADCALL |x| (|shellEntry| $ 19))))) - -(DEFUN |STAGG-;elt;AIS;5| (|x| |i| $) - (SEQ (SETQ |i| (- |i| (SPADCALL |x| (|shellEntry| $ 21)))) - (EXIT (COND - ((OR (MINUSP |i|) - (SPADCALL - (SETQ |x| - (SPADCALL |x| - (|check-subtype| (NOT (MINUSP |i|)) - '(|NonNegativeInteger|) |i|) - (|shellEntry| $ 25))) - (|shellEntry| $ 18))) - (|error| "index out of range")) - (T (SPADCALL |x| (|shellEntry| $ 19))))))) - -(DEFUN |STAGG-;elt;AUsA;6| (|x| |i| $) - (PROG (|h|) - (RETURN - (LET ((|l| (- (SPADCALL |i| (|shellEntry| $ 28)) - (SPADCALL |x| (|shellEntry| $ 21))))) - (COND - ((MINUSP |l|) (|error| "index out of range")) - ((NOT (SPADCALL |i| (|shellEntry| $ 29))) - (SPADCALL - (SPADCALL |x| - (|check-subtype| (NOT (MINUSP |l|)) - '(|NonNegativeInteger|) |l|) - (|shellEntry| $ 25)) - (|shellEntry| $ 30))) - (T (SEQ (LETT |h| - (- (SPADCALL |i| (|shellEntry| $ 31)) - (SPADCALL |x| (|shellEntry| $ 21))) - |STAGG-;elt;AUsA;6|) - (EXIT (COND - ((< |h| |l|) (SPADCALL (|shellEntry| $ 32))) - (T (SPADCALL (SPADCALL |x| - (|check-subtype| - (NOT (MINUSP |l|)) - '(|NonNegativeInteger|) |l|) - (|shellEntry| $ 25)) - (LET - ((#0=#:G1395 (+ (- |h| |l|) 1))) - (|check-subtype| - (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|shellEntry| $ 35)))))))))))) - -(DEFUN |STAGG-;concat;3A;7| (|x| |y| $) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 30)) |y| (|shellEntry| $ 37))) - -(DEFUN |STAGG-;concat;LA;8| (|l| $) - (COND - ((NULL |l|) (SPADCALL (|shellEntry| $ 32))) - (T (SPADCALL (SPADCALL (|SPADfirst| |l|) (|shellEntry| $ 30)) - (SPADCALL (CDR |l|) (|shellEntry| $ 44)) - (|shellEntry| $ 37))))) - -(DEFUN |STAGG-;map!;M2A;9| (|f| |l| $) - (LET ((|y| |l|)) - (SEQ (LOOP - (COND - ((NOT (NOT (SPADCALL |l| (|shellEntry| $ 18)))) - (RETURN NIL)) - (T (SEQ (SPADCALL |l| - (SPADCALL (SPADCALL |l| (|shellEntry| $ 19)) - |f|) - (|shellEntry| $ 46)) - (EXIT (SETQ |l| - (SPADCALL |l| (|shellEntry| $ 13)))))))) - (EXIT |y|)))) - -(DEFUN |STAGG-;fill!;ASA;10| (|x| |s| $) - (LET ((|y| |x|)) - (SEQ (LOOP - (COND - ((NOT (NOT (SPADCALL |y| (|shellEntry| $ 18)))) - (RETURN NIL)) - (T (SEQ (SPADCALL |y| |s| (|shellEntry| $ 46)) - (EXIT (SETQ |y| - (SPADCALL |y| (|shellEntry| $ 13)))))))) - (EXIT |x|)))) - -(DEFUN |STAGG-;setelt;AI2S;11| (|x| |i| |s| $) - (SEQ (SETQ |i| (- |i| (SPADCALL |x| (|shellEntry| $ 21)))) - (EXIT (COND - ((OR (MINUSP |i|) - (SPADCALL - (SETQ |x| - (SPADCALL |x| - (|check-subtype| (NOT (MINUSP |i|)) - '(|NonNegativeInteger|) |i|) - (|shellEntry| $ 25))) - (|shellEntry| $ 18))) - (|error| "index out of range")) - (T (SPADCALL |x| |s| (|shellEntry| $ 46))))))) - -(DEFUN |STAGG-;setelt;AUs2S;12| (|x| |i| |s| $) - (PROG (|h| |y| |z|) - (RETURN - (LET ((|l| (- (SPADCALL |i| (|shellEntry| $ 28)) - (SPADCALL |x| (|shellEntry| $ 21))))) - (COND - ((MINUSP |l|) (|error| "index out of range")) - (T (SEQ (LETT |h| - (COND - ((SPADCALL |i| (|shellEntry| $ 29)) - (- (SPADCALL |i| (|shellEntry| $ 31)) - (SPADCALL |x| (|shellEntry| $ 21)))) - (T (SPADCALL |x| (|shellEntry| $ 51)))) - |STAGG-;setelt;AUs2S;12|) - (EXIT (COND - ((< |h| |l|) |s|) - (T (SEQ (LETT |y| - (SPADCALL |x| - (|check-subtype| - (NOT (MINUSP |l|)) - '(|NonNegativeInteger|) |l|) - (|shellEntry| $ 25)) - |STAGG-;setelt;AUs2S;12|) - (LETT |z| - (SPADCALL |y| - (LET - ((#0=#:G1418 - (+ (- |h| |l|) 1))) - (|check-subtype| - (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) - #0#)) - (|shellEntry| $ 25)) - |STAGG-;setelt;AUs2S;12|) - (LOOP - (COND - ((NOT - (NOT - (SPADCALL |y| |z| - (|shellEntry| $ 52)))) - (RETURN NIL)) - (T - (SEQ - (SPADCALL |y| |s| - (|shellEntry| $ 46)) - (EXIT - (SETQ |y| - (SPADCALL |y| - (|shellEntry| $ 13)))))))) - (EXIT |s|)))))))))))) - -(DEFUN |STAGG-;concat!;3A;13| (|x| |y| $) - (COND - ((SPADCALL |x| (|shellEntry| $ 18)) |y|) - (T (SEQ (SPADCALL (SPADCALL |x| (|shellEntry| $ 54)) |y| - (|shellEntry| $ 55)) - (EXIT |x|))))) - -(DEFUN |StreamAggregate&| (|#1| |#2|) - (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) - (|dv$| (LIST '|StreamAggregate&| |dv$1| |dv$2|)) - ($ (|newShell| 61)) (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (SETF (|shellEntry| $ 7) |#2|) - (COND - ((|HasAttribute| |#1| '|shallowlyMutable|) - (PROGN - (SETF (|shellEntry| $ 38) - (CONS (|dispatchFunction| |STAGG-;concat;3A;7|) $)) - (SETF (|shellEntry| $ 45) - (CONS (|dispatchFunction| |STAGG-;concat;LA;8|) $)) - (SETF (|shellEntry| $ 48) - (CONS (|dispatchFunction| |STAGG-;map!;M2A;9|) $)) - (SETF (|shellEntry| $ 49) - (CONS (|dispatchFunction| |STAGG-;fill!;ASA;10|) $)) - (SETF (|shellEntry| $ 50) - (CONS (|dispatchFunction| |STAGG-;setelt;AI2S;11|) $)) - (SETF (|shellEntry| $ 53) - (CONS (|dispatchFunction| |STAGG-;setelt;AUs2S;12|) $)) - (SETF (|shellEntry| $ 56) - (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 . -) (41 . |Zero|) - (45 . <) (51 . |rest|) |STAGG-;elt;AIS;5| - (|UniversalSegment| 20) (57 . |lo|) (62 . |hasHi|) - (67 . |copy|) (72 . |hi|) (77 . |empty|) (81 . |One|) - (85 . +) (91 . |first|) |STAGG-;elt;AUsA;6| - (97 . |concat!|) (103 . |concat|) (|List| 6) - (109 . |empty?|) (114 . |first|) (119 . |rest|) (|List| $) - (124 . |concat|) (129 . |concat|) (134 . |setfirst!|) - (|Mapping| 7 7) (140 . |map!|) (146 . |fill!|) - (152 . |setelt|) (159 . |maxIndex|) (164 . |eq?|) - (170 . |setelt|) (177 . |tail|) (182 . |setrest!|) - (188 . |concat!|) '"rest" '"last" '"first" '"value") - '#(|setelt| 194 |possiblyInfinite?| 208 |map!| 213 |first| - 219 |fill!| 225 |explicitlyFinite?| 231 |elt| 236 - |concat!| 248 |concat| 254) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 56 - '(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 20 0 0 0 22 0 20 0 23 2 20 8 0 0 - 24 2 6 0 0 16 25 1 27 20 0 28 1 27 8 - 0 29 1 6 0 0 30 1 27 20 0 31 0 6 0 32 - 0 16 0 33 2 20 0 0 0 34 2 6 0 0 16 35 - 2 6 0 0 0 37 2 0 0 0 0 38 1 39 8 0 40 - 1 39 6 0 41 1 39 0 0 42 1 6 0 43 44 1 - 0 0 43 45 2 6 7 0 7 46 2 0 0 47 0 48 - 2 0 0 0 7 49 3 0 7 0 20 7 50 1 6 20 0 - 51 2 6 8 0 0 52 3 0 7 0 27 7 53 1 6 0 - 0 54 2 6 0 0 0 55 2 0 0 0 0 56 3 0 7 - 0 20 7 50 3 0 7 0 27 7 53 1 0 8 0 12 - 2 0 0 47 0 48 2 0 0 0 16 17 2 0 0 0 7 - 49 1 0 8 0 11 2 0 7 0 20 26 2 0 0 0 - 27 36 2 0 0 0 0 56 1 0 0 43 45 2 0 0 - 0 0 38))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/STAGG.lsp b/src/algebra/strap/STAGG.lsp deleted file mode 100644 index e6b12835..00000000 --- a/src/algebra/strap/STAGG.lsp +++ /dev/null @@ -1,37 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |StreamAggregate;CAT| 'NIL) - -(DEFPARAMETER |StreamAggregate;AL| 'NIL) - -(DEFUN |StreamAggregate;| (|t#1|) - (LET ((#0=#:G1379 - (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (COND - (|StreamAggregate;CAT|) - (T (SETQ |StreamAggregate;CAT| - (|Join| (|UnaryRecursiveAggregate| '|t#1|) - (|LinearAggregate| '|t#1|) - (|mkCategory| '|domain| - '(((|explicitlyFinite?| - ((|Boolean|) $)) - T) - ((|possiblyInfinite?| - ((|Boolean|) $)) - T)) - NIL '((|Boolean|)) NIL)))))))) - (SETF (|shellEntry| #0# 0) - (LIST '|StreamAggregate| (|devaluate| |t#1|))) - #0#)) - -(DEFUN |StreamAggregate| (#0=#:G1380) - (LET ((#1=#:G1381 (|assoc| (|devaluate| #0#) |StreamAggregate;AL|))) - (COND - (#1# (CDR #1#)) - (T (PROGN - (SETQ #1# (|StreamAggregate;| #0#)) - (SETQ |StreamAggregate;AL| - (|cons5| (CONS (|devaluate| #0#) #1#) - |StreamAggregate;AL|)) - #1#))))) diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp deleted file mode 100644 index c9e9bd05..00000000 --- a/src/algebra/strap/SYMBOL.lsp +++ /dev/null @@ -1,762 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Void|) - |SYMBOL;writeOMSym|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%String|) - |SYMBOL;OMwrite;$S;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Boolean| |%Shell|) |%String|) - |SYMBOL;OMwrite;$BS;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Void|) - |SYMBOL;OMwrite;Omd$V;4|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Boolean| |%Shell|) - |%Void|) - |SYMBOL;OMwrite;Omd$BV;5|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |SYMBOL;convert;$If;6|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |SYMBOL;convert;2$;7|)) - -(PUT '|SYMBOL;convert;2$;7| '|SPADreplace| '(XLAM (|s|) |s|)) - -(DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%Thing|) - |SYMBOL;coerce;S$;8|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |SYMBOL;=;2$B;9|)) - -(PUT '|SYMBOL;=;2$B;9| '|SPADreplace| '|%equal|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |SYMBOL;<;2$B;10|)) - -(PUT '|SYMBOL;<;2$B;10| '|SPADreplace| '|%before?|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |SYMBOL;coerce;$Of;11|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|) - |SYMBOL;subscript;$L$;12|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|) - |SYMBOL;elt;$L$;13|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|) - |SYMBOL;superscript;$L$;14|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|) - |SYMBOL;argscript;$L$;15|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |SYMBOL;patternMatch;$P2Pmr;16|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |SYMBOL;patternMatch;$P2Pmr;17|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |SYMBOL;convert;$P;18|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |SYMBOL;convert;$P;19|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell| |%Shell|) |%String|) - |SYMBOL;syprefix|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell| |%Shell|) |%List|) - |SYMBOL;syscripts|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|) - |SYMBOL;script;$L$;22|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell| |%Shell|) |%Thing|) - |SYMBOL;script;$R$;23|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%String|) - |SYMBOL;string;$S;24|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%String|) - |SYMBOL;latex;$S;25|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%String| |%Shell|) |%String|) - |SYMBOL;anyRadix|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |SYMBOL;new;$;27|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |SYMBOL;new;2$;28|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Void|) |SYMBOL;resetNew;V;29|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |SYMBOL;scripted?;$B;30|)) - -(PUT '|SYMBOL;scripted?;$B;30| '|SPADreplace| '|%pair?|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |SYMBOL;name;2$;31|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Shell|) - |SYMBOL;scripts;$R;32|)) - -(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%String|) - |SYMBOL;istring|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|) - |SYMBOL;list;$L;34|)) - -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |SYMBOL;sample;$;35|)) - -(PUT '|SYMBOL;sample;$;35| '|SPADreplace| '(XLAM NIL '|aSymbol|)) - -(DEFUN |SYMBOL;writeOMSym| (|dev| |x| $) - (COND - ((CONSP |x|) - (|error| "Cannot convert a scripted symbol to OpenMath")) - (T (SPADCALL |dev| |x| (|shellEntry| $ 27))))) - -(DEFUN |SYMBOL;OMwrite;$S;2| (|x| $) - (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) - (|dev| (SPADCALL |sp| (SPADCALL (|shellEntry| $ 29)) - (|shellEntry| $ 30)))) - (SEQ (SPADCALL |dev| (|shellEntry| $ 31)) - (|SYMBOL;writeOMSym| |dev| |x| $) - (SPADCALL |dev| (|shellEntry| $ 32)) - (SPADCALL |dev| (|shellEntry| $ 33)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) - -(DEFUN |SYMBOL;OMwrite;$BS;3| (|x| |wholeObj| $) - (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) - (|dev| (SPADCALL |sp| (SPADCALL (|shellEntry| $ 29)) - (|shellEntry| $ 30)))) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 31)))) - (|SYMBOL;writeOMSym| |dev| |x| $) - (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 32)))) - (SPADCALL |dev| (|shellEntry| $ 33)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) - -(DEFUN |SYMBOL;OMwrite;Omd$V;4| (|dev| |x| $) - (SEQ (SPADCALL |dev| (|shellEntry| $ 31)) - (|SYMBOL;writeOMSym| |dev| |x| $) - (EXIT (SPADCALL |dev| (|shellEntry| $ 32))))) - -(DEFUN |SYMBOL;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 31)))) - (|SYMBOL;writeOMSym| |dev| |x| $) - (EXIT (COND (|wholeObj| (SPADCALL |dev| (|shellEntry| $ 32))))))) - -(DEFUN |SYMBOL;convert;$If;6| (|s| $) - (SPADCALL |s| (|shellEntry| $ 47))) - -(DEFUN |SYMBOL;convert;2$;7| (|s| $) (DECLARE (IGNORE $)) |s|) - -(DEFUN |SYMBOL;coerce;S$;8| (|s| $) (VALUES (INTERN |s|))) - -(DEFUN |SYMBOL;=;2$B;9| (|x| |y| $) - (DECLARE (IGNORE $)) - (EQUAL |x| |y|)) - -(DEFUN |SYMBOL;<;2$B;10| (|x| |y| $) - (DECLARE (IGNORE $)) - (GGREATERP |y| |x|)) - -(DEFUN |SYMBOL;coerce;$Of;11| (|x| $) - (SPADCALL |x| (|shellEntry| $ 54))) - -(DEFUN |SYMBOL;subscript;$L$;12| (|sy| |lx| $) - (|SYMBOL;script;$L$;22| |sy| (LIST |lx| NIL NIL NIL NIL) $)) - -(DEFUN |SYMBOL;elt;$L$;13| (|sy| |lx| $) - (|SYMBOL;subscript;$L$;12| |sy| |lx| $)) - -(DEFUN |SYMBOL;superscript;$L$;14| (|sy| |lx| $) - (|SYMBOL;script;$L$;22| |sy| (LIST NIL |lx| NIL NIL NIL) $)) - -(DEFUN |SYMBOL;argscript;$L$;15| (|sy| |lx| $) - (|SYMBOL;script;$L$;22| |sy| (LIST NIL NIL NIL NIL |lx|) $)) - -(DEFUN |SYMBOL;patternMatch;$P2Pmr;16| (|x| |p| |l| $) - (SPADCALL |x| |p| |l| (|shellEntry| $ 67))) - -(DEFUN |SYMBOL;patternMatch;$P2Pmr;17| (|x| |p| |l| $) - (SPADCALL |x| |p| |l| (|shellEntry| $ 74))) - -(DEFUN |SYMBOL;convert;$P;18| (|x| $) - (SPADCALL |x| (|shellEntry| $ 77))) - -(DEFUN |SYMBOL;convert;$P;19| (|x| $) - (SPADCALL |x| (|shellEntry| $ 79))) - -(DEFUN |SYMBOL;syprefix| (|sc| $) - (LET ((|ns| (LIST (LIST-LENGTH (SVREF |sc| 3)) - (LIST-LENGTH (SVREF |sc| 2)) - (LIST-LENGTH (SVREF |sc| 1)) - (LIST-LENGTH (SVREF |sc| 0))))) - (SEQ (LOOP - (COND - ((NOT (AND (NOT (< (LIST-LENGTH |ns|) 2)) - (ZEROP (|SPADfirst| |ns|)))) - (RETURN NIL)) - (T (SETQ |ns| (CDR |ns|))))) - (EXIT (SPADCALL - (CONS (STRCONC (SVREF $ 38) - (|SYMBOL;istring| - (LIST-LENGTH (SVREF |sc| 4)) $)) - (LET ((#0=#:G1524 (NREVERSE |ns|)) - (#1=#:G1523 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|n| (CAR #0#))) - (SETQ #1# - (CONS (|SYMBOL;istring| |n| $) - #1#))))) - (SETQ #0# (CDR #0#))))) - (|shellEntry| $ 93)))))) - -(DEFUN |SYMBOL;syscripts| (|sc| $) - (LET ((|all| (SVREF |sc| 3))) - (SEQ (SETQ |all| - (SPADCALL (SVREF |sc| 2) |all| (|shellEntry| $ 94))) - (SETQ |all| - (SPADCALL (SVREF |sc| 1) |all| (|shellEntry| $ 94))) - (SETQ |all| - (SPADCALL (SVREF |sc| 0) |all| (|shellEntry| $ 94))) - (EXIT (SPADCALL |all| (SVREF |sc| 4) (|shellEntry| $ 94)))))) - -(DEFUN |SYMBOL;script;$L$;22| (|sy| |ls| $) - (LET ((|sc| (VECTOR NIL NIL NIL NIL NIL))) - (SEQ (COND - ((NOT (NULL |ls|)) - (SEQ (SETF (SVREF |sc| 0) (|SPADfirst| |ls|)) - (EXIT (SETQ |ls| (CDR |ls|)))))) - (COND - ((NOT (NULL |ls|)) - (SEQ (SETF (SVREF |sc| 1) (|SPADfirst| |ls|)) - (EXIT (SETQ |ls| (CDR |ls|)))))) - (COND - ((NOT (NULL |ls|)) - (SEQ (SETF (SVREF |sc| 2) (|SPADfirst| |ls|)) - (EXIT (SETQ |ls| (CDR |ls|)))))) - (COND - ((NOT (NULL |ls|)) - (SEQ (SETF (SVREF |sc| 3) (|SPADfirst| |ls|)) - (EXIT (SETQ |ls| (CDR |ls|)))))) - (COND - ((NOT (NULL |ls|)) - (SEQ (SETF (SVREF |sc| 4) (|SPADfirst| |ls|)) - (EXIT (SETQ |ls| (CDR |ls|)))))) - (EXIT (|SYMBOL;script;$R$;23| |sy| |sc| $))))) - -(DEFUN |SYMBOL;script;$R$;23| (|sy| |sc| $) - (COND - ((CONSP |sy|) (|error| "Cannot add scripts to a scripted symbol")) - (T (CONS (|SYMBOL;coerce;$Of;11| - (|SYMBOL;coerce;S$;8| - (STRCONC (|SYMBOL;syprefix| |sc| $) - (|SYMBOL;string;$S;24| - (|SYMBOL;name;2$;31| |sy| $) $)) - $) - $) - (|SYMBOL;syscripts| |sc| $))))) - -(DEFUN |SYMBOL;string;$S;24| (|e| $) - (COND - ((NOT (CONSP |e|)) (PNAME |e|)) - (T (|error| "Cannot form string from non-atomic symbols.")))) - -(DEFUN |SYMBOL;latex;$S;25| (|e| $) - (PROG (|ss| |lo| |sc|) - (RETURN - (LET ((|s| (PNAME (|SYMBOL;name;2$;31| |e| $)))) - (SEQ (COND - ((AND (< 1 (LENGTH |s|)) - (SPADCALL (SPADCALL |s| 1 (|shellEntry| $ 106)) - (SPADCALL "\\" (|shellEntry| $ 43)) - (|shellEntry| $ 107))) - (SETQ |s| (STRCONC "\\mbox{\\it " (STRCONC |s| "}"))))) - (COND ((NOT (CONSP |e|)) (EXIT |s|))) - (LETT |ss| (|SYMBOL;scripts;$R;32| |e| $) - |SYMBOL;latex;$S;25|) - (LETT |lo| (SVREF |ss| 0) |SYMBOL;latex;$S;25|) - (COND - ((NOT (NULL |lo|)) - (SEQ (LETT |sc| "_{" |SYMBOL;latex;$S;25|) - (LOOP - (COND - ((NOT (NOT (NULL |lo|))) (RETURN NIL)) - (T (SEQ (SETQ |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|shellEntry| $ 112)))) - (SETQ |lo| (CDR |lo|)) - (EXIT (COND - ((NOT (NULL |lo|)) - (SETQ |sc| - (STRCONC |sc| ", "))))))))) - (SETQ |sc| (STRCONC |sc| "}")) - (EXIT (SETQ |s| (STRCONC |s| |sc|)))))) - (SETQ |lo| (SVREF |ss| 1)) - (COND - ((NOT (NULL |lo|)) - (SEQ (LETT |sc| "^{" |SYMBOL;latex;$S;25|) - (LOOP - (COND - ((NOT (NOT (NULL |lo|))) (RETURN NIL)) - (T (SEQ (SETQ |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|shellEntry| $ 112)))) - (SETQ |lo| (CDR |lo|)) - (EXIT (COND - ((NOT (NULL |lo|)) - (SETQ |sc| - (STRCONC |sc| ", "))))))))) - (SETQ |sc| (STRCONC |sc| "}")) - (EXIT (SETQ |s| (STRCONC |s| |sc|)))))) - (SETQ |lo| (SVREF |ss| 2)) - (COND - ((NOT (NULL |lo|)) - (SEQ (LETT |sc| "{}^{" |SYMBOL;latex;$S;25|) - (LOOP - (COND - ((NOT (NOT (NULL |lo|))) (RETURN NIL)) - (T (SEQ (SETQ |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|shellEntry| $ 112)))) - (SETQ |lo| (CDR |lo|)) - (EXIT (COND - ((NOT (NULL |lo|)) - (SETQ |sc| - (STRCONC |sc| ", "))))))))) - (SETQ |sc| (STRCONC |sc| "}")) - (EXIT (SETQ |s| (STRCONC |sc| |s|)))))) - (SETQ |lo| (SVREF |ss| 3)) - (COND - ((NOT (NULL |lo|)) - (SEQ (LETT |sc| "{}_{" |SYMBOL;latex;$S;25|) - (LOOP - (COND - ((NOT (NOT (NULL |lo|))) (RETURN NIL)) - (T (SEQ (SETQ |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|shellEntry| $ 112)))) - (SETQ |lo| (CDR |lo|)) - (EXIT (COND - ((NOT (NULL |lo|)) - (SETQ |sc| - (STRCONC |sc| ", "))))))))) - (SETQ |sc| (STRCONC |sc| "}")) - (EXIT (SETQ |s| (STRCONC |sc| |s|)))))) - (SETQ |lo| (SVREF |ss| 4)) - (COND - ((NOT (NULL |lo|)) - (SEQ (LETT |sc| "\\left( {" |SYMBOL;latex;$S;25|) - (LOOP - (COND - ((NOT (NOT (NULL |lo|))) (RETURN NIL)) - (T (SEQ (SETQ |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|shellEntry| $ 112)))) - (SETQ |lo| (CDR |lo|)) - (EXIT (COND - ((NOT (NULL |lo|)) - (SETQ |sc| - (STRCONC |sc| ", "))))))))) - (SETQ |sc| (STRCONC |sc| "} \\right)")) - (EXIT (SETQ |s| (STRCONC |s| |sc|)))))) - (EXIT |s|)))))) - -(DEFUN |SYMBOL;anyRadix| (|n| |s| $) - (PROG (|qr|) - (RETURN - (LET ((|ns| "")) - (LOOP - (COND - (NIL (RETURN NIL)) - (T (SEQ (LETT |qr| - (MULTIPLE-VALUE-CALL #'CONS - (TRUNCATE |n| (LENGTH |s|))) - |SYMBOL;anyRadix|) - (SETQ |n| (CAR |qr|)) - (SETQ |ns| - (SPADCALL - (SPADCALL |s| - (+ (CDR |qr|) - (SPADCALL |s| - (|shellEntry| $ 117))) - (|shellEntry| $ 106)) - |ns| (|shellEntry| $ 119))) - (EXIT (COND - ((ZEROP |n|) - (RETURN-FROM |SYMBOL;anyRadix| |ns|)))))))))))) - -(DEFUN |SYMBOL;new;$;27| ($) - (LET ((|sym| (|SYMBOL;anyRadix| - (SPADCALL (SVREF $ 10) (|shellEntry| $ 120)) - (SVREF $ 20) $))) - (SEQ (SPADCALL (SVREF $ 10) - (+ (SPADCALL (SVREF $ 10) (|shellEntry| $ 120)) 1) - (|shellEntry| $ 121)) - (EXIT (|SYMBOL;coerce;S$;8| (STRCONC "%" |sym|) $))))) - -(DEFUN |SYMBOL;new;2$;28| (|x| $) - (PROG (|u| |n| |xx|) - (RETURN - (SEQ (LETT |n| - (SEQ (LETT |u| - (SPADCALL |x| (SVREF $ 13) - (|shellEntry| $ 124)) - |SYMBOL;new;2$;28|) - (EXIT (COND - ((EQL (CAR |u|) 1) 0) - (T (+ (CDR |u|) 1))))) - |SYMBOL;new;2$;28|) - (SPADCALL (SVREF $ 13) |x| |n| (|shellEntry| $ 127)) - (LETT |xx| - (COND - ((NOT (CONSP |x|)) (|SYMBOL;string;$S;24| |x| $)) - (T (|SYMBOL;string;$S;24| - (|SYMBOL;name;2$;31| |x| $) $))) - |SYMBOL;new;2$;28|) - (SETQ |xx| (STRCONC "%" |xx|)) - (SETQ |xx| - (COND - ((NOT (< (SPADCALL - (SPADCALL |xx| - (SPADCALL |xx| - (|shellEntry| $ 128)) - (|shellEntry| $ 106)) - (SVREF $ 19) (|shellEntry| $ 129)) - (SPADCALL (SVREF $ 19) - (|shellEntry| $ 117)))) - (STRCONC |xx| - (|SYMBOL;anyRadix| |n| (SVREF $ 21) $))) - (T (STRCONC |xx| - (|SYMBOL;anyRadix| |n| (SVREF $ 19) $))))) - (COND - ((NOT (CONSP |x|)) (EXIT (|SYMBOL;coerce;S$;8| |xx| $)))) - (EXIT (|SYMBOL;script;$R$;23| (|SYMBOL;coerce;S$;8| |xx| $) - (|SYMBOL;scripts;$R;32| |x| $) $)))))) - -(DEFUN |SYMBOL;resetNew;V;29| ($) - (SEQ (SPADCALL (SVREF $ 10) 0 (|shellEntry| $ 121)) - (EXIT (LET ((#0=#:G1525 - (SPADCALL (SVREF $ 13) (|shellEntry| $ 133)))) - (LOOP - (COND - ((ATOM #0#) (RETURN NIL)) - (T (LET ((|k| (CAR #0#))) - (SPADCALL |k| (SVREF $ 13) - (|shellEntry| $ 134))))) - (SETQ #0# (CDR #0#))))))) - -(DEFUN |SYMBOL;scripted?;$B;30| (|sy| $) - (DECLARE (IGNORE $)) - (CONSP |sy|)) - -(DEFUN |SYMBOL;name;2$;31| (|sy| $) - (COND - ((NOT (CONSP |sy|)) |sy|) - (T (LET ((|str| (|SYMBOL;string;$S;24| - (SPADCALL (|SYMBOL;list;$L;34| |sy| $) - (|shellEntry| $ 137)) - $))) - (SEQ (LET ((|i| (+ (SVREF $ 41) 1)) - (#0=#:G1526 (LENGTH |str|))) - (LOOP - (COND - ((> |i| #0#) (RETURN NIL)) - (T (COND - ((NOT (SPADCALL - (SPADCALL |str| |i| - (|shellEntry| $ 106)) - (|shellEntry| $ 139))) - (RETURN-FROM |SYMBOL;name;2$;31| - (|SYMBOL;coerce;S$;8| - (SPADCALL |str| - (SPADCALL |i| (LENGTH |str|) - (|shellEntry| $ 141)) - (|shellEntry| $ 142)) - $)))))) - (SETQ |i| (+ |i| 1)))) - (EXIT (|error| "Improper scripted symbol"))))))) - -(DEFUN |SYMBOL;scripts;$R;32| (|sy| $) - (PROG (|allscripts|) - (RETURN - (COND - ((NOT (CONSP |sy|)) (VECTOR NIL NIL NIL NIL NIL)) - (T (LET* ((|nscripts| '(0 0 0 0 0)) - (|lscripts| (LIST NIL NIL NIL NIL NIL)) - (|str| (|SYMBOL;string;$S;24| - (SPADCALL (|SYMBOL;list;$L;34| |sy| $) - (|shellEntry| $ 137)) - $)) - (|nstr| (LENGTH |str|)) - (|m| (SPADCALL |nscripts| (|shellEntry| $ 144)))) - (SEQ (LET ((|i| |m|) (|j| (+ (SVREF $ 41) 1))) - (LOOP - (COND - ((OR (> |j| |nstr|) - (NOT (SPADCALL - (SPADCALL |str| |j| - (|shellEntry| $ 106)) - (|shellEntry| $ 139)))) - (RETURN NIL)) - (T (SPADCALL |nscripts| |i| - (LET ((#0=#:G1517 - (- - (SPADCALL - (SPADCALL |str| |j| - (|shellEntry| $ 106)) - (|shellEntry| $ 44)) - (SVREF $ 45)))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|shellEntry| $ 148)))) - (SETQ |i| (+ |i| 1)) - (SETQ |j| (+ |j| 1)))) - (SETQ |nscripts| - (SPADCALL (CDR |nscripts|) - (|SPADfirst| |nscripts|) - (|shellEntry| $ 151))) - (LETT |allscripts| (CDR (|SYMBOL;list;$L;34| |sy| $)) - |SYMBOL;scripts;$R;32|) - (SETQ |m| (SPADCALL |lscripts| (|shellEntry| $ 153))) - (LET ((|i| |m|) (#1=#:G1527 |nscripts|)) - (LOOP - (COND - ((ATOM #1#) (RETURN NIL)) - (T (LET ((|n| (CAR #1#))) - (COND - ((< (LIST-LENGTH |allscripts|) |n|) - (|error| "Improper script count in symbol")) - (T (SEQ (SPADCALL |lscripts| |i| - (LET - ((#2=#:G1529 - (SPADCALL |allscripts| |n| - (|shellEntry| $ 156))) - (#3=#:G1528 NIL)) - (LOOP - (COND - ((ATOM #2#) - (RETURN (NREVERSE #3#))) - (T - (LET ((|a| (CAR #2#))) - (SETQ #3# - (CONS - (|SYMBOL;coerce;$Of;11| - |a| $) - #3#))))) - (SETQ #2# (CDR #2#)))) - (|shellEntry| $ 157)) - (EXIT - (SETQ |allscripts| - (SPADCALL |allscripts| |n| - (|shellEntry| $ 158)))))))))) - (SETQ |i| (+ |i| 1)) - (SETQ #1# (CDR #1#)))) - (EXIT (VECTOR (SPADCALL |lscripts| |m| - (|shellEntry| $ 159)) - (SPADCALL |lscripts| (+ |m| 1) - (|shellEntry| $ 159)) - (SPADCALL |lscripts| (+ |m| 2) - (|shellEntry| $ 159)) - (SPADCALL |lscripts| (+ |m| 3) - (|shellEntry| $ 159)) - (SPADCALL |lscripts| (+ |m| 4) - (|shellEntry| $ 159))))))))))) - -(DEFUN |SYMBOL;istring| (|n| $) - (COND - ((< 9 |n|) (|error| "Can have at most 9 scripts of each kind")) - (T (|getSimpleArrayEntry| (SVREF $ 18) |n|)))) - -(DEFUN |SYMBOL;list;$L;34| (|sy| $) - (COND - ((NOT (CONSP |sy|)) - (|error| "Cannot convert a symbol to a list if it is not subscripted")) - (T |sy|))) - -(DEFUN |SYMBOL;sample;$;35| ($) (DECLARE (IGNORE $)) '|aSymbol|) - -(DEFUN |Symbol| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((#0=#:G1531 (HGET |$ConstructorCache| '|Symbol|))) - (COND - (#0# (|CDRwithIncrement| (CDAR #0#))) - (T (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Symbol| - (LIST (CONS NIL (CONS 1 (|Symbol;|)))))) - (SETQ #0# T)) - (COND ((NOT #0#) (HREM |$ConstructorCache| '|Symbol|)))))))) - -(DEFUN |Symbol;| () - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((|dv$| '(|Symbol|)) ($ (|newShell| 165)) - (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|haddProp| |$ConstructorCache| '|Symbol| NIL (CONS 1 $)) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 10) (SPADCALL 0 (|shellEntry| $ 9))) - (SETF (|shellEntry| $ 13) (SPADCALL (|shellEntry| $ 12))) - (SETF (|shellEntry| $ 18) - (SPADCALL '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9") - (|shellEntry| $ 17))) - (SETF (|shellEntry| $ 19) "0123456789") - (SETF (|shellEntry| $ 20) "ABCDEFGHIJKLMNOPQRSTUVWXYZ") - (SETF (|shellEntry| $ 21) "abcdefghijklmnopqrstuvwxyz") - (SETF (|shellEntry| $ 38) "*") - (SETF (|shellEntry| $ 41) (LENGTH (SVREF $ 38))) - (SETF (|shellEntry| $ 45) - (SPADCALL (SPADCALL "0" (|shellEntry| $ 43)) - (|shellEntry| $ 44))) - $)) - -(MAKEPROP '|Symbol| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|Integer|) (0 . |Zero|) - (|Reference| 6) (4 . |ref|) '|count| - (|AssociationList| $$ 6) (9 . |empty|) '|xcount| - (|String|) (|List| 14) (|PrimitiveArray| 14) - (13 . |construct|) '|istrings| '|nums| 'ALPHAS '|alphas| - (|Boolean|) |SYMBOL;scripted?;$B;30| (|Void|) (|Symbol|) - (|OpenMathDevice|) (18 . |OMputVariable|) - (|OpenMathEncoding|) (24 . |OMencodingXML|) - (28 . |OMopenString|) (34 . |OMputObject|) - (39 . |OMputEndObject|) (44 . |OMclose|) - |SYMBOL;OMwrite;$S;2| |SYMBOL;OMwrite;$BS;3| - |SYMBOL;OMwrite;Omd$V;4| |SYMBOL;OMwrite;Omd$BV;5| '|hd| - (|NonNegativeInteger|) (49 . |#|) '|lhd| (|Character|) - (54 . |char|) (59 . |ord|) '|ord0| (|InputForm|) - (64 . |convert|) |SYMBOL;convert;$If;6| - |SYMBOL;convert;2$;7| |SYMBOL;coerce;S$;8| - |SYMBOL;=;2$B;9| |SYMBOL;<;2$B;10| (|OutputForm|) - (69 . |outputForm|) |SYMBOL;coerce;$Of;11| (|List| 53) - (74 . |nil|) (|List| 56) |SYMBOL;script;$L$;22| - |SYMBOL;subscript;$L$;12| |SYMBOL;elt;$L$;13| - |SYMBOL;superscript;$L$;14| |SYMBOL;argscript;$L$;15| - (|PatternMatchResult| 6 25) (|Pattern| 6) - (|PatternMatchSymbol| 6) (78 . |patternMatch|) - (|PatternMatchResult| 6 $) |SYMBOL;patternMatch;$P2Pmr;16| - (|Float|) (|PatternMatchResult| 70 25) (|Pattern| 70) - (|PatternMatchSymbol| 70) (85 . |patternMatch|) - (|PatternMatchResult| 70 $) - |SYMBOL;patternMatch;$P2Pmr;17| (92 . |coerce|) - |SYMBOL;convert;$P;18| (97 . |coerce|) - |SYMBOL;convert;$P;19| (102 . |#|) (|List| 6) (107 . |#|) - (112 . >=) (118 . |first|) (123 . |zero?|) (128 . |false|) - (132 . |rest|) (137 . |concat|) (143 . |reverse!|) - (148 . |concat|) (|List| $) (154 . |concat|) - (159 . |concat|) (165 . |null|) (170 . |first|) - (175 . |rest|) - (|Record| (|:| |sub| 56) (|:| |sup| 56) (|:| |presup| 56) - (|:| |presub| 56) (|:| |args| 56)) - |SYMBOL;script;$R$;23| |SYMBOL;name;2$;31| - |SYMBOL;string;$S;24| (180 . |concat|) (186 . |One|) - (190 . >) (196 . |One|) (200 . |elt|) (206 . ~=) - |SYMBOL;scripts;$R;32| (212 . |empty?|) (217 . |not|) - (222 . |first|) (227 . |latex|) (232 . |rest|) - |SYMBOL;latex;$S;25| - (|Record| (|:| |quotient| $) (|:| |remainder| $)) - (237 . |divide|) (243 . |minIndex|) (248 . +) - (254 . |concat|) (260 . |elt|) (265 . |setelt|) - |SYMBOL;new;$;27| (|Union| 6 '"failed") (271 . |search|) - (277 . |Zero|) (281 . |inc|) (286 . |setelt|) - (293 . |maxIndex|) (298 . |position|) (304 . >=) - |SYMBOL;new;2$;28| (|List| $$) (310 . |keys|) - (315 . |remove!|) |SYMBOL;resetNew;V;29| - |SYMBOL;list;$L;34| (321 . |first|) (326 . +) - (332 . |digit?|) (|UniversalSegment| 6) (337 . SEGMENT) - (343 . |elt|) (|List| 39) (349 . |minIndex|) - (|PositiveInteger|) (354 . |One|) (358 . -) - (364 . |setelt|) (371 . |rest|) (376 . |first|) - (381 . |concat|) (387 . |rest|) (392 . |minIndex|) - (397 . |#|) (402 . <) (408 . |first|) (414 . |setelt|) - (421 . |rest|) (427 . |elt|) (433 . >) (439 . |minIndex|) - (444 . |elt|) - (CONS IDENTITY - (FUNCALL (|dispatchFunction| |SYMBOL;sample;$;35|) - $)) - (|SingleInteger|)) - '#(~= 450 |superscript| 456 |subscript| 462 |string| 468 - |scripts| 473 |scripted?| 478 |script| 483 |sample| 495 - |resetNew| 499 |patternMatch| 503 |new| 517 |name| 526 - |min| 531 |max| 537 |list| 543 |latex| 548 |hash| 553 - |elt| 558 |convert| 564 |coerce| 584 |before?| 594 - |argscript| 600 |OMwrite| 606 >= 630 > 636 = 642 <= 648 < - 654) - 'NIL - (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0 0 0 0 0 0 0 0 0)) - (CONS '#(NIL NIL NIL |SetCategory&| |OrderedType&| - |BasicType&| NIL NIL NIL NIL NIL NIL NIL NIL) - (CONS '#((|OrderedSet|) (|PatternMatchable| 70) - (|PatternMatchable| 6) (|SetCategory|) - (|OrderedType|) (|BasicType|) - (|ConvertibleTo| 72) - (|ConvertibleTo| 65) - (|CoercibleFrom| 14) - (|ConvertibleTo| 25) (|OpenMath|) - (|ConvertibleTo| 46) (|Type|) - (|CoercibleTo| 53)) - (|makeByteWordVec2| 164 - '(0 6 0 7 1 8 0 6 9 0 11 0 12 1 16 0 15 - 17 2 26 24 0 25 27 0 28 0 29 2 26 0 - 14 28 30 1 26 24 0 31 1 26 24 0 32 1 - 26 24 0 33 1 14 39 0 40 1 42 0 14 43 - 1 42 39 0 44 1 46 0 25 47 1 53 0 25 - 54 0 56 0 57 3 66 64 25 65 64 67 3 73 - 71 25 72 71 74 1 72 0 25 77 1 65 0 25 - 79 1 56 39 0 81 1 82 39 0 83 2 39 22 - 0 0 84 1 82 6 0 85 1 6 22 0 86 0 22 0 - 87 1 82 0 0 88 2 14 0 0 0 89 1 82 0 0 - 90 2 15 0 14 0 91 1 14 0 92 93 2 56 0 - 0 0 94 1 58 22 0 95 1 58 56 0 96 1 58 - 0 0 97 2 56 0 53 0 102 0 39 0 103 2 - 39 22 0 0 104 0 6 0 105 2 14 42 0 6 - 106 2 42 22 0 0 107 1 56 22 0 109 1 - 22 0 0 110 1 56 53 0 111 1 53 14 0 - 112 1 56 0 0 113 2 6 115 0 0 116 1 14 - 6 0 117 2 6 0 0 0 118 2 14 0 42 0 119 - 1 8 6 0 120 2 8 6 0 6 121 2 11 123 2 - 0 124 0 39 0 125 1 6 0 0 126 3 11 6 0 - 2 6 127 1 14 6 0 128 2 14 6 42 0 129 - 2 6 22 0 0 130 1 11 132 0 133 2 11 - 123 2 0 134 1 132 2 0 137 2 39 0 0 0 - 138 1 42 22 0 139 2 140 0 6 6 141 2 - 14 0 0 140 142 1 143 6 0 144 0 145 0 - 146 2 6 0 0 0 147 3 143 39 0 6 39 148 - 1 143 0 0 149 1 143 39 0 150 2 143 0 - 0 39 151 1 132 0 0 152 1 58 6 0 153 1 - 132 39 0 154 2 39 22 0 0 155 2 132 0 - 0 39 156 3 58 56 0 6 56 157 2 132 0 0 - 39 158 2 58 56 0 6 159 2 6 22 0 0 160 - 1 16 6 0 161 2 16 14 0 6 162 2 0 22 0 - 0 1 2 0 0 0 56 62 2 0 0 0 56 60 1 0 - 14 0 101 1 0 98 0 108 1 0 22 0 23 2 0 - 0 0 58 59 2 0 0 0 98 99 0 0 0 163 0 0 - 24 135 3 0 75 0 72 75 76 3 0 68 0 65 - 68 69 1 0 0 0 131 0 0 0 122 1 0 0 0 - 100 2 0 0 0 0 1 2 0 0 0 0 1 1 0 92 0 - 136 1 0 14 0 114 1 0 164 0 1 2 0 0 0 - 56 61 1 0 65 0 80 1 0 72 0 78 1 0 25 - 0 49 1 0 46 0 48 1 0 0 14 50 1 0 53 0 - 55 2 0 22 0 0 1 2 0 0 0 56 63 2 0 24 - 26 0 36 3 0 24 26 0 22 37 1 0 14 0 34 - 2 0 14 0 22 35 2 0 22 0 0 1 2 0 22 0 - 0 1 2 0 22 0 0 51 2 0 22 0 0 1 2 0 22 - 0 0 52))))) - '|lookupComplete|)) - -(MAKEPROP '|Symbol| 'NILADIC T) diff --git a/src/algebra/strap/UFD-.lsp b/src/algebra/strap/UFD-.lsp deleted file mode 100644 index c947b666..00000000 --- a/src/algebra/strap/UFD-.lsp +++ /dev/null @@ -1,71 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |UFD-;squareFreePart;2S;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |UFD-;prime?;SB;2|)) - -(DEFUN |UFD-;squareFreePart;2S;1| (|x| $) - (PROG (|s|) - (RETURN - (SPADCALL - (SPADCALL - (LETT |s| (SPADCALL |x| (|shellEntry| $ 8)) - |UFD-;squareFreePart;2S;1|) - (|shellEntry| $ 10)) - (LET ((#0=#:G1380 NIL) (#1=#:G1381 T) - (#2=#:G1394 (SPADCALL |s| (|shellEntry| $ 14)))) - (LOOP - (COND - ((ATOM #2#) - (RETURN (COND (#1# (|spadConstant| $ 16)) (T #0#)))) - (T (LET ((|f| (CAR #2#))) - (LET ((#3=#:G1379 (CAR |f|))) - (COND - (#1# (SETQ #0# #3#)) - (T (SETQ #0# - (SPADCALL #0# #3# - (|shellEntry| $ 15))))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#)))) - (|shellEntry| $ 15))))) - -(DEFUN |UFD-;prime?;SB;2| (|x| $) - (EQL (LIST-LENGTH - (SPADCALL (SPADCALL |x| (|shellEntry| $ 18)) - (|shellEntry| $ 22))) - 1)) - -(DEFUN |UniqueFactorizationDomain&| (|#1|) - (LET* ((|dv$1| (|devaluate| |#1|)) - (|dv$| (LIST '|UniqueFactorizationDomain&| |dv$1|)) - ($ (|newShell| 29)) (|pv$| (|buildPredVector| 0 0 NIL))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 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|) (|NonNegativeInteger|) - (35 . |#|) (40 . |One|) (|Boolean|) (44 . =) - |UFD-;prime?;SB;2|) - '#(|squareFreePart| 50 |prime?| 55) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 28 - '(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 21 23 0 24 0 23 0 25 2 23 26 0 0 - 27 1 0 0 0 17 1 0 26 0 28))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/UFD.lsp b/src/algebra/strap/UFD.lsp deleted file mode 100644 index a52735be..00000000 --- a/src/algebra/strap/UFD.lsp +++ /dev/null @@ -1,24 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |UniqueFactorizationDomain;AL| 'NIL) - -(DEFUN |UniqueFactorizationDomain;| () - (LET ((#0=#:G1372 - (|Join| (|GcdDomain|) - (|mkCategory| '|domain| - '(((|prime?| ((|Boolean|) $)) T) - ((|squareFree| ((|Factored| $) $)) T) - ((|squareFreePart| ($ $)) T) - ((|factor| ((|Factored| $) $)) T)) - NIL '((|Factored| $) (|Boolean|)) NIL)))) - (SETF (|shellEntry| #0# 0) '(|UniqueFactorizationDomain|)) - #0#)) - -(DEFUN |UniqueFactorizationDomain| () - (COND - (|UniqueFactorizationDomain;AL|) - (T (SETQ |UniqueFactorizationDomain;AL| - (|UniqueFactorizationDomain;|))))) - -(MAKEPROP '|UniqueFactorizationDomain| 'NILADIC T) diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp deleted file mode 100644 index d0071f47..00000000 --- a/src/algebra/strap/URAGG-.lsp +++ /dev/null @@ -1,573 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |URAGG-;elt;AfirstS;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |URAGG-;elt;AlastS;2|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |URAGG-;elt;ArestA;3|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |URAGG-;second;AS;4|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |URAGG-;third;AS;5|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |URAGG-;cyclic?;AB;6|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |URAGG-;last;AS;7|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|) - |URAGG-;nodes;AL;8|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|) - |URAGG-;children;AL;9|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|) - |URAGG-;leaf?;AB;10|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |URAGG-;value;AS;11|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|) - |%Boolean|) - |URAGG-;less?;ANniB;12|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|) - |%Boolean|) - |URAGG-;more?;ANniB;13|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|) - |%Boolean|) - |URAGG-;size?;ANniB;14|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0)) - |URAGG-;#;ANni;15|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |URAGG-;tail;2A;16|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |URAGG-;findCycle|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |URAGG-;cycleTail;2A;18|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |URAGG-;cycleEntry;2A;19|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0)) - |URAGG-;cycleLength;ANni;20|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|) - |%Thing|) - |URAGG-;rest;ANniA;21|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|) - |%Thing|) - |URAGG-;last;ANniA;22|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |URAGG-;=;2AB;23|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) - |URAGG-;node?;2AB;24|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |URAGG-;setelt;Afirst2S;25|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |URAGG-;setelt;Alast2S;26|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) - |%Thing|) - |URAGG-;setelt;Arest2A;27|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |URAGG-;concat;3A;28|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |URAGG-;setlast!;A2S;29|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|) - |URAGG-;setchildren!;ALA;30|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) - |URAGG-;setvalue!;A2S;31|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Thing|) - |URAGG-;split!;AIA;32|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |URAGG-;cycleSplit!;2A;33|)) - -(DEFUN |URAGG-;elt;AfirstS;1| (|x| T0 $) - (SPADCALL |x| (|shellEntry| $ 8))) - -(DEFUN |URAGG-;elt;AlastS;2| (|x| T1 $) - (SPADCALL |x| (|shellEntry| $ 11))) - -(DEFUN |URAGG-;elt;ArestA;3| (|x| T2 $) - (SPADCALL |x| (|shellEntry| $ 14))) - -(DEFUN |URAGG-;second;AS;4| (|x| $) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 14)) (|shellEntry| $ 8))) - -(DEFUN |URAGG-;third;AS;5| (|x| $) - (SPADCALL - (SPADCALL (SPADCALL |x| (|shellEntry| $ 14)) (|shellEntry| $ 14)) - (|shellEntry| $ 8))) - -(DEFUN |URAGG-;cyclic?;AB;6| (|x| $) - (AND (NOT (SPADCALL |x| (|shellEntry| $ 20))) - (NOT (SPADCALL (|URAGG-;findCycle| |x| $) (|shellEntry| $ 20))))) - -(DEFUN |URAGG-;last;AS;7| (|x| $) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 24)) (|shellEntry| $ 8))) - -(DEFUN |URAGG-;nodes;AL;8| (|x| $) - (LET ((|l| NIL)) - (SEQ (LOOP - (COND - ((NOT (NOT (SPADCALL |x| (|shellEntry| $ 20)))) - (RETURN NIL)) - (T (SEQ (SETQ |l| (CONS |x| |l|)) - (EXIT (SETQ |x| - (SPADCALL |x| (|shellEntry| $ 14)))))))) - (EXIT (NREVERSE |l|))))) - -(DEFUN |URAGG-;children;AL;9| (|x| $) - (LET ((|l| NIL)) - (COND - ((SPADCALL |x| (|shellEntry| $ 20)) |l|) - (T (CONS (SPADCALL |x| (|shellEntry| $ 14)) |l|))))) - -(DEFUN |URAGG-;leaf?;AB;10| (|x| $) - (SPADCALL |x| (|shellEntry| $ 20))) - -(DEFUN |URAGG-;value;AS;11| (|x| $) - (COND - ((SPADCALL |x| (|shellEntry| $ 20)) - (|error| "value of empty object")) - (T (SPADCALL |x| (|shellEntry| $ 8))))) - -(DEFUN |URAGG-;less?;ANniB;12| (|l| |n| $) - (LET ((|i| |n|)) - (SEQ (LOOP - (COND - ((NOT (AND (PLUSP |i|) - (NOT (SPADCALL |l| (|shellEntry| $ 20))))) - (RETURN NIL)) - (T (SEQ (SETQ |l| (SPADCALL |l| (|shellEntry| $ 14))) - (EXIT (SETQ |i| (- |i| 1))))))) - (EXIT (PLUSP |i|))))) - -(DEFUN |URAGG-;more?;ANniB;13| (|l| |n| $) - (LET ((|i| |n|)) - (SEQ (LOOP - (COND - ((NOT (AND (PLUSP |i|) - (NOT (SPADCALL |l| (|shellEntry| $ 20))))) - (RETURN NIL)) - (T (SEQ (SETQ |l| (SPADCALL |l| (|shellEntry| $ 14))) - (EXIT (SETQ |i| (- |i| 1))))))) - (EXIT (AND (ZEROP |i|) - (NOT (SPADCALL |l| (|shellEntry| $ 20)))))))) - -(DEFUN |URAGG-;size?;ANniB;14| (|l| |n| $) - (LET ((|i| |n|)) - (SEQ (LOOP - (COND - ((NOT (AND (NOT (SPADCALL |l| (|shellEntry| $ 20))) - (PLUSP |i|))) - (RETURN NIL)) - (T (SEQ (SETQ |l| (SPADCALL |l| (|shellEntry| $ 14))) - (EXIT (SETQ |i| (- |i| 1))))))) - (EXIT (AND (SPADCALL |l| (|shellEntry| $ 20)) (ZEROP |i|)))))) - -(DEFUN |URAGG-;#;ANni;15| (|x| $) - (LET ((|k| 0)) - (SEQ (LOOP - (COND - ((NOT (NOT (SPADCALL |x| (|shellEntry| $ 20)))) - (RETURN NIL)) - (T (COND - ((AND (EQL |k| 1000) - (SPADCALL |x| (|shellEntry| $ 48))) - (|error| "cyclic list")) - (T (SEQ (SETQ |x| (SPADCALL |x| (|shellEntry| $ 14))) - (EXIT (SETQ |k| (+ |k| 1))))))))) - (EXIT |k|)))) - -(DEFUN |URAGG-;tail;2A;16| (|x| $) - (COND - ((SPADCALL |x| (|shellEntry| $ 20)) (|error| "empty list")) - (T (LET ((|y| (SPADCALL |x| (|shellEntry| $ 14)))) - (SEQ (LET ((|k| 0)) - (LOOP - (COND - ((NOT (NOT (SPADCALL |y| (|shellEntry| $ 20)))) - (RETURN NIL)) - (T (COND - ((AND (EQL |k| 1000) - (SPADCALL |x| (|shellEntry| $ 48))) - (|error| "cyclic list")) - (T (SETQ |y| - (SPADCALL (SETQ |x| |y|) - (|shellEntry| $ 14))))))) - (SETQ |k| (+ |k| 1)))) - (EXIT |x|)))))) - -(DEFUN |URAGG-;findCycle| (|x| $) - (LET ((|y| (SPADCALL |x| (|shellEntry| $ 14)))) - (SEQ (LOOP - (COND - ((NOT (NOT (SPADCALL |y| (|shellEntry| $ 20)))) - (RETURN NIL)) - (T (SEQ (COND - ((SPADCALL |x| |y| (|shellEntry| $ 54)) - (RETURN-FROM |URAGG-;findCycle| |x|))) - (SETQ |x| (SPADCALL |x| (|shellEntry| $ 14))) - (SETQ |y| (SPADCALL |y| (|shellEntry| $ 14))) - (COND - ((SPADCALL |y| (|shellEntry| $ 20)) - (RETURN-FROM |URAGG-;findCycle| |y|))) - (COND - ((SPADCALL |x| |y| (|shellEntry| $ 54)) - (RETURN-FROM |URAGG-;findCycle| |y|))) - (EXIT (SETQ |y| - (SPADCALL |y| (|shellEntry| $ 14)))))))) - (EXIT |y|)))) - -(DEFUN |URAGG-;cycleTail;2A;18| (|x| $) - (PROG (|y| |z|) - (RETURN - (COND - ((SPADCALL - (LETT |y| (SETQ |x| (SPADCALL |x| (|shellEntry| $ 55))) - |URAGG-;cycleTail;2A;18|) - (|shellEntry| $ 20)) - |x|) - (T (SEQ (LETT |z| (SPADCALL |x| (|shellEntry| $ 14)) - |URAGG-;cycleTail;2A;18|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |x| |z| (|shellEntry| $ 54)))) - (RETURN NIL)) - (T (SEQ (SETQ |y| |z|) - (EXIT (SETQ |z| - (SPADCALL |z| - (|shellEntry| $ 14)))))))) - (EXIT |y|))))))) - -(DEFUN |URAGG-;cycleEntry;2A;19| (|x| $) - (PROG (|y| |z| |l|) - (RETURN - (COND - ((SPADCALL |x| (|shellEntry| $ 20)) |x|) - ((SPADCALL - (LETT |y| (|URAGG-;findCycle| |x| $) - |URAGG-;cycleEntry;2A;19|) - (|shellEntry| $ 20)) - |y|) - (T (SEQ (LETT |z| (SPADCALL |y| (|shellEntry| $ 14)) - |URAGG-;cycleEntry;2A;19|) - (LETT |l| 1 |URAGG-;cycleEntry;2A;19|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |y| |z| (|shellEntry| $ 54)))) - (RETURN NIL)) - (T (SEQ (SETQ |z| - (SPADCALL |z| (|shellEntry| $ 14))) - (EXIT (SETQ |l| (+ |l| 1))))))) - (SETQ |y| |x|) - (LET ((|k| 1)) - (LOOP - (COND - ((> |k| |l|) (RETURN NIL)) - (T (SETQ |y| (SPADCALL |y| (|shellEntry| $ 14))))) - (SETQ |k| (+ |k| 1)))) - (LOOP - (COND - ((NOT (NOT (SPADCALL |x| |y| (|shellEntry| $ 54)))) - (RETURN NIL)) - (T (SEQ (SETQ |x| - (SPADCALL |x| (|shellEntry| $ 14))) - (EXIT (SETQ |y| - (SPADCALL |y| - (|shellEntry| $ 14)))))))) - (EXIT |x|))))))) - -(DEFUN |URAGG-;cycleLength;ANni;20| (|x| $) - (COND - ((OR (SPADCALL |x| (|shellEntry| $ 20)) - (SPADCALL (SETQ |x| (|URAGG-;findCycle| |x| $)) - (|shellEntry| $ 20))) - 0) - (T (LET ((|y| (SPADCALL |x| (|shellEntry| $ 14))) (|k| 1)) - (SEQ (LOOP - (COND - ((NOT (NOT (SPADCALL |x| |y| (|shellEntry| $ 54)))) - (RETURN NIL)) - (T (SEQ (SETQ |y| (SPADCALL |y| (|shellEntry| $ 14))) - (EXIT (SETQ |k| (+ |k| 1))))))) - (EXIT |k|)))))) - -(DEFUN |URAGG-;rest;ANniA;21| (|x| |n| $) - (SEQ (LET ((|i| 1)) - (LOOP - (COND - ((> |i| |n|) (RETURN NIL)) - (T (COND - ((SPADCALL |x| (|shellEntry| $ 20)) - (|error| "Index out of range")) - (T (SETQ |x| (SPADCALL |x| (|shellEntry| $ 14))))))) - (SETQ |i| (+ |i| 1)))) - (EXIT |x|))) - -(DEFUN |URAGG-;last;ANniA;22| (|x| |n| $) - (LET ((|m| (SPADCALL |x| (|shellEntry| $ 60)))) - (COND - ((< |m| |n|) (|error| "index out of range")) - (T (SPADCALL - (SPADCALL |x| - (LET ((#0=#:G1477 (- |m| |n|))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|shellEntry| $ 62)) - (|shellEntry| $ 63)))))) - -(DEFUN |URAGG-;=;2AB;23| (|x| |y| $) - (OR (SPADCALL |x| |y| (|shellEntry| $ 54)) - (SEQ (LET ((|k| 0)) - (LOOP - (COND - ((NOT (AND (NOT (SPADCALL |x| (|shellEntry| $ 20))) - (NOT (SPADCALL |y| (|shellEntry| $ 20))))) - (RETURN NIL)) - (T (COND - ((AND (EQL |k| 1000) - (SPADCALL |x| (|shellEntry| $ 48))) - (|error| "cyclic list")) - ((SPADCALL (SPADCALL |x| (|shellEntry| $ 8)) - (SPADCALL |y| (|shellEntry| $ 8)) - (|shellEntry| $ 66)) - (RETURN-FROM |URAGG-;=;2AB;23| NIL)) - (T (SEQ (SETQ |x| - (SPADCALL |x| (|shellEntry| $ 14))) - (EXIT (SETQ |y| - (SPADCALL |y| (|shellEntry| $ 14))))))))) - (SETQ |k| (+ |k| 1)))) - (EXIT (AND (SPADCALL |x| (|shellEntry| $ 20)) - (SPADCALL |y| (|shellEntry| $ 20))))))) - -(DEFUN |URAGG-;node?;2AB;24| (|u| |v| $) - (SEQ (LET ((|k| 0)) - (LOOP - (COND - ((NOT (NOT (SPADCALL |v| (|shellEntry| $ 20)))) - (RETURN NIL)) - (T (COND - ((SPADCALL |u| |v| (|shellEntry| $ 68)) - (RETURN-FROM |URAGG-;node?;2AB;24| T)) - ((AND (EQL |k| 1000) - (SPADCALL |v| (|shellEntry| $ 48))) - (|error| "cyclic list")) - (T (SETQ |v| (SPADCALL |v| (|shellEntry| $ 14))))))) - (SETQ |k| (+ |k| 1)))) - (EXIT (SPADCALL |u| |v| (|shellEntry| $ 68))))) - -(DEFUN |URAGG-;setelt;Afirst2S;25| (|x| T3 |a| $) - (SPADCALL |x| |a| (|shellEntry| $ 70))) - -(DEFUN |URAGG-;setelt;Alast2S;26| (|x| T4 |a| $) - (SPADCALL |x| |a| (|shellEntry| $ 72))) - -(DEFUN |URAGG-;setelt;Arest2A;27| (|x| T5 |a| $) - (SPADCALL |x| |a| (|shellEntry| $ 74))) - -(DEFUN |URAGG-;concat;3A;28| (|x| |y| $) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 63)) |y| (|shellEntry| $ 76))) - -(DEFUN |URAGG-;setlast!;A2S;29| (|x| |s| $) - (COND - ((SPADCALL |x| (|shellEntry| $ 20)) - (|error| "setlast: empty list")) - (T (SEQ (SPADCALL (SPADCALL |x| (|shellEntry| $ 24)) |s| - (|shellEntry| $ 70)) - (EXIT |s|))))) - -(DEFUN |URAGG-;setchildren!;ALA;30| (|u| |lv| $) - (COND - ((EQL (LIST-LENGTH |lv|) 1) - (SPADCALL |u| (|SPADfirst| |lv|) (|shellEntry| $ 74))) - (T (|error| "wrong number of children specified")))) - -(DEFUN |URAGG-;setvalue!;A2S;31| (|u| |s| $) - (SPADCALL |u| |s| (|shellEntry| $ 70))) - -(DEFUN |URAGG-;split!;AIA;32| (|p| |n| $) - (PROG (|q|) - (RETURN - (COND - ((< |n| 1) (|error| "index out of range")) - (T (SEQ (SETQ |p| - (SPADCALL |p| - (LET ((#0=#:G1503 (- |n| 1))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|shellEntry| $ 62))) - (LETT |q| (SPADCALL |p| (|shellEntry| $ 14)) - |URAGG-;split!;AIA;32|) - (SPADCALL |p| (SPADCALL (|shellEntry| $ 84)) - (|shellEntry| $ 74)) - (EXIT |q|))))))) - -(DEFUN |URAGG-;cycleSplit!;2A;33| (|x| $) - (PROG (|y| |z|) - (RETURN - (COND - ((OR (SPADCALL - (LETT |y| (SPADCALL |x| (|shellEntry| $ 55)) - |URAGG-;cycleSplit!;2A;33|) - (|shellEntry| $ 20)) - (SPADCALL |x| |y| (|shellEntry| $ 54))) - |y|) - (T (SEQ (LETT |z| (SPADCALL |x| (|shellEntry| $ 14)) - |URAGG-;cycleSplit!;2A;33|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |z| |y| (|shellEntry| $ 54)))) - (RETURN NIL)) - (T (SEQ (SETQ |x| |z|) - (EXIT (SETQ |z| - (SPADCALL |z| - (|shellEntry| $ 14)))))))) - (SPADCALL |x| (SPADCALL (|shellEntry| $ 84)) - (|shellEntry| $ 74)) - (EXIT |y|))))))) - -(DEFUN |UnaryRecursiveAggregate&| (|#1| |#2|) - (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) - (|dv$| (LIST '|UnaryRecursiveAggregate&| |dv$1| |dv$2|)) - ($ (|newShell| 88)) - (|pv$| (|buildPredVector| 0 0 - (LIST (|HasAttribute| |#1| '|shallowlyMutable|))))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (SETF (|shellEntry| $ 7) |#2|) - (COND - ((|HasAttribute| |#1| '|finiteAggregate|) - (SETF (|shellEntry| $ 64) - (CONS (|dispatchFunction| |URAGG-;last;ANniA;22|) $)))) - (COND - ((|HasCategory| |#2| '(|SetCategory|)) - (PROGN - (SETF (|shellEntry| $ 67) - (CONS (|dispatchFunction| |URAGG-;=;2AB;23|) $)) - (SETF (|shellEntry| $ 69) - (CONS (|dispatchFunction| |URAGG-;node?;2AB;24|) $))))) - (COND - ((|testBitVector| |pv$| 1) - (PROGN - (SETF (|shellEntry| $ 71) - (CONS (|dispatchFunction| |URAGG-;setelt;Afirst2S;25|) - $)) - (SETF (|shellEntry| $ 73) - (CONS (|dispatchFunction| |URAGG-;setelt;Alast2S;26|) $)) - (SETF (|shellEntry| $ 75) - (CONS (|dispatchFunction| |URAGG-;setelt;Arest2A;27|) $)) - (SETF (|shellEntry| $ 77) - (CONS (|dispatchFunction| |URAGG-;concat;3A;28|) $)) - (SETF (|shellEntry| $ 78) - (CONS (|dispatchFunction| |URAGG-;setlast!;A2S;29|) $)) - (SETF (|shellEntry| $ 81) - (CONS (|dispatchFunction| |URAGG-;setchildren!;ALA;30|) - $)) - (SETF (|shellEntry| $ 82) - (CONS (|dispatchFunction| |URAGG-;setvalue!;A2S;31|) $)) - (SETF (|shellEntry| $ 85) - (CONS (|dispatchFunction| |URAGG-;split!;AIA;32|) $)) - (SETF (|shellEntry| $ 86) - (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 . |false|) (24 . |not|) |URAGG-;cyclic?;AB;6| - (29 . |tail|) |URAGG-;last;AS;7| (|List| 6) (34 . |empty|) - (38 . |concat|) (44 . |reverse!|) (|List| $) - |URAGG-;nodes;AL;8| |URAGG-;children;AL;9| - |URAGG-;leaf?;AB;10| |URAGG-;value;AS;11| - (|NonNegativeInteger|) (49 . |Zero|) (|Integer|) - (53 . |Zero|) (57 . >) (63 . |One|) (67 . |One|) (71 . -) - |URAGG-;less?;ANniB;12| (77 . |zero?|) - |URAGG-;more?;ANniB;13| |URAGG-;size?;ANniB;14| (82 . =) - (88 . |cyclic?|) (|PositiveInteger|) (93 . |One|) (97 . +) - |URAGG-;#;ANni;15| |URAGG-;tail;2A;16| (103 . |eq?|) - (109 . |cycleEntry|) |URAGG-;cycleTail;2A;18| - |URAGG-;cycleEntry;2A;19| |URAGG-;cycleLength;ANni;20| - |URAGG-;rest;ANniA;21| (114 . |#|) (119 . >) - (125 . |rest|) (131 . |copy|) (136 . |last|) - (142 . |true|) (146 . ~=) (152 . =) (158 . =) - (164 . |node?|) (170 . |setfirst!|) (176 . |setelt|) - (183 . |setlast!|) (189 . |setelt|) (196 . |setrest!|) - (202 . |setelt|) (209 . |concat!|) (215 . |concat|) - (221 . |setlast!|) (227 . |#|) (232 . |first|) - (237 . |setchildren!|) (243 . |setvalue!|) (249 . <) - (255 . |empty|) (259 . |split!|) (265 . |cycleSplit!|) - '"value") - '#(|value| 270 |third| 275 |tail| 280 |split!| 285 |size?| - 291 |setvalue!| 297 |setlast!| 303 |setelt| 309 - |setchildren!| 330 |second| 336 |rest| 341 |nodes| 347 - |node?| 352 |more?| 358 |less?| 364 |leaf?| 370 |last| 375 - |elt| 386 |cyclic?| 404 |cycleTail| 409 |cycleSplit!| 414 - |cycleLength| 419 |cycleEntry| 424 |concat| 429 |children| - 435 = 440 |#| 446) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 86 - '(1 6 7 0 8 1 6 7 0 11 1 6 0 0 14 1 6 - 19 0 20 0 19 0 21 1 19 0 0 22 1 6 0 0 - 24 0 26 0 27 2 26 0 6 0 28 1 26 0 0 - 29 0 35 0 36 0 37 0 38 2 37 19 0 0 39 - 0 35 0 40 0 37 0 41 2 37 0 0 0 42 1 - 37 19 0 44 2 35 19 0 0 47 1 6 19 0 48 - 0 49 0 50 2 35 0 0 0 51 2 6 19 0 0 54 - 1 6 0 0 55 1 6 35 0 60 2 35 19 0 0 61 - 2 6 0 0 35 62 1 6 0 0 63 2 0 0 0 35 - 64 0 19 0 65 2 7 19 0 0 66 2 0 19 0 0 - 67 2 6 19 0 0 68 2 0 19 0 0 69 2 6 7 - 0 7 70 3 0 7 0 9 7 71 2 6 7 0 7 72 3 - 0 7 0 12 7 73 2 6 0 0 0 74 3 0 0 0 15 - 0 75 2 6 0 0 0 76 2 0 0 0 0 77 2 0 7 - 0 7 78 1 26 35 0 79 1 26 6 0 80 2 0 0 - 0 30 81 2 0 7 0 7 82 2 37 19 0 0 83 0 - 6 0 84 2 0 0 0 37 85 1 0 0 0 86 1 0 7 - 0 34 1 0 7 0 18 1 0 0 0 53 2 0 0 0 37 - 85 2 0 19 0 35 46 2 0 7 0 7 82 2 0 7 - 0 7 78 3 0 7 0 12 7 73 3 0 7 0 9 7 71 - 3 0 0 0 15 0 75 2 0 0 0 30 81 1 0 7 0 - 17 2 0 0 0 35 59 1 0 30 0 31 2 0 19 0 - 0 69 2 0 19 0 35 45 2 0 19 0 35 43 1 - 0 19 0 33 2 0 0 0 35 64 1 0 7 0 25 2 - 0 7 0 12 13 2 0 0 0 15 16 2 0 7 0 9 - 10 1 0 19 0 23 1 0 0 0 56 1 0 0 0 86 - 1 0 35 0 58 1 0 0 0 57 2 0 0 0 0 77 1 - 0 30 0 32 2 0 19 0 0 67 1 0 35 0 52))))) - '|lookupComplete|)) diff --git a/src/algebra/strap/URAGG.lsp b/src/algebra/strap/URAGG.lsp deleted file mode 100644 index 2ce314eb..00000000 --- a/src/algebra/strap/URAGG.lsp +++ /dev/null @@ -1,91 +0,0 @@ - -(/VERSIONCHECK 2) - -(DEFPARAMETER |UnaryRecursiveAggregate;CAT| 'NIL) - -(DEFPARAMETER |UnaryRecursiveAggregate;AL| 'NIL) - -(DEFUN |UnaryRecursiveAggregate;| (|t#1|) - (LET ((#0=#:G1400 - (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (COND - (|UnaryRecursiveAggregate;CAT|) - (T (SETQ |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)))))))) - (SETF (|shellEntry| #0# 0) - (LIST '|UnaryRecursiveAggregate| (|devaluate| |t#1|))) - #0#)) - -(DEFUN |UnaryRecursiveAggregate| (#0=#:G1401) - (LET ((#1=#:G1402 - (|assoc| (|devaluate| #0#) |UnaryRecursiveAggregate;AL|))) - (COND - (#1# (CDR #1#)) - (T (PROGN - (SETQ #1# (|UnaryRecursiveAggregate;| #0#)) - (SETQ |UnaryRecursiveAggregate;AL| - (|cons5| (CONS (|devaluate| #0#) #1#) - |UnaryRecursiveAggregate;AL|)) - #1#))))) diff --git a/src/algebra/strap/VECTOR.lsp b/src/algebra/strap/VECTOR.lsp deleted file mode 100644 index 2c8e5eac..00000000 --- a/src/algebra/strap/VECTOR.lsp +++ /dev/null @@ -1,143 +0,0 @@ - -(/VERSIONCHECK 2) - -(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) - |VECTOR;vector;L$;1|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|) - |VECTOR;maxIndex;$I;2|)) - -(PUT '|VECTOR;maxIndex;$I;2| '|SPADreplace| '|sizeOfSimpleArray|) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) - |VECTOR;convert;$If;3|)) - -(DEFUN |VECTOR;vector;L$;1| (|l| $) - (SPADCALL |l| (|shellEntry| $ 10))) - -(DEFUN |VECTOR;maxIndex;$I;2| (|x| $) - (DECLARE (IGNORE $)) - (|sizeOfSimpleArray| |x|)) - -(DEFUN |VECTOR;convert;$If;3| (|x| $) - (SPADCALL - (LIST (SPADCALL '|vector| (|shellEntry| $ 15)) - (SPADCALL (SPADCALL |x| (|shellEntry| $ 16)) - (|shellEntry| $ 17))) - (|shellEntry| $ 19))) - -(DEFUN |Vector| (#0=#:G1383) - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET ((#1=#:G1384 - (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) - (HGET |$ConstructorCache| '|Vector|) - '|domainEqualList|))) - (COND - (#1# (|CDRwithIncrement| #1#)) - (T (UNWIND-PROTECT - (PROG1 (|Vector;| #0#) (SETQ #1# T)) - (COND ((NOT #1#) (HREM |$ConstructorCache| '|Vector|)))))))) - -(DEFUN |Vector;| (|#1|) - (DECLARE (SPECIAL |$ConstructorCache|)) - (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$| (LIST '|Vector| |dv$1|)) - ($ (|newShell| 37)) - (|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|)) - (OR (|HasCategory| |#1| '(|BasicType|)) - (|HasCategory| |#1| '(|OrderedSet|)) - (|HasCategory| |#1| '(|SetCategory|))) - (|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|))) - (|HasCategory| |#1| - '(|CoercibleTo| (|OutputForm|))) - (|HasCategory| |#1| '(|BasicType|)) - (AND (|HasCategory| |#1| '(|SetCategory|)) - (|HasCategory| |#1| - (LIST '|Evalable| - (|devaluate| |#1|)))))))) - (SETF (|shellEntry| $ 0) |dv$|) - (SETF (|shellEntry| $ 3) |pv$|) - (|haddProp| |$ConstructorCache| '|Vector| (LIST |dv$1|) (CONS 1 $)) - (|stuffDomainSlots| $) - (SETF (|shellEntry| $ 6) |#1|) - (COND - ((|testBitVector| |pv$| 3) - (SETF (|shellEntry| $ 20) - (CONS (|dispatchFunction| |VECTOR;convert;$If;3|) $)))) - $)) - -(MAKEPROP '|Vector| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL (|IndexedVector| 6 (NRTEVAL 1)) - (|local| |#1|) (|Integer|) (0 . |One|) (|List| 6) - (4 . |construct|) |VECTOR;vector;L$;1| - |VECTOR;maxIndex;$I;2| (|Symbol|) (|InputForm|) - (9 . |convert|) (14 . |parts|) (19 . |convert|) (|List| $) - (24 . |convert|) (29 . |convert|) (|Mapping| 6 6 6) - (|Boolean|) (|NonNegativeInteger|) (|Equation| 6) - (|List| 24) (|Mapping| 22 6) (|Mapping| 22 6 6) - (|UniversalSegment| 7) (|Void|) (|Mapping| 6 6) - (|OutputForm|) (|Matrix| 6) (|String|) (|SingleInteger|) - (|Union| 6 '"failed") (|List| 7)) - '#(|vector| 34 |parts| 39 |maxIndex| 44 |convert| 49 - |construct| 54) - '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) - (CONS (|makeByteWordVec2| 6 - '(0 0 0 0 0 0 0 5 0 4 5 0 0 0 1 6 0 1 2 3)) - (CONS '#(|VectorCategory&| - |OneDimensionalArrayAggregate&| - |FiniteLinearAggregate&| |LinearAggregate&| - |IndexedAggregate&| |Collection&| - |HomogeneousAggregate&| NIL - |EltableAggregate&| |SetCategory&| - |OrderedType&| NIL |Aggregate&| NIL - |Evalable&| |BasicType&| NIL |InnerEvalable&| - NIL NIL) - (CONS '#((|VectorCategory| 6) - (|OneDimensionalArrayAggregate| 6) - (|FiniteLinearAggregate| 6) - (|LinearAggregate| 6) - (|IndexedAggregate| 7 6) - (|Collection| 6) - (|HomogeneousAggregate| 6) - (|OrderedSet|) (|EltableAggregate| 7 6) - (|SetCategory|) (|OrderedType|) - (|Eltable| 28 $$) (|Aggregate|) - (|Eltable| 7 6) (|Evalable| 6) - (|BasicType|) (|Type|) - (|InnerEvalable| 6 6) (|CoercibleTo| 31) - (|ConvertibleTo| 14)) - (|makeByteWordVec2| 20 - '(0 7 0 8 1 0 0 9 10 1 14 0 13 15 1 0 9 - 0 16 1 9 14 0 17 1 14 0 18 19 1 0 14 - 0 20 1 0 0 9 11 1 0 9 0 16 1 7 7 0 12 - 1 3 14 0 20 1 0 0 9 10))))) - '|lookupIncomplete|)) diff --git a/src/algebra/string.spad.pamphlet b/src/algebra/string.spad.pamphlet index 82b60fb4..54c0a14f 100644 --- a/src/algebra/string.spad.pamphlet +++ b/src/algebra/string.spad.pamphlet @@ -101,6 +101,7 @@ Character: OrderedFinite() with import %ccst: String -> % from Foreign Builtin import %s2c: String -> % from Foreign Builtin import %c2s: % -> String from Foreign Builtin + import %strconc: (String,String) -> String from Foreign Builtin a = b == %ceq(a,b) a < b == %clt(a,b) @@ -133,7 +134,7 @@ Character: OrderedFinite() with alphanumeric? c == member?(c, alphanumeric()) latex c == - concat("\mbox{`", concat(%c2s c, "'}")$String)$String + %strconc("\mbox{`", %strconc(%c2s c, "'}")) char(s: String) == %s2c s diff --git a/src/etc/Makefile.in b/src/etc/Makefile.in index 1d2c05a5..211b41eb 100644 --- a/src/etc/Makefile.in +++ b/src/etc/Makefile.in @@ -34,7 +34,7 @@ DRIVER = ../driver/open-axiom$(EXEEX) INTERPSYS = \ $(DRIVER) --execpath=../interp/interpsys$(EXEEXT) \ --system="$(AXIOM)" \ - --sysalg="$(axiom_src_datadir)/algebra/" + --sysdb="$(axiom_src_datadir)/algebra/" openaxiom_databases = \ $(addprefix $(axiom_targetdir)/algebra/, \ diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index 8934bad6..c751e8d3 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -243,7 +243,7 @@ ${SAVESYS}: database.date \ $(DRIVER) --execpath=$(BOOTSYS) \ --syslib=$(axiom_target_libdir) \ --system="$(AXIOM)/" --system-algebra \ - --sysalg="$(axiom_src_datadir)/algebra/" \ + --sysdb="$(axiom_src_datadir)/algebra/" \ --prologue="(pushnew :open-axiom-basic-system *features*)" \ --make --output=$@ --main="BOOT::|systemMain|" \ --load-directory=. $(OBJS) makeint.$(LNKEXT) diff --git a/src/interp/database.boot b/src/interp/database.boot index cf823270..3e4077a9 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -46,7 +46,7 @@ $globalExposureGroupAlist := [] --% pathToDatabase name == - if dbdir := systemAlgebraDirectory() then + if dbdir := systemDatabaseDirectory() then path := strconc(dbdir,name) if $verbose then FORMAT(true,'" Using local database ~a..",path) diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index 499739b5..ec35299a 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -227,6 +227,7 @@ checkMkdir path == ++ return the pathname to the system module designated by `m'. getSystemModulePath m == + d := systemAlgebraDirectory() => strconc(d,m,'".",$faslType) strconc(systemRootDirectory(),'"algebra/",m,'".",$faslType) ++ load module in `path' that supposedly will define the function |