diff options
58 files changed, 2971 insertions, 3040 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 832d9d5a..8c439650 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,19 @@ +2010-07-24 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/cattable.boot: Use %true for truth value in VM expressions. + * interp/clam.boot: Likewise. + * interp/define.boot: Likewise. + * interp/format.boot: Likewise. + * interp/functor.boot: Likewise. + * interp/g-opt.boot: Likewise. + * interp/mark.boot: Likewise. + * interp/pspad1.boot: Likewise. + * interp/pspad2.boot: Likewise. + * interp/slam.boot: Likewise. + * interp/wi1.boot: Likewise. + * interp/wi2.boot: Likewise. + * interp/sys-constants.boot: Remove $true and $false as unused. + 2010-07-23 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/compiler.boot (compMatchAlternative): Don't generate diff --git a/src/algebra/strap/ABELGRP-.lsp b/src/algebra/strap/ABELGRP-.lsp index d436441d..a10e5227 100644 --- a/src/algebra/strap/ABELGRP-.lsp +++ b/src/algebra/strap/ABELGRP-.lsp @@ -28,9 +28,8 @@ (COND ((ZEROP |n|) (|spadConstant| $ 19)) ((PLUSP |n|) (SPADCALL |n| |x| (|getShellEntry| $ 24))) - ('T - (SPADCALL (- |n|) (SPADCALL |x| (|getShellEntry| $ 7)) - (|getShellEntry| $ 24))))) + (T (SPADCALL (- |n|) (SPADCALL |x| (|getShellEntry| $ 7)) + (|getShellEntry| $ 24))))) (DEFUN |AbelianGroup&| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) @@ -42,9 +41,8 @@ (|setShellEntry| $ 6 |#1|) (COND ((|HasCategory| |#1| '(|Ring|))) - ('T - (|setShellEntry| $ 26 - (CONS (|dispatchFunction| |ABELGRP-;*;I2S;4|) $)))) + (T (|setShellEntry| $ 26 + (CONS (|dispatchFunction| |ABELGRP-;*;I2S;4|) $)))) $)) (MAKEPROP '|AbelianGroup&| '|infovec| diff --git a/src/algebra/strap/ABELMON-.lsp b/src/algebra/strap/ABELMON-.lsp index ce89d0ed..8bad28b8 100644 --- a/src/algebra/strap/ABELMON-.lsp +++ b/src/algebra/strap/ABELMON-.lsp @@ -25,7 +25,7 @@ (DEFUN |ABELMON-;*;Nni2S;4| (|n| |x| $) (COND ((ZEROP |n|) (|spadConstant| $ 7)) - ('T (SPADCALL |n| |x| (|getShellEntry| $ 18))))) + (T (SPADCALL |n| |x| (|getShellEntry| $ 18))))) (DEFUN |AbelianMonoid&| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) @@ -37,9 +37,8 @@ (|setShellEntry| $ 6 |#1|) (COND ((|HasCategory| |#1| '(|Ring|))) - ('T - (|setShellEntry| $ 19 - (CONS (|dispatchFunction| |ABELMON-;*;Nni2S;4|) $)))) + (T (|setShellEntry| $ 19 + (CONS (|dispatchFunction| |ABELMON-;*;Nni2S;4|) $)))) $)) (MAKEPROP '|AbelianMonoid&| '|infovec| diff --git a/src/algebra/strap/ABELSG-.lsp b/src/algebra/strap/ABELSG-.lsp index 4cc27b47..c06795c0 100644 --- a/src/algebra/strap/ABELSG-.lsp +++ b/src/algebra/strap/ABELSG-.lsp @@ -18,9 +18,8 @@ (|setShellEntry| $ 6 |#1|) (COND ((|HasCategory| |#1| '(|Ring|))) - ('T - (|setShellEntry| $ 10 - (CONS (|dispatchFunction| |ABELSG-;*;Pi2S;1|) $)))) + (T (|setShellEntry| $ 10 + (CONS (|dispatchFunction| |ABELSG-;*;Pi2S;1|) $)))) $)) (MAKEPROP '|AbelianSemiGroup&| '|infovec| diff --git a/src/algebra/strap/ALAGG.lsp b/src/algebra/strap/ALAGG.lsp index e8aa377c..c33b5d87 100644 --- a/src/algebra/strap/ALAGG.lsp +++ b/src/algebra/strap/ALAGG.lsp @@ -16,19 +16,19 @@ (|:| |entry| |t#2|)))) (COND (|AssociationListAggregate;CAT|) - ('T - (SETQ |AssociationListAggregate;CAT| - (|Join| (|TableAggregate| '|t#1| '|t#2|) - (|ListAggregate| '#1#) - (|mkCategory| '|domain| - '(((|assoc| - ((|Union| - (|Record| (|:| |key| |t#1|) - (|:| |entry| |t#2|)) - "failed") - |t#1| $)) - T)) - NIL 'NIL NIL))))))))) + (T (SETQ |AssociationListAggregate;CAT| + (|Join| (|TableAggregate| '|t#1| '|t#2|) + (|ListAggregate| '#1#) + (|mkCategory| '|domain| + '(((|assoc| + ((|Union| + (|Record| + (|:| |key| |t#1|) + (|:| |entry| |t#2|)) + "failed") + |t#1| $)) + T)) + NIL 'NIL NIL))))))))) (|setShellEntry| #0# 0 (LIST '|AssociationListAggregate| (|devaluate| |t#1|) (|devaluate| |t#2|))) diff --git a/src/algebra/strap/BOOLEAN.lsp b/src/algebra/strap/BOOLEAN.lsp index 32d29e58..df73f473 100644 --- a/src/algebra/strap/BOOLEAN.lsp +++ b/src/algebra/strap/BOOLEAN.lsp @@ -114,41 +114,39 @@ (DECLARE (IGNORE $)) (OR |a| |b|)) -(DEFUN |BOOLEAN;xor;3$;10| (|a| |b| $) - (COND (|a| (NOT |b|)) ('T |b|))) +(DEFUN |BOOLEAN;xor;3$;10| (|a| |b| $) (COND (|a| (NOT |b|)) (T |b|))) -(DEFUN |BOOLEAN;nor;3$;11| (|a| |b| $) - (COND (|a| NIL) ('T (NOT |b|)))) +(DEFUN |BOOLEAN;nor;3$;11| (|a| |b| $) (COND (|a| NIL) (T (NOT |b|)))) -(DEFUN |BOOLEAN;nand;3$;12| (|a| |b| $) (COND (|a| (NOT |b|)) ('T T))) +(DEFUN |BOOLEAN;nand;3$;12| (|a| |b| $) (COND (|a| (NOT |b|)) (T T))) (DEFUN |BOOLEAN;=;3$;13| (|a| |b| $) (DECLARE (IGNORE $)) (EQ |a| |b|)) -(DEFUN |BOOLEAN;implies;3$;14| (|a| |b| $) (COND (|a| |b|) ('T T))) +(DEFUN |BOOLEAN;implies;3$;14| (|a| |b| $) (COND (|a| |b|) (T T))) (DEFUN |BOOLEAN;equiv;3$;15| (|a| |b| $) (DECLARE (IGNORE $)) (EQ |a| |b|)) -(DEFUN |BOOLEAN;<;3$;16| (|a| |b| $) (COND (|b| (NOT |a|)) ('T NIL))) +(DEFUN |BOOLEAN;<;3$;16| (|a| |b| $) (COND (|b| (NOT |a|)) (T NIL))) (DEFUN |BOOLEAN;size;Nni;17| ($) (DECLARE (IGNORE $)) 2) (DEFUN |BOOLEAN;index;Pi$;18| (|i| $) - (COND ((SPADCALL |i| (|getShellEntry| $ 26)) NIL) ('T T))) + (COND ((SPADCALL |i| (|getShellEntry| $ 26)) NIL) (T T))) -(DEFUN |BOOLEAN;lookup;$Pi;19| (|a| $) (COND (|a| 1) ('T 2))) +(DEFUN |BOOLEAN;lookup;$Pi;19| (|a| $) (COND (|a| 1) (T 2))) (DEFUN |BOOLEAN;random;$;20| ($) - (COND ((SPADCALL (|random|) (|getShellEntry| $ 26)) NIL) ('T T))) + (COND ((SPADCALL (|random|) (|getShellEntry| $ 26)) NIL) (T T))) (DEFUN |BOOLEAN;convert;$If;21| (|x| $) - (COND (|x| '|true|) ('T '|false|))) + (COND (|x| '|true|) (T '|false|))) (DEFUN |BOOLEAN;coerce;$Of;22| (|x| $) - (COND (|x| '|true|) ('T '|false|))) + (COND (|x| '|true|) (T '|false|))) (DEFUN |Boolean| () (DECLARE (SPECIAL |$ConstructorCache|)) @@ -157,12 +155,11 @@ (COND ((SETQ #0# (HGET |$ConstructorCache| '|Boolean|)) (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Boolean| - (LIST (CONS NIL (CONS 1 (|Boolean;|)))))) - (SETQ #0# T)) - (COND ((NOT #0#) (HREM |$ConstructorCache| '|Boolean|))))))))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Boolean| + (LIST (CONS NIL (CONS 1 (|Boolean;|)))))) + (SETQ #0# T)) + (COND ((NOT #0#) (HREM |$ConstructorCache| '|Boolean|))))))))) (DEFUN |Boolean;| () (LET ((|dv$| (LIST '|Boolean|)) ($ (|newShell| 39)) diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp index 869562e9..c43f36f7 100644 --- a/src/algebra/strap/CHAR.lsp +++ b/src/algebra/strap/CHAR.lsp @@ -175,7 +175,7 @@ ((EQL (QCSIZE |s|) 1) (SPADCALL |s| (SPADCALL |s| (|getShellEntry| $ 52)) (|getShellEntry| $ 53))) - ('T (|userError| "String is not a single character")))) + (T (|userError| "String is not a single character")))) (DEFUN |CHAR;upperCase;2$;24| (|c| $) (DECLARE (IGNORE $)) @@ -192,12 +192,13 @@ (COND ((SETQ #0# (HGET |$ConstructorCache| '|Character|)) (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Character| - (LIST (CONS NIL (CONS 1 (|Character;|)))))) - (SETQ #0# T)) - (COND ((NOT #0#) (HREM |$ConstructorCache| '|Character|))))))))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Character| + (LIST (CONS NIL + (CONS 1 (|Character;|)))))) + (SETQ #0# T)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|Character|))))))))) (DEFUN |Character;| () (LET ((|dv$| (LIST '|Character|)) ($ (|newShell| 58)) diff --git a/src/algebra/strap/CLAGG.lsp b/src/algebra/strap/CLAGG.lsp index b917ed26..0b352d92 100644 --- a/src/algebra/strap/CLAGG.lsp +++ b/src/algebra/strap/CLAGG.lsp @@ -10,65 +10,62 @@ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) (COND (|Collection;CAT|) - ('T - (SETQ |Collection;CAT| - (|Join| (|HomogeneousAggregate| '|t#1|) - (|mkCategory| '|domain| - '(((|construct| - ($ (|List| |t#1|))) - T) - ((|find| - ((|Union| |t#1| "failed") - (|Mapping| (|Boolean|) |t#1|) - $)) - T) - ((|reduce| - (|t#1| - (|Mapping| |t#1| |t#1| |t#1|) - $)) + (T (SETQ |Collection;CAT| + (|Join| (|HomogeneousAggregate| '|t#1|) + (|mkCategory| '|domain| + '(((|construct| ($ (|List| |t#1|))) + T) + ((|find| + ((|Union| |t#1| "failed") + (|Mapping| (|Boolean|) |t#1|) + $)) + T) + ((|reduce| + (|t#1| + (|Mapping| |t#1| |t#1| |t#1|) + $)) + (|has| $ + (ATTRIBUTE |finiteAggregate|))) + ((|reduce| + (|t#1| + (|Mapping| |t#1| |t#1| |t#1|) + $ |t#1|)) + (|has| $ + (ATTRIBUTE |finiteAggregate|))) + ((|remove| + ($ + (|Mapping| (|Boolean|) |t#1|) + $)) + (|has| $ + (ATTRIBUTE |finiteAggregate|))) + ((|select| + ($ + (|Mapping| (|Boolean|) |t#1|) + $)) + (|has| $ + (ATTRIBUTE |finiteAggregate|))) + ((|reduce| + (|t#1| + (|Mapping| |t#1| |t#1| |t#1|) + $ |t#1| |t#1|)) + (AND + (|has| |t#1| (|SetCategory|)) (|has| $ - (ATTRIBUTE |finiteAggregate|))) - ((|reduce| - (|t#1| - (|Mapping| |t#1| |t#1| |t#1|) - $ |t#1|)) + (ATTRIBUTE |finiteAggregate|)))) + ((|remove| ($ |t#1| $)) + (AND + (|has| |t#1| (|SetCategory|)) (|has| $ - (ATTRIBUTE |finiteAggregate|))) - ((|remove| - ($ - (|Mapping| (|Boolean|) |t#1|) - $)) + (ATTRIBUTE |finiteAggregate|)))) + ((|removeDuplicates| ($ $)) + (AND + (|has| |t#1| (|SetCategory|)) (|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)))))))) + (ATTRIBUTE |finiteAggregate|))))) + '(((|ConvertibleTo| (|InputForm|)) + (|has| |t#1| + (|ConvertibleTo| (|InputForm|))))) + '((|List| |t#1|)) NIL)))))))) (|setShellEntry| #0# 0 (LIST '|Collection| (|devaluate| |t#1|))) #0#)) diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp index 94b2fb12..f1bc4f5c 100644 --- a/src/algebra/strap/DFLOAT.lsp +++ b/src/algebra/strap/DFLOAT.lsp @@ -441,15 +441,14 @@ (COND ((EQL 2 2) 53) ((EQL 2 16) (* 4 53)) - ('T - (LET ((#0=#:G1431 - (TRUNCATE - (SPADCALL 53 - (|DFLOAT;log2;2$;40| - (FLOAT 2 |$DoubleFloatMaximum|) $) - (|getShellEntry| $ 32))))) - (|check-subtype| (AND (NOT (MINUSP #0#)) (PLUSP #0#)) - '(|PositiveInteger|) #0#))))) + (T (LET ((#0=#:G1431 + (TRUNCATE + (SPADCALL 53 + (|DFLOAT;log2;2$;40| + (FLOAT 2 |$DoubleFloatMaximum|) $) + (|getShellEntry| $ 32))))) + (|check-subtype| (AND (NOT (MINUSP #0#)) (PLUSP #0#)) + '(|PositiveInteger|) #0#))))) (DEFUN |DFLOAT;max;$;11| ($) (DECLARE (IGNORE $)) @@ -594,7 +593,7 @@ (DEFUN |DFLOAT;hash;$Si;69| (|x| $) (DECLARE (IGNORE $)) (HASHEQ |x|)) (DEFUN |DFLOAT;recip;$U;70| (|x| $) - (COND ((ZEROP |x|) (CONS 1 "failed")) ('T (CONS 0 (/ 1.0 |x|))))) + (COND ((ZEROP |x|) (CONS 1 "failed")) (T (CONS 0 (/ 1.0 |x|))))) (DEFUN |DFLOAT;differentiate;2$;71| (|x| $) (DECLARE (IGNORE $)) 0.0) @@ -627,13 +626,13 @@ (COND ((PLUSP |y|) (/ PI 2)) ((MINUSP |y|) (- (/ PI 2))) - ('T 0.0))) - ('T - (SEQ (LETT |theta| (ATAN (ABS (/ |y| |x|))) - |DFLOAT;atan;3$;79|) - (COND ((MINUSP |x|) (SETQ |theta| (- PI |theta|)))) - (COND ((MINUSP |y|) (SETQ |theta| (- |theta|)))) - (EXIT |theta|)))))))) + (T 0.0))) + (T (SEQ (LETT |theta| (ATAN (ABS (/ |y| |x|))) + |DFLOAT;atan;3$;79|) + (COND + ((MINUSP |x|) (SETQ |theta| (- PI |theta|)))) + (COND ((MINUSP |y|) (SETQ |theta| (- |theta|)))) + (EXIT |theta|)))))))) (DEFUN |DFLOAT;retract;$F;80| (|x| $) (|DFLOAT;rationalApproximation;$2NniF;87| |x| @@ -658,7 +657,7 @@ (FLOAT (LETT |n| (TRUNCATE |x|) |DFLOAT;retract;$I;82|) |$DoubleFloatMaximum|)) |n|) - ('T (|error| "Not an integer")))))) + (T (|error| "Not an integer")))))) (DEFUN |DFLOAT;retractIfCan;$U;83| (|x| $) (PROG (|n|) @@ -669,7 +668,7 @@ |DFLOAT;retractIfCan;$U;83|) |$DoubleFloatMaximum|)) (CONS 0 |n|)) - ('T (CONS 1 "failed")))))) + (T (CONS 1 "failed")))))) (DEFUN |DFLOAT;sign;$I;84| (|x| $) (|DFLOAT;retract;$I;82| (FLOAT-SIGN |x| 1.0) $)) @@ -681,24 +680,23 @@ (RETURN (SEQ (COND ((ZEROP |x|) (CONS 0 0)) - ('T - (SEQ (LETT |s| (|DFLOAT;sign;$I;84| |x| $) - |DFLOAT;manexp|) - (SETQ |x| (ABS |x|)) - (COND - ((< |$DoubleFloatMaximum| |x|) - (RETURN-FROM |DFLOAT;manexp| - (CONS (+ (* |s| + (T (SEQ (LETT |s| (|DFLOAT;sign;$I;84| |x| $) + |DFLOAT;manexp|) + (SETQ |x| (ABS |x|)) + (COND + ((< |$DoubleFloatMaximum| |x|) + (RETURN-FROM |DFLOAT;manexp| + (CONS (+ (* |s| (|DFLOAT;mantissa;$I;7| |$DoubleFloatMaximum| $)) - 1) - (|DFLOAT;exponent;$I;8| - |$DoubleFloatMaximum| $))))) - (LETT |me| (MANEXP |x|) |DFLOAT;manexp|) - (LETT |two53| (EXPT 2 53) |DFLOAT;manexp|) - (EXIT (CONS (* |s| - (TRUNCATE (* |two53| (CAR |me|)))) - (- (CDR |me|) 53)))))))))) + 1) + (|DFLOAT;exponent;$I;8| + |$DoubleFloatMaximum| $))))) + (LETT |me| (MANEXP |x|) |DFLOAT;manexp|) + (LETT |two53| (EXPT 2 53) |DFLOAT;manexp|) + (EXIT (CONS (* |s| + (TRUNCATE (* |two53| (CAR |me|)))) + (- (CDR |me|) 53)))))))))) (DEFUN |DFLOAT;rationalApproximation;$2NniF;87| (|f| |d| |b| $) (PROG (BASE |de| |tol| |s| |t| |p0| |p1| |q0| |q1| |#G107| |q| |r| @@ -717,88 +715,87 @@ (|check-subtype| (NOT (MINUSP |ex|)) '(|NonNegativeInteger|) |ex|))) (|getShellEntry| $ 134))) - ('T - (SEQ (LETT |de| - (EXPT BASE - (LET ((#0=#:G1550 (- |ex|))) - (|check-subtype| - (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#))) - |DFLOAT;rationalApproximation;$2NniF;87|) - (EXIT (COND - ((< |b| 2) - (|error| "base must be > 1")) - ('T - (SEQ - (LETT |tol| (EXPT |b| |d|) - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |s| |nu| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |t| |de| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |p0| 0 - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |p1| 1 - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |q0| 1 - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |q1| 0 - |DFLOAT;rationalApproximation;$2NniF;87|) - (EXIT - (LOOP - (COND - (NIL (RETURN NIL)) - (T - (SEQ - (LETT |#G107| - (DIVIDE2 |s| |t|) - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |q| (CAR |#G107|) - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |r| (CDR |#G107|) - |DFLOAT;rationalApproximation;$2NniF;87|) - |#G107| - (LETT |p2| - (+ (* |q| |p1|) |p0|) - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |q2| - (+ (* |q| |q1|) |q0|) - |DFLOAT;rationalApproximation;$2NniF;87|) - (COND - ((OR (ZEROP |r|) - (< - (SPADCALL |tol| - (ABS - (- (* |nu| |q2|) - (* |de| |p2|))) - (|getShellEntry| $ - 143)) - (* |de| (ABS |p2|)))) - (RETURN-FROM - |DFLOAT;rationalApproximation;$2NniF;87| - (SPADCALL |p2| |q2| - (|getShellEntry| $ - 141))))) - (LETT |#G108| |p1| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |#G109| |p2| - |DFLOAT;rationalApproximation;$2NniF;87|) - (SETQ |p0| |#G108|) - (SETQ |p1| |#G109|) - (LETT |#G110| |q1| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |#G111| |q2| - |DFLOAT;rationalApproximation;$2NniF;87|) - (SETQ |q0| |#G110|) - (SETQ |q1| |#G111|) - (EXIT - (PROGN - (LETT |#G112| |t| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |#G113| |r| - |DFLOAT;rationalApproximation;$2NniF;87|) - (SETQ |s| |#G112|) - (SETQ |t| |#G113|))))))))))))))))))))) + (T (SEQ (LETT |de| + (EXPT BASE + (LET ((#0=#:G1550 (- |ex|))) + (|check-subtype| + (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#))) + |DFLOAT;rationalApproximation;$2NniF;87|) + (EXIT (COND + ((< |b| 2) + (|error| "base must be > 1")) + (T + (SEQ + (LETT |tol| (EXPT |b| |d|) + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |s| |nu| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |t| |de| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |p0| 0 + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |p1| 1 + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |q0| 1 + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |q1| 0 + |DFLOAT;rationalApproximation;$2NniF;87|) + (EXIT + (LOOP + (COND + (NIL (RETURN NIL)) + (T + (SEQ + (LETT |#G107| + (DIVIDE2 |s| |t|) + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |q| (CAR |#G107|) + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |r| (CDR |#G107|) + |DFLOAT;rationalApproximation;$2NniF;87|) + |#G107| + (LETT |p2| + (+ (* |q| |p1|) |p0|) + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |q2| + (+ (* |q| |q1|) |q0|) + |DFLOAT;rationalApproximation;$2NniF;87|) + (COND + ((OR (ZEROP |r|) + (< + (SPADCALL |tol| + (ABS + (- (* |nu| |q2|) + (* |de| |p2|))) + (|getShellEntry| $ + 143)) + (* |de| (ABS |p2|)))) + (RETURN-FROM + |DFLOAT;rationalApproximation;$2NniF;87| + (SPADCALL |p2| |q2| + (|getShellEntry| $ + 141))))) + (LETT |#G108| |p1| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |#G109| |p2| + |DFLOAT;rationalApproximation;$2NniF;87|) + (SETQ |p0| |#G108|) + (SETQ |p1| |#G109|) + (LETT |#G110| |q1| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |#G111| |q2| + |DFLOAT;rationalApproximation;$2NniF;87|) + (SETQ |q0| |#G110|) + (SETQ |q1| |#G111|) + (EXIT + (PROGN + (LETT |#G112| |t| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |#G113| |r| + |DFLOAT;rationalApproximation;$2NniF;87|) + (SETQ |s| |#G112|) + (SETQ |t| |#G113|))))))))))))))))))))) (DEFUN |DFLOAT;**;$F$;88| (|x| |r| $) (PROG (|n| |d|) @@ -810,39 +807,44 @@ (|error| "0**0 is undefined")) ((SPADCALL |r| (|getShellEntry| $ 146)) (|error| "division by 0")) - ('T 0.0))) + (T 0.0))) ((OR (SPADCALL |r| (|getShellEntry| $ 145)) (= |x| 1.0)) 1.0) - ('T - (COND - ((SPADCALL |r| (|getShellEntry| $ 147)) |x|) - ('T - (SEQ (LETT |n| (SPADCALL |r| (|getShellEntry| $ 148)) - |DFLOAT;**;$F$;88|) - (LETT |d| (SPADCALL |r| (|getShellEntry| $ 149)) - |DFLOAT;**;$F$;88|) - (EXIT (COND - ((MINUSP |x|) - (COND - ((ODDP |d|) - (COND - ((ODDP |n|) - (RETURN-FROM |DFLOAT;**;$F$;88| - (- - (|DFLOAT;**;$F$;88| (- |x|) |r| - $)))) - ('T - (RETURN-FROM |DFLOAT;**;$F$;88| - (|DFLOAT;**;$F$;88| (- |x|) |r| - $))))) - ('T (|error| "negative root")))) - ((EQL |d| 2) - (EXPT (|DFLOAT;sqrt;2$;33| |x| $) |n|)) - ('T - (|DFLOAT;**;3$;36| |x| - (/ (FLOAT |n| |$DoubleFloatMaximum|) - (FLOAT |d| |$DoubleFloatMaximum|)) - $))))))))))))) + (T (COND + ((SPADCALL |r| (|getShellEntry| $ 147)) |x|) + (T (SEQ (LETT |n| + (SPADCALL |r| (|getShellEntry| $ 148)) + |DFLOAT;**;$F$;88|) + (LETT |d| + (SPADCALL |r| (|getShellEntry| $ 149)) + |DFLOAT;**;$F$;88|) + (EXIT (COND + ((MINUSP |x|) + (COND + ((ODDP |d|) + (COND + ((ODDP |n|) + (RETURN-FROM + |DFLOAT;**;$F$;88| + (- + (|DFLOAT;**;$F$;88| (- |x|) + |r| $)))) + (T + (RETURN-FROM + |DFLOAT;**;$F$;88| + (|DFLOAT;**;$F$;88| (- |x|) + |r| $))))) + (T (|error| "negative root")))) + ((EQL |d| 2) + (EXPT (|DFLOAT;sqrt;2$;33| |x| $) + |n|)) + (T (|DFLOAT;**;3$;36| |x| + (/ + (FLOAT |n| + |$DoubleFloatMaximum|) + (FLOAT |d| + |$DoubleFloatMaximum|)) + $))))))))))))) (DEFUN |DoubleFloat| () (DECLARE (SPECIAL |$ConstructorCache|)) @@ -851,14 +853,13 @@ (COND ((SETQ #0# (HGET |$ConstructorCache| '|DoubleFloat|)) (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|DoubleFloat| - (LIST (CONS NIL - (CONS 1 (|DoubleFloat;|)))))) - (SETQ #0# T)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|DoubleFloat|))))))))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|DoubleFloat| + (LIST (CONS NIL + (CONS 1 (|DoubleFloat;|)))))) + (SETQ #0# T)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|DoubleFloat|))))))))) (DEFUN |DoubleFloat;| () (LET ((|dv$| (LIST '|DoubleFloat|)) ($ (|newShell| 164)) diff --git a/src/algebra/strap/DIVRING-.lsp b/src/algebra/strap/DIVRING-.lsp index af1162d4..ffcd2e1d 100644 --- a/src/algebra/strap/DIVRING-.lsp +++ b/src/algebra/strap/DIVRING-.lsp @@ -11,11 +11,11 @@ (COND ((ZEROP |n|) (|spadConstant| $ 10)) ((SPADCALL |x| (|getShellEntry| $ 11)) - (COND ((MINUSP |n|) (|error| "division by zero")) ('T |x|))) + (COND ((MINUSP |n|) (|error| "division by zero")) (T |x|))) ((MINUSP |n|) (SPADCALL (SPADCALL |x| (|getShellEntry| $ 15)) (- |n|) (|getShellEntry| $ 19))) - ('T (SPADCALL |x| |n| (|getShellEntry| $ 19))))) + (T (SPADCALL |x| |n| (|getShellEntry| $ 19))))) (DEFUN |DIVRING-;*;F2S;2| (|q| |x| $) (SPADCALL diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp index 8e091370..9a28b2bf 100644 --- a/src/algebra/strap/EUCDOM-.lsp +++ b/src/algebra/strap/EUCDOM-.lsp @@ -39,9 +39,8 @@ (COND ((SPADCALL |y| (|getShellEntry| $ 8)) NIL) ((SPADCALL |x| (|getShellEntry| $ 8)) T) - ('T - (< (SPADCALL |x| (|getShellEntry| $ 12)) - (SPADCALL |y| (|getShellEntry| $ 12)))))) + (T (< (SPADCALL |x| (|getShellEntry| $ 12)) + (SPADCALL |y| (|getShellEntry| $ 12)))))) (DEFUN |EUCDOM-;quo;3S;2| (|x| |y| $) (CAR (SPADCALL |x| |y| (|getShellEntry| $ 16)))) @@ -56,13 +55,14 @@ ((SPADCALL |x| (|getShellEntry| $ 8)) (CONS 0 (|spadConstant| $ 19))) ((SPADCALL |y| (|getShellEntry| $ 8)) (CONS 1 "failed")) - ('T - (SEQ (LETT |qr| (SPADCALL |x| |y| (|getShellEntry| $ 16)) - |EUCDOM-;exquo;2SU;4|) - (EXIT (COND - ((SPADCALL (CDR |qr|) (|getShellEntry| $ 8)) - (CONS 0 (CAR |qr|))) - ('T (CONS 1 "failed"))))))))))) + (T (SEQ (LETT |qr| + (SPADCALL |x| |y| (|getShellEntry| $ 16)) + |EUCDOM-;exquo;2SU;4|) + (EXIT (COND + ((SPADCALL (CDR |qr|) + (|getShellEntry| $ 8)) + (CONS 0 (CAR |qr|))) + (T (CONS 1 "failed"))))))))))) (DEFUN |EUCDOM-;gcd;3S;5| (|x| |y| $) (PROG (|#G13| |#G14|) @@ -90,12 +90,11 @@ (SEQ |#G16| (EXIT (COND ((SPADCALL |a| (|getShellEntry| $ 28)) |s|) - ('T - (VECTOR (SPADCALL |a| (QVELT |s| 0) - (|getShellEntry| $ 29)) - (SPADCALL |a| (QVELT |s| 1) - (|getShellEntry| $ 29)) - |c|))))))) + (T (VECTOR (SPADCALL |a| (QVELT |s| 0) + (|getShellEntry| $ 29)) + (SPADCALL |a| (QVELT |s| 1) + (|getShellEntry| $ 29)) + |c|))))))) (DEFUN |EUCDOM-;extendedEuclidean;2SR;7| (|x| |y| $) (PROG (|s3| |qr|) @@ -111,53 +110,54 @@ (COND ((SPADCALL |y| (|getShellEntry| $ 8)) |s1|) ((SPADCALL |x| (|getShellEntry| $ 8)) |s2|) - ('T - (SEQ (LOOP - (COND - ((NOT (NOT (SPADCALL (QVELT |s2| 2) - (|getShellEntry| $ 8)))) - (RETURN NIL)) - (T (SEQ (LETT |qr| - (SPADCALL (QVELT |s1| 2) - (QVELT |s2| 2) - (|getShellEntry| $ 16)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (LETT |s3| - (VECTOR (SPADCALL (QVELT |s1| 0) - (SPADCALL (CAR |qr|) - (QVELT |s2| 0) - (|getShellEntry| $ 29)) - (|getShellEntry| $ 31)) - (SPADCALL (QVELT |s1| 1) - (SPADCALL (CAR |qr|) - (QVELT |s2| 1) - (|getShellEntry| $ 29)) - (|getShellEntry| $ 31)) - (CDR |qr|)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (SETQ |s1| |s2|) - (EXIT (SETQ |s2| - (|EUCDOM-;unitNormalizeIdealElt| - |s3| $))))))) - (COND - ((NOT (SPADCALL (QVELT |s1| 0) (|getShellEntry| $ 8))) - (COND - ((NOT (SPADCALL (QVELT |s1| 0) |y| - (|getShellEntry| $ 32))) - (SEQ (LETT |qr| - (SPADCALL (QVELT |s1| 0) |y| + (T (SEQ (LOOP + (COND + ((NOT (NOT (SPADCALL (QVELT |s2| 2) + (|getShellEntry| $ 8)))) + (RETURN NIL)) + (T (SEQ (LETT |qr| + (SPADCALL (QVELT |s1| 2) + (QVELT |s2| 2) (|getShellEntry| $ 16)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (QSETVELT |s1| 0 (CDR |qr|)) - (QSETVELT |s1| 1 - (SPADCALL (QVELT |s1| 1) - (SPADCALL (CAR |qr|) |x| - (|getShellEntry| $ 29)) - (|getShellEntry| $ 33))) - (EXIT (SETQ |s1| - (|EUCDOM-;unitNormalizeIdealElt| - |s1| $)))))))) - (EXIT |s1|)))))))) + |EUCDOM-;extendedEuclidean;2SR;7|) + (LETT |s3| + (VECTOR + (SPADCALL (QVELT |s1| 0) + (SPADCALL (CAR |qr|) + (QVELT |s2| 0) + (|getShellEntry| $ 29)) + (|getShellEntry| $ 31)) + (SPADCALL (QVELT |s1| 1) + (SPADCALL (CAR |qr|) + (QVELT |s2| 1) + (|getShellEntry| $ 29)) + (|getShellEntry| $ 31)) + (CDR |qr|)) + |EUCDOM-;extendedEuclidean;2SR;7|) + (SETQ |s1| |s2|) + (EXIT (SETQ |s2| + (|EUCDOM-;unitNormalizeIdealElt| + |s3| $))))))) + (COND + ((NOT (SPADCALL (QVELT |s1| 0) + (|getShellEntry| $ 8))) + (COND + ((NOT (SPADCALL (QVELT |s1| 0) |y| + (|getShellEntry| $ 32))) + (SEQ (LETT |qr| + (SPADCALL (QVELT |s1| 0) |y| + (|getShellEntry| $ 16)) + |EUCDOM-;extendedEuclidean;2SR;7|) + (QSETVELT |s1| 0 (CDR |qr|)) + (QSETVELT |s1| 1 + (SPADCALL (QVELT |s1| 1) + (SPADCALL (CAR |qr|) |x| + (|getShellEntry| $ 29)) + (|getShellEntry| $ 33))) + (EXIT (SETQ |s1| + (|EUCDOM-;unitNormalizeIdealElt| + |s1| $)))))))) + (EXIT |s1|)))))))) (DEFUN |EUCDOM-;extendedEuclidean;3SU;8| (|x| |y| |z| $) (PROG (|s| |w| |qr|) @@ -166,40 +166,39 @@ ((SPADCALL |z| (|getShellEntry| $ 8)) (CONS 0 (CONS (|spadConstant| $ 19) (|spadConstant| $ 19)))) - ('T - (SEQ (LETT |s| (SPADCALL |x| |y| (|getShellEntry| $ 36)) - |EUCDOM-;extendedEuclidean;3SU;8|) - (LETT |w| - (SPADCALL |z| (QVELT |s| 2) - (|getShellEntry| $ 37)) - |EUCDOM-;extendedEuclidean;3SU;8|) - (EXIT (COND - ((EQL (CAR |w|) 1) (CONS 1 "failed")) - ((SPADCALL |y| (|getShellEntry| $ 8)) - (CONS 0 - (CONS (SPADCALL (QVELT |s| 0) - (CDR |w|) - (|getShellEntry| $ 29)) - (SPADCALL (QVELT |s| 1) - (CDR |w|) - (|getShellEntry| $ 29))))) - ('T - (SEQ (LETT |qr| - (SPADCALL - (SPADCALL (QVELT |s| 0) - (CDR |w|) - (|getShellEntry| $ 29)) - |y| (|getShellEntry| $ 16)) - |EUCDOM-;extendedEuclidean;3SU;8|) - (EXIT (CONS 0 - (CONS (CDR |qr|) - (SPADCALL - (SPADCALL (QVELT |s| 1) - (CDR |w|) - (|getShellEntry| $ 29)) - (SPADCALL (CAR |qr|) |x| - (|getShellEntry| $ 29)) - (|getShellEntry| $ 33)))))))))))))))) + (T (SEQ (LETT |s| + (SPADCALL |x| |y| (|getShellEntry| $ 36)) + |EUCDOM-;extendedEuclidean;3SU;8|) + (LETT |w| + (SPADCALL |z| (QVELT |s| 2) + (|getShellEntry| $ 37)) + |EUCDOM-;extendedEuclidean;3SU;8|) + (EXIT (COND + ((EQL (CAR |w|) 1) (CONS 1 "failed")) + ((SPADCALL |y| (|getShellEntry| $ 8)) + (CONS 0 + (CONS + (SPADCALL (QVELT |s| 0) (CDR |w|) + (|getShellEntry| $ 29)) + (SPADCALL (QVELT |s| 1) (CDR |w|) + (|getShellEntry| $ 29))))) + (T (SEQ (LETT |qr| + (SPADCALL + (SPADCALL (QVELT |s| 0) + (CDR |w|) + (|getShellEntry| $ 29)) + |y| (|getShellEntry| $ 16)) + |EUCDOM-;extendedEuclidean;3SU;8|) + (EXIT + (CONS 0 + (CONS (CDR |qr|) + (SPADCALL + (SPADCALL (QVELT |s| 1) + (CDR |w|) + (|getShellEntry| $ 29)) + (SPADCALL (CAR |qr|) |x| + (|getShellEntry| $ 29)) + (|getShellEntry| $ 33)))))))))))))))) (DEFUN |EUCDOM-;principalIdeal;LR;9| (|l| $) (PROG (|uca| |v| |u|) @@ -221,32 +220,32 @@ |EUCDOM-;principalIdeal;LR;9|) (EXIT (CONS (LIST (QVELT |u| 0) (QVELT |u| 1)) (QVELT |u| 2))))) - ('T - (SEQ (LETT |v| - (SPADCALL (CDR |l|) (|getShellEntry| $ 48)) - |EUCDOM-;principalIdeal;LR;9|) - (LETT |u| - (SPADCALL (|SPADfirst| |l|) (CDR |v|) - (|getShellEntry| $ 36)) - |EUCDOM-;principalIdeal;LR;9|) - (EXIT (CONS (CONS (QVELT |u| 0) - (LET - ((#0=#:G1519 (CAR |v|)) - (#1=#:G1518 NIL)) - (LOOP - (COND - ((ATOM #0#) - (RETURN (NREVERSE #1#))) - (T - (LET ((|vv| (CAR #0#))) - (SETQ #1# - (CONS - (SPADCALL (QVELT |u| 1) - |vv| - (|getShellEntry| $ 29)) - #1#))))) - (SETQ #0# (CDR #0#))))) - (QVELT |u| 2)))))))))) + (T (SEQ (LETT |v| + (SPADCALL (CDR |l|) (|getShellEntry| $ 48)) + |EUCDOM-;principalIdeal;LR;9|) + (LETT |u| + (SPADCALL (|SPADfirst| |l|) (CDR |v|) + (|getShellEntry| $ 36)) + |EUCDOM-;principalIdeal;LR;9|) + (EXIT (CONS (CONS (QVELT |u| 0) + (LET + ((#0=#:G1519 (CAR |v|)) + (#1=#:G1518 NIL)) + (LOOP + (COND + ((ATOM #0#) + (RETURN (NREVERSE #1#))) + (T + (LET ((|vv| (CAR #0#))) + (SETQ #1# + (CONS + (SPADCALL + (QVELT |u| 1) |vv| + (|getShellEntry| $ + 29)) + #1#))))) + (SETQ #0# (CDR #0#))))) + (QVELT |u| 2)))))))))) (DEFUN |EUCDOM-;expressIdealMember;LSU;10| (|l| |z| $) (PROG (|pid| |q|) @@ -263,31 +262,32 @@ (SETQ #1# (CONS (|spadConstant| $ 19) #1#))))) (SETQ #0# (CDR #0#)))))) - ('T - (SEQ (LETT |pid| (SPADCALL |l| (|getShellEntry| $ 48)) - |EUCDOM-;expressIdealMember;LSU;10|) - (LETT |q| - (SPADCALL |z| (CDR |pid|) - (|getShellEntry| $ 37)) - |EUCDOM-;expressIdealMember;LSU;10|) - (EXIT (COND - ((EQL (CAR |q|) 1) (CONS 1 "failed")) - ('T - (CONS 0 - (LET ((#2=#:G1523 (CAR |pid|)) + (T (SEQ (LETT |pid| (SPADCALL |l| (|getShellEntry| $ 48)) + |EUCDOM-;expressIdealMember;LSU;10|) + (LETT |q| + (SPADCALL |z| (CDR |pid|) + (|getShellEntry| $ 37)) + |EUCDOM-;expressIdealMember;LSU;10|) + (EXIT (COND + ((EQL (CAR |q|) 1) (CONS 1 "failed")) + (T (CONS 0 + (LET + ((#2=#:G1523 (CAR |pid|)) (#3=#:G1522 NIL)) - (LOOP - (COND - ((ATOM #2#) - (RETURN (NREVERSE #3#))) - (T - (LET ((|v| (CAR #2#))) - (SETQ #3# - (CONS - (SPADCALL (CDR |q|) |v| - (|getShellEntry| $ 29)) - #3#))))) - (SETQ #2# (CDR #2#))))))))))))))) + (LOOP + (COND + ((ATOM #2#) + (RETURN (NREVERSE #3#))) + (T + (LET ((|v| (CAR #2#))) + (SETQ #3# + (CONS + (SPADCALL (CDR |q|) + |v| + (|getShellEntry| $ + 29)) + #3#))))) + (SETQ #2# (CDR #2#))))))))))))))) (DEFUN |EUCDOM-;multiEuclidean;LSU;11| (|l| |z| $) (PROG (|l1| |l2| |u| |v1| |v2|) @@ -296,80 +296,80 @@ (COND ((ZEROP |n|) (|error| "empty list passed to multiEuclidean")) ((EQL |n| 1) (CONS 0 (LIST |z|))) - ('T - (SEQ (LETT |l1| (SPADCALL |l| (|getShellEntry| $ 58)) - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT |l2| - (SPADCALL |l1| (QUOTIENT2 |n| 2) - (|getShellEntry| $ 61)) - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT |u| - (SPADCALL - (LET ((#0=#:G1504 NIL) (#1=#:G1505 T) - (#2=#:G1524 |l1|)) - (LOOP - (COND - ((ATOM #2#) - (RETURN - (COND - (#1# (|spadConstant| $ 30)) - (T #0#)))) - (T (LET ((#3=#:G1397 (CAR #2#))) - (LET ((#4=#:G1503 #3#)) - (COND - (#1# (SETQ #0# #4#)) - (T - (SETQ #0# - (SPADCALL #0# #4# - (|getShellEntry| $ 29))))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#)))) - (LET ((#5=#:G1507 NIL) (#6=#:G1508 T) - (#7=#:G1525 |l2|)) - (LOOP - (COND - ((ATOM #7#) - (RETURN - (COND - (#6# (|spadConstant| $ 30)) - (T #5#)))) - (T (LET ((#8=#:G1398 (CAR #7#))) - (LET ((#9=#:G1506 #8#)) - (COND - (#6# (SETQ #5# #9#)) - (T - (SETQ #5# - (SPADCALL #5# #9# - (|getShellEntry| $ 29))))) - (SETQ #6# NIL))))) - (SETQ #7# (CDR #7#)))) - |z| (|getShellEntry| $ 62)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT (COND - ((EQL (CAR |u|) 1) (CONS 1 "failed")) - ('T - (SEQ (LETT |v1| - (SPADCALL |l1| (CDR (CDR |u|)) - (|getShellEntry| $ 63)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT (COND - ((EQL (CAR |v1|) 1) - (CONS 1 "failed")) - ('T - (SEQ - (LETT |v2| - (SPADCALL |l2| (CAR (CDR |u|)) - (|getShellEntry| $ 63)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT + (T (SEQ (LETT |l1| (SPADCALL |l| (|getShellEntry| $ 58)) + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT |l2| + (SPADCALL |l1| (QUOTIENT2 |n| 2) + (|getShellEntry| $ 61)) + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT |u| + (SPADCALL + (LET ((#0=#:G1504 NIL) (#1=#:G1505 T) + (#2=#:G1524 |l1|)) + (LOOP + (COND + ((ATOM #2#) + (RETURN + (COND + (#1# (|spadConstant| $ 30)) + (T #0#)))) + (T (LET ((#3=#:G1397 (CAR #2#))) + (LET ((#4=#:G1503 #3#)) (COND - ((EQL (CAR |v2|) 1) - (CONS 1 "failed")) - ('T - (CONS 0 - (SPADCALL (CDR |v1|) - (CDR |v2|) - (|getShellEntry| $ 64))))))))))))))))))))) + (#1# (SETQ #0# #4#)) + (T + (SETQ #0# + (SPADCALL #0# #4# + (|getShellEntry| $ 29))))) + (SETQ #1# NIL))))) + (SETQ #2# (CDR #2#)))) + (LET ((#5=#:G1507 NIL) (#6=#:G1508 T) + (#7=#:G1525 |l2|)) + (LOOP + (COND + ((ATOM #7#) + (RETURN + (COND + (#6# (|spadConstant| $ 30)) + (T #5#)))) + (T (LET ((#8=#:G1398 (CAR #7#))) + (LET ((#9=#:G1506 #8#)) + (COND + (#6# (SETQ #5# #9#)) + (T + (SETQ #5# + (SPADCALL #5# #9# + (|getShellEntry| $ 29))))) + (SETQ #6# NIL))))) + (SETQ #7# (CDR #7#)))) + |z| (|getShellEntry| $ 62)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT (COND + ((EQL (CAR |u|) 1) (CONS 1 "failed")) + (T (SEQ (LETT |v1| + (SPADCALL |l1| (CDR (CDR |u|)) + (|getShellEntry| $ 63)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT (COND + ((EQL (CAR |v1|) 1) + (CONS 1 "failed")) + (T + (SEQ + (LETT |v2| + (SPADCALL |l2| + (CAR (CDR |u|)) + (|getShellEntry| $ 63)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT + (COND + ((EQL (CAR |v2|) 1) + (CONS 1 "failed")) + (T + (CONS 0 + (SPADCALL (CDR |v1|) + (CDR |v2|) + (|getShellEntry| $ + 64))))))))))))))))))))) (DEFUN |EuclideanDomain&| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp index 8126e2db..2f8a01ce 100644 --- a/src/algebra/strap/FFIELDC-.lsp +++ b/src/algebra/strap/FFIELDC-.lsp @@ -60,7 +60,7 @@ (|getShellEntry| $ 14))) (|getShellEntry| $ 16)) (CONS 1 "failed")) - ('T (CONS 0 |a|)))) + (T (CONS 0 |a|)))) (DEFUN |FFIELDC-;order;SOpc;4| (|e| $) (SPADCALL (SPADCALL |e| (|getShellEntry| $ 19)) @@ -95,7 +95,7 @@ (CONS 1 "polynomial") (|getShellEntry| $ 49)) (|spadConstant| $ 41)) - ('T 1))) + (T 1))) (|found| NIL)) (SEQ (LET ((|i| |start|)) (LOOP @@ -122,27 +122,26 @@ (RETURN (SEQ (COND ((SPADCALL |a| (|getShellEntry| $ 16)) NIL) - ('T - (SEQ (LETT |explist| (SPADCALL (|getShellEntry| $ 56)) - |FFIELDC-;primitive?;SB;9|) - (LETT |q| (- (SPADCALL (|getShellEntry| $ 40)) 1) - |FFIELDC-;primitive?;SB;9|) - (LETT |equalone| NIL |FFIELDC-;primitive?;SB;9|) - (LET ((#0=#:G1513 |explist|) (|exp| NIL)) - (LOOP - (COND - ((OR (ATOM #0#) - (PROGN (SETQ |exp| (CAR #0#)) NIL) - (NOT (NOT |equalone|))) - (RETURN NIL)) - (T (SETQ |equalone| - (SPADCALL - (SPADCALL |a| - (QUOTIENT2 |q| (CAR |exp|)) - (|getShellEntry| $ 58)) - (|getShellEntry| $ 59))))) - (SETQ #0# (CDR #0#)))) - (EXIT (NOT |equalone|))))))))) + (T (SEQ (LETT |explist| (SPADCALL (|getShellEntry| $ 56)) + |FFIELDC-;primitive?;SB;9|) + (LETT |q| (- (SPADCALL (|getShellEntry| $ 40)) 1) + |FFIELDC-;primitive?;SB;9|) + (LETT |equalone| NIL |FFIELDC-;primitive?;SB;9|) + (LET ((#0=#:G1513 |explist|) (|exp| NIL)) + (LOOP + (COND + ((OR (ATOM #0#) + (PROGN (SETQ |exp| (CAR #0#)) NIL) + (NOT (NOT |equalone|))) + (RETURN NIL)) + (T (SETQ |equalone| + (SPADCALL + (SPADCALL |a| + (QUOTIENT2 |q| (CAR |exp|)) + (|getShellEntry| $ 58)) + (|getShellEntry| $ 59))))) + (SETQ #0# (CDR #0#)))) + (EXIT (NOT |equalone|))))))))) (DEFUN |FFIELDC-;order;SPi;10| (|e| $) (PROG (|primeDivisor| |a| |goon| |ord| |lof|) @@ -151,50 +150,51 @@ ((SPADCALL |e| (|spadConstant| $ 7) (|getShellEntry| $ 63)) (|error| "order(0) is not defined ")) - ('T - (SEQ (LETT |ord| (- (SPADCALL (|getShellEntry| $ 40)) 1) - |FFIELDC-;order;SPi;10|) - (LETT |lof| (SPADCALL (|getShellEntry| $ 56)) - |FFIELDC-;order;SPi;10|) - (LET ((#0=#:G1514 |lof|)) - (LOOP - (COND - ((ATOM #0#) (RETURN NIL)) - (T (LET ((|rec| (CAR #0#))) - (SEQ (LETT |a| - (QUOTIENT2 |ord| - (LETT |primeDivisor| (CAR |rec|) - |FFIELDC-;order;SPi;10|)) - |FFIELDC-;order;SPi;10|) - (LETT |goon| - (SPADCALL - (SPADCALL |e| |a| - (|getShellEntry| $ 58)) - (|getShellEntry| $ 59)) - |FFIELDC-;order;SPi;10|) - (LET - ((|j| 0) - (#1=#:G1515 (- (CDR |rec|) 2))) - (LOOP - (COND - ((OR (> |j| #1#) (NOT |goon|)) - (RETURN NIL)) - (T - (SEQ (SETQ |ord| |a|) - (SETQ |a| - (QUOTIENT2 |ord| - |primeDivisor|)) - (EXIT - (SETQ |goon| - (SPADCALL - (SPADCALL |e| |a| - (|getShellEntry| $ 58)) - (|getShellEntry| $ 59))))))) - (SETQ |j| (+ |j| 1)))) - (EXIT - (COND (|goon| (SETQ |ord| |a|)))))))) - (SETQ #0# (CDR #0#)))) - (EXIT |ord|)))))))) + (T (SEQ (LETT |ord| + (- (SPADCALL (|getShellEntry| $ 40)) 1) + |FFIELDC-;order;SPi;10|) + (LETT |lof| (SPADCALL (|getShellEntry| $ 56)) + |FFIELDC-;order;SPi;10|) + (LET ((#0=#:G1514 |lof|)) + (LOOP + (COND + ((ATOM #0#) (RETURN NIL)) + (T (LET ((|rec| (CAR #0#))) + (SEQ (LETT |a| + (QUOTIENT2 |ord| + (LETT |primeDivisor| (CAR |rec|) + |FFIELDC-;order;SPi;10|)) + |FFIELDC-;order;SPi;10|) + (LETT |goon| + (SPADCALL + (SPADCALL |e| |a| + (|getShellEntry| $ 58)) + (|getShellEntry| $ 59)) + |FFIELDC-;order;SPi;10|) + (LET + ((|j| 0) + (#1=#:G1515 (- (CDR |rec|) 2))) + (LOOP + (COND + ((OR (> |j| #1#) + (NOT |goon|)) + (RETURN NIL)) + (T + (SEQ (SETQ |ord| |a|) + (SETQ |a| + (QUOTIENT2 |ord| + |primeDivisor|)) + (EXIT + (SETQ |goon| + (SPADCALL + (SPADCALL |e| |a| + (|getShellEntry| $ 58)) + (|getShellEntry| $ 59))))))) + (SETQ |j| (+ |j| 1)))) + (EXIT + (COND (|goon| (SETQ |ord| |a|)))))))) + (SETQ #0# (CDR #0#)))) + (EXIT |ord|)))))))) (DEFUN |FFIELDC-;discreteLog;SNni;11| (|b| $) (PROG (|rho| |exptable| |n| |c| |end| |found| |disc1| |fac| |faclist| @@ -203,169 +203,178 @@ (SEQ (COND ((SPADCALL |b| (|getShellEntry| $ 16)) (|error| "discreteLog: logarithm of zero")) - ('T - (SEQ (LETT |faclist| (SPADCALL (|getShellEntry| $ 56)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |a| |b| |FFIELDC-;discreteLog;SNni;11|) - (LETT |gen| (SPADCALL (|getShellEntry| $ 65)) - |FFIELDC-;discreteLog;SNni;11|) - (EXIT (COND - ((SPADCALL |b| |gen| (|getShellEntry| $ 63)) - 1) - ('T - (SEQ (LETT |disclog| 0 - |FFIELDC-;discreteLog;SNni;11|) - (LETT |mult| 1 - |FFIELDC-;discreteLog;SNni;11|) - (LETT |groupord| - (- - (SPADCALL - (|getShellEntry| $ 40)) - 1) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |exp| |groupord| - |FFIELDC-;discreteLog;SNni;11|) - (LET ((#0=#:G1516 |faclist|)) - (LOOP - (COND - ((ATOM #0#) (RETURN NIL)) - (T - (LET ((|f| (CAR #0#))) - (SEQ - (LETT |fac| (CAR |f|) - |FFIELDC-;discreteLog;SNni;11|) - (EXIT - (LET - ((|t| 0) - (#1=#:G1517 - (- (CDR |f|) 1))) - (LOOP - (COND - ((> |t| #1#) - (RETURN NIL)) - (T - (SEQ - (SETQ |exp| - (QUOTIENT2 |exp| - |fac|)) - (LETT |exptable| - (SPADCALL |fac| - (|getShellEntry| - $ 67)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |n| - (SPADCALL - |exptable| - (|getShellEntry| - $ 68)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |c| - (SPADCALL |a| - |exp| - (|getShellEntry| - $ 58)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |end| - (QUOTIENT2 - (- |fac| 1) |n|) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |found| NIL - |FFIELDC-;discreteLog;SNni;11|) - (LETT |disc1| 0 - |FFIELDC-;discreteLog;SNni;11|) - (LET ((|i| 0)) - (LOOP - (COND - ((OR - (> |i| - |end|) - (NOT - (NOT - |found|))) - (RETURN - NIL)) - (T - (SEQ - (LETT |rho| - (SPADCALL - (SPADCALL - |c| - (|getShellEntry| - $ 11)) - |exptable| - (|getShellEntry| - $ 71)) - |FFIELDC-;discreteLog;SNni;11|) - (EXIT - (COND - ((ZEROP - (CAR - |rho|)) - (SEQ - (SETQ - |found| - T) - (EXIT - (SETQ - |disc1| - (* - (+ - (* - |n| - |i|) - (CDR - |rho|)) - |mult|))))) - ('T - (SETQ - |c| + (T (SEQ (LETT |faclist| (SPADCALL (|getShellEntry| $ 56)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |a| |b| |FFIELDC-;discreteLog;SNni;11|) + (LETT |gen| (SPADCALL (|getShellEntry| $ 65)) + |FFIELDC-;discreteLog;SNni;11|) + (EXIT (COND + ((SPADCALL |b| |gen| + (|getShellEntry| $ 63)) + 1) + (T (SEQ (LETT |disclog| 0 + |FFIELDC-;discreteLog;SNni;11|) + (LETT |mult| 1 + |FFIELDC-;discreteLog;SNni;11|) + (LETT |groupord| + (- + (SPADCALL + (|getShellEntry| $ 40)) + 1) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |exp| |groupord| + |FFIELDC-;discreteLog;SNni;11|) + (LET ((#0=#:G1516 |faclist|)) + (LOOP + (COND + ((ATOM #0#) (RETURN NIL)) + (T + (LET ((|f| (CAR #0#))) + (SEQ + (LETT |fac| (CAR |f|) + |FFIELDC-;discreteLog;SNni;11|) + (EXIT + (LET + ((|t| 0) + (#1=#:G1517 + (- (CDR |f|) 1))) + (LOOP + (COND + ((> |t| #1#) + (RETURN NIL)) + (T + (SEQ + (SETQ |exp| + (QUOTIENT2 + |exp| |fac|)) + (LETT + |exptable| + (SPADCALL + |fac| + (|getShellEntry| + $ 67)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |n| + (SPADCALL + |exptable| + (|getShellEntry| + $ 68)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |c| + (SPADCALL |a| + |exp| + (|getShellEntry| + $ 58)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |end| + (QUOTIENT2 + (- |fac| 1) + |n|) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |found| + NIL + |FFIELDC-;discreteLog;SNni;11|) + (LETT |disc1| 0 + |FFIELDC-;discreteLog;SNni;11|) + (LET ((|i| 0)) + (LOOP + (COND + ((OR + (> |i| + |end|) + (NOT + (NOT + |found|))) + (RETURN + NIL)) + (T + (SEQ + (LETT + |rho| (SPADCALL - |c| (SPADCALL - |gen| - (* - (QUOTIENT2 - |groupord| - |fac|) - (- - |n|)) + |c| (|getShellEntry| $ - 58)) + 11)) + |exptable| (|getShellEntry| $ - 77))))))))) - (SETQ |i| - (+ |i| 1)))) - (EXIT - (COND - (|found| - (SEQ - (SETQ |mult| - (* |mult| - |fac|)) - (SETQ - |disclog| - (+ |disclog| - |disc1|)) - (EXIT - (SETQ |a| - (SPADCALL - |a| - (SPADCALL - |gen| - (- - |disc1|) - (|getShellEntry| - $ 58)) - (|getShellEntry| - $ 77)))))) - ('T - (|error| - "discreteLog: ?? discrete logarithm"))))))) - (SETQ |t| (+ |t| 1))))))))) - (SETQ #0# (CDR #0#)))) - (EXIT |disclog|)))))))))))) + 71)) + |FFIELDC-;discreteLog;SNni;11|) + (EXIT + (COND + ((ZEROP + (CAR + |rho|)) + (SEQ + (SETQ + |found| + T) + (EXIT + (SETQ + |disc1| + (* + (+ + (* + |n| + |i|) + (CDR + |rho|)) + |mult|))))) + (T + (SETQ + |c| + (SPADCALL + |c| + (SPADCALL + |gen| + (* + (QUOTIENT2 + |groupord| + |fac|) + (- + |n|)) + (|getShellEntry| + $ + 58)) + (|getShellEntry| + $ + 77))))))))) + (SETQ |i| + (+ |i| 1)))) + (EXIT + (COND + (|found| + (SEQ + (SETQ + |mult| + (* |mult| + |fac|)) + (SETQ + |disclog| + (+ + |disclog| + |disc1|)) + (EXIT + (SETQ |a| + (SPADCALL + |a| + (SPADCALL + |gen| + (- + |disc1|) + (|getShellEntry| + $ 58)) + (|getShellEntry| + $ 77)))))) + (T + (|error| + "discreteLog: ?? discrete logarithm"))))))) + (SETQ |t| + (+ |t| 1))))))))) + (SETQ #0# (CDR #0#)))) + (EXIT |disclog|)))))))))))) (DEFUN |FFIELDC-;discreteLog;2SU;12| (|logbase| |b| $) (PROG (|rhoHelp| |rho| |fac| |primroot| |groupord| |faclist| |a| @@ -382,36 +391,37 @@ (EXIT (CONS 1 "failed")))) ((SPADCALL |b| |logbase| (|getShellEntry| $ 63)) (CONS 0 1)) - ('T - (COND - ((NOT (ZEROP (REMAINDER2 - (LETT |groupord| - (SPADCALL |logbase| - (|getShellEntry| $ 19)) - |FFIELDC-;discreteLog;2SU;12|) - (SPADCALL |b| (|getShellEntry| $ 19))))) - (SEQ (SPADCALL - "discreteLog: second argument not in cyclic group generated by first argument" - (|getShellEntry| $ 83)) - (EXIT (CONS 1 "failed")))) - ('T - (SEQ (LETT |faclist| - (SPADCALL - (SPADCALL |groupord| - (|getShellEntry| $ 87)) - (|getShellEntry| $ 89)) - |FFIELDC-;discreteLog;2SU;12|) - (LETT |a| |b| |FFIELDC-;discreteLog;2SU;12|) - (LETT |disclog| 0 |FFIELDC-;discreteLog;2SU;12|) - (LETT |mult| 1 |FFIELDC-;discreteLog;2SU;12|) - (LETT |exp| |groupord| - |FFIELDC-;discreteLog;2SU;12|) - (LET ((#0=#:G1518 |faclist|)) - (LOOP - (COND - ((ATOM #0#) (RETURN NIL)) - (T (LET ((|f| (CAR #0#))) - (SEQ (LETT |fac| (CAR |f|) + (T (COND + ((NOT (ZEROP (REMAINDER2 + (LETT |groupord| + (SPADCALL |logbase| + (|getShellEntry| $ 19)) + |FFIELDC-;discreteLog;2SU;12|) + (SPADCALL |b| + (|getShellEntry| $ 19))))) + (SEQ (SPADCALL + "discreteLog: second argument not in cyclic group generated by first argument" + (|getShellEntry| $ 83)) + (EXIT (CONS 1 "failed")))) + (T (SEQ (LETT |faclist| + (SPADCALL + (SPADCALL |groupord| + (|getShellEntry| $ 87)) + (|getShellEntry| $ 89)) + |FFIELDC-;discreteLog;2SU;12|) + (LETT |a| |b| |FFIELDC-;discreteLog;2SU;12|) + (LETT |disclog| 0 + |FFIELDC-;discreteLog;2SU;12|) + (LETT |mult| 1 |FFIELDC-;discreteLog;2SU;12|) + (LETT |exp| |groupord| + |FFIELDC-;discreteLog;2SU;12|) + (LET ((#0=#:G1518 |faclist|)) + (LOOP + (COND + ((ATOM #0#) (RETURN NIL)) + (T (LET ((|f| (CAR #0#))) + (SEQ + (LETT |fac| (CAR |f|) |FFIELDC-;discreteLog;2SU;12|) (LETT |primroot| (SPADCALL |logbase| @@ -444,7 +454,7 @@ (RETURN-FROM |FFIELDC-;discreteLog;2SU;12| (CONS 1 "failed"))) - ('T + (T (SEQ (LETT |rho| (* (CDR |rhoHelp|) @@ -466,8 +476,8 @@ (|getShellEntry| $ 77))))))))))) (SETQ |t| (+ |t| 1))))))))) - (SETQ #0# (CDR #0#)))) - (EXIT (CONS 0 |disclog|))))))))))) + (SETQ #0# (CDR #0#)))) + (EXIT (CONS 0 |disclog|))))))))))) (DEFUN |FFIELDC-;squareFreePolynomial| (|f| $) (SPADCALL |f| (|getShellEntry| $ 96))) @@ -482,37 +492,37 @@ ((SPADCALL |f| (|spadConstant| $ 99) (|getShellEntry| $ 100)) (|spadConstant| $ 101)) - ('T - (SEQ (LETT |flist| - (SPADCALL |f| T (|getShellEntry| $ 105)) - |FFIELDC-;factorSquareFreePolynomial|) - (EXIT (SPADCALL - (SPADCALL (CAR |flist|) - (|getShellEntry| $ 106)) - (LET ((#0=#:G1508 NIL) (#1=#:G1509 T) - (#2=#:G1520 (CDR |flist|))) - (LOOP - (COND - ((ATOM #2#) - (RETURN - (COND - (#1# (|spadConstant| $ 109)) - (T #0#)))) - (T - (LET ((|u| (CAR #2#))) - (LET - ((#3=#:G1507 - (SPADCALL (CAR |u|) (CDR |u|) - (|getShellEntry| $ 107)))) + (T (SEQ (LETT |flist| + (SPADCALL |f| T (|getShellEntry| $ 105)) + |FFIELDC-;factorSquareFreePolynomial|) + (EXIT (SPADCALL + (SPADCALL (CAR |flist|) + (|getShellEntry| $ 106)) + (LET ((#0=#:G1508 NIL) (#1=#:G1509 T) + (#2=#:G1520 (CDR |flist|))) + (LOOP + (COND + ((ATOM #2#) + (RETURN (COND - (#1# (SETQ #0# #3#)) - (T - (SETQ #0# - (SPADCALL #0# #3# - (|getShellEntry| $ 108))))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#)))) - (|getShellEntry| $ 110)))))))))) + (#1# (|spadConstant| $ 109)) + (T #0#)))) + (T + (LET ((|u| (CAR #2#))) + (LET + ((#3=#:G1507 + (SPADCALL (CAR |u|) + (CDR |u|) + (|getShellEntry| $ 107)))) + (COND + (#1# (SETQ #0# #3#)) + (T + (SETQ #0# + (SPADCALL #0# #3# + (|getShellEntry| $ 108))))) + (SETQ #1# NIL))))) + (SETQ #2# (CDR #2#)))) + (|getShellEntry| $ 110)))))))))) (DEFUN |FFIELDC-;gcdPolynomial;3Sup;16| (|f| |g| $) (SPADCALL |f| |g| (|getShellEntry| $ 112))) diff --git a/src/algebra/strap/GCDDOM-.lsp b/src/algebra/strap/GCDDOM-.lsp index 34e0980e..8abb8a01 100644 --- a/src/algebra/strap/GCDDOM-.lsp +++ b/src/algebra/strap/GCDDOM-.lsp @@ -22,17 +22,17 @@ (SPADCALL |x| (|spadConstant| $ 7) (|getShellEntry| $ 9))) (|spadConstant| $ 7)) - ('T - (SEQ (LETT LCM - (SPADCALL |y| - (SPADCALL |x| |y| (|getShellEntry| $ 10)) - (|getShellEntry| $ 12)) - |GCDDOM-;lcm;3S;1|) - (EXIT (COND - ((ZEROP (CAR LCM)) - (SPADCALL |x| (CDR LCM) - (|getShellEntry| $ 13))) - ('T (|error| "bad gcd in lcm computation"))))))))))) + (T (SEQ (LETT LCM + (SPADCALL |y| + (SPADCALL |x| |y| + (|getShellEntry| $ 10)) + (|getShellEntry| $ 12)) + |GCDDOM-;lcm;3S;1|) + (EXIT (COND + ((ZEROP (CAR LCM)) + (SPADCALL |x| (CDR LCM) + (|getShellEntry| $ 13))) + (T (|error| "bad gcd in lcm computation"))))))))))) (DEFUN |GCDDOM-;lcm;LS;2| (|l| $) (SPADCALL (ELT $ 15) |l| (|spadConstant| $ 16) (|spadConstant| $ 7) @@ -50,129 +50,122 @@ (SPADCALL |p2| (|getShellEntry| $ 25))) ((SPADCALL |p2| (|getShellEntry| $ 24)) (SPADCALL |p1| (|getShellEntry| $ 25))) - ('T - (SEQ (LETT |c1| (SPADCALL |p1| (|getShellEntry| $ 26)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (LETT |c2| (SPADCALL |p2| (|getShellEntry| $ 26)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (SETQ |p1| - (LET ((#0=#:G1418 - (SPADCALL |p1| |c1| - (|getShellEntry| $ 27)))) - (|check-union| (ZEROP (CAR #0#)) - (|SparseUnivariatePolynomial| - (|getShellEntry| $ 6)) - #0#) - (CDR #0#))) - (SETQ |p2| - (LET ((#0# (SPADCALL |p2| |c2| - (|getShellEntry| $ 27)))) - (|check-union| (ZEROP (CAR #0#)) - (|SparseUnivariatePolynomial| - (|getShellEntry| $ 6)) - #0#) - (CDR #0#))) - (SEQ (LETT |e1| - (SPADCALL |p1| (|getShellEntry| $ 29)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((PLUSP |e1|) - (SETQ |p1| - (LET - ((#0# - (SPADCALL |p1| + (T (SEQ (LETT |c1| (SPADCALL |p1| (|getShellEntry| $ 26)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (LETT |c2| (SPADCALL |p2| (|getShellEntry| $ 26)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (SETQ |p1| + (LET ((#0=#:G1418 + (SPADCALL |p1| |c1| + (|getShellEntry| $ 27)))) + (|check-union| (ZEROP (CAR #0#)) + (|SparseUnivariatePolynomial| + (|getShellEntry| $ 6)) + #0#) + (CDR #0#))) + (SETQ |p2| + (LET ((#0# (SPADCALL |p2| |c2| + (|getShellEntry| $ 27)))) + (|check-union| (ZEROP (CAR #0#)) + (|SparseUnivariatePolynomial| + (|getShellEntry| $ 6)) + #0#) + (CDR #0#))) + (SEQ (LETT |e1| + (SPADCALL |p1| (|getShellEntry| $ 29)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT (COND + ((PLUSP |e1|) + (SETQ |p1| + (LET + ((#0# + (SPADCALL |p1| + (SPADCALL (|spadConstant| $ 16) + |e1| (|getShellEntry| $ 34)) + (|getShellEntry| $ 35)))) + (|check-union| (ZEROP (CAR #0#)) + (|SparseUnivariatePolynomial| + (|getShellEntry| $ 6)) + #0#) + (CDR #0#))))))) + (SEQ (LETT |e2| + (SPADCALL |p2| (|getShellEntry| $ 29)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT (COND + ((PLUSP |e2|) + (SETQ |p2| + (LET + ((#0# + (SPADCALL |p2| + (SPADCALL (|spadConstant| $ 16) + |e2| (|getShellEntry| $ 34)) + (|getShellEntry| $ 35)))) + (|check-union| (ZEROP (CAR #0#)) + (|SparseUnivariatePolynomial| + (|getShellEntry| $ 6)) + #0#) + (CDR #0#))))))) + (LETT |e1| (MIN |e1| |e2|) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (SETQ |c1| + (SPADCALL |c1| |c2| (|getShellEntry| $ 10))) + (SETQ |p1| + (COND + ((OR (ZEROP (SPADCALL |p1| + (|getShellEntry| $ 37))) + (ZEROP (SPADCALL |p2| + (|getShellEntry| $ 37)))) + (SPADCALL |c1| 0 (|getShellEntry| $ 34))) + (T (SEQ (LETT |p| + (SPADCALL |p1| |p2| + (|getShellEntry| $ 39)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT + (COND + ((ZEROP + (SPADCALL |p| + (|getShellEntry| $ 37))) + (SPADCALL |c1| 0 + (|getShellEntry| $ 34))) + (T + (SEQ + (SETQ |c2| (SPADCALL - (|spadConstant| $ 16) |e1| - (|getShellEntry| $ 34)) - (|getShellEntry| $ 35)))) - (|check-union| - (ZEROP (CAR #0#)) - (|SparseUnivariatePolynomial| - (|getShellEntry| $ 6)) - #0#) - (CDR #0#))))))) - (SEQ (LETT |e2| - (SPADCALL |p2| (|getShellEntry| $ 29)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((PLUSP |e2|) - (SETQ |p2| - (LET - ((#0# - (SPADCALL |p2| + (SPADCALL |p1| + (|getShellEntry| $ 40)) + (SPADCALL |p2| + (|getShellEntry| $ 40)) + (|getShellEntry| $ 10))) + (EXIT (SPADCALL - (|spadConstant| $ 16) |e2| - (|getShellEntry| $ 34)) - (|getShellEntry| $ 35)))) - (|check-union| - (ZEROP (CAR #0#)) - (|SparseUnivariatePolynomial| - (|getShellEntry| $ 6)) - #0#) - (CDR #0#))))))) - (LETT |e1| (MIN |e1| |e2|) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (SETQ |c1| - (SPADCALL |c1| |c2| (|getShellEntry| $ 10))) - (SETQ |p1| - (COND - ((OR (ZEROP (SPADCALL |p1| - (|getShellEntry| $ 37))) - (ZEROP (SPADCALL |p2| - (|getShellEntry| $ 37)))) - (SPADCALL |c1| 0 (|getShellEntry| $ 34))) - ('T - (SEQ (LETT |p| - (SPADCALL |p1| |p2| - (|getShellEntry| $ 39)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((ZEROP - (SPADCALL |p| - (|getShellEntry| $ 37))) - (SPADCALL |c1| 0 - (|getShellEntry| $ 34))) - ('T - (SEQ - (SETQ |c2| - (SPADCALL - (SPADCALL |p1| - (|getShellEntry| $ 40)) - (SPADCALL |p2| - (|getShellEntry| $ 40)) - (|getShellEntry| $ 10))) - (EXIT - (SPADCALL - (SPADCALL |c1| - (SPADCALL - (LET - ((#0# - (SPADCALL - (SPADCALL |c2| |p| - (|getShellEntry| $ - 41)) - (SPADCALL |p| - (|getShellEntry| $ - 40)) + (SPADCALL |c1| + (SPADCALL + (LET + ((#0# + (SPADCALL + (SPADCALL |c2| |p| (|getShellEntry| $ - 27)))) - (|check-union| - (ZEROP (CAR #0#)) - (|SparseUnivariatePolynomial| + 41)) + (SPADCALL |p| (|getShellEntry| $ - 6)) - #0#) - (CDR #0#)) - (|getShellEntry| $ 42)) - (|getShellEntry| $ 41)) - (|getShellEntry| $ 25))))))))))) - (EXIT (COND - ((ZEROP |e1|) |p1|) - ('T - (SPADCALL - (SPADCALL (|spadConstant| $ 16) |e1| - (|getShellEntry| $ 34)) - |p1| (|getShellEntry| $ 44)))))))))))) + 40)) + (|getShellEntry| $ + 27)))) + (|check-union| + (ZEROP (CAR #0#)) + (|SparseUnivariatePolynomial| + (|getShellEntry| $ 6)) + #0#) + (CDR #0#)) + (|getShellEntry| $ 42)) + (|getShellEntry| $ 41)) + (|getShellEntry| $ 25))))))))))) + (EXIT (COND + ((ZEROP |e1|) |p1|) + (T (SPADCALL + (SPADCALL (|spadConstant| $ 16) + |e1| (|getShellEntry| $ 34)) + |p1| (|getShellEntry| $ 44)))))))))))) (DEFUN |GcdDomain&| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) diff --git a/src/algebra/strap/HOAGG-.lsp b/src/algebra/strap/HOAGG-.lsp index c5d5b902..7443870a 100644 --- a/src/algebra/strap/HOAGG-.lsp +++ b/src/algebra/strap/HOAGG-.lsp @@ -107,7 +107,7 @@ (SETQ #1# NIL))))) (SETQ #2# (CDR #2#)) (SETQ #3# (CDR #3#))))) - ('T NIL))) + (T NIL))) (DEFUN |HOAGG-;count;SANni;8| (|s| |x| $) (SPADCALL (CONS #'|HOAGG-;count;SANni;8!0| (VECTOR $ |s|)) |x| diff --git a/src/algebra/strap/HOAGG.lsp b/src/algebra/strap/HOAGG.lsp index d256f98a..44e52b8b 100644 --- a/src/algebra/strap/HOAGG.lsp +++ b/src/algebra/strap/HOAGG.lsp @@ -10,70 +10,69 @@ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) (COND (|HomogeneousAggregate;CAT|) - ('T - (SETQ |HomogeneousAggregate;CAT| - (|Join| (|Aggregate|) - (|mkCategory| '|domain| - '(((|map| - ($ (|Mapping| |t#1| |t#1|) $)) - T) - ((|map!| - ($ (|Mapping| |t#1| |t#1|) $)) + (T (SETQ |HomogeneousAggregate;CAT| + (|Join| (|Aggregate|) + (|mkCategory| '|domain| + '(((|map| + ($ (|Mapping| |t#1| |t#1|) $)) + T) + ((|map!| + ($ (|Mapping| |t#1| |t#1|) $)) + (|has| $ + (ATTRIBUTE |shallowlyMutable|))) + ((|any?| + ((|Boolean|) + (|Mapping| (|Boolean|) |t#1|) + $)) + (|has| $ + (ATTRIBUTE |finiteAggregate|))) + ((|every?| + ((|Boolean|) + (|Mapping| (|Boolean|) |t#1|) + $)) + (|has| $ + (ATTRIBUTE |finiteAggregate|))) + ((|count| + ((|NonNegativeInteger|) + (|Mapping| (|Boolean|) |t#1|) + $)) + (|has| $ + (ATTRIBUTE |finiteAggregate|))) + ((|parts| ((|List| |t#1|) $)) + (|has| $ + (ATTRIBUTE |finiteAggregate|))) + ((|members| ((|List| |t#1|) $)) + (|has| $ + (ATTRIBUTE |finiteAggregate|))) + ((|count| + ((|NonNegativeInteger|) |t#1| + $)) + (AND + (|has| |t#1| (|SetCategory|)) (|has| $ - (ATTRIBUTE |shallowlyMutable|))) - ((|any?| - ((|Boolean|) - (|Mapping| (|Boolean|) |t#1|) - $)) + (ATTRIBUTE |finiteAggregate|)))) + ((|member?| + ((|Boolean|) |t#1| $)) + (AND + (|has| |t#1| (|SetCategory|)) (|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|)) + (ATTRIBUTE |finiteAggregate|))))) + '(((|CoercibleTo| (|OutputForm|)) + (|has| |t#1| + (|CoercibleTo| (|OutputForm|)))) + ((|BasicType|) + (|has| |t#1| (|BasicType|))) + ((|SetCategory|) + (|has| |t#1| (|SetCategory|))) + ((|Evalable| |t#1|) + (AND (|has| |t#1| - (|CoercibleTo| (|OutputForm|)))) - ((|BasicType|) - (|has| |t#1| (|BasicType|))) - ((|SetCategory|) - (|has| |t#1| (|SetCategory|))) - ((|Evalable| |t#1|) - (AND - (|has| |t#1| - (|Evalable| |t#1|)) - (|has| |t#1| (|SetCategory|))))) - '((|Boolean|) - (|NonNegativeInteger|) - (|List| |t#1|)) - NIL)))))))) + (|Evalable| |t#1|)) + (|has| |t#1| (|SetCategory|))))) + '((|Boolean|) + (|NonNegativeInteger|) + (|List| |t#1|)) + NIL)))))))) (|setShellEntry| #0# 0 (LIST '|HomogeneousAggregate| (|devaluate| |t#1|))) #0#)) diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp index bd099bd0..75666112 100644 --- a/src/algebra/strap/ILIST.lsp +++ b/src/algebra/strap/ILIST.lsp @@ -150,22 +150,22 @@ (DEFUN |ILIST;setfirst!;$2S;10| (|x| |s| $) (COND ((NULL |x|) (|error| "Cannot update an empty list")) - ('T (CAR (RPLACA |x| |s|))))) + (T (CAR (RPLACA |x| |s|))))) (DEFUN |ILIST;setelt;$first2S;11| (|x| T2 |s| $) (COND ((NULL |x|) (|error| "Cannot update an empty list")) - ('T (CAR (RPLACA |x| |s|))))) + (T (CAR (RPLACA |x| |s|))))) (DEFUN |ILIST;setrest!;3$;12| (|x| |y| $) (COND ((NULL |x|) (|error| "Cannot update an empty list")) - ('T (CDR (RPLACD |x| |y|))))) + (T (CDR (RPLACD |x| |y|))))) (DEFUN |ILIST;setelt;$rest2$;13| (|x| T3 |y| $) (COND ((NULL |x|) (|error| "Cannot update an empty list")) - ('T (CDR (RPLACD |x| |y|))))) + (T (CDR (RPLACD |x| |y|))))) (DEFUN |ILIST;construct;L$;14| (|l| $) (DECLARE (IGNORE $)) |l|) @@ -223,49 +223,48 @@ (SETQ |y| (NREVERSE |y|)) (EXIT (COND ((NULL |s|) (SPADCALL |y| (|getShellEntry| $ 45))) - ('T - (SEQ (LETT |z| - (SPADCALL - (SPADCALL (|SPADfirst| |x|) - (|getShellEntry| $ 41)) - (|getShellEntry| $ 46)) - |ILIST;coerce;$Of;21|) - (LOOP - (COND - ((NOT (NOT (EQ |s| (CDR |x|)))) - (RETURN NIL)) - (T (SEQ (SETQ |x| (CDR |x|)) - (EXIT - (SETQ |z| - (CONS - (SPADCALL (|SPADfirst| |x|) - (|getShellEntry| $ 41)) - |z|))))))) - (EXIT (SPADCALL - (SPADCALL |y| - (SPADCALL - (SPADCALL (NREVERSE |z|) - (|getShellEntry| $ 47)) - (|getShellEntry| $ 48)) - (|getShellEntry| $ 49)) - (|getShellEntry| $ 45)))))))))))) + (T (SEQ (LETT |z| + (SPADCALL + (SPADCALL (|SPADfirst| |x|) + (|getShellEntry| $ 41)) + (|getShellEntry| $ 46)) + |ILIST;coerce;$Of;21|) + (LOOP + (COND + ((NOT (NOT (EQ |s| (CDR |x|)))) + (RETURN NIL)) + (T (SEQ (SETQ |x| (CDR |x|)) + (EXIT + (SETQ |z| + (CONS + (SPADCALL (|SPADfirst| |x|) + (|getShellEntry| $ 41)) + |z|))))))) + (EXIT (SPADCALL + (SPADCALL |y| + (SPADCALL + (SPADCALL (NREVERSE |z|) + (|getShellEntry| $ 47)) + (|getShellEntry| $ 48)) + (|getShellEntry| $ 49)) + (|getShellEntry| $ 45)))))))))))) (DEFUN |ILIST;=;2$B;22| (|x| |y| $) (SEQ (COND ((EQ |x| |y|) T) - ('T - (SEQ (LOOP - (COND - ((NOT (COND ((NULL |x|) NIL) ('T (NOT (NULL |y|))))) - (RETURN NIL)) - (T (COND - ((SPADCALL (CAR |x|) (CAR |y|) - (|getShellEntry| $ 53)) - (RETURN-FROM |ILIST;=;2$B;22| NIL)) - ('T - (SEQ (SETQ |x| (CDR |x|)) - (EXIT (SETQ |y| (CDR |y|))))))))) - (EXIT (COND ((NULL |x|) (NULL |y|)) ('T NIL)))))))) + (T (SEQ (LOOP + (COND + ((NOT (COND + ((NULL |x|) NIL) + (T (NOT (NULL |y|))))) + (RETURN NIL)) + (T (COND + ((SPADCALL (CAR |x|) (CAR |y|) + (|getShellEntry| $ 53)) + (RETURN-FROM |ILIST;=;2$B;22| NIL)) + (T (SEQ (SETQ |x| (CDR |x|)) + (EXIT (SETQ |y| (CDR |y|))))))))) + (EXIT (COND ((NULL |x|) (NULL |y|)) (T NIL)))))))) (DEFUN |ILIST;latex;$S;23| (|x| $) (LET ((|s| "\\left[")) @@ -289,7 +288,7 @@ (T (COND ((SPADCALL |s| (CAR |x|) (|getShellEntry| $ 59)) (RETURN-FROM |ILIST;member?;S$B;24| T)) - ('T (SETQ |x| (CDR |x|))))))) + (T (SETQ |x| (CDR |x|))))))) (EXIT NIL))) (DEFUN |ILIST;concat!;3$;25| (|x| |y| $) @@ -299,16 +298,14 @@ ((NULL |x|) (COND ((NULL |y|) |x|) - ('T - (SEQ (PUSH (|SPADfirst| |y|) |x|) - (QRPLACD |x| (CDR |y|)) (EXIT |x|))))) - ('T - (SEQ (LETT |z| |x| |ILIST;concat!;3$;25|) - (LOOP - (COND - ((NOT (NOT (NULL (CDR |z|)))) (RETURN NIL)) - (T (SETQ |z| (CDR |z|))))) - (QRPLACD |z| |y|) (EXIT |x|)))))))) + (T (SEQ (PUSH (|SPADfirst| |y|) |x|) + (QRPLACD |x| (CDR |y|)) (EXIT |x|))))) + (T (SEQ (LETT |z| |x| |ILIST;concat!;3$;25|) + (LOOP + (COND + ((NOT (NOT (NULL (CDR |z|)))) (RETURN NIL)) + (T (SETQ |z| (CDR |z|))))) + (QRPLACD |z| |y|) (EXIT |x|)))))))) (DEFUN |ILIST;removeDuplicates!;2$;26| (|l| $) (PROG (|pp| |f| |pr|) @@ -335,7 +332,7 @@ ((SPADCALL (CAR |pr|) |f| (|getShellEntry| $ 59)) (QRPLACD |pp| (CDR |pr|))) - ('T (SETQ |pp| |pr|))))))))))) + (T (SETQ |pp| |pr|))))))))))) (EXIT |l|)))))) (DEFUN |ILIST;sort!;M2$;27| (|f| |l| $) @@ -348,50 +345,49 @@ ((NULL |p|) |q|) ((NULL |q|) |p|) ((EQ |p| |q|) (|error| "cannot merge a list into itself")) - ('T - (SEQ (COND - ((SPADCALL (CAR |p|) (CAR |q|) |f|) - (SEQ (LETT |r| - (LETT |t| |p| |ILIST;merge!;M3$;28|) - |ILIST;merge!;M3$;28|) - (EXIT (SETQ |p| (CDR |p|))))) - ('T - (SEQ (LETT |r| - (LETT |t| |q| |ILIST;merge!;M3$;28|) - |ILIST;merge!;M3$;28|) - (EXIT (SETQ |q| (CDR |q|)))))) - (LOOP - (COND - ((NOT (COND - ((NULL |p|) NIL) - ('T (NOT (NULL |q|))))) - (RETURN NIL)) - (T (COND - ((SPADCALL (CAR |p|) (CAR |q|) |f|) - (SEQ (QRPLACD |t| |p|) - (LETT |t| |p| |ILIST;merge!;M3$;28|) - (EXIT (SETQ |p| (CDR |p|))))) - ('T - (SEQ (QRPLACD |t| |q|) - (LETT |t| |q| |ILIST;merge!;M3$;28|) - (EXIT (SETQ |q| (CDR |q|))))))))) - (QRPLACD |t| (COND ((NULL |p|) |q|) ('T |p|))) - (EXIT |r|)))))))) + (T (SEQ (COND + ((SPADCALL (CAR |p|) (CAR |q|) |f|) + (SEQ (LETT |r| + (LETT |t| |p| |ILIST;merge!;M3$;28|) + |ILIST;merge!;M3$;28|) + (EXIT (SETQ |p| (CDR |p|))))) + (T (SEQ (LETT |r| + (LETT |t| |q| + |ILIST;merge!;M3$;28|) + |ILIST;merge!;M3$;28|) + (EXIT (SETQ |q| (CDR |q|)))))) + (LOOP + (COND + ((NOT (COND + ((NULL |p|) NIL) + (T (NOT (NULL |q|))))) + (RETURN NIL)) + (T (COND + ((SPADCALL (CAR |p|) (CAR |q|) |f|) + (SEQ (QRPLACD |t| |p|) + (LETT |t| |p| + |ILIST;merge!;M3$;28|) + (EXIT (SETQ |p| (CDR |p|))))) + (T (SEQ (QRPLACD |t| |q|) + (LETT |t| |q| + |ILIST;merge!;M3$;28|) + (EXIT (SETQ |q| (CDR |q|))))))))) + (QRPLACD |t| (COND ((NULL |p|) |q|) (T |p|))) + (EXIT |r|)))))))) (DEFUN |ILIST;split!;$I$;29| (|p| |n| $) (PROG (|q|) (RETURN (SEQ (COND ((< |n| 1) (|error| "index out of range")) - ('T - (SEQ (SETQ |p| - (|ILIST;rest;$Nni$;19| |p| - (LET ((#0=#:G1506 (- |n| 1))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - $)) - (LETT |q| (CDR |p|) |ILIST;split!;$I$;29|) - (QRPLACD |p| NIL) (EXIT |q|)))))))) + (T (SEQ (SETQ |p| + (|ILIST;rest;$Nni$;19| |p| + (LET ((#0=#:G1506 (- |n| 1))) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)) + $)) + (LETT |q| (CDR |p|) |ILIST;split!;$I$;29|) + (QRPLACD |p| NIL) (EXIT |q|)))))))) (DEFUN |ILIST;mergeSort| (|f| |p| |n| $) (PROG (|l| |q|) @@ -404,19 +400,18 @@ (SETQ |p| (NREVERSE |p|)))))) (EXIT (COND ((< |n| 3) |p|) - ('T - (SEQ (LETT |l| - (LET ((#0=#:G1511 (QUOTIENT2 |n| 2))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - |ILIST;mergeSort|) - (LETT |q| (|ILIST;split!;$I$;29| |p| |l| $) - |ILIST;mergeSort|) - (SETQ |p| (|ILIST;mergeSort| |f| |p| |l| $)) - (SETQ |q| - (|ILIST;mergeSort| |f| |q| (- |n| |l|) - $)) - (EXIT (|ILIST;merge!;M3$;28| |f| |p| |q| $)))))))))) + (T (SEQ (LETT |l| + (LET ((#0=#:G1511 (QUOTIENT2 |n| 2))) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)) + |ILIST;mergeSort|) + (LETT |q| (|ILIST;split!;$I$;29| |p| |l| $) + |ILIST;mergeSort|) + (SETQ |p| (|ILIST;mergeSort| |f| |p| |l| $)) + (SETQ |q| + (|ILIST;mergeSort| |f| |q| (- |n| |l|) + $)) + (EXIT (|ILIST;merge!;M3$;28| |f| |p| |q| $)))))))))) (DEFUN |IndexedList| (&REST #0=#:G1520 &AUX #1=#:G1518) (DECLARE (SPECIAL |$ConstructorCache|)) @@ -429,12 +424,11 @@ (HGET |$ConstructorCache| '|IndexedList|) '|domainEqualList|)) (|CDRwithIncrement| #2#)) - ('T - (UNWIND-PROTECT - (PROG1 (APPLY (|function| |IndexedList;|) #1#) - (SETQ #2# T)) - (COND - ((NOT #2#) (HREM |$ConstructorCache| '|IndexedList|))))))))) + (T (UNWIND-PROTECT + (PROG1 (APPLY (|function| |IndexedList;|) #1#) + (SETQ #2# T)) + (COND + ((NOT #2#) (HREM |$ConstructorCache| '|IndexedList|))))))))) (DEFUN |IndexedList;| (|#1| |#2|) (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) diff --git a/src/algebra/strap/INS-.lsp b/src/algebra/strap/INS-.lsp index 6df95b2e..7270b8a1 100644 --- a/src/algebra/strap/INS-.lsp +++ b/src/algebra/strap/INS-.lsp @@ -126,9 +126,9 @@ ((SPADCALL |x| (|spadConstant| $ 10) (|getShellEntry| $ 28)) (LET ((#0=#:G1426 (- (SPADCALL |x| (|getShellEntry| $ 30))))) (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#))) - ('T - (LET ((#1=#:G1427 (SPADCALL |x| (|getShellEntry| $ 30)))) - (|check-subtype| (NOT (MINUSP #1#)) '(|NonNegativeInteger|) #1#))))) + (T (LET ((#1=#:G1427 (SPADCALL |x| (|getShellEntry| $ 30)))) + (|check-subtype| (NOT (MINUSP #1#)) '(|NonNegativeInteger|) + #1#))))) (DEFUN |INS-;convert;SF;10| (|x| $) (SPADCALL (SPADCALL |x| (|getShellEntry| $ 30)) @@ -177,9 +177,9 @@ (CONS 0 (|spadConstant| $ 22))) ((SPADCALL |n| (|spadConstant| $ 10) (|getShellEntry| $ 16)) (CONS 0 (SPADCALL |n| (|getShellEntry| $ 19)))) - ('T - (CONS 0 - (SPADCALL (|spadConstant| $ 22) |n| (|getShellEntry| $ 67)))))) + (T (CONS 0 + (SPADCALL (|spadConstant| $ 22) |n| + (|getShellEntry| $ 67)))))) (DEFUN |INS-;patternMatch;SP2Pmr;24| (|x| |p| |l| $) (SPADCALL |x| |p| |l| (|getShellEntry| $ 72))) @@ -197,29 +197,28 @@ (LET ((|r| (SPADCALL |x| |n| (|getShellEntry| $ 80)))) (COND ((SPADCALL |r| (|spadConstant| $ 10) (|getShellEntry| $ 27)) |r|) - ('T - (SEQ (COND - ((SPADCALL |n| (|spadConstant| $ 10) - (|getShellEntry| $ 28)) - (SETQ |n| (SPADCALL |n| (|getShellEntry| $ 19))))) - (EXIT (COND - ((SPADCALL |r| (|spadConstant| $ 10) - (|getShellEntry| $ 16)) - (COND - ((SPADCALL - (SPADCALL 2 |r| (|getShellEntry| $ 82)) |n| - (|getShellEntry| $ 16)) - (SPADCALL |r| |n| (|getShellEntry| $ 67))) - ('T |r|))) - ((NOT (SPADCALL - (SPADCALL - (SPADCALL 2 |r| - (|getShellEntry| $ 82)) - |n| (|getShellEntry| $ 83)) - (|spadConstant| $ 10) - (|getShellEntry| $ 16))) - (SPADCALL |r| |n| (|getShellEntry| $ 83))) - ('T |r|)))))))) + (T (SEQ (COND + ((SPADCALL |n| (|spadConstant| $ 10) + (|getShellEntry| $ 28)) + (SETQ |n| (SPADCALL |n| (|getShellEntry| $ 19))))) + (EXIT (COND + ((SPADCALL |r| (|spadConstant| $ 10) + (|getShellEntry| $ 16)) + (COND + ((SPADCALL + (SPADCALL 2 |r| (|getShellEntry| $ 82)) + |n| (|getShellEntry| $ 16)) + (SPADCALL |r| |n| (|getShellEntry| $ 67))) + (T |r|))) + ((NOT (SPADCALL + (SPADCALL + (SPADCALL 2 |r| + (|getShellEntry| $ 82)) + |n| (|getShellEntry| $ 83)) + (|spadConstant| $ 10) + (|getShellEntry| $ 16))) + (SPADCALL |r| |n| (|getShellEntry| $ 83))) + (T |r|)))))))) (DEFUN |INS-;invmod;3S;28| (|a| |b| $) (PROG (|c| |c1| |d| |d1| |q| |r| |r1|) @@ -258,7 +257,7 @@ (EXIT (COND ((SPADCALL |c1| (|getShellEntry| $ 85)) (SPADCALL |c1| |b| (|getShellEntry| $ 83))) - ('T |c1|))))))) + (T |c1|))))))) (DEFUN |INS-;powmod;4S;29| (|x| |n| |p| $) (PROG (|y| |z|) @@ -271,38 +270,37 @@ (|spadConstant| $ 10)) ((SPADCALL |n| (|getShellEntry| $ 66)) (|spadConstant| $ 22)) - ('T - (SEQ (LETT |y| (|spadConstant| $ 22) - |INS-;powmod;4S;29|) - (LETT |z| |x| |INS-;powmod;4S;29|) - (EXIT (LOOP - (COND - (NIL (RETURN NIL)) - (T - (SEQ - (COND - ((SPADCALL |n| - (|getShellEntry| $ 13)) - (SETQ |y| - (SPADCALL |y| |z| |p| - (|getShellEntry| $ 91))))) - (EXIT - (COND - ((SPADCALL - (SETQ |n| - (SPADCALL |n| - (SPADCALL - (|spadConstant| $ 22) - (|getShellEntry| $ 19)) - (|getShellEntry| $ 20))) - (|getShellEntry| $ 66)) - (RETURN-FROM - |INS-;powmod;4S;29| - |y|)) - ('T - (SETQ |z| - (SPADCALL |z| |z| |p| - (|getShellEntry| $ 91))))))))))))))))))) + (T (SEQ (LETT |y| (|spadConstant| $ 22) + |INS-;powmod;4S;29|) + (LETT |z| |x| |INS-;powmod;4S;29|) + (EXIT (LOOP + (COND + (NIL (RETURN NIL)) + (T + (SEQ + (COND + ((SPADCALL |n| + (|getShellEntry| $ 13)) + (SETQ |y| + (SPADCALL |y| |z| |p| + (|getShellEntry| $ 91))))) + (EXIT + (COND + ((SPADCALL + (SETQ |n| + (SPADCALL |n| + (SPADCALL + (|spadConstant| $ 22) + (|getShellEntry| $ 19)) + (|getShellEntry| $ 20))) + (|getShellEntry| $ 66)) + (RETURN-FROM + |INS-;powmod;4S;29| + |y|)) + (T + (SETQ |z| + (SPADCALL |z| |z| |p| + (|getShellEntry| $ 91))))))))))))))))))) (DEFUN |IntegerNumberSystem&| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp index 5c5fe790..2da51e0e 100644 --- a/src/algebra/strap/INT.lsp +++ b/src/algebra/strap/INT.lsp @@ -274,7 +274,7 @@ (|getShellEntry| $ 15)) (SPADCALL |dev| (- |x|) (|getShellEntry| $ 18)) (EXIT (SPADCALL |dev| (|getShellEntry| $ 19))))) - ('T (SPADCALL |dev| |x| (|getShellEntry| $ 18)))))) + (T (SPADCALL |dev| |x| (|getShellEntry| $ 18)))))) (DEFUN |INT;OMwrite;$S;2| (|x| $) (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) @@ -342,10 +342,10 @@ (DEFUN |INT;addmod;4$;20| (|a| |b| |p| $) (LET ((|c| (+ |a| |b|))) - (COND ((NOT (< |c| |p|)) (- |c| |p|)) ('T |c|)))) + (COND ((NOT (< |c| |p|)) (- |c| |p|)) (T |c|)))) (DEFUN |INT;submod;4$;21| (|a| |b| |p| $) - (LET ((|c| (- |a| |b|))) (COND ((MINUSP |c|) (+ |c| |p|)) ('T |c|)))) + (LET ((|c| (- |a| |b|))) (COND ((MINUSP |c|) (+ |c| |p|)) (T |c|)))) (DEFUN |INT;mulmod;4$;22| (|a| |b| |p| $) (REMAINDER2 (* |a| |b|) |p|)) @@ -377,8 +377,8 @@ (LETT |r| (REMAINDER2 |a| |b|) |INT;positiveRemainder;3$;28|) $) - (COND ((MINUSP |b|) (- |r| |b|)) ('T (+ |r| |b|)))) - ('T |r|))))) + (COND ((MINUSP |b|) (- |r| |b|)) (T (+ |r| |b|)))) + (T |r|))))) (DEFUN |INT;reducedSystem;2M;29| (|m| $) (DECLARE (IGNORE $)) |m|) @@ -445,12 +445,12 @@ (DEFUN |INT;recip;$U;52| (|x| $) (COND ((OR (EQL |x| 1) (EQL |x| -1)) (CONS 0 |x|)) - ('T (CONS 1 "failed")))) + (T (CONS 1 "failed")))) (DEFUN |INT;gcd;3$;53| (|x| |y| $) (DECLARE (IGNORE $)) (GCD |x| |y|)) (DEFUN |INT;unitNormal;$R;54| (|x| $) - (COND ((MINUSP |x|) (VECTOR -1 (- |x|) -1)) ('T (VECTOR 1 |x| 1)))) + (COND ((MINUSP |x|) (VECTOR -1 (- |x|) -1)) (T (VECTOR 1 |x| 1)))) (DEFUN |INT;unitCanonical;2$;55| (|x| $) (DECLARE (IGNORE $)) @@ -468,22 +468,21 @@ ((EQL (SPADCALL |pp| (|getShellEntry| $ 108)) (SPADCALL |p| (|getShellEntry| $ 108))) (SPADCALL |p| (|getShellEntry| $ 110))) - ('T - (SPADCALL (SPADCALL |pp| (|getShellEntry| $ 110)) - (SPADCALL (CONS #'|INT;factorPolynomial!0| $) - (SPADCALL - (LET ((#0=#:G1499 - (SPADCALL - (SPADCALL |p| - (|getShellEntry| $ 108)) - (SPADCALL |pp| - (|getShellEntry| $ 108)) - (|getShellEntry| $ 112)))) - (|check-union| (ZEROP (CAR #0#)) $ #0#) - (CDR #0#)) - (|getShellEntry| $ 114)) - (|getShellEntry| $ 118)) - (|getShellEntry| $ 120)))))) + (T (SPADCALL (SPADCALL |pp| (|getShellEntry| $ 110)) + (SPADCALL (CONS #'|INT;factorPolynomial!0| $) + (SPADCALL + (LET ((#0=#:G1499 + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 108)) + (SPADCALL |pp| + (|getShellEntry| $ 108)) + (|getShellEntry| $ 112)))) + (|check-union| (ZEROP (CAR #0#)) $ #0#) + (CDR #0#)) + (|getShellEntry| $ 114)) + (|getShellEntry| $ 118)) + (|getShellEntry| $ 120)))))) (DEFUN |INT;factorPolynomial!0| (|#1| $) (SPADCALL |#1| (|getShellEntry| $ 111))) @@ -497,7 +496,7 @@ (SPADCALL |q| (|getShellEntry| $ 123))) ((SPADCALL |q| (|getShellEntry| $ 122)) (SPADCALL |p| (|getShellEntry| $ 123))) - ('T (SPADCALL (LIST |p| |q|) (|getShellEntry| $ 126))))) + (T (SPADCALL (LIST |p| |q|) (|getShellEntry| $ 126))))) (DEFUN |Integer| () (DECLARE (SPECIAL |$ConstructorCache|)) @@ -506,12 +505,11 @@ (COND ((SETQ #0# (HGET |$ConstructorCache| '|Integer|)) (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Integer| - (LIST (CONS NIL (CONS 1 (|Integer;|)))))) - (SETQ #0# T)) - (COND ((NOT #0#) (HREM |$ConstructorCache| '|Integer|))))))))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Integer| + (LIST (CONS NIL (CONS 1 (|Integer;|)))))) + (SETQ #0# T)) + (COND ((NOT #0#) (HREM |$ConstructorCache| '|Integer|))))))))) (DEFUN |Integer;| () (LET ((|dv$| (LIST '|Integer|)) ($ (|newShell| 141)) diff --git a/src/algebra/strap/INTDOM-.lsp b/src/algebra/strap/INTDOM-.lsp index 1a7126d9..2f3a9cc0 100644 --- a/src/algebra/strap/INTDOM-.lsp +++ b/src/algebra/strap/INTDOM-.lsp @@ -28,12 +28,12 @@ (DEFUN |INTDOM-;recip;SU;3| (|x| $) (COND ((SPADCALL |x| (|getShellEntry| $ 13)) (CONS 1 "failed")) - ('T (SPADCALL (|spadConstant| $ 7) |x| (|getShellEntry| $ 15))))) + (T (SPADCALL (|spadConstant| $ 7) |x| (|getShellEntry| $ 15))))) (DEFUN |INTDOM-;unit?;SB;4| (|x| $) (COND ((EQL (CAR (SPADCALL |x| (|getShellEntry| $ 17))) 1) NIL) - ('T T))) + (T T))) (DEFUN |INTDOM-;associates?;2SB;5| (|x| |y| $) (SPADCALL (QVELT (SPADCALL |x| (|getShellEntry| $ 10)) 1) @@ -48,7 +48,7 @@ (OR (EQL (CAR (SPADCALL |x| |y| (|getShellEntry| $ 15))) 1) (EQL (CAR (SPADCALL |y| |x| (|getShellEntry| $ 15))) 1))) NIL) - ('T T))) + (T T))) (DEFUN |IntegralDomain&| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) @@ -60,16 +60,14 @@ (|setShellEntry| $ 6 |#1|) (COND ((|HasCategory| |#1| '(|Field|))) - ('T - (|setShellEntry| $ 9 - (CONS (|dispatchFunction| |INTDOM-;unitNormal;SR;1|) $)))) + (T (|setShellEntry| $ 9 + (CONS (|dispatchFunction| |INTDOM-;unitNormal;SR;1|) $)))) (COND ((|HasAttribute| |#1| '|canonicalUnitNormal|) (|setShellEntry| $ 22 (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;5|) $))) - ('T - (|setShellEntry| $ 22 - (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;6|) $)))) + (T (|setShellEntry| $ 22 + (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;6|) $)))) $)) (MAKEPROP '|IntegralDomain&| '|infovec| diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp index 435801a9..2c120ff9 100644 --- a/src/algebra/strap/ISTRING.lsp +++ b/src/algebra/strap/ISTRING.lsp @@ -187,9 +187,8 @@ ((SPADCALL |sg| (|getShellEntry| $ 45)) (- (SPADCALL |sg| (|getShellEntry| $ 46)) (|getShellEntry| $ 6))) - ('T - (- (SPADCALL |s| (|getShellEntry| $ 47)) - (|getShellEntry| $ 6)))))) + (T (- (SPADCALL |s| (|getShellEntry| $ 47)) + (|getShellEntry| $ 6)))))) (SEQ (COND ((OR (OR (MINUSP |l|) (NOT (< |h| |m|))) (< |h| (- |l| 1))) @@ -231,9 +230,8 @@ ((OR (< |i| (|getShellEntry| $ 6)) (< (SPADCALL |s| (|getShellEntry| $ 47)) |i|)) (|error| "index out of range")) - ('T - (SEQ (QESET |s| (- |i| (|getShellEntry| $ 6)) |c|) - (EXIT |c|)))))) + (T (SEQ (QESET |s| (- |i| (|getShellEntry| $ 6)) |c|) + (EXIT |c|)))))) (DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $) (LET ((|np| (QCSIZE |part|)) (|nw| (QCSIZE |whole|))) @@ -241,22 +239,21 @@ (EXIT (COND ((MINUSP |startpos|) (|error| "index out of bounds")) ((< (- |nw| |startpos|) |np|) NIL) - ('T - (SEQ (LET ((|ip| 0) (#0=#:G1538 (- |np| 1)) - (|iw| |startpos|)) - (LOOP - (COND - ((> |ip| #0#) (RETURN NIL)) - (T (COND - ((NOT - (CHAR= (CHAR |part| |ip|) - (CHAR |whole| |iw|))) - (RETURN-FROM - |ISTRING;substring?;2$IB;17| - NIL))))) - (SETQ |ip| (+ |ip| 1)) - (SETQ |iw| (+ |iw| 1)))) - (EXIT T)))))))) + (T (SEQ (LET ((|ip| 0) (#0=#:G1538 (- |np| 1)) + (|iw| |startpos|)) + (LOOP + (COND + ((> |ip| #0#) (RETURN NIL)) + (T (COND + ((NOT + (CHAR= (CHAR |part| |ip|) + (CHAR |whole| |iw|))) + (RETURN-FROM + |ISTRING;substring?;2$IB;17| + NIL))))) + (SETQ |ip| (+ |ip| 1)) + (SETQ |iw| (+ |iw| 1)))) + (EXIT T)))))))) (DEFUN |ISTRING;position;2$2I;18| (|s| |t| |startpos| $) (PROG (|r|) @@ -267,13 +264,12 @@ (|error| "index out of bounds")) ((NOT (< |startpos| (QCSIZE |t|))) (- (|getShellEntry| $ 6) 1)) - ('T - (SEQ (LETT |r| (STRPOS |s| |t| |startpos| NIL) - |ISTRING;position;2$2I;18|) - (EXIT (COND - ((EQ |r| NIL) - (- (|getShellEntry| $ 6) 1)) - ('T (+ |r| (|getShellEntry| $ 6))))))))))))) + (T (SEQ (LETT |r| (STRPOS |s| |t| |startpos| NIL) + |ISTRING;position;2$2I;18|) + (EXIT (COND + ((EQ |r| NIL) + (- (|getShellEntry| $ 6) 1)) + (T (+ |r| (|getShellEntry| $ 6))))))))))))) (DEFUN |ISTRING;position;C$2I;19| (|c| |t| |startpos| $) (SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6))) @@ -281,19 +277,18 @@ ((MINUSP |startpos|) (|error| "index out of bounds")) ((NOT (< |startpos| (QCSIZE |t|))) (- (|getShellEntry| $ 6) 1)) - ('T - (SEQ (LET ((|r| |startpos|) - (#0=#:G1539 (- (QCSIZE |t|) 1))) - (LOOP - (COND - ((> |r| #0#) (RETURN NIL)) - (T (COND - ((CHAR= (CHAR |t| |r|) |c|) - (RETURN-FROM - |ISTRING;position;C$2I;19| - (+ |r| (|getShellEntry| $ 6))))))) - (SETQ |r| (+ |r| 1)))) - (EXIT (- (|getShellEntry| $ 6) 1)))))))) + (T (SEQ (LET ((|r| |startpos|) + (#0=#:G1539 (- (QCSIZE |t|) 1))) + (LOOP + (COND + ((> |r| #0#) (RETURN NIL)) + (T (COND + ((CHAR= (CHAR |t| |r|) |c|) + (RETURN-FROM + |ISTRING;position;C$2I;19| + (+ |r| (|getShellEntry| $ 6))))))) + (SETQ |r| (+ |r| 1)))) + (EXIT (- (|getShellEntry| $ 6) 1)))))))) (DEFUN |ISTRING;position;Cc$2I;20| (|cc| |t| |startpos| $) (SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6))) @@ -301,29 +296,27 @@ ((MINUSP |startpos|) (|error| "index out of bounds")) ((NOT (< |startpos| (QCSIZE |t|))) (- (|getShellEntry| $ 6) 1)) - ('T - (SEQ (LET ((|r| |startpos|) - (#0=#:G1540 (- (QCSIZE |t|) 1))) - (LOOP - (COND - ((> |r| #0#) (RETURN NIL)) - (T (COND - ((SPADCALL (CHAR |t| |r|) |cc| - (|getShellEntry| $ 65)) - (RETURN-FROM - |ISTRING;position;Cc$2I;20| - (+ |r| (|getShellEntry| $ 6))))))) - (SETQ |r| (+ |r| 1)))) - (EXIT (- (|getShellEntry| $ 6) 1)))))))) + (T (SEQ (LET ((|r| |startpos|) + (#0=#:G1540 (- (QCSIZE |t|) 1))) + (LOOP + (COND + ((> |r| #0#) (RETURN NIL)) + (T (COND + ((SPADCALL (CHAR |t| |r|) |cc| + (|getShellEntry| $ 65)) + (RETURN-FROM + |ISTRING;position;Cc$2I;20| + (+ |r| (|getShellEntry| $ 6))))))) + (SETQ |r| (+ |r| 1)))) + (EXIT (- (|getShellEntry| $ 6) 1)))))))) (DEFUN |ISTRING;suffix?;2$B;21| (|s| |t| $) (LET ((|m| (SPADCALL |s| (|getShellEntry| $ 47))) (|n| (SPADCALL |t| (|getShellEntry| $ 47)))) (COND ((< |n| |m|) NIL) - ('T - (|ISTRING;substring?;2$IB;17| |s| |t| - (- (+ (|getShellEntry| $ 6) |n|) |m|) $))))) + (T (|ISTRING;substring?;2$IB;17| |s| |t| + (- (+ (|getShellEntry| $ 6) |n|) |m|) $))))) (DEFUN |ISTRING;split;$CL;22| (|s| |c| $) (PROG (|l| |j|) @@ -334,9 +327,8 @@ (COND ((NOT (COND ((< |n| |i|) NIL) - ('T - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) - |c| (|getShellEntry| $ 69))))) + (T (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) + |c| (|getShellEntry| $ 69))))) (RETURN NIL)) (T (SETQ |i| (+ |i| 1))))) (LETT |l| NIL |ISTRING;split;$CL;22|) @@ -344,12 +336,11 @@ (COND ((NOT (COND ((< |n| |i|) NIL) - ('T - (NOT (< (LETT |j| - (|ISTRING;position;C$2I;19| |c| - |s| |i| $) - |ISTRING;split;$CL;22|) - (|getShellEntry| $ 6)))))) + (T (NOT (< (LETT |j| + (|ISTRING;position;C$2I;19| |c| + |s| |i| $) + |ISTRING;split;$CL;22|) + (|getShellEntry| $ 6)))))) (RETURN NIL)) (T (SEQ (SETQ |l| (SPADCALL @@ -364,7 +355,7 @@ ((NOT (COND ((< |n| |i|) NIL) - ('T + (T (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) @@ -390,9 +381,8 @@ (COND ((NOT (COND ((< |n| |i|) NIL) - ('T - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) - |cc| (|getShellEntry| $ 65))))) + (T (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) + |cc| (|getShellEntry| $ 65))))) (RETURN NIL)) (T (SETQ |i| (+ |i| 1))))) (LETT |l| NIL |ISTRING;split;$CcL;23|) @@ -400,12 +390,11 @@ (COND ((NOT (COND ((< |n| |i|) NIL) - ('T - (NOT (< (LETT |j| - (|ISTRING;position;Cc$2I;20| - |cc| |s| |i| $) - |ISTRING;split;$CcL;23|) - (|getShellEntry| $ 6)))))) + (T (NOT (< (LETT |j| + (|ISTRING;position;Cc$2I;20| |cc| + |s| |i| $) + |ISTRING;split;$CcL;23|) + (|getShellEntry| $ 6)))))) (RETURN NIL)) (T (SEQ (SETQ |l| (SPADCALL @@ -420,7 +409,7 @@ ((NOT (COND ((< |n| |i|) NIL) - ('T + (T (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) @@ -444,9 +433,8 @@ (COND ((NOT (COND ((< |n| |i|) NIL) - ('T - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |c| - (|getShellEntry| $ 69))))) + (T (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |c| + (|getShellEntry| $ 69))))) (RETURN NIL)) (T (SETQ |i| (+ |i| 1))))) (EXIT (|ISTRING;elt;$Us$;31| |s| @@ -459,9 +447,8 @@ (COND ((NOT (COND ((< |n| |i|) NIL) - ('T - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |cc| - (|getShellEntry| $ 65))))) + (T (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |cc| + (|getShellEntry| $ 65))))) (RETURN NIL)) (T (SETQ |i| (+ |i| 1))))) (EXIT (|ISTRING;elt;$Us$;31| |s| @@ -475,7 +462,7 @@ ((NOT (< |j| (|getShellEntry| $ 6))) (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) |c| (|getShellEntry| $ 69))) - ('T NIL))) + (T NIL))) (RETURN NIL)) (T (SETQ |j| (- |j| 1))))) (EXIT (|ISTRING;elt;$Us$;31| |s| @@ -491,7 +478,7 @@ ((NOT (< |j| (|getShellEntry| $ 6))) (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) |cc| (|getShellEntry| $ 65))) - ('T NIL))) + (T NIL))) (RETURN NIL)) (T (SETQ |j| (- |j| 1))))) (EXIT (|ISTRING;elt;$Us$;31| |s| @@ -540,7 +527,7 @@ ((OR (< |i| (|getShellEntry| $ 6)) (< (SPADCALL |s| (|getShellEntry| $ 47)) |i|)) (|error| "index out of range")) - ('T (CHAR |s| (- |i| (|getShellEntry| $ 6)))))) + (T (CHAR |s| (- |i| (|getShellEntry| $ 6)))))) (DEFUN |ISTRING;elt;$Us$;31| (|s| |sg| $) (LET ((|l| (- (SPADCALL |sg| (|getShellEntry| $ 44)) @@ -549,9 +536,8 @@ ((SPADCALL |sg| (|getShellEntry| $ 45)) (- (SPADCALL |sg| (|getShellEntry| $ 46)) (|getShellEntry| $ 6))) - ('T - (- (SPADCALL |s| (|getShellEntry| $ 47)) - (|getShellEntry| $ 6)))))) + (T (- (SPADCALL |s| (|getShellEntry| $ 47)) + (|getShellEntry| $ 6)))))) (SEQ (COND ((OR (MINUSP |l|) (NOT (< |h| (QCSIZE |s|)))) (EXIT (|error| "index out of bound")))) @@ -582,79 +568,84 @@ |ISTRING;match?;2$CB;34|) (EXIT (COND ((EQL |p| (- |m| 1)) (EQUAL |pattern| |target|)) - ('T - (SEQ (COND - ((SPADCALL |p| |m| (|getShellEntry| $ 87)) - (COND - ((NOT (SPADCALL - (|ISTRING;elt;$Us$;31| |pattern| - (SPADCALL |m| (- |p| 1) - (|getShellEntry| $ 24)) - $) - |target| (|getShellEntry| $ 88))) - (EXIT NIL))))) - (LETT |i| |p| |ISTRING;match?;2$CB;34|) - (LETT |q| - (LET ((#1=#:G1526 - (|ISTRING;position;C$2I;19| - |dontcare| |pattern| (+ |p| 1) - $))) - (|check-subtype| (NOT (MINUSP #1#)) - '(|NonNegativeInteger|) #1#)) - |ISTRING;match?;2$CB;34|) - (LOOP + (T (SEQ (COND + ((SPADCALL |p| |m| + (|getShellEntry| $ 87)) + (COND + ((NOT + (SPADCALL + (|ISTRING;elt;$Us$;31| |pattern| + (SPADCALL |m| (- |p| 1) + (|getShellEntry| $ 24)) + $) + |target| (|getShellEntry| $ 88))) + (EXIT NIL))))) + (LETT |i| |p| |ISTRING;match?;2$CB;34|) + (LETT |q| + (LET + ((#1=#:G1526 + (|ISTRING;position;C$2I;19| + |dontcare| |pattern| (+ |p| 1) + $))) + (|check-subtype| + (NOT (MINUSP #1#)) + '(|NonNegativeInteger|) #1#)) + |ISTRING;match?;2$CB;34|) + (LOOP + (COND + ((NOT (SPADCALL |q| (- |m| 1) + (|getShellEntry| $ 87))) + (RETURN NIL)) + (T (SEQ + (LETT |s| + (|ISTRING;elt;$Us$;31| |pattern| + (SPADCALL (+ |p| 1) (- |q| 1) + (|getShellEntry| $ 24)) + $) + |ISTRING;match?;2$CB;34|) + (SETQ |i| + (LET + ((#2=#:G1527 + (|ISTRING;position;2$2I;18| + |s| |target| |i| $))) + (|check-subtype| + (NOT (MINUSP #2#)) + '(|NonNegativeInteger|) #2#))) + (EXIT + (COND + ((EQL |i| (- |m| 1)) + (RETURN-FROM + |ISTRING;match?;2$CB;34| + NIL)) + (T + (SEQ + (SETQ |i| + (+ |i| (QCSIZE |s|))) + (SETQ |p| |q|) + (EXIT + (SETQ |q| + (LET + ((#3=#:G1528 + (|ISTRING;position;C$2I;19| + |dontcare| |pattern| + (+ |q| 1) $))) + (|check-subtype| + (NOT (MINUSP #3#)) + '(|NonNegativeInteger|) + #3#)))))))))))) (COND - ((NOT (SPADCALL |q| (- |m| 1) - (|getShellEntry| $ 87))) - (RETURN NIL)) - (T (SEQ (LETT |s| - (|ISTRING;elt;$Us$;31| - |pattern| - (SPADCALL (+ |p| 1) (- |q| 1) - (|getShellEntry| $ 24)) - $) - |ISTRING;match?;2$CB;34|) - (SETQ |i| - (LET - ((#2=#:G1527 - (|ISTRING;position;2$2I;18| - |s| |target| |i| $))) - (|check-subtype| - (NOT (MINUSP #2#)) - '(|NonNegativeInteger|) #2#))) - (EXIT - (COND - ((EQL |i| (- |m| 1)) - (RETURN-FROM - |ISTRING;match?;2$CB;34| - NIL)) - ('T - (SEQ - (SETQ |i| - (+ |i| (QCSIZE |s|))) - (SETQ |p| |q|) - (EXIT - (SETQ |q| - (LET - ((#3=#:G1528 - (|ISTRING;position;C$2I;19| - |dontcare| |pattern| - (+ |q| 1) $))) - (|check-subtype| - (NOT (MINUSP #3#)) - '(|NonNegativeInteger|) - #3#)))))))))))) - (COND - ((SPADCALL |p| |n| (|getShellEntry| $ 87)) - (COND - ((NOT (|ISTRING;suffix?;2$B;21| - (|ISTRING;elt;$Us$;31| |pattern| - (SPADCALL (+ |p| 1) |n| - (|getShellEntry| $ 24)) - $) - |target| $)) - (EXIT NIL))))) - (EXIT T)))))))))) + ((SPADCALL |p| |n| + (|getShellEntry| $ 87)) + (COND + ((NOT + (|ISTRING;suffix?;2$B;21| + (|ISTRING;elt;$Us$;31| |pattern| + (SPADCALL (+ |p| 1) |n| + (|getShellEntry| $ 24)) + $) + |target| $)) + (EXIT NIL))))) + (EXIT T)))))))))) (DEFUN |IndexedString| (#0=#:G1543) (DECLARE (SPECIAL |$ConstructorCache|)) @@ -666,11 +657,10 @@ (HGET |$ConstructorCache| '|IndexedString|) '|domainEqualList|)) (|CDRwithIncrement| #1#)) - ('T - (UNWIND-PROTECT - (PROG1 (|IndexedString;| #0#) (SETQ #1# T)) - (COND - ((NOT #1#) (HREM |$ConstructorCache| '|IndexedString|))))))))) + (T (UNWIND-PROTECT + (PROG1 (|IndexedString;| #0#) (SETQ #1# T)) + (COND + ((NOT #1#) (HREM |$ConstructorCache| '|IndexedString|))))))))) (DEFUN |IndexedString;| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp index 5e52d0bc..5ab75d13 100644 --- a/src/algebra/strap/LIST.lsp +++ b/src/algebra/strap/LIST.lsp @@ -176,10 +176,9 @@ (HGET |$ConstructorCache| '|List|) '|domainEqualList|)) (|CDRwithIncrement| #1#)) - ('T - (UNWIND-PROTECT - (PROG1 (|List;| #0#) (SETQ #1# T)) - (COND ((NOT #1#) (HREM |$ConstructorCache| '|List|))))))))) + (T (UNWIND-PROTECT + (PROG1 (|List;| #0#) (SETQ #1# T)) + (COND ((NOT #1#) (HREM |$ConstructorCache| '|List|))))))))) (DEFUN |List;| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$| (LIST '|List| |dv$1|)) diff --git a/src/algebra/strap/LNAGG-.lsp b/src/algebra/strap/LNAGG-.lsp index e0bd3c89..f14a10d8 100644 --- a/src/algebra/strap/LNAGG-.lsp +++ b/src/algebra/strap/LNAGG-.lsp @@ -34,7 +34,7 @@ (COND ((NOT (< |i| (SPADCALL |a| (|getShellEntry| $ 9)))) (NOT (< (SPADCALL |a| (|getShellEntry| $ 10)) |i|))) - ('T NIL))) + (T NIL))) (DEFUN |LNAGG-;concat;ASA;3| (|a| |x| $) (SPADCALL |a| (SPADCALL 1 |x| (|getShellEntry| $ 22)) diff --git a/src/algebra/strap/LNAGG.lsp b/src/algebra/strap/LNAGG.lsp index 42e509b5..cd27da9b 100644 --- a/src/algebra/strap/LNAGG.lsp +++ b/src/algebra/strap/LNAGG.lsp @@ -14,52 +14,52 @@ '(|UniversalSegment| (|Integer|)))) (COND (|LinearAggregate;CAT|) - ('T - (SETQ |LinearAggregate;CAT| - (|Join| (|IndexedAggregate| '#1# '|t#1|) - (|Collection| '|t#1|) - (|Eltable| '#2# '$) - (|mkCategory| '|domain| - '(((|new| - ($ (|NonNegativeInteger|) - |t#1|)) - T) - ((|concat| ($ $ |t#1|)) T) - ((|concat| ($ |t#1| $)) T) - ((|concat| ($ $ $)) T) - ((|concat| ($ (|List| $))) T) - ((|map| - ($ - (|Mapping| |t#1| |t#1| - |t#1|) - $ $)) - T) - ((|delete| ($ $ (|Integer|))) - T) - ((|delete| - ($ $ - (|UniversalSegment| - (|Integer|)))) - T) - ((|insert| - ($ |t#1| $ (|Integer|))) - T) - ((|insert| ($ $ $ (|Integer|))) - T) - ((|setelt| - (|t#1| $ - (|UniversalSegment| - (|Integer|)) - |t#1|)) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|)))) - NIL - '((|UniversalSegment| - (|Integer|)) - (|Integer|) (|List| $) - (|NonNegativeInteger|)) - NIL))))))))) + (T (SETQ |LinearAggregate;CAT| + (|Join| (|IndexedAggregate| '#1# '|t#1|) + (|Collection| '|t#1|) + (|Eltable| '#2# '$) + (|mkCategory| '|domain| + '(((|new| + ($ (|NonNegativeInteger|) + |t#1|)) + T) + ((|concat| ($ $ |t#1|)) T) + ((|concat| ($ |t#1| $)) T) + ((|concat| ($ $ $)) T) + ((|concat| ($ (|List| $))) T) + ((|map| + ($ + (|Mapping| |t#1| |t#1| + |t#1|) + $ $)) + T) + ((|delete| ($ $ (|Integer|))) + T) + ((|delete| + ($ $ + (|UniversalSegment| + (|Integer|)))) + T) + ((|insert| + ($ |t#1| $ (|Integer|))) + T) + ((|insert| + ($ $ $ (|Integer|))) + T) + ((|setelt| + (|t#1| $ + (|UniversalSegment| + (|Integer|)) + |t#1|)) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|)))) + NIL + '((|UniversalSegment| + (|Integer|)) + (|Integer|) (|List| $) + (|NonNegativeInteger|)) + NIL))))))))) (|setShellEntry| #0# 0 (LIST '|LinearAggregate| (|devaluate| |t#1|))) #0#)) diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp index 85d05973..747351b5 100644 --- a/src/algebra/strap/LSAGG-.lsp +++ b/src/algebra/strap/LSAGG-.lsp @@ -99,9 +99,9 @@ (COND ((SPADCALL |x| (|getShellEntry| $ 16)) (|error| "reducing over an empty list needs the 3 argument form")) - ('T - (SPADCALL |f| (SPADCALL |x| (|getShellEntry| $ 17)) - (SPADCALL |x| (|getShellEntry| $ 18)) (|getShellEntry| $ 20))))) + (T (SPADCALL |f| (SPADCALL |x| (|getShellEntry| $ 17)) + (SPADCALL |x| (|getShellEntry| $ 18)) + (|getShellEntry| $ 20))))) (DEFUN |LSAGG-;merge;M3A;4| (|f| |p| |q| $) (SPADCALL |f| (SPADCALL |p| (|getShellEntry| $ 22)) @@ -114,44 +114,43 @@ (COND ((NOT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T - (NOT (SPADCALL - (SPADCALL |x| (|getShellEntry| $ 18)) - |f|))))) + (T (NOT (SPADCALL + (SPADCALL |x| + (|getShellEntry| $ 18)) + |f|))))) (RETURN NIL)) (T (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 17)))))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) |x|) - ('T - (SEQ (LETT |y| |x| |LSAGG-;select!;M2A;5|) - (LETT |z| - (SPADCALL |y| (|getShellEntry| $ 17)) - |LSAGG-;select!;M2A;5|) - (LOOP - (COND - ((NOT (NOT - (SPADCALL |z| - (|getShellEntry| $ 16)))) - (RETURN NIL)) - (T (COND - ((SPADCALL - (SPADCALL |z| - (|getShellEntry| $ 18)) - |f|) - (SEQ (SETQ |y| |z|) - (EXIT - (SETQ |z| + (T (SEQ (LETT |y| |x| |LSAGG-;select!;M2A;5|) + (LETT |z| + (SPADCALL |y| (|getShellEntry| $ 17)) + |LSAGG-;select!;M2A;5|) + (LOOP + (COND + ((NOT (NOT (SPADCALL |z| - (|getShellEntry| $ 17)))))) - ('T - (SEQ - (SETQ |z| - (SPADCALL |z| - (|getShellEntry| $ 17))) - (EXIT - (SPADCALL |y| |z| - (|getShellEntry| $ 27))))))))) - (EXIT |x|))))))))) + (|getShellEntry| $ 16)))) + (RETURN NIL)) + (T (COND + ((SPADCALL + (SPADCALL |z| + (|getShellEntry| $ 18)) + |f|) + (SEQ (SETQ |y| |z|) + (EXIT + (SETQ |z| + (SPADCALL |z| + (|getShellEntry| $ 17)))))) + (T + (SEQ + (SETQ |z| + (SPADCALL |z| + (|getShellEntry| $ 17))) + (EXIT + (SPADCALL |y| |z| + (|getShellEntry| $ 27))))))))) + (EXIT |x|))))))))) (DEFUN |LSAGG-;merge!;M3A;6| (|f| |p| |q| $) (PROG (|r| |t|) @@ -161,56 +160,61 @@ ((SPADCALL |q| (|getShellEntry| $ 16)) |p|) ((SPADCALL |p| |q| (|getShellEntry| $ 30)) (|error| "cannot merge a list into itself")) - ('T - (SEQ (COND - ((SPADCALL (SPADCALL |p| (|getShellEntry| $ 18)) - (SPADCALL |q| (|getShellEntry| $ 18)) |f|) - (SEQ (LETT |r| - (LETT |t| |p| |LSAGG-;merge!;M3A;6|) - |LSAGG-;merge!;M3A;6|) - (EXIT (SETQ |p| - (SPADCALL |p| - (|getShellEntry| $ 17)))))) - ('T - (SEQ (LETT |r| - (LETT |t| |q| |LSAGG-;merge!;M3A;6|) - |LSAGG-;merge!;M3A;6|) - (EXIT (SETQ |q| - (SPADCALL |q| - (|getShellEntry| $ 17))))))) - (LOOP - (COND - ((NOT (COND - ((SPADCALL |p| (|getShellEntry| $ 16)) - NIL) - ('T - (NOT (SPADCALL |q| - (|getShellEntry| $ 16)))))) - (RETURN NIL)) - (T (COND - ((SPADCALL - (SPADCALL |p| (|getShellEntry| $ 18)) - (SPADCALL |q| (|getShellEntry| $ 18)) - |f|) - (SEQ (SPADCALL |t| |p| - (|getShellEntry| $ 27)) - (LETT |t| |p| |LSAGG-;merge!;M3A;6|) - (EXIT (SETQ |p| - (SPADCALL |p| - (|getShellEntry| $ 17)))))) - ('T - (SEQ (SPADCALL |t| |q| - (|getShellEntry| $ 27)) - (LETT |t| |q| |LSAGG-;merge!;M3A;6|) - (EXIT (SETQ |q| - (SPADCALL |q| - (|getShellEntry| $ 17)))))))))) - (SPADCALL |t| + (T (SEQ (COND + ((SPADCALL (SPADCALL |p| (|getShellEntry| $ 18)) + (SPADCALL |q| (|getShellEntry| $ 18)) + |f|) + (SEQ (LETT |r| + (LETT |t| |p| |LSAGG-;merge!;M3A;6|) + |LSAGG-;merge!;M3A;6|) + (EXIT (SETQ |p| + (SPADCALL |p| + (|getShellEntry| $ 17)))))) + (T (SEQ (LETT |r| + (LETT |t| |q| + |LSAGG-;merge!;M3A;6|) + |LSAGG-;merge!;M3A;6|) + (EXIT (SETQ |q| + (SPADCALL |q| + (|getShellEntry| $ 17))))))) + (LOOP (COND - ((SPADCALL |p| (|getShellEntry| $ 16)) |q|) - ('T |p|)) - (|getShellEntry| $ 27)) - (EXIT |r|)))))))) + ((NOT (COND + ((SPADCALL |p| (|getShellEntry| $ 16)) + NIL) + (T (NOT + (SPADCALL |q| + (|getShellEntry| $ 16)))))) + (RETURN NIL)) + (T (COND + ((SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 18)) + (SPADCALL |q| + (|getShellEntry| $ 18)) + |f|) + (SEQ (SPADCALL |t| |p| + (|getShellEntry| $ 27)) + (LETT |t| |p| + |LSAGG-;merge!;M3A;6|) + (EXIT + (SETQ |p| + (SPADCALL |p| + (|getShellEntry| $ 17)))))) + (T (SEQ (SPADCALL |t| |q| + (|getShellEntry| $ 27)) + (LETT |t| |q| + |LSAGG-;merge!;M3A;6|) + (EXIT + (SETQ |q| + (SPADCALL |q| + (|getShellEntry| $ 17)))))))))) + (SPADCALL |t| + (COND + ((SPADCALL |p| (|getShellEntry| $ 16)) |q|) + (T |p|)) + (|getShellEntry| $ 27)) + (EXIT |r|)))))))) (DEFUN |LSAGG-;insert!;SAIA;7| (|s| |x| |i| $) (PROG (|y| |z|) @@ -219,19 +223,19 @@ (COND ((< |i| |m|) (|error| "index out of range")) ((EQL |i| |m|) (SPADCALL |s| |x| (|getShellEntry| $ 14))) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (LET ((#0=#:G1467 (- (- |i| 1) |m|))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 39)) - |LSAGG-;insert!;SAIA;7|) - (LETT |z| (SPADCALL |y| (|getShellEntry| $ 17)) - |LSAGG-;insert!;SAIA;7|) - (SPADCALL |y| (SPADCALL |s| |z| (|getShellEntry| $ 14)) - (|getShellEntry| $ 27)) - (EXIT |x|)))))))) + (T (SEQ (LETT |y| + (SPADCALL |x| + (LET ((#0=#:G1467 (- (- |i| 1) |m|))) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 39)) + |LSAGG-;insert!;SAIA;7|) + (LETT |z| (SPADCALL |y| (|getShellEntry| $ 17)) + |LSAGG-;insert!;SAIA;7|) + (SPADCALL |y| + (SPADCALL |s| |z| (|getShellEntry| $ 14)) + (|getShellEntry| $ 27)) + (EXIT |x|)))))))) (DEFUN |LSAGG-;insert!;2AIA;8| (|w| |x| |i| $) (PROG (|y| |z|) @@ -240,18 +244,17 @@ (COND ((< |i| |m|) (|error| "index out of range")) ((EQL |i| |m|) (SPADCALL |w| |x| (|getShellEntry| $ 41))) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (LET ((#0=#:G1471 (- (- |i| 1) |m|))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 39)) - |LSAGG-;insert!;2AIA;8|) - (LETT |z| (SPADCALL |y| (|getShellEntry| $ 17)) - |LSAGG-;insert!;2AIA;8|) - (SPADCALL |y| |w| (|getShellEntry| $ 27)) - (SPADCALL |y| |z| (|getShellEntry| $ 41)) (EXIT |x|)))))))) + (T (SEQ (LETT |y| + (SPADCALL |x| + (LET ((#0=#:G1471 (- (- |i| 1) |m|))) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 39)) + |LSAGG-;insert!;2AIA;8|) + (LETT |z| (SPADCALL |y| (|getShellEntry| $ 17)) + |LSAGG-;insert!;2AIA;8|) + (SPADCALL |y| |w| (|getShellEntry| $ 27)) + (SPADCALL |y| |z| (|getShellEntry| $ 41)) (EXIT |x|)))))))) (DEFUN |LSAGG-;remove!;M2A;9| (|f| |x| $) (PROG (|p| |q|) @@ -260,41 +263,40 @@ (COND ((NOT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18)) - |f|)))) + (T (SPADCALL + (SPADCALL |x| (|getShellEntry| $ 18)) + |f|)))) (RETURN NIL)) (T (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 17)))))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) |x|) - ('T - (SEQ (LETT |p| |x| |LSAGG-;remove!;M2A;9|) - (LETT |q| - (SPADCALL |x| (|getShellEntry| $ 17)) - |LSAGG-;remove!;M2A;9|) - (LOOP - (COND - ((NOT (NOT - (SPADCALL |q| - (|getShellEntry| $ 16)))) - (RETURN NIL)) - (T (COND - ((SPADCALL - (SPADCALL |q| - (|getShellEntry| $ 18)) - |f|) - (SETQ |q| - (SPADCALL |p| - (SPADCALL |q| - (|getShellEntry| $ 17)) - (|getShellEntry| $ 27)))) - ('T - (SEQ (SETQ |p| |q|) - (EXIT - (SETQ |q| + (T (SEQ (LETT |p| |x| |LSAGG-;remove!;M2A;9|) + (LETT |q| + (SPADCALL |x| (|getShellEntry| $ 17)) + |LSAGG-;remove!;M2A;9|) + (LOOP + (COND + ((NOT (NOT + (SPADCALL |q| + (|getShellEntry| $ 16)))) + (RETURN NIL)) + (T (COND + ((SPADCALL (SPADCALL |q| - (|getShellEntry| $ 17)))))))))) - (EXIT |x|))))))))) + (|getShellEntry| $ 18)) + |f|) + (SETQ |q| + (SPADCALL |p| + (SPADCALL |q| + (|getShellEntry| $ 17)) + (|getShellEntry| $ 27)))) + (T + (SEQ (SETQ |p| |q|) + (EXIT + (SETQ |q| + (SPADCALL |q| + (|getShellEntry| $ 17)))))))))) + (EXIT |x|))))))))) (DEFUN |LSAGG-;delete!;AIA;10| (|x| |i| $) (PROG (|y|) @@ -303,17 +305,16 @@ (COND ((< |i| |m|) (|error| "index out of range")) ((EQL |i| |m|) (SPADCALL |x| (|getShellEntry| $ 17))) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (LET ((#0=#:G1483 (- (- |i| 1) |m|))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 39)) - |LSAGG-;delete!;AIA;10|) - (SPADCALL |y| (SPADCALL |y| 2 (|getShellEntry| $ 39)) - (|getShellEntry| $ 27)) - (EXIT |x|)))))))) + (T (SEQ (LETT |y| + (SPADCALL |x| + (LET ((#0=#:G1483 (- (- |i| 1) |m|))) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 39)) + |LSAGG-;delete!;AIA;10|) + (SPADCALL |y| (SPADCALL |y| 2 (|getShellEntry| $ 39)) + (|getShellEntry| $ 27)) + (EXIT |x|)))))))) (DEFUN |LSAGG-;delete!;AUsA;11| (|x| |i| $) (PROG (|h| |t|) @@ -322,56 +323,56 @@ (|m| (SPADCALL |x| (|getShellEntry| $ 33)))) (COND ((< |l| |m|) (|error| "index out of range")) - ('T - (SEQ (LETT |h| - (COND - ((SPADCALL |i| (|getShellEntry| $ 47)) - (SPADCALL |i| (|getShellEntry| $ 48))) - ('T (SPADCALL |x| (|getShellEntry| $ 49)))) - |LSAGG-;delete!;AUsA;11|) - (EXIT (COND - ((< |h| |l|) |x|) - ((EQL |l| |m|) - (SPADCALL |x| - (LET ((#0=#:G1489 (- (+ |h| 1) |m|))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 39))) - ('T - (SEQ (LETT |t| - (SPADCALL |x| - (LET - ((#1=#:G1490 (- (- |l| 1) |m|))) - (|check-subtype| - (NOT (MINUSP #1#)) - '(|NonNegativeInteger|) #1#)) - (|getShellEntry| $ 39)) - |LSAGG-;delete!;AUsA;11|) - (SPADCALL |t| + (T (SEQ (LETT |h| + (COND + ((SPADCALL |i| (|getShellEntry| $ 47)) + (SPADCALL |i| (|getShellEntry| $ 48))) + (T (SPADCALL |x| (|getShellEntry| $ 49)))) + |LSAGG-;delete!;AUsA;11|) + (EXIT (COND + ((< |h| |l|) |x|) + ((EQL |l| |m|) + (SPADCALL |x| + (LET ((#0=#:G1489 (- (+ |h| 1) |m|))) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 39))) + (T (SEQ (LETT |t| + (SPADCALL |x| + (LET + ((#1=#:G1490 + (- (- |l| 1) |m|))) + (|check-subtype| + (NOT (MINUSP #1#)) + '(|NonNegativeInteger|) + #1#)) + (|getShellEntry| $ 39)) + |LSAGG-;delete!;AUsA;11|) (SPADCALL |t| - (LET - ((#2=#:G1491 (+ (- |h| |l|) 2))) - (|check-subtype| - (NOT (MINUSP #2#)) - '(|NonNegativeInteger|) #2#)) - (|getShellEntry| $ 39)) - (|getShellEntry| $ 27)) - (EXIT |x|)))))))))))) + (SPADCALL |t| + (LET + ((#2=#:G1491 (+ (- |h| |l|) 2))) + (|check-subtype| + (NOT (MINUSP #2#)) + '(|NonNegativeInteger|) #2#)) + (|getShellEntry| $ 39)) + (|getShellEntry| $ 27)) + (EXIT |x|)))))))))))) (DEFUN |LSAGG-;find;MAU;12| (|f| |x| $) (SEQ (LOOP (COND ((NOT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T - (NOT (SPADCALL - (SPADCALL |x| (|getShellEntry| $ 18)) |f|))))) + (T (NOT (SPADCALL + (SPADCALL |x| (|getShellEntry| $ 18)) + |f|))))) (RETURN NIL)) (T (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 17)))))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) (CONS 1 "failed")) - ('T (CONS 0 (SPADCALL |x| (|getShellEntry| $ 18)))))))) + (T (CONS 0 (SPADCALL |x| (|getShellEntry| $ 18)))))))) (DEFUN |LSAGG-;position;MAI;13| (|f| |x| $) (LET ((|k| (SPADCALL |x| (|getShellEntry| $ 33)))) @@ -379,17 +380,16 @@ (COND ((NOT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T - (NOT (SPADCALL - (SPADCALL |x| (|getShellEntry| $ 18)) - |f|))))) + (T (NOT (SPADCALL + (SPADCALL |x| (|getShellEntry| $ 18)) + |f|))))) (RETURN NIL)) (T (SEQ (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 17))) (EXIT (SETQ |k| (+ |k| 1))))))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) (- (SPADCALL |x| (|getShellEntry| $ 33)) 1)) - ('T |k|)))))) + (T |k|)))))) (DEFUN |LSAGG-;mergeSort| (|f| |p| |n| $) (PROG (|l| |q|) @@ -404,48 +404,50 @@ (SETQ |p| (SPADCALL |p| (|getShellEntry| $ 55))))))) (EXIT (COND ((< |n| 3) |p|) - ('T - (SEQ (LETT |l| - (LET ((#0=#:G1511 (QUOTIENT2 |n| 2))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - |LSAGG-;mergeSort|) - (LETT |q| - (SPADCALL |p| |l| - (|getShellEntry| $ 57)) - |LSAGG-;mergeSort|) - (SETQ |p| (|LSAGG-;mergeSort| |f| |p| |l| $)) - (SETQ |q| - (|LSAGG-;mergeSort| |f| |q| (- |n| |l|) - $)) - (EXIT (SPADCALL |f| |p| |q| - (|getShellEntry| $ 23))))))))))) + (T (SEQ (LETT |l| + (LET ((#0=#:G1511 (QUOTIENT2 |n| 2))) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)) + |LSAGG-;mergeSort|) + (LETT |q| + (SPADCALL |p| |l| + (|getShellEntry| $ 57)) + |LSAGG-;mergeSort|) + (SETQ |p| + (|LSAGG-;mergeSort| |f| |p| |l| $)) + (SETQ |q| + (|LSAGG-;mergeSort| |f| |q| + (- |n| |l|) $)) + (EXIT (SPADCALL |f| |p| |q| + (|getShellEntry| $ 23))))))))))) (DEFUN |LSAGG-;sorted?;MAB;15| (|f| |l| $) (PROG (|p|) (RETURN (SEQ (COND ((SPADCALL |l| (|getShellEntry| $ 16)) T) - ('T - (SEQ (LETT |p| (SPADCALL |l| (|getShellEntry| $ 17)) - |LSAGG-;sorted?;MAB;15|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |p| (|getShellEntry| $ 16)))) - (RETURN NIL)) - (T (SEQ (COND - ((NOT (SPADCALL - (SPADCALL |l| - (|getShellEntry| $ 18)) - (SPADCALL |p| - (|getShellEntry| $ 18)) - |f|)) - (RETURN-FROM |LSAGG-;sorted?;MAB;15| - NIL))) - (EXIT (SETQ |p| - (SPADCALL (SETQ |l| |p|) - (|getShellEntry| $ 17)))))))) - (EXIT T)))))))) + (T (SEQ (LETT |p| (SPADCALL |l| (|getShellEntry| $ 17)) + |LSAGG-;sorted?;MAB;15|) + (LOOP + (COND + ((NOT (NOT (SPADCALL |p| + (|getShellEntry| $ 16)))) + (RETURN NIL)) + (T (SEQ (COND + ((NOT + (SPADCALL + (SPADCALL |l| + (|getShellEntry| $ 18)) + (SPADCALL |p| + (|getShellEntry| $ 18)) + |f|)) + (RETURN-FROM + |LSAGG-;sorted?;MAB;15| + NIL))) + (EXIT (SETQ |p| + (SPADCALL (SETQ |l| |p|) + (|getShellEntry| $ 17)))))))) + (EXIT T)))))))) (DEFUN |LSAGG-;reduce;MA2S;16| (|f| |x| |i| $) (LET ((|r| |i|)) @@ -467,7 +469,7 @@ (COND ((NOT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T (SPADCALL |r| |a| (|getShellEntry| $ 61))))) + (T (SPADCALL |r| |a| (|getShellEntry| $ 61))))) (RETURN NIL)) (T (SEQ (SETQ |r| (SPADCALL |r| @@ -493,7 +495,7 @@ (COND ((NOT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T (NOT (SPADCALL |y| (|getShellEntry| $ 16)))))) + (T (NOT (SPADCALL |y| (|getShellEntry| $ 16)))))) (RETURN NIL)) (T (SEQ (SETQ |z| (SPADCALL @@ -519,23 +521,23 @@ |LSAGG-;reverse!;2A;20|) (|getShellEntry| $ 16))) |x|) - ('T - (SEQ (SPADCALL |x| (SPADCALL (|getShellEntry| $ 13)) - (|getShellEntry| $ 27)) - (LOOP - (COND - ((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 16)))) - (RETURN NIL)) - (T (SEQ (LETT |z| - (SPADCALL |y| - (|getShellEntry| $ 17)) - |LSAGG-;reverse!;2A;20|) - (SPADCALL |y| |x| - (|getShellEntry| $ 27)) - (SETQ |x| |y|) - (EXIT (LETT |y| |z| - |LSAGG-;reverse!;2A;20|)))))) - (EXIT |x|)))))))) + (T (SEQ (SPADCALL |x| (SPADCALL (|getShellEntry| $ 13)) + (|getShellEntry| $ 27)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |y| + (|getShellEntry| $ 16)))) + (RETURN NIL)) + (T (SEQ (LETT |z| + (SPADCALL |y| + (|getShellEntry| $ 17)) + |LSAGG-;reverse!;2A;20|) + (SPADCALL |y| |x| + (|getShellEntry| $ 27)) + (SETQ |x| |y|) + (EXIT (LETT |y| |z| + |LSAGG-;reverse!;2A;20|)))))) + (EXIT |x|)))))))) (DEFUN |LSAGG-;copy;2A;21| (|x| $) (LET ((|y| (SPADCALL (|getShellEntry| $ 13)))) @@ -565,30 +567,31 @@ (LET ((|m| (SPADCALL |y| (|getShellEntry| $ 33)))) (COND ((< |s| |m|) (|error| "index out of range")) - ('T - (SEQ (LETT |z| - (SPADCALL |y| - (LET ((#0=#:G1552 (- |s| |m|))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 39)) - |LSAGG-;copyInto!;2AIA;22|) - (LOOP - (COND - ((NOT (COND - ((SPADCALL |z| (|getShellEntry| $ 16)) NIL) - ('T - (NOT (SPADCALL |x| (|getShellEntry| $ 16)))))) - (RETURN NIL)) - (T (SEQ (SPADCALL |z| - (SPADCALL |x| (|getShellEntry| $ 18)) - (|getShellEntry| $ 69)) - (SETQ |x| - (SPADCALL |x| (|getShellEntry| $ 17))) - (EXIT (SETQ |z| - (SPADCALL |z| - (|getShellEntry| $ 17)))))))) - (EXIT |y|)))))))) + (T (SEQ (LETT |z| + (SPADCALL |y| + (LET ((#0=#:G1552 (- |s| |m|))) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 39)) + |LSAGG-;copyInto!;2AIA;22|) + (LOOP + (COND + ((NOT (COND + ((SPADCALL |z| (|getShellEntry| $ 16)) + NIL) + (T (NOT (SPADCALL |x| + (|getShellEntry| $ 16)))))) + (RETURN NIL)) + (T (SEQ (SPADCALL |z| + (SPADCALL |x| (|getShellEntry| $ 18)) + (|getShellEntry| $ 69)) + (SETQ |x| + (SPADCALL |x| + (|getShellEntry| $ 17))) + (EXIT (SETQ |z| + (SPADCALL |z| + (|getShellEntry| $ 17)))))))) + (EXIT |y|)))))))) (DEFUN |LSAGG-;position;SA2I;23| (|w| |x| |s| $) (PROG (|k|) @@ -596,30 +599,31 @@ (LET ((|m| (SPADCALL |x| (|getShellEntry| $ 33)))) (COND ((< |s| |m|) (|error| "index out of range")) - ('T - (SEQ (SETQ |x| - (SPADCALL |x| - (LET ((#0=#:G1559 (- |s| |m|))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 39))) - (LETT |k| |s| |LSAGG-;position;SA2I;23|) - (LOOP - (COND - ((NOT (COND - ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T - (SPADCALL |w| - (SPADCALL |x| (|getShellEntry| $ 18)) - (|getShellEntry| $ 61))))) - (RETURN NIL)) - (T (SEQ (SETQ |x| - (SPADCALL |x| (|getShellEntry| $ 17))) - (EXIT (SETQ |k| (+ |k| 1))))))) - (EXIT (COND - ((SPADCALL |x| (|getShellEntry| $ 16)) - (- (SPADCALL |x| (|getShellEntry| $ 33)) 1)) - ('T |k|)))))))))) + (T (SEQ (SETQ |x| + (SPADCALL |x| + (LET ((#0=#:G1559 (- |s| |m|))) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 39))) + (LETT |k| |s| |LSAGG-;position;SA2I;23|) + (LOOP + (COND + ((NOT (COND + ((SPADCALL |x| (|getShellEntry| $ 16)) + NIL) + (T (SPADCALL |w| + (SPADCALL |x| + (|getShellEntry| $ 18)) + (|getShellEntry| $ 61))))) + (RETURN NIL)) + (T (SEQ (SETQ |x| + (SPADCALL |x| + (|getShellEntry| $ 17))) + (EXIT (SETQ |k| (+ |k| 1))))))) + (EXIT (COND + ((SPADCALL |x| (|getShellEntry| $ 16)) + (- (SPADCALL |x| (|getShellEntry| $ 33)) 1)) + (T |k|)))))))))) (DEFUN |LSAGG-;removeDuplicates!;2A;24| (|l| $) (LET ((|p| |l|)) @@ -648,7 +652,7 @@ (COND ((NOT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T (NOT (SPADCALL |y| (|getShellEntry| $ 16)))))) + (T (NOT (SPADCALL |y| (|getShellEntry| $ 16)))))) (RETURN NIL)) (T (COND ((SPADCALL (SPADCALL |x| (|getShellEntry| $ 18)) @@ -658,14 +662,15 @@ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18)) (SPADCALL |y| (|getShellEntry| $ 18)) (|getShellEntry| $ 75)))) - ('T - (SEQ (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 17))) - (EXIT (SETQ |y| - (SPADCALL |y| (|getShellEntry| $ 17)))))))))) + (T (SEQ (SETQ |x| + (SPADCALL |x| (|getShellEntry| $ 17))) + (EXIT (SETQ |y| + (SPADCALL |y| + (|getShellEntry| $ 17)))))))))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) (NOT (SPADCALL |y| (|getShellEntry| $ 16)))) - ('T NIL))))) + (T NIL))))) (DEFUN |ListAggregate&| (|#1| |#2|) (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) diff --git a/src/algebra/strap/LSAGG.lsp b/src/algebra/strap/LSAGG.lsp index eeb2b6ed..219998d3 100644 --- a/src/algebra/strap/LSAGG.lsp +++ b/src/algebra/strap/LSAGG.lsp @@ -10,14 +10,13 @@ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) (COND (|ListAggregate;CAT|) - ('T - (SETQ |ListAggregate;CAT| - (|Join| (|StreamAggregate| '|t#1|) - (|FiniteLinearAggregate| '|t#1|) - (|ExtensibleLinearAggregate| '|t#1|) - (|mkCategory| '|domain| - '(((|list| ($ |t#1|)) T)) NIL 'NIL - NIL)))))))) + (T (SETQ |ListAggregate;CAT| + (|Join| (|StreamAggregate| '|t#1|) + (|FiniteLinearAggregate| '|t#1|) + (|ExtensibleLinearAggregate| '|t#1|) + (|mkCategory| '|domain| + '(((|list| ($ |t#1|)) T)) NIL 'NIL + NIL)))))))) (|setShellEntry| #0# 0 (LIST '|ListAggregate| (|devaluate| |t#1|))) #0#)) diff --git a/src/algebra/strap/MONOID-.lsp b/src/algebra/strap/MONOID-.lsp index 01837d68..e8679174 100644 --- a/src/algebra/strap/MONOID-.lsp +++ b/src/algebra/strap/MONOID-.lsp @@ -21,12 +21,12 @@ (DEFUN |MONOID-;recip;SU;3| (|x| $) (COND ((SPADCALL |x| (|getShellEntry| $ 12)) (CONS 0 |x|)) - ('T (CONS 1 "failed")))) + (T (CONS 1 "failed")))) (DEFUN |MONOID-;**;SNniS;4| (|x| |n| $) (COND ((ZEROP |n|) (|spadConstant| $ 7)) - ('T (SPADCALL |x| |n| (|getShellEntry| $ 19))))) + (T (SPADCALL |x| |n| (|getShellEntry| $ 19))))) (DEFUN |Monoid&| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$| (LIST '|Monoid&| |dv$1|)) diff --git a/src/algebra/strap/MTSCAT.lsp b/src/algebra/strap/MTSCAT.lsp index ae14c0d5..72955375 100644 --- a/src/algebra/strap/MTSCAT.lsp +++ b/src/algebra/strap/MTSCAT.lsp @@ -15,70 +15,72 @@ (LIST '(|IndexedExponents| |t#2|))) (COND (|MultivariateTaylorSeriesCategory;CAT|) - ('T - (SETQ |MultivariateTaylorSeriesCategory;CAT| - (|Join| (|PartialDifferentialRing| '|t#2|) - (|PowerSeriesCategory| '|t#1| '#1# - '|t#2|) - (|InnerEvalable| '|t#2| '$) - (|Evalable| '$) - (|mkCategory| '|domain| - '(((|coefficient| - ($ $ |t#2| + (T (SETQ |MultivariateTaylorSeriesCategory;CAT| + (|Join| (|PartialDifferentialRing| + '|t#2|) + (|PowerSeriesCategory| '|t#1| + '#1# '|t#2|) + (|InnerEvalable| '|t#2| '$) + (|Evalable| '$) + (|mkCategory| '|domain| + '(((|coefficient| + ($ $ |t#2| + (|NonNegativeInteger|))) + T) + ((|coefficient| + ($ $ (|List| |t#2|) + (|List| + (|NonNegativeInteger|)))) + T) + ((|extend| + ($ $ + (|NonNegativeInteger|))) + T) + ((|monomial| + ($ $ |t#2| + (|NonNegativeInteger|))) + T) + ((|monomial| + ($ $ (|List| |t#2|) + (|List| + (|NonNegativeInteger|)))) + T) + ((|order| + ((|NonNegativeInteger|) $ + |t#2|)) + T) + ((|order| + ((|NonNegativeInteger|) $ + |t#2| + (|NonNegativeInteger|))) + T) + ((|polynomial| + ((|Polynomial| |t#1|) $ + (|NonNegativeInteger|))) + T) + ((|polynomial| + ((|Polynomial| |t#1|) $ + (|NonNegativeInteger|) + (|NonNegativeInteger|))) + T) + ((|integrate| ($ $ |t#2|)) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|)))))) + '(((|RadicalCategory|) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|))))) + ((|TranscendentalFunctionCategory|) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|)))))) + '((|Polynomial| |t#1|) + (|NonNegativeInteger|) + (|List| |t#2|) + (|List| (|NonNegativeInteger|))) - T) - ((|coefficient| - ($ $ (|List| |t#2|) - (|List| - (|NonNegativeInteger|)))) - T) - ((|extend| - ($ $ (|NonNegativeInteger|))) - T) - ((|monomial| - ($ $ |t#2| - (|NonNegativeInteger|))) - T) - ((|monomial| - ($ $ (|List| |t#2|) - (|List| - (|NonNegativeInteger|)))) - T) - ((|order| - ((|NonNegativeInteger|) $ - |t#2|)) - T) - ((|order| - ((|NonNegativeInteger|) $ - |t#2| - (|NonNegativeInteger|))) - T) - ((|polynomial| - ((|Polynomial| |t#1|) $ - (|NonNegativeInteger|))) - T) - ((|polynomial| - ((|Polynomial| |t#1|) $ - (|NonNegativeInteger|) - (|NonNegativeInteger|))) - T) - ((|integrate| ($ $ |t#2|)) - (|has| |t#1| - (|Algebra| - (|Fraction| (|Integer|)))))) - '(((|RadicalCategory|) - (|has| |t#1| - (|Algebra| - (|Fraction| (|Integer|))))) - ((|TranscendentalFunctionCategory|) - (|has| |t#1| - (|Algebra| - (|Fraction| (|Integer|)))))) - '((|Polynomial| |t#1|) - (|NonNegativeInteger|) - (|List| |t#2|) - (|List| (|NonNegativeInteger|))) - NIL))))))))) + NIL))))))))) (|setShellEntry| #0# 0 (LIST '|MultivariateTaylorSeriesCategory| (|devaluate| |t#1|) (|devaluate| |t#2|))) diff --git a/src/algebra/strap/NNI.lsp b/src/algebra/strap/NNI.lsp index dbe1dda2..b355751f 100644 --- a/src/algebra/strap/NNI.lsp +++ b/src/algebra/strap/NNI.lsp @@ -34,10 +34,9 @@ (LET ((|c| (- |x| |y|))) (COND ((MINUSP |c|) (CONS 1 "failed")) - ('T - (CONS 0 - (|check-subtype| (NOT (MINUSP |c|)) - '(|NonNegativeInteger|) |c|)))))) + (T (CONS 0 + (|check-subtype| (NOT (MINUSP |c|)) + '(|NonNegativeInteger|) |c|)))))) (DEFUN |NonNegativeInteger| () (DECLARE (SPECIAL |$ConstructorCache|)) @@ -46,16 +45,16 @@ (COND ((SETQ #0# (HGET |$ConstructorCache| '|NonNegativeInteger|)) (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| - '|NonNegativeInteger| - (LIST (CONS NIL - (CONS 1 (|NonNegativeInteger;|)))))) - (SETQ #0# T)) - (COND - ((NOT #0#) - (HREM |$ConstructorCache| '|NonNegativeInteger|))))))))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| + '|NonNegativeInteger| + (LIST (CONS NIL + (CONS 1 + (|NonNegativeInteger;|)))))) + (SETQ #0# T)) + (COND + ((NOT #0#) + (HREM |$ConstructorCache| '|NonNegativeInteger|))))))))) (DEFUN |NonNegativeInteger;| () (LET ((|dv$| (LIST '|NonNegativeInteger|)) ($ (|newShell| 22)) diff --git a/src/algebra/strap/ORDRING-.lsp b/src/algebra/strap/ORDRING-.lsp index b7f704a3..6204c289 100644 --- a/src/algebra/strap/ORDRING-.lsp +++ b/src/algebra/strap/ORDRING-.lsp @@ -24,7 +24,7 @@ ((SPADCALL |x| (|getShellEntry| $ 13)) 1) ((SPADCALL |x| (|getShellEntry| $ 16)) -1) ((SPADCALL |x| (|getShellEntry| $ 19)) 0) - ('T (|error| "x satisfies neither positive?, negative? or zero?")))) + (T (|error| "x satisfies neither positive?, negative? or zero?")))) (DEFUN |ORDRING-;abs;2S;4| (|x| $) (COND @@ -32,7 +32,7 @@ ((SPADCALL |x| (|getShellEntry| $ 16)) (SPADCALL |x| (|getShellEntry| $ 22))) ((SPADCALL |x| (|getShellEntry| $ 19)) (|spadConstant| $ 7)) - ('T (|error| "x satisfies neither positive?, negative? or zero?")))) + (T (|error| "x satisfies neither positive?, negative? or zero?")))) (DEFUN |OrderedRing&| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp index 400131f1..43a2d0bc 100644 --- a/src/algebra/strap/OUTFORM.lsp +++ b/src/algebra/strap/OUTFORM.lsp @@ -544,7 +544,7 @@ (DEFUN |OUTFORM;message;S$;7| (|s| $) (COND ((SPADCALL |s| (|getShellEntry| $ 12)) (|OUTFORM;empty;$;73| $)) - ('T |s|))) + (T |s|))) (DEFUN |OUTFORM;messagePrint;SV;8| (|s| $) (|mathprint| (|OUTFORM;message;S$;7| |s| $))) @@ -619,18 +619,18 @@ ((PLUSP |n|) (|OUTFORM;vconcat;3$;50| " " (|OUTFORM;vspace;I$;28| (- |n| 1) $) $)) - ('T (|OUTFORM;empty;$;73| $)))) + (T (|OUTFORM;empty;$;73| $)))) (DEFUN |OUTFORM;hspace;I$;29| (|n| $) (COND ((PLUSP |n|) (|fillerSpaces| |n|)) - ('T (|OUTFORM;empty;$;73| $)))) + (T (|OUTFORM;empty;$;73| $)))) (DEFUN |OUTFORM;rspace;2I$;30| (|n| |m| $) (SEQ (COND ((PLUSP |n|) (COND ((NOT (PLUSP |m|)) (EXIT (|OUTFORM;empty;$;73| $))))) - ('T (EXIT (|OUTFORM;empty;$;73| $)))) + (T (EXIT (|OUTFORM;empty;$;73| $)))) (EXIT (|OUTFORM;vconcat;3$;50| (|OUTFORM;hspace;I$;29| |n| $) (|OUTFORM;rspace;2I$;30| |n| (- |m| 1) $) $)))) @@ -666,7 +666,7 @@ (COND ((EQCAR |u| |c|) (SETQ |l1| (APPEND (CDR |u|) |l1|))) - ('T (SETQ |l1| (CONS |u| |l1|))))))) + (T (SETQ |l1| (CONS |u| |l1|))))))) (SETQ #0# (CDR #0#)))) (EXIT (CONS |c| |l1|))))) @@ -712,7 +712,7 @@ ((NULL |l|) |a|) ((NULL (CDR |l|)) (|OUTFORM;sub;3$;42| |a| (SPADCALL |l| (|getShellEntry| $ 78)) $)) - ('T (CONS 'SUPERSUB (CONS |a| |l|))))) + (T (CONS 'SUPERSUB (CONS |a| |l|))))) (DEFUN |OUTFORM;supersub;$L$;47| (|a| |l| $) (SEQ (COND @@ -824,8 +824,8 @@ (LET ((|e| (COND ((IDENTP |a|) |a|) ((STRINGP |a|) (INTERN |a|)) - ('T (RETURN-FROM |OUTFORM;infix?;$B;74| NIL))))) - (COND ((GET |e| 'INFIXOP) T) ('T NIL)))) + (T (RETURN-FROM |OUTFORM;infix?;$B;74| NIL))))) + (COND ((GET |e| 'INFIXOP) T) (T NIL)))) (DEFUN |OUTFORM;elt;$L$;75| (|a| |l| $) (DECLARE (IGNORE $)) @@ -834,25 +834,23 @@ (DEFUN |OUTFORM;prefix;$L$;76| (|a| |l| $) (COND ((NOT (|OUTFORM;infix?;$B;74| |a| $)) (CONS |a| |l|)) - ('T - (|OUTFORM;hconcat;3$;48| |a| - (|OUTFORM;paren;2$;40| (CONS 'AGGLST |l|) $) $)))) + (T (|OUTFORM;hconcat;3$;48| |a| + (|OUTFORM;paren;2$;40| (CONS 'AGGLST |l|) $) $)))) (DEFUN |OUTFORM;infix;$L$;77| (|a| |l| $) (COND ((NULL |l|) (|OUTFORM;empty;$;73| $)) ((NULL (CDR |l|)) (SPADCALL |l| (|getShellEntry| $ 78))) ((|OUTFORM;infix?;$B;74| |a| $) (CONS |a| |l|)) - ('T - (|OUTFORM;hconcat;L$;49| - (LIST (SPADCALL |l| (|getShellEntry| $ 78)) |a| - (|OUTFORM;infix;$L$;77| |a| (CDR |l|) $)) - $)))) + (T (|OUTFORM;hconcat;L$;49| + (LIST (SPADCALL |l| (|getShellEntry| $ 78)) |a| + (|OUTFORM;infix;$L$;77| |a| (CDR |l|) $)) + $)))) (DEFUN |OUTFORM;infix;4$;78| (|a| |b| |c| $) (COND ((|OUTFORM;infix?;$B;74| |a| $) (LIST |a| |b| |c|)) - ('T (|OUTFORM;hconcat;L$;49| (LIST |b| |a| |c|) $)))) + (T (|OUTFORM;hconcat;L$;49| (LIST |b| |a| |c|) $)))) (DEFUN |OUTFORM;postfix;3$;79| (|a| |b| $) (DECLARE (IGNORE $)) @@ -934,17 +932,16 @@ (SEQ (COND ((ZEROP |nn|) |a|) ((< |nn| 4) (|OUTFORM;prime;$Nni$;86| |a| |nn| $)) - ('T - (SEQ (LETT |r| - (SPADCALL - (|check-subtype| (PLUSP |nn|) - '(|PositiveInteger|) |nn|) - (|getShellEntry| $ 137)) - |OUTFORM;differentiate;$Nni$;97|) - (LETT |s| (SPADCALL |r| (|getShellEntry| $ 138)) - |OUTFORM;differentiate;$Nni$;97|) - (EXIT (|OUTFORM;super;3$;43| |a| (LIST 'PAREN |s|) - $))))))))) + (T (SEQ (LETT |r| + (SPADCALL + (|check-subtype| (PLUSP |nn|) + '(|PositiveInteger|) |nn|) + (|getShellEntry| $ 137)) + |OUTFORM;differentiate;$Nni$;97|) + (LETT |s| (SPADCALL |r| (|getShellEntry| $ 138)) + |OUTFORM;differentiate;$Nni$;97|) + (EXIT (|OUTFORM;super;3$;43| |a| (LIST 'PAREN |s|) + $))))))))) (DEFUN |OUTFORM;sum;2$;98| (|a| $) (LIST 'SIGMA (|OUTFORM;empty;$;73| $) |a|)) @@ -985,13 +982,13 @@ (COND ((SETQ #0# (HGET |$ConstructorCache| '|OutputForm|)) (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|OutputForm| - (LIST (CONS NIL - (CONS 1 (|OutputForm;|)))))) - (SETQ #0# T)) - (COND ((NOT #0#) (HREM |$ConstructorCache| '|OutputForm|))))))))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|OutputForm| + (LIST (CONS NIL + (CONS 1 (|OutputForm;|)))))) + (SETQ #0# T)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|OutputForm|))))))))) (DEFUN |OutputForm;| () (LET ((|dv$| (LIST '|OutputForm|)) ($ (|newShell| 150)) diff --git a/src/algebra/strap/PI.lsp b/src/algebra/strap/PI.lsp index 4f7ecd8d..8f17450f 100644 --- a/src/algebra/strap/PI.lsp +++ b/src/algebra/strap/PI.lsp @@ -11,14 +11,14 @@ (COND ((SETQ #0# (HGET |$ConstructorCache| '|PositiveInteger|)) (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|PositiveInteger| - (LIST (CONS NIL - (CONS 1 (|PositiveInteger;|)))))) - (SETQ #0# T)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|PositiveInteger|))))))))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|PositiveInteger| + (LIST (CONS NIL + (CONS 1 (|PositiveInteger;|)))))) + (SETQ #0# T)) + (COND + ((NOT #0#) + (HREM |$ConstructorCache| '|PositiveInteger|))))))))) (DEFUN |PositiveInteger;| () (LET ((|dv$| (LIST '|PositiveInteger|)) ($ (|newShell| 16)) diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp index 439ed083..13c315ef 100644 --- a/src/algebra/strap/POLYCAT-.lsp +++ b/src/algebra/strap/POLYCAT-.lsp @@ -146,52 +146,53 @@ (RETURN (SEQ (COND ((NULL |l|) |p|) - ('T - (SEQ (LET ((#0=#:G1691 |l|)) - (LOOP - (COND - ((ATOM #0#) (RETURN NIL)) - (T (LET ((|e| (CAR #0#))) - (COND - ((EQL (CAR - (SPADCALL - (SPADCALL |e| - (|getShellEntry| $ 14)) - (|getShellEntry| $ 16))) - 1) - (RETURN - (|error| - "cannot find a variable to evaluate"))))))) - (SETQ #0# (CDR #0#)))) - (LETT |lvar| - (LET ((#1=#:G1693 |l|) (#2=#:G1692 NIL)) - (LOOP - (COND - ((ATOM #1#) (RETURN (NREVERSE #2#))) - (T (LET ((|e| (CAR #1#))) - (SETQ #2# - (CONS - (SPADCALL - (SPADCALL |e| - (|getShellEntry| $ 14)) - (|getShellEntry| $ 17)) - #2#))))) - (SETQ #1# (CDR #1#)))) - |POLYCAT-;eval;SLS;1|) - (EXIT (SPADCALL |p| |lvar| - (LET ((#3=#:G1695 |l|) (#4=#:G1694 NIL)) - (LOOP - (COND - ((ATOM #3#) (RETURN (NREVERSE #4#))) - (T - (LET ((|e| (CAR #3#))) - (SETQ #4# + (T (SEQ (LET ((#0=#:G1691 |l|)) + (LOOP + (COND + ((ATOM #0#) (RETURN NIL)) + (T (LET ((|e| (CAR #0#))) + (COND + ((EQL + (CAR + (SPADCALL + (SPADCALL |e| + (|getShellEntry| $ 14)) + (|getShellEntry| $ 16))) + 1) + (RETURN + (|error| + "cannot find a variable to evaluate"))))))) + (SETQ #0# (CDR #0#)))) + (LETT |lvar| + (LET ((#1=#:G1693 |l|) (#2=#:G1692 NIL)) + (LOOP + (COND + ((ATOM #1#) (RETURN (NREVERSE #2#))) + (T (LET ((|e| (CAR #1#))) + (SETQ #2# (CONS - (SPADCALL |e| - (|getShellEntry| $ 18)) - #4#))))) - (SETQ #3# (CDR #3#)))) - (|getShellEntry| $ 21)))))))))) + (SPADCALL + (SPADCALL |e| + (|getShellEntry| $ 14)) + (|getShellEntry| $ 17)) + #2#))))) + (SETQ #1# (CDR #1#)))) + |POLYCAT-;eval;SLS;1|) + (EXIT (SPADCALL |p| |lvar| + (LET ((#3=#:G1695 |l|) (#4=#:G1694 NIL)) + (LOOP + (COND + ((ATOM #3#) + (RETURN (NREVERSE #4#))) + (T + (LET ((|e| (CAR #3#))) + (SETQ #4# + (CONS + (SPADCALL |e| + (|getShellEntry| $ 18)) + #4#))))) + (SETQ #3# (CDR #3#)))) + (|getShellEntry| $ 21)))))))))) (DEFUN |POLYCAT-;monomials;SL;2| (|p| $) (LET ((|ml| NIL)) @@ -214,7 +215,7 @@ ((NULL (CDR (LETT |l| (SPADCALL |p| (|getShellEntry| $ 35)) |POLYCAT-;isPlus;SU;3|))) (CONS 1 "failed")) - ('T (CONS 0 |l|)))))) + (T (CONS 0 |l|)))))) (DEFUN |POLYCAT-;isTimes;SU;4| (|p| $) (PROG (|lv| |l| |r|) @@ -225,38 +226,37 @@ |POLYCAT-;isTimes;SU;4|)) (NOT (SPADCALL |p| (|getShellEntry| $ 42)))) (CONS 1 "failed")) - ('T - (SEQ (LETT |l| - (LET ((#0=#:G1697 |lv|) (#1=#:G1696 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|v| (CAR #0#))) - (SETQ #1# - (CONS - (SPADCALL (|spadConstant| $ 43) - |v| - (SPADCALL |p| |v| - (|getShellEntry| $ 46)) - (|getShellEntry| $ 47)) - #1#))))) - (SETQ #0# (CDR #0#)))) - |POLYCAT-;isTimes;SU;4|) - (EXIT (COND - ((SPADCALL - (LETT |r| - (SPADCALL |p| - (|getShellEntry| $ 48)) - |POLYCAT-;isTimes;SU;4|) - (|getShellEntry| $ 49)) - (COND - ((NULL (CDR |lv|)) (CONS 1 "failed")) - ('T (CONS 0 |l|)))) - ('T - (CONS 0 - (CONS (SPADCALL |r| - (|getShellEntry| $ 51)) - |l|)))))))))))) + (T (SEQ (LETT |l| + (LET ((#0=#:G1697 |lv|) (#1=#:G1696 NIL)) + (LOOP + (COND + ((ATOM #0#) (RETURN (NREVERSE #1#))) + (T (LET ((|v| (CAR #0#))) + (SETQ #1# + (CONS + (SPADCALL (|spadConstant| $ 43) + |v| + (SPADCALL |p| |v| + (|getShellEntry| $ 46)) + (|getShellEntry| $ 47)) + #1#))))) + (SETQ #0# (CDR #0#)))) + |POLYCAT-;isTimes;SU;4|) + (EXIT (COND + ((SPADCALL + (LETT |r| + (SPADCALL |p| + (|getShellEntry| $ 48)) + |POLYCAT-;isTimes;SU;4|) + (|getShellEntry| $ 49)) + (COND + ((NULL (CDR |lv|)) (CONS 1 "failed")) + (T (CONS 0 |l|)))) + (T (CONS 0 + (CONS + (SPADCALL |r| + (|getShellEntry| $ 51)) + |l|)))))))))))) (DEFUN |POLYCAT-;isExpt;SU;5| (|p| $) (PROG (|d|) @@ -273,7 +273,7 @@ (|getShellEntry| $ 47)) (|getShellEntry| $ 54)))) (CONS 1 "failed")) - ('T (CONS 0 (CONS (CDR |u|) |d|)))))))) + (T (CONS 0 (CONS (CDR |u|) |d|)))))))) (DEFUN |POLYCAT-;coefficient;SVarSetNniS;6| (|p| |v| |n| $) (SPADCALL (SPADCALL |p| |v| (|getShellEntry| $ 59)) |n| @@ -284,27 +284,25 @@ ((NULL |lv|) (COND ((NULL |ln|) |p|) - ('T (|error| "mismatched lists in coefficient")))) + (T (|error| "mismatched lists in coefficient")))) ((NULL |ln|) (|error| "mismatched lists in coefficient")) - ('T - (SPADCALL - (SPADCALL - (SPADCALL |p| (|SPADfirst| |lv|) (|getShellEntry| $ 59)) - (|SPADfirst| |ln|) (|getShellEntry| $ 61)) - (CDR |lv|) (CDR |ln|) (|getShellEntry| $ 68))))) + (T (SPADCALL + (SPADCALL + (SPADCALL |p| (|SPADfirst| |lv|) (|getShellEntry| $ 59)) + (|SPADfirst| |ln|) (|getShellEntry| $ 61)) + (CDR |lv|) (CDR |ln|) (|getShellEntry| $ 68))))) (DEFUN |POLYCAT-;monomial;SLLS;8| (|p| |lv| |ln| $) (COND ((NULL |lv|) (COND ((NULL |ln|) |p|) - ('T (|error| "mismatched lists in monomial")))) + (T (|error| "mismatched lists in monomial")))) ((NULL |ln|) (|error| "mismatched lists in monomial")) - ('T - (SPADCALL - (SPADCALL |p| (|SPADfirst| |lv|) (|SPADfirst| |ln|) - (|getShellEntry| $ 47)) - (CDR |lv|) (CDR |ln|) (|getShellEntry| $ 70))))) + (T (SPADCALL + (SPADCALL |p| (|SPADfirst| |lv|) (|SPADfirst| |ln|) + (|getShellEntry| $ 47)) + (CDR |lv|) (CDR |ln|) (|getShellEntry| $ 70))))) (DEFUN |POLYCAT-;retract;SVarSet;9| (|p| $) (LET ((|q| (LET ((#0=#:G1478 (SPADCALL |p| (|getShellEntry| $ 53)))) @@ -315,7 +313,7 @@ ((SPADCALL (SPADCALL |q| (|getShellEntry| $ 72)) |p| (|getShellEntry| $ 54)) |q|) - ('T (|error| "Polynomial is not a single variable"))))) + (T (|error| "Polynomial is not a single variable"))))) (DEFUN |POLYCAT-;retractIfCan;SU;10| (|p| $) (PROG (|q| #0=#:G1486) @@ -356,80 +354,78 @@ (RETURN (SEQ (COND ((SPADCALL |p| (|getShellEntry| $ 78)) 0) - ('T - (SEQ (LETT |u| - (SPADCALL |p| - (LET ((#0=#:G1492 - (SPADCALL |p| - (|getShellEntry| $ 53)))) - (|check-union| (ZEROP (CAR #0#)) - (|getShellEntry| $ 9) #0#) - (CDR #0#)) - (|getShellEntry| $ 59)) - |POLYCAT-;totalDegree;SNni;13|) - (LETT |d| 0 |POLYCAT-;totalDegree;SNni;13|) - (LOOP - (COND - ((NOT (SPADCALL |u| (|spadConstant| $ 80) - (|getShellEntry| $ 81))) - (RETURN NIL)) - (T (SEQ (SETQ |d| - (MAX |d| - (+ - (SPADCALL |u| - (|getShellEntry| $ 82)) - (SPADCALL + (T (SEQ (LETT |u| + (SPADCALL |p| + (LET ((#0=#:G1492 + (SPADCALL |p| + (|getShellEntry| $ 53)))) + (|check-union| (ZEROP (CAR #0#)) + (|getShellEntry| $ 9) #0#) + (CDR #0#)) + (|getShellEntry| $ 59)) + |POLYCAT-;totalDegree;SNni;13|) + (LETT |d| 0 |POLYCAT-;totalDegree;SNni;13|) + (LOOP + (COND + ((NOT (SPADCALL |u| (|spadConstant| $ 80) + (|getShellEntry| $ 81))) + (RETURN NIL)) + (T (SEQ (SETQ |d| + (MAX |d| + (+ + (SPADCALL |u| + (|getShellEntry| $ 82)) + (SPADCALL + (SPADCALL |u| + (|getShellEntry| $ 83)) + (|getShellEntry| $ 84))))) + (EXIT (SETQ |u| (SPADCALL |u| - (|getShellEntry| $ 83)) - (|getShellEntry| $ 84))))) - (EXIT (SETQ |u| - (SPADCALL |u| - (|getShellEntry| $ 87)))))))) - (EXIT |d|)))))))) + (|getShellEntry| $ 87)))))))) + (EXIT |d|)))))))) (DEFUN |POLYCAT-;totalDegree;SLNni;14| (|p| |lv| $) (PROG (|v| |u| |d| |w|) (RETURN (SEQ (COND ((SPADCALL |p| (|getShellEntry| $ 78)) 0) - ('T - (SEQ (LETT |u| - (SPADCALL |p| - (LETT |v| - (LET - ((#0=#:G1500 - (SPADCALL |p| - (|getShellEntry| $ 53)))) - (|check-union| (ZEROP (CAR #0#)) - (|getShellEntry| $ 9) #0#) - (CDR #0#)) - |POLYCAT-;totalDegree;SLNni;14|) - (|getShellEntry| $ 59)) - |POLYCAT-;totalDegree;SLNni;14|) - (LETT |d| 0 |POLYCAT-;totalDegree;SLNni;14|) - (LETT |w| 0 |POLYCAT-;totalDegree;SLNni;14|) - (COND - ((SPADCALL |v| |lv| (|getShellEntry| $ 89)) - (SETQ |w| 1))) - (LOOP + (T (SEQ (LETT |u| + (SPADCALL |p| + (LETT |v| + (LET + ((#0=#:G1500 + (SPADCALL |p| + (|getShellEntry| $ 53)))) + (|check-union| (ZEROP (CAR #0#)) + (|getShellEntry| $ 9) #0#) + (CDR #0#)) + |POLYCAT-;totalDegree;SLNni;14|) + (|getShellEntry| $ 59)) + |POLYCAT-;totalDegree;SLNni;14|) + (LETT |d| 0 |POLYCAT-;totalDegree;SLNni;14|) + (LETT |w| 0 |POLYCAT-;totalDegree;SLNni;14|) (COND - ((NOT (SPADCALL |u| (|spadConstant| $ 80) - (|getShellEntry| $ 81))) - (RETURN NIL)) - (T (SEQ (SETQ |d| - (MAX |d| - (+ - (* |w| - (SPADCALL |u| - (|getShellEntry| $ 82))) - (SPADCALL + ((SPADCALL |v| |lv| (|getShellEntry| $ 89)) + (SETQ |w| 1))) + (LOOP + (COND + ((NOT (SPADCALL |u| (|spadConstant| $ 80) + (|getShellEntry| $ 81))) + (RETURN NIL)) + (T (SEQ (SETQ |d| + (MAX |d| + (+ + (* |w| + (SPADCALL |u| + (|getShellEntry| $ 82))) + (SPADCALL + (SPADCALL |u| + (|getShellEntry| $ 83)) + |lv| (|getShellEntry| $ 92))))) + (EXIT (SETQ |u| (SPADCALL |u| - (|getShellEntry| $ 83)) - |lv| (|getShellEntry| $ 92))))) - (EXIT (SETQ |u| - (SPADCALL |u| - (|getShellEntry| $ 87)))))))) - (EXIT |d|)))))))) + (|getShellEntry| $ 87)))))))) + (EXIT |d|)))))))) (DEFUN |POLYCAT-;resultant;2SVarSetS;15| (|p1| |p2| |mvar| $) (SPADCALL (SPADCALL |p1| |mvar| (|getShellEntry| $ 59)) @@ -626,35 +622,35 @@ #1#))))) (SETQ #0# (CDR #0#)))) (|getShellEntry| $ 159))))) - ('T - (SEQ (LETT |up| - (SPADCALL |p| (CDR |v|) (|getShellEntry| $ 59)) - |POLYCAT-;factor;SF;26|) - (LETT |ansSUP| (SPADCALL |up| (|getShellEntry| $ 143)) - |POLYCAT-;factor;SF;26|) - (EXIT (SPADCALL - (SPADCALL - (SPADCALL |ansSUP| - (|getShellEntry| $ 160)) - (CDR |v|) (|getShellEntry| $ 161)) - (LET ((#2=#:G1719 - (SPADCALL |ansSUP| - (|getShellEntry| $ 164))) - (#3=#:G1718 NIL)) - (LOOP - (COND - ((ATOM #2#) (RETURN (NREVERSE #3#))) - (T (LET ((|ww| (CAR #2#))) - (SETQ #3# - (CONS - (VECTOR (QVELT |ww| 0) - (SPADCALL (QVELT |ww| 1) - (CDR |v|) - (|getShellEntry| $ 161)) - (QVELT |ww| 2)) - #3#))))) - (SETQ #2# (CDR #2#)))) - (|getShellEntry| $ 159)))))))))) + (T (SEQ (LETT |up| + (SPADCALL |p| (CDR |v|) (|getShellEntry| $ 59)) + |POLYCAT-;factor;SF;26|) + (LETT |ansSUP| + (SPADCALL |up| (|getShellEntry| $ 143)) + |POLYCAT-;factor;SF;26|) + (EXIT (SPADCALL + (SPADCALL + (SPADCALL |ansSUP| + (|getShellEntry| $ 160)) + (CDR |v|) (|getShellEntry| $ 161)) + (LET ((#2=#:G1719 + (SPADCALL |ansSUP| + (|getShellEntry| $ 164))) + (#3=#:G1718 NIL)) + (LOOP + (COND + ((ATOM #2#) (RETURN (NREVERSE #3#))) + (T (LET ((|ww| (CAR #2#))) + (SETQ #3# + (CONS + (VECTOR (QVELT |ww| 0) + (SPADCALL (QVELT |ww| 1) + (CDR |v|) + (|getShellEntry| $ 161)) + (QVELT |ww| 2)) + #3#))))) + (SETQ #2# (CDR #2#)))) + (|getShellEntry| $ 159)))))))))) (DEFUN |POLYCAT-;conditionP;MU;27| (|mat| $) (PROG (|nd| |vars| |degs| |deg1| |mons| |redmons| |ans| |i|) @@ -747,7 +743,7 @@ |POLYCAT-;conditionP;MU;27| (CONS 1 "failed"))) - ('T + (T (LET ((#10=#:G1612 (CDR |nd|))) @@ -810,86 +806,78 @@ |POLYCAT-;conditionP;MU;27|) (EXIT (COND ((EQL (CAR |ans|) 1) (CONS 1 "failed")) - ('T - (SEQ (LETT |i| 0 |POLYCAT-;conditionP;MU;27|) - (EXIT (CONS 0 - (LET - ((#14=#:G1611 - (|makeSimpleArray| - (|getVMType| - (|getShellEntry| $ 6)) - (SIZE |monslist|)))) - (LET - ((#15=#:G1728 |monslist|) - (#16=#:G1610 0)) - (LOOP - (COND - ((ATOM #15#) - (RETURN #14#)) - (T + (T (SEQ (LETT |i| 0 |POLYCAT-;conditionP;MU;27|) + (EXIT (CONS 0 + (LET + ((#14=#:G1611 + (|makeSimpleArray| + (|getVMType| + (|getShellEntry| $ 6)) + (SIZE |monslist|)))) + (LET + ((#15=#:G1728 |monslist|) + (#16=#:G1610 0)) + (LOOP + (COND + ((ATOM #15#) (RETURN #14#)) + (T + (LET ((|mons| (CAR #15#))) + (|setSimpleArrayEntry| + #14# #16# (LET - ((|mons| (CAR #15#))) - (|setSimpleArrayEntry| - #14# #16# - (LET - ((#17=#:G1604 NIL) - (#18=#:G1605 T) - (#19=#:G1729 - |mons|)) - (LOOP - (COND - ((ATOM #19#) - (RETURN - (COND - (#18# - (|spadConstant| - $ 27)) - (T #17#)))) - (T - (LET - ((|m| - (CAR #19#))) - (LET - ((#20=#:G1603 + ((#17=#:G1604 NIL) + (#18=#:G1605 T) + (#19=#:G1729 |mons|)) + (LOOP + (COND + ((ATOM #19#) + (RETURN + (COND + (#18# + (|spadConstant| + $ 27)) + (T #17#)))) + (T + (LET + ((|m| + (CAR #19#))) + (LET + ((#20=#:G1603 + (SPADCALL + |m| + (SPADCALL + (SPADCALL + (CDR + |ans|) + (SETQ + |i| + (+ |i| + 1)) + (|getShellEntry| + $ 181)) + (|getShellEntry| + $ 51)) + (|getShellEntry| + $ 182)))) + (COND + (#18# + (SETQ + #17# + #20#)) + (T + (SETQ + #17# (SPADCALL - |m| - (SPADCALL - (SPADCALL - (CDR - |ans|) - (SETQ - |i| - (+ - |i| - 1)) - (|getShellEntry| - $ - 181)) - (|getShellEntry| - $ 51)) + #17# + #20# (|getShellEntry| - $ 182)))) - (COND - (#18# - (SETQ - #17# - #20#)) - (T - (SETQ - #17# - (SPADCALL - #17# - #20# - (|getShellEntry| - $ - 183))))) - (SETQ - #18# - NIL))))) - (SETQ #19# - (CDR #19#)))))))) - (SETQ #15# (CDR #15#)) - (SETQ #16# (+ #16# 1)))))))))))))))) + $ 183))))) + (SETQ #18# + NIL))))) + (SETQ #19# + (CDR #19#)))))))) + (SETQ #15# (CDR #15#)) + (SETQ #16# (+ #16# 1)))))))))))))))) (DEFUN |POLYCAT-;charthRoot;SU;28| (|p| $) (PROG (|ans| |ch|) @@ -903,14 +891,12 @@ |POLYCAT-;charthRoot;SU;28|) (EXIT (COND ((EQL (CAR |ans|) 1) (CONS 1 "failed")) - ('T - (CONS 0 - (SPADCALL (CDR |ans|) - (|getShellEntry| $ 51)))))))) - ('T - (SEQ (LETT |ch| (|spadConstant| $ 169) - |POLYCAT-;charthRoot;SU;28|) - (EXIT (|POLYCAT-;charthRootlv| |p| |vars| |ch| $))))))))) + (T (CONS 0 + (SPADCALL (CDR |ans|) + (|getShellEntry| $ 51)))))))) + (T (SEQ (LETT |ch| (|spadConstant| $ 169) + |POLYCAT-;charthRoot;SU;28|) + (EXIT (|POLYCAT-;charthRootlv| |p| |vars| |ch| $))))))))) (DEFUN |POLYCAT-;charthRootlv| (|p| |vars| |ch| $) (PROG (|v| |d| |ans| |dd| |cp| |ansx|) @@ -924,84 +910,84 @@ |POLYCAT-;charthRootlv|) (EXIT (COND ((EQL (CAR |ans|) 1) (CONS 1 "failed")) - ('T - (CONS 0 - (SPADCALL (CDR |ans|) - (|getShellEntry| $ 51)))))))) - ('T - (SEQ (LETT |v| (|SPADfirst| |vars|) - |POLYCAT-;charthRootlv|) - (SETQ |vars| (CDR |vars|)) - (LETT |d| (SPADCALL |p| |v| (|getShellEntry| $ 46)) - |POLYCAT-;charthRootlv|) - (LETT |ans| (|spadConstant| $ 27) - |POLYCAT-;charthRootlv|) - (LOOP - (COND - ((NOT (PLUSP |d|)) (RETURN NIL)) - (T (SEQ (LETT |dd| - (SPADCALL |d| |ch| - (|getShellEntry| $ 173)) - |POLYCAT-;charthRootlv|) - (EXIT (COND - ((EQL (CAR |dd|) 1) - (RETURN-FROM - |POLYCAT-;charthRootlv| - (CONS 1 "failed"))) - ('T - (SEQ - (LETT |cp| - (SPADCALL |p| |v| |d| - (|getShellEntry| $ 188)) - |POLYCAT-;charthRootlv|) - (SETQ |p| - (SPADCALL |p| - (SPADCALL |cp| |v| |d| - (|getShellEntry| $ 47)) - (|getShellEntry| $ 189))) - (LETT |ansx| - (|POLYCAT-;charthRootlv| |cp| - |vars| |ch| $) - |POLYCAT-;charthRootlv|) - (EXIT - (COND - ((EQL (CAR |ansx|) 1) - (RETURN-FROM - |POLYCAT-;charthRootlv| - (CONS 1 "failed"))) - ('T - (SEQ - (SETQ |d| - (SPADCALL |p| |v| - (|getShellEntry| $ 46))) - (EXIT - (SETQ |ans| - (SPADCALL |ans| - (SPADCALL (CDR |ansx|) - |v| - (LET - ((#0=#:G1640 - (CDR |dd|))) - (|check-subtype| - (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) - #0#)) + (T (CONS 0 + (SPADCALL (CDR |ans|) + (|getShellEntry| $ 51)))))))) + (T (SEQ (LETT |v| (|SPADfirst| |vars|) + |POLYCAT-;charthRootlv|) + (SETQ |vars| (CDR |vars|)) + (LETT |d| + (SPADCALL |p| |v| (|getShellEntry| $ 46)) + |POLYCAT-;charthRootlv|) + (LETT |ans| (|spadConstant| $ 27) + |POLYCAT-;charthRootlv|) + (LOOP + (COND + ((NOT (PLUSP |d|)) (RETURN NIL)) + (T (SEQ (LETT |dd| + (SPADCALL |d| |ch| + (|getShellEntry| $ 173)) + |POLYCAT-;charthRootlv|) + (EXIT (COND + ((EQL (CAR |dd|) 1) + (RETURN-FROM + |POLYCAT-;charthRootlv| + (CONS 1 "failed"))) + (T + (SEQ + (LETT |cp| + (SPADCALL |p| |v| |d| + (|getShellEntry| $ 188)) + |POLYCAT-;charthRootlv|) + (SETQ |p| + (SPADCALL |p| + (SPADCALL |cp| |v| |d| + (|getShellEntry| $ 47)) + (|getShellEntry| $ 189))) + (LETT |ansx| + (|POLYCAT-;charthRootlv| + |cp| |vars| |ch| $) + |POLYCAT-;charthRootlv|) + (EXIT + (COND + ((EQL (CAR |ansx|) 1) + (RETURN-FROM + |POLYCAT-;charthRootlv| + (CONS 1 "failed"))) + (T + (SEQ + (SETQ |d| + (SPADCALL |p| |v| (|getShellEntry| $ - 47)) - (|getShellEntry| $ - 183)))))))))))))))) - (LETT |ansx| - (|POLYCAT-;charthRootlv| |p| |vars| |ch| $) - |POLYCAT-;charthRootlv|) - (EXIT (COND - ((EQL (CAR |ansx|) 1) - (RETURN-FROM |POLYCAT-;charthRootlv| - (CONS 1 "failed"))) - ('T - (RETURN-FROM |POLYCAT-;charthRootlv| - (CONS 0 - (SPADCALL |ans| (CDR |ansx|) - (|getShellEntry| $ 183)))))))))))))) + 46))) + (EXIT + (SETQ |ans| + (SPADCALL |ans| + (SPADCALL + (CDR |ansx|) |v| + (LET + ((#0=#:G1640 + (CDR |dd|))) + (|check-subtype| + (NOT + (MINUSP #0#)) + '(|NonNegativeInteger|) + #0#)) + (|getShellEntry| $ + 47)) + (|getShellEntry| $ + 183)))))))))))))))) + (LETT |ansx| + (|POLYCAT-;charthRootlv| |p| |vars| |ch| $) + |POLYCAT-;charthRootlv|) + (EXIT (COND + ((EQL (CAR |ansx|) 1) + (RETURN-FROM |POLYCAT-;charthRootlv| + (CONS 1 "failed"))) + (T (RETURN-FROM |POLYCAT-;charthRootlv| + (CONS 0 + (SPADCALL |ans| (CDR |ansx|) + (|getShellEntry| $ 183)))))))))))))) (DEFUN |POLYCAT-;monicDivide;2SVarSetR;30| (|p1| |p2| |mvar| $) (LET ((|result| @@ -1084,11 +1070,10 @@ ((SPADCALL |dq| |dp| (|getShellEntry| $ 214)) (SPADCALL (SPADCALL |p| (|getShellEntry| $ 48)) (|spadConstant| $ 28) (|getShellEntry| $ 215))) - ('T - (SPADCALL - (SPADCALL (SPADCALL |p| |q| (|getShellEntry| $ 189)) - (|getShellEntry| $ 48)) - (|spadConstant| $ 28) (|getShellEntry| $ 215)))))) + (T (SPADCALL + (SPADCALL (SPADCALL |p| |q| (|getShellEntry| $ 189)) + (|getShellEntry| $ 48)) + (|spadConstant| $ 28) (|getShellEntry| $ 215)))))) (DEFUN |POLYCAT-;patternMatch;SP2Pmr;39| (|p| |pat| |l| $) (SPADCALL |p| |pat| |l| (|getShellEntry| $ 220))) @@ -1212,15 +1197,14 @@ (CONS (|dispatchFunction| |POLYCAT-;squareFree;SF;31|) $))) - ('T - (|setShellEntry| $ 195 - (CONS (|dispatchFunction| - |POLYCAT-;squareFree;SF;32|) - $))))) - ('T - (|setShellEntry| $ 195 - (CONS (|dispatchFunction| |POLYCAT-;squareFree;SF;33|) - $)))) + (T (|setShellEntry| $ 195 + (CONS (|dispatchFunction| + |POLYCAT-;squareFree;SF;32|) + $))))) + (T (|setShellEntry| $ 195 + (CONS (|dispatchFunction| + |POLYCAT-;squareFree;SF;33|) + $)))) (|setShellEntry| $ 203 (CONS (|dispatchFunction| |POLYCAT-;squareFreePart;2S;34|) $)) diff --git a/src/algebra/strap/POLYCAT.lsp b/src/algebra/strap/POLYCAT.lsp index a6d05ac2..c511ad14 100644 --- a/src/algebra/strap/POLYCAT.lsp +++ b/src/algebra/strap/POLYCAT.lsp @@ -13,191 +13,186 @@ (|devaluate| |t#3|))) (COND (|PolynomialCategory;CAT|) - ('T - (SETQ |PolynomialCategory;CAT| - (|Join| (|PartialDifferentialRing| '|t#3|) - (|FiniteAbelianMonoidRing| '|t#1| - '|t#2|) - (|Evalable| '$) - (|InnerEvalable| '|t#3| '|t#1|) - (|InnerEvalable| '|t#3| '$) - (|RetractableTo| '|t#3|) - (|FullyLinearlyExplicitRingOver| - '|t#1|) - (|mkCategory| '|domain| - '(((|degree| - ((|NonNegativeInteger|) $ - |t#3|)) - T) - ((|degree| - ((|List| - (|NonNegativeInteger|)) - $ (|List| |t#3|))) - T) - ((|coefficient| - ($ $ |t#3| - (|NonNegativeInteger|))) - T) - ((|coefficient| - ($ $ (|List| |t#3|) - (|List| - (|NonNegativeInteger|)))) - T) - ((|monomials| ((|List| $) $)) T) - ((|univariate| - ((|SparseUnivariatePolynomial| - $) - $ |t#3|)) - T) - ((|univariate| - ((|SparseUnivariatePolynomial| - |t#1|) - $)) - T) - ((|mainVariable| - ((|Union| |t#3| "failed") $)) - T) - ((|minimumDegree| - ((|NonNegativeInteger|) $ - |t#3|)) - T) - ((|minimumDegree| - ((|List| - (|NonNegativeInteger|)) - $ (|List| |t#3|))) - T) - ((|monicDivide| - ((|Record| (|:| |quotient| $) - (|:| |remainder| $)) - $ $ |t#3|)) - T) - ((|monomial| - ($ $ |t#3| - (|NonNegativeInteger|))) - T) - ((|monomial| - ($ $ (|List| |t#3|) - (|List| - (|NonNegativeInteger|)))) - T) - ((|multivariate| - ($ - (|SparseUnivariatePolynomial| - |t#1|) - |t#3|)) - T) - ((|multivariate| - ($ - (|SparseUnivariatePolynomial| - $) - |t#3|)) - T) - ((|isPlus| - ((|Union| (|List| $) "failed") - $)) - T) - ((|isTimes| - ((|Union| (|List| $) "failed") - $)) - T) - ((|isExpt| - ((|Union| - (|Record| (|:| |var| |t#3|) - (|:| |exponent| - (|NonNegativeInteger|))) - "failed") - $)) - T) - ((|totalDegree| - ((|NonNegativeInteger|) $)) - T) - ((|totalDegree| - ((|NonNegativeInteger|) $ - (|List| |t#3|))) - T) - ((|variables| - ((|List| |t#3|) $)) - T) - ((|primitiveMonomials| - ((|List| $) $)) - T) - ((|resultant| ($ $ $ |t#3|)) + (T (SETQ |PolynomialCategory;CAT| + (|Join| (|PartialDifferentialRing| '|t#3|) + (|FiniteAbelianMonoidRing| '|t#1| + '|t#2|) + (|Evalable| '$) + (|InnerEvalable| '|t#3| '|t#1|) + (|InnerEvalable| '|t#3| '$) + (|RetractableTo| '|t#3|) + (|FullyLinearlyExplicitRingOver| + '|t#1|) + (|mkCategory| '|domain| + '(((|degree| + ((|NonNegativeInteger|) $ + |t#3|)) + T) + ((|degree| + ((|List| + (|NonNegativeInteger|)) + $ (|List| |t#3|))) + T) + ((|coefficient| + ($ $ |t#3| + (|NonNegativeInteger|))) + T) + ((|coefficient| + ($ $ (|List| |t#3|) + (|List| + (|NonNegativeInteger|)))) + T) + ((|monomials| ((|List| $) $)) T) + ((|univariate| + ((|SparseUnivariatePolynomial| + $) + $ |t#3|)) + T) + ((|univariate| + ((|SparseUnivariatePolynomial| + |t#1|) + $)) + T) + ((|mainVariable| + ((|Union| |t#3| "failed") $)) + T) + ((|minimumDegree| + ((|NonNegativeInteger|) $ + |t#3|)) + T) + ((|minimumDegree| + ((|List| + (|NonNegativeInteger|)) + $ (|List| |t#3|))) + T) + ((|monicDivide| + ((|Record| (|:| |quotient| $) + (|:| |remainder| $)) + $ $ |t#3|)) + T) + ((|monomial| + ($ $ |t#3| + (|NonNegativeInteger|))) + T) + ((|monomial| + ($ $ (|List| |t#3|) + (|List| + (|NonNegativeInteger|)))) + T) + ((|multivariate| + ($ + (|SparseUnivariatePolynomial| + |t#1|) + |t#3|)) + T) + ((|multivariate| + ($ + (|SparseUnivariatePolynomial| + $) + |t#3|)) + T) + ((|isPlus| + ((|Union| (|List| $) "failed") + $)) + T) + ((|isTimes| + ((|Union| (|List| $) "failed") + $)) + T) + ((|isExpt| + ((|Union| + (|Record| (|:| |var| |t#3|) + (|:| |exponent| + (|NonNegativeInteger|))) + "failed") + $)) + T) + ((|totalDegree| + ((|NonNegativeInteger|) $)) + T) + ((|totalDegree| + ((|NonNegativeInteger|) $ + (|List| |t#3|))) + T) + ((|variables| ((|List| |t#3|) $)) + T) + ((|primitiveMonomials| + ((|List| $) $)) + T) + ((|resultant| ($ $ $ |t#3|)) + (|has| |t#1| + (|CommutativeRing|))) + ((|discriminant| ($ $ |t#3|)) + (|has| |t#1| + (|CommutativeRing|))) + ((|content| ($ $ |t#3|)) + (|has| |t#1| (|GcdDomain|))) + ((|primitivePart| ($ $)) + (|has| |t#1| (|GcdDomain|))) + ((|primitivePart| ($ $ |t#3|)) + (|has| |t#1| (|GcdDomain|))) + ((|squareFree| + ((|Factored| $) $)) + (|has| |t#1| (|GcdDomain|))) + ((|squareFreePart| ($ $)) + (|has| |t#1| (|GcdDomain|)))) + '(((|ConvertibleTo| (|InputForm|)) + (AND + (|has| |t#3| + (|ConvertibleTo| + (|InputForm|))) (|has| |t#1| - (|CommutativeRing|))) - ((|discriminant| ($ $ |t#3|)) + (|ConvertibleTo| + (|InputForm|))))) + ((|ConvertibleTo| + (|Pattern| (|Integer|))) + (AND + (|has| |t#3| + (|ConvertibleTo| + (|Pattern| (|Integer|)))) (|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| + (|ConvertibleTo| + (|Pattern| (|Integer|)))))) + ((|ConvertibleTo| + (|Pattern| (|Float|))) + (AND + (|has| |t#3| + (|ConvertibleTo| + (|Pattern| (|Float|)))) (|has| |t#1| - (ATTRIBUTE - |canonicalUnitNormal|))) - ((|PolynomialFactorizationExplicit|) + (|ConvertibleTo| + (|Pattern| (|Float|)))))) + ((|PatternMatchable| (|Integer|)) + (AND + (|has| |t#3| + (|PatternMatchable| + (|Integer|))) (|has| |t#1| - (|PolynomialFactorizationExplicit|)))) - '((|Factored| $) (|List| $) - (|List| |t#3|) - (|NonNegativeInteger|) - (|SparseUnivariatePolynomial| $) - (|SparseUnivariatePolynomial| - |t#1|) - (|List| (|NonNegativeInteger|))) - NIL)))))))) + (|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)))))))) (|setShellEntry| #0# 0 (LIST '|PolynomialCategory| (|devaluate| |t#1|) (|devaluate| |t#2|) (|devaluate| |t#3|))) diff --git a/src/algebra/strap/QFCAT-.lsp b/src/algebra/strap/QFCAT-.lsp index 49aa6887..8b0d783e 100644 --- a/src/algebra/strap/QFCAT-.lsp +++ b/src/algebra/strap/QFCAT-.lsp @@ -99,10 +99,9 @@ (COND ((EQL (CAR |m|) 1) (|error| "We seem to have a Fraction of a finite object")) - ('T - (CONS 0 - (SPADCALL (CDR |m|) (|spadConstant| $ 14) - (|getShellEntry| $ 15))))))) + (T (CONS 0 + (SPADCALL (CDR |m|) (|spadConstant| $ 14) + (|getShellEntry| $ 15))))))) (DEFUN |QFCAT-;map;M2A;5| (|fn| |x| $) (SPADCALL (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) |fn|) @@ -210,7 +209,7 @@ (LET ((|r| (SPADCALL |x| (|getShellEntry| $ 63)))) (COND ((EQL (CAR |r|) 1) (CONS 1 "failed")) - ('T (SPADCALL (CDR |r|) (|getShellEntry| $ 65)))))) + (T (SPADCALL (CDR |r|) (|getShellEntry| $ 65)))))) (DEFUN |QFCAT-;convert;AP;19| (|x| $) (SPADCALL @@ -250,7 +249,7 @@ (LET ((|u| (SPADCALL |x| (|getShellEntry| $ 63)))) (COND ((EQL (CAR |u|) 1) (CONS 1 "failed")) - ('T (SPADCALL (CDR |u|) (|getShellEntry| $ 95)))))) + (T (SPADCALL (CDR |u|) (|getShellEntry| $ 95)))))) (DEFUN |QFCAT-;random;A;26| ($) (PROG (|d|) @@ -331,9 +330,8 @@ ((|HasAttribute| |#2| '|canonicalUnitNormal|) (|setShellEntry| $ 51 (CONS (|dispatchFunction| |QFCAT-;<;2AB;12|) $))) - ('T - (|setShellEntry| $ 51 - (CONS (|dispatchFunction| |QFCAT-;<;2AB;13|) $))))) + (T (|setShellEntry| $ 51 + (CONS (|dispatchFunction| |QFCAT-;<;2AB;13|) $))))) ((|testBitVector| |pv$| 10) (|setShellEntry| $ 51 (CONS (|dispatchFunction| |QFCAT-;<;2AB;14|) $)))) @@ -379,14 +377,14 @@ (CONS (|dispatchFunction| |QFCAT-;coerce;FA;23|) $)) (COND ((|domainEqual| |#2| (|Integer|))) - ('T - (PROGN - (|setShellEntry| $ 93 - (CONS (|dispatchFunction| |QFCAT-;retract;AI;24|) $)) - (|setShellEntry| $ 96 - (CONS (|dispatchFunction| - |QFCAT-;retractIfCan;AU;25|) - $)))))))) + (T (PROGN + (|setShellEntry| $ 93 + (CONS (|dispatchFunction| |QFCAT-;retract;AI;24|) + $)) + (|setShellEntry| $ 96 + (CONS (|dispatchFunction| + |QFCAT-;retractIfCan;AU;25|) + $)))))))) (COND ((|testBitVector| |pv$| 2) (|setShellEntry| $ 99 diff --git a/src/algebra/strap/QFCAT.lsp b/src/algebra/strap/QFCAT.lsp index 4a0941f2..97e3c046 100644 --- a/src/algebra/strap/QFCAT.lsp +++ b/src/algebra/strap/QFCAT.lsp @@ -10,70 +10,68 @@ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) (COND (|QuotientFieldCategory;CAT|) - ('T - (SETQ |QuotientFieldCategory;CAT| - (|Join| (|Field|) (|Algebra| '|t#1|) - (|RetractableTo| '|t#1|) - (|FullyEvalableOver| '|t#1|) - (|DifferentialExtension| '|t#1|) - (|FullyLinearlyExplicitRingOver| - '|t#1|) - (|Patternable| '|t#1|) - (|FullyPatternMatchable| '|t#1|) - (|mkCategory| '|domain| - '(((/ ($ |t#1| |t#1|)) T) - ((|numer| (|t#1| $)) T) - ((|denom| (|t#1| $)) T) - ((|numerator| ($ $)) T) - ((|denominator| ($ $)) T) - ((|wholePart| (|t#1| $)) - (|has| |t#1| - (|EuclideanDomain|))) - ((|fractionPart| ($ $)) - (|has| |t#1| - (|EuclideanDomain|))) - ((|random| ($)) - (|has| |t#1| - (|IntegerNumberSystem|))) - ((|ceiling| (|t#1| $)) - (|has| |t#1| - (|IntegerNumberSystem|))) - ((|floor| (|t#1| $)) - (|has| |t#1| - (|IntegerNumberSystem|)))) - '(((|StepThrough|) - (|has| |t#1| (|StepThrough|))) - ((|RetractableTo| (|Integer|)) - (|has| |t#1| - (|RetractableTo| (|Integer|)))) - ((|RetractableTo| - (|Fraction| (|Integer|))) - (|has| |t#1| - (|RetractableTo| (|Integer|)))) - ((|OrderedSet|) - (|has| |t#1| (|OrderedSet|))) - ((|OrderedIntegralDomain|) - (|has| |t#1| - (|OrderedIntegralDomain|))) - ((|RealConstant|) - (|has| |t#1| (|RealConstant|))) - ((|ConvertibleTo| (|InputForm|)) - (|has| |t#1| - (|ConvertibleTo| - (|InputForm|)))) - ((|CharacteristicZero|) - (|has| |t#1| - (|CharacteristicZero|))) - ((|CharacteristicNonZero|) - (|has| |t#1| - (|CharacteristicNonZero|))) - ((|RetractableTo| (|Symbol|)) - (|has| |t#1| - (|RetractableTo| (|Symbol|)))) - ((|PolynomialFactorizationExplicit|) - (|has| |t#1| - (|PolynomialFactorizationExplicit|)))) - 'NIL NIL)))))))) + (T (SETQ |QuotientFieldCategory;CAT| + (|Join| (|Field|) (|Algebra| '|t#1|) + (|RetractableTo| '|t#1|) + (|FullyEvalableOver| '|t#1|) + (|DifferentialExtension| '|t#1|) + (|FullyLinearlyExplicitRingOver| + '|t#1|) + (|Patternable| '|t#1|) + (|FullyPatternMatchable| '|t#1|) + (|mkCategory| '|domain| + '(((/ ($ |t#1| |t#1|)) T) + ((|numer| (|t#1| $)) T) + ((|denom| (|t#1| $)) T) + ((|numerator| ($ $)) T) + ((|denominator| ($ $)) T) + ((|wholePart| (|t#1| $)) + (|has| |t#1| + (|EuclideanDomain|))) + ((|fractionPart| ($ $)) + (|has| |t#1| + (|EuclideanDomain|))) + ((|random| ($)) + (|has| |t#1| + (|IntegerNumberSystem|))) + ((|ceiling| (|t#1| $)) + (|has| |t#1| + (|IntegerNumberSystem|))) + ((|floor| (|t#1| $)) + (|has| |t#1| + (|IntegerNumberSystem|)))) + '(((|StepThrough|) + (|has| |t#1| (|StepThrough|))) + ((|RetractableTo| (|Integer|)) + (|has| |t#1| + (|RetractableTo| (|Integer|)))) + ((|RetractableTo| + (|Fraction| (|Integer|))) + (|has| |t#1| + (|RetractableTo| (|Integer|)))) + ((|OrderedSet|) + (|has| |t#1| (|OrderedSet|))) + ((|OrderedIntegralDomain|) + (|has| |t#1| + (|OrderedIntegralDomain|))) + ((|RealConstant|) + (|has| |t#1| (|RealConstant|))) + ((|ConvertibleTo| (|InputForm|)) + (|has| |t#1| + (|ConvertibleTo| (|InputForm|)))) + ((|CharacteristicZero|) + (|has| |t#1| + (|CharacteristicZero|))) + ((|CharacteristicNonZero|) + (|has| |t#1| + (|CharacteristicNonZero|))) + ((|RetractableTo| (|Symbol|)) + (|has| |t#1| + (|RetractableTo| (|Symbol|)))) + ((|PolynomialFactorizationExplicit|) + (|has| |t#1| + (|PolynomialFactorizationExplicit|)))) + 'NIL NIL)))))))) (|setShellEntry| #0# 0 (LIST '|QuotientFieldCategory| (|devaluate| |t#1|))) #0#)) diff --git a/src/algebra/strap/RCAGG.lsp b/src/algebra/strap/RCAGG.lsp index 5fa04082..809bda8c 100644 --- a/src/algebra/strap/RCAGG.lsp +++ b/src/algebra/strap/RCAGG.lsp @@ -10,39 +10,37 @@ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) (COND (|RecursiveAggregate;CAT|) - ('T - (SETQ |RecursiveAggregate;CAT| - (|Join| (|HomogeneousAggregate| '|t#1|) - (|mkCategory| '|domain| - '(((|children| ((|List| $) $)) T) - ((|nodes| ((|List| $) $)) T) - ((|leaf?| ((|Boolean|) $)) T) - ((|value| (|t#1| $)) T) - ((|elt| (|t#1| $ "value")) T) - ((|cyclic?| ((|Boolean|) $)) T) - ((|leaves| ((|List| |t#1|) $)) - T) - ((|distance| ((|Integer|) $ $)) - T) - ((|child?| ((|Boolean|) $ $)) - (|has| |t#1| (|SetCategory|))) - ((|node?| ((|Boolean|) $ $)) - (|has| |t#1| (|SetCategory|))) - ((|setchildren!| - ($ $ (|List| $))) - (|has| $ - (ATTRIBUTE |shallowlyMutable|))) - ((|setelt| - (|t#1| $ "value" |t#1|)) - (|has| $ - (ATTRIBUTE |shallowlyMutable|))) - ((|setvalue!| (|t#1| $ |t#1|)) - (|has| $ - (ATTRIBUTE |shallowlyMutable|)))) - NIL - '((|List| $) (|Boolean|) - (|Integer|) (|List| |t#1|)) - NIL)))))))) + (T (SETQ |RecursiveAggregate;CAT| + (|Join| (|HomogeneousAggregate| '|t#1|) + (|mkCategory| '|domain| + '(((|children| ((|List| $) $)) T) + ((|nodes| ((|List| $) $)) T) + ((|leaf?| ((|Boolean|) $)) T) + ((|value| (|t#1| $)) T) + ((|elt| (|t#1| $ "value")) T) + ((|cyclic?| ((|Boolean|) $)) T) + ((|leaves| ((|List| |t#1|) $)) T) + ((|distance| ((|Integer|) $ $)) + T) + ((|child?| ((|Boolean|) $ $)) + (|has| |t#1| (|SetCategory|))) + ((|node?| ((|Boolean|) $ $)) + (|has| |t#1| (|SetCategory|))) + ((|setchildren!| + ($ $ (|List| $))) + (|has| $ + (ATTRIBUTE |shallowlyMutable|))) + ((|setelt| + (|t#1| $ "value" |t#1|)) + (|has| $ + (ATTRIBUTE |shallowlyMutable|))) + ((|setvalue!| (|t#1| $ |t#1|)) + (|has| $ + (ATTRIBUTE |shallowlyMutable|)))) + NIL + '((|List| $) (|Boolean|) + (|Integer|) (|List| |t#1|)) + NIL)))))))) (|setShellEntry| #0# 0 (LIST '|RecursiveAggregate| (|devaluate| |t#1|))) #0#)) diff --git a/src/algebra/strap/RNS-.lsp b/src/algebra/strap/RNS-.lsp index e7be74cf..1a319cca 100644 --- a/src/algebra/strap/RNS-.lsp +++ b/src/algebra/strap/RNS-.lsp @@ -47,7 +47,7 @@ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 15)) (|getShellEntry| $ 16)) (|getShellEntry| $ 15))) - ('T (SPADCALL |x| (|getShellEntry| $ 16))))) + (T (SPADCALL |x| (|getShellEntry| $ 16))))) (DEFUN |RNS-;round;2S;4| (|x| $) (COND @@ -59,14 +59,13 @@ (|getShellEntry| $ 21)) (|getShellEntry| $ 11)) (|getShellEntry| $ 10))) - ('T - (SPADCALL - (SPADCALL |x| - (SPADCALL (|spadConstant| $ 18) - (SPADCALL 2 (|getShellEntry| $ 20)) - (|getShellEntry| $ 21)) - (|getShellEntry| $ 24)) - (|getShellEntry| $ 10))))) + (T (SPADCALL + (SPADCALL |x| + (SPADCALL (|spadConstant| $ 18) + (SPADCALL 2 (|getShellEntry| $ 20)) + (|getShellEntry| $ 21)) + (|getShellEntry| $ 24)) + (|getShellEntry| $ 10))))) (DEFUN |RNS-;norm;2S;5| (|x| $) (SPADCALL |x| (|getShellEntry| $ 26))) @@ -89,7 +88,7 @@ ((SPADCALL |x| |x1| (|getShellEntry| $ 38)) |x|) ((SPADCALL |x| (|spadConstant| $ 39) (|getShellEntry| $ 41)) (SPADCALL |x1| (|spadConstant| $ 18) (|getShellEntry| $ 11))) - ('T |x1|)))) + (T |x1|)))) (DEFUN |RNS-;ceiling;2S;9| (|x| $) (LET ((|x1| (SPADCALL (SPADCALL |x| (|getShellEntry| $ 37)) @@ -98,7 +97,7 @@ ((SPADCALL |x| |x1| (|getShellEntry| $ 38)) |x|) ((SPADCALL |x| (|spadConstant| $ 39) (|getShellEntry| $ 44)) (SPADCALL |x1| (|spadConstant| $ 18) (|getShellEntry| $ 24))) - ('T |x1|)))) + (T |x1|)))) (DEFUN |RNS-;patternMatch;SP2Pmr;10| (|x| |p| |l| $) (PROG (|r|) @@ -117,9 +116,9 @@ (|getShellEntry| $ 33)) (CDR |r|) (|getShellEntry| $ 52)) |l|) - ('T (SPADCALL (|getShellEntry| $ 53))))) - ('T (SPADCALL (|getShellEntry| $ 53))))))) - ('T (SPADCALL (|getShellEntry| $ 53)))))))) + (T (SPADCALL (|getShellEntry| $ 53))))) + (T (SPADCALL (|getShellEntry| $ 53))))))) + (T (SPADCALL (|getShellEntry| $ 53)))))))) (DEFUN |RealNumberSystem&| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) diff --git a/src/algebra/strap/SETAGG.lsp b/src/algebra/strap/SETAGG.lsp index 00d0411c..67ed3cd5 100644 --- a/src/algebra/strap/SETAGG.lsp +++ b/src/algebra/strap/SETAGG.lsp @@ -10,27 +10,26 @@ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) (COND (|SetAggregate;CAT|) - ('T - (SETQ |SetAggregate;CAT| - (|Join| (|SetCategory|) (|Collection| '|t#1|) - (|mkCategory| '|domain| - '(((|part?| ((|Boolean|) $ $)) T) - ((|brace| ($)) T) - ((|brace| ($ (|List| |t#1|))) T) - ((|set| ($)) T) - ((|set| ($ (|List| |t#1|))) T) - ((|intersect| ($ $ $)) T) - ((|difference| ($ $ $)) T) - ((|difference| ($ $ |t#1|)) T) - ((|symmetricDifference| ($ $ $)) - T) - ((|subset?| ((|Boolean|) $ $)) - T) - ((|union| ($ $ $)) T) - ((|union| ($ $ |t#1|)) T) - ((|union| ($ |t#1| $)) T)) - '((|partiallyOrderedSet| T)) - '((|Boolean|) (|List| |t#1|)) NIL)))))))) + (T (SETQ |SetAggregate;CAT| + (|Join| (|SetCategory|) + (|Collection| '|t#1|) + (|mkCategory| '|domain| + '(((|part?| ((|Boolean|) $ $)) T) + ((|brace| ($)) T) + ((|brace| ($ (|List| |t#1|))) T) + ((|set| ($)) T) + ((|set| ($ (|List| |t#1|))) T) + ((|intersect| ($ $ $)) T) + ((|difference| ($ $ $)) T) + ((|difference| ($ $ |t#1|)) T) + ((|symmetricDifference| ($ $ $)) + T) + ((|subset?| ((|Boolean|) $ $)) T) + ((|union| ($ $ $)) T) + ((|union| ($ $ |t#1|)) T) + ((|union| ($ |t#1| $)) T)) + '((|partiallyOrderedSet| T)) + '((|Boolean|) (|List| |t#1|)) NIL)))))))) (|setShellEntry| #0# 0 (LIST '|SetAggregate| (|devaluate| |t#1|))) #0#)) diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp index d5afc6c2..44f7224c 100644 --- a/src/algebra/strap/SINT.lsp +++ b/src/algebra/strap/SINT.lsp @@ -294,7 +294,7 @@ (|getShellEntry| $ 15)) (SPADCALL |dev| (QSMINUS |x|) (|getShellEntry| $ 18)) (EXIT (SPADCALL |dev| (|getShellEntry| $ 19))))) - ('T (SPADCALL |dev| |x| (|getShellEntry| $ 18)))))) + (T (SPADCALL |dev| |x| (|getShellEntry| $ 18)))))) (DEFUN |SINT;OMwrite;$S;2| (|x| $) (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) @@ -499,8 +499,8 @@ ((QSMINUSP |r|) (COND ((QSMINUSP |n|) (QSDIFFERENCE |x| |n|)) - ('T (QSPLUS |r| |n|)))) - ('T |r|)))) + (T (QSPLUS |r| |n|)))) + (T |r|)))) (DEFUN |SINT;coerce;I$;59| (|x| $) (|check-subtype| (SMINTP |x|) '(|SingleInteger|) |x|)) @@ -516,7 +516,7 @@ (DEFUN |SINT;unitNormal;$R;62| (|x| $) (COND ((QSLESSP |x| 0) (VECTOR (QSMINUS 1) (QSMINUS |x|) (QSMINUS 1))) - ('T (VECTOR 1 |x| 1)))) + (T (VECTOR 1 |x| 1)))) (DEFUN |SingleInteger| () (DECLARE (SPECIAL |$ConstructorCache|)) @@ -525,14 +525,13 @@ (COND ((SETQ #0# (HGET |$ConstructorCache| '|SingleInteger|)) (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|SingleInteger| - (LIST (CONS NIL - (CONS 1 (|SingleInteger;|)))))) - (SETQ #0# T)) - (COND - ((NOT #0#) (HREM |$ConstructorCache| '|SingleInteger|))))))))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|SingleInteger| + (LIST (CONS NIL + (CONS 1 (|SingleInteger;|)))))) + (SETQ #0# T)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|SingleInteger|))))))))) (DEFUN |SingleInteger;| () (LET ((|dv$| (LIST '|SingleInteger|)) ($ (|newShell| 116)) diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp index cdcf96d8..4a3fbda0 100644 --- a/src/algebra/strap/STAGG-.lsp +++ b/src/algebra/strap/STAGG-.lsp @@ -69,7 +69,7 @@ (COND ((SPADCALL |x| (|getShellEntry| $ 18)) (|error| "Index out of range")) - ('T (SPADCALL |x| (|getShellEntry| $ 19))))) + (T (SPADCALL |x| (|getShellEntry| $ 19))))) (DEFUN |STAGG-;elt;AIS;5| (|x| |i| $) (SEQ (SETQ |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 21)))) @@ -99,23 +99,23 @@ '(|NonNegativeInteger|) |l|) (|getShellEntry| $ 25)) (|getShellEntry| $ 30))) - ('T - (SEQ (LETT |h| - (- (SPADCALL |i| (|getShellEntry| $ 31)) - (SPADCALL |x| (|getShellEntry| $ 21))) - |STAGG-;elt;AUsA;6|) - (EXIT (COND - ((< |h| |l|) (SPADCALL (|getShellEntry| $ 32))) - ('T - (SPADCALL - (SPADCALL |x| - (|check-subtype| (NOT (MINUSP |l|)) - '(|NonNegativeInteger|) |l|) - (|getShellEntry| $ 25)) - (LET ((#0=#:G1420 (+ (- |h| |l|) 1))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 35)))))))))))) + (T (SEQ (LETT |h| + (- (SPADCALL |i| (|getShellEntry| $ 31)) + (SPADCALL |x| (|getShellEntry| $ 21))) + |STAGG-;elt;AUsA;6|) + (EXIT (COND + ((< |h| |l|) + (SPADCALL (|getShellEntry| $ 32))) + (T (SPADCALL + (SPADCALL |x| + (|check-subtype| + (NOT (MINUSP |l|)) + '(|NonNegativeInteger|) |l|) + (|getShellEntry| $ 25)) + (LET ((#0=#:G1420 (+ (- |h| |l|) 1))) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 35)))))))))))) (DEFUN |STAGG-;concat;3A;7| (|x| |y| $) (SPADCALL (SPADCALL |x| (|getShellEntry| $ 30)) |y| @@ -124,10 +124,9 @@ (DEFUN |STAGG-;concat;LA;8| (|l| $) (COND ((NULL |l|) (SPADCALL (|getShellEntry| $ 32))) - ('T - (SPADCALL (SPADCALL (|SPADfirst| |l|) (|getShellEntry| $ 30)) - (SPADCALL (CDR |l|) (|getShellEntry| $ 44)) - (|getShellEntry| $ 37))))) + (T (SPADCALL (SPADCALL (|SPADfirst| |l|) (|getShellEntry| $ 30)) + (SPADCALL (CDR |l|) (|getShellEntry| $ 44)) + (|getShellEntry| $ 37))))) (DEFUN |STAGG-;map!;M2A;9| (|f| |l| $) (LET ((|y| |l|)) @@ -175,56 +174,56 @@ (SPADCALL |x| (|getShellEntry| $ 21))))) (COND ((MINUSP |l|) (|error| "index out of range")) - ('T - (SEQ (LETT |h| - (COND - ((SPADCALL |i| (|getShellEntry| $ 29)) - (- (SPADCALL |i| (|getShellEntry| $ 31)) - (SPADCALL |x| (|getShellEntry| $ 21)))) - ('T (SPADCALL |x| (|getShellEntry| $ 51)))) - |STAGG-;setelt;AUs2S;12|) - (EXIT (COND - ((< |h| |l|) |s|) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (|check-subtype| - (NOT (MINUSP |l|)) - '(|NonNegativeInteger|) |l|) - (|getShellEntry| $ 25)) - |STAGG-;setelt;AUs2S;12|) - (LETT |z| - (SPADCALL |y| - (LET - ((#0=#:G1443 (+ (- |h| |l|) 1))) - (|check-subtype| - (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 25)) - |STAGG-;setelt;AUs2S;12|) - (LOOP - (COND - ((NOT - (NOT - (SPADCALL |y| |z| - (|getShellEntry| $ 52)))) - (RETURN NIL)) - (T (SEQ - (SPADCALL |y| |s| - (|getShellEntry| $ 46)) - (EXIT - (SETQ |y| + (T (SEQ (LETT |h| + (COND + ((SPADCALL |i| (|getShellEntry| $ 29)) + (- (SPADCALL |i| (|getShellEntry| $ 31)) + (SPADCALL |x| (|getShellEntry| $ 21)))) + (T (SPADCALL |x| (|getShellEntry| $ 51)))) + |STAGG-;setelt;AUs2S;12|) + (EXIT (COND + ((< |h| |l|) |s|) + (T (SEQ (LETT |y| + (SPADCALL |x| + (|check-subtype| + (NOT (MINUSP |l|)) + '(|NonNegativeInteger|) |l|) + (|getShellEntry| $ 25)) + |STAGG-;setelt;AUs2S;12|) + (LETT |z| (SPADCALL |y| - (|getShellEntry| $ 13)))))))) - (EXIT |s|)))))))))))) + (LET + ((#0=#:G1443 + (+ (- |h| |l|) 1))) + (|check-subtype| + (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) + #0#)) + (|getShellEntry| $ 25)) + |STAGG-;setelt;AUs2S;12|) + (LOOP + (COND + ((NOT + (NOT + (SPADCALL |y| |z| + (|getShellEntry| $ 52)))) + (RETURN NIL)) + (T + (SEQ + (SPADCALL |y| |s| + (|getShellEntry| $ 46)) + (EXIT + (SETQ |y| + (SPADCALL |y| + (|getShellEntry| $ 13)))))))) + (EXIT |s|)))))))))))) (DEFUN |STAGG-;concat!;3A;13| (|x| |y| $) (SEQ (COND ((SPADCALL |x| (|getShellEntry| $ 18)) |y|) - ('T - (SEQ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 54)) |y| - (|getShellEntry| $ 55)) - (EXIT |x|)))))) + (T (SEQ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 54)) |y| + (|getShellEntry| $ 55)) + (EXIT |x|)))))) (DEFUN |StreamAggregate&| (|#1| |#2|) (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) diff --git a/src/algebra/strap/STAGG.lsp b/src/algebra/strap/STAGG.lsp index 3f7d7848..945a862c 100644 --- a/src/algebra/strap/STAGG.lsp +++ b/src/algebra/strap/STAGG.lsp @@ -10,18 +10,17 @@ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) (COND (|StreamAggregate;CAT|) - ('T - (SETQ |StreamAggregate;CAT| - (|Join| (|UnaryRecursiveAggregate| '|t#1|) - (|LinearAggregate| '|t#1|) - (|mkCategory| '|domain| - '(((|explicitlyFinite?| - ((|Boolean|) $)) - T) - ((|possiblyInfinite?| - ((|Boolean|) $)) - T)) - NIL '((|Boolean|)) NIL)))))))) + (T (SETQ |StreamAggregate;CAT| + (|Join| (|UnaryRecursiveAggregate| '|t#1|) + (|LinearAggregate| '|t#1|) + (|mkCategory| '|domain| + '(((|explicitlyFinite?| + ((|Boolean|) $)) + T) + ((|possiblyInfinite?| + ((|Boolean|) $)) + T)) + NIL '((|Boolean|)) NIL)))))))) (|setShellEntry| #0# 0 (LIST '|StreamAggregate| (|devaluate| |t#1|))) #0#)) diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp index 190f733b..c2af9d6f 100644 --- a/src/algebra/strap/SYMBOL.lsp +++ b/src/algebra/strap/SYMBOL.lsp @@ -119,7 +119,7 @@ (COND ((|SYMBOL;scripted?;$B;30| |x| $) (|error| "Cannot convert a scripted symbol to OpenMath")) - ('T (SPADCALL |dev| |x| (|getShellEntry| $ 27))))) + (T (SPADCALL |dev| |x| (|getShellEntry| $ 27))))) (DEFUN |SYMBOL;OMwrite;$S;2| (|x| $) (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) @@ -202,7 +202,7 @@ ((NOT (COND ((NOT (< (LENGTH |ns|) 2)) (ZEROP (|SPADfirst| |ns|))) - ('T NIL))) + (T NIL))) (RETURN NIL)) (T (SETQ |ns| (CDR |ns|))))) (EXIT (SPADCALL @@ -259,20 +259,19 @@ (COND ((|SYMBOL;scripted?;$B;30| |sy| $) (|error| "Cannot add scripts to a scripted symbol")) - ('T - (CONS (|SYMBOL;coerce;$Of;11| - (|SYMBOL;coerce;S$;8| - (STRCONC (|SYMBOL;syprefix| |sc| $) - (|SYMBOL;string;$S;24| - (|SYMBOL;name;2$;31| |sy| $) $)) - $) - $) - (|SYMBOL;syscripts| |sc| $))))) + (T (CONS (|SYMBOL;coerce;$Of;11| + (|SYMBOL;coerce;S$;8| + (STRCONC (|SYMBOL;syprefix| |sc| $) + (|SYMBOL;string;$S;24| + (|SYMBOL;name;2$;31| |sy| $) $)) + $) + $) + (|SYMBOL;syscripts| |sc| $))))) (DEFUN |SYMBOL;string;$S;24| (|e| $) (COND ((NOT (|SYMBOL;scripted?;$B;30| |e| $)) (PNAME |e|)) - ('T (|error| "Cannot form string from non-atomic symbols.")))) + (T (|error| "Cannot form string from non-atomic symbols.")))) (DEFUN |SYMBOL;latex;$S;25| (|e| $) (PROG (|ss| |lo| |sc|) @@ -426,7 +425,7 @@ |SYMBOL;new;2$;28|) (EXIT (COND ((EQL (CAR |u|) 1) 0) - ('T (+ (CDR |u|) 1))))) + (T (+ (CDR |u|) 1))))) |SYMBOL;new;2$;28|) (SPADCALL (|getShellEntry| $ 13) |x| |n| (|getShellEntry| $ 127)) @@ -434,9 +433,8 @@ (COND ((NOT (|SYMBOL;scripted?;$B;30| |x| $)) (|SYMBOL;string;$S;24| |x| $)) - ('T - (|SYMBOL;string;$S;24| (|SYMBOL;name;2$;31| |x| $) - $))) + (T (|SYMBOL;string;$S;24| + (|SYMBOL;name;2$;31| |x| $) $))) |SYMBOL;new;2$;28|) (SETQ |xx| (STRCONC "%" |xx|)) (SETQ |xx| @@ -453,10 +451,9 @@ (STRCONC |xx| (|SYMBOL;anyRadix| |n| (|getShellEntry| $ 21) $))) - ('T - (STRCONC |xx| - (|SYMBOL;anyRadix| |n| - (|getShellEntry| $ 19) $))))) + (T (STRCONC |xx| + (|SYMBOL;anyRadix| |n| + (|getShellEntry| $ 19) $))))) (COND ((NOT (|SYMBOL;scripted?;$B;30| |x| $)) (EXIT (|SYMBOL;coerce;S$;8| |xx| $)))) @@ -483,32 +480,31 @@ (RETURN (SEQ (COND ((NOT (|SYMBOL;scripted?;$B;30| |sy| $)) |sy|) - ('T - (SEQ (LETT |str| - (|SYMBOL;string;$S;24| - (SPADCALL (|SYMBOL;list;$L;34| |sy| $) - (|getShellEntry| $ 137)) - $) - |SYMBOL;name;2$;31|) - (LET ((|i| (+ (|getShellEntry| $ 41) 1)) - (#0=#:G1551 (QCSIZE |str|))) - (LOOP - (COND - ((> |i| #0#) (RETURN NIL)) - (T (COND - ((NOT (SPADCALL - (SPADCALL |str| |i| - (|getShellEntry| $ 106)) - (|getShellEntry| $ 139))) - (RETURN-FROM |SYMBOL;name;2$;31| - (|SYMBOL;coerce;S$;8| - (SPADCALL |str| - (SPADCALL |i| (QCSIZE |str|) - (|getShellEntry| $ 141)) - (|getShellEntry| $ 142)) - $)))))) - (SETQ |i| (+ |i| 1)))) - (EXIT (|error| "Improper scripted symbol"))))))))) + (T (SEQ (LETT |str| + (|SYMBOL;string;$S;24| + (SPADCALL (|SYMBOL;list;$L;34| |sy| $) + (|getShellEntry| $ 137)) + $) + |SYMBOL;name;2$;31|) + (LET ((|i| (+ (|getShellEntry| $ 41) 1)) + (#0=#:G1551 (QCSIZE |str|))) + (LOOP + (COND + ((> |i| #0#) (RETURN NIL)) + (T (COND + ((NOT (SPADCALL + (SPADCALL |str| |i| + (|getShellEntry| $ 106)) + (|getShellEntry| $ 139))) + (RETURN-FROM |SYMBOL;name;2$;31| + (|SYMBOL;coerce;S$;8| + (SPADCALL |str| + (SPADCALL |i| (QCSIZE |str|) + (|getShellEntry| $ 141)) + (|getShellEntry| $ 142)) + $)))))) + (SETQ |i| (+ |i| 1)))) + (EXIT (|error| "Improper scripted symbol"))))))))) (DEFUN |SYMBOL;scripts;$R;32| (|sy| $) (PROG (|nscripts| |lscripts| |str| |nstr| |m| |allscripts|) @@ -516,62 +512,66 @@ (SEQ (COND ((NOT (|SYMBOL;scripted?;$B;30| |sy| $)) (VECTOR NIL NIL NIL NIL NIL)) - ('T - (SEQ (LETT |nscripts| (LIST 0 0 0 0 0) - |SYMBOL;scripts;$R;32|) - (LETT |lscripts| (LIST NIL NIL NIL NIL NIL) - |SYMBOL;scripts;$R;32|) - (LETT |str| - (|SYMBOL;string;$S;24| - (SPADCALL (|SYMBOL;list;$L;34| |sy| $) - (|getShellEntry| $ 137)) - $) - |SYMBOL;scripts;$R;32|) - (LETT |nstr| (QCSIZE |str|) |SYMBOL;scripts;$R;32|) - (LETT |m| - (SPADCALL |nscripts| (|getShellEntry| $ 144)) - |SYMBOL;scripts;$R;32|) - (LET ((|i| |m|) (|j| (+ (|getShellEntry| $ 41) 1))) - (LOOP - (COND - ((OR (> |j| |nstr|) - (NOT (SPADCALL - (SPADCALL |str| |j| - (|getShellEntry| $ 106)) - (|getShellEntry| $ 139)))) - (RETURN NIL)) - (T (SPADCALL |nscripts| |i| - (LET ((#0=#:G1542 - (- - (SPADCALL - (SPADCALL |str| |j| - (|getShellEntry| $ 106)) - (|getShellEntry| $ 44)) - (|getShellEntry| $ 45)))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 148)))) - (SETQ |i| (+ |i| 1)) - (SETQ |j| (+ |j| 1)))) - (SETQ |nscripts| - (SPADCALL (CDR |nscripts|) - (|SPADfirst| |nscripts|) - (|getShellEntry| $ 151))) - (LETT |allscripts| - (CDR (|SYMBOL;list;$L;34| |sy| $)) - |SYMBOL;scripts;$R;32|) - (SETQ |m| - (SPADCALL |lscripts| (|getShellEntry| $ 153))) - (LET ((|i| |m|) (#1=#:G1552 |nscripts|)) - (LOOP - (COND - ((ATOM #1#) (RETURN NIL)) - (T (LET ((|n| (CAR #1#))) - (COND - ((< (LENGTH |allscripts|) |n|) - (|error| "Improper script count in symbol")) - ('T - (SEQ (SPADCALL |lscripts| |i| + (T (SEQ (LETT |nscripts| (LIST 0 0 0 0 0) + |SYMBOL;scripts;$R;32|) + (LETT |lscripts| (LIST NIL NIL NIL NIL NIL) + |SYMBOL;scripts;$R;32|) + (LETT |str| + (|SYMBOL;string;$S;24| + (SPADCALL (|SYMBOL;list;$L;34| |sy| $) + (|getShellEntry| $ 137)) + $) + |SYMBOL;scripts;$R;32|) + (LETT |nstr| (QCSIZE |str|) + |SYMBOL;scripts;$R;32|) + (LETT |m| + (SPADCALL |nscripts| + (|getShellEntry| $ 144)) + |SYMBOL;scripts;$R;32|) + (LET ((|i| |m|) + (|j| (+ (|getShellEntry| $ 41) 1))) + (LOOP + (COND + ((OR (> |j| |nstr|) + (NOT (SPADCALL + (SPADCALL |str| |j| + (|getShellEntry| $ 106)) + (|getShellEntry| $ 139)))) + (RETURN NIL)) + (T (SPADCALL |nscripts| |i| + (LET ((#0=#:G1542 + (- + (SPADCALL + (SPADCALL |str| |j| + (|getShellEntry| $ 106)) + (|getShellEntry| $ 44)) + (|getShellEntry| $ 45)))) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 148)))) + (SETQ |i| (+ |i| 1)) + (SETQ |j| (+ |j| 1)))) + (SETQ |nscripts| + (SPADCALL (CDR |nscripts|) + (|SPADfirst| |nscripts|) + (|getShellEntry| $ 151))) + (LETT |allscripts| + (CDR (|SYMBOL;list;$L;34| |sy| $)) + |SYMBOL;scripts;$R;32|) + (SETQ |m| + (SPADCALL |lscripts| + (|getShellEntry| $ 153))) + (LET ((|i| |m|) (#1=#:G1552 |nscripts|)) + (LOOP + (COND + ((ATOM #1#) (RETURN NIL)) + (T (LET ((|n| (CAR #1#))) + (COND + ((< (LENGTH |allscripts|) |n|) + (|error| + "Improper script count in symbol")) + (T (SEQ + (SPADCALL |lscripts| |i| (LET ((#2=#:G1554 (SPADCALL |allscripts| |n| @@ -594,29 +594,29 @@ (SETQ |allscripts| (SPADCALL |allscripts| |n| (|getShellEntry| $ 158)))))))))) - (SETQ |i| (+ |i| 1)) - (SETQ #1# (CDR #1#)))) - (EXIT (VECTOR (SPADCALL |lscripts| |m| - (|getShellEntry| $ 159)) - (SPADCALL |lscripts| (+ |m| 1) - (|getShellEntry| $ 159)) - (SPADCALL |lscripts| (+ |m| 2) - (|getShellEntry| $ 159)) - (SPADCALL |lscripts| (+ |m| 3) - (|getShellEntry| $ 159)) - (SPADCALL |lscripts| (+ |m| 4) - (|getShellEntry| $ 159))))))))))) + (SETQ |i| (+ |i| 1)) + (SETQ #1# (CDR #1#)))) + (EXIT (VECTOR (SPADCALL |lscripts| |m| + (|getShellEntry| $ 159)) + (SPADCALL |lscripts| (+ |m| 1) + (|getShellEntry| $ 159)) + (SPADCALL |lscripts| (+ |m| 2) + (|getShellEntry| $ 159)) + (SPADCALL |lscripts| (+ |m| 3) + (|getShellEntry| $ 159)) + (SPADCALL |lscripts| (+ |m| 4) + (|getShellEntry| $ 159))))))))))) (DEFUN |SYMBOL;istring| (|n| $) (COND ((< 9 |n|) (|error| "Can have at most 9 scripts of each kind")) - ('T (|getSimpleArrayEntry| (|getShellEntry| $ 18) (+ |n| 0))))) + (T (|getSimpleArrayEntry| (|getShellEntry| $ 18) (+ |n| 0))))) (DEFUN |SYMBOL;list;$L;34| (|sy| $) (COND ((NOT (|SYMBOL;scripted?;$B;30| |sy| $)) (|error| "Cannot convert a symbol to a list if it is not subscripted")) - ('T |sy|))) + (T |sy|))) (DEFUN |SYMBOL;sample;$;35| ($) (DECLARE (IGNORE $)) '|aSymbol|) @@ -627,12 +627,11 @@ (COND ((SETQ #0# (HGET |$ConstructorCache| '|Symbol|)) (|CDRwithIncrement| (CDAR #0#))) - ('T - (UNWIND-PROTECT - (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Symbol| - (LIST (CONS NIL (CONS 1 (|Symbol;|)))))) - (SETQ #0# T)) - (COND ((NOT #0#) (HREM |$ConstructorCache| '|Symbol|))))))))) + (T (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Symbol| + (LIST (CONS NIL (CONS 1 (|Symbol;|)))))) + (SETQ #0# T)) + (COND ((NOT #0#) (HREM |$ConstructorCache| '|Symbol|))))))))) (DEFUN |Symbol;| () (LET ((|dv$| (LIST '|Symbol|)) ($ (|newShell| 165)) diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp index fb03bf3a..e9d5c793 100644 --- a/src/algebra/strap/URAGG-.lsp +++ b/src/algebra/strap/URAGG-.lsp @@ -130,8 +130,8 @@ (DEFUN |URAGG-;cyclic?;AB;6| (|x| $) (COND ((SPADCALL |x| (|getShellEntry| $ 20)) NIL) - ('T - (NOT (SPADCALL (|URAGG-;findCycle| |x| $) (|getShellEntry| $ 20)))))) + (T (NOT (SPADCALL (|URAGG-;findCycle| |x| $) + (|getShellEntry| $ 20)))))) (DEFUN |URAGG-;last;AS;7| (|x| $) (SPADCALL (SPADCALL |x| (|getShellEntry| $ 24)) @@ -152,7 +152,7 @@ (LET ((|l| NIL)) (COND ((SPADCALL |x| (|getShellEntry| $ 20)) |l|) - ('T (CONS (SPADCALL |x| (|getShellEntry| $ 14)) |l|))))) + (T (CONS (SPADCALL |x| (|getShellEntry| $ 14)) |l|))))) (DEFUN |URAGG-;leaf?;AB;10| (|x| $) (SPADCALL |x| (|getShellEntry| $ 20))) @@ -161,7 +161,7 @@ (COND ((SPADCALL |x| (|getShellEntry| $ 20)) (|error| "value of empty object")) - ('T (SPADCALL |x| (|getShellEntry| $ 8))))) + (T (SPADCALL |x| (|getShellEntry| $ 8))))) (DEFUN |URAGG-;less?;ANniB;12| (|l| |n| $) (LET ((|i| |n|)) @@ -170,7 +170,7 @@ ((NOT (COND ((PLUSP |i|) (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) - ('T NIL))) + (T NIL))) (RETURN NIL)) (T (SEQ (SETQ |l| (SPADCALL |l| (|getShellEntry| $ 14))) (EXIT (SETQ |i| (- |i| 1))))))) @@ -183,14 +183,14 @@ ((NOT (COND ((PLUSP |i|) (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) - ('T NIL))) + (T NIL))) (RETURN NIL)) (T (SEQ (SETQ |l| (SPADCALL |l| (|getShellEntry| $ 14))) (EXIT (SETQ |i| (- |i| 1))))))) (EXIT (COND ((ZEROP |i|) (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) - ('T NIL)))))) + (T NIL)))))) (DEFUN |URAGG-;size?;ANniB;14| (|l| |n| $) (LET ((|i| |n|)) @@ -198,13 +198,13 @@ (COND ((NOT (COND ((SPADCALL |l| (|getShellEntry| $ 20)) NIL) - ('T (PLUSP |i|)))) + (T (PLUSP |i|)))) (RETURN NIL)) (T (SEQ (SETQ |l| (SPADCALL |l| (|getShellEntry| $ 14))) (EXIT (SETQ |i| (- |i| 1))))))) (EXIT (COND ((SPADCALL |l| (|getShellEntry| $ 20)) (ZEROP |i|)) - ('T NIL)))))) + (T NIL)))))) (DEFUN |URAGG-;#;ANni;15| (|x| $) (LET ((|k| 0)) @@ -227,26 +227,26 @@ (SEQ (COND ((SPADCALL |x| (|getShellEntry| $ 20)) (|error| "empty list")) - ('T - (SEQ (LETT |y| (SPADCALL |x| (|getShellEntry| $ 14)) - |URAGG-;tail;2A;16|) - (LET ((|k| 0)) - (LOOP - (COND - ((NOT (NOT (SPADCALL |y| - (|getShellEntry| $ 20)))) - (RETURN NIL)) - (T (SEQ (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |x| - (|getShellEntry| $ 48)) - (EXIT (|error| "cyclic list")))))) - (EXIT (SETQ |y| - (SPADCALL (SETQ |x| |y|) - (|getShellEntry| $ 14))))))) - (SETQ |k| (+ |k| 1)))) - (EXIT |x|)))))))) + (T (SEQ (LETT |y| (SPADCALL |x| (|getShellEntry| $ 14)) + |URAGG-;tail;2A;16|) + (LET ((|k| 0)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |y| + (|getShellEntry| $ 20)))) + (RETURN NIL)) + (T (SEQ (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |x| + (|getShellEntry| $ 48)) + (EXIT (|error| "cyclic list")))))) + (EXIT + (SETQ |y| + (SPADCALL (SETQ |x| |y|) + (|getShellEntry| $ 14))))))) + (SETQ |k| (+ |k| 1)))) + (EXIT |x|)))))))) (DEFUN |URAGG-;findCycle| (|x| $) (LET ((|y| (SPADCALL |x| (|getShellEntry| $ 14)))) @@ -280,19 +280,19 @@ |URAGG-;cycleTail;2A;18|) (|getShellEntry| $ 20)) |x|) - ('T - (SEQ (LETT |z| (SPADCALL |x| (|getShellEntry| $ 14)) - |URAGG-;cycleTail;2A;18|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |x| |z| - (|getShellEntry| $ 54)))) - (RETURN NIL)) - (T (SEQ (LETT |y| |z| |URAGG-;cycleTail;2A;18|) - (EXIT (SETQ |z| - (SPADCALL |z| - (|getShellEntry| $ 14)))))))) - (EXIT |y|)))))))) + (T (SEQ (LETT |z| (SPADCALL |x| (|getShellEntry| $ 14)) + |URAGG-;cycleTail;2A;18|) + (LOOP + (COND + ((NOT (NOT (SPADCALL |x| |z| + (|getShellEntry| $ 54)))) + (RETURN NIL)) + (T (SEQ (LETT |y| |z| + |URAGG-;cycleTail;2A;18|) + (EXIT (SETQ |z| + (SPADCALL |z| + (|getShellEntry| $ 14)))))))) + (EXIT |y|)))))))) (DEFUN |URAGG-;cycleEntry;2A;19| (|x| $) (PROG (|z| |l| |y|) @@ -304,39 +304,39 @@ |URAGG-;cycleEntry;2A;19|) (|getShellEntry| $ 20)) |y|) - ('T - (SEQ (LETT |z| (SPADCALL |y| (|getShellEntry| $ 14)) - |URAGG-;cycleEntry;2A;19|) - (LETT |l| 1 |URAGG-;cycleEntry;2A;19|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |y| |z| - (|getShellEntry| $ 54)))) - (RETURN NIL)) - (T (SEQ (SETQ |z| - (SPADCALL |z| - (|getShellEntry| $ 14))) - (EXIT (SETQ |l| (+ |l| 1))))))) - (LETT |y| |x| |URAGG-;cycleEntry;2A;19|) - (LET ((|k| 1)) + (T (SEQ (LETT |z| (SPADCALL |y| (|getShellEntry| $ 14)) + |URAGG-;cycleEntry;2A;19|) + (LETT |l| 1 |URAGG-;cycleEntry;2A;19|) (LOOP (COND - ((> |k| |l|) (RETURN NIL)) - (T (SETQ |y| - (SPADCALL |y| (|getShellEntry| $ 14))))) - (SETQ |k| (+ |k| 1)))) - (LOOP - (COND - ((NOT (NOT (SPADCALL |x| |y| - (|getShellEntry| $ 54)))) - (RETURN NIL)) - (T (SEQ (SETQ |x| - (SPADCALL |x| - (|getShellEntry| $ 14))) - (EXIT (SETQ |y| - (SPADCALL |y| - (|getShellEntry| $ 14)))))))) - (EXIT |x|)))))))) + ((NOT (NOT (SPADCALL |y| |z| + (|getShellEntry| $ 54)))) + (RETURN NIL)) + (T (SEQ (SETQ |z| + (SPADCALL |z| + (|getShellEntry| $ 14))) + (EXIT (SETQ |l| (+ |l| 1))))))) + (LETT |y| |x| |URAGG-;cycleEntry;2A;19|) + (LET ((|k| 1)) + (LOOP + (COND + ((> |k| |l|) (RETURN NIL)) + (T (SETQ |y| + (SPADCALL |y| + (|getShellEntry| $ 14))))) + (SETQ |k| (+ |k| 1)))) + (LOOP + (COND + ((NOT (NOT (SPADCALL |x| |y| + (|getShellEntry| $ 54)))) + (RETURN NIL)) + (T (SEQ (SETQ |x| + (SPADCALL |x| + (|getShellEntry| $ 14))) + (EXIT (SETQ |y| + (SPADCALL |y| + (|getShellEntry| $ 14)))))))) + (EXIT |x|)))))))) (DEFUN |URAGG-;cycleLength;ANni;20| (|x| $) (PROG (|y| |k|) @@ -346,20 +346,19 @@ (SPADCALL (SETQ |x| (|URAGG-;findCycle| |x| $)) (|getShellEntry| $ 20))) 0) - ('T - (SEQ (LETT |y| (SPADCALL |x| (|getShellEntry| $ 14)) - |URAGG-;cycleLength;ANni;20|) - (LETT |k| 1 |URAGG-;cycleLength;ANni;20|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |x| |y| - (|getShellEntry| $ 54)))) - (RETURN NIL)) - (T (SEQ (SETQ |y| - (SPADCALL |y| - (|getShellEntry| $ 14))) - (EXIT (SETQ |k| (+ |k| 1))))))) - (EXIT |k|)))))))) + (T (SEQ (LETT |y| (SPADCALL |x| (|getShellEntry| $ 14)) + |URAGG-;cycleLength;ANni;20|) + (LETT |k| 1 |URAGG-;cycleLength;ANni;20|) + (LOOP + (COND + ((NOT (NOT (SPADCALL |x| |y| + (|getShellEntry| $ 54)))) + (RETURN NIL)) + (T (SEQ (SETQ |y| + (SPADCALL |y| + (|getShellEntry| $ 14))) + (EXIT (SETQ |k| (+ |k| 1))))))) + (EXIT |k|)))))))) (DEFUN |URAGG-;rest;ANniA;21| (|x| |n| $) (SEQ (LET ((|i| 1)) @@ -369,7 +368,7 @@ (T (COND ((SPADCALL |x| (|getShellEntry| $ 20)) (|error| "Index out of range")) - ('T (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 14))))))) + (T (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 14))))))) (SETQ |i| (+ |i| 1)))) (EXIT |x|))) @@ -377,58 +376,55 @@ (LET ((|m| (SPADCALL |x| (|getShellEntry| $ 60)))) (COND ((< |m| |n|) (|error| "index out of range")) - ('T - (SPADCALL - (SPADCALL |x| - (LET ((#0=#:G1502 (- |m| |n|))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 62)) - (|getShellEntry| $ 63)))))) + (T (SPADCALL + (SPADCALL |x| + (LET ((#0=#:G1502 (- |m| |n|))) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 62)) + (|getShellEntry| $ 63)))))) (DEFUN |URAGG-;=;2AB;23| (|x| |y| $) (SEQ (COND ((SPADCALL |x| |y| (|getShellEntry| $ 54)) T) - ('T - (SEQ (LET ((|k| 0)) - (LOOP - (COND - ((NOT (COND - ((SPADCALL |x| (|getShellEntry| $ 20)) - NIL) - ('T - (NOT (SPADCALL |y| - (|getShellEntry| $ 20)))))) - (RETURN NIL)) - (T (SEQ (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |x| - (|getShellEntry| $ 48)) - (EXIT (|error| "cyclic list")))))) - (EXIT (COND - ((SPADCALL - (SPADCALL |x| - (|getShellEntry| $ 8)) - (SPADCALL |y| - (|getShellEntry| $ 8)) - (|getShellEntry| $ 66)) - (RETURN-FROM |URAGG-;=;2AB;23| - NIL)) - ('T - (SEQ - (SETQ |x| - (SPADCALL |x| - (|getShellEntry| $ 14))) - (EXIT - (SETQ |y| + (T (SEQ (LET ((|k| 0)) + (LOOP + (COND + ((NOT (COND + ((SPADCALL |x| (|getShellEntry| $ 20)) + NIL) + (T (NOT (SPADCALL |y| + (|getShellEntry| $ 20)))))) + (RETURN NIL)) + (T (SEQ (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |x| + (|getShellEntry| $ 48)) + (EXIT (|error| "cyclic list")))))) + (EXIT (COND + ((SPADCALL + (SPADCALL |x| + (|getShellEntry| $ 8)) (SPADCALL |y| - (|getShellEntry| $ 14))))))))))) - (SETQ |k| (+ |k| 1)))) - (EXIT (COND - ((SPADCALL |x| (|getShellEntry| $ 20)) - (SPADCALL |y| (|getShellEntry| $ 20))) - ('T NIL)))))))) + (|getShellEntry| $ 8)) + (|getShellEntry| $ 66)) + (RETURN-FROM |URAGG-;=;2AB;23| + NIL)) + (T + (SEQ + (SETQ |x| + (SPADCALL |x| + (|getShellEntry| $ 14))) + (EXIT + (SETQ |y| + (SPADCALL |y| + (|getShellEntry| $ 14))))))))))) + (SETQ |k| (+ |k| 1)))) + (EXIT (COND + ((SPADCALL |x| (|getShellEntry| $ 20)) + (SPADCALL |y| (|getShellEntry| $ 20))) + (T NIL)))))))) (DEFUN |URAGG-;node?;2AB;24| (|u| |v| $) (SEQ (LET ((|k| 0)) @@ -439,15 +435,14 @@ (T (COND ((SPADCALL |u| |v| (|getShellEntry| $ 68)) (RETURN-FROM |URAGG-;node?;2AB;24| T)) - ('T - (SEQ (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |v| (|getShellEntry| $ 48)) - (EXIT (|error| "cyclic list")))))) - (EXIT (SETQ |v| - (SPADCALL |v| - (|getShellEntry| $ 14))))))))) + (T (SEQ (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |v| (|getShellEntry| $ 48)) + (EXIT (|error| "cyclic list")))))) + (EXIT (SETQ |v| + (SPADCALL |v| + (|getShellEntry| $ 14))))))))) (SETQ |k| (+ |k| 1)))) (EXIT (SPADCALL |u| |v| (|getShellEntry| $ 68))))) @@ -468,16 +463,15 @@ (SEQ (COND ((SPADCALL |x| (|getShellEntry| $ 20)) (|error| "setlast: empty list")) - ('T - (SEQ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 24)) |s| - (|getShellEntry| $ 70)) - (EXIT |s|)))))) + (T (SEQ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 24)) |s| + (|getShellEntry| $ 70)) + (EXIT |s|)))))) (DEFUN |URAGG-;setchildren!;ALA;30| (|u| |lv| $) (COND ((EQL (LENGTH |lv|) 1) (SPADCALL |u| (|SPADfirst| |lv|) (|getShellEntry| $ 74))) - ('T (|error| "wrong number of children specified")))) + (T (|error| "wrong number of children specified")))) (DEFUN |URAGG-;setvalue!;A2S;31| (|u| |s| $) (SPADCALL |u| |s| (|getShellEntry| $ 70))) @@ -487,18 +481,17 @@ (RETURN (SEQ (COND ((< |n| 1) (|error| "index out of range")) - ('T - (SEQ (SETQ |p| - (SPADCALL |p| - (LET ((#0=#:G1528 (- |n| 1))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 62))) - (LETT |q| (SPADCALL |p| (|getShellEntry| $ 14)) - |URAGG-;split!;AIA;32|) - (SPADCALL |p| (SPADCALL (|getShellEntry| $ 84)) - (|getShellEntry| $ 74)) - (EXIT |q|)))))))) + (T (SEQ (SETQ |p| + (SPADCALL |p| + (LET ((#0=#:G1528 (- |n| 1))) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 62))) + (LETT |q| (SPADCALL |p| (|getShellEntry| $ 14)) + |URAGG-;split!;AIA;32|) + (SPADCALL |p| (SPADCALL (|getShellEntry| $ 84)) + (|getShellEntry| $ 74)) + (EXIT |q|)))))))) (DEFUN |URAGG-;cycleSplit!;2A;33| (|x| $) (PROG (|y| |z|) @@ -510,21 +503,20 @@ (|getShellEntry| $ 20)) (SPADCALL |x| |y| (|getShellEntry| $ 54))) |y|) - ('T - (SEQ (LETT |z| (SPADCALL |x| (|getShellEntry| $ 14)) - |URAGG-;cycleSplit!;2A;33|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |z| |y| - (|getShellEntry| $ 54)))) - (RETURN NIL)) - (T (SEQ (SETQ |x| |z|) - (EXIT (SETQ |z| - (SPADCALL |z| - (|getShellEntry| $ 14)))))))) - (SPADCALL |x| (SPADCALL (|getShellEntry| $ 84)) - (|getShellEntry| $ 74)) - (EXIT |y|)))))))) + (T (SEQ (LETT |z| (SPADCALL |x| (|getShellEntry| $ 14)) + |URAGG-;cycleSplit!;2A;33|) + (LOOP + (COND + ((NOT (NOT (SPADCALL |z| |y| + (|getShellEntry| $ 54)))) + (RETURN NIL)) + (T (SEQ (SETQ |x| |z|) + (EXIT (SETQ |z| + (SPADCALL |z| + (|getShellEntry| $ 14)))))))) + (SPADCALL |x| (SPADCALL (|getShellEntry| $ 84)) + (|getShellEntry| $ 74)) + (EXIT |y|)))))))) (DEFUN |UnaryRecursiveAggregate&| (|#1| |#2|) (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) diff --git a/src/algebra/strap/URAGG.lsp b/src/algebra/strap/URAGG.lsp index f082c794..60a22e5a 100644 --- a/src/algebra/strap/URAGG.lsp +++ b/src/algebra/strap/URAGG.lsp @@ -10,71 +10,70 @@ (|sublisV| (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) (COND (|UnaryRecursiveAggregate;CAT|) - ('T - (SETQ |UnaryRecursiveAggregate;CAT| - (|Join| (|RecursiveAggregate| '|t#1|) - (|mkCategory| '|domain| - '(((|concat| ($ $ $)) T) - ((|concat| ($ |t#1| $)) T) - ((|first| (|t#1| $)) T) - ((|elt| (|t#1| $ "first")) T) - ((|first| - ($ $ (|NonNegativeInteger|))) - T) - ((|rest| ($ $)) T) - ((|elt| ($ $ "rest")) T) - ((|rest| - ($ $ (|NonNegativeInteger|))) - T) - ((|last| (|t#1| $)) T) - ((|elt| (|t#1| $ "last")) T) - ((|last| - ($ $ (|NonNegativeInteger|))) - T) - ((|tail| ($ $)) T) - ((|second| (|t#1| $)) T) - ((|third| (|t#1| $)) T) - ((|cycleEntry| ($ $)) T) - ((|cycleLength| - ((|NonNegativeInteger|) $)) - T) - ((|cycleTail| ($ $)) T) - ((|concat!| ($ $ $)) - (|has| $ - (ATTRIBUTE |shallowlyMutable|))) - ((|concat!| ($ $ |t#1|)) - (|has| $ - (ATTRIBUTE |shallowlyMutable|))) - ((|cycleSplit!| ($ $)) - (|has| $ - (ATTRIBUTE |shallowlyMutable|))) - ((|setfirst!| (|t#1| $ |t#1|)) - (|has| $ - (ATTRIBUTE |shallowlyMutable|))) - ((|setelt| - (|t#1| $ "first" |t#1|)) - (|has| $ - (ATTRIBUTE |shallowlyMutable|))) - ((|setrest!| ($ $ $)) - (|has| $ - (ATTRIBUTE |shallowlyMutable|))) - ((|setelt| ($ $ "rest" $)) - (|has| $ - (ATTRIBUTE |shallowlyMutable|))) - ((|setlast!| (|t#1| $ |t#1|)) - (|has| $ - (ATTRIBUTE |shallowlyMutable|))) - ((|setelt| - (|t#1| $ "last" |t#1|)) - (|has| $ - (ATTRIBUTE |shallowlyMutable|))) - ((|split!| ($ $ (|Integer|))) - (|has| $ - (ATTRIBUTE |shallowlyMutable|)))) - NIL - '((|Integer|) - (|NonNegativeInteger|)) - NIL)))))))) + (T (SETQ |UnaryRecursiveAggregate;CAT| + (|Join| (|RecursiveAggregate| '|t#1|) + (|mkCategory| '|domain| + '(((|concat| ($ $ $)) T) + ((|concat| ($ |t#1| $)) T) + ((|first| (|t#1| $)) T) + ((|elt| (|t#1| $ "first")) T) + ((|first| + ($ $ (|NonNegativeInteger|))) + T) + ((|rest| ($ $)) T) + ((|elt| ($ $ "rest")) T) + ((|rest| + ($ $ (|NonNegativeInteger|))) + T) + ((|last| (|t#1| $)) T) + ((|elt| (|t#1| $ "last")) T) + ((|last| + ($ $ (|NonNegativeInteger|))) + T) + ((|tail| ($ $)) T) + ((|second| (|t#1| $)) T) + ((|third| (|t#1| $)) T) + ((|cycleEntry| ($ $)) T) + ((|cycleLength| + ((|NonNegativeInteger|) $)) + T) + ((|cycleTail| ($ $)) T) + ((|concat!| ($ $ $)) + (|has| $ + (ATTRIBUTE |shallowlyMutable|))) + ((|concat!| ($ $ |t#1|)) + (|has| $ + (ATTRIBUTE |shallowlyMutable|))) + ((|cycleSplit!| ($ $)) + (|has| $ + (ATTRIBUTE |shallowlyMutable|))) + ((|setfirst!| (|t#1| $ |t#1|)) + (|has| $ + (ATTRIBUTE |shallowlyMutable|))) + ((|setelt| + (|t#1| $ "first" |t#1|)) + (|has| $ + (ATTRIBUTE |shallowlyMutable|))) + ((|setrest!| ($ $ $)) + (|has| $ + (ATTRIBUTE |shallowlyMutable|))) + ((|setelt| ($ $ "rest" $)) + (|has| $ + (ATTRIBUTE |shallowlyMutable|))) + ((|setlast!| (|t#1| $ |t#1|)) + (|has| $ + (ATTRIBUTE |shallowlyMutable|))) + ((|setelt| + (|t#1| $ "last" |t#1|)) + (|has| $ + (ATTRIBUTE |shallowlyMutable|))) + ((|split!| ($ $ (|Integer|))) + (|has| $ + (ATTRIBUTE |shallowlyMutable|)))) + NIL + '((|Integer|) + (|NonNegativeInteger|)) + NIL)))))))) (|setShellEntry| #0# 0 (LIST '|UnaryRecursiveAggregate| (|devaluate| |t#1|))) #0#)) diff --git a/src/algebra/strap/VECTOR.lsp b/src/algebra/strap/VECTOR.lsp index c4b8430e..717a24ec 100644 --- a/src/algebra/strap/VECTOR.lsp +++ b/src/algebra/strap/VECTOR.lsp @@ -36,10 +36,9 @@ (HGET |$ConstructorCache| '|Vector|) '|domainEqualList|)) (|CDRwithIncrement| #1#)) - ('T - (UNWIND-PROTECT - (PROG1 (|Vector;| #0#) (SETQ #1# T)) - (COND ((NOT #1#) (HREM |$ConstructorCache| '|Vector|))))))))) + (T (UNWIND-PROTECT + (PROG1 (|Vector;| #0#) (SETQ #1# T)) + (COND ((NOT #1#) (HREM |$ConstructorCache| '|Vector|))))))))) (DEFUN |Vector;| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$| (LIST '|Vector| |dv$1|)) diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index ff4066a4..6104ef51 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -105,11 +105,11 @@ simpHasPred(pred,:options) == main where simpHasAttribute(form,a,b) op in '(AND OR NOT) => null (u := MKPF([simp p for p in r],op)) => nil - u is '(QUOTE T) => true + u = '%true or u is '(QUOTE T) => true simpBool u op = 'hasArgs => ($hasArgs => $hasArgs = r; pred) null r and opOf op = "has" => simp first pred - pred is '(QUOTE T) => true + pred = '%true or pred is '(QUOTE T) => true op1 := LASSOC(op,'((and . AND)(or . OR)(not . NOT))) => simp [op1,:r] simp first pred --REMOVE THIS HACK !!!! pred in '(T etc) => pred diff --git a/src/interp/clam.boot b/src/interp/clam.boot index 608aff79..bf66a8a0 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -134,10 +134,9 @@ compClam(op,argl,body,$clamList) == countFl => ['CONS,1,g2] g2 thirdPredPair:= --- null argl => ['(QUOTE T),['SETQ,cacheName,computeValue]] - ['(QUOTE T), - ['SETQ,g2,computeValue], - ['SETQ,g3,['CAR,cacheName]], + ['%true, + ['%store,g2,computeValue], + ['%store,g3,['CAR,cacheName]], ['RPLACA,g3,g1], ['RPLACD,g3,resetCacheEntry], g2] @@ -247,7 +246,7 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == if cacheNameOrNil then putCode := ['UNWIND_-PROTECT,['PROG1,putCode,['SETQ,g2,'T]], ['COND,[['NOT,g2],['HREM,cacheName,MKQ op]]]] - thirdPredPair:= ['(QUOTE T),putCode] + thirdPredPair:= ['%true,putCode] codeBody:= ['PROG,[g2], :callCountCode,['RETURN,['COND,secondPredPair,thirdPredPair]]] lamex:= ['LAM,arg,codeBody] @@ -299,12 +298,12 @@ compHashGlobal(op,argl,body,cacheName,eqEtc,countFl) == countFl => ['CDRwithIncrement,g2] g2 getCode:= ['HGET,cacheName,cacheArgKey] - secondPredPair:= [['SETQ,g2,getCode],returnFoundValue] + secondPredPair:= [['%store,g2,getCode],returnFoundValue] putForm:= ['CONS,MKQ op,g1] putCode:= countFl => ['HPUT,cacheName,putForm,['CONS,1,computeValue]] ['HPUT,cacheName,putForm,computeValue] - thirdPredPair:= ['(QUOTE T),putCode] + thirdPredPair:= ['%true,putCode] codeBody:= ['PROG,[g2], ['RETURN,['COND,secondPredPair,thirdPredPair]]] lamex:= ['LAM,arg,codeBody] mainFunction:= [op,lamex] diff --git a/src/interp/define.boot b/src/interp/define.boot index c2f08f1d..558b28fb 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1188,7 +1188,7 @@ addArgumentConditions($body,$functionName) == fn clist == clist is [[n,untypedCondition,typedCondition],:.] => ['COND,[typedCondition,fn rest clist], - [$true,["argumentDataError",n, + ['%true,["argumentDataError",n, MKQ untypedCondition,MKQ $functionName]]] null clist => $body systemErrorHere ["addArgumentConditions",clist] @@ -1571,7 +1571,7 @@ doItIf(item is [.,p,x,y],$predl,$e) == compSingleCapsuleItem(y,[["not",p],:$predl],getInverseEnvironment(p,olde)) y':=localExtras(oldFLP) item.op := "COND" - item.rest := [[p',x,:x'],['(QUOTE T),y,:y']] + item.rest := [[p',x,:x'],['%true,y,:y']] where localExtras(oldFLP) == EQ(oldFLP,$functorLocalParameters) => NIL flp1:=$functorLocalParameters @@ -1692,7 +1692,7 @@ DomainSubstitutionFunction(parameters,body) == --should not bother if it will only be called once name:= INTERN strconc(KAR $definition,";CAT") SETANDFILE(name,nil) - body:= ["COND",[name],['(QUOTE T),['SETQ,name,body]]] + body:= ["COND",[name],['%true,['%store,name,body]]] body diff --git a/src/interp/format.boot b/src/interp/format.boot index 15ba282d..06652ba3 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -680,7 +680,7 @@ plural(n,string) == formatIf pred == not pred => nil - member(pred,'(T (QUOTE T))) => nil + member(pred,'(T %true (QUOTE T))) => nil concat('%b,'"if",'%d,pred2English pred) formatPredParts s == diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 3b8d900c..97e3938a 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -253,10 +253,9 @@ optFunctorBody x == [CondClause u for u in l | u and first u] where CondClause [pred,:conseq] == [optFunctorBody pred,:optFunctorPROGN conseq] - l:= EFFACE('((QUOTE T)),l) - --delete any trailing ("T) + l:= EFFACE(['%true],l) --delete any trailing ("T) null l => nil - CAAR l='(QUOTE T) => + CAAR l='%true => (null CDAR l => nil; null CDDAR l => CADAR l; ["PROGN",:CDAR l]) null rest l and null CDAR l => --there is no meat to this COND @@ -525,7 +524,7 @@ DescendCode(code,flag,viewAssoc,EnvToPass) == else viewAssoc,EnvToPass) for v in rest u] TruthP CAAR c => ['PROGN,:CDAR c] while (c and (LAST c is [c1] or LAST c is [c1,[]]) and - (c1 = '(QUOTE T) or c1 is ['HasAttribute,:.])) repeat + (c1 = '%true or c1 is ['HasAttribute,:.])) repeat --strip out some worthless junk at the end c:=nreverse rest nreverse c null c => '(LIST) @@ -745,7 +744,7 @@ InvestigateConditions catvecListMaker == ($HackSlot4:= [reshape u for u in $HackSlot4]) where reshape u == ['COND,[TryGDC ICformat rest u], - ['(QUOTE T),['RPLACA,'(CAR TrueDomain), + ['%true,['RPLACA,'(CAR TrueDomain), ['delete,['QUOTE,first u],'(CAAR TrueDomain)]]]] $supplementaries:= [u diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index ccde3eb8..2bc01ca1 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -311,20 +311,20 @@ optCond (x is ['COND,:l]) == if l is [a,[aa,b]] and TruthP aa and b is ["COND",:c] then x.rest.rest := c if l is [[p1,:c1],[p2,:c2],:.] then - if (p1 is ["NOT",=p2]) or (p2 is ["NOT",=p1]) then - l:=[[p1,:c1],['(QUOTE T),:c2]] + if (p1 is ['%not,=p2]) or (p2 is ['%not,=p1]) then + l:=[[p1,:c1],['%true,:c2]] x.rest := l - c1 is ['NIL] and p2 = '(QUOTE T) and first c2 = '(QUOTE T) => - p1 is ["NOT",p1']=> return p1' - return ["NOT",p1] + c1 is ['NIL] and p2 = '%true and first c2 = '%true => + p1 is ['%not,p1']=> return p1' + return ['%not,p1] l is [[p1,:c1],[p2,:c2],[p3,:c3]] and TruthP p3 => EqualBarGensym(c1,c3) => - ["COND",[["OR",p1,["NOT",p2]],:c1],[['QUOTE,true],:c2]] - EqualBarGensym(c1,c2) => ["COND",[["OR",p1,p2],:c1],[['QUOTE,true],:c3]] + ["COND",[['%or,p1,['%not,p2]],:c1],['%true,:c2]] + EqualBarGensym(c1,c2) => ["COND",[['%or,p1,p2],:c1],['%true,:c3]] x for y in tails l repeat while y is [[a1,c1],[a2,c2],:y'] and EqualBarGensym(c1,c2) repeat - a:=['OR,a1,a2] + a:=['%or,a1,a2] first(y).first := a y.rest := y' x @@ -351,30 +351,25 @@ EqualBarGensym(x,y) == --Called early, to change IF to COND optIF2COND ["IF",a,b,c] == - b is "%noBranch" => ["COND",[["NOT",a],c]] + b is "%noBranch" => ["COND",[['%not,a],c]] c is "%noBranch" => ["COND",[a,b]] c is ["IF",:.] => ["COND",[a,b],:rest optIF2COND c] c is ["COND",:p] => ["COND",[a,b],:p] - ["COND",[a,b],[$true,c]] + ["COND",[a,b],['%true,c]] optXLAMCond x == x is ["COND",u:= [p,c],:l] => - (optPredicateIfTrue p => c; ["COND",u,:optCONDtail l]) + (p = '%true => c; ["COND",u,:optCONDtail l]) atom x => x x.first := optXLAMCond first x x.rest := optXLAMCond rest x x -optPredicateIfTrue p == - p is ['QUOTE,:.] => true - p is [fn,x] and MEMQ(fn,$BasicPredicates) and FUNCALL(fn,x) => true - nil - optCONDtail l == null l => nil [frst:= [p,c],:l']:= l - optPredicateIfTrue p => [[$true,c]] - null rest l => [frst,[$true,["CondError"]]] + p = '%true => [['%true,c]] + null rest l => [frst,['%true,["CondError"]]] [frst,:optCONDtail l'] ++ Determine whether the symbol `g' is the name of a temporary that @@ -406,8 +401,8 @@ optSEQ ["SEQ",:l] == before:= take(#transform,l) aft:= after(l,before) null before => ["SEQ",:aft] - null aft => ["COND",:transform,'((QUOTE T) (conderr))] - ["COND",:transform,['(QUOTE T),optSEQ ["SEQ",:aft]]] + null aft => ["COND",:transform,'(%true (conderr))] + ["COND",:transform,['%true,optSEQ ["SEQ",:aft]]] tryToRemoveSEQ l == l is ["SEQ",[op,a]] and op in '(EXIT RETURN THROW) => a l diff --git a/src/interp/mark.boot b/src/interp/mark.boot index 2f8849fa..cd7997d4 100644 --- a/src/interp/mark.boot +++ b/src/interp/mark.boot @@ -1469,7 +1469,7 @@ buildNewDefinition(op,theSig,formPredAlist) == theAlist := [[pred, first form, :theArgl] for [pred,:form] in alist] theNils := [nil for x in theForm] thePred := - member(outerPred, '(T (QUOTE T))) => nil + member(outerPred, '(T %true)) => nil outerPred def := ['DEF, theForm, theSig, theNils, ifize theAlist] value := diff --git a/src/interp/pspad1.boot b/src/interp/pspad1.boot index 7534a057..2af4ef75 100644 --- a/src/interp/pspad1.boot +++ b/src/interp/pspad1.boot @@ -365,7 +365,7 @@ formatForm (u) == [op,:argl] := u if op in '(Record Union) then $fieldNames := union(getFieldNames argl,$fieldNames) - MEMQ(op,'((QUOTE T) true)) => format "true" + MEMQ(op,'(true %true)) => format "true" op in '(false nil) => format op u='(Zero) => format 0 u='(One) => format 1 diff --git a/src/interp/pspad2.boot b/src/interp/pspad2.boot index 173fca07..ed99dbd6 100644 --- a/src/interp/pspad2.boot +++ b/src/interp/pspad2.boot @@ -549,7 +549,7 @@ nBlanks m == strconc/[char('_ ) for i in 1..m] isNewspadOperator op == GETL(op,"Led") or GETL(op,"Nud") -isTrue x == x="true" or x is '(QUOTE T) +isTrue x == x="true" or x = '%true nary2Binary(u,op) == u is [a,b,:t] => (t => nary2Binary([[op,a,b],:t],op); [op,a,b]) diff --git a/src/interp/slam.boot b/src/interp/slam.boot index 2b404a55..f91bea41 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -86,7 +86,7 @@ isRecurrenceRelation(op,body,minivectorName) == n:= k+minIndex --Check general predicate predOk := - generalPred is '(QUOTE T) => true + generalPred = '%true => true generalPred is ['SPADCALL,m,=sharpArg, ["ELT",["%dynval",=MKQ minivectorName],slot]] and EQ(lesspSlot,$minivector.slot)=> m+1 @@ -175,9 +175,9 @@ reportFunctionCompilation(op,nam,argl,body,isRecursive) == null argl => [cacheName] [["%store",g3,['assocCircular,g1,["%dynval",MKQ cacheName]]],['CDR,g3]] thirdPredPair:= - null argl => ['(QUOTE T),[["%store",["%dynval",MKQ cacheName],computeValue]]] - ['(QUOTE T), - ["SETQ",g2,computeValue], + null argl => ['%true,[['%store,['%dynval,MKQ cacheName],computeValue]]] + ['%true, + ['%store,g2,computeValue], ["SETQ",g3, ["CAR",["%store",["%dynval",MKQ cacheName],['predCircular,["%dynval",cacheName],cacheCount]]]], ["RPLACA",g3,g1], @@ -218,7 +218,7 @@ reportFunctionCacheAll(op,nam,argl,body) == cacheName:= mkCacheName nam g2:= gensym() --value computed by calling function secondPredPair:= [["SETQ",g2,["HGET",["%dynval",MKQ cacheName],g1]],g2] - thirdPredPair:= ['(QUOTE T),["HPUT",["%dynval",MKQ cacheName],g1,computeValue]] + thirdPredPair:= ['%true,["HPUT",['%dynval,MKQ cacheName],g1,computeValue]] codeBody:= ["PROG",[g2],["RETURN",["COND",secondPredPair,thirdPredPair]]] lamex:= ["LAM",arg,codeBody] mainFunction:= [nam,lamex] @@ -335,7 +335,7 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) == phrase3:= [["%igt",sharpArg,n],[auxfn,:argl,["LIST",n,:initCode]]] phrase4:= [["%igt",sharpArg,n-k], ["ELT",["LIST",:initCode],["QSDIFFERENCE",n,sharpArg]]] - phrase5:= ['(QUOTE T),['recurrenceError,MKQ op,sharpArg]] + phrase5:= ['%true,['recurrenceError,MKQ op,sharpArg]] ['PROGN,:preset,['COND,phrase1,phrase2,phrase3,phrase4,phrase5]] if $verbose then sayKeyedMsg("S2IX0001",[op]) diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot index 61abaaeb..eebbc95d 100644 --- a/src/interp/sys-constants.boot +++ b/src/interp/sys-constants.boot @@ -646,14 +646,6 @@ $Zero == $One == '(One) - -++ -$true == - ''T - -$false == - false - ++ Indicate absence of value $NoValue == "$NoValue" diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot index 365e319d..e3c82844 100644 --- a/src/interp/wi1.boot +++ b/src/interp/wi1.boot @@ -366,8 +366,8 @@ extractCodeAndConstructTriple(u, m, oldE) == compSymbol(s,m,e) == s="$NoValue" => ["$NoValue",$NoValueMode,e] isFluid s => [s,getmode(s,e) or return nil,e] - s="true" => ['(QUOTE T),$Boolean,e] - s="false" => [false,$Boolean,e] + s="true" => ['%true,$Boolean,e] + s="false" => ['%false,$Boolean,e] s=m or isLiteral(s,e) => [["QUOTE",s],s,e] v:= get(s,"value",e) => --+ diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot index 669abeed..9280c4c0 100644 --- a/src/interp/wi2.boot +++ b/src/interp/wi2.boot @@ -1005,7 +1005,7 @@ doItIf(item is [.,p,x,y],$predl,$e) == qe(21,compSingleCapsuleItem(y,[['not, p],:$predl],getInverseEnvironment(markKillAll p,olde))) --> ----------- y':=localExtras(oldFLP) - wiReplaceNode(item,["COND",[p',x,:x'],['(QUOTE T),y,:y']],12) + wiReplaceNode(item,["COND",[p',x,:x'],['%true,y,:y']],12) doItSeq item == ['SEQ,:l,['exit,1,x]] := item |