diff options
Diffstat (limited to 'src/algebra/catdef.spad.pamphlet')
| -rw-r--r-- | src/algebra/catdef.spad.pamphlet | 2276 |
1 files changed, 0 insertions, 2276 deletions
diff --git a/src/algebra/catdef.spad.pamphlet b/src/algebra/catdef.spad.pamphlet index 75c43cae..628130a2 100644 --- a/src/algebra/catdef.spad.pamphlet +++ b/src/algebra/catdef.spad.pamphlet @@ -48,107 +48,7 @@ AbelianGroup(): Category == CancellationAbelianMonoid with double((-n) pretend PositiveInteger,-x) @ -\section{ABELGRP.lsp BOOTSTRAP} -{\bf ABELGRP} depends on a chain of -files. We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf ABELGRP} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf ABELGRP.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. -Note that this code is not included in the generated catdef.spad file. - -<<ABELGRP.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |AbelianGroup;AL| 'NIL) - -(DEFUN |AbelianGroup| () - (LET (#:G1388) - (COND - (|AbelianGroup;AL|) - (T (SETQ |AbelianGroup;AL| (|AbelianGroup;|)))))) - -(DEFUN |AbelianGroup;| () - (PROG (#0=#:G1386) - (RETURN - (PROG1 (LETT #0# - (|Join| (|CancellationAbelianMonoid|) - (|mkCategory| '|domain| - '(((- ($ $)) T) ((- ($ $ $)) T) - ((* ($ (|Integer|) $)) T)) - NIL '((|Integer|)) NIL)) - |AbelianGroup|) - (SETELT #0# 0 '(|AbelianGroup|)))))) - -(MAKEPROP '|AbelianGroup| 'NILADIC T) -@ -\section{ABELGRP-.lsp BOOTSTRAP} -{\bf ABELGRP-} depends on a chain of files. -We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ABELGRP-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ABELGRP-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<ABELGRP-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |ABELGRP-;-;3S;1| (|x| |y| $) - (SPADCALL |x| (SPADCALL |y| (QREFELT $ 7)) (QREFELT $ 8))) - -(DEFUN |ABELGRP-;subtractIfCan;2SU;2| (|x| |y| $) - (CONS 0 (SPADCALL |x| |y| (QREFELT $ 10)))) - -(DEFUN |ABELGRP-;*;Nni2S;3| (|n| |x| $) - (SPADCALL |n| |x| (QREFELT $ 14))) - -(DEFUN |ABELGRP-;*;I2S;4| (|n| |x| $) - (COND - ((ZEROP |n|) (|spadConstant| $ 17)) - ((< 0 |n|) (SPADCALL |n| |x| (QREFELT $ 20))) - ('T (SPADCALL (- |n|) (SPADCALL |x| (QREFELT $ 7)) (QREFELT $ 20))))) - -(DEFUN |AbelianGroup&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|AbelianGroup&|)) - (LETT |dv$| (LIST '|AbelianGroup&| |dv$1|) . #0#) - (LETT $ (GETREFV 22) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (COND - ((|HasCategory| |#1| '(|Ring|))) - ('T - (QSETREFV $ 21 - (CONS (|dispatchFunction| |ABELGRP-;*;I2S;4|) $)))) - $)))) - -(MAKEPROP '|AbelianGroup&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . -) (5 . +) - |ABELGRP-;-;3S;1| (11 . -) (|Union| $ '"failed") - |ABELGRP-;subtractIfCan;2SU;2| (|Integer|) (17 . *) - (|NonNegativeInteger|) |ABELGRP-;*;Nni2S;3| (23 . |Zero|) - (|PositiveInteger|) (|RepeatedDoubling| 6) (27 . |double|) - (33 . *)) - '#(|subtractIfCan| 39 - 45 * 51) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 21 - '(1 6 0 0 7 2 6 0 0 0 8 2 6 0 0 0 10 2 - 6 0 13 0 14 0 6 0 17 2 19 6 18 6 20 2 - 0 0 13 0 21 2 0 11 0 0 12 2 0 0 0 0 9 - 2 0 0 13 0 21 2 0 0 15 0 16))))) - '|lookupComplete|)) -@ \section{category ABELMON AbelianMonoid} <<category ABELMON AbelianMonoid>>= )abbrev category ABELMON AbelianMonoid @@ -191,131 +91,8 @@ AbelianMonoid(): Category == AbelianSemiGroup with double(n pretend PositiveInteger,x) @ -\section{ABELMON.lsp BOOTSTRAP} -{\bf ABELMON} which needs -{\bf ABELSG} which needs -{\bf SETCAT} which needs -{\bf SINT} which needs -{\bf UFD} which needs -{\bf GCDDOM} which needs -{\bf COMRING} which needs -{\bf RING} which needs -{\bf RNG} which needs -{\bf ABELGRP} which needs -{\bf CABMON} which needs -{\bf ABELMON}. -We break this chain with {\bf ABELMON.lsp} which we -cache here. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ABELMON} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ABELMON.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. -Note that this code is not included in the generated catdef.spad file. -<<ABELMON.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |AbelianMonoid;AL| 'NIL) - -(DEFUN |AbelianMonoid| () - (LET (#:G1388) - (COND - (|AbelianMonoid;AL|) - (T (SETQ |AbelianMonoid;AL| (|AbelianMonoid;|)))))) - -(DEFUN |AbelianMonoid;| () - (PROG (#0=#:G1386) - (RETURN - (PROG1 (LETT #0# - (|Join| (|AbelianSemiGroup|) - (|mkCategory| '|domain| - '(((|Zero| ($) |constant|) T) - ((|sample| ($) |constant|) T) - ((|zero?| ((|Boolean|) $)) T) - ((* ($ (|NonNegativeInteger|) $)) T)) - NIL - '((|NonNegativeInteger|) (|Boolean|)) - NIL)) - |AbelianMonoid|) - (SETELT #0# 0 '(|AbelianMonoid|)))))) - -(MAKEPROP '|AbelianMonoid| 'NILADIC T) -@ -\section{ABELMON-.lsp BOOTSTRAP} -{\bf ABELMON-} which needs -{\bf ABELSG} which needs -{\bf SETCAT} which needs -{\bf SINT} which needs -{\bf UFD} which needs -{\bf GCDDOM} which needs -{\bf COMRING} which needs -{\bf RING} which needs -{\bf RNG} which needs -{\bf ABELGRP} which needs -{\bf CABMON} which needs -{\bf ABELMON-}. -We break this chain with {\bf ABELMON-.lsp} which we -cache here. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ABELMON-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ABELMON-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<ABELMON-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |ABELMON-;zero?;SB;1| (|x| $) - (SPADCALL |x| (|spadConstant| $ 7) (QREFELT $ 9))) - -(DEFUN |ABELMON-;*;Pi2S;2| (|n| |x| $) - (SPADCALL |n| |x| (QREFELT $ 12))) - -(DEFUN |ABELMON-;sample;S;3| ($) (|spadConstant| $ 7)) - -(DEFUN |ABELMON-;*;Nni2S;4| (|n| |x| $) - (COND - ((ZEROP |n|) (|spadConstant| $ 7)) - ('T (SPADCALL |n| |x| (QREFELT $ 17))))) - -(DEFUN |AbelianMonoid&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|AbelianMonoid&|)) - (LETT |dv$| (LIST '|AbelianMonoid&| |dv$1|) . #0#) - (LETT $ (GETREFV 19) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (COND - ((|HasCategory| |#1| '(|Ring|))) - ('T - (QSETREFV $ 18 - (CONS (|dispatchFunction| |ABELMON-;*;Nni2S;4|) $)))) - $)))) - -(MAKEPROP '|AbelianMonoid&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|) - (|Boolean|) (4 . =) |ABELMON-;zero?;SB;1| - (|NonNegativeInteger|) (10 . *) (|PositiveInteger|) - |ABELMON-;*;Pi2S;2| |ABELMON-;sample;S;3| - (|RepeatedDoubling| 6) (16 . |double|) (22 . *)) - '#(|zero?| 28 |sample| 33 * 37) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 18 - '(0 6 0 7 2 6 8 0 0 9 2 6 0 11 0 12 2 - 16 6 13 6 17 2 0 0 11 0 18 1 0 8 0 10 - 0 0 0 15 2 0 0 11 0 18 2 0 0 13 0 14))))) - '|lookupComplete|)) -@ \section{category ABELSG AbelianSemiGroup} <<category ABELSG AbelianSemiGroup>>= )abbrev category ABELSG AbelianSemiGroup @@ -347,113 +124,7 @@ AbelianSemiGroup(): Category == SetCategory with n:PositiveInteger * x:% == double(n,x) @ -\section{ABELSG.lsp BOOTSTRAP} -{\bf ABELSG} needs -{\bf SETCAT} which needs -{\bf SINT} which needs -{\bf UFD} which needs -{\bf GCDDOM} which needs -{\bf COMRING} which needs -{\bf RING} which needs -{\bf RNG} which needs -{\bf ABELGRP} which needs -{\bf CABMON} which needs -{\bf ABELMON} which needs -{\bf ABELSG}. -We break this chain with {\bf ABELSG.lsp} which we -cache here. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ABELSG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ABELSG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. -Note that this code is not included in the generated catdef.spad file. - -<<ABELSG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |AbelianSemiGroup;AL| 'NIL) - -(DEFUN |AbelianSemiGroup| () - (LET (#:G1387) - (COND - (|AbelianSemiGroup;AL|) - (T (SETQ |AbelianSemiGroup;AL| (|AbelianSemiGroup;|)))))) - -(DEFUN |AbelianSemiGroup;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# - (|Join| (|SetCategory|) - (|mkCategory| '|domain| - '(((+ ($ $ $)) T) - ((* ($ (|PositiveInteger|) $)) T)) - NIL '((|PositiveInteger|)) NIL)) - |AbelianSemiGroup|) - (SETELT #0# 0 '(|AbelianSemiGroup|)))))) - -(MAKEPROP '|AbelianSemiGroup| 'NILADIC T) -@ -\section{ABELSG-.lsp BOOTSTRAP} -{\bf ABELSG-} needs -{\bf SETCAT} which needs -{\bf SINT} which needs -{\bf UFD} which needs -{\bf GCDDOM} which needs -{\bf COMRING} which needs -{\bf RING} which needs -{\bf RNG} which needs -{\bf ABELGRP} which needs -{\bf CABMON} which needs -{\bf ABELMON} which needs -{\bf ABELSG-}. -We break this chain with {\bf ABELSG-.lsp} which we -cache here. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ABELSG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ABELSG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<ABELSG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |ABELSG-;*;Pi2S;1| (|n| |x| $) - (SPADCALL |n| |x| (QREFELT $ 9))) - -(DEFUN |AbelianSemiGroup&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|AbelianSemiGroup&|)) - (LETT |dv$| (LIST '|AbelianSemiGroup&| |dv$1|) . #0#) - (LETT $ (GETREFV 11) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (COND - ((|HasCategory| |#1| '(|Ring|))) - ('T - (QSETREFV $ 10 - (CONS (|dispatchFunction| |ABELSG-;*;Pi2S;1|) $)))) - $)))) - -(MAKEPROP '|AbelianSemiGroup&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|PositiveInteger|) - (|RepeatedDoubling| 6) (0 . |double|) (6 . *)) - '#(* 12) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 10 - '(2 8 6 7 6 9 2 0 0 7 0 10 2 0 0 7 0 - 10))))) - '|lookupComplete|)) -@ \section{category ALGEBRA Algebra} <<category ALGEBRA Algebra>>= )abbrev category ALGEBRA Algebra @@ -558,56 +229,7 @@ CancellationAbelianMonoid(): Category == AbelianMonoid with ++ or "failed" if no such element exists. @ -\section{CABMON.lsp BOOTSTRAP} -{\bf CABMON} which needs -{\bf ABELMON} which needs -{\bf ABELSG} which needs -{\bf SETCAT} which needs -{\bf SINT} which needs -{\bf UFD} which needs -{\bf GCDDOM} which needs -{\bf COMRING} which needs -{\bf RING} which needs -{\bf RNG} which needs -{\bf ABELGRP} which needs -{\bf CABMON}. -We break this chain with {\bf CABMON.lsp} which we -cache here. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf CABMON} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf CABMON.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<CABMON.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) -(DEFPARAMETER |CancellationAbelianMonoid;AL| 'NIL) - -(DEFUN |CancellationAbelianMonoid| () - (LET (#:G1387) - (COND - (|CancellationAbelianMonoid;AL|) - (T (SETQ |CancellationAbelianMonoid;AL| - (|CancellationAbelianMonoid;|)))))) - -(DEFUN |CancellationAbelianMonoid;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# - (|Join| (|AbelianMonoid|) - (|mkCategory| '|domain| - '(((|subtractIfCan| - ((|Union| $ "failed") $ $)) - T)) - NIL 'NIL NIL)) - |CancellationAbelianMonoid|) - (SETELT #0# 0 '(|CancellationAbelianMonoid|)))))) - -(MAKEPROP '|CancellationAbelianMonoid| 'NILADIC T) -@ \section{category CHARNZ CharacteristicNonZero} <<category CHARNZ CharacteristicNonZero>>= )abbrev category CHARNZ CharacteristicNonZero @@ -666,39 +288,7 @@ CommutativeRing():Category == Join(Ring,BiModule(%,%)) with commutative("*") ++ multiplication is commutative. @ -\section{COMRING.lsp BOOTSTRAP} -{\bf COMRING} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf COMRING} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf COMRING.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<COMRING.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |CommutativeRing;AL| 'NIL) -(DEFUN |CommutativeRing| () - (LET (#:G1387) - (COND - (|CommutativeRing;AL|) - (T (SETQ |CommutativeRing;AL| (|CommutativeRing;|)))))) - -(DEFUN |CommutativeRing;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# - (|Join| (|Ring|) (|BiModule| '$ '$) - (|mkCategory| '|package| NIL - '(((|commutative| "*") T)) 'NIL NIL)) - |CommutativeRing|) - (SETELT #0# 0 '(|CommutativeRing|)))))) - -(MAKEPROP '|CommutativeRing| 'NILADIC T) -@ \section{category DIFRING DifferentialRing} <<category DIFRING DifferentialRing>>= )abbrev category DIFRING DifferentialRing @@ -740,104 +330,7 @@ DifferentialRing(): Category == Ring with D(r,n) == differentiate(r,n) @ -\section{DIFRING.lsp BOOTSTRAP} -{\bf DIFRING} needs {\bf INT} which needs {\bf DIFRING}. -We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf DIFRING} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf DIFRING.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<DIFRING.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |DifferentialRing;AL| 'NIL) - -(DEFUN |DifferentialRing| () - (LET (#:G1387) - (COND - (|DifferentialRing;AL|) - (T (SETQ |DifferentialRing;AL| (|DifferentialRing;|)))))) - -(DEFUN |DifferentialRing;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# - (|Join| (|Ring|) - (|mkCategory| '|domain| - '(((|differentiate| ($ $)) T) - ((D ($ $)) T) - ((|differentiate| - ($ $ (|NonNegativeInteger|))) - T) - ((D ($ $ (|NonNegativeInteger|))) T)) - NIL '((|NonNegativeInteger|)) NIL)) - |DifferentialRing|) - (SETELT #0# 0 '(|DifferentialRing|)))))) - -(MAKEPROP '|DifferentialRing| 'NILADIC T) -@ -\section{DIFRING-.lsp BOOTSTRAP} -{\bf DIFRING-} needs {\bf DIFRING}. -We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf DIFRING-} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf DIFRING-.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<DIFRING-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |DIFRING-;D;2S;1| (|r| $) (SPADCALL |r| (QREFELT $ 7))) - -(DEFUN |DIFRING-;differentiate;SNniS;2| (|r| |n| $) - (PROG (|i|) - (RETURN - (SEQ (SEQ (LETT |i| 1 |DIFRING-;differentiate;SNniS;2|) G190 - (COND ((QSGREATERP |i| |n|) (GO G191))) - (SEQ (EXIT (LETT |r| (SPADCALL |r| (QREFELT $ 7)) - |DIFRING-;differentiate;SNniS;2|))) - (LETT |i| (QSADD1 |i|) - |DIFRING-;differentiate;SNniS;2|) - (GO G190) G191 (EXIT NIL)) - (EXIT |r|))))) - -(DEFUN |DIFRING-;D;SNniS;3| (|r| |n| $) - (SPADCALL |r| |n| (QREFELT $ 11))) -(DEFUN |DifferentialRing&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|DifferentialRing&|)) - (LETT |dv$| (LIST '|DifferentialRing&| |dv$1|) . #0#) - (LETT $ (GETREFV 13) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) - -(MAKEPROP '|DifferentialRing&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) - (0 . |differentiate|) |DIFRING-;D;2S;1| - (|NonNegativeInteger|) |DIFRING-;differentiate;SNniS;2| - (5 . |differentiate|) |DIFRING-;D;SNniS;3|) - '#(|differentiate| 11 D 17) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 12 - '(1 6 0 0 7 2 6 0 0 9 11 2 0 0 0 9 10 2 - 0 0 0 9 12 1 0 0 0 8))))) - '|lookupComplete|)) -@ \section{category DIFEXT DifferentialExtension} <<category DIFEXT DifferentialExtension>>= )abbrev category DIFEXT DifferentialExtension @@ -933,113 +426,7 @@ DivisionRing(): Category == q:Fraction(Integer) * x:% == numer(q) * inv(denom(q)::%) * x @ -\section{DIVRING.lsp BOOTSTRAP} -{\bf DIVRING} depends on {\bf QFCAT} which eventually depends on -{\bf DIVRING}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf DIVRING} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf DIVRING.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<DIVRING.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |DivisionRing;AL| 'NIL) - -(DEFUN |DivisionRing| () - (LET (#:G1390) - (COND - (|DivisionRing;AL|) - (T (SETQ |DivisionRing;AL| (|DivisionRing;|)))))) - -(DEFUN |DivisionRing;| () - (PROG (#0=#:G1388) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(#1=#:G1387) - (LIST '(|Fraction| (|Integer|)))) - (|Join| (|EntireRing|) (|Algebra| '#1#) - (|mkCategory| '|domain| - '(((** ($ $ (|Integer|))) T) - ((^ ($ $ (|Integer|))) T) - ((|inv| ($ $)) T)) - NIL '((|Integer|)) NIL))) - |DivisionRing|) - (SETELT #0# 0 '(|DivisionRing|)))))) -(MAKEPROP '|DivisionRing| 'NILADIC T) -@ -\section{DIVRING-.lsp BOOTSTRAP} -{\bf DIVRING-} depends on {\bf DIVRING}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf DIVRING-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf DIVRING-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<DIVRING-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |DIVRING-;^;SIS;1| (|x| |n| $) - (SPADCALL |x| |n| (QREFELT $ 8))) - -(DEFUN |DIVRING-;**;SIS;2| (|x| |n| $) - (COND - ((ZEROP |n|) (|spadConstant| $ 10)) - ((SPADCALL |x| (QREFELT $ 12)) - (COND ((< |n| 0) (|error| "division by zero")) ('T |x|))) - ((< |n| 0) - (SPADCALL (SPADCALL |x| (QREFELT $ 14)) (- |n|) (QREFELT $ 17))) - ('T (SPADCALL |x| |n| (QREFELT $ 17))))) - -(DEFUN |DIVRING-;*;F2S;3| (|q| |x| $) - (SPADCALL - (SPADCALL (SPADCALL |q| (QREFELT $ 20)) - (SPADCALL - (SPADCALL (SPADCALL |q| (QREFELT $ 21)) (QREFELT $ 22)) - (QREFELT $ 14)) - (QREFELT $ 23)) - |x| (QREFELT $ 24))) - -(DEFUN |DivisionRing&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|DivisionRing&|)) - (LETT |dv$| (LIST '|DivisionRing&| |dv$1|) . #0#) - (LETT $ (GETREFV 27) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) - -(MAKEPROP '|DivisionRing&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Integer|) - (0 . **) |DIVRING-;^;SIS;1| (6 . |One|) (|Boolean|) - (10 . |zero?|) (15 . |Zero|) (19 . |inv|) - (|PositiveInteger|) (|RepeatedSquaring| 6) (24 . |expt|) - |DIVRING-;**;SIS;2| (|Fraction| 7) (30 . |numer|) - (35 . |denom|) (40 . |coerce|) (45 . *) (51 . *) - |DIVRING-;*;F2S;3| (|NonNegativeInteger|)) - '#(^ 57 ** 63 * 69) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 25 - '(2 6 0 0 7 8 0 6 0 10 1 6 11 0 12 0 6 - 0 13 1 6 0 0 14 2 16 6 6 15 17 1 19 7 - 0 20 1 19 7 0 21 1 6 0 7 22 2 6 0 7 0 - 23 2 6 0 0 0 24 2 0 0 0 7 9 2 0 0 0 7 - 18 2 0 0 19 0 25))))) - '|lookupComplete|)) -@ \section{category ENTIRER EntireRing} <<category ENTIRER EntireRing>>= )abbrev category ENTIRER EntireRing @@ -1065,39 +452,7 @@ EntireRing():Category == Join(Ring,BiModule(%,%)) with ++ must be zero. @ -\section{ENTIRER.lsp BOOTSTRAP} -{\bf ENTIRER} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ENTIRER} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ENTIRER.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<ENTIRER.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |EntireRing;AL| 'NIL) - -(DEFUN |EntireRing| () - (LET (#:G1387) - (COND - (|EntireRing;AL|) - (T (SETQ |EntireRing;AL| (|EntireRing;|)))))) - -(DEFUN |EntireRing;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# - (|Join| (|Ring|) (|BiModule| '$ '$) - (|mkCategory| '|package| NIL - '((|noZeroDivisors| T)) 'NIL NIL)) - |EntireRing|) - (SETELT #0# 0 '(|EntireRing|)))))) -(MAKEPROP '|EntireRing| 'NILADIC T) -@ \section{category EUCDOM EuclideanDomain} <<category EUCDOM EuclideanDomain>>= )abbrev category EUCDOM EuclideanDomain @@ -1250,656 +605,6 @@ EuclideanDomain(): Category == PrincipalIdealDomain with concat(v1,v2) @ -\section{EUCDOM.lsp BOOTSTRAP} -{\bf EUCDOM} depends on {\bf INT} which depends on {\bf EUCDOM}. -We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf EUCDOM} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf EUCDOM.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -\subsection{The Lisp Implementation} -\subsubsection{EUCDOM;VersionCheck} -This implements the bootstrap code for {\bf EuclideanDomain}. -The call to {\bf VERSIONCHECK} is a legacy check to ensure that -we did not load algebra code from a previous system version (which -would not run due to major surgical changes in the system) without -recompiling. -<<EUCDOM;VersionCheck>>= -(|/VERSIONCHECK| 2) - -@ -\subsubsection{The Domain Cache Variable} -We create a variable which is formed by concatenating the string -``{\bf ;AL}'' to the domain name forming, in this case, -``{\bf EuclideanDomain;AL}''. The variable has the initial value -at load time of a list of one element, {\bf NIL}. This list is -a data structure that will be modified to hold an executable -function. This function is created the first time the domain is -used which it replaces the {\bf NIL}. -<<EuclideanDomain;AL>>= -(DEFPARAMETER |EuclideanDomain;AL| (QUOTE NIL)) - -@ -\subsubsection{The Domain Function} -When you call a domain the code is pretty simple at the top -level. This code will check to see if this domain has ever been -used. It does this by checking the value of the cached domain -variable (which is the domain name {\bf EuclideanDomain} concatenated -with the string ``{\bf ;AL}'' to form the cache variable name which -is {\bf EuclideanDomain;AL}). - -If this value is NIL we have never executed this function -before. If it is not NIL we have executed this function before and -we need only return the cached function which was stored in the -cache variable. - -If this is the first time this function is called, the cache -variable is NIL and we execute the other branch of the conditional. -This calls a function which -\begin{enumerate} -\item creates a procedure -\item returns the procedure as a value. -\end{enumerate} -This procedure replaces the cached variable {\bf EuclideanDomain;AL} -value so it will be non-NIL the second time this domain is used. -Thus the work of building the domain only happens once. - -If this function has never been called before we call the -<<EuclideanDomain>>= -(DEFUN |EuclideanDomain| NIL - (LET (#:G83585) - (COND - (|EuclideanDomain;AL|) - (T (SETQ |EuclideanDomain;AL| (|EuclideanDomain;|)))))) - -@ -\subsubsection{The First Call Domain Function} -<<EuclideanDomain;>>= -(DEFUN |EuclideanDomain;| NIL - (PROG (#1=#:G83583) - (RETURN - (PROG1 - (LETT #1# - (|Join| - (|PrincipalIdealDomain|) - (|mkCategory| - (QUOTE |domain|) - (QUOTE ( - ((|sizeLess?| ((|Boolean|) |$| |$|)) T) - ((|euclideanSize| ((|NonNegativeInteger|) |$|)) T) - ((|divide| - ((|Record| - (|:| |quotient| |$|) - (|:| |remainder| |$|)) - |$| |$|)) T) - ((|quo| (|$| |$| |$|)) T) - ((|rem| (|$| |$| |$|)) T) - ((|extendedEuclidean| - ((|Record| - (|:| |coef1| |$|) - (|:| |coef2| |$|) - (|:| |generator| |$|)) - |$| |$|)) T) - ((|extendedEuclidean| - ((|Union| - (|Record| (|:| |coef1| |$|) (|:| |coef2| |$|)) - "failed") - |$| |$| |$|)) T) - ((|multiEuclidean| - ((|Union| - (|List| |$|) - "failed") - (|List| |$|) |$|)) T))) - NIL - (QUOTE ((|List| |$|) (|NonNegativeInteger|) (|Boolean|))) - NIL)) - |EuclideanDomain|) - (SETELT #1# 0 (QUOTE (|EuclideanDomain|))))))) - -@ -\subsubsection{EUCDOM;MAKEPROP} -<<EUCDOM;MAKEPROP>>= -(MAKEPROP (QUOTE |EuclideanDomain|) (QUOTE NILADIC) T) - -@ -<<EUCDOM.lsp BOOTSTRAP>>= -<<EUCDOM;VersionCheck>> -<<EuclideanDomain;AL>> -<<EuclideanDomain>> -<<EuclideanDomain;>> -<<EUCDOM;MAKEPROP>> -@ -\section{EUCDOM-.lsp BOOTSTRAP} -{\bf EUCDOM-} depends on {\bf EUCDOM}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf EUCDOM-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf EUCDOM-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -<<EUCDOM-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |EUCDOM-;sizeLess?;2SB;1| (|x| |y| $) - (COND - ((SPADCALL |y| (|getShellEntry| $ 8)) 'NIL) - ((SPADCALL |x| (|getShellEntry| $ 8)) 'T) - ('T - (< (SPADCALL |x| (|getShellEntry| $ 10)) - (SPADCALL |y| (|getShellEntry| $ 10)))))) - -(DEFUN |EUCDOM-;quo;3S;2| (|x| |y| $) - (QCAR (SPADCALL |x| |y| (|getShellEntry| $ 13)))) - -(DEFUN |EUCDOM-;rem;3S;3| (|x| |y| $) - (QCDR (SPADCALL |x| |y| (|getShellEntry| $ 13)))) - -(DEFUN |EUCDOM-;exquo;2SU;4| (|x| |y| $) - (PROG (|qr|) - (RETURN - (SEQ (COND - ((SPADCALL |y| (|getShellEntry| $ 8)) (CONS 1 "failed")) - ('T - (SEQ (LETT |qr| (SPADCALL |x| |y| (|getShellEntry| $ 13)) - |EUCDOM-;exquo;2SU;4|) - (EXIT (COND - ((SPADCALL (QCDR |qr|) - (|getShellEntry| $ 8)) - (CONS 0 (QCAR |qr|))) - ('T (CONS 1 "failed"))))))))))) - -(DEFUN |EUCDOM-;gcd;3S;5| (|x| |y| $) - (PROG (|#G13| |#G14|) - (RETURN - (SEQ (LETT |x| (SPADCALL |x| (|getShellEntry| $ 18)) - |EUCDOM-;gcd;3S;5|) - (LETT |y| (SPADCALL |y| (|getShellEntry| $ 18)) - |EUCDOM-;gcd;3S;5|) - (SEQ G190 - (COND - ((NULL (SPADCALL (SPADCALL |y| (|getShellEntry| $ 8)) - (|getShellEntry| $ 19))) - (GO G191))) - (SEQ (PROGN - (LETT |#G13| |y| |EUCDOM-;gcd;3S;5|) - (LETT |#G14| - (SPADCALL |x| |y| (|getShellEntry| $ 20)) - |EUCDOM-;gcd;3S;5|) - (LETT |x| |#G13| |EUCDOM-;gcd;3S;5|) - (LETT |y| |#G14| |EUCDOM-;gcd;3S;5|)) - (EXIT (LETT |y| - (SPADCALL |y| (|getShellEntry| $ 18)) - |EUCDOM-;gcd;3S;5|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |x|))))) - -(DEFUN |EUCDOM-;unitNormalizeIdealElt| (|s| $) - (PROG (|#G16| |u| |c| |a|) - (RETURN - (SEQ (PROGN - (LETT |#G16| - (SPADCALL (QVELT |s| 2) (|getShellEntry| $ 23)) - |EUCDOM-;unitNormalizeIdealElt|) - (LETT |u| (QVELT |#G16| 0) - |EUCDOM-;unitNormalizeIdealElt|) - (LETT |c| (QVELT |#G16| 1) - |EUCDOM-;unitNormalizeIdealElt|) - (LETT |a| (QVELT |#G16| 2) - |EUCDOM-;unitNormalizeIdealElt|) - |#G16|) - (EXIT (COND - ((SPADCALL |a| (|spadConstant| $ 24) - (|getShellEntry| $ 25)) - |s|) - ('T - (VECTOR (SPADCALL |a| (QVELT |s| 0) - (|getShellEntry| $ 26)) - (SPADCALL |a| (QVELT |s| 1) - (|getShellEntry| $ 26)) - |c|)))))))) - -(DEFUN |EUCDOM-;extendedEuclidean;2SR;7| (|x| |y| $) - (PROG (|s3| |s2| |qr| |s1|) - (RETURN - (SEQ (LETT |s1| - (|EUCDOM-;unitNormalizeIdealElt| - (VECTOR (|spadConstant| $ 24) - (|spadConstant| $ 27) |x|) - $) - |EUCDOM-;extendedEuclidean;2SR;7|) - (LETT |s2| - (|EUCDOM-;unitNormalizeIdealElt| - (VECTOR (|spadConstant| $ 27) - (|spadConstant| $ 24) |y|) - $) - |EUCDOM-;extendedEuclidean;2SR;7|) - (EXIT (COND - ((SPADCALL |y| (|getShellEntry| $ 8)) |s1|) - ((SPADCALL |x| (|getShellEntry| $ 8)) |s2|) - ('T - (SEQ (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL (QVELT |s2| 2) - (|getShellEntry| $ 8)) - (|getShellEntry| $ 19))) - (GO G191))) - (SEQ (LETT |qr| - (SPADCALL (QVELT |s1| 2) - (QVELT |s2| 2) - (|getShellEntry| $ 13)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (LETT |s3| - (VECTOR - (SPADCALL (QVELT |s1| 0) - (SPADCALL (QCAR |qr|) - (QVELT |s2| 0) - (|getShellEntry| $ 26)) - (|getShellEntry| $ 28)) - (SPADCALL (QVELT |s1| 1) - (SPADCALL (QCAR |qr|) - (QVELT |s2| 1) - (|getShellEntry| $ 26)) - (|getShellEntry| $ 28)) - (QCDR |qr|)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (LETT |s1| |s2| - |EUCDOM-;extendedEuclidean;2SR;7|) - (EXIT - (LETT |s2| - (|EUCDOM-;unitNormalizeIdealElt| - |s3| $) - |EUCDOM-;extendedEuclidean;2SR;7|))) - NIL (GO G190) G191 (EXIT NIL)) - (COND - ((NULL (SPADCALL (QVELT |s1| 0) - (|getShellEntry| $ 8))) - (COND - ((NULL (SPADCALL (QVELT |s1| 0) |y| - (|getShellEntry| $ 29))) - (SEQ (LETT |qr| - (SPADCALL (QVELT |s1| 0) |y| - (|getShellEntry| $ 13)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (QSETVELT |s1| 0 (QCDR |qr|)) - (QSETVELT |s1| 1 - (SPADCALL (QVELT |s1| 1) - (SPADCALL (QCAR |qr|) |x| - (|getShellEntry| $ 26)) - (|getShellEntry| $ 30))) - (EXIT - (LETT |s1| - (|EUCDOM-;unitNormalizeIdealElt| - |s1| $) - |EUCDOM-;extendedEuclidean;2SR;7|))))))) - (EXIT |s1|))))))))) - -(DEFUN |EUCDOM-;extendedEuclidean;3SU;8| (|x| |y| |z| $) - (PROG (|s| |w| |qr|) - (RETURN - (SEQ (COND - ((SPADCALL |z| (|getShellEntry| $ 8)) - (CONS 0 - (CONS (|spadConstant| $ 27) (|spadConstant| $ 27)))) - ('T - (SEQ (LETT |s| (SPADCALL |x| |y| (|getShellEntry| $ 33)) - |EUCDOM-;extendedEuclidean;3SU;8|) - (LETT |w| - (SPADCALL |z| (QVELT |s| 2) - (|getShellEntry| $ 34)) - |EUCDOM-;extendedEuclidean;3SU;8|) - (EXIT (COND - ((QEQCAR |w| 1) (CONS 1 "failed")) - ((SPADCALL |y| (|getShellEntry| $ 8)) - (CONS 0 - (CONS (SPADCALL (QVELT |s| 0) - (QCDR |w|) - (|getShellEntry| $ 26)) - (SPADCALL (QVELT |s| 1) - (QCDR |w|) - (|getShellEntry| $ 26))))) - ('T - (SEQ (LETT |qr| - (SPADCALL - (SPADCALL (QVELT |s| 0) - (QCDR |w|) - (|getShellEntry| $ 26)) - |y| (|getShellEntry| $ 13)) - |EUCDOM-;extendedEuclidean;3SU;8|) - (EXIT (CONS 0 - (CONS (QCDR |qr|) - (SPADCALL - (SPADCALL (QVELT |s| 1) - (QCDR |w|) - (|getShellEntry| $ 26)) - (SPADCALL (QCAR |qr|) |x| - (|getShellEntry| $ 26)) - (|getShellEntry| $ 30)))))))))))))))) - -(DEFUN |EUCDOM-;principalIdeal;LR;9| (|l| $) - (PROG (|uca| |v| |u| #0=#:G1478 |vv| #1=#:G1479) - (RETURN - (SEQ (COND - ((SPADCALL |l| NIL (|getShellEntry| $ 39)) - (|error| "empty list passed to principalIdeal")) - ((SPADCALL (CDR |l|) NIL (|getShellEntry| $ 39)) - (SEQ (LETT |uca| - (SPADCALL (|SPADfirst| |l|) - (|getShellEntry| $ 23)) - |EUCDOM-;principalIdeal;LR;9|) - (EXIT (CONS (LIST (QVELT |uca| 0)) (QVELT |uca| 1))))) - ((SPADCALL (CDR (CDR |l|)) NIL (|getShellEntry| $ 39)) - (SEQ (LETT |u| - (SPADCALL (|SPADfirst| |l|) - (SPADCALL |l| (|getShellEntry| $ 40)) - (|getShellEntry| $ 33)) - |EUCDOM-;principalIdeal;LR;9|) - (EXIT (CONS (LIST (QVELT |u| 0) (QVELT |u| 1)) - (QVELT |u| 2))))) - ('T - (SEQ (LETT |v| - (SPADCALL (CDR |l|) (|getShellEntry| $ 43)) - |EUCDOM-;principalIdeal;LR;9|) - (LETT |u| - (SPADCALL (|SPADfirst| |l|) (QCDR |v|) - (|getShellEntry| $ 33)) - |EUCDOM-;principalIdeal;LR;9|) - (EXIT (CONS (CONS (QVELT |u| 0) - (PROGN - (LETT #0# NIL - |EUCDOM-;principalIdeal;LR;9|) - (SEQ - (LETT |vv| NIL - |EUCDOM-;principalIdeal;LR;9|) - (LETT #1# (QCAR |v|) - |EUCDOM-;principalIdeal;LR;9|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |vv| (CAR #1#) - |EUCDOM-;principalIdeal;LR;9|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (LETT #0# - (CONS - (SPADCALL (QVELT |u| 1) - |vv| - (|getShellEntry| $ 26)) - #0#) - |EUCDOM-;principalIdeal;LR;9|))) - (LETT #1# (CDR #1#) - |EUCDOM-;principalIdeal;LR;9|) - (GO G190) G191 - (EXIT (NREVERSE0 #0#))))) - (QVELT |u| 2)))))))))) - -(DEFUN |EUCDOM-;expressIdealMember;LSU;10| (|l| |z| $) - (PROG (#0=#:G1494 #1=#:G1495 |pid| |q| #2=#:G1496 |v| #3=#:G1497) - (RETURN - (SEQ (COND - ((SPADCALL |z| (|spadConstant| $ 27) - (|getShellEntry| $ 25)) - (CONS 0 - (PROGN - (LETT #0# NIL - |EUCDOM-;expressIdealMember;LSU;10|) - (SEQ (LETT |v| NIL - |EUCDOM-;expressIdealMember;LSU;10|) - (LETT #1# |l| - |EUCDOM-;expressIdealMember;LSU;10|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |v| (CAR #1#) - |EUCDOM-;expressIdealMember;LSU;10|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS (|spadConstant| $ 27) #0#) - |EUCDOM-;expressIdealMember;LSU;10|))) - (LETT #1# (CDR #1#) - |EUCDOM-;expressIdealMember;LSU;10|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))))) - ('T - (SEQ (LETT |pid| (SPADCALL |l| (|getShellEntry| $ 43)) - |EUCDOM-;expressIdealMember;LSU;10|) - (LETT |q| - (SPADCALL |z| (QCDR |pid|) - (|getShellEntry| $ 34)) - |EUCDOM-;expressIdealMember;LSU;10|) - (EXIT (COND - ((QEQCAR |q| 1) (CONS 1 "failed")) - ('T - (CONS 0 - (PROGN - (LETT #2# NIL - |EUCDOM-;expressIdealMember;LSU;10|) - (SEQ - (LETT |v| NIL - |EUCDOM-;expressIdealMember;LSU;10|) - (LETT #3# (QCAR |pid|) - |EUCDOM-;expressIdealMember;LSU;10|) - G190 - (COND - ((OR (ATOM #3#) - (PROGN - (LETT |v| (CAR #3#) - |EUCDOM-;expressIdealMember;LSU;10|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (LETT #2# - (CONS - (SPADCALL (QCDR |q|) |v| - (|getShellEntry| $ 26)) - #2#) - |EUCDOM-;expressIdealMember;LSU;10|))) - (LETT #3# (CDR #3#) - |EUCDOM-;expressIdealMember;LSU;10|) - (GO G190) G191 - (EXIT (NREVERSE0 #2#))))))))))))))) - -(DEFUN |EUCDOM-;multiEuclidean;LSU;11| (|l| |z| $) - (PROG (|n| |l1| |l2| #0=#:G1392 #1=#:G1516 #2=#:G1503 #3=#:G1501 - #4=#:G1502 #5=#:G1393 #6=#:G1517 #7=#:G1506 #8=#:G1504 - #9=#:G1505 |u| |v1| |v2|) - (RETURN - (SEQ (LETT |n| (LENGTH |l|) |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT (COND - ((ZEROP |n|) - (|error| "empty list passed to multiEuclidean")) - ((EQL |n| 1) (CONS 0 (LIST |z|))) - ('T - (SEQ (LETT |l1| - (SPADCALL |l| (|getShellEntry| $ 47)) - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT |l2| - (SPADCALL |l1| (QUOTIENT2 |n| 2) - (|getShellEntry| $ 49)) - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT |u| - (SPADCALL - (PROGN - (LETT #4# NIL - |EUCDOM-;multiEuclidean;LSU;11|) - (SEQ - (LETT #0# NIL - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT #1# |l1| - |EUCDOM-;multiEuclidean;LSU;11|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT #0# (CAR #1#) - |EUCDOM-;multiEuclidean;LSU;11|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (PROGN - (LETT #2# #0# - |EUCDOM-;multiEuclidean;LSU;11|) - (COND - (#4# - (LETT #3# - (SPADCALL #3# #2# - (|getShellEntry| $ 26)) - |EUCDOM-;multiEuclidean;LSU;11|)) - ('T - (PROGN - (LETT #3# #2# - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT #4# 'T - |EUCDOM-;multiEuclidean;LSU;11|))))))) - (LETT #1# (CDR #1#) - |EUCDOM-;multiEuclidean;LSU;11|) - (GO G190) G191 (EXIT NIL)) - (COND - (#4# #3#) - ('T (|spadConstant| $ 24)))) - (PROGN - (LETT #9# NIL - |EUCDOM-;multiEuclidean;LSU;11|) - (SEQ - (LETT #5# NIL - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT #6# |l2| - |EUCDOM-;multiEuclidean;LSU;11|) - G190 - (COND - ((OR (ATOM #6#) - (PROGN - (LETT #5# (CAR #6#) - |EUCDOM-;multiEuclidean;LSU;11|) - NIL)) - (GO G191))) - (SEQ - (EXIT - (PROGN - (LETT #7# #5# - |EUCDOM-;multiEuclidean;LSU;11|) - (COND - (#9# - (LETT #8# - (SPADCALL #8# #7# - (|getShellEntry| $ 26)) - |EUCDOM-;multiEuclidean;LSU;11|)) - ('T - (PROGN - (LETT #8# #7# - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT #9# 'T - |EUCDOM-;multiEuclidean;LSU;11|))))))) - (LETT #6# (CDR #6#) - |EUCDOM-;multiEuclidean;LSU;11|) - (GO G190) G191 (EXIT NIL)) - (COND - (#9# #8#) - ('T (|spadConstant| $ 24)))) - |z| (|getShellEntry| $ 50)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT (COND - ((QEQCAR |u| 1) (CONS 1 "failed")) - ('T - (SEQ (LETT |v1| - (SPADCALL |l1| - (QCDR (QCDR |u|)) - (|getShellEntry| $ 51)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT - (COND - ((QEQCAR |v1| 1) - (CONS 1 "failed")) - ('T - (SEQ - (LETT |v2| - (SPADCALL |l2| - (QCAR (QCDR |u|)) - (|getShellEntry| $ 51)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT - (COND - ((QEQCAR |v2| 1) - (CONS 1 "failed")) - ('T - (CONS 0 - (SPADCALL (QCDR |v1|) - (QCDR |v2|) - (|getShellEntry| $ - 52)))))))))))))))))))))) - -(DEFUN |EuclideanDomain&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|EuclideanDomain&|)) - (LETT |dv$| (LIST '|EuclideanDomain&| |dv$1|) . #0#) - (LETT $ (|newShell| 54) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 |#1|) - $)))) - -(MAKEPROP '|EuclideanDomain&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Boolean|) - (0 . |zero?|) (|NonNegativeInteger|) (5 . |euclideanSize|) - |EUCDOM-;sizeLess?;2SB;1| - (|Record| (|:| |quotient| $) (|:| |remainder| $)) - (10 . |divide|) |EUCDOM-;quo;3S;2| |EUCDOM-;rem;3S;3| - (|Union| $ '"failed") |EUCDOM-;exquo;2SU;4| - (16 . |unitCanonical|) (21 . |not|) (26 . |rem|) - |EUCDOM-;gcd;3S;5| - (|Record| (|:| |unit| $) (|:| |canonical| $) - (|:| |associate| $)) - (32 . |unitNormal|) (37 . |One|) (41 . =) (47 . *) - (53 . |Zero|) (57 . -) (63 . |sizeLess?|) (69 . +) - (|Record| (|:| |coef1| $) (|:| |coef2| $) - (|:| |generator| $)) - |EUCDOM-;extendedEuclidean;2SR;7| - (75 . |extendedEuclidean|) (81 . |exquo|) - (|Record| (|:| |coef1| $) (|:| |coef2| $)) - (|Union| 35 '"failed") |EUCDOM-;extendedEuclidean;3SU;8| - (|List| 6) (87 . =) (93 . |second|) (|List| $) - (|Record| (|:| |coef| 41) (|:| |generator| $)) - (98 . |principalIdeal|) |EUCDOM-;principalIdeal;LR;9| - (|Union| 41 '"failed") |EUCDOM-;expressIdealMember;LSU;10| - (103 . |copy|) (|Integer|) (108 . |split!|) - (114 . |extendedEuclidean|) (121 . |multiEuclidean|) - (127 . |concat|) |EUCDOM-;multiEuclidean;LSU;11|) - '#(|sizeLess?| 133 |rem| 139 |quo| 145 |principalIdeal| 151 - |multiEuclidean| 156 |gcd| 162 |extendedEuclidean| 168 - |exquo| 181 |expressIdealMember| 187) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 53 - '(1 6 7 0 8 1 6 9 0 10 2 6 12 0 0 13 1 - 6 0 0 18 1 7 0 0 19 2 6 0 0 0 20 1 6 - 22 0 23 0 6 0 24 2 6 7 0 0 25 2 6 0 0 - 0 26 0 6 0 27 2 6 0 0 0 28 2 6 7 0 0 - 29 2 6 0 0 0 30 2 6 31 0 0 33 2 6 16 - 0 0 34 2 38 7 0 0 39 1 38 6 0 40 1 6 - 42 41 43 1 38 0 0 47 2 38 0 0 48 49 3 - 6 36 0 0 0 50 2 6 45 41 0 51 2 38 0 0 - 0 52 2 0 7 0 0 11 2 0 0 0 0 15 2 0 0 - 0 0 14 1 0 42 41 44 2 0 45 41 0 53 2 - 0 0 0 0 21 3 0 36 0 0 0 37 2 0 31 0 0 - 32 2 0 16 0 0 17 2 0 45 41 0 46))))) - '|lookupComplete|)) -@ - \section{category FIELD Field} @@ -2087,283 +792,7 @@ GcdDomain(): Category == IntegralDomain with monomial(1,e1)*p1 @ -\section{GCDDOM.lsp BOOTSTRAP} -{\bf GCDDOM} needs -{\bf COMRING} which needs -{\bf RING} which needs -{\bf RNG} which needs -{\bf ABELGRP} which needs -{\bf CABMON} which needs -{\bf ABELMON} which needs -{\bf ABELSG} which needs -{\bf SETCAT} which needs -{\bf SINT} which needs -{\bf UFD} which needs -{\bf GCDDOM}. -We break this chain with {\bf GCDDOM.lsp} which we -cache here. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf GCDDOM} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf GCDDOM.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<GCDDOM.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |GcdDomain;AL| 'NIL) - -(DEFUN |GcdDomain| () - (LET (#:G1393) - (COND (|GcdDomain;AL|) (T (SETQ |GcdDomain;AL| (|GcdDomain;|)))))) - -(DEFUN |GcdDomain;| () - (PROG (#0=#:G1391) - (RETURN - (PROG1 (LETT #0# - (|Join| (|IntegralDomain|) - (|mkCategory| '|domain| - '(((|gcd| ($ $ $)) T) - ((|gcd| ($ (|List| $))) T) - ((|lcm| ($ $ $)) T) - ((|lcm| ($ (|List| $))) T) - ((|gcdPolynomial| - ((|SparseUnivariatePolynomial| $) - (|SparseUnivariatePolynomial| $) - (|SparseUnivariatePolynomial| $))) - T)) - NIL - '((|SparseUnivariatePolynomial| $) - (|List| $)) - NIL)) - |GcdDomain|) - (SETELT #0# 0 '(|GcdDomain|)))))) - -(MAKEPROP '|GcdDomain| 'NILADIC T) -@ -\section{GCDDOM-.lsp BOOTSTRAP} -{\bf GCDDOM-} depends on {\bf GCDDOM}. -We break this chain with {\bf GCDDOM-.lsp} which we -cache here. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf GCDDOM-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf GCDDOM-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<GCDDOM-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |GCDDOM-;lcm;3S;1| (|x| |y| $) - (PROG (LCM) - (RETURN - (SEQ (COND - ((OR (SPADCALL |y| (|spadConstant| $ 7) (QREFELT $ 9)) - (SPADCALL |x| (|spadConstant| $ 7) (QREFELT $ 9))) - (|spadConstant| $ 7)) - ('T - (SEQ (LETT LCM - (SPADCALL |y| - (SPADCALL |x| |y| (QREFELT $ 10)) - (QREFELT $ 12)) - |GCDDOM-;lcm;3S;1|) - (EXIT (COND - ((QEQCAR LCM 0) - (SPADCALL |x| (QCDR LCM) (QREFELT $ 13))) - ('T (|error| "bad gcd in lcm computation"))))))))))) - -(DEFUN |GCDDOM-;lcm;LS;2| (|l| $) - (SPADCALL (ELT $ 15) |l| (|spadConstant| $ 16) (|spadConstant| $ 7) - (QREFELT $ 19))) - -(DEFUN |GCDDOM-;gcd;LS;3| (|l| $) - (SPADCALL (ELT $ 10) |l| (|spadConstant| $ 7) (|spadConstant| $ 16) - (QREFELT $ 19))) - -(DEFUN |GCDDOM-;gcdPolynomial;3Sup;4| (|p1| |p2| $) - (PROG (|e2| |e1| |c1| |p| |c2| #0=#:G1406) - (RETURN - (SEQ (COND - ((SPADCALL |p1| (QREFELT $ 24)) - (SPADCALL |p2| (QREFELT $ 25))) - ((SPADCALL |p2| (QREFELT $ 24)) - (SPADCALL |p1| (QREFELT $ 25))) - ('T - (SEQ (LETT |c1| (SPADCALL |p1| (QREFELT $ 26)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (LETT |c2| (SPADCALL |p2| (QREFELT $ 26)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (LETT |p1| - (PROG2 (LETT #0# - (SPADCALL |p1| |c1| - (QREFELT $ 27)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|SparseUnivariatePolynomial| - (QREFELT $ 6)) - #0#)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (LETT |p2| - (PROG2 (LETT #0# - (SPADCALL |p2| |c2| - (QREFELT $ 27)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|SparseUnivariatePolynomial| - (QREFELT $ 6)) - #0#)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (SEQ (LETT |e1| (SPADCALL |p1| (QREFELT $ 29)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((< 0 |e1|) - (LETT |p1| - (PROG2 - (LETT #0# - (SPADCALL |p1| - (SPADCALL - (|spadConstant| $ 16) |e1| - (QREFELT $ 32)) - (QREFELT $ 33)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|SparseUnivariatePolynomial| - (QREFELT $ 6)) - #0#)) - |GCDDOM-;gcdPolynomial;3Sup;4|))))) - (SEQ (LETT |e2| (SPADCALL |p2| (QREFELT $ 29)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((< 0 |e2|) - (LETT |p2| - (PROG2 - (LETT #0# - (SPADCALL |p2| - (SPADCALL - (|spadConstant| $ 16) |e2| - (QREFELT $ 32)) - (QREFELT $ 33)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) - (|SparseUnivariatePolynomial| - (QREFELT $ 6)) - #0#)) - |GCDDOM-;gcdPolynomial;3Sup;4|))))) - (LETT |e1| (MIN |e1| |e2|) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (LETT |c1| (SPADCALL |c1| |c2| (QREFELT $ 10)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (LETT |p1| - (COND - ((OR (EQL (SPADCALL |p1| (QREFELT $ 34)) 0) - (EQL (SPADCALL |p2| (QREFELT $ 34)) 0)) - (SPADCALL |c1| 0 (QREFELT $ 32))) - ('T - (SEQ (LETT |p| - (SPADCALL |p1| |p2| - (QREFELT $ 35)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((EQL - (SPADCALL |p| - (QREFELT $ 34)) - 0) - (SPADCALL |c1| 0 - (QREFELT $ 32))) - ('T - (SEQ - (LETT |c2| - (SPADCALL - (SPADCALL |p1| - (QREFELT $ 36)) - (SPADCALL |p2| - (QREFELT $ 36)) - (QREFELT $ 10)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT - (SPADCALL - (SPADCALL |c1| - (SPADCALL - (PROG2 - (LETT #0# - (SPADCALL - (SPADCALL |c2| |p| - (QREFELT $ 37)) - (SPADCALL |p| - (QREFELT $ 36)) - (QREFELT $ 27)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (QCDR #0#) - (|check-union| - (QEQCAR #0# 0) - (|SparseUnivariatePolynomial| - (QREFELT $ 6)) - #0#)) - (QREFELT $ 38)) - (QREFELT $ 37)) - (QREFELT $ 25)))))))))) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((ZEROP |e1|) |p1|) - ('T - (SPADCALL - (SPADCALL (|spadConstant| $ 16) |e1| - (QREFELT $ 32)) - |p1| (QREFELT $ 39)))))))))))) - -(DEFUN |GcdDomain&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|GcdDomain&|)) - (LETT |dv$| (LIST '|GcdDomain&| |dv$1|) . #0#) - (LETT $ (GETREFV 42) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) -(MAKEPROP '|GcdDomain&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|) - (|Boolean|) (4 . =) (10 . |gcd|) (|Union| $ '"failed") - (16 . |exquo|) (22 . *) |GCDDOM-;lcm;3S;1| (28 . |lcm|) - (34 . |One|) (|Mapping| 6 6 6) (|List| 6) (38 . |reduce|) - (|List| $) |GCDDOM-;lcm;LS;2| |GCDDOM-;gcd;LS;3| - (|SparseUnivariatePolynomial| 6) (46 . |zero?|) - (51 . |unitCanonical|) (56 . |content|) (61 . |exquo|) - (|NonNegativeInteger|) (67 . |minimumDegree|) - (72 . |Zero|) (76 . |One|) (80 . |monomial|) - (86 . |exquo|) (92 . |degree|) (97 . |subResultantGcd|) - (103 . |leadingCoefficient|) (108 . *) - (114 . |primitivePart|) (119 . *) - (|SparseUnivariatePolynomial| $) - |GCDDOM-;gcdPolynomial;3Sup;4|) - '#(|lcm| 125 |gcdPolynomial| 136 |gcd| 142) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 41 - '(0 6 0 7 2 6 8 0 0 9 2 6 0 0 0 10 2 6 - 11 0 0 12 2 6 0 0 0 13 2 6 0 0 0 15 0 - 6 0 16 4 18 6 17 0 6 6 19 1 23 8 0 24 - 1 23 0 0 25 1 23 6 0 26 2 23 11 0 6 - 27 1 23 28 0 29 0 23 0 30 0 23 0 31 2 - 23 0 6 28 32 2 23 11 0 0 33 1 23 28 0 - 34 2 23 0 0 0 35 1 23 6 0 36 2 23 0 6 - 0 37 1 23 0 0 38 2 23 0 0 0 39 1 0 0 - 20 21 2 0 0 0 0 14 2 0 40 40 40 41 1 - 0 0 20 22))))) - '|lookupComplete|)) -@ \section{category GROUP Group} <<category GROUP Group>>= )abbrev category GROUP Group @@ -2472,141 +901,8 @@ IntegralDomain(): Category == true @ -\section{INTDOM.lsp BOOTSTRAP} -{\bf INTDOM} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf INTDOM} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf INTDOM.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<INTDOM.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |IntegralDomain;AL| 'NIL) - -(DEFUN |IntegralDomain| () - (LET (#:G1393) - (COND - (|IntegralDomain;AL|) - (T (SETQ |IntegralDomain;AL| (|IntegralDomain;|)))))) - -(DEFUN |IntegralDomain;| () - (PROG (#0=#:G1391) - (RETURN - (PROG1 (LETT #0# - (|Join| (|CommutativeRing|) (|Algebra| '$) - (|EntireRing|) - (|mkCategory| '|domain| - '(((|exquo| ((|Union| $ "failed") $ $)) - T) - ((|unitNormal| - ((|Record| (|:| |unit| $) - (|:| |canonical| $) - (|:| |associate| $)) - $)) - T) - ((|unitCanonical| ($ $)) T) - ((|associates?| ((|Boolean|) $ $)) T) - ((|unit?| ((|Boolean|) $)) T)) - NIL '((|Boolean|)) NIL)) - |IntegralDomain|) - (SETELT #0# 0 '(|IntegralDomain|)))))) - -(MAKEPROP '|IntegralDomain| 'NILADIC T) -@ -\section{INTDOM-.lsp BOOTSTRAP} -{\bf INTDOM-} depends on {\bf INTDOM}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf INTDOM-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf INTDOM-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<INTDOM-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |INTDOM-;unitNormal;SR;1| (|x| $) - (VECTOR (|spadConstant| $ 7) |x| (|spadConstant| $ 7))) - -(DEFUN |INTDOM-;unitCanonical;2S;2| (|x| $) - (QVELT (SPADCALL |x| (QREFELT $ 10)) 1)) - -(DEFUN |INTDOM-;recip;SU;3| (|x| $) - (COND - ((SPADCALL |x| (QREFELT $ 13)) (CONS 1 "failed")) - ('T (SPADCALL (|spadConstant| $ 7) |x| (QREFELT $ 15))))) - -(DEFUN |INTDOM-;unit?;SB;4| (|x| $) - (COND ((QEQCAR (SPADCALL |x| (QREFELT $ 17)) 1) 'NIL) ('T 'T))) -(DEFUN |INTDOM-;associates?;2SB;5| (|x| |y| $) - (SPADCALL (QVELT (SPADCALL |x| (QREFELT $ 10)) 1) - (QVELT (SPADCALL |y| (QREFELT $ 10)) 1) (QREFELT $ 19))) -(DEFUN |INTDOM-;associates?;2SB;6| (|x| |y| $) - (COND - ((SPADCALL |x| (QREFELT $ 13)) (SPADCALL |y| (QREFELT $ 13))) - ((OR (SPADCALL |y| (QREFELT $ 13)) - (OR (QEQCAR (SPADCALL |x| |y| (QREFELT $ 15)) 1) - (QEQCAR (SPADCALL |y| |x| (QREFELT $ 15)) 1))) - 'NIL) - ('T 'T))) - -(DEFUN |IntegralDomain&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|IntegralDomain&|)) - (LETT |dv$| (LIST '|IntegralDomain&| |dv$1|) . #0#) - (LETT $ (GETREFV 21) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (COND - ((|HasCategory| |#1| '(|Field|))) - ('T - (QSETREFV $ 9 - (CONS (|dispatchFunction| |INTDOM-;unitNormal;SR;1|) $)))) - (COND - ((|HasAttribute| |#1| '|canonicalUnitNormal|) - (QSETREFV $ 20 - (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;5|) - $))) - ('T - (QSETREFV $ 20 - (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;6|) - $)))) - $)))) - -(MAKEPROP '|IntegralDomain&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |One|) - (|Record| (|:| |unit| $) (|:| |canonical| $) - (|:| |associate| $)) - (4 . |unitNormal|) (9 . |unitNormal|) - |INTDOM-;unitCanonical;2S;2| (|Boolean|) (14 . |zero?|) - (|Union| $ '"failed") (19 . |exquo|) |INTDOM-;recip;SU;3| - (25 . |recip|) |INTDOM-;unit?;SB;4| (30 . =) - (36 . |associates?|)) - '#(|unitNormal| 42 |unitCanonical| 47 |unit?| 52 |recip| 57 - |associates?| 62) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 20 - '(0 6 0 7 1 0 8 0 9 1 6 8 0 10 1 6 12 0 - 13 2 6 14 0 0 15 1 6 14 0 17 2 6 12 0 - 0 19 2 0 12 0 0 20 1 0 8 0 9 1 0 0 0 - 11 1 0 12 0 18 1 0 14 0 16 2 0 12 0 0 - 20))))) - '|lookupComplete|)) -@ \section{category LMODULE LeftModule} <<category LMODULE LeftModule>>= )abbrev category LMODULE LeftModule @@ -2730,106 +1026,7 @@ Monoid(): Category == SemiGroup with expt(x,n pretend PositiveInteger) @ -\section{MONOID.lsp BOOTSTRAP} -{\bf MONOID} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf MONOID} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf MONOID.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<MONOID.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |Monoid;AL| 'NIL) - -(DEFUN |Monoid| () - (LET (#:G1388) - (COND (|Monoid;AL|) (T (SETQ |Monoid;AL| (|Monoid;|)))))) - -(DEFUN |Monoid;| () - (PROG (#0=#:G1386) - (RETURN - (PROG1 (LETT #0# - (|Join| (|SemiGroup|) - (|mkCategory| '|domain| - '(((|One| ($) |constant|) T) - ((|sample| ($) |constant|) T) - ((|one?| ((|Boolean|) $)) T) - ((** ($ $ (|NonNegativeInteger|))) T) - ((^ ($ $ (|NonNegativeInteger|))) T) - ((|recip| ((|Union| $ "failed") $)) T)) - NIL - '((|NonNegativeInteger|) (|Boolean|)) - NIL)) - |Monoid|) - (SETELT #0# 0 '(|Monoid|)))))) - -(MAKEPROP '|Monoid| 'NILADIC T) -@ -\section{MONOID-.lsp BOOTSTRAP} -{\bf MONOID-} depends on {\bf MONOID}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf MONOID-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf MONOID-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<MONOID-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |MONOID-;^;SNniS;1| (|x| |n| $) - (SPADCALL |x| |n| (QREFELT $ 8))) - -(DEFUN |MONOID-;one?;SB;2| (|x| $) - (SPADCALL |x| (|spadConstant| $ 10) (QREFELT $ 12))) - -(DEFUN |MONOID-;sample;S;3| ($) (|spadConstant| $ 10)) -(DEFUN |MONOID-;recip;SU;4| (|x| $) - (COND - ((SPADCALL |x| (|spadConstant| $ 10) (QREFELT $ 12)) (CONS 0 |x|)) - ('T (CONS 1 "failed")))) - -(DEFUN |MONOID-;**;SNniS;5| (|x| |n| $) - (COND - ((ZEROP |n|) (|spadConstant| $ 10)) - ('T (SPADCALL |x| |n| (QREFELT $ 19))))) - -(DEFUN |Monoid&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|Monoid&|)) - (LETT |dv$| (LIST '|Monoid&| |dv$1|) . #0#) - (LETT $ (GETREFV 21) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) - -(MAKEPROP '|Monoid&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) - (|NonNegativeInteger|) (0 . **) |MONOID-;^;SNniS;1| - (6 . |One|) (|Boolean|) (10 . =) |MONOID-;one?;SB;2| - |MONOID-;sample;S;3| (|Union| $ '"failed") - |MONOID-;recip;SU;4| (|PositiveInteger|) - (|RepeatedSquaring| 6) (16 . |expt|) |MONOID-;**;SNniS;5|) - '#(|sample| 22 |recip| 26 |one?| 31 ^ 36 ** 42) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 20 - '(2 6 0 0 7 8 0 6 0 10 2 6 11 0 0 12 2 - 18 6 6 17 19 0 0 0 14 1 0 15 0 16 1 0 - 11 0 13 2 0 0 0 7 9 2 0 0 0 7 20))))) - '|lookupComplete|)) -@ \section{category OAGROUP OrderedAbelianGroup} <<category OAGROUP OrderedAbelianGroup>>= )abbrev category OAGROUP OrderedAbelianGroup @@ -2989,36 +1186,7 @@ OrderedIntegralDomain(): Category == Join(IntegralDomain, OrderedRing) @ -\section{OINTDOM.lsp BOOTSTRAP} -{\bf OINTDOM} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf OINTDOM} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf OINTDOM.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<OINTDOM.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |OrderedIntegralDomain;AL| 'NIL) -(DEFUN |OrderedIntegralDomain| () - (LET (#:G1387) - (COND - (|OrderedIntegralDomain;AL|) - (T (SETQ |OrderedIntegralDomain;AL| (|OrderedIntegralDomain;|)))))) - -(DEFUN |OrderedIntegralDomain;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# (|Join| (|IntegralDomain|) (|OrderedRing|)) - |OrderedIntegralDomain|) - (SETELT #0# 0 '(|OrderedIntegralDomain|)))))) - -(MAKEPROP '|OrderedIntegralDomain| 'NILADIC T) -@ \section{category ORDMON OrderedMonoid} <<category ORDMON OrderedMonoid>>= )abbrev category ORDMON OrderedMonoid @@ -3085,111 +1253,7 @@ OrderedRing(): Category == Join(OrderedAbelianGroup,Ring,Monoid) with error "x satisfies neither positive?, negative? or zero?" @ -\section{ORDRING.lsp BOOTSTRAP} -{\bf ORDRING} depends on {\bf INT}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ORDRING} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ORDRING.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Technically I can't justify this bootstrap stanza based on the lattice -since {\bf INT} is already bootstrapped. However using {\bf INT} naked -generates a "value stack overflow" error suggesting an infinite recursive -loop. This code is here to experiment with breaking that loop. - -Note that this code is not included in the generated catdef.spad file. - -<<ORDRING.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |OrderedRing;AL| 'NIL) - -(DEFUN |OrderedRing| () - (LET (#:G1393) - (COND - (|OrderedRing;AL|) - (T (SETQ |OrderedRing;AL| (|OrderedRing;|)))))) - -(DEFUN |OrderedRing;| () - (PROG (#0=#:G1391) - (RETURN - (PROG1 (LETT #0# - (|Join| (|OrderedAbelianGroup|) (|Ring|) (|Monoid|) - (|mkCategory| '|domain| - '(((|positive?| ((|Boolean|) $)) T) - ((|negative?| ((|Boolean|) $)) T) - ((|sign| ((|Integer|) $)) T) - ((|abs| ($ $)) T)) - NIL '((|Integer|) (|Boolean|)) NIL)) - |OrderedRing|) - (SETELT #0# 0 '(|OrderedRing|)))))) - -(MAKEPROP '|OrderedRing| 'NILADIC T) -@ -\section{ORDRING-.lsp BOOTSTRAP} -{\bf ORDRING-} depends on {\bf ORDRING}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ORDRING-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ORDRING-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<ORDRING-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |ORDRING-;positive?;SB;1| (|x| $) - (SPADCALL (|spadConstant| $ 7) |x| (QREFELT $ 9))) - -(DEFUN |ORDRING-;negative?;SB;2| (|x| $) - (SPADCALL |x| (|spadConstant| $ 7) (QREFELT $ 9))) -(DEFUN |ORDRING-;sign;SI;3| (|x| $) - (COND - ((SPADCALL |x| (QREFELT $ 12)) 1) - ((SPADCALL |x| (QREFELT $ 13)) -1) - ((SPADCALL |x| (QREFELT $ 15)) 0) - ('T (|error| "x satisfies neither positive?, negative? or zero?")))) - -(DEFUN |ORDRING-;abs;2S;4| (|x| $) - (COND - ((SPADCALL |x| (QREFELT $ 12)) |x|) - ((SPADCALL |x| (QREFELT $ 13)) (SPADCALL |x| (QREFELT $ 18))) - ((SPADCALL |x| (QREFELT $ 15)) (|spadConstant| $ 7)) - ('T (|error| "x satisfies neither positive?, negative? or zero?")))) - -(DEFUN |OrderedRing&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|OrderedRing&|)) - (LETT |dv$| (LIST '|OrderedRing&| |dv$1|) . #0#) - (LETT $ (GETREFV 20) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) - -(MAKEPROP '|OrderedRing&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|) - (|Boolean|) (4 . <) |ORDRING-;positive?;SB;1| - |ORDRING-;negative?;SB;2| (10 . |positive?|) - (15 . |negative?|) (20 . |One|) (24 . |zero?|) (|Integer|) - |ORDRING-;sign;SI;3| (29 . -) |ORDRING-;abs;2S;4|) - '#(|sign| 34 |positive?| 39 |negative?| 44 |abs| 49) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 19 - '(0 6 0 7 2 6 8 0 0 9 1 6 8 0 12 1 6 8 - 0 13 0 6 0 14 1 6 8 0 15 1 6 0 0 18 1 - 0 16 0 17 1 0 8 0 10 1 0 8 0 11 1 0 0 - 0 19))))) - '|lookupComplete|)) -@ \section{category ORDSET OrderedSet} <<category ORDSET OrderedSet>>= )abbrev category ORDSET OrderedSet @@ -3484,82 +1548,8 @@ Ring(): Category == Join(Rng,Monoid,LeftModule(%)) with coerce(n) == n * 1$% @ -\section{RING.lsp BOOTSTRAP} -{\bf RING} depends on itself. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf RING} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf RING.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<RING.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |Ring;AL| 'NIL) -(DEFUN |Ring| () - (LET (#:G1387) (COND (|Ring;AL|) (T (SETQ |Ring;AL| (|Ring;|)))))) -(DEFUN |Ring;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# - (|Join| (|Rng|) (|Monoid|) (|LeftModule| '$) - (|mkCategory| '|domain| - '(((|characteristic| - ((|NonNegativeInteger|))) - T) - ((|coerce| ($ (|Integer|))) T)) - '((|unitsKnown| T)) - '((|Integer|) (|NonNegativeInteger|)) - NIL)) - |Ring|) - (SETELT #0# 0 '(|Ring|)))))) - -(MAKEPROP '|Ring| 'NILADIC T) -@ -\section{RING-.lsp BOOTSTRAP} -{\bf RING-} depends on {\bf RING}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf RING-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf RING-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<RING-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |RING-;coerce;IS;1| (|n| $) - (SPADCALL |n| (|spadConstant| $ 7) (QREFELT $ 9))) - -(DEFUN |Ring&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|Ring&|)) - (LETT |dv$| (LIST '|Ring&| |dv$1|) . #0#) - (LETT $ (GETREFV 12) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) - -(MAKEPROP '|Ring&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |One|) - (|Integer|) (4 . *) |RING-;coerce;IS;1| (|OutputForm|)) - '#(|coerce| 10) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 10 - '(0 6 0 7 2 6 0 8 0 9 1 0 0 8 10))))) - '|lookupComplete|)) -@ \section{category RNG Rng} <<category RNG Rng>>= )abbrev category RNG Rng @@ -3586,33 +1576,7 @@ Note that this code is not included in the generated catdef.spad file. Rng(): Category == Join(AbelianGroup,SemiGroup) @ -\section{RNG.lsp BOOTSTRAP} -{\bf RNG} depends on a chain of -files. We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf RNG} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf RNG.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<RNG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) -(DEFPARAMETER |Rng;AL| 'NIL) - -(DEFUN |Rng| () - (LET (#:G1387) (COND (|Rng;AL|) (T (SETQ |Rng;AL| (|Rng;|)))))) - -(DEFUN |Rng;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# (|Join| (|AbelianGroup|) (|SemiGroup|)) |Rng|) - (SETELT #0# 0 '(|Rng|)))))) - -(MAKEPROP '|Rng| 'NILADIC T) -@ \section{category SGROUP SemiGroup} <<category SGROUP SemiGroup>>= )abbrev category SGROUP SemiGroup @@ -3676,102 +1640,7 @@ SetCategory(): Category == Join(BasicType,CoercibleTo OutputForm) with latex(s : %): String == "\mbox{\bf Unimplemented}" @ -\section{SETCAT.lsp BOOTSTRAP} -{\bf SETCAT} needs -{\bf SINT} which needs -{\bf UFD} which needs -{\bf GCDDOM} which needs -{\bf COMRING} which needs -{\bf RING} which needs -{\bf RNG} which needs -{\bf ABELGRP} which needs -{\bf CABMON} which needs -{\bf ABELMON} which needs -{\bf ABELSG} which needs -{\bf SETCAT}. We break this chain with {\bf SETCAT.lsp} which we -cache here. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf SETCAT} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf SETCAT.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. -Note that this code is not included in the generated catdef.spad file. - -<<SETCAT.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |SetCategory;AL| 'NIL) - -(DEFUN |SetCategory| () - (LET (#:G1388) - (COND - (|SetCategory;AL|) - (T (SETQ |SetCategory;AL| (|SetCategory;|)))))) - -(DEFUN |SetCategory;| () - (PROG (#0=#:G1386) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(#1=#:G1385) (LIST '(|OutputForm|))) - (|Join| (|BasicType|) (|CoercibleTo| '#1#) - (|mkCategory| '|domain| - '(((|hash| ((|SingleInteger|) $)) T) - ((|latex| ((|String|) $)) T)) - NIL '((|String|) (|SingleInteger|)) - NIL))) - |SetCategory|) - (SETELT #0# 0 '(|SetCategory|)))))) - -(MAKEPROP '|SetCategory| 'NILADIC T) -@ -\section{SETCAT-.lsp BOOTSTRAP} -{\bf SETCAT-} is the implementation of the operations exported -by {\bf SETCAT}. It comes into existance whenever {\bf SETCAT} -gets compiled by Axiom. However this will not happen at the -lisp level so we also cache this information here. See the -explanation under the {\bf SETCAT.lsp} section for more details. - -Note that this code is not included in the generated catdef.spad file. - -<<SETCAT-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(PUT '|SETCAT-;hash;SSi;1| '|SPADreplace| '(XLAM (|s|) 0)) - -(DEFUN |SETCAT-;hash;SSi;1| (|s| $) 0) - -(PUT '|SETCAT-;latex;SS;2| '|SPADreplace| - '(XLAM (|s|) "\\mbox{\\bf Unimplemented}")) - -(DEFUN |SETCAT-;latex;SS;2| (|s| $) "\\mbox{\\bf Unimplemented}") - -(DEFUN |SetCategory&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|SetCategory&|)) - (LETT |dv$| (LIST '|SetCategory&| |dv$1|) . #0#) - (LETT $ (GETREFV 11) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - $)))) - -(MAKEPROP '|SetCategory&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|SingleInteger|) - |SETCAT-;hash;SSi;1| (|String|) |SETCAT-;latex;SS;2|) - '#(|latex| 0 |hash| 5) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 10 - '(1 0 9 0 10 1 0 7 0 8))))) - '|lookupComplete|)) -@ \section{category STEP StepThrough} <<category STEP StepThrough>>= )abbrev category STEP StepThrough @@ -3843,151 +1712,6 @@ UniqueFactorizationDomain(): Category == GcdDomain with prime? x == # factorList factor x = 1 @ -\section{UFD.lsp BOOTSTRAP} -{\bf UFD} needs -{\bf GCDDOM} which needs -{\bf COMRING} which needs -{\bf RING} which needs -{\bf RNG} which needs -{\bf ABELGRP} which needs -{\bf CABMON} which needs -{\bf ABELMON} which needs -{\bf ABELSG} which needs -{\bf SETCAT} which needs -{\bf SINT} which needs -{\bf UFD}. -We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf UFD} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf UFD.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<UFD.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |UniqueFactorizationDomain;AL| 'NIL) - -(DEFUN |UniqueFactorizationDomain| () - (LET (#:G1387) - (COND - (|UniqueFactorizationDomain;AL|) - (T (SETQ |UniqueFactorizationDomain;AL| - (|UniqueFactorizationDomain;|)))))) - -(DEFUN |UniqueFactorizationDomain;| () - (PROG (#0=#:G1385) - (RETURN - (PROG1 (LETT #0# - (|Join| (|GcdDomain|) - (|mkCategory| '|domain| - '(((|prime?| ((|Boolean|) $)) T) - ((|squareFree| ((|Factored| $) $)) T) - ((|squareFreePart| ($ $)) T) - ((|factor| ((|Factored| $) $)) T)) - NIL '((|Factored| $) (|Boolean|)) NIL)) - |UniqueFactorizationDomain|) - (SETELT #0# 0 '(|UniqueFactorizationDomain|)))))) - -(MAKEPROP '|UniqueFactorizationDomain| 'NILADIC T) -@ -\section{UFD-.lsp BOOTSTRAP} -{\bf UFD-} needs {\bf UFD}. -We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf UFD-} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf UFD-.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<UFD-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |UFD-;squareFreePart;2S;1| (|x| $) - (PROG (|s| |f| #0=#:G1403 #1=#:G1401 #2=#:G1399 #3=#:G1400) - (RETURN - (SEQ (SPADCALL - (SPADCALL - (LETT |s| (SPADCALL |x| (|getShellEntry| $ 8)) - |UFD-;squareFreePart;2S;1|) - (|getShellEntry| $ 10)) - (PROGN - (LETT #3# NIL |UFD-;squareFreePart;2S;1|) - (SEQ (LETT |f| NIL |UFD-;squareFreePart;2S;1|) - (LETT #0# (SPADCALL |s| (|getShellEntry| $ 14)) - |UFD-;squareFreePart;2S;1|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |f| (CAR #0#) - |UFD-;squareFreePart;2S;1|) - NIL)) - (GO G191))) - (SEQ (EXIT (PROGN - (LETT #1# (QCAR |f|) - |UFD-;squareFreePart;2S;1|) - (COND - (#3# - (LETT #2# - (SPADCALL #2# #1# - (|getShellEntry| $ 15)) - |UFD-;squareFreePart;2S;1|)) - ('T - (PROGN - (LETT #2# #1# - |UFD-;squareFreePart;2S;1|) - (LETT #3# 'T - |UFD-;squareFreePart;2S;1|))))))) - (LETT #0# (CDR #0#) |UFD-;squareFreePart;2S;1|) - (GO G190) G191 (EXIT NIL)) - (COND (#3# #2#) ('T (|spadConstant| $ 16)))) - (|getShellEntry| $ 15)))))) - -(DEFUN |UFD-;prime?;SB;2| (|x| $) - (EQL (LENGTH (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18)) - (|getShellEntry| $ 22))) - 1)) - -(DEFUN |UniqueFactorizationDomain&| (|#1|) - (PROG (|dv$1| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) - . #0=(|UniqueFactorizationDomain&|)) - (LETT |dv$| (LIST '|UniqueFactorizationDomain&| |dv$1|) . #0#) - (LETT $ (|newShell| 25) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 |#1|) - $)))) - -(MAKEPROP '|UniqueFactorizationDomain&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Factored| $) - (0 . |squareFree|) (|Factored| 6) (5 . |unit|) (|Integer|) - (|Record| (|:| |factor| 6) (|:| |exponent| 11)) - (|List| 12) (10 . |factors|) (15 . *) (21 . |One|) - |UFD-;squareFreePart;2S;1| (25 . |factor|) - (|Union| '"nil" '"sqfr" '"irred" '"prime") - (|Record| (|:| |flg| 19) (|:| |fctr| 6) (|:| |xpnt| 11)) - (|List| 20) (30 . |factorList|) (|Boolean|) - |UFD-;prime?;SB;2|) - '#(|squareFreePart| 35 |prime?| 40) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 24 - '(1 6 7 0 8 1 9 6 0 10 1 9 13 0 14 2 6 - 0 0 0 15 0 6 0 16 1 6 7 0 18 1 9 21 0 - 22 1 0 0 0 17 1 0 23 0 24))))) - '|lookupComplete|)) -@ \section{category VSPACE VectorSpace} |