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