diff --git a/changelog b/changelog index 35101d5..abeeb4c 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ +20091005 tpd src/axiom-website/patches.html 20091005.03.tpd.patch +20091005 tpd src/interp/i-coerfn.lisp cleanup 20091005 tpd src/axiom-website/patches.html 20091005.02.tpd.patch 20091005 tpd src/interp/i-funsel.lisp cleanup 20091005 tpd src/axiom-website/patches.html 20091005.01.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 42dec8a..409d082 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2105,5 +2105,7 @@ src/interp/i-intern.lisp cleanup
src/interp/i-eval.lisp cleanup
20091005.02.tpd.patch src/interp/i-funsel.lisp cleanup
+20091005.03.tpd.patch +src/interp/i-coerfn.lisp cleanup
diff --git a/src/interp/i-coerfn.lisp.pamphlet b/src/interp/i-coerfn.lisp.pamphlet index 4ae277d..68a4dfe 100755 --- a/src/interp/i-coerfn.lisp.pamphlet +++ b/src/interp/i-coerfn.lisp.pamphlet @@ -94,23 +94,24 @@ all these coercion functions have the following result: ; objValUnwrap u' (DEFUN DP2DP (|u| |source| |target|) - (PROG (|m| T$ |n| S |u'|) - (RETURN - (PROGN - (SPADLET |m| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |n| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((NEQUAL |n| |m|) NIL) - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| S T$)) - ((NULL - (SPADLET |u'| - (|coerceInt| - (|objNewWrap| |u| (CONS (QUOTE |Vector|) (CONS S NIL))) - (CONS (QUOTE |Vector|) (CONS T$ NIL))))) - (|coercionFailure|)) - ((QUOTE T) (|objValUnwrap| |u'|))))))) + (PROG (|m| T$ |n| S |u'|) + (RETURN + (PROGN + (SPADLET |m| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |n| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (COND + ((NEQUAL |n| |m|) NIL) + ((BOOT-EQUAL |u| '|$fromCoerceable$|) (|canCoerce| S T$)) + ((NULL (SPADLET |u'| + (|coerceInt| + (|objNewWrap| |u| + (CONS '|Vector| (CONS S NIL))) + (CONS '|Vector| (CONS T$ NIL))))) + (|coercionFailure|)) + ('T (|objValUnwrap| |u'|))))))) + ;--% Distributed Multivariate Polynomials, New and Old ;Dmp2Dmp(u,source is [dmp,v1,S], target is [.,v2,T]) == @@ -133,58 +134,68 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |Dmp2Dmp| (|u| |source| |target|) - (PROG (|v2| T$ |dmp| |v1| S |w2| |t1| |t2| |ISTMP#1| |e| |c| |z| |v| |w1|) - (RETURN - (SEQ - (PROGN - (SPADLET |v2| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |dmp| (CAR |source|)) - (SPADLET |v1| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (SPADLET |v| (|intersection| |v1| |v2|)) - (AND - |v| - (PROGN - (SPADLET |w2| (SETDIFFERENCE |v2| |v|)) - (SPADLET |t1| - (COND (|w1| (CONS |dmp| (CONS |w1| (CONS S NIL)))) ((QUOTE T) S))) - (SPADLET |t2| - (COND (|w2| (CONS |dmp| (CONS |w2| (CONS T$ NIL)))) ((QUOTE T) T$))) - (|canCoerce| |t1| |t2|)))) - ((NULL |u|) (|domainZero| |target|)) - ((AND (PAIRP |u|) - (EQ (QCDR |u|) NIL) - (PROGN - (SPADLET |ISTMP#1| (QCAR |u|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |e| (QCAR |ISTMP#1|)) - (SPADLET |c| (QCDR |ISTMP#1|)) - (QUOTE T)))) - (BOOT-EQUAL - |e| - (LIST2VEC - (PROG (#0=#:G166139) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166144 |v1| (CDR #1#)) (|v| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |v| (CAR #1#)) NIL)) - (NREVERSE0 #0#)) - (SEQ (EXIT (SETQ #0# (CONS 0 #0#)))))))))) - (COND - ((SPADLET |z| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|objValUnwrap| |z|)) - ((QUOTE T) - (|coercionFailure|)))) - ((SPADLET |v| (|intersection| |v1| |v2|)) - (COND - ((SPADLET |w1| (SETDIFFERENCE |v1| |v|)) - (|coerceDmp1| |u| |source| |target| |v| |w1|)) - ((QUOTE T) (|coerceDmp2| |u| |source| |target|)))) - ((QUOTE T) (|coercionFailure|)))))))) + (PROG (|v2| T$ |dmp| |v1| S |w2| |t1| |t2| |ISTMP#1| |e| |c| |z| |v| + |w1|) + (RETURN + (SEQ (PROGN + (SPADLET |v2| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |dmp| (CAR |source|)) + (SPADLET |v1| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (SPADLET |v| (|intersection| |v1| |v2|)) + (AND |v| + (PROGN + (SPADLET |w2| (SETDIFFERENCE |v2| |v|)) + (SPADLET |t1| + (COND + (|w1| (CONS |dmp| + (CONS |w1| (CONS S NIL)))) + ('T S))) + (SPADLET |t2| + (COND + (|w2| (CONS |dmp| + (CONS |w2| (CONS T$ NIL)))) + ('T T$))) + (|canCoerce| |t1| |t2|)))) + ((NULL |u|) (|domainZero| |target|)) + ((AND (PAIRP |u|) (EQ (QCDR |u|) NIL) + (PROGN + (SPADLET |ISTMP#1| (QCAR |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |e| (QCAR |ISTMP#1|)) + (SPADLET |c| (QCDR |ISTMP#1|)) + 'T))) + (BOOT-EQUAL |e| + (LIST2VEC + (PROG (G166139) + (SPADLET G166139 NIL) + (RETURN + (DO ((G166144 |v1| (CDR G166144)) + (|v| NIL)) + ((OR (ATOM G166144) + (PROGN + (SETQ |v| (CAR G166144)) + NIL)) + (NREVERSE0 G166139)) + (SEQ + (EXIT + (SETQ G166139 + (CONS 0 G166139)))))))))) + (COND + ((SPADLET |z| + (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|objValUnwrap| |z|)) + ('T (|coercionFailure|)))) + ((SPADLET |v| (|intersection| |v1| |v2|)) + (COND + ((SPADLET |w1| (SETDIFFERENCE |v1| |v|)) + (|coerceDmp1| |u| |source| |target| |v| |w1|)) + ('T (|coerceDmp2| |u| |source| |target|)))) + ('T (|coercionFailure|)))))))) ;coerceDmp1(u,source is [.,v1,S],target is [.,v2,T],v,w) == ; -- coerces one Dmp to another, where v1 is not a subset of v2 @@ -207,131 +218,187 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |coerceDmp1| (|u| |source| |target| |v| |w|) - (PROG (|v2| T$ |v1| S |t| |one| |plusfunc| |multfunc| |pat1| |pat2| |pat3| - |e| |c| |exp| |z| |li| |a| |x|) - (RETURN - (SEQ - (PROGN - (SPADLET |v2| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |v1| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (SPADLET |t| - (CONS - (QUOTE |DistributedMultivariatePolynomial|) - (CONS |w| (CONS S NIL)))) - (SPADLET |x| (|domainZero| |target|)) - (SPADLET |one| (|domainOne| T$)) - (SPADLET |plusfunc| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |multfunc| - (|getFunctionFromDomain| - (QUOTE *) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |pat1| - (PROG (#0=#:G166206) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166211 |v1| (CDR #1#)) (|x| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) - (SEQ (EXIT (SETQ #0# (CONS (|member| |x| |v|) #0#)))))))) - (SPADLET |pat2| - (PROG (#2=#:G166221) - (SPADLET #2# NIL) - (RETURN - (DO ((#3=#:G166226 |v1| (CDR #3#)) (|x| NIL)) - ((OR (ATOM #3#) (PROGN (SETQ |x| (CAR #3#)) NIL)) (NREVERSE0 #2#)) - (SEQ (EXIT (SETQ #2# (CONS (|member| |x| |w|) #2#)))))))) - (SPADLET |pat3| - (PROG (#4=#:G166236) - (SPADLET #4# NIL) - (RETURN - (DO ((#5=#:G166241 |v2| (CDR #5#)) (|x| NIL)) - ((OR (ATOM #5#) (PROGN (SETQ |x| (CAR #5#)) NIL)) (NREVERSE0 #4#)) - (SEQ - (EXIT - (SETQ #4# - (CONS (AND (|member| |x| |v|) (POSN1 |x| |v|)) #4#)))))))) - (DO ((#6=#:G166257 |u| (CDR #6#)) - (#7=#:G166171 NIL) - (#8=#:G166258 NIL (NULL |z|))) - ((OR (ATOM #6#) - (PROGN (SETQ #7# (CAR #6#)) NIL) - (PROGN - (PROGN (SPADLET |e| (CAR #7#)) (SPADLET |c| (CDR #7#)) #7#) - NIL) - #8#) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET - |exp| - (LIST2VEC - (PROG (#9=#:G166272) - (SPADLET #9# NIL) - (RETURN - (DO ((#10=#:G166279 |pat2| (CDR #10#)) - (|x| NIL) - (#11=#:G166280 (VEC2LIST |e|) (CDR #11#)) - (|y| NIL)) - ((OR (ATOM #10#) - (PROGN (SETQ |x| (CAR #10#)) NIL) - (ATOM #11#) - (PROGN (SETQ |y| (CAR #11#)) NIL)) - (NREVERSE0 #9#)) - (SEQ (EXIT (COND (|x| (SETQ #9# (CONS |y| #9#))))))))))) - (COND - ((SPADLET |z| - (|coerceInt| - (|objNewWrap| (CONS (CONS |exp| |c|) NIL) |t|) - |target|)) - (PROGN - (SPADLET - |li| - (PROG (#12=#:G166295) - (SPADLET #12# NIL) - (RETURN - (DO ((#13=#:G166302 |pat1| (CDR #13#)) - (|x| NIL) - (#14=#:G166303 (VEC2LIST |e|) (CDR #14#)) - (|y| NIL)) - ((OR (ATOM #13#) - (PROGN (SETQ |x| (CAR #13#)) NIL) - (ATOM #14#) - (PROGN (SETQ |y| (CAR #14#)) NIL)) - (NREVERSE0 #12#)) - (SEQ (EXIT (COND (|x| (SETQ #12# (CONS |y| #12#)))))))))) - (SPADLET - |a| - (CONS - (CONS - (LIST2VEC - (PROG (#15=#:G166316) - (SPADLET #15# NIL) - (RETURN - (DO ((#16=#:G166321 |pat3| (CDR #16#)) (|x| NIL)) - ((OR (ATOM #16#) (PROGN (SETQ |x| (CAR #16#)) NIL)) - (NREVERSE0 #15#)) - (SEQ - (EXIT - (SETQ #15# - (CONS - (COND (|x| (ELT |li| |x|)) ((QUOTE T) 0)) - #15#)))))))) - |one|) - NIL)) - (SPADLET |x| - (SPADCALL |x| - (SPADCALL (|objValUnwrap| |z|) |a| |multfunc|) - |plusfunc|))))))))) - (COND - (|z| |x|) - ((QUOTE T) (|coercionFailure|)))))))) + (PROG (|v2| T$ |v1| S |t| |one| |plusfunc| |multfunc| |pat1| |pat2| + |pat3| |e| |c| |exp| |z| |li| |a| |x|) + (RETURN + (SEQ (PROGN + (SPADLET |v2| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |v1| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (SPADLET |t| + (CONS '|DistributedMultivariatePolynomial| + (CONS |w| (CONS S NIL)))) + (SPADLET |x| (|domainZero| |target|)) + (SPADLET |one| (|domainOne| T$)) + (SPADLET |plusfunc| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |multfunc| + (|getFunctionFromDomain| '* |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |pat1| + (PROG (G166206) + (SPADLET G166206 NIL) + (RETURN + (DO ((G166211 |v1| (CDR G166211)) + (|x| NIL)) + ((OR (ATOM G166211) + (PROGN + (SETQ |x| (CAR G166211)) + NIL)) + (NREVERSE0 G166206)) + (SEQ (EXIT (SETQ G166206 + (CONS (|member| |x| |v|) + G166206)))))))) + (SPADLET |pat2| + (PROG (G166221) + (SPADLET G166221 NIL) + (RETURN + (DO ((G166226 |v1| (CDR G166226)) + (|x| NIL)) + ((OR (ATOM G166226) + (PROGN + (SETQ |x| (CAR G166226)) + NIL)) + (NREVERSE0 G166221)) + (SEQ (EXIT (SETQ G166221 + (CONS (|member| |x| |w|) + G166221)))))))) + (SPADLET |pat3| + (PROG (G166236) + (SPADLET G166236 NIL) + (RETURN + (DO ((G166241 |v2| (CDR G166241)) + (|x| NIL)) + ((OR (ATOM G166241) + (PROGN + (SETQ |x| (CAR G166241)) + NIL)) + (NREVERSE0 G166236)) + (SEQ (EXIT (SETQ G166236 + (CONS + (AND (|member| |x| |v|) + (POSN1 |x| |v|)) + G166236)))))))) + (DO ((G166257 |u| (CDR G166257)) (G166171 NIL) + (G166258 NIL (NULL |z|))) + ((OR (ATOM G166257) + (PROGN (SETQ G166171 (CAR G166257)) NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G166171)) + (SPADLET |c| (CDR G166171)) + G166171) + NIL) + G166258) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |exp| + (LIST2VEC + (PROG (G166272) + (SPADLET G166272 NIL) + (RETURN + (DO + ((G166279 |pat2| + (CDR G166279)) + (|x| NIL) + (G166280 (VEC2LIST |e|) + (CDR G166280)) + (|y| NIL)) + ((OR (ATOM G166279) + (PROGN + (SETQ |x| + (CAR G166279)) + NIL) + (ATOM G166280) + (PROGN + (SETQ |y| + (CAR G166280)) + NIL)) + (NREVERSE0 G166272)) + (SEQ + (EXIT + (COND + (|x| + (SETQ G166272 + (CONS |y| G166272))))))))))) + (COND + ((SPADLET |z| + (|coerceInt| + (|objNewWrap| + (CONS (CONS |exp| |c|) NIL) + |t|) + |target|)) + (PROGN + (SPADLET |li| + (PROG (G166295) + (SPADLET G166295 NIL) + (RETURN + (DO + ((G166302 |pat1| + (CDR G166302)) + (|x| NIL) + (G166303 + (VEC2LIST |e|) + (CDR G166303)) + (|y| NIL)) + ((OR (ATOM G166302) + (PROGN + (SETQ |x| + (CAR G166302)) + NIL) + (ATOM G166303) + (PROGN + (SETQ |y| + (CAR G166303)) + NIL)) + (NREVERSE0 G166295)) + (SEQ + (EXIT + (COND + (|x| + (SETQ G166295 + (CONS |y| + G166295)))))))))) + (SPADLET |a| + (CONS + (CONS + (LIST2VEC + (PROG (G166316) + (SPADLET G166316 NIL) + (RETURN + (DO + ((G166321 |pat3| + (CDR G166321)) + (|x| NIL)) + ((OR (ATOM G166321) + (PROGN + (SETQ |x| + (CAR G166321)) + NIL)) + (NREVERSE0 + G166316)) + (SEQ + (EXIT + (SETQ G166316 + (CONS + (COND + (|x| + (ELT |li| + |x|)) + ('T 0)) + G166316)))))))) + |one|) + NIL)) + (SPADLET |x| + (SPADCALL |x| + (SPADCALL + (|objValUnwrap| |z|) |a| + |multfunc|) + |plusfunc|))))))))) + (COND (|z| |x|) ('T (|coercionFailure|)))))))) + ;coerceDmp2(u,source is [.,v1,S],target is [.,v2,T]) == ; -- coerces one Dmp to another, where v1 is included in v2 ; x:= domainZero(target) @@ -349,76 +416,90 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |coerceDmp2| (|u| |source| |target|) - (PROG (|v2| T$ |v1| S |one| |plusfunc| |multfunc| |pat| |e| |c| |z| |li| - |a| |x|) - (RETURN - (SEQ - (PROGN - (SPADLET |v2| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |v1| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (SPADLET |x| (|domainZero| |target|)) - (SPADLET |one| (|domainOne| T$)) - (SPADLET |plusfunc| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |multfunc| - (|getFunctionFromDomain| - (QUOTE *) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |pat| - (PROG (#0=#:G166392) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166397 |v2| (CDR #1#)) (|x| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS (AND (|member| |x| |v1|) (POSN1 |x| |v1|)) #0#)))))))) - (DO ((#2=#:G166408 |u| (CDR #2#)) - (#3=#:G166357 NIL) - (#4=#:G166409 NIL (NULL |z|))) - ((OR (ATOM #2#) - (PROGN (SETQ #3# (CAR #2#)) NIL) - (PROGN - (PROGN (SPADLET |e| (CAR #3#)) (SPADLET |c| (CDR #3#)) #3#) - NIL) - #4#) - NIL) - (SEQ - (EXIT - (COND - ((SPADLET |z| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (SPADLET |li| (VEC2LIST |e|)) - (SPADLET |a| - (CONS - (CONS - (LIST2VEC - (PROG (#5=#:G166421) - (SPADLET #5# NIL) - (RETURN - (DO ((#6=#:G166426 |pat| (CDR #6#)) (|x| NIL)) - ((OR (ATOM #6#) (PROGN (SETQ |x| (CAR #6#)) NIL)) - (NREVERSE0 #5#)) - (SEQ - (EXIT - (SETQ #5# - (CONS - (COND (|x| (ELT |li| |x|)) ((QUOTE T) 0)) - #5#)))))))) - |one|) - NIL)) - (SPADLET |x| - (SPADCALL |x| - (SPADCALL (|objValUnwrap| |z|) |a| |multfunc|) - |plusfunc|))) - ((QUOTE T) NIL))))) - (COND (|z| |x|) ((QUOTE T) (|coercionFailure|)))))))) + (PROG (|v2| T$ |v1| S |one| |plusfunc| |multfunc| |pat| |e| |c| |z| + |li| |a| |x|) + (RETURN + (SEQ (PROGN + (SPADLET |v2| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |v1| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (SPADLET |x| (|domainZero| |target|)) + (SPADLET |one| (|domainOne| T$)) + (SPADLET |plusfunc| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |multfunc| + (|getFunctionFromDomain| '* |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |pat| + (PROG (G166392) + (SPADLET G166392 NIL) + (RETURN + (DO ((G166397 |v2| (CDR G166397)) + (|x| NIL)) + ((OR (ATOM G166397) + (PROGN + (SETQ |x| (CAR G166397)) + NIL)) + (NREVERSE0 G166392)) + (SEQ (EXIT (SETQ G166392 + (CONS + (AND (|member| |x| |v1|) + (POSN1 |x| |v1|)) + G166392)))))))) + (DO ((G166408 |u| (CDR G166408)) (G166357 NIL) + (G166409 NIL (NULL |z|))) + ((OR (ATOM G166408) + (PROGN (SETQ G166357 (CAR G166408)) NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G166357)) + (SPADLET |c| (CDR G166357)) + G166357) + NIL) + G166409) + NIL) + (SEQ (EXIT (COND + ((SPADLET |z| + (|coerceInt| (|objNewWrap| |c| S) + |target|)) + (SPADLET |li| (VEC2LIST |e|)) + (SPADLET |a| + (CONS + (CONS + (LIST2VEC + (PROG (G166421) + (SPADLET G166421 NIL) + (RETURN + (DO + ((G166426 |pat| + (CDR G166426)) + (|x| NIL)) + ((OR (ATOM G166426) + (PROGN + (SETQ |x| + (CAR G166426)) + NIL)) + (NREVERSE0 G166421)) + (SEQ + (EXIT + (SETQ G166421 + (CONS + (COND + (|x| + (ELT |li| |x|)) + ('T 0)) + G166421)))))))) + |one|) + NIL)) + (SPADLET |x| + (SPADCALL |x| + (SPADCALL (|objValUnwrap| |z|) + |a| |multfunc|) + |plusfunc|))) + ('T NIL))))) + (COND (|z| |x|) ('T (|coercionFailure|)))))))) ;Dmp2Expr(u,source is [dmp,vars,S], target is [Expr,T]) == ; u = '_$fromCoerceable_$ => canCoerce(S, target) @@ -443,86 +524,96 @@ all these coercion functions have the following result: ; sum (DEFUN |Dmp2Expr| (|u| |source| |target|) - (PROG (|Expr| T$ |dmp| |vars| S |syms| |plus| |mult| |expn| |e| |c| - |exp| |term| |sum|) - (RETURN - (SEQ - (PROGN - (SPADLET |Expr| (CAR |target|)) - (SPADLET T$ (CADR |target|)) - (SPADLET |dmp| (CAR |source|)) - (SPADLET |vars| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| S |target|)) - ((NULL |vars|) - (SPADLET |c| (CDAR |u|)) - (COND - ((NULL (SPADLET |c| (|coerceInt| (|objNewWrap| |c| S) |target|))) - (|coercionFailure|)) - ((QUOTE T) (|objValUnwrap| |c|)))) - ((QUOTE T) - (SPADLET |syms| - (PROG (#0=#:G166499) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166504 |vars| (CDR #1#)) (|var| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |var| (CAR #1#)) NIL)) - (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS - (|objValUnwrap| - (|coerceInt| (|objNewWrap| |var| |$Symbol|) |target|)) - #0#)))))))) - (SPADLET |sum| (|domainZero| |target|)) - (SPADLET |plus| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |mult| - (|getFunctionFromDomain| - (QUOTE *) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |expn| - (|getFunctionFromDomain| - (QUOTE **) - |target| - (CONS |target| (CONS |$Integer| NIL)))) - (DO ((#2=#:G166516 |u| (CDR #2#)) (#3=#:G166457 NIL)) - ((OR (ATOM #2#) - (PROGN (SETQ #3# (CAR #2#)) NIL) - (PROGN - (PROGN (SPADLET |e| (CAR #3#)) (SPADLET |c| (CDR #3#)) #3#) - NIL)) - NIL) - (SEQ - (EXIT - (COND - ((NULL (SPADLET |c| (|coerceInt| (|objNewWrap| |c| S) |target|))) - (|coercionFailure|)) - ((QUOTE T) - (SPADLET |c| (|objValUnwrap| |c|)) - (SPADLET |term| (|domainOne| |target|)) - (DO ((|i| 0 (QSADD1 |i|)) - (#4=#:G166529 |syms| (CDR #4#)) - (|sym| NIL)) - ((OR (ATOM #4#) (PROGN (SETQ |sym| (CAR #4#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |exp| (ELT |e| |i|)) - (COND - ((> (ELT |e| |i|) 0) - (SPADLET |term| - (SPADCALL |term| - (SPADCALL |sym| (ELT |e| |i|) |expn|) |mult|)))))))) - (SPADLET |sum| - (SPADCALL |sum| (SPADCALL |c| |term| |mult|) |plus|))))))) - |sum|))))))) + (PROG (|Expr| T$ |dmp| |vars| S |syms| |plus| |mult| |expn| |e| |c| + |exp| |term| |sum|) + (DECLARE (SPECIAL |$Integer| |$Symbol|)) + (RETURN + (SEQ (PROGN + (SPADLET |Expr| (CAR |target|)) + (SPADLET T$ (CADR |target|)) + (SPADLET |dmp| (CAR |source|)) + (SPADLET |vars| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| S |target|)) + ((NULL |vars|) (SPADLET |c| (CDAR |u|)) + (COND + ((NULL (SPADLET |c| + (|coerceInt| (|objNewWrap| |c| S) + |target|))) + (|coercionFailure|)) + ('T (|objValUnwrap| |c|)))) + ('T + (SPADLET |syms| + (PROG (G166499) + (SPADLET G166499 NIL) + (RETURN + (DO ((G166504 |vars| (CDR G166504)) + (|var| NIL)) + ((OR (ATOM G166504) + (PROGN + (SETQ |var| (CAR G166504)) + NIL)) + (NREVERSE0 G166499)) + (SEQ (EXIT + (SETQ G166499 + (CONS + (|objValUnwrap| + (|coerceInt| + (|objNewWrap| |var| |$Symbol|) + |target|)) + G166499)))))))) + (SPADLET |sum| (|domainZero| |target|)) + (SPADLET |plus| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |mult| + (|getFunctionFromDomain| '* |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |expn| + (|getFunctionFromDomain| '** |target| + (CONS |target| (CONS |$Integer| NIL)))) + (DO ((G166516 |u| (CDR G166516)) (G166457 NIL)) + ((OR (ATOM G166516) + (PROGN (SETQ G166457 (CAR G166516)) NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G166457)) + (SPADLET |c| (CDR G166457)) + G166457) + NIL)) + NIL) + (SEQ (EXIT (COND + ((NULL (SPADLET |c| + (|coerceInt| + (|objNewWrap| |c| S) |target|))) + (|coercionFailure|)) + ('T (SPADLET |c| (|objValUnwrap| |c|)) + (SPADLET |term| (|domainOne| |target|)) + (DO ((|i| 0 (QSADD1 |i|)) + (G166529 |syms| (CDR G166529)) + (|sym| NIL)) + ((OR (ATOM G166529) + (PROGN + (SETQ |sym| (CAR G166529)) + NIL)) + NIL) + (SEQ (EXIT + (PROGN + (SPADLET |exp| (ELT |e| |i|)) + (COND + ((> (ELT |e| |i|) 0) + (SPADLET |term| + (SPADCALL |term| + (SPADCALL |sym| + (ELT |e| |i|) |expn|) + |mult|)))))))) + (SPADLET |sum| + (SPADCALL |sum| + (SPADCALL |c| |term| |mult|) + |plus|))))))) + |sum|))))))) ;Dmp2Mp(u, source is [dmp, x, S], target is [mp, y, T]) == ; source' := [dmp,y,T] @@ -547,59 +638,54 @@ all these coercion functions have the following result: ; u'' (DEFUN |Dmp2Mp| (|u| |source| |target|) - (PROG (|mp| |y| T$ |dmp| |x| S |source'| |u'| |plusfunc| |u''|) - (RETURN - (SEQ - (PROGN - (SPADLET |mp| (CAR |target|)) - (SPADLET |y| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |dmp| (CAR |source|)) - (SPADLET |x| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (SPADLET |source'| (CONS |dmp| (CONS |y| (CONS T$ NIL)))) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (COND - ((BOOT-EQUAL |x| |y|) (|canCoerce| S T$)) - ((QUOTE T) (|canCoerce| |source'| |target|)))) - ((NULL |u|) (|domainZero| |target|)) - ((NEQUAL |x| |y|) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |u| |source|) |source'|)) - (|coercionFailure|)) - (OR - (SPADLET |u'| (|coerceInt| |u'| |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)) - ((AND (BOOT-EQUAL |x| |y|) - (EQL 1 (|#| |u|)) - (EQL 1 (|#| |x|)) - (BOOT-EQUAL S T$)) - (CONS 1 - (CONS 1 - (CONS - (CONS (ELT (CAAR |u|) 0) (CONS 0 (CDAR |u|))) - NIL)))) - ((BOOT-EQUAL - (SPADLET |u'| (|coerceDmpCoeffs| |u| S T$)) - (QUOTE |failed|)) - (|coercionFailure|)) - ((QUOTE T) - (SPADLET |plusfunc| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |u''| (|genMpFromDmpTerm| (ELT |u'| 0) 0)) - (DO ((#0=#:G166590 (SPADDIFFERENCE (|#| |u'|) 1)) (|i| 1 (QSADD1 |i|))) - ((QSGREATERP |i| #0#) NIL) - (SEQ - (EXIT - (SPADLET |u''| - (SPADCALL |u''| - (|genMpFromDmpTerm| (ELT |u'| |i|) 0) |plusfunc|))))) - |u''|))))))) + (PROG (|mp| |y| T$ |dmp| |x| S |source'| |u'| |plusfunc| |u''|) + (RETURN + (SEQ (PROGN + (SPADLET |mp| (CAR |target|)) + (SPADLET |y| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |dmp| (CAR |source|)) + (SPADLET |x| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (SPADLET |source'| (CONS |dmp| (CONS |y| (CONS T$ NIL)))) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (COND + ((BOOT-EQUAL |x| |y|) (|canCoerce| S T$)) + ('T (|canCoerce| |source'| |target|)))) + ((NULL |u|) (|domainZero| |target|)) + ((NEQUAL |x| |y|) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |u| |source|) + |source'|)) + (|coercionFailure|)) + (OR (SPADLET |u'| (|coerceInt| |u'| |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)) + ((AND (BOOT-EQUAL |x| |y|) (EQL 1 (|#| |u|)) + (EQL 1 (|#| |x|)) (BOOT-EQUAL S T$)) + (CONS 1 + (CONS 1 + (CONS (CONS (ELT (CAAR |u|) 0) + (CONS 0 (CDAR |u|))) + NIL)))) + ((BOOT-EQUAL (SPADLET |u'| (|coerceDmpCoeffs| |u| S T$)) + '|failed|) + (|coercionFailure|)) + ('T + (SPADLET |plusfunc| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |u''| (|genMpFromDmpTerm| (ELT |u'| 0) 0)) + (DO ((G166590 (SPADDIFFERENCE (|#| |u'|) 1)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G166590) NIL) + (SEQ (EXIT (SPADLET |u''| + (SPADCALL |u''| + (|genMpFromDmpTerm| + (ELT |u'| |i|) 0) + |plusfunc|))))) + |u''|))))))) ;coerceDmpCoeffs(u,S,T) == ; -- u is a dmp, S is domain of coeffs, T is domain to coerce coeffs to @@ -614,34 +700,34 @@ all these coercion functions have the following result: ; nreverse u' (DEFUN |coerceDmpCoeffs| (|u| S T$) - (PROG (|e| |c| |c'| |bad| |u'|) - (RETURN - (SEQ - (COND - ((BOOT-EQUAL S T$) |u|) - ((QUOTE T) - (SPADLET |u'| NIL) - (SPADLET |bad| NIL) - (DO ((#0=#:G166620 |u| (CDR #0#)) (#1=#:G166611 NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN - (SPADLET |e| (CAR #1#)) - (SPADLET |c| (CDR #1#)) #1#) - NIL)) - NIL) - (SEQ - (EXIT - (COND - (|bad| NIL) - ((NULL (SPADLET |c'| (|coerceInt| (|objNewWrap| |c| S) T$))) - (RETURN (SPADLET |bad| (QUOTE T)))) - ((QUOTE T) - (SPADLET |u'| (CONS (CONS |e| (|objValUnwrap| |c'|)) |u'|))))))) - (COND - (|bad| (QUOTE |failed|)) - ((QUOTE T) (NREVERSE |u'|))))))))) + (PROG (|e| |c| |c'| |bad| |u'|) + (RETURN + (SEQ (COND + ((BOOT-EQUAL S T$) |u|) + ('T (SPADLET |u'| NIL) (SPADLET |bad| NIL) + (DO ((G166620 |u| (CDR G166620)) (G166611 NIL)) + ((OR (ATOM G166620) + (PROGN (SETQ G166611 (CAR G166620)) NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G166611)) + (SPADLET |c| (CDR G166611)) + G166611) + NIL)) + NIL) + (SEQ (EXIT (COND + (|bad| NIL) + ((NULL (SPADLET |c'| + (|coerceInt| (|objNewWrap| |c| S) + T$))) + (RETURN (SPADLET |bad| 'T))) + ('T + (SPADLET |u'| + (CONS + (CONS |e| + (|objValUnwrap| |c'|)) + |u'|))))))) + (COND (|bad| '|failed|) ('T (NREVERSE |u'|))))))))) ;sortAndReorderDmpExponents(u,vl) == ; vl' := reverse MSORT vl @@ -656,33 +742,36 @@ all these coercion functions have the following result: ; reverse u' (DEFUN |sortAndReorderDmpExponents| (|u| |vl|) - (PROG (|vl'| |n| |pos| |e| |c| |e'| |u'|) - (RETURN - (SEQ - (PROGN - (SPADLET |vl'| (REVERSE (MSORT |vl|))) - (SPADLET |n| (PLUS (SPADDIFFERENCE 1) (|#| |vl|))) - (SPADLET |pos| (LIST2VEC (|LZeros| (PLUS |n| 1)))) - (DO ((|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| |n|) NIL) - (SEQ (EXIT (SETELT |pos| |i| (|position| (ELT |vl| |i|) |vl'|))))) - (SPADLET |u'| NIL) - (DO ((#0=#:G166656 |u| (CDR #0#)) (#1=#:G166638 NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN (SPADLET |e| (CAR #1#)) (SPADLET |c| (CDR #1#)) #1#) - NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |e'| (LIST2VEC (|LZeros| (PLUS |n| 1)))) - (DO ((|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| |n|) NIL) - (SEQ (EXIT (SETELT |e'| (ELT |pos| |i|) (ELT |e| |i|))))) - (SPADLET |u'| (CONS (CONS |e'| |c|) |u'|)))))) - (REVERSE |u'|)))))) + (PROG (|vl'| |n| |pos| |e| |c| |e'| |u'|) + (RETURN + (SEQ (PROGN + (SPADLET |vl'| (REVERSE (MSORT |vl|))) + (SPADLET |n| (PLUS (SPADDIFFERENCE 1) (|#| |vl|))) + (SPADLET |pos| (LIST2VEC (|LZeros| (PLUS |n| 1)))) + (DO ((|i| 0 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (SETELT |pos| |i| + (|position| (ELT |vl| |i|) |vl'|))))) + (SPADLET |u'| NIL) + (DO ((G166656 |u| (CDR G166656)) (G166638 NIL)) + ((OR (ATOM G166656) + (PROGN (SETQ G166638 (CAR G166656)) NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G166638)) + (SPADLET |c| (CDR G166638)) + G166638) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |e'| + (LIST2VEC (|LZeros| (PLUS |n| 1)))) + (DO ((|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT + (SETELT |e'| (ELT |pos| |i|) + (ELT |e| |i|))))) + (SPADLET |u'| (CONS (CONS |e'| |c|) |u'|)))))) + (REVERSE |u'|)))))) ;domain2NDmp(u, source, target is [., y, T]) == ; target' := ['DistributedMultivariatePolynomial,y,T] @@ -694,23 +783,24 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |domain2NDmp| (|u| |source| |target|) - (PROG (|y| T$ |target'| |u'| |u''|) - (RETURN - (PROGN - (SPADLET |y| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |target'| - (CONS - (QUOTE |DistributedMultivariatePolynomial|) - (CONS |y| (CONS T$ NIL)))) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (|canCoerce| |source| |target'|)) - ((SPADLET |u'| (|coerceInt| (|objNewWrap| |u| |source|) |target'|)) - (COND - ((SPADLET |u''| (|coerceInt| |u'| |target|)) (|objValUnwrap| |u''|)) - ((QUOTE T) (|coercionFailure|)))) - ((QUOTE T) (|coercionFailure|))))))) + (PROG (|y| T$ |target'| |u'| |u''|) + (RETURN + (PROGN + (SPADLET |y| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |target'| + (CONS '|DistributedMultivariatePolynomial| + (CONS |y| (CONS T$ NIL)))) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| |source| |target'|)) + ((SPADLET |u'| + (|coerceInt| (|objNewWrap| |u| |source|) |target'|)) + (COND + ((SPADLET |u''| (|coerceInt| |u'| |target|)) + (|objValUnwrap| |u''|)) + ('T (|coercionFailure|)))) + ('T (|coercionFailure|))))))) ;Dmp2NDmp(u,source is [dmp,x,S],target is [ndmp,y,T]) == ; -- a null DMP = 0 @@ -721,25 +811,24 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |Dmp2NDmp| (|u| |source| |target|) - (PROG (|ndmp| |y| T$ |dmp| |x| S |target'| |u'|) - (RETURN - (PROGN - (SPADLET |ndmp| (CAR |target|)) - (SPADLET |y| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |dmp| (CAR |source|)) - (SPADLET |x| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((NULL |u|) (|domainZero| |target|)) - ((QUOTE T) - (SPADLET |target'| (CONS |dmp| (CONS |y| (CONS T$ NIL)))) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (|Dmp2Dmp| |u| |source| |target'|)) - ((SPADLET |u'| (|Dmp2Dmp| |u| |source| |target'|)) - (|addDmpLikeTermsAsTarget| |u'| |target|)) - ((QUOTE T) (|coercionFailure|))))))))) + (PROG (|ndmp| |y| T$ |dmp| |x| S |target'| |u'|) + (RETURN + (PROGN + (SPADLET |ndmp| (CAR |target|)) + (SPADLET |y| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |dmp| (CAR |source|)) + (SPADLET |x| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (COND + ((NULL |u|) (|domainZero| |target|)) + ('T (SPADLET |target'| (CONS |dmp| (CONS |y| (CONS T$ NIL)))) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|Dmp2Dmp| |u| |source| |target'|)) + ((SPADLET |u'| (|Dmp2Dmp| |u| |source| |target'|)) + (|addDmpLikeTermsAsTarget| |u'| |target|)) + ('T (|coercionFailure|))))))))) ;addDmpLikeTermsAsTarget(u,target) == ; u' := domainZero(target) @@ -748,20 +837,21 @@ all these coercion functions have the following result: ; u' (DEFUN |addDmpLikeTermsAsTarget| (|u| |target|) - (PROG (|func| |u'|) - (RETURN - (SEQ - (PROGN - (SPADLET |u'| (|domainZero| |target|)) - (SPADLET |func| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (DO ((#0=#:G166739 |u| (CDR #0#)) (|t| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |t| (CAR #0#)) NIL)) NIL) - (SEQ (EXIT (SPADLET |u'| (SPADCALL |u'| (CONS |t| NIL) |func|))))) - |u'|))))) + (PROG (|func| |u'|) + (RETURN + (SEQ (PROGN + (SPADLET |u'| (|domainZero| |target|)) + (SPADLET |func| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (DO ((G166739 |u| (CDR G166739)) (|t| NIL)) + ((OR (ATOM G166739) + (PROGN (SETQ |t| (CAR G166739)) NIL)) + NIL) + (SEQ (EXIT (SPADLET |u'| + (SPADCALL |u'| (CONS |t| NIL) + |func|))))) + |u'|))))) ;-- rewrite ? ;Dmp2P(u, source is [dmp,vl, S], target is [.,T]) == @@ -805,96 +895,110 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |Dmp2P| (|u| |source| |target|) - (PROG (T$ |dmp| |vl| S |ISTMP#1| |mp| |p| |lexp| |vl'| |target'| |source'| - |oneT| |plusfunc| |multfunc| |e| |c| |c'| |e'| |t| |u'|) - (RETURN - (SEQ - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET |dmp| (CAR |source|)) - (SPADLET |vl| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((NULL |u|) (|domainZero| |target|)) - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (SPADLET |t| (|canCoerce| S T$)) - (COND ((NULL |t|) (|canCoerce| S |target|)) ((QUOTE T) |t|))) - ((AND (PAIRP S) - (EQ (QCAR S) (QUOTE |Polynomial|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR S)) - (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL)))) - (SPADLET |mp| - (OR - (|coerceInt| - (|objNewWrap| |u| |source|) - (CONS (QUOTE |MultivariatePolynomial|) (CONS |vl| (CONS S NIL)))) - (|coercionFailure|))) - (SPADLET |p| (OR (|coerceInt| |mp| |target|) (|coercionFailure|))) - (|objValUnwrap| |p|)) - ((AND (EQL 1 (|#| |u|)) (EQL 1 (|#| |vl|)) (BOOT-EQUAL S T$)) - (COND - ((EQL (SPADLET |lexp| (ELT (CAAR |u|) 0)) 0) (CONS 1 (CDAR |u|))) - ((QUOTE T) - (CONS 1 - (CONS (ELT |vl| 0) - (CONS (CONS |lexp| (CONS 0 (CDAR |u|))) NIL)))))) - ((QUOTE T) - (SPADLET |vl'| (REVERSE (MSORT |vl|))) - (SPADLET |source'| (CONS |dmp| (CONS |vl'| (CONS S NIL)))) - (SPADLET |target'| - (CONS (QUOTE |MultivariatePolynomial|) (CONS |vl'| (CONS S NIL)))) - (SPADLET |u'| (|sortAndReorderDmpExponents| |u| |vl|)) - (SPADLET |u'| (|coerceInt| (|objNewWrap| |u'| |source'|) |target'|)) - (COND - (|u'| - (SPADLET |u'| (|translateMpVars2PVars| (|objValUnwrap| |u'|) |vl'|)) - (SPADLET |u'| - (|coerceInt| - (|objNewWrap| |u'| - (CONS (QUOTE |Polynomial|) (CONS S NIL))) |target|)))) - (COND - (|u'| (|objValUnwrap| |u'|)) - ((QUOTE T) - (SPADLET |source'| (CONS |dmp| (CONS |vl| (CONS T$ NIL)))) - (SPADLET |u'| (|domainZero| |target|)) - (SPADLET |oneT| (|domainOne| T$)) - (SPADLET |plusfunc| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |multfunc| - (|getFunctionFromDomain| - (QUOTE *) - |target| - (CONS |target| (CONS |target| NIL)))) - (DO ((#0=#:G166802 |u| (CDR #0#)) (#1=#:G166758 NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN (SPADLET |e| (CAR #1#)) (SPADLET |c| (CDR #1#)) #1#) - NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (OR - (SPADLET |c'| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|coercionFailure|)) - (OR - (SPADLET |e'| - (|coerceInt| - (|objNewWrap| - (CONS (CONS |e| |oneT|) NIL) |source'|) |target|)) - (|coercionFailure|)) - (SPADLET |t| - (SPADCALL - (|objValUnwrap| |e'|) - (|objValUnwrap| |c'|) - |multfunc|)) - (SPADLET |u'| (SPADCALL |u'| |t| |plusfunc|)))))) - (|coercionFailure|)))))))))) + (PROG (T$ |dmp| |vl| S |ISTMP#1| |mp| |p| |lexp| |vl'| |target'| + |source'| |oneT| |plusfunc| |multfunc| |e| |c| |c'| |e'| + |t| |u'|) + (RETURN + (SEQ (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET |dmp| (CAR |source|)) + (SPADLET |vl| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (COND + ((NULL |u|) (|domainZero| |target|)) + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (SPADLET |t| (|canCoerce| S T$)) + (COND ((NULL |t|) (|canCoerce| S |target|)) ('T |t|))) + ((AND (PAIRP S) (EQ (QCAR S) '|Polynomial|) + (PROGN + (SPADLET |ISTMP#1| (QCDR S)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL)))) + (SPADLET |mp| + (OR (|coerceInt| (|objNewWrap| |u| |source|) + (CONS '|MultivariatePolynomial| + (CONS |vl| (CONS S NIL)))) + (|coercionFailure|))) + (SPADLET |p| + (OR (|coerceInt| |mp| |target|) + (|coercionFailure|))) + (|objValUnwrap| |p|)) + ((AND (EQL 1 (|#| |u|)) (EQL 1 (|#| |vl|)) + (BOOT-EQUAL S T$)) + (COND + ((EQL (SPADLET |lexp| (ELT (CAAR |u|) 0)) 0) + (CONS 1 (CDAR |u|))) + ('T + (CONS 1 + (CONS (ELT |vl| 0) + (CONS (CONS |lexp| (CONS 0 (CDAR |u|))) + NIL)))))) + ('T (SPADLET |vl'| (REVERSE (MSORT |vl|))) + (SPADLET |source'| + (CONS |dmp| (CONS |vl'| (CONS S NIL)))) + (SPADLET |target'| + (CONS '|MultivariatePolynomial| + (CONS |vl'| (CONS S NIL)))) + (SPADLET |u'| (|sortAndReorderDmpExponents| |u| |vl|)) + (SPADLET |u'| + (|coerceInt| (|objNewWrap| |u'| |source'|) + |target'|)) + (COND + (|u'| (SPADLET |u'| + (|translateMpVars2PVars| + (|objValUnwrap| |u'|) |vl'|)) + (SPADLET |u'| + (|coerceInt| + (|objNewWrap| |u'| + (CONS '|Polynomial| (CONS S NIL))) + |target|)))) + (COND + (|u'| (|objValUnwrap| |u'|)) + ('T + (SPADLET |source'| + (CONS |dmp| (CONS |vl| (CONS T$ NIL)))) + (SPADLET |u'| (|domainZero| |target|)) + (SPADLET |oneT| (|domainOne| T$)) + (SPADLET |plusfunc| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |multfunc| + (|getFunctionFromDomain| '* |target| + (CONS |target| (CONS |target| NIL)))) + (DO ((G166802 |u| (CDR G166802)) + (G166758 NIL)) + ((OR (ATOM G166802) + (PROGN + (SETQ G166758 (CAR G166802)) + NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G166758)) + (SPADLET |c| (CDR G166758)) + G166758) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (OR (SPADLET |c'| + (|coerceInt| + (|objNewWrap| |c| S) |target|)) + (|coercionFailure|)) + (OR (SPADLET |e'| + (|coerceInt| + (|objNewWrap| + (CONS (CONS |e| |oneT|) NIL) + |source'|) + |target|)) + (|coercionFailure|)) + (SPADLET |t| + (SPADCALL + (|objValUnwrap| |e'|) + (|objValUnwrap| |c'|) + |multfunc|)) + (SPADLET |u'| + (SPADCALL |u'| |t| + |plusfunc|)))))) + (|coercionFailure|)))))))))) ;translateMpVars2PVars (u, vl) == ; u is [ =1, v, :termlist] => @@ -903,41 +1007,44 @@ all these coercion functions have the following result: ; u (DEFUN |translateMpVars2PVars| (|u| |vl|) - (PROG (|ISTMP#1| |v| |termlist| |e| |c|) - (RETURN - (SEQ - (COND - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 1) - (PROGN - (SPADLET |ISTMP#1| (QCDR |u|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |v| (QCAR |ISTMP#1|)) - (SPADLET |termlist| (QCDR |ISTMP#1|)) - (QUOTE T))))) - (CONS 1 - (CONS - (ELT |vl| (SPADDIFFERENCE |v| 1)) - (PROG (#0=#:G166857) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166863 |termlist| (CDR #1#)) (#2=#:G166847 NIL)) - ((OR (ATOM #1#) - (PROGN (SETQ #2# (CAR #1#)) NIL) + (PROG (|ISTMP#1| |v| |termlist| |e| |c|) + (RETURN + (SEQ (COND + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 1) (PROGN - (PROGN - (SPADLET |e| (CAR #2#)) - (SPADLET |c| (CDR #2#)) - #2#) - NIL)) - (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS (CONS |e| (|translateMpVars2PVars| |c| |vl|)) #0#)))))))))) - ((QUOTE T) |u|)))))) + (SPADLET |ISTMP#1| (QCDR |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |v| (QCAR |ISTMP#1|)) + (SPADLET |termlist| (QCDR |ISTMP#1|)) + 'T)))) + (CONS 1 + (CONS (ELT |vl| (SPADDIFFERENCE |v| 1)) + (PROG (G166857) + (SPADLET G166857 NIL) + (RETURN + (DO ((G166863 |termlist| + (CDR G166863)) + (G166847 NIL)) + ((OR (ATOM G166863) + (PROGN + (SETQ G166847 (CAR G166863)) + NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G166847)) + (SPADLET |c| (CDR G166847)) + G166847) + NIL)) + (NREVERSE0 G166857)) + (SEQ (EXIT + (SETQ G166857 + (CONS + (CONS |e| + (|translateMpVars2PVars| |c| + |vl|)) + G166857)))))))))) + ('T |u|)))))) ;Dmp2Up(u, source is [dmp,vl,S],target is [up,var,T]) == ; null u => -- this is true if u = 0 @@ -987,160 +1094,193 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |Dmp2Up| (|u| |source| |target|) - (PROG (|up| |var| T$ |dmp| |vl| S |ISTMP#1| |vl'| |u'| S1 |plusfunc| |zero| - |pos| |e| |c| |exp| |e1| |y| |p| |c'| |x|) - (RETURN - (SEQ - (PROGN - (SPADLET |up| (CAR |target|)) - (SPADLET |var| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |dmp| (CAR |source|)) - (SPADLET |vl| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((NULL |u|) (|domainZero| |target|)) - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (COND - ((|member| |var| |vl|) - (SPADLET |vl'| (|remove| |vl| |var|)) - (COND - ((NULL |vl'|) (|canCoerce| S T$)) - ((NULL (CDR |vl'|)) - (|canCoerce| (CONS |up| (CONS (CAR |vl'|) (CONS S NIL))) T$)) - ((QUOTE T) (|canCoerce| (CONS |dmp| (CONS |vl'| (CONS S NIL))) T$)))) - ((QUOTE T) (|canCoerce| |source| T$)))) - ((AND - (NULL (CDR |u|)) - (PROGN - (SPADLET |ISTMP#1| (CAR |u|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |e| (QCAR |ISTMP#1|)) - (SPADLET |c| (QCDR |ISTMP#1|)) - (QUOTE T)))) - (PROG (#0=#:G166951) - (SPADLET #0# (QUOTE T)) - (RETURN - (DO ((#1=#:G166957 NIL (NULL #0#)) - (#2=#:G166958 (PLUS (SPADDIFFERENCE 1) (|#| |vl|))) - (|i| 0 (QSADD1 |i|))) - ((OR #1# (QSGREATERP |i| #2#)) #0#) - (SEQ (EXIT (SETQ #0# (AND #0# (EQL 0 (ELT |e| |i|)))))))))) - (OR - (SPADLET |x| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |x|)) - ((NULL (|member| |var| |vl|)) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |u| |source|) T$)) - (|coercionFailure|)) - (CONS (CONS 0 (|objValUnwrap| |u'|)) NIL)) - ((QUOTE T) - (SPADLET |vl'| (|remove| |vl| |var|)) - (COND - ((NULL |vl'|) - (SPADLET |u'| - (NREVERSE - (SORTBY - (QUOTE CAR) - (PROG (#3=#:G166968) - (SPADLET #3# NIL) - (RETURN - (DO ((#4=#:G166974 |u| (CDR #4#)) (#5=#:G166891 NIL)) - ((OR (ATOM #4#) - (PROGN (SETQ #5# (CAR #4#)) NIL) - (PROGN - (PROGN - (SPADLET |e| (CAR #5#)) - (SPADLET |c| (CDR #5#)) - #5#) - NIL)) - (NREVERSE0 #3#)) - (SEQ (EXIT (SETQ #3# (CONS (CONS (ELT |e| 0) |c|) #3#)))))))))) - (OR - (SPADLET |u'| - (|coerceInt| - (|objNewWrap| |u'| (CONS |up| (CONS |var| (CONS S NIL)))) - |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)) - ((QUOTE T) - (SPADLET S1 (CONS |dmp| (CONS |vl'| (CONS S NIL)))) - (SPADLET |plusfunc| - (|getFunctionFromDomain| (QUOTE +) T$ (CONS T$ (CONS T$ NIL)))) - (SPADLET |zero| (|getConstantFromDomain| (QUOTE (|Zero|)) T$)) - (SPADLET |x| NIL) - (SPADLET |pos| (POSN1 |var| |vl|)) - (DO ((#6=#:G166989 |u| (CDR #6#)) - (#7=#:G166899 NIL) - (#8=#:G166990 NIL (NULL |y|))) - ((OR (ATOM #6#) - (PROGN (SETQ #7# (CAR #6#)) NIL) - (PROGN - (PROGN - (SPADLET |e| (CAR #7#)) - (SPADLET |c| (CDR #7#)) - #7#) - NIL) - #8#) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |exp| (ELT |e| |pos|)) - (SPADLET |e1| (|removeVectorElt| |e| |pos|)) - (COND - ((SPADLET |y| (|coerceInt| (|objNewWrap| (CONS (CONS |e1| |c|) NIL) S1) T$)) + (PROG (|up| |var| T$ |dmp| |vl| S |ISTMP#1| |vl'| |u'| S1 |plusfunc| + |zero| |pos| |e| |c| |exp| |e1| |y| |p| |c'| |x|) + (RETURN + (SEQ (PROGN + (SPADLET |up| (CAR |target|)) + (SPADLET |var| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |dmp| (CAR |source|)) + (SPADLET |vl| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (COND + ((NULL |u|) (|domainZero| |target|)) + ((BOOT-EQUAL |u| '|$fromCoerceable$|) (COND - ((SPADLET |p| (ASSQ |exp| |x|)) - (SPADLET |c'| - (SPADCALL (CDR |p|) (|objValUnwrap| |y|) |plusfunc|)) - (COND - ((BOOT-EQUAL |c'| |zero|) - (SPADLET |x| (REMALIST |x| |exp|))) - ((QUOTE T) - (RPLACD |p| |c'|)))) - ((BOOT-EQUAL |zero| (|objValUnwrap| |y|)) (QUOTE |iterate|)) - ((QUOTE T) - (SPADLET |x| - (CONS (CONS |exp| (|objValUnwrap| |y|)) |x|)))))))))) - (COND - (|y| (NREVERSE (SORTBY (QUOTE CAR) |x|))) - ((QUOTE T) (|coercionFailure|)))))))))))) + ((|member| |var| |vl|) + (SPADLET |vl'| (|remove| |vl| |var|)) + (COND + ((NULL |vl'|) (|canCoerce| S T$)) + ((NULL (CDR |vl'|)) + (|canCoerce| + (CONS |up| (CONS (CAR |vl'|) (CONS S NIL))) + T$)) + ('T + (|canCoerce| + (CONS |dmp| (CONS |vl'| (CONS S NIL))) T$)))) + ('T (|canCoerce| |source| T$)))) + ((AND (NULL (CDR |u|)) + (PROGN + (SPADLET |ISTMP#1| (CAR |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |e| (QCAR |ISTMP#1|)) + (SPADLET |c| (QCDR |ISTMP#1|)) + 'T))) + (PROG (G166951) + (SPADLET G166951 'T) + (RETURN + (DO ((G166957 NIL (NULL G166951)) + (G166958 + (PLUS (SPADDIFFERENCE 1) (|#| |vl|))) + (|i| 0 (QSADD1 |i|))) + ((OR G166957 (QSGREATERP |i| G166958)) + G166951) + (SEQ (EXIT (SETQ G166951 + (AND G166951 + (EQL 0 (ELT |e| |i|)))))))))) + (OR (SPADLET |x| + (|coerceInt| (|objNewWrap| |c| S) + |target|)) + (|coercionFailure|)) + (|objValUnwrap| |x|)) + ((NULL (|member| |var| |vl|)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |u| |source|) + T$)) + (|coercionFailure|)) + (CONS (CONS 0 (|objValUnwrap| |u'|)) NIL)) + ('T (SPADLET |vl'| (|remove| |vl| |var|)) + (COND + ((NULL |vl'|) + (SPADLET |u'| + (NREVERSE + (SORTBY 'CAR + (PROG (G166968) + (SPADLET G166968 NIL) + (RETURN + (DO + ((G166974 |u| + (CDR G166974)) + (G166891 NIL)) + ((OR (ATOM G166974) + (PROGN + (SETQ G166891 + (CAR G166974)) + NIL) + (PROGN + (PROGN + (SPADLET |e| + (CAR G166891)) + (SPADLET |c| + (CDR G166891)) + G166891) + NIL)) + (NREVERSE0 G166968)) + (SEQ + (EXIT + (SETQ G166968 + (CONS + (CONS (ELT |e| 0) + |c|) + G166968)))))))))) + (OR (SPADLET |u'| + (|coerceInt| + (|objNewWrap| |u'| + (CONS |up| + (CONS |var| (CONS S NIL)))) + |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)) + ('T + (SPADLET S1 (CONS |dmp| (CONS |vl'| (CONS S NIL)))) + (SPADLET |plusfunc| + (|getFunctionFromDomain| '+ T$ + (CONS T$ (CONS T$ NIL)))) + (SPADLET |zero| + (|getConstantFromDomain| '(|Zero|) T$)) + (SPADLET |x| NIL) (SPADLET |pos| (POSN1 |var| |vl|)) + (DO ((G166989 |u| (CDR G166989)) (G166899 NIL) + (G166990 NIL (NULL |y|))) + ((OR (ATOM G166989) + (PROGN + (SETQ G166899 (CAR G166989)) + NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G166899)) + (SPADLET |c| (CDR G166899)) + G166899) + NIL) + G166990) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |exp| (ELT |e| |pos|)) + (SPADLET |e1| + (|removeVectorElt| |e| + |pos|)) + (COND + ((SPADLET |y| + (|coerceInt| + (|objNewWrap| + (CONS (CONS |e1| |c|) NIL) S1) + T$)) + (COND + ((SPADLET |p| (ASSQ |exp| |x|)) + (SPADLET |c'| + (SPADCALL (CDR |p|) + (|objValUnwrap| |y|) + |plusfunc|)) + (COND + ((BOOT-EQUAL |c'| |zero|) + (SPADLET |x| + (REMALIST |x| |exp|))) + ('T (RPLACD |p| |c'|)))) + ((BOOT-EQUAL |zero| + (|objValUnwrap| |y|)) + '|iterate|) + ('T + (SPADLET |x| + (CONS + (CONS |exp| + (|objValUnwrap| |y|)) + |x|)))))))))) + (COND + (|y| (NREVERSE (SORTBY 'CAR |x|))) + ('T (|coercionFailure|)))))))))))) ;removeVectorElt(v,pos) == ; -- removes the pos'th element from vector v ; LIST2VEC [x for x in VEC2LIST v for y in 0.. | not (y=pos)] (DEFUN |removeVectorElt| (|v| |pos|) - (PROG NIL - (RETURN - (SEQ - (LIST2VEC - (PROG (#0=#:G167040) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G167047 (VEC2LIST |v|) (CDR #1#)) - (|x| NIL) - (|y| 0 (QSADD1 |y|))) - ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) - (SEQ - (EXIT - (COND - ((NULL (BOOT-EQUAL |y| |pos|)) - (SETQ #0# (CONS |x| #0#)))))))))))))) + (PROG () + (RETURN + (SEQ (LIST2VEC + (PROG (G167040) + (SPADLET G167040 NIL) + (RETURN + (DO ((G167047 (VEC2LIST |v|) (CDR G167047)) + (|x| NIL) (|y| 0 (QSADD1 |y|))) + ((OR (ATOM G167047) + (PROGN (SETQ |x| (CAR G167047)) NIL)) + (NREVERSE0 G167040)) + (SEQ (EXIT (COND + ((NULL (BOOT-EQUAL |y| |pos|)) + (SETQ G167040 + (CONS |x| G167040)))))))))))))) ;removeListElt(l,pos) == ; pos = 0 => CDR l ; [CAR l, :removeListElt(CDR l,pos-1)] (DEFUN |removeListElt| (|l| |pos|) - (COND - ((EQL |pos| 0) (CDR |l|)) - ((QUOTE T) - (CONS (CAR |l|) (|removeListElt| (CDR |l|) (SPADDIFFERENCE |pos| 1)))))) + (COND + ((EQL |pos| 0) (CDR |l|)) + ('T + (CONS (CAR |l|) + (|removeListElt| (CDR |l|) (SPADDIFFERENCE |pos| 1)))))) ;NDmp2domain(u,source is [ndmp,x,S],target) == ; -- a null NDMP = 0 @@ -1154,27 +1294,27 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |NDmp2domain| (|u| |source| |target|) - (PROG (|ndmp| |x| S |dmp| |source'| |u'| |u''|) - (RETURN - (PROGN - (SPADLET |ndmp| (CAR |source|)) - (SPADLET |x| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((NULL |u|) (|domainZero| |target|)) - ((QUOTE T) - (SPADLET |dmp| (QUOTE |DistributedMultivariatePolynomial|)) - (SPADLET |source'| (CONS |dmp| (CONS |x| (CONS S NIL)))) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (|canCoerce| |source'| |target|)) - ((QUOTE T) - (SPADLET |u'| (|addDmpLikeTermsAsTarget| |u| |source'|)) + (PROG (|ndmp| |x| S |dmp| |source'| |u'| |u''|) + (RETURN + (PROGN + (SPADLET |ndmp| (CAR |source|)) + (SPADLET |x| (CADR |source|)) + (SPADLET S (CADDR |source|)) (COND - ((SPADLET |u''| (|coerceInt| (|objNewWrap| |u'| |source'|) |target|)) - (|objValUnwrap| |u''|)) - ((QUOTE T) - (|coercionFailure|))))))))))) + ((NULL |u|) (|domainZero| |target|)) + ('T (SPADLET |dmp| '|DistributedMultivariatePolynomial|) + (SPADLET |source'| (CONS |dmp| (CONS |x| (CONS S NIL)))) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| |source'| |target|)) + ('T + (SPADLET |u'| (|addDmpLikeTermsAsTarget| |u| |source'|)) + (COND + ((SPADLET |u''| + (|coerceInt| (|objNewWrap| |u'| |source'|) + |target|)) + (|objValUnwrap| |u''|)) + ('T (|coercionFailure|))))))))))) ;NDmp2NDmp(u,source is [ndmp,x,S],target is [.,y,T]) == ; -- a null NDMP = 0 @@ -1189,29 +1329,31 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |NDmp2NDmp| (|u| |source| |target|) - (PROG (|y| T$ |ndmp| |x| S |dmp| |source'| |target'| |u'| |u''|) - (RETURN - (PROGN - (SPADLET |y| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |ndmp| (CAR |source|)) - (SPADLET |x| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((NULL |u|) (|domainZero| |target|)) - ((QUOTE T) - (SPADLET |dmp| (QUOTE |DistributedMultivariatePolynomial|)) - (SPADLET |source'| (CONS |dmp| (CONS |x| (CONS S NIL)))) - (SPADLET |target'| (CONS |dmp| (CONS |y| (CONS T$ NIL)))) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (|canCoerce| |source'| |target'|)) - ((QUOTE T) - (SPADLET |u'| (|addDmpLikeTermsAsTarget| |u| |source'|)) + (PROG (|y| T$ |ndmp| |x| S |dmp| |source'| |target'| |u'| |u''|) + (RETURN + (PROGN + (SPADLET |y| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |ndmp| (CAR |source|)) + (SPADLET |x| (CADR |source|)) + (SPADLET S (CADDR |source|)) (COND - ((SPADLET |u''| (|coerceInt| (|objNewWrap| |u'| |source'|) |target'|)) - (|addDmpLikeTermsAsTarget| (|objValUnwrap| |u''|) |target|)) - ((QUOTE T) (|coercionFailure|))))))))))) + ((NULL |u|) (|domainZero| |target|)) + ('T (SPADLET |dmp| '|DistributedMultivariatePolynomial|) + (SPADLET |source'| (CONS |dmp| (CONS |x| (CONS S NIL)))) + (SPADLET |target'| (CONS |dmp| (CONS |y| (CONS T$ NIL)))) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| |source'| |target'|)) + ('T + (SPADLET |u'| (|addDmpLikeTermsAsTarget| |u| |source'|)) + (COND + ((SPADLET |u''| + (|coerceInt| (|objNewWrap| |u'| |source'|) + |target'|)) + (|addDmpLikeTermsAsTarget| (|objValUnwrap| |u''|) + |target|)) + ('T (|coercionFailure|))))))))))) ;--% Expression ;Expr2Complex(u,source is [.,S], target is [.,T]) == @@ -1228,36 +1370,40 @@ all these coercion functions have the following result: ; cf (DEFUN |Expr2Complex| (|u| |source| |target|) - (PROG (T$ S |complexNumeric| |cf| |z|) - (RETURN - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) NIL) - ((NULL - (|member| S - (CONS |$Integer| (CONS |$Float| (CONS |$DoubleFloat| NIL))))) - (|coercionFailure|)) - ((NULL (|member| T$ (CONS |$Float| (CONS |$DoubleFloat| NIL)))) - (|coercionFailure|)) - ((QUOTE T) - (SPADLET |complexNumeric| - (|getFunctionFromDomain| - (QUOTE |complexNumeric|) - (CONS (QUOTE |Numeric|) (CONS S NIL)) (CONS |source| NIL))) - (SPADLET |cf| (SPADCALL |u| |complexNumeric|)) - (COND - ((BOOT-EQUAL T$ |$DoubleFloat|) + (PROG (T$ S |complexNumeric| |cf| |z|) + (DECLARE (SPECIAL |$DoubleFloat| |$Float|)) + (RETURN + (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET S (CADR |source|)) (COND - ((NULL - (SPADLET |z| - (|coerceInt| - (|objNewWrap| |cf| (CONS (QUOTE |Complex|) (CONS |$Float| NIL))) - (CONS (QUOTE |Complex|) (CONS |$DoubleFloat| NIL))))) - (|coercionFailure|)) - ((QUOTE T) (|objValUnwrap| |z|)))) - ((QUOTE T) |cf|)))))))) + ((BOOT-EQUAL |u| '|$fromCoerceable$|) NIL) + ((NULL (|member| S + (CONS |$Integer| + (CONS |$Float| (CONS |$DoubleFloat| NIL))))) + (|coercionFailure|)) + ((NULL (|member| T$ + (CONS |$Float| (CONS |$DoubleFloat| NIL)))) + (|coercionFailure|)) + ('T + (SPADLET |complexNumeric| + (|getFunctionFromDomain| '|complexNumeric| + (CONS '|Numeric| (CONS S NIL)) + (CONS |source| NIL))) + (SPADLET |cf| (SPADCALL |u| |complexNumeric|)) + (COND + ((BOOT-EQUAL T$ |$DoubleFloat|) + (COND + ((NULL (SPADLET |z| + (|coerceInt| + (|objNewWrap| |cf| + (CONS '|Complex| + (CONS |$Float| NIL))) + (CONS '|Complex| + (CONS |$DoubleFloat| NIL))))) + (|coercionFailure|)) + ('T (|objValUnwrap| |z|)))) + ('T |cf|)))))))) ;Expr2Dmp(u,source is [Expr,S], target is [dmp,v2,T]) == ; u = '_$fromCoerceable_$ => canCoerce(source, T) @@ -1294,98 +1440,126 @@ all these coercion functions have the following result: ; sum (DEFUN |Expr2Dmp| (|u| |source| |target|) - (PROG (|dmp| |v2| T$ |Expr| S |obj| |z| |univ| |e| |c| - |summands| |plus| |sum|) - (RETURN - (SEQ - (PROGN - (SPADLET |dmp| (CAR |target|)) - (SPADLET |v2| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |Expr| (CAR |source|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| |source| T$)) - ((NULL |v2|) - (COND - ((NULL (SPADLET |z| (|coerceInt| (|objNewWrap| |u| |source|) T$))) - (|coercionFailure|)) - ((QUOTE T) (CONS (CONS (LIST2VEC NIL) (|objValUnwrap| |z|)) NIL)))) - ((QUOTE T) - (SPADLET |obj| (|objNewWrap| |u| |source|)) - (SPADLET |univ| - (|coerceInt| |obj| - (CONS - (QUOTE |UnivariatePolynomial|) - (CONS (CAR |v2|) (CONS T$ NIL))))) - (COND - ((NULL |univ|) - (COND - ((BOOT-EQUAL T$ |source|) (|coercionFailure|)) - ((NULL - (SPADLET |z| - (|coerceInt| |obj| (CONS |dmp| (CONS |v2| (CONS |source| NIL)))))) - (|coercionFailure|)) - ((QUOTE T) - (SPADLET |z| (|objValUnwrap| |z|)) - (DO ((#0=#:G167192 |z| (CDR #0#)) (|term| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |term| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |c| (CDR |term|)) - (COND - ((NULL - (SPADLET |c| (|coerceInt| (|objNewWrap| |c| |source|) T$))) - (|coercionFailure|)) - ((QUOTE T) (RPLACD |term| (|objValUnwrap| |c|)))))))) - |z|))) - ((QUOTE T) - (SPADLET |univ| (|objValUnwrap| |univ|)) - (COND - ((NULL (CDR |v2|)) - (DO ((#1=#:G167201 |univ| (CDR #1#)) (|term| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |term| (CAR #1#)) NIL)) NIL) - (SEQ (EXIT (RPLACA |term| (VECTOR (CAR |term|)))))) - |univ|) - ((QUOTE T) - (SPADLET |summands| NIL) - (DO ((#2=#:G167211 |univ| (CDR #2#)) (#3=#:G167150 NIL)) - ((OR (ATOM #2#) - (PROGN (SETQ #3# (CAR #2#)) NIL) - (PROGN - (PROGN - (SPADLET |e| (CAR #3#)) - (SPADLET |c| (CDR #3#)) - #3#) - NIL)) - NIL) - (SEQ - (EXIT - (SPADLET |summands| - (|Expr2Dmp1| |summands| - (LIST2VEC - (CONS |e| - (PROG (#4=#:G167222) - (SPADLET #4# NIL) - (RETURN - (DO ((#5=#:G167227 (CDR |v2|) (CDR #5#)) (|v| NIL)) - ((OR (ATOM #5#) (PROGN (SETQ |v| (CAR #5#)) NIL)) - (NREVERSE0 #4#)) - (SEQ (EXIT (SETQ #4# (CONS 0 #4#))))))))) - |c| T$ 1 (CDR |v2|) T$))))) - (SPADLET |plus| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |sum| (|domainZero| |target|)) - (DO ((#6=#:G167236 |summands| (CDR #6#)) (|summand| NIL)) - ((OR (ATOM #6#) (PROGN (SETQ |summand| (CAR #6#)) NIL)) NIL) - (SEQ - (EXIT - (SPADLET |sum| (SPADCALL (CONS |summand| NIL) |sum| |plus|))))) - |sum|))))))))))) + (PROG (|dmp| |v2| T$ |Expr| S |obj| |z| |univ| |e| |c| |summands| + |plus| |sum|) + (RETURN + (SEQ (PROGN + (SPADLET |dmp| (CAR |target|)) + (SPADLET |v2| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |Expr| (CAR |source|)) + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| |source| T$)) + ((NULL |v2|) + (COND + ((NULL (SPADLET |z| + (|coerceInt| + (|objNewWrap| |u| |source|) T$))) + (|coercionFailure|)) + ('T + (CONS (CONS (LIST2VEC NIL) (|objValUnwrap| |z|)) + NIL)))) + ('T (SPADLET |obj| (|objNewWrap| |u| |source|)) + (SPADLET |univ| + (|coerceInt| |obj| + (CONS '|UnivariatePolynomial| + (CONS (CAR |v2|) (CONS T$ NIL))))) + (COND + ((NULL |univ|) + (COND + ((BOOT-EQUAL T$ |source|) (|coercionFailure|)) + ((NULL (SPADLET |z| + (|coerceInt| |obj| + (CONS |dmp| + (CONS |v2| (CONS |source| NIL)))))) + (|coercionFailure|)) + ('T (SPADLET |z| (|objValUnwrap| |z|)) + (DO ((G167192 |z| (CDR G167192)) + (|term| NIL)) + ((OR (ATOM G167192) + (PROGN + (SETQ |term| (CAR G167192)) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |c| (CDR |term|)) + (COND + ((NULL + (SPADLET |c| + (|coerceInt| + (|objNewWrap| |c| |source|) + T$))) + (|coercionFailure|)) + ('T + (RPLACD |term| + (|objValUnwrap| |c|)))))))) + |z|))) + ('T (SPADLET |univ| (|objValUnwrap| |univ|)) + (COND + ((NULL (CDR |v2|)) + (DO ((G167201 |univ| (CDR G167201)) + (|term| NIL)) + ((OR (ATOM G167201) + (PROGN + (SETQ |term| (CAR G167201)) + NIL)) + NIL) + (SEQ (EXIT (RPLACA |term| + (VECTOR (CAR |term|)))))) + |univ|) + ('T (SPADLET |summands| NIL) + (DO ((G167211 |univ| (CDR G167211)) + (G167150 NIL)) + ((OR (ATOM G167211) + (PROGN + (SETQ G167150 (CAR G167211)) + NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G167150)) + (SPADLET |c| (CDR G167150)) + G167150) + NIL)) + NIL) + (SEQ (EXIT (SPADLET |summands| + (|Expr2Dmp1| |summands| + (LIST2VEC + (CONS |e| + (PROG (G167222) + (SPADLET G167222 NIL) + (RETURN + (DO + ((G167227 (CDR |v2|) + (CDR G167227)) + (|v| NIL)) + ((OR (ATOM G167227) + (PROGN + (SETQ |v| + (CAR G167227)) + NIL)) + (NREVERSE0 G167222)) + (SEQ + (EXIT + (SETQ G167222 + (CONS 0 G167222))))))))) + |c| T$ 1 (CDR |v2|) T$))))) + (SPADLET |plus| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |sum| (|domainZero| |target|)) + (DO ((G167236 |summands| (CDR G167236)) + (|summand| NIL)) + ((OR (ATOM G167236) + (PROGN + (SETQ |summand| (CAR G167236)) + NIL)) + NIL) + (SEQ (EXIT (SPADLET |sum| + (SPADCALL (CONS |summand| NIL) + |sum| |plus|))))) + |sum|))))))))))) ;Expr2Dmp1(summands, vec, c, source, index, varList, T) == ; if null varList then @@ -1404,45 +1578,45 @@ all these coercion functions have the following result: ; summands (DEFUN |Expr2Dmp1| (|summands| |vec| |c| |source| |index| |varList| T$) - (PROG (|univ| |e|) - (RETURN - (SEQ - (PROGN - (COND - ((NULL |varList|) - (COND - ((NULL (BOOT-EQUAL |source| T$)) - (COND - ((NULL (SPADLET |c| (|coerceInt| (|objNewWrap| |c| |source|) T$))) - (|coercionFailure|)) - ((QUOTE T) (SPADLET |c| (|objValUnwrap| |c|)))))) - (SPADLET |summands| (CONS (CONS |vec| |c|) |summands|))) - ((QUOTE T) - (SPADLET |univ| - (|coerceInt| - (|objNewWrap| |c| |source|) - (CONS - (QUOTE |UnivariatePolynomial|) - (CONS (CAR |varList|) (CONS T$ NIL))))) - (SPADLET |univ| (|objValUnwrap| |univ|)) - (DO ((#0=#:G167282 |univ| (CDR #0#)) (#1=#:G167269 NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN - (SPADLET |e| (CAR #1#)) - (SPADLET |c| (CDR #1#)) #1#) - NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |vec| (COPY-SEQ |vec|)) - (SETELT |vec| |index| |e|) - (SPADLET |summands| - (|Expr2Dmp1| |summands| |vec| |c| - T$ (PLUS |index| 1) (CDR |varList|) T$)))))))) - |summands|))))) + (PROG (|univ| |e|) + (RETURN + (SEQ (PROGN + (COND + ((NULL |varList|) + (COND + ((NULL (BOOT-EQUAL |source| T$)) + (COND + ((NULL (SPADLET |c| + (|coerceInt| + (|objNewWrap| |c| |source|) T$))) + (|coercionFailure|)) + ('T (SPADLET |c| (|objValUnwrap| |c|)))))) + (SPADLET |summands| (CONS (CONS |vec| |c|) |summands|))) + ('T + (SPADLET |univ| + (|coerceInt| (|objNewWrap| |c| |source|) + (CONS '|UnivariatePolynomial| + (CONS (CAR |varList|) (CONS T$ NIL))))) + (SPADLET |univ| (|objValUnwrap| |univ|)) + (DO ((G167282 |univ| (CDR G167282)) + (G167269 NIL)) + ((OR (ATOM G167282) + (PROGN (SETQ G167269 (CAR G167282)) NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G167269)) + (SPADLET |c| (CDR G167269)) + G167269) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |vec| (COPY-SEQ |vec|)) + (SETELT |vec| |index| |e|) + (SPADLET |summands| + (|Expr2Dmp1| |summands| |vec| + |c| T$ (PLUS |index| 1) + (CDR |varList|) T$)))))))) + |summands|))))) ;Expr2Mp(u,source is [Expr,S], target is [.,v2,T]) == ; u = '_$fromCoerceable_$ => canCoerce(source, T) @@ -1452,25 +1626,27 @@ all these coercion functions have the following result: ; objValUnwrap m (DEFUN |Expr2Mp| (|u| |source| |target|) - (PROG (|v2| T$ |Expr| S |dmp| |d| |m|) - (RETURN - (PROGN - (SPADLET |v2| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |Expr| (CAR |source|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| |source| T$)) - ((QUOTE T) - (SPADLET |dmp| - (CONS - (QUOTE |DistributedMultivariatePolynomial|) - (CONS |v2| (CONS T$ NIL)))) - (SPADLET |d| (|Expr2Dmp| |u| |source| |dmp|)) - (COND - ((NULL (SPADLET |m| (|coerceInt| (|objNewWrap| |d| |dmp|) |target|))) - (|coercionFailure|)) - ((QUOTE T) (|objValUnwrap| |m|))))))))) + (PROG (|v2| T$ |Expr| S |dmp| |d| |m|) + (RETURN + (PROGN + (SPADLET |v2| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |Expr| (CAR |source|)) + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| |source| T$)) + ('T + (SPADLET |dmp| + (CONS '|DistributedMultivariatePolynomial| + (CONS |v2| (CONS T$ NIL)))) + (SPADLET |d| (|Expr2Dmp| |u| |source| |dmp|)) + (COND + ((NULL (SPADLET |m| + (|coerceInt| (|objNewWrap| |d| |dmp|) + |target|))) + (|coercionFailure|)) + ('T (|objValUnwrap| |m|))))))))) ;Expr2Up(u,source is [Expr,S], target is [.,var,T]) == ; u = '_$fromCoerceable_$ => canCoerce(source, T) @@ -1493,66 +1669,73 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |Expr2Up| (|u| |source| |target|) - (PROG (|var| T$ |Expr| S |kernelFunc| |kernelDom| |nameFunc| |kernels| |v1| - |varKernel| |univFunc| |sup| |fracUniv| |denom| |numer| |uniType| |z|) - (RETURN - (SEQ - (PROGN - (SPADLET |var| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |Expr| (CAR |source|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| |source| T$)) - ((QUOTE T) - (SPADLET |kernelFunc| - (|getFunctionFromDomain| - (QUOTE |kernels|) - |source| - (CONS |source| NIL))) - (SPADLET |kernelDom| (CONS (QUOTE |Kernel|) (CONS |source| NIL))) - (SPADLET |nameFunc| - (|getFunctionFromDomain| - (QUOTE |name|) - |kernelDom| - (CONS |kernelDom| NIL))) - (SPADLET |kernels| (SPADCALL |u| |kernelFunc|)) - (SPADLET |v1| - (PROG (#0=#:G167357) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G167362 |kernels| (CDR #1#)) (|kernel| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |kernel| (CAR #1#)) NIL)) - (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# (CONS (SPADCALL |kernel| |nameFunc|) #0#)))))))) - (COND - ((NULL (|member| |var| |v1|)) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |varKernel| (ELT |kernels| (POSN1 |var| |v1|))) - (SPADLET |univFunc| - (|getFunctionFromDomain| - (QUOTE |univariate|) - |source| - (CONS |source| (CONS |kernelDom| NIL)))) - (SPADLET |sup| - (CONS (QUOTE |SparseUnivariatePolynomial|) (CONS |source| NIL))) - (SPADLET |fracUniv| (SPADCALL |u| |varKernel| |univFunc|)) - (SPADLET |denom| (CDR |fracUniv|)) - (COND - ((NULL (|equalOne| |denom| |sup|)) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |numer| (CAR |fracUniv|)) - (SPADLET |uniType| - (CONS - (QUOTE |UnivariatePolynomial|) - (CONS |var| (CONS |source| NIL)))) - (COND - ((SPADLET |z| - (|coerceInt| (|objNewWrap| |numer| |uniType|) |target|)) - (|objValUnwrap| |z|)) - ((QUOTE T) (|coercionFailure|)))))))))))))) + (PROG (|var| T$ |Expr| S |kernelFunc| |kernelDom| |nameFunc| + |kernels| |v1| |varKernel| |univFunc| |sup| |fracUniv| + |denom| |numer| |uniType| |z|) + (RETURN + (SEQ (PROGN + (SPADLET |var| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |Expr| (CAR |source|)) + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| |source| T$)) + ('T + (SPADLET |kernelFunc| + (|getFunctionFromDomain| '|kernels| |source| + (CONS |source| NIL))) + (SPADLET |kernelDom| + (CONS '|Kernel| (CONS |source| NIL))) + (SPADLET |nameFunc| + (|getFunctionFromDomain| '|name| |kernelDom| + (CONS |kernelDom| NIL))) + (SPADLET |kernels| (SPADCALL |u| |kernelFunc|)) + (SPADLET |v1| + (PROG (G167357) + (SPADLET G167357 NIL) + (RETURN + (DO ((G167362 |kernels| (CDR G167362)) + (|kernel| NIL)) + ((OR (ATOM G167362) + (PROGN + (SETQ |kernel| (CAR G167362)) + NIL)) + (NREVERSE0 G167357)) + (SEQ (EXIT + (SETQ G167357 + (CONS + (SPADCALL |kernel| |nameFunc|) + G167357)))))))) + (COND + ((NULL (|member| |var| |v1|)) (|coercionFailure|)) + ('T + (SPADLET |varKernel| + (ELT |kernels| (POSN1 |var| |v1|))) + (SPADLET |univFunc| + (|getFunctionFromDomain| '|univariate| + |source| + (CONS |source| (CONS |kernelDom| NIL)))) + (SPADLET |sup| + (CONS '|SparseUnivariatePolynomial| + (CONS |source| NIL))) + (SPADLET |fracUniv| + (SPADCALL |u| |varKernel| |univFunc|)) + (SPADLET |denom| (CDR |fracUniv|)) + (COND + ((NULL (|equalOne| |denom| |sup|)) + (|coercionFailure|)) + ('T (SPADLET |numer| (CAR |fracUniv|)) + (SPADLET |uniType| + (CONS '|UnivariatePolynomial| + (CONS |var| (CONS |source| NIL)))) + (COND + ((SPADLET |z| + (|coerceInt| + (|objNewWrap| |numer| |uniType|) + |target|)) + (|objValUnwrap| |z|)) + ('T (|coercionFailure|)))))))))))))) ;--% Kernels over Expr ;Ker2Ker(u,source is [.,S], target is [.,T]) == @@ -1565,26 +1748,28 @@ all these coercion functions have the following result: ; objValUnwrap m'' (DEFUN |Ker2Ker| (|u| |source| |target|) - (PROG (T$ S |m| |u'| |m'| |u''| |m''|) - (RETURN - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| S T$)) - ((NULL (SPADLET |m| (|coerceInt| (|objNewWrap| |u| |source|) S))) - (|coercionFailure|)) - ((QUOTE T) - (SPADLET |u'| (|objValUnwrap| |m|)) - (COND - ((NULL (SPADLET |m'| (|coerceInt| (|objNewWrap| |u'| S) T$))) - (|coercionFailure|)) - ((QUOTE T) - (SPADLET |u''| (|objValUnwrap| |m'|)) + (PROG (T$ S |m| |u'| |m'| |u''| |m''|) + (RETURN + (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET S (CADR |source|)) (COND - ((NULL (SPADLET |m''| (|coerceInt| (|objNewWrap| |u''| T$) |target|))) - (|coercionFailure|)) - ((QUOTE T) (|objValUnwrap| |m''|))))))))))) + ((BOOT-EQUAL |u| '|$fromCoerceable$|) (|canCoerce| S T$)) + ((NULL (SPADLET |m| + (|coerceInt| (|objNewWrap| |u| |source|) S))) + (|coercionFailure|)) + ('T (SPADLET |u'| (|objValUnwrap| |m|)) + (COND + ((NULL (SPADLET |m'| + (|coerceInt| (|objNewWrap| |u'| S) T$))) + (|coercionFailure|)) + ('T (SPADLET |u''| (|objValUnwrap| |m'|)) + (COND + ((NULL (SPADLET |m''| + (|coerceInt| (|objNewWrap| |u''| T$) + |target|))) + (|coercionFailure|)) + ('T (|objValUnwrap| |m''|))))))))))) ;Ker2Expr(u,source is [.,S], target) == ; u = '_$fromCoerceable_$ => canCoerce(S, target) @@ -1594,20 +1779,25 @@ all these coercion functions have the following result: ; objValUnwrap m' (DEFUN |Ker2Expr| (|u| |source| |target|) - (PROG (S |m| |u'| |m'|) - (RETURN - (PROGN - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| S |target|)) - ((NULL (SPADLET |m| (|coerceByFunction| (|objNewWrap| |u| |source|) S))) - (|coercionFailure|)) - ((QUOTE T) - (SPADLET |u'| (|objValUnwrap| |m|)) - (COND - ((NULL (SPADLET |m'| (|coerceInt| (|objNewWrap| |u'| S) |target|))) - (|coercionFailure|)) - ((QUOTE T) (|objValUnwrap| |m'|))))))))) + (PROG (S |m| |u'| |m'|) + (RETURN + (PROGN + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| S |target|)) + ((NULL (SPADLET |m| + (|coerceByFunction| + (|objNewWrap| |u| |source|) S))) + (|coercionFailure|)) + ('T (SPADLET |u'| (|objValUnwrap| |m|)) + (COND + ((NULL (SPADLET |m'| + (|coerceInt| (|objNewWrap| |u'| S) + |target|))) + (|coercionFailure|)) + ('T (|objValUnwrap| |m'|))))))))) + ;--% Factored objects ;Factored2Factored(u,oldmode,newmode) == ; [.,oldargmode,:.]:= oldmode @@ -1622,38 +1812,44 @@ all these coercion functions have the following result: ; [objValUnwrap(unit'),:factors'] (DEFUN |Factored2Factored| (|u| |oldmode| |newmode|) - (PROG (|oldargmode| |newargmode| |u'| |unit'| |factors| |factors'|) - (RETURN - (SEQ - (PROGN - (SPADLET |oldargmode| (CADR |oldmode|)) - (SPADLET |newargmode| (CADR |newmode|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (|canCoerce| |oldargmode| |newargmode|)) - ((QUOTE T) - (SPADLET |u'| (|unwrap| |u|)) - (SPADLET |unit'| - (|coerceInt| (|objNewWrap| (CAR |u'|) |oldargmode|) |newargmode|)) - (COND - ((NULL |unit'|) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |factors| (KDR |u'|)) - (SPADLET |factors'| - (PROG (#0=#:G167438) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G167443 |factors| (CDR #1#)) (|x| NIL)) - ((OR (ATOM #1#) - (PROGN (SETQ |x| (CAR #1#)) NIL)) - (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS (|coerceFFE| |x| |oldargmode| |newargmode|) #0#)))))))) - (COND - ((|member| (QUOTE |failed|) |factors'|) (|coercionFailure|)) - ((QUOTE T) (CONS (|objValUnwrap| |unit'|) |factors'|)))))))))))) + (PROG (|oldargmode| |newargmode| |u'| |unit'| |factors| |factors'|) + (RETURN + (SEQ (PROGN + (SPADLET |oldargmode| (CADR |oldmode|)) + (SPADLET |newargmode| (CADR |newmode|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| |oldargmode| |newargmode|)) + ('T (SPADLET |u'| (|unwrap| |u|)) + (SPADLET |unit'| + (|coerceInt| + (|objNewWrap| (CAR |u'|) |oldargmode|) + |newargmode|)) + (COND + ((NULL |unit'|) (|coercionFailure|)) + ('T (SPADLET |factors| (KDR |u'|)) + (SPADLET |factors'| + (PROG (G167438) + (SPADLET G167438 NIL) + (RETURN + (DO ((G167443 |factors| + (CDR G167443)) + (|x| NIL)) + ((OR (ATOM G167443) + (PROGN + (SETQ |x| (CAR G167443)) + NIL)) + (NREVERSE0 G167438)) + (SEQ (EXIT + (SETQ G167438 + (CONS + (|coerceFFE| |x| |oldargmode| + |newargmode|) + G167438)))))))) + (COND + ((|member| '|failed| |factors'|) + (|coercionFailure|)) + ('T (CONS (|objValUnwrap| |unit'|) |factors'|)))))))))))) ;coerceFFE(ffe, oldmode, newmode) == ; fac' := coerceInt(objNewWrap(ffe.1,oldmode),newmode) @@ -1661,18 +1857,19 @@ all these coercion functions have the following result: ; LIST2VEC [ffe.0,objValUnwrap(fac'),ffe.2] (DEFUN |coerceFFE| (|ffe| |oldmode| |newmode|) - (PROG (|fac'|) - (RETURN - (PROGN - (SPADLET |fac'| - (|coerceInt| (|objNewWrap| (ELT |ffe| 1) |oldmode|) |newmode|)) - (COND - ((NULL |fac'|) (QUOTE |failed|)) - ((QUOTE T) - (LIST2VEC - (CONS - (ELT |ffe| 0) - (CONS (|objValUnwrap| |fac'|) (CONS (ELT |ffe| 2) NIL)))))))))) + (PROG (|fac'|) + (RETURN + (PROGN + (SPADLET |fac'| + (|coerceInt| (|objNewWrap| (ELT |ffe| 1) |oldmode|) + |newmode|)) + (COND + ((NULL |fac'|) '|failed|) + ('T + (LIST2VEC + (CONS (ELT |ffe| 0) + (CONS (|objValUnwrap| |fac'|) + (CONS (ELT |ffe| 2) NIL)))))))))) ;--% Complex ;Complex2underDomain(u,[.,S],target) == @@ -1684,23 +1881,21 @@ all these coercion functions have the following result: ; r' ; coercionFailure() -(DEFUN |Complex2underDomain| (|u| #0=#:G167474 |target|) - (PROG (S |r| |i| |LETTMP#1| |r'|) - (RETURN - (PROGN - (SPADLET S (CADR #0#)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) NIL) - ((QUOTE T) - (SPADLET |r| (CAR |u|)) - (SPADLET |i| (CDR |u|)) - (COND - ((BOOT-EQUAL |i| (|domainZero| S)) - (SPADLET |LETTMP#1| - (OR (|coerceInt| (|objNewWrap| |r| S) |target|) (|coercionFailure|))) - (SPADLET |r'| (CAR |LETTMP#1|)) - |r'|) - ((QUOTE T) (|coercionFailure|))))))))) +(DEFUN |Complex2underDomain| (|u| G167474 |target|) + (PROG (S |r| |i| |LETTMP#1| |r'|) + (RETURN + (PROGN + (SPADLET S (CADR G167474)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) NIL) + ('T (SPADLET |r| (CAR |u|)) (SPADLET |i| (CDR |u|)) + (COND + ((BOOT-EQUAL |i| (|domainZero| S)) + (SPADLET |LETTMP#1| + (OR (|coerceInt| (|objNewWrap| |r| S) |target|) + (|coercionFailure|))) + (SPADLET |r'| (CAR |LETTMP#1|)) |r'|) + ('T (|coercionFailure|))))))))) ;Complex2FR(u,S is [.,R],target is [.,T]) == ; u = '_$fromCoerceable_$ => @@ -1715,30 +1910,29 @@ all these coercion functions have the following result: ; SPADCALL(u,factor) (DEFUN |Complex2FR| (|u| S |target|) - (PROG (T$ R |package| |factor|) - (RETURN - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET R (CADR S)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (COND - ((NEQUAL S T$) NIL) - ((BOOT-EQUAL R |$Integer|) (QUOTE T)) - ((QUOTE T) NIL))) - ((NEQUAL S T$) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |package| - (COND - ((BOOT-EQUAL R |$Integer|) - (CONS (QUOTE |GaussianFactorizationPackage|) NIL)) - ((QUOTE T) (|coercionFailure|)))) - (SPADLET |factor| - (|getFunctionFromDomain| - (QUOTE |factor|) - |package| - (CONS S NIL))) - (SPADCALL |u| |factor|))))))) + (PROG (T$ R |package| |factor|) + (DECLARE (SPECIAL |$Integer|)) + (RETURN + (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET R (CADR S)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (COND + ((NEQUAL S T$) NIL) + ((BOOT-EQUAL R |$Integer|) 'T) + ('T NIL))) + ((NEQUAL S T$) (|coercionFailure|)) + ('T + (SPADLET |package| + (COND + ((BOOT-EQUAL R |$Integer|) + (CONS '|GaussianFactorizationPackage| NIL)) + ('T (|coercionFailure|)))) + (SPADLET |factor| + (|getFunctionFromDomain| '|factor| |package| + (CONS S NIL))) + (SPADCALL |u| |factor|))))))) ;Complex2Expr(u, source is [.,S], target is [., T]) == ; u = '_$fromCoerceable_$ => @@ -1766,63 +1960,70 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |Complex2Expr| (|u| |source| |target|) - (PROG (T$ S |ISTMP#1| T1 E |negOne| |sqrtFun| |i| |realFun| |imagFun| |real| - |imag| |realExp| |imagExp| |timesFun| |plusFun| |newVal| - |newObj| |finalObj|) - (RETURN - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (OR - (AND (PAIRP T$) - (EQ (QCAR T$) (QUOTE |Complex|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR T$)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET T1 (QCAR |ISTMP#1|)) (QUOTE T)))) - (|canCoerceFrom| S T1)) - (|coercionFailure|))) - ((QUOTE T) - (SPADLET E (|defaultTargetFE| |source|)) - (SPADLET |negOne| - (|coerceInt| (|objNewWrap| (SPADDIFFERENCE 1) |$Integer|) E)) - (COND - ((NULL |negOne|) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |sqrtFun| - (|getFunctionFromDomain| (QUOTE |sqrt|) E (CONS E NIL))) - (SPADLET |i| (SPADCALL (|objValUnwrap| |negOne|) |sqrtFun|)) - (SPADLET |realFun| - (|getFunctionFromDomain| (QUOTE |real|) |source| (CONS |source| NIL))) - (SPADLET |imagFun| - (|getFunctionFromDomain| (QUOTE |imag|) |source| (CONS |source| NIL))) - (SPADLET |real| (SPADCALL |u| |realFun|)) - (SPADLET |imag| (SPADCALL |u| |imagFun|)) - (SPADLET |realExp| (|coerceInt| (|objNewWrap| |real| S) E)) + (PROG (T$ S |ISTMP#1| T1 E |negOne| |sqrtFun| |i| |realFun| |imagFun| + |real| |imag| |realExp| |imagExp| |timesFun| |plusFun| + |newVal| |newObj| |finalObj|) + (DECLARE (SPECIAL |$Integer|)) + (RETURN + (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET S (CADR |source|)) (COND - ((NULL |realExp|) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |imagExp| (|coerceInt| (|objNewWrap| |imag| S) E)) - (COND - ((NULL |imagExp|) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |timesFun| - (|getFunctionFromDomain| (QUOTE *) E (CONS E (CONS E NIL)))) - (SPADLET |plusFun| - (|getFunctionFromDomain| (QUOTE +) E (CONS E (CONS E NIL)))) - (SPADLET |newVal| - (SPADCALL - (|objValUnwrap| |realExp|) - (SPADCALL |i| (|objValUnwrap| |imagExp|) |timesFun|) |plusFun|)) - (SPADLET |newObj| (|objNewWrap| |newVal| E)) - (SPADLET |finalObj| (|coerceInt| |newObj| |target|)) - (COND - (|finalObj| (|objValUnwrap| |finalObj|)) - ((QUOTE T) (|coercionFailure|))))))))))))))) + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (OR (AND (PAIRP T$) (EQ (QCAR T$) '|Complex|) + (PROGN + (SPADLET |ISTMP#1| (QCDR T$)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET T1 (QCAR |ISTMP#1|)) 'T))) + (|canCoerceFrom| S T1)) + (|coercionFailure|))) + ('T (SPADLET E (|defaultTargetFE| |source|)) + (SPADLET |negOne| + (|coerceInt| + (|objNewWrap| (SPADDIFFERENCE 1) |$Integer|) E)) + (COND + ((NULL |negOne|) (|coercionFailure|)) + ('T + (SPADLET |sqrtFun| + (|getFunctionFromDomain| '|sqrt| E (CONS E NIL))) + (SPADLET |i| + (SPADCALL (|objValUnwrap| |negOne|) |sqrtFun|)) + (SPADLET |realFun| + (|getFunctionFromDomain| '|real| |source| + (CONS |source| NIL))) + (SPADLET |imagFun| + (|getFunctionFromDomain| '|imag| |source| + (CONS |source| NIL))) + (SPADLET |real| (SPADCALL |u| |realFun|)) + (SPADLET |imag| (SPADCALL |u| |imagFun|)) + (SPADLET |realExp| + (|coerceInt| (|objNewWrap| |real| S) E)) + (COND + ((NULL |realExp|) (|coercionFailure|)) + ('T + (SPADLET |imagExp| + (|coerceInt| (|objNewWrap| |imag| S) E)) + (COND + ((NULL |imagExp|) (|coercionFailure|)) + ('T + (SPADLET |timesFun| + (|getFunctionFromDomain| '* E + (CONS E (CONS E NIL)))) + (SPADLET |plusFun| + (|getFunctionFromDomain| '+ E + (CONS E (CONS E NIL)))) + (SPADLET |newVal| + (SPADCALL (|objValUnwrap| |realExp|) + (SPADCALL |i| + (|objValUnwrap| |imagExp|) + |timesFun|) + |plusFun|)) + (SPADLET |newObj| (|objNewWrap| |newVal| E)) + (SPADLET |finalObj| + (|coerceInt| |newObj| |target|)) + (COND + (|finalObj| (|objValUnwrap| |finalObj|)) + ('T (|coercionFailure|))))))))))))))) ;--% Integer ;I2EI(n,source,target) == @@ -1830,40 +2031,44 @@ all these coercion functions have the following result: ; if not ODDP(n) then n else coercionFailure() (DEFUN I2EI (|n| |source| |target|) - (COND - ((BOOT-EQUAL |n| (QUOTE |$fromCoerceable$|)) NIL) - ((NULL (ODDP |n|)) |n|) - ((QUOTE T) (|coercionFailure|)))) + (DECLARE (IGNORE |source| |target|)) + (COND + ((BOOT-EQUAL |n| '|$fromCoerceable$|) NIL) + ((NULL (ODDP |n|)) |n|) + ('T (|coercionFailure|)))) ;I2OI(n,source,target) == ; n = '_$fromCoerceable_$ => nil ; if ODDP(n) then n else coercionFailure() (DEFUN I2OI (|n| |source| |target|) - (COND - ((BOOT-EQUAL |n| (QUOTE |$fromCoerceable$|)) NIL) - ((ODDP |n|) |n|) - ((QUOTE T) (|coercionFailure|)))) + (DECLARE (IGNORE |source| |target|)) + (COND + ((BOOT-EQUAL |n| '|$fromCoerceable$|) NIL) + ((ODDP |n|) |n|) + ('T (|coercionFailure|)))) ;I2PI(n,source,target) == ; n = '_$fromCoerceable_$ => nil ; if n > 0 then n else coercionFailure() (DEFUN I2PI (|n| |source| |target|) - (COND - ((BOOT-EQUAL |n| (QUOTE |$fromCoerceable$|)) NIL) - ((> |n| 0) |n|) - ((QUOTE T) (|coercionFailure|)))) + (DECLARE (IGNORE |source| |target|)) + (COND + ((BOOT-EQUAL |n| '|$fromCoerceable$|) NIL) + ((> |n| 0) |n|) + ('T (|coercionFailure|)))) ;I2NNI(n,source,target) == ; n = '_$fromCoerceable_$ => nil ; if n >= 0 then n else coercionFailure() (DEFUN I2NNI (|n| |source| |target|) - (COND - ((BOOT-EQUAL |n| (QUOTE |$fromCoerceable$|)) NIL) - ((>= |n| 0) |n|) - ((QUOTE T) (|coercionFailure|)))) + (DECLARE (IGNORE |source| |target|)) + (COND + ((BOOT-EQUAL |n| '|$fromCoerceable$|) NIL) + ((>= |n| 0) |n|) + ('T (|coercionFailure|)))) ;--% List ;L2Tuple(val, source is [.,S], target is [.,T]) == @@ -1873,20 +2078,18 @@ all these coercion functions have the following result: ; asTupleNew0 objValUnwrap object (DEFUN |L2Tuple| (|val| |source| |target|) - (PROG (T$ S |object|) - (RETURN - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |val| (QUOTE |$fromCoerceable$|)) (|canCoerce| S T$)) - ((NULL - (SPADLET |object| - (|coerceInt1| - (|mkObjWrap| |val| |source|) - (CONS (QUOTE |List|) (CONS T$ NIL))))) - (|coercionFailure|)) - ((QUOTE T) (|asTupleNew0| (|objValUnwrap| |object|)))))))) + (PROG (T$ S |object|) + (RETURN + (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |val| '|$fromCoerceable$|) (|canCoerce| S T$)) + ((NULL (SPADLET |object| + (|coerceInt1| (|mkObjWrap| |val| |source|) + (CONS '|List| (CONS T$ NIL))))) + (|coercionFailure|)) + ('T (|asTupleNew0| (|objValUnwrap| |object|)))))))) ;L2DP(l, source is [.,S], target is [.,n,T]) == ; -- need to know size of the list @@ -1897,26 +2100,24 @@ all these coercion functions have the following result: ; V2DP(objValUnwrap v, ['Vector, T], target) (DEFUN L2DP (|l| |source| |target|) - (PROG (|n| T$ S |v|) - (RETURN - (PROGN - (SPADLET |n| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |l| (QUOTE |$fromCoerceable$|)) NIL) - ((NEQUAL |n| (SIZE |l|)) (|coercionFailure|)) - ((QUOTE T) - (OR - (SPADLET |v| - (|coerceInt| - (|objNewWrap| (LIST2VEC |l|) (CONS (QUOTE |Vector|) (CONS S NIL))) - (CONS (QUOTE |Vector|) (CONS T$ NIL)))) - (|coercionFailure|)) - (V2DP - (|objValUnwrap| |v|) - (CONS (QUOTE |Vector|) (CONS T$ NIL)) - |target|))))))) + (PROG (|n| T$ S |v|) + (RETURN + (PROGN + (SPADLET |n| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |l| '|$fromCoerceable$|) NIL) + ((NEQUAL |n| (SIZE |l|)) (|coercionFailure|)) + ('T + (OR (SPADLET |v| + (|coerceInt| + (|objNewWrap| (LIST2VEC |l|) + (CONS '|Vector| (CONS S NIL))) + (CONS '|Vector| (CONS T$ NIL)))) + (|coercionFailure|)) + (V2DP (|objValUnwrap| |v|) (CONS '|Vector| (CONS T$ NIL)) + |target|))))))) ;V2DP(v, source is [.,S], target is [.,n,T]) == ; -- need to know size of the vector @@ -1928,28 +2129,24 @@ all these coercion functions have the following result: ; SPADCALL(objValUnwrap v1, dpFun) (DEFUN V2DP (|v| |source| |target|) - (PROG (|n| T$ S |v1| |dpFun|) - (RETURN - (PROGN - (SPADLET |n| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |v| (QUOTE |$fromCoerceable$|)) NIL) - ((NEQUAL |n| (SIZE |v|)) (|coercionFailure|)) - ((QUOTE T) - (OR - (SPADLET |v1| - (|coerceInt| - (|objNewWrap| |v| |source|) - (CONS (QUOTE |Vector|) (CONS T$ NIL)))) - (|coercionFailure|)) - (SPADLET |dpFun| - (|getFunctionFromDomain| - (QUOTE |directProduct|) - |target| - (CONS (CONS (QUOTE |Vector|) (CONS T$ NIL)) NIL))) - (SPADCALL (|objValUnwrap| |v1|) |dpFun|))))))) + (PROG (|n| T$ S |v1| |dpFun|) + (RETURN + (PROGN + (SPADLET |n| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |v| '|$fromCoerceable$|) NIL) + ((NEQUAL |n| (SIZE |v|)) (|coercionFailure|)) + ('T + (OR (SPADLET |v1| + (|coerceInt| (|objNewWrap| |v| |source|) + (CONS '|Vector| (CONS T$ NIL)))) + (|coercionFailure|)) + (SPADLET |dpFun| + (|getFunctionFromDomain| '|directProduct| |target| + (CONS (CONS '|Vector| (CONS T$ NIL)) NIL))) + (SPADCALL (|objValUnwrap| |v1|) |dpFun|))))))) ;L2V(l, source is [.,S], target is [.,T]) == ; l = '_$fromCoerceable_$ => canCoerce(S,T) @@ -1958,21 +2155,21 @@ all these coercion functions have the following result: ; objValUnwrap(v) (DEFUN L2V (|l| |source| |target|) - (PROG (T$ S |v|) - (RETURN - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |l| (QUOTE |$fromCoerceable$|)) (|canCoerce| S T$)) - ((QUOTE T) - (OR - (SPADLET |v| - (|coerceInt| - (|objNewWrap| (LIST2VEC |l|) (CONS (QUOTE |Vector|) (CONS S NIL))) - |target|)) - (|coercionFailure|)) - (|objValUnwrap| |v|))))))) + (PROG (T$ S |v|) + (RETURN + (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |l| '|$fromCoerceable$|) (|canCoerce| S T$)) + ('T + (OR (SPADLET |v| + (|coerceInt| + (|objNewWrap| (LIST2VEC |l|) + (CONS '|Vector| (CONS S NIL))) + |target|)) + (|coercionFailure|)) + (|objValUnwrap| |v|))))))) ;V2L(v, source is [.,S], target is [.,T]) == ; v = '_$fromCoerceable_$ => canCoerce(S,T) @@ -1981,23 +2178,21 @@ all these coercion functions have the following result: ; objValUnwrap(l) (DEFUN V2L (|v| |source| |target|) - (PROG (T$ S |l|) - (RETURN - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |v| (QUOTE |$fromCoerceable$|)) (|canCoerce| S T$)) - ((QUOTE T) - (OR - (SPADLET |l| - (|coerceInt| - (|objNewWrap| - (VEC2LIST |v|) - (CONS (QUOTE |List|) (CONS S NIL))) - |target|)) - (|coercionFailure|)) - (|objValUnwrap| |l|))))))) + (PROG (T$ S |l|) + (RETURN + (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |v| '|$fromCoerceable$|) (|canCoerce| S T$)) + ('T + (OR (SPADLET |l| + (|coerceInt| + (|objNewWrap| (VEC2LIST |v|) + (CONS '|List| (CONS S NIL))) + |target|)) + (|coercionFailure|)) + (|objValUnwrap| |l|))))))) ;L2M(u,[.,D],[.,R]) == ; u = '_$fromCoerceable_$ => nil @@ -2012,42 +2207,50 @@ all these coercion functions have the following result: ; LIST2VEC reverse u' ; coercionFailure() -(DEFUN L2M (|u| #0=#:G167711 #1=#:G167722) - (PROG (R D |ISTMP#1| E |y'| |x'| |u'|) - (RETURN - (SEQ - (PROGN - (SPADLET R (CADR #1#)) - (SPADLET D (CADR #0#)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) NIL) - ((AND (PAIRP D) - (EQ (QCAR D) (QUOTE |List|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR D)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET E (QCAR |ISTMP#1|)) (QUOTE T)))) - (|isRectangularList| |u| (|#| |u|) (|#| (CAR |u|)))) - (SPADLET |u'| NIL) - (DO ((#2=#:G167744 |u| (CDR #2#)) (|x| NIL)) - ((OR (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |x'| NIL) - (DO ((#3=#:G167755 |x| (CDR #3#)) (|y| NIL)) - ((OR (ATOM #3#) (PROGN (SETQ |y| (CAR #3#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (OR - (SPADLET |y'| (|coerceInt| (|objNewWrap| |y| E) R)) - (|coercionFailure|)) - (SPADLET |x'| (CONS (|objValUnwrap| |y'|) |x'|)))))) - (SPADLET |u'| (CONS (LIST2VEC (REVERSE |x'|)) |u'|)))))) - (LIST2VEC (REVERSE |u'|))) - ((QUOTE T) (|coercionFailure|)))))))) +(DEFUN L2M (|u| G167711 G167722) + (PROG (R D |ISTMP#1| E |y'| |x'| |u'|) + (RETURN + (SEQ (PROGN + (SPADLET R (CADR G167722)) + (SPADLET D (CADR G167711)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) NIL) + ((AND (PAIRP D) (EQ (QCAR D) '|List|) + (PROGN + (SPADLET |ISTMP#1| (QCDR D)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET E (QCAR |ISTMP#1|)) 'T))) + (|isRectangularList| |u| (|#| |u|) + (|#| (CAR |u|)))) + (SPADLET |u'| NIL) + (DO ((G167744 |u| (CDR G167744)) (|x| NIL)) + ((OR (ATOM G167744) + (PROGN (SETQ |x| (CAR G167744)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |x'| NIL) + (DO ((G167755 |x| (CDR G167755)) + (|y| NIL)) + ((OR (ATOM G167755) + (PROGN + (SETQ |y| (CAR G167755)) + NIL)) + NIL) + (SEQ (EXIT + (PROGN + (OR + (SPADLET |y'| + (|coerceInt| + (|objNewWrap| |y| E) R)) + (|coercionFailure|)) + (SPADLET |x'| + (CONS (|objValUnwrap| |y'|) + |x'|)))))) + (SPADLET |u'| + (CONS (LIST2VEC (REVERSE |x'|)) + |u'|)))))) + (LIST2VEC (REVERSE |u'|))) + ('T (|coercionFailure|)))))))) ;L2Record(l,[.,D],[.,:al]) == ; l = '_$fromCoerceable_$ => nil @@ -2060,46 +2263,55 @@ all these coercion functions have the following result: ; LIST2VEC v ; coercionFailure() -(DEFUN |L2Record| (|l| #0=#:G167782 #1=#:G167791) - (PROG (|al| D |D'| T$ |v|) - (RETURN - (SEQ - (PROGN - (SPADLET |al| (CDR #1#)) - (SPADLET D (CADR #0#)) - (COND - ((BOOT-EQUAL |l| (QUOTE |$fromCoerceable$|)) NIL) - ((BOOT-EQUAL (|#| |l|) (|#| |al|)) - (SPADLET |v| - (PROG (#2=#:G167811) - (SPADLET #2# NIL) - (RETURN - (DO ((#3=#:G167820 |l| (CDR #3#)) - (|x| NIL) - (#4=#:G167821 |al| (CDR #4#)) - (#5=#:G167774 NIL)) - ((OR (ATOM #3#) - (PROGN (SETQ |x| (CAR #3#)) NIL) - (ATOM #4#) - (PROGN (SETQ #5# (CAR #4#)) NIL) - (PROGN (PROGN (SPADLET |D'| (CADDR #5#)) #5#) NIL)) - (NREVERSE0 #2#)) - (SEQ - (EXIT - (SETQ #2# - (CONS - (PROGN - (SPADLET T$ - (OR - (|coerceInt| (|objNewWrap| |x| D) |D'|) - (RETURN (QUOTE |failed|)))) - (|objValUnwrap| T$)) - #2#)))))))) - (COND - ((BOOT-EQUAL |v| (QUOTE |failed|)) (|coercionFailure|)) - ((EQL (|#| |v|) 2) (CONS (ELT |v| 0) (ELT |v| 1))) - ((QUOTE T) (LIST2VEC |v|)))) - ((QUOTE T) (|coercionFailure|)))))))) +(DEFUN |L2Record| (|l| G167782 G167791) + (PROG (|al| D |D'| T$ |v|) + (RETURN + (SEQ (PROGN + (SPADLET |al| (CDR G167791)) + (SPADLET D (CADR G167782)) + (COND + ((BOOT-EQUAL |l| '|$fromCoerceable$|) NIL) + ((BOOT-EQUAL (|#| |l|) (|#| |al|)) + (SPADLET |v| + (PROG (G167811) + (SPADLET G167811 NIL) + (RETURN + (DO ((G167820 |l| (CDR G167820)) + (|x| NIL) + (G167821 |al| (CDR G167821)) + (G167774 NIL)) + ((OR (ATOM G167820) + (PROGN + (SETQ |x| (CAR G167820)) + NIL) + (ATOM G167821) + (PROGN + (SETQ G167774 + (CAR G167821)) + NIL) + (PROGN + (PROGN + (SPADLET |D'| + (CADDR G167774)) + G167774) + NIL)) + (NREVERSE0 G167811)) + (SEQ (EXIT + (SETQ G167811 + (CONS + (PROGN + (SPADLET T$ + (OR + (|coerceInt| + (|objNewWrap| |x| D) |D'|) + (RETURN '|failed|))) + (|objValUnwrap| T$)) + G167811)))))))) + (COND + ((BOOT-EQUAL |v| '|failed|) (|coercionFailure|)) + ((EQL (|#| |v|) 2) (CONS (ELT |v| 0) (ELT |v| 1))) + ('T (LIST2VEC |v|)))) + ('T (|coercionFailure|)))))))) ;L2Rm(u,source is [.,D],target is [.,n,m,R]) == ; u = '_$fromCoerceable_$ => nil @@ -2108,25 +2320,23 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |L2Rm| (|u| |source| |target|) - (PROG (|n| |m| R D |ISTMP#1| E) - (RETURN - (PROGN - (SPADLET |n| (CADR |target|)) - (SPADLET |m| (CADDR |target|)) - (SPADLET R (CADDDR |target|)) - (SPADLET D (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) NIL) - ((AND (PAIRP D) - (EQ (QCAR D) (QUOTE |List|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR D)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET E (QCAR |ISTMP#1|)) (QUOTE T)))) - (|isRectangularList| |u| |n| |m|)) - (L2M |u| |source| (CONS (QUOTE |Matrix|) (CONS R NIL)))) - ((QUOTE T) (|coercionFailure|))))))) + (PROG (|n| |m| R D |ISTMP#1| E) + (RETURN + (PROGN + (SPADLET |n| (CADR |target|)) + (SPADLET |m| (CADDR |target|)) + (SPADLET R (CADDDR |target|)) + (SPADLET D (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) NIL) + ((AND (PAIRP D) (EQ (QCAR D) '|List|) + (PROGN + (SPADLET |ISTMP#1| (QCDR D)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET E (QCAR |ISTMP#1|)) 'T))) + (|isRectangularList| |u| |n| |m|)) + (L2M |u| |source| (CONS '|Matrix| (CONS R NIL)))) + ('T (|coercionFailure|))))))) ;L2Sm(u,source is [.,D],[.,n,R]) == ; u = '_$fromCoerceable_$ => nil @@ -2134,26 +2344,23 @@ all these coercion functions have the following result: ; L2M(u,source,['Matrix,R]) ; coercionFailure() -(DEFUN |L2Sm| (|u| |source| #0=#:G167896) - (PROG (|n| R D |ISTMP#1| E) - (RETURN - (PROGN - (SPADLET |n| (CADR #0#)) - (SPADLET R (CADDR #0#)) - (SPADLET D (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) NIL) - ((AND (PAIRP D) - (EQ (QCAR D) (QUOTE |List|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR D)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET E (QCAR |ISTMP#1|)) (QUOTE T)))) - (|isRectangularList| |u| |n| |n|)) - (L2M |u| |source| (CONS (QUOTE |Matrix|) (CONS R NIL)))) - ((QUOTE T) (|coercionFailure|))))))) +(DEFUN |L2Sm| (|u| |source| G167896) + (PROG (|n| R D |ISTMP#1| E) + (RETURN + (PROGN + (SPADLET |n| (CADR G167896)) + (SPADLET R (CADDR G167896)) + (SPADLET D (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) NIL) + ((AND (PAIRP D) (EQ (QCAR D) '|List|) + (PROGN + (SPADLET |ISTMP#1| (QCDR D)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET E (QCAR |ISTMP#1|)) 'T))) + (|isRectangularList| |u| |n| |n|)) + (L2M |u| |source| (CONS '|Matrix| (CONS R NIL)))) + ('T (|coercionFailure|))))))) ;L2Set(x,source is [.,S],target is [.,T]) == ; x = '_$fromCoerceable_$ => canCoerce(S,T) @@ -2166,22 +2373,24 @@ all these coercion functions have the following result: ; objValUnwrap u (DEFUN |L2Set| (|x| |source| |target|) - (PROG (T$ S |target'| |u|) - (RETURN - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |x| (QUOTE |$fromCoerceable$|)) (|canCoerce| S T$)) - ((QUOTE T) - (SPADLET |target'| (CONS (QUOTE |Set|) (CONS S NIL))) - (SPADLET |u| - (|objNewWrap| - (SPADCALL |x| - (|getFunctionFromDomain| '|brace| |target'| (CONS |source| NIL))) - |target'|)) - (OR (SPADLET |u| (|coerceInt| |u| |target|)) (|coercionFailure|)) - (|objValUnwrap| |u|))))))) + (PROG (T$ S |target'| |u|) + (RETURN + (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |x| '|$fromCoerceable$|) (|canCoerce| S T$)) + ('T (SPADLET |target'| (CONS '|Set| (CONS S NIL))) + (SPADLET |u| + (|objNewWrap| + (SPADCALL |x| + (|getFunctionFromDomain| '|brace| |target'| + (CONS |source| NIL))) + |target'|)) + (OR (SPADLET |u| (|coerceInt| |u| |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u|))))))) + ;Set2L(x,source is [.,S],target is [.,T]) == ; x = '_$fromCoerceable_$ => canCoerce(S,T) @@ -2193,21 +2402,23 @@ all these coercion functions have the following result: ; objValUnwrap u (DEFUN |Set2L| (|x| |source| |target|) - (PROG (T$ S |u|) - (RETURN - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |x| (QUOTE |$fromCoerceable$|)) (|canCoerce| S T$)) - ((QUOTE T) - (SPADLET |u| - (|objNewWrap| - (SPADCALL |x| - (|getFunctionFromDomain| '|destruct| |source| (CONS |source| NIL))) - (CONS (QUOTE |List|) (CONS S NIL)))) - (OR (SPADLET |u| (|coerceInt| |u| |target|)) (|coercionFailure|)) - (|objValUnwrap| |u|))))))) + (PROG (T$ S |u|) + (RETURN + (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |x| '|$fromCoerceable$|) (|canCoerce| S T$)) + ('T + (SPADLET |u| + (|objNewWrap| + (SPADCALL |x| + (|getFunctionFromDomain| '|destruct| + |source| (CONS |source| NIL))) + (CONS '|List| (CONS S NIL)))) + (OR (SPADLET |u| (|coerceInt| |u| |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u|))))))) ;Agg2Agg(x,source is [agg1,S],target is [.,T]) == ; x = '_$fromCoerceable_$ => canCoerce(S,T) @@ -2218,24 +2429,23 @@ all these coercion functions have the following result: ; objValUnwrap u (DEFUN |Agg2Agg| (|x| |source| |target|) - (PROG (T$ |agg1| S |target'| |u|) - (RETURN - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET |agg1| (CAR |source|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |x| (QUOTE |$fromCoerceable$|)) (|canCoerce| S T$)) - ((BOOT-EQUAL S T$) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |target'| (CONS |agg1| (CONS T$ NIL))) - (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |x| |source|) |target'|)) - (|coercionFailure|)) - (OR - (SPADLET |u| (|coerceInt| |u| |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u|))))))) + (PROG (T$ |agg1| S |target'| |u|) + (RETURN + (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET |agg1| (CAR |source|)) + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |x| '|$fromCoerceable$|) (|canCoerce| S T$)) + ((BOOT-EQUAL S T$) (|coercionFailure|)) + ('T (SPADLET |target'| (CONS |agg1| (CONS T$ NIL))) + (OR (SPADLET |u| + (|coerceInt| (|objNewWrap| |x| |source|) + |target'|)) + (|coercionFailure|)) + (OR (SPADLET |u| (|coerceInt| |u| |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u|))))))) ;Agg2L2Agg(x,source is [.,S],target) == ; -- tries to use list as an intermediate type @@ -2247,24 +2457,22 @@ all these coercion functions have the following result: ; objValUnwrap u (DEFUN |Agg2L2Agg| (|x| |source| |target|) - (PROG (S |mid| |u|) - (RETURN - (PROGN - (SPADLET S (CADR |source|)) - (SPADLET |mid| (CONS (QUOTE |List|) (CONS S NIL))) - (COND - ((BOOT-EQUAL |x| (QUOTE |$fromCoerceable$|)) - (AND - (|canCoerce| |source| |mid|) - (|canCoerce| |mid| |target|))) - ((QUOTE T) - (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |x| |source|) |mid|)) - (|coercionFailure|)) - (OR - (SPADLET |u| (|coerceInt| |u| |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u|))))))) + (PROG (S |mid| |u|) + (RETURN + (PROGN + (SPADLET S (CADR |source|)) + (SPADLET |mid| (CONS '|List| (CONS S NIL))) + (COND + ((BOOT-EQUAL |x| '|$fromCoerceable$|) + (AND (|canCoerce| |source| |mid|) + (|canCoerce| |mid| |target|))) + ('T + (OR (SPADLET |u| + (|coerceInt| (|objNewWrap| |x| |source|) |mid|)) + (|coercionFailure|)) + (OR (SPADLET |u| (|coerceInt| |u| |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u|))))))) ;isRectangularList(x,p,q) == ; p=0 or p=#x => @@ -2272,24 +2480,29 @@ all these coercion functions have the following result: ; and/[n=#y for y in rest x] => p=0 or q=n (DEFUN |isRectangularList| (|x| |p| |q|) - (PROG (|n|) - (RETURN - (SEQ - (COND - ((OR (EQL |p| 0) (BOOT-EQUAL |p| (|#| |x|))) - (EXIT - (PROGN - (SPADLET |n| (|#| (CAR |x|))) - (COND - ((PROG (#0=#:G168010) - (SPADLET #0# (QUOTE T)) - (RETURN - (DO ((#1=#:G168016 NIL (NULL #0#)) - (#2=#:G168017 (CDR |x|) (CDR #2#)) - (|y| NIL)) - ((OR #1# (ATOM #2#) (PROGN (SETQ |y| (CAR #2#)) NIL)) #0#) - (SEQ (EXIT (SETQ #0# (AND #0# (BOOT-EQUAL |n| (|#| |y|))))))))) - (OR (EQL |p| 0) (BOOT-EQUAL |q| |n|)))))))))))) + (PROG (|n|) + (RETURN + (SEQ (COND + ((OR (EQL |p| 0) (BOOT-EQUAL |p| (|#| |x|))) + (EXIT (PROGN + (SPADLET |n| (|#| (CAR |x|))) + (COND + ((PROG (G168010) + (SPADLET G168010 'T) + (RETURN + (DO ((G168016 NIL (NULL G168010)) + (G168017 (CDR |x|) (CDR G168017)) + (|y| NIL)) + ((OR G168016 (ATOM G168017) + (PROGN + (SETQ |y| (CAR G168017)) + NIL)) + G168010) + (SEQ (EXIT + (SETQ G168010 + (AND G168010 + (BOOT-EQUAL |n| (|#| |y|))))))))) + (OR (EQL |p| 0) (BOOT-EQUAL |q| |n|)))))))))))) ;--% Matrix ;M2L(x,[.,S],target) == @@ -2298,20 +2511,22 @@ all these coercion functions have the following result: ; (u := coerceInt(objNewWrap(x,mid),target)) or coercionFailure() ; objValUnwrap u -(DEFUN M2L (|x| #0=#:G168030 |target|) - (PROG (S |mid| |u|) - (RETURN - (PROGN - (SPADLET S (CADR #0#)) - (SPADLET |mid| - (CONS (QUOTE |Vector|) (CONS (CONS (QUOTE |Vector|) (CONS S NIL)) NIL))) - (COND - ((BOOT-EQUAL |x| (QUOTE |$fromCoerceable$|)) (|canCoerce| |mid| |target|)) - ((QUOTE T) - (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |x| |mid|) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u|))))))) +(DEFUN M2L (|x| G168030 |target|) + (PROG (S |mid| |u|) + (RETURN + (PROGN + (SPADLET S (CADR G168030)) + (SPADLET |mid| + (CONS '|Vector| + (CONS (CONS '|Vector| (CONS S NIL)) NIL))) + (COND + ((BOOT-EQUAL |x| '|$fromCoerceable$|) + (|canCoerce| |mid| |target|)) + ('T + (OR (SPADLET |u| + (|coerceInt| (|objNewWrap| |x| |mid|) |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u|))))))) ;M2M(x,[.,R],[.,S]) == ; x = '_$fromCoerceable_$ => canCoerce(R,S) @@ -2327,37 +2542,40 @@ all these coercion functions have the following result: ; v := [LIST2VEC reverse u,:v] ; LIST2VEC reverse v -(DEFUN M2M (|x| #0=#:G168046 #1=#:G168053) - (PROG (S R |n| |m| |y| |y'| |u| |v|) - (RETURN - (SEQ - (PROGN - (SPADLET S (CADR #1#)) - (SPADLET R (CADR #0#)) - (COND - ((BOOT-EQUAL |x| (QUOTE |$fromCoerceable$|)) (|canCoerce| R S)) - ((QUOTE T) - (SPADLET |n| (|#| |x|)) - (SPADLET |m| (|#| (ELT |x| 0))) - (SPADLET |v| NIL) - (DO ((#2=#:G168072 (SPADDIFFERENCE |n| 1)) (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| #2#) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |u| NIL) - (DO ((#3=#:G168082 (SPADDIFFERENCE |m| 1)) (|j| 0 (QSADD1 |j|))) - ((QSGREATERP |j| #3#) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |y| (ELT (ELT |x| |i|) |j|)) - (OR - (SPADLET |y'| (|coerceInt| (|objNewWrap| |y| R) S)) - (|coercionFailure|)) - (SPADLET |u| (CONS (|objValUnwrap| |y'|) |u|)))))) - (SPADLET |v| (CONS (LIST2VEC (REVERSE |u|)) |v|)))))) - (LIST2VEC (REVERSE |v|))))))))) +(DEFUN M2M (|x| G168046 G168053) + (PROG (S R |n| |m| |y| |y'| |u| |v|) + (RETURN + (SEQ (PROGN + (SPADLET S (CADR G168053)) + (SPADLET R (CADR G168046)) + (COND + ((BOOT-EQUAL |x| '|$fromCoerceable$|) (|canCoerce| R S)) + ('T (SPADLET |n| (|#| |x|)) + (SPADLET |m| (|#| (ELT |x| 0))) (SPADLET |v| NIL) + (DO ((G168072 (SPADDIFFERENCE |n| 1)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G168072) NIL) + (SEQ (EXIT (PROGN + (SPADLET |u| NIL) + (DO ((G168082 (SPADDIFFERENCE |m| 1)) + (|j| 0 (QSADD1 |j|))) + ((QSGREATERP |j| G168082) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |y| + (ELT (ELT |x| |i|) |j|)) + (OR + (SPADLET |y'| + (|coerceInt| + (|objNewWrap| |y| R) S)) + (|coercionFailure|)) + (SPADLET |u| + (CONS (|objValUnwrap| |y'|) + |u|)))))) + (SPADLET |v| + (CONS (LIST2VEC (REVERSE |u|)) + |v|)))))) + (LIST2VEC (REVERSE |v|))))))))) ;M2Rm(x,source is [.,R],[.,p,q,S]) == ; x = '_$fromCoerceable_$ => nil @@ -2366,23 +2584,21 @@ all these coercion functions have the following result: ; n=p and m=q => M2M(x,source,[nil,S]) ; coercionFailure() -(DEFUN |M2Rm| (|x| |source| #0=#:G168106) - (PROG (|p| |q| S R |n| |m|) - (RETURN - (PROGN - (SPADLET |p| (CADR #0#)) - (SPADLET |q| (CADDR #0#)) - (SPADLET S (CADDDR #0#)) - (SPADLET R (CADR |source|)) - (COND - ((BOOT-EQUAL |x| (QUOTE |$fromCoerceable$|)) NIL) - ((QUOTE T) - (SPADLET |n| (|#| |x|)) - (SPADLET |m| (|#| (ELT |x| 0))) - (COND - ((AND (BOOT-EQUAL |n| |p|) (BOOT-EQUAL |m| |q|)) - (M2M |x| |source| (CONS NIL (CONS S NIL)))) - ((QUOTE T) (|coercionFailure|))))))))) +(DEFUN |M2Rm| (|x| |source| G168106) + (PROG (|p| |q| S R |n| |m|) + (RETURN + (PROGN + (SPADLET |p| (CADR G168106)) + (SPADLET |q| (CADDR G168106)) + (SPADLET S (CADDDR G168106)) + (SPADLET R (CADR |source|)) + (COND + ((BOOT-EQUAL |x| '|$fromCoerceable$|) NIL) + ('T (SPADLET |n| (|#| |x|)) (SPADLET |m| (|#| (ELT |x| 0))) + (COND + ((AND (BOOT-EQUAL |n| |p|) (BOOT-EQUAL |m| |q|)) + (M2M |x| |source| (CONS NIL (CONS S NIL)))) + ('T (|coercionFailure|))))))))) ;M2Sm(x,source is [.,R],[.,p,S]) == ; x = '_$fromCoerceable_$ => nil @@ -2391,22 +2607,20 @@ all these coercion functions have the following result: ; n=m and m=p => M2M(x,source,[nil,S]) ; coercionFailure() -(DEFUN |M2Sm| (|x| |source| #0=#:G168136) - (PROG (|p| S R |n| |m|) - (RETURN - (PROGN - (SPADLET |p| (CADR #0#)) - (SPADLET S (CADDR #0#)) - (SPADLET R (CADR |source|)) - (COND - ((BOOT-EQUAL |x| (QUOTE |$fromCoerceable$|)) NIL) - ((QUOTE T) - (SPADLET |n| (|#| |x|)) - (SPADLET |m| (|#| (ELT |x| 0))) - (COND - ((AND (BOOT-EQUAL |n| |m|) (BOOT-EQUAL |m| |p|)) - (M2M |x| |source| (CONS NIL (CONS S NIL)))) - ((QUOTE T) (|coercionFailure|))))))))) +(DEFUN |M2Sm| (|x| |source| G168136) + (PROG (|p| S R |n| |m|) + (RETURN + (PROGN + (SPADLET |p| (CADR G168136)) + (SPADLET S (CADDR G168136)) + (SPADLET R (CADR |source|)) + (COND + ((BOOT-EQUAL |x| '|$fromCoerceable$|) NIL) + ('T (SPADLET |n| (|#| |x|)) (SPADLET |m| (|#| (ELT |x| 0))) + (COND + ((AND (BOOT-EQUAL |n| |m|) (BOOT-EQUAL |m| |p|)) + (M2M |x| |source| (CONS NIL (CONS S NIL)))) + ('T (|coercionFailure|))))))))) ;M2V(x,[.,S],target) == ; mid := ['Vector,['Vector,S]] @@ -2414,20 +2628,22 @@ all these coercion functions have the following result: ; (u := coerceInt(objNewWrap(x,mid),target)) or coercionFailure() ; objValUnwrap u -(DEFUN M2V (|x| #0=#:G168157 |target|) - (PROG (S |mid| |u|) - (RETURN - (PROGN - (SPADLET S (CADR #0#)) - (SPADLET |mid| - (CONS (QUOTE |Vector|) (CONS (CONS (QUOTE |Vector|) (CONS S NIL)) NIL))) - (COND - ((BOOT-EQUAL |x| (QUOTE |$fromCoerceable$|)) (|canCoerce| |mid| |target|)) - ((QUOTE T) - (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |x| |mid|) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u|))))))) +(DEFUN M2V (|x| G168157 |target|) + (PROG (S |mid| |u|) + (RETURN + (PROGN + (SPADLET S (CADR G168157)) + (SPADLET |mid| + (CONS '|Vector| + (CONS (CONS '|Vector| (CONS S NIL)) NIL))) + (COND + ((BOOT-EQUAL |x| '|$fromCoerceable$|) + (|canCoerce| |mid| |target|)) + ('T + (OR (SPADLET |u| + (|coerceInt| (|objNewWrap| |x| |mid|) |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u|))))))) ;--% Multivariate Polynomial ;Mp2Dmp(u, source is [., x, S], target is [dmp, y, T]) == @@ -2449,47 +2665,45 @@ all these coercion functions have the following result: ; objValUnwrap(u') (DEFUN |Mp2Dmp| (|u| |source| |target|) - (PROG (|dmp| |y| T$ |x| S |target'| |c| |plus| |mult| |one| |zero| |u'|) - (RETURN - (PROGN - (SPADLET |dmp| (CAR |target|)) - (SPADLET |y| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |x| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (SPADLET |target'| (CONS |dmp| (CONS |x| (CONS S NIL)))) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (|canCoerce| |target'| |target|)) - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 0) - (PROGN (SPADLET |c| (QCDR |u|)) (QUOTE T))) - (COND - ((NULL (SPADLET |u'| (|coerceInt| (|objNewWrap| |c| S) |target|))) - (|coercionFailure|)) - ((QUOTE T) (|objValUnwrap| |u'|)))) - ((QUOTE T) - (SPADLET |plus| - (|getFunctionFromDomain| - (QUOTE +) - |target'| - (CONS |target'| (CONS |target'| NIL)))) - (SPADLET |mult| - (|getFunctionFromDomain| - (QUOTE *) - |target'| - (CONS |target'| (CONS |target'| NIL)))) - (SPADLET |one| (|domainOne| S)) - (SPADLET |zero| (|domainZero| S)) - (OR - (SPADLET |u'| - (|coerceInt| - (|objNewWrap| - (|Mp2SimilarDmp| |u| S (|#| |x|) |plus| |mult| |one| |zero|) - |target'|) - |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|))))))) + (PROG (|dmp| |y| T$ |x| S |target'| |c| |plus| |mult| |one| |zero| + |u'|) + (RETURN + (PROGN + (SPADLET |dmp| (CAR |target|)) + (SPADLET |y| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |x| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (SPADLET |target'| (CONS |dmp| (CONS |x| (CONS S NIL)))) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| |target'| |target|)) + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 0) + (PROGN (SPADLET |c| (QCDR |u|)) 'T)) + (COND + ((NULL (SPADLET |u'| + (|coerceInt| (|objNewWrap| |c| S) + |target|))) + (|coercionFailure|)) + ('T (|objValUnwrap| |u'|)))) + ('T + (SPADLET |plus| + (|getFunctionFromDomain| '+ |target'| + (CONS |target'| (CONS |target'| NIL)))) + (SPADLET |mult| + (|getFunctionFromDomain| '* |target'| + (CONS |target'| (CONS |target'| NIL)))) + (SPADLET |one| (|domainOne| S)) + (SPADLET |zero| (|domainZero| S)) + (OR (SPADLET |u'| + (|coerceInt| + (|objNewWrap| + (|Mp2SimilarDmp| |u| S (|#| |x|) |plus| + |mult| |one| |zero|) + |target'|) + |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|))))))) ;Mp2SimilarDmp(u,S,n,plus,mult,one,zero) == ; u is [ =0,:c] => @@ -2506,46 +2720,44 @@ all these coercion functions have the following result: ; u' (DEFUN |Mp2SimilarDmp| (|u| S |n| |plus| |mult| |one| |zero|) - (PROG (|ISTMP#1| |x| |terms| |e| |c| |e'| |t| |u'|) - (RETURN - (SEQ - (COND - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 0) - (PROGN (SPADLET |c| (QCDR |u|)) (QUOTE T))) - (COND - ((BOOT-EQUAL |c| |zero|) NIL) - ((QUOTE T) - (CONS (CONS (LIST2VEC (|LZeros| |n|)) |c|) NIL)))) - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 1) - (PROGN - (SPADLET |ISTMP#1| (QCDR |u|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |x| (QCAR |ISTMP#1|)) - (SPADLET |terms| (QCDR |ISTMP#1|)) - (QUOTE T))))) - (SPADLET |u'| NIL) - (DO ((#0=#:G168239 |terms| (CDR #0#)) (#1=#:G168224 NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN (SPADLET |e| (CAR #1#)) (SPADLET |c| (CDR #1#)) #1#) - NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |e'| (LIST2VEC (|LZeros| |n|))) - (SETELT |e'| (SPADDIFFERENCE |x| 1) |e|) - (SPADLET |t| (CONS (CONS |e'| |one|) NIL)) - (SPADLET |t| - (SPADCALL |t| - (|Mp2SimilarDmp| |c| S |n| |plus| |mult| |one| |zero|) - |mult|)) - (SPADLET |u'| (SPADCALL |u'| |t| |plus|)))))) - |u'|)))))) + (PROG (|ISTMP#1| |x| |terms| |e| |c| |e'| |t| |u'|) + (RETURN + (SEQ (COND + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 0) + (PROGN (SPADLET |c| (QCDR |u|)) 'T)) + (COND + ((BOOT-EQUAL |c| |zero|) NIL) + ('T (CONS (CONS (LIST2VEC (|LZeros| |n|)) |c|) NIL)))) + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 1) + (PROGN + (SPADLET |ISTMP#1| (QCDR |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |x| (QCAR |ISTMP#1|)) + (SPADLET |terms| (QCDR |ISTMP#1|)) + 'T)))) + (SPADLET |u'| NIL) + (DO ((G168239 |terms| (CDR G168239)) (G168224 NIL)) + ((OR (ATOM G168239) + (PROGN (SETQ G168224 (CAR G168239)) NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G168224)) + (SPADLET |c| (CDR G168224)) + G168224) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |e'| (LIST2VEC (|LZeros| |n|))) + (SETELT |e'| (SPADDIFFERENCE |x| 1) |e|) + (SPADLET |t| (CONS (CONS |e'| |one|) NIL)) + (SPADLET |t| + (SPADCALL |t| + (|Mp2SimilarDmp| |c| S |n| + |plus| |mult| |one| |zero|) + |mult|)) + (SPADLET |u'| (SPADCALL |u'| |t| |plus|)))))) + |u'|)))))) ;Mp2Expr(u,source is [mp,vars,S], target is [Expr,T]) == ; u = '_$fromCoerceable_$ => canCoerce(S, target) @@ -2554,26 +2766,27 @@ all these coercion functions have the following result: ; Dmp2Expr(objValUnwrap d, dmp, target) (DEFUN |Mp2Expr| (|u| |source| |target|) - (PROG (|Expr| T$ |mp| |vars| S |dmp| |d|) - (RETURN - (PROGN - (SPADLET |Expr| (CAR |target|)) - (SPADLET T$ (CADR |target|)) - (SPADLET |mp| (CAR |source|)) - (SPADLET |vars| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| S |target|)) - ((QUOTE T) - (SPADLET |dmp| - (CONS - (QUOTE |DistributedMultivariatePolynomial|) - (CONS |vars| (CONS S NIL)))) - (COND - ((NULL (SPADLET |d| (|coerceInt| (|objNewWrap| |u| |source|) |dmp|))) - (|coercionFailure|)) - ((QUOTE T) - (|Dmp2Expr| (|objValUnwrap| |d|) |dmp| |target|))))))))) + (PROG (|Expr| T$ |mp| |vars| S |dmp| |d|) + (RETURN + (PROGN + (SPADLET |Expr| (CAR |target|)) + (SPADLET T$ (CADR |target|)) + (SPADLET |mp| (CAR |source|)) + (SPADLET |vars| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| S |target|)) + ('T + (SPADLET |dmp| + (CONS '|DistributedMultivariatePolynomial| + (CONS |vars| (CONS S NIL)))) + (COND + ((NULL (SPADLET |d| + (|coerceInt| (|objNewWrap| |u| |source|) + |dmp|))) + (|coercionFailure|)) + ('T (|Dmp2Expr| (|objValUnwrap| |d|) |dmp| |target|))))))))) ;Mp2FR(u,S is [.,vl,R],[.,T]) == ; u = '_$fromCoerceable_$ => @@ -2592,49 +2805,57 @@ all these coercion functions have the following result: ; factor := getFunctionFromDomain('factor,package,[S]) ; SPADCALL(u,factor) -(DEFUN |Mp2FR| (|u| S #0=#:G168315) - (PROG (T$ |vl| R |ISTMP#1| D |ovl| |package| |factor|) - (RETURN - (PROGN - (SPADLET T$ (CADR #0#)) - (SPADLET |vl| (CADR S)) - (SPADLET R (CADDR S)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (COND - ((NEQUAL S T$) NIL) - ((|member| R (QUOTE ((|Integer|) (|Fraction| (|Integer|))))) (QUOTE T)) - ((QUOTE T) NIL))) - ((NEQUAL S T$) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |package| - (COND - ((BOOT-EQUAL R |$Integer|) - (SPADLET |ovl| (CONS (QUOTE |OrderedVariableList|) (CONS |vl| NIL))) - (CONS - (QUOTE |MultivariateFactorize|) - (CONS |ovl| - (CONS - (CONS (QUOTE |IndexedExponents|) (CONS |ovl| NIL)) - (CONS R (CONS S NIL)))))) - ((AND (PAIRP R) - (EQ (QCAR R) (QUOTE |Fraction|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR R)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET D (QCAR |ISTMP#1|)) (QUOTE T))))) - (SPADLET |ovl| (CONS (QUOTE |OrderedVariableList|) (CONS |vl| NIL))) - (SPADLET |package| - (CONS - (QUOTE |MRationalFactorize|) - (CONS - (CONS (QUOTE |IndexedExponents|) (CONS |ovl| NIL)) - (CONS |ovl| (CONS D (CONS S NIL))))))) - ((QUOTE T) (|coercionFailure|)))) - (SPADLET |factor| - (|getFunctionFromDomain| (QUOTE |factor|) |package| (CONS S NIL))) - (SPADCALL |u| |factor|))))))) +(DEFUN |Mp2FR| (|u| S G168315) + (PROG (T$ |vl| R |ISTMP#1| D |ovl| |package| |factor|) + (DECLARE (SPECIAL |$Integer|)) + (RETURN + (PROGN + (SPADLET T$ (CADR G168315)) + (SPADLET |vl| (CADR S)) + (SPADLET R (CADDR S)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (COND + ((NEQUAL S T$) NIL) + ((|member| R '((|Integer|) (|Fraction| (|Integer|)))) 'T) + ('T NIL))) + ((NEQUAL S T$) (|coercionFailure|)) + ('T + (SPADLET |package| + (COND + ((BOOT-EQUAL R |$Integer|) + (SPADLET |ovl| + (CONS '|OrderedVariableList| + (CONS |vl| NIL))) + (CONS '|MultivariateFactorize| + (CONS |ovl| + (CONS + (CONS '|IndexedExponents| + (CONS |ovl| NIL)) + (CONS R (CONS S NIL)))))) + ((AND (PAIRP R) (EQ (QCAR R) '|Fraction|) + (PROGN + (SPADLET |ISTMP#1| (QCDR R)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET D (QCAR |ISTMP#1|)) + 'T)))) + (SPADLET |ovl| + (CONS '|OrderedVariableList| + (CONS |vl| NIL))) + (SPADLET |package| + (CONS '|MRationalFactorize| + (CONS + (CONS '|IndexedExponents| + (CONS |ovl| NIL)) + (CONS |ovl| + (CONS D (CONS S NIL))))))) + ('T (|coercionFailure|)))) + (SPADLET |factor| + (|getFunctionFromDomain| '|factor| |package| + (CONS S NIL))) + (SPADCALL |u| |factor|))))))) ;Mp2Mp(u,source is [mp,x,S], target is [.,y,T]) == ; -- need not deal with case of x = y (coerceByMapping) @@ -2678,93 +2899,93 @@ all these coercion functions have the following result: ; objValUnwrap(u') (DEFUN |Mp2Mp| (|u| |source| |target|) - (PROG (|y| T$ |mp| |x| S |common| |x'| |y'| |c| |plus| |times| |expn| - |monom| |univariate| |u'|) - (RETURN - (PROGN - (SPADLET |y| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |mp| (CAR |source|)) - (SPADLET |x| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (SPADLET |common| (|intersection| |y| |x|)) - (SPADLET |x'| (SETDIFFERENCE |x| |common|)) - (SPADLET |y'| (SETDIFFERENCE |y| |common|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (COND - ((BOOT-EQUAL |x| |y|) (|canCoerce| S T$)) - ((NULL |common|) (|canCoerce| |source| T$)) - ((NULL |x'|) (|canCoerce| S |target|)) - ((NULL |y'|) (|canCoerce| (CONS |mp| (CONS |x'| (CONS S NIL))) T$)) - ((QUOTE T) - (|canCoerce| - (CONS |mp| (CONS |x'| (CONS S NIL))) - (CONS |mp| (CONS |y'| (CONS T$ NIL))))))) - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 0) - (PROGN (SPADLET |c| (QCDR |u|)) (QUOTE T))) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|coercionFailure|)) (|objValUnwrap| |u'|)) - ((QUOTE T) - (SPADLET |plus| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (COND - ((NULL |common|) - (SPADLET |times| - (|getFunctionFromDomain| - (QUOTE *) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |expn| - (|getFunctionFromDomain| - (QUOTE **) - |target| - (CONS |target| (CONS |$NonNegativeInteger| NIL)))) - (|Mp2MpAux0| |u| S |target| |x| |plus| |times| |expn|)) - ((NULL |x'|) - (SPADLET |monom| - (|getFunctionFromDomain| - (QUOTE |monomial|) - |target| - (CONS - |target| - (CONS - (CONS (QUOTE |OrderedVariableList|) (CONS |y| NIL)) - (CONS |$NonNegativeInteger| NIL))))) - (|Mp2MpAux1| |u| S |target| |x| |y| |plus| |monom|)) - ((NULL |y'|) - (SPADLET |univariate| - (|getFunctionFromDomain| - (QUOTE |univariate|) - |source| - (CONS |source| - (CONS (CONS (QUOTE |OrderedVariableList|) (CONS |x| NIL)) NIL)))) - (SPADLET |u'| - (|Mp2MpAux2| |u| |x| |common| |x'| |common| |x'| |univariate| S NIL)) - (OR - (SPADLET |u'| - (|coerceInt| - (|objNewWrap| |u'| - (CONS |mp| - (CONS |common| (CONS (CONS |mp| (CONS |x'| (CONS S NIL))) NIL)))) - |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)) - ((QUOTE T) - (OR - (SPADLET |u'| - (|coerceInt| - (|objNewWrap| |u| |source|) - (CONS |mp| - (CONS |common| (CONS (CONS |mp| (CONS |x'| (CONS S NIL))) NIL))))) - (|coercionFailure|)) - (OR (SPADLET |u'| (|coerceInt| |u'| |target|)) (|coercionFailure|)) - (|objValUnwrap| |u'|))))))))) + (PROG (|y| T$ |mp| |x| S |common| |x'| |y'| |c| |plus| |times| |expn| + |monom| |univariate| |u'|) + (DECLARE (SPECIAL |$NonNegativeInteger|)) + (RETURN + (PROGN + (SPADLET |y| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |mp| (CAR |source|)) + (SPADLET |x| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (SPADLET |common| (|intersection| |y| |x|)) + (SPADLET |x'| (SETDIFFERENCE |x| |common|)) + (SPADLET |y'| (SETDIFFERENCE |y| |common|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (COND + ((BOOT-EQUAL |x| |y|) (|canCoerce| S T$)) + ((NULL |common|) (|canCoerce| |source| T$)) + ((NULL |x'|) (|canCoerce| S |target|)) + ((NULL |y'|) + (|canCoerce| (CONS |mp| (CONS |x'| (CONS S NIL))) T$)) + ('T + (|canCoerce| (CONS |mp| (CONS |x'| (CONS S NIL))) + (CONS |mp| (CONS |y'| (CONS T$ NIL))))))) + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 0) + (PROGN (SPADLET |c| (QCDR |u|)) 'T)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)) + ('T + (SPADLET |plus| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (COND + ((NULL |common|) + (SPADLET |times| + (|getFunctionFromDomain| '* |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |expn| + (|getFunctionFromDomain| '** |target| + (CONS |target| + (CONS |$NonNegativeInteger| NIL)))) + (|Mp2MpAux0| |u| S |target| |x| |plus| |times| |expn|)) + ((NULL |x'|) + (SPADLET |monom| + (|getFunctionFromDomain| '|monomial| |target| + (CONS |target| + (CONS (CONS '|OrderedVariableList| + (CONS |y| NIL)) + (CONS |$NonNegativeInteger| NIL))))) + (|Mp2MpAux1| |u| S |target| |x| |y| |plus| |monom|)) + ((NULL |y'|) + (SPADLET |univariate| + (|getFunctionFromDomain| '|univariate| |source| + (CONS |source| + (CONS (CONS '|OrderedVariableList| + (CONS |x| NIL)) + NIL)))) + (SPADLET |u'| + (|Mp2MpAux2| |u| |x| |common| |x'| |common| |x'| + |univariate| S NIL)) + (OR (SPADLET |u'| + (|coerceInt| + (|objNewWrap| |u'| + (CONS |mp| + (CONS |common| + (CONS + (CONS |mp| + (CONS |x'| (CONS S NIL))) + NIL)))) + |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)) + ('T + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |u| |source|) + (CONS |mp| + (CONS |common| + (CONS + (CONS |mp| + (CONS |x'| (CONS S NIL))) + NIL))))) + (|coercionFailure|)) + (OR (SPADLET |u'| (|coerceInt| |u'| |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|))))))))) ;Mp2MpAux0(u,S,target,vars,plus,times,expn) == ; -- for case when no common variables @@ -2785,55 +3006,58 @@ all these coercion functions have the following result: ; sum (DEFUN |Mp2MpAux0| (|u| S |target| |vars| |plus| |times| |expn|) - (PROG (|u'| |var| |terms| |mp| T$ |x| |e| |c| |prod| |sum|) - (RETURN - (SEQ - (COND - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 0) - (PROGN (SPADLET |c| (QCDR |u|)) (QUOTE T))) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)) - ((QUOTE T) - (SPADLET |var| (CADR |u|)) - (SPADLET |terms| (CDDR |u|)) - (SPADLET |mp| (CAR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |x| - (OR - (|coerceInt| - (|objNewWrap| - (ELT |vars| (SPADDIFFERENCE |var| 1)) - (CONS - (QUOTE |Variable|) - (CONS (ELT |vars| (SPADDIFFERENCE |var| 1)) NIL))) - (CONS |mp| (CONS |vars| (CONS |$Integer| NIL)))) - (|coercionFailure|))) - (OR (SPADLET |x| (|coerceInt| |x| T$)) (|coercionFailure|)) - (SPADLET |x| (CONS 0 (|objValUnwrap| |x|))) - (SPADLET |sum| (|domainZero| |target|)) - (DO ((#0=#:G168417 |terms| (CDR #0#)) (#1=#:G168406 NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN - (SPADLET |e| (CAR #1#)) - (SPADLET |c| (CDR #1#)) - #1#) - NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |prod| - (SPADCALL - (SPADCALL |x| |e| |expn|) - (|Mp2MpAux0| |c| S |target| |vars| |plus| |times| |expn|) - |times|)) - (SPADLET |sum| (SPADCALL |sum| |prod| |plus|)))))) - |sum|)))))) + (PROG (|u'| |var| |terms| |mp| T$ |x| |e| |c| |prod| |sum|) + (DECLARE (SPECIAL |$Integer|)) + (RETURN + (SEQ (COND + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 0) + (PROGN (SPADLET |c| (QCDR |u|)) 'T)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)) + ('T (SPADLET |var| (CADR |u|)) + (SPADLET |terms| (CDDR |u|)) + (SPADLET |mp| (CAR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |x| + (OR (|coerceInt| + (|objNewWrap| + (ELT |vars| + (SPADDIFFERENCE |var| 1)) + (CONS '|Variable| + (CONS + (ELT |vars| + (SPADDIFFERENCE |var| 1)) + NIL))) + (CONS |mp| + (CONS |vars| + (CONS |$Integer| NIL)))) + (|coercionFailure|))) + (OR (SPADLET |x| (|coerceInt| |x| T$)) + (|coercionFailure|)) + (SPADLET |x| (CONS 0 (|objValUnwrap| |x|))) + (SPADLET |sum| (|domainZero| |target|)) + (DO ((G168417 |terms| (CDR G168417)) (G168406 NIL)) + ((OR (ATOM G168417) + (PROGN (SETQ G168406 (CAR G168417)) NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G168406)) + (SPADLET |c| (CDR G168406)) + G168406) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |prod| + (SPADCALL + (SPADCALL |x| |e| |expn|) + (|Mp2MpAux0| |c| S |target| + |vars| |plus| |times| |expn|) + |times|)) + (SPADLET |sum| + (SPADCALL |sum| |prod| |plus|)))))) + |sum|)))))) ;Mp2MpAux1(u,S,target,varl1,varl2,plus,monom) == ; -- for case when source vars are all in target @@ -2849,39 +3073,41 @@ all these coercion functions have the following result: ; sum (DEFUN |Mp2MpAux1| (|u| S |target| |varl1| |varl2| |plus| |monom|) - (PROG (|u'| |var| |terms| |e| |c| |mon| |sum|) - (RETURN - (SEQ - (COND - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 0) - (PROGN (SPADLET |c| (QCDR |u|)) (QUOTE T))) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)) - ((QUOTE T) - (SPADLET |var| (CADR |u|)) - (SPADLET |terms| (CDDR |u|)) - (SPADLET |sum| (|domainZero| |target|)) - (DO ((#0=#:G168457 |terms| (CDR #0#)) (#1=#:G168446 NIL)) - ((OR - (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN (SPADLET |e| (CAR #1#)) (SPADLET |c| (CDR #1#)) #1#) - NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |mon| - (SPADCALL - (|Mp2MpAux1| |c| S |target| |varl1| |varl2| |plus| |monom|) - (|position1| (ELT |varl1| (SPADDIFFERENCE |var| 1)) |varl2|) - |e| |monom|)) - (SPADLET |sum| (SPADCALL |sum| |mon| |plus|)))))) - |sum|)))))) + (PROG (|u'| |var| |terms| |e| |c| |mon| |sum|) + (RETURN + (SEQ (COND + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 0) + (PROGN (SPADLET |c| (QCDR |u|)) 'T)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)) + ('T (SPADLET |var| (CADR |u|)) + (SPADLET |terms| (CDDR |u|)) + (SPADLET |sum| (|domainZero| |target|)) + (DO ((G168457 |terms| (CDR G168457)) (G168446 NIL)) + ((OR (ATOM G168457) + (PROGN (SETQ G168446 (CAR G168457)) NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G168446)) + (SPADLET |c| (CDR G168446)) + G168446) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |mon| + (SPADCALL + (|Mp2MpAux1| |c| S |target| + |varl1| |varl2| |plus| |monom|) + (|position1| + (ELT |varl1| + (SPADDIFFERENCE |var| 1)) + |varl2|) + |e| |monom|)) + (SPADLET |sum| + (SPADCALL |sum| |mon| |plus|)))))) + |sum|)))))) ;Mp2MpAux2(u,x,oldcomm,oldrest,common,restvars,univariate,S,isUnder) == ; -- target vars are all in source @@ -2908,104 +3134,123 @@ all these coercion functions have the following result: ; [1,position1(var,oldrest),:[[e,:Mp2MpAux2(c,x,oldcomm,oldrest, ; common,restvars,univariate,S,isUnder)] for [e,:c] in u']] -(DEFUN |Mp2MpAux2| (|u| |x| |oldcomm| |oldrest| |common| |restvars| - |univariate| S |isUnder|) - (PROG (|mp2| |LETTMP#1| |var| |u'| |e| |c|) - (RETURN - (SEQ - (PROGN - (SPADLET |mp2| - (CONS - (QUOTE |MultivariatePolynomial|) - (CONS |oldcomm| - (CONS - (CONS (QUOTE |MultivariatePolynomial|) (CONS |oldrest| (CONS S NIL))) - NIL)))) - (COND - (|common| - (COND - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 0) - (PROGN (SPADLET |c| (QCDR |u|)) (QUOTE T))) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |c| S) |mp2|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)) - ((QUOTE T) - (SPADLET |LETTMP#1| |common|) - (SPADLET |var| (CAR |LETTMP#1|)) - (SPADLET |common| (CDR |LETTMP#1|)) - (SPADLET |u'| (SPADCALL |u| (|position1| |var| |x|) |univariate|)) - (COND - ((AND (NULL (CDR |u'|)) (EQL (CAR (CAR |u'|)) 0)) - (|Mp2MpAux2| |u| |x| |oldcomm| |oldrest| |common| |restvars| - |univariate| S |isUnder|)) - ((QUOTE T) - (CONS 1 - (CONS - (|position1| |var| |oldcomm|) - (PROG (#0=#:G168506) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G168512 |u'| (CDR #1#)) (#2=#:G168484 NIL)) - ((OR (ATOM #1#) - (PROGN (SETQ #2# (CAR #1#)) NIL) - (PROGN - (PROGN - (SPADLET |e| (CAR #2#)) - (SPADLET |c| (CDR #2#)) - #2#) - NIL)) - (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS - (CONS |e| - (|Mp2MpAux2| |c| |x| |oldcomm| |oldrest| |common| - |restvars| |univariate| S |isUnder|)) - #0#)))))))))))))) - ((NULL |isUnder|) - (CONS 0 - (|Mp2MpAux2| |u| |x| |oldcomm| |oldrest| |common| |restvars| - |univariate| S (QUOTE T)))) - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 0) - (PROGN (SPADLET |c| (QCDR |u|)) (QUOTE T))) - |u|) - ((QUOTE T) - (SPADLET |LETTMP#1| |restvars|) - (SPADLET |var| (CAR |LETTMP#1|)) - (SPADLET |restvars| (CDR |LETTMP#1|)) - (SPADLET |u'| (SPADCALL |u| (|position1| |var| |x|) |univariate|)) - (COND - ((AND (NULL (CDR |u'|)) (EQL (CAR (CAR |u'|)) 0)) - (|Mp2MpAux2| |u| |x| |oldcomm| |oldrest| |common| |restvars| - |univariate| S |isUnder|)) - ((QUOTE T) - (CONS 1 - (CONS - (|position1| |var| |oldrest|) - (PROG (#3=#:G168524) - (SPADLET #3# NIL) - (RETURN - (DO ((#4=#:G168530 |u'| (CDR #4#)) (#5=#:G168496 NIL)) - ((OR (ATOM #4#) - (PROGN (SETQ #5# (CAR #4#)) NIL) - (PROGN - (PROGN - (SPADLET |e| (CAR #5#)) - (SPADLET |c| (CDR #5#)) #5#) - NIL)) - (NREVERSE0 #3#)) - (SEQ - (EXIT - (SETQ #3# - (CONS - (CONS |e| - (|Mp2MpAux2| |c| |x| |oldcomm| |oldrest| |common| - |restvars| |univariate| S |isUnder|)) - #3#)))))))))))))))))) +(DEFUN |Mp2MpAux2| + (|u| |x| |oldcomm| |oldrest| |common| |restvars| |univariate| S + |isUnder|) + (PROG (|mp2| |LETTMP#1| |var| |u'| |e| |c|) + (RETURN + (SEQ (PROGN + (SPADLET |mp2| + (CONS '|MultivariatePolynomial| + (CONS |oldcomm| + (CONS (CONS '|MultivariatePolynomial| + (CONS |oldrest| (CONS S NIL))) + NIL)))) + (COND + (|common| + (COND + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 0) + (PROGN (SPADLET |c| (QCDR |u|)) 'T)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |c| S) + |mp2|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)) + ('T (SPADLET |LETTMP#1| |common|) + (SPADLET |var| (CAR |LETTMP#1|)) + (SPADLET |common| (CDR |LETTMP#1|)) + (SPADLET |u'| + (SPADCALL |u| (|position1| |var| |x|) + |univariate|)) + (COND + ((AND (NULL (CDR |u'|)) + (EQL (CAR (CAR |u'|)) 0)) + (|Mp2MpAux2| |u| |x| |oldcomm| |oldrest| + |common| |restvars| |univariate| S + |isUnder|)) + ('T + (CONS 1 + (CONS (|position1| |var| |oldcomm|) + (PROG (G168506) + (SPADLET G168506 NIL) + (RETURN + (DO + ((G168512 |u'| + (CDR G168512)) + (G168484 NIL)) + ((OR (ATOM G168512) + (PROGN + (SETQ G168484 + (CAR G168512)) + NIL) + (PROGN + (PROGN + (SPADLET |e| + (CAR G168484)) + (SPADLET |c| + (CDR G168484)) + G168484) + NIL)) + (NREVERSE0 G168506)) + (SEQ + (EXIT + (SETQ G168506 + (CONS + (CONS |e| + (|Mp2MpAux2| |c| |x| + |oldcomm| |oldrest| + |common| |restvars| + |univariate| S + |isUnder|)) + G168506)))))))))))))) + ((NULL |isUnder|) + (CONS 0 + (|Mp2MpAux2| |u| |x| |oldcomm| |oldrest| |common| + |restvars| |univariate| S 'T))) + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 0) + (PROGN (SPADLET |c| (QCDR |u|)) 'T)) + |u|) + ('T (SPADLET |LETTMP#1| |restvars|) + (SPADLET |var| (CAR |LETTMP#1|)) + (SPADLET |restvars| (CDR |LETTMP#1|)) + (SPADLET |u'| + (SPADCALL |u| (|position1| |var| |x|) + |univariate|)) + (COND + ((AND (NULL (CDR |u'|)) (EQL (CAR (CAR |u'|)) 0)) + (|Mp2MpAux2| |u| |x| |oldcomm| |oldrest| |common| + |restvars| |univariate| S |isUnder|)) + ('T + (CONS 1 + (CONS (|position1| |var| |oldrest|) + (PROG (G168524) + (SPADLET G168524 NIL) + (RETURN + (DO + ((G168530 |u'| (CDR G168530)) + (G168496 NIL)) + ((OR (ATOM G168530) + (PROGN + (SETQ G168496 + (CAR G168530)) + NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G168496)) + (SPADLET |c| (CDR G168496)) + G168496) + NIL)) + (NREVERSE0 G168524)) + (SEQ + (EXIT + (SETQ G168524 + (CONS + (CONS |e| + (|Mp2MpAux2| |c| |x| + |oldcomm| |oldrest| |common| + |restvars| |univariate| S + |isUnder|)) + G168524)))))))))))))))))) ;genMpFromDmpTerm(u, oldlen) == ; -- given one term of a DMP representation of a polynomial, this creates @@ -3021,36 +3266,32 @@ all these coercion functions have the following result: ; [1, 1+patlen, [e.patlen,:genMpFromDmpTerm(u,patlen+1)]] (DEFUN |genMpFromDmpTerm| (|u| |oldlen|) - (PROG (|e| |c| |numexps| |patlen|) - (RETURN - (SEQ - (PROGN - (SPADLET |patlen| |oldlen|) - (SPADLET |e| (CAR |u|)) - (SPADLET |c| (CDR |u|)) - (SPADLET |numexps| (|#| |e|)) - (COND - ((>= |patlen| |numexps|) (CONS 0 |c|)) - ((QUOTE T) - (DO ((#0=#:G168566 (SPADDIFFERENCE |numexps| 1)) - (|i| |patlen| (+ |i| 1))) - ((> |i| #0#) NIL) - (SEQ - (EXIT - (COND - ((EQL (ELT |e| |i|) 0) (SPADLET |patlen| (PLUS |patlen| 1))) - ((QUOTE T) (RETURN NIL)))))) - (COND - ((>= |patlen| |numexps|) (CONS 0 |c|)) - ((QUOTE T) - (CONS 1 - (CONS - (PLUS 1 |patlen|) - (CONS - (CONS - (ELT |e| |patlen|) - (|genMpFromDmpTerm| |u| (PLUS |patlen| 1))) - NIL)))))))))))) + (PROG (|e| |c| |numexps| |patlen|) + (RETURN + (SEQ (PROGN + (SPADLET |patlen| |oldlen|) + (SPADLET |e| (CAR |u|)) + (SPADLET |c| (CDR |u|)) + (SPADLET |numexps| (|#| |e|)) + (COND + ((>= |patlen| |numexps|) (CONS 0 |c|)) + ('T + (DO ((G168566 (SPADDIFFERENCE |numexps| 1)) + (|i| |patlen| (+ |i| 1))) + ((> |i| G168566) NIL) + (SEQ (EXIT (COND + ((EQL (ELT |e| |i|) 0) + (SPADLET |patlen| (PLUS |patlen| 1))) + ('T (RETURN NIL)))))) + (COND + ((>= |patlen| |numexps|) (CONS 0 |c|)) + ('T + (CONS 1 + (CONS (PLUS 1 |patlen|) + (CONS (CONS (ELT |e| |patlen|) + (|genMpFromDmpTerm| |u| + (PLUS |patlen| 1))) + NIL)))))))))))) ;Mp2P(u, source is [mp,vl, S], target is [p,R]) == ; u = '_$fromCoerceable_$ => canCoerce(S,target) @@ -3063,32 +3304,33 @@ all these coercion functions have the following result: ; objValUnwrap(u') (DEFUN |Mp2P| (|u| |source| |target|) - (PROG (|p| R |mp| |vl| S |ISTMP#1| |vl'| |u'|) - (RETURN - (PROGN - (SPADLET |p| (CAR |target|)) - (SPADLET R (CADR |target|)) - (SPADLET |mp| (CAR |source|)) - (SPADLET |vl| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| S |target|)) - ((AND (PAIRP S) - (EQ (QCAR S) (QUOTE |Polynomial|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR S)) - (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL)))) - (|MpP2P| |u| |vl| S R)) - ((QUOTE T) - (SPADLET |vl'| (REVERSE (MSORT |vl|))) - (SPADLET |u'| - (|Mp2Mp| |u| |source| (CONS |mp| (CONS |vl'| (CONS S NIL))))) - (SPADLET |u'| (|translateMpVars2PVars| |u'| |vl'|)) - (OR - (SPADLET |u'| - (|coerceInt| (|objNewWrap| |u'| (CONS |p| (CONS S NIL))) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|))))))) + (PROG (|p| R |mp| |vl| S |ISTMP#1| |vl'| |u'|) + (RETURN + (PROGN + (SPADLET |p| (CAR |target|)) + (SPADLET R (CADR |target|)) + (SPADLET |mp| (CAR |source|)) + (SPADLET |vl| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| S |target|)) + ((AND (PAIRP S) (EQ (QCAR S) '|Polynomial|) + (PROGN + (SPADLET |ISTMP#1| (QCDR S)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL)))) + (|MpP2P| |u| |vl| S R)) + ('T (SPADLET |vl'| (REVERSE (MSORT |vl|))) + (SPADLET |u'| + (|Mp2Mp| |u| |source| + (CONS |mp| (CONS |vl'| (CONS S NIL))))) + (SPADLET |u'| (|translateMpVars2PVars| |u'| |vl'|)) + (OR (SPADLET |u'| + (|coerceInt| + (|objNewWrap| |u'| (CONS |p| (CONS S NIL))) + |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|))))))) ;MpP2P(u,vl,PS,R) == ; -- u has type MP(vl,PS). Want to coerce to P R. @@ -3104,48 +3346,52 @@ all these coercion functions have the following result: ; p := SPADCALL(sup,vl.(pos-1),multivariate) (DEFUN |MpP2P| (|u| |vl| PS R) - (PROG (PR |u'| |pos| |ec| |multivariate| |e| |c| |sup| |p|) - (RETURN - (SEQ - (PROGN - (SPADLET PR (CONS (QUOTE |Polynomial|) (CONS R NIL))) - (COND - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 0) - (PROGN (SPADLET |c| (QCDR |u|)) (QUOTE T))) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |c| PS) PR)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)) - ((QUOTE T) - (SPADLET |pos| (CADR |u|)) - (SPADLET |ec| (CDDR |u|)) - (SPADLET |multivariate| - (|getFunctionFromDomain| - (QUOTE |multivariate|) - PR - (CONS - (CONS (QUOTE |SparseUnivariatePolynomial|) (CONS PR NIL)) - (CONS |$Symbol| NIL)))) - (SPADLET |sup| - (PROG (#0=#:G168635) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G168641 |ec| (CDR #1#)) (#2=#:G168625 NIL)) - ((OR (ATOM #1#) - (PROGN (SETQ #2# (CAR #1#)) NIL) - (PROGN - (PROGN - (SPADLET |e| (CAR #2#)) - (SPADLET |c| (CDR #2#)) #2#) - NIL)) - (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# (CONS (CONS |e| (|MpP2P| |c| |vl| PS R)) #0#)))))))) - (SPADLET |p| - (SPADCALL |sup| - (ELT |vl| (SPADDIFFERENCE |pos| 1)) |multivariate|))))))))) + (PROG (PR |u'| |pos| |ec| |multivariate| |e| |c| |sup| |p|) + (DECLARE (SPECIAL |$Symbol|)) + (RETURN + (SEQ (PROGN + (SPADLET PR (CONS '|Polynomial| (CONS R NIL))) + (COND + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 0) + (PROGN (SPADLET |c| (QCDR |u|)) 'T)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |c| PS) PR)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)) + ('T (SPADLET |pos| (CADR |u|)) (SPADLET |ec| (CDDR |u|)) + (SPADLET |multivariate| + (|getFunctionFromDomain| '|multivariate| PR + (CONS (CONS '|SparseUnivariatePolynomial| + (CONS PR NIL)) + (CONS |$Symbol| NIL)))) + (SPADLET |sup| + (PROG (G168635) + (SPADLET G168635 NIL) + (RETURN + (DO ((G168641 |ec| (CDR G168641)) + (G168625 NIL)) + ((OR (ATOM G168641) + (PROGN + (SETQ G168625 + (CAR G168641)) + NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G168625)) + (SPADLET |c| (CDR G168625)) + G168625) + NIL)) + (NREVERSE0 G168635)) + (SEQ (EXIT + (SETQ G168635 + (CONS + (CONS |e| + (|MpP2P| |c| |vl| PS R)) + G168635)))))))) + (SPADLET |p| + (SPADCALL |sup| + (ELT |vl| (SPADDIFFERENCE |pos| 1)) + |multivariate|))))))))) ; --(p' :=coerceInt(objNewWrap(p,PS),['Polynomial,R])) or coercionFailure() ; --objValUnwrap(p') @@ -3176,75 +3422,92 @@ all these coercion functions have the following result: ; objValUnwrap u' (DEFUN |Mp2Up| (|u| |source| |target|) - (PROG (|up| |x| T$ |mp| |vl| S |e| |c| |var| UPP |univariate| |upU| |u'|) - (RETURN - (SEQ - (PROGN - (SPADLET |up| (CAR |target|)) - (SPADLET |x| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |mp| (CAR |source|)) - (SPADLET |vl| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (COND - ((|member| |x| |vl|) - (COND - ((BOOT-EQUAL |vl| (CONS |x| NIL)) (|canCoerce| S T$)) - ((QUOTE T) - (|canCoerce| - (CONS |mp| (CONS (|delete| |x| |vl|) (CONS S NIL))) - T$)))) - ((QUOTE T) (|canCoerce| |source| T$)))) - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 0) - (PROGN (SPADLET |c| (QCDR |u|)) (QUOTE T))) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)) - ((NULL (|member| |x| |vl|)) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |u| |source|) T$)) - (|coercionFailure|)) - (CONS (CONS 0 (|objValUnwrap| |u'|)) NIL)) - ((BOOT-EQUAL |vl| (CONS |x| NIL)) - (SPADLET |u'| - (PROG (#0=#:G168712) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G168718 (CDDR |u|) (CDR #1#)) (#2=#:G168666 NIL)) - ((OR (ATOM #1#) - (PROGN (SETQ #2# (CAR #1#)) NIL) - (PROGN - (PROGN - (SPADLET |e| (CAR #2#)) - (SPADLET |c| (CDDR #2#)) #2#) - NIL)) - (NREVERSE0 #0#)) - (SEQ (EXIT (SETQ #0# (CONS (CONS |e| |c|) #0#)))))))) - (OR - (SPADLET |u'| - (|coerceInt| - (|objNewWrap| |u'| (CONS |up| (CONS |x| (CONS S NIL)))) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)) - ((QUOTE T) - (SPADLET |var| (|position1| |x| |vl|)) - (SPADLET UPP - (CONS (QUOTE |UnivariatePolynomial|) (CONS |x| (CONS |source| NIL)))) - (SPADLET |univariate| - (|getFunctionFromDomain| - (QUOTE |univariate|) - |source| - (CONS |source| - (CONS (CONS (QUOTE |OrderedVariableList|) (CONS |vl| NIL)) NIL)))) - (SPADLET |upU| (SPADCALL |u| |var| |univariate|)) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |upU| UPP) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)))))))) + (PROG (|up| |x| T$ |mp| |vl| S |e| |c| |var| UPP |univariate| |upU| + |u'|) + (RETURN + (SEQ (PROGN + (SPADLET |up| (CAR |target|)) + (SPADLET |x| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |mp| (CAR |source|)) + (SPADLET |vl| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (COND + ((|member| |x| |vl|) + (COND + ((BOOT-EQUAL |vl| (CONS |x| NIL)) + (|canCoerce| S T$)) + ('T + (|canCoerce| + (CONS |mp| + (CONS (|delete| |x| |vl|) (CONS S NIL))) + T$)))) + ('T (|canCoerce| |source| T$)))) + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 0) + (PROGN (SPADLET |c| (QCDR |u|)) 'T)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |c| S) + |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)) + ((NULL (|member| |x| |vl|)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |u| |source|) + T$)) + (|coercionFailure|)) + (CONS (CONS 0 (|objValUnwrap| |u'|)) NIL)) + ((BOOT-EQUAL |vl| (CONS |x| NIL)) + (SPADLET |u'| + (PROG (G168712) + (SPADLET G168712 NIL) + (RETURN + (DO ((G168718 (CDDR |u|) + (CDR G168718)) + (G168666 NIL)) + ((OR (ATOM G168718) + (PROGN + (SETQ G168666 + (CAR G168718)) + NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G168666)) + (SPADLET |c| + (CDDR G168666)) + G168666) + NIL)) + (NREVERSE0 G168712)) + (SEQ (EXIT + (SETQ G168712 + (CONS (CONS |e| |c|) G168712)))))))) + (OR (SPADLET |u'| + (|coerceInt| + (|objNewWrap| |u'| + (CONS |up| + (CONS |x| (CONS S NIL)))) + |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)) + ('T (SPADLET |var| (|position1| |x| |vl|)) + (SPADLET UPP + (CONS '|UnivariatePolynomial| + (CONS |x| (CONS |source| NIL)))) + (SPADLET |univariate| + (|getFunctionFromDomain| '|univariate| + |source| + (CONS |source| + (CONS + (CONS '|OrderedVariableList| + (CONS |vl| NIL)) + NIL)))) + (SPADLET |upU| (SPADCALL |u| |var| |univariate|)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |upU| UPP) + |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)))))))) ;--% OrderedVariableList ;OV2OV(u,source is [.,svl], target is [.,tvl]) == @@ -3255,18 +3518,19 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN OV2OV (|u| |source| |target|) - (PROG (|tvl| |svl|) - (RETURN - (PROGN - (SPADLET |tvl| (CADR |target|)) - (SPADLET |svl| (CADR |source|)) - (COND - ((BOOT-EQUAL |svl| (|intersection| |svl| |tvl|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (QUOTE T)) - ((QUOTE T) (|position1| (ELT |svl| (SPADDIFFERENCE |u| 1)) |tvl|)))) - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) NIL) - ((QUOTE T) (|coercionFailure|))))))) + (PROG (|tvl| |svl|) + (RETURN + (PROGN + (SPADLET |tvl| (CADR |target|)) + (SPADLET |svl| (CADR |source|)) + (COND + ((BOOT-EQUAL |svl| (|intersection| |svl| |tvl|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) 'T) + ('T + (|position1| (ELT |svl| (SPADDIFFERENCE |u| 1)) |tvl|)))) + ((BOOT-EQUAL |u| '|$fromCoerceable$|) NIL) + ('T (|coercionFailure|))))))) ;OV2P(u,source is [.,svl], target is [.,T]) == ; u = '_$fromCoerceable_$ => true @@ -3274,16 +3538,18 @@ all these coercion functions have the following result: ; [1,v,[1,0,:domainOne(T)]] (DEFUN OV2P (|u| |source| |target|) - (PROG (T$ |svl| |v|) - (RETURN - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET |svl| (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (QUOTE T)) - ((QUOTE T) - (SPADLET |v| (ELT |svl| (SPADDIFFERENCE (|unwrap| |u|) 1))) - (CONS 1 (CONS |v| (CONS (CONS 1 (CONS 0 (|domainOne| T$))) NIL))))))))) + (PROG (T$ |svl| |v|) + (RETURN + (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET |svl| (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) 'T) + ('T + (SPADLET |v| (ELT |svl| (SPADDIFFERENCE (|unwrap| |u|) 1))) + (CONS 1 + (CONS |v| + (CONS (CONS 1 (CONS 0 (|domainOne| T$))) NIL))))))))) ;OV2poly(u,source is [.,svl], target is [p,vl,T]) == ; u = '_$fromCoerceable_$ => @@ -3302,71 +3568,82 @@ all these coercion functions have the following result: ; objValUnwrap(u') (DEFUN |OV2poly| (|u| |source| |target|) - (PROG (|p| |vl| T$ |svl| |v| |val'| |source'| |u'|) - (RETURN - (SEQ - (PROGN - (SPADLET |p| (CAR |target|)) - (SPADLET |vl| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |svl| (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (COND - ((BOOT-EQUAL |p| (QUOTE |UnivariatePolynomial|)) - (AND (EQL (|#| |svl|) 1) (BOOT-EQUAL |p| (ELT |svl| 0)))) - ((QUOTE T) - (PROG (#0=#:G168813) - (SPADLET #0# (QUOTE T)) - (RETURN - (DO ((#1=#:G168819 NIL (NULL #0#)) - (#2=#:G168820 |svl| (CDR #2#)) - (|v| NIL)) - ((OR #1# (ATOM #2#) (PROGN (SETQ |v| (CAR #2#)) NIL)) #0#) - (SEQ (EXIT (SETQ #0# (AND #0# (|member| |v| |vl|))))))))))) - ((QUOTE T) - (SPADLET |v| (ELT |svl| (SPADDIFFERENCE (|unwrap| |u|) 1))) - (SPADLET |val'| (CONS 1 (|domainOne| T$))) - (COND - ((BOOT-EQUAL |p| (QUOTE |UnivariatePolynomial|)) - (COND - ((NEQUAL |v| |vl|) (|coercionFailure|)) - ((QUOTE T) (CONS (CONS 1 (|domainOne| T$)) NIL)))) - ((NULL (|member| |v| |vl|)) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |val'| (CONS (CONS 1 (|domainOne| T$)) NIL)) - (SPADLET |source'| - (CONS (QUOTE |UnivariatePolynomial|) (CONS |v| (CONS T$ NIL)))) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |val'| |source'|) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)))))))))) + (PROG (|p| |vl| T$ |svl| |v| |val'| |source'| |u'|) + (RETURN + (SEQ (PROGN + (SPADLET |p| (CAR |target|)) + (SPADLET |vl| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |svl| (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (COND + ((BOOT-EQUAL |p| '|UnivariatePolynomial|) + (AND (EQL (|#| |svl|) 1) + (BOOT-EQUAL |p| (ELT |svl| 0)))) + ('T + (PROG (G168813) + (SPADLET G168813 'T) + (RETURN + (DO ((G168819 NIL (NULL G168813)) + (G168820 |svl| (CDR G168820)) + (|v| NIL)) + ((OR G168819 (ATOM G168820) + (PROGN (SETQ |v| (CAR G168820)) NIL)) + G168813) + (SEQ (EXIT (SETQ G168813 + (AND G168813 + (|member| |v| |vl|))))))))))) + ('T + (SPADLET |v| + (ELT |svl| (SPADDIFFERENCE (|unwrap| |u|) 1))) + (SPADLET |val'| (CONS 1 (|domainOne| T$))) + (COND + ((BOOT-EQUAL |p| '|UnivariatePolynomial|) + (COND + ((NEQUAL |v| |vl|) (|coercionFailure|)) + ('T (CONS (CONS 1 (|domainOne| T$)) NIL)))) + ((NULL (|member| |v| |vl|)) (|coercionFailure|)) + ('T + (SPADLET |val'| + (CONS (CONS 1 (|domainOne| T$)) NIL)) + (SPADLET |source'| + (CONS '|UnivariatePolynomial| + (CONS |v| (CONS T$ NIL)))) + (OR (SPADLET |u'| + (|coerceInt| + (|objNewWrap| |val'| |source'|) + |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)))))))))) ;OV2SE(u,source is [.,svl], target) == ; u = '_$fromCoerceable_$ => true ; svl.(unwrap(u)-1) (DEFUN OV2SE (|u| |source| |target|) - (PROG (|svl|) - (RETURN - (PROGN - (SPADLET |svl| (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (QUOTE T)) - ((QUOTE T) (ELT |svl| (SPADDIFFERENCE (|unwrap| |u|) 1)))))))) + (DECLARE (IGNORE |target|)) + (PROG (|svl|) + (RETURN + (PROGN + (SPADLET |svl| (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) 'T) + ('T (ELT |svl| (SPADDIFFERENCE (|unwrap| |u|) 1)))))))) ;OV2Sy(u,source is [.,svl], target) == ; u = '_$fromCoerceable_$ => true ; svl.(unwrap(u)-1) (DEFUN |OV2Sy| (|u| |source| |target|) - (PROG (|svl|) - (RETURN - (PROGN - (SPADLET |svl| (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (QUOTE T)) - ((QUOTE T) (ELT |svl| (SPADDIFFERENCE (|unwrap| |u|) 1)))))))) + (DECLARE (IGNORE |target|)) + (PROG (|svl|) + (RETURN + (PROGN + (SPADLET |svl| (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) 'T) + ('T (ELT |svl| (SPADDIFFERENCE (|unwrap| |u|) 1)))))))) ;--% Polynomial ;varsInPoly(u) == @@ -3375,32 +3652,37 @@ all these coercion functions have the following result: ; nil (DEFUN |varsInPoly| (|u|) - (PROG (|ISTMP#1| |v| |termlist| |e| |c|) - (RETURN - (SEQ - (COND - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 1) - (PROGN - (SPADLET |ISTMP#1| (QCDR |u|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |v| (QCAR |ISTMP#1|)) - (SPADLET |termlist| (QCDR |ISTMP#1|)) - (QUOTE T))))) - (PROG (#0=#:G168875) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G168881 |termlist| (CDR #1#)) (#2=#:G168870 NIL)) - ((OR (ATOM #1#) - (PROGN (SETQ #2# (CAR #1#)) NIL) - (PROGN - (PROGN (SPADLET |e| (CAR #2#)) (SPADLET |c| (CDR #2#)) #2#) - NIL)) - #0#) - (SEQ (EXIT (SETQ #0# (APPEND #0# (CONS |v| (|varsInPoly| |c|)))))))))) - ((QUOTE T) NIL)))))) + (PROG (|ISTMP#1| |v| |termlist| |e| |c|) + (RETURN + (SEQ (COND + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 1) + (PROGN + (SPADLET |ISTMP#1| (QCDR |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |v| (QCAR |ISTMP#1|)) + (SPADLET |termlist| (QCDR |ISTMP#1|)) + 'T)))) + (PROG (G168875) + (SPADLET G168875 NIL) + (RETURN + (DO ((G168881 |termlist| (CDR G168881)) + (G168870 NIL)) + ((OR (ATOM G168881) + (PROGN + (SETQ G168870 (CAR G168881)) + NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G168870)) + (SPADLET |c| (CDR G168870)) + G168870) + NIL)) + G168875) + (SEQ (EXIT (SETQ G168875 + (APPEND G168875 + (CONS |v| (|varsInPoly| |c|)))))))))) + ('T NIL)))))) ;P2FR(u,S is [.,R],[.,T]) == ; u = '_$fromCoerceable_$ => @@ -3418,48 +3700,50 @@ all these coercion functions have the following result: ; factor := getFunctionFromDomain('factor,package,[S]) ; SPADCALL(u,factor) -(DEFUN P2FR (|u| S #0=#:G168914) - (PROG (T$ R |ISTMP#1| D |package| |factor|) - (RETURN - (PROGN - (SPADLET T$ (CADR #0#)) - (SPADLET R (CADR S)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (COND - ((NEQUAL S T$) NIL) - ((|member| R (QUOTE ((|Integer|) (|Fraction| (|Integer|))))) (QUOTE T)) - ((QUOTE T) NIL))) - ((NEQUAL S T$) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |package| - (COND - ((BOOT-EQUAL R |$Integer|) - (CONS - (QUOTE |MultivariateFactorize|) - (CONS - |$Symbol| - (CONS - (CONS (QUOTE |IndexedExponents|) (CONS |$Symbol| NIL)) - (CONS R (CONS S NIL)))))) - ((AND (PAIRP R) - (EQ (QCAR R) (QUOTE |Fraction|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR R)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET D (QCAR |ISTMP#1|)) (QUOTE T))))) - (SPADLET |package| - (CONS - (QUOTE |MRationalFactorize|) - (CONS - (CONS (QUOTE |IndexedExponents|) (CONS |$Symbol| NIL)) - (CONS |$Symbol| (CONS D (CONS S NIL))))))) - ((QUOTE T) (|coercionFailure|)))) - (SPADLET |factor| - (|getFunctionFromDomain| (QUOTE |factor|) |package| (CONS S NIL))) - (SPADCALL |u| |factor|))))))) +(DEFUN P2FR (|u| S G168914) + (PROG (T$ R |ISTMP#1| D |package| |factor|) + (DECLARE (SPECIAL |$Symbol| |$Integer|)) + (RETURN + (PROGN + (SPADLET T$ (CADR G168914)) + (SPADLET R (CADR S)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (COND + ((NEQUAL S T$) NIL) + ((|member| R '((|Integer|) (|Fraction| (|Integer|)))) 'T) + ('T NIL))) + ((NEQUAL S T$) (|coercionFailure|)) + ('T + (SPADLET |package| + (COND + ((BOOT-EQUAL R |$Integer|) + (CONS '|MultivariateFactorize| + (CONS |$Symbol| + (CONS + (CONS '|IndexedExponents| + (CONS |$Symbol| NIL)) + (CONS R (CONS S NIL)))))) + ((AND (PAIRP R) (EQ (QCAR R) '|Fraction|) + (PROGN + (SPADLET |ISTMP#1| (QCDR R)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET D (QCAR |ISTMP#1|)) + 'T)))) + (SPADLET |package| + (CONS '|MRationalFactorize| + (CONS + (CONS '|IndexedExponents| + (CONS |$Symbol| NIL)) + (CONS |$Symbol| + (CONS D (CONS S NIL))))))) + ('T (|coercionFailure|)))) + (SPADLET |factor| + (|getFunctionFromDomain| '|factor| |package| + (CONS S NIL))) + (SPADCALL |u| |factor|))))))) ;P2Dmp(u, source is [., S], target is [., y, T]) == ; u = '_$fromCoerceable_$ => @@ -3476,42 +3760,37 @@ all these coercion functions have the following result: ; P2DmpAux(u,source,S,target,copy y,y,T,univariate,plus,monom) (DEFUN |P2Dmp| (|u| |source| |target|) - (PROG (|y| T$ S |c| |u'| |univariate| |plus| |monom|) - (RETURN - (PROGN - (SPADLET |y| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| |source| T$)) - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 0) - (PROGN (SPADLET |c| (QCDR |u|)) (QUOTE T))) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)) - ((QUOTE T) - (SPADLET |univariate| - (|getFunctionFromDomain| - (QUOTE |univariate|) - |source| (CONS |source| (CONS |$Symbol| NIL)))) - (SPADLET |plus| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |monom| - (|getFunctionFromDomain| - (QUOTE |monomial|) - |target| - (CONS - |target| - (CONS - (CONS (QUOTE |OrderedVariableList|) (CONS |y| NIL)) - (CONS |$NonNegativeInteger| NIL))))) - (|P2DmpAux| |u| |source| S |target| (COPY |y|) - |y| T$ |univariate| |plus| |monom|))))))) + (PROG (|y| T$ S |c| |u'| |univariate| |plus| |monom|) + (DECLARE (SPECIAL |$NonNegativeInteger| |$Symbol|)) + (RETURN + (PROGN + (SPADLET |y| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| |source| T$)) + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 0) + (PROGN (SPADLET |c| (QCDR |u|)) 'T)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)) + ('T + (SPADLET |univariate| + (|getFunctionFromDomain| '|univariate| |source| + (CONS |source| (CONS |$Symbol| NIL)))) + (SPADLET |plus| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |monom| + (|getFunctionFromDomain| '|monomial| |target| + (CONS |target| + (CONS (CONS '|OrderedVariableList| + (CONS |y| NIL)) + (CONS |$NonNegativeInteger| NIL))))) + (|P2DmpAux| |u| |source| S |target| (COPY |y|) |y| T$ + |univariate| |plus| |monom|))))))) ;P2Expr(u, source is [.,S], target is [., T]) == ; u = '_$fromCoerceable_$ => @@ -3525,24 +3804,23 @@ all these coercion functions have the following result: ; objValUnwrap val (DEFUN |P2Expr| (|u| |source| |target|) - (PROG (T$ S |newS| |val|) - (RETURN - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| S T$)) - ((BOOT-EQUAL S T$) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |newS| (CONS (QUOTE |Polynomial|) (CONS T$ NIL))) - (SPADLET |val| (|coerceInt| (|objNewWrap| |u| |source|) |newS|)) - (COND - ((NULL |val|) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |val| (|coerceInt| |val| |target|)) + (PROG (T$ S |newS| |val|) + (RETURN + (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET S (CADR |source|)) (COND - ((NULL |val|) (|coercionFailure|)) - ((QUOTE T) (|objValUnwrap| |val|))))))))))) + ((BOOT-EQUAL |u| '|$fromCoerceable$|) (|canCoerce| S T$)) + ((BOOT-EQUAL S T$) (|coercionFailure|)) + ('T (SPADLET |newS| (CONS '|Polynomial| (CONS T$ NIL))) + (SPADLET |val| + (|coerceInt| (|objNewWrap| |u| |source|) |newS|)) + (COND + ((NULL |val|) (|coercionFailure|)) + ('T (SPADLET |val| (|coerceInt| |val| |target|)) + (COND + ((NULL |val|) (|coercionFailure|)) + ('T (|objValUnwrap| |val|))))))))))) ;P2DmpAux(u,source,S,target,varlist,vars,T,univariate,plus,monom) == ; u is [ =0,:c] => -- polynomial is a constant @@ -3572,69 +3850,63 @@ all these coercion functions have the following result: ; u' := SPADCALL(u',u'',plus) ; u' -(DEFUN |P2DmpAux| (|u| |source| S |target| |varlist| |vars| T$ |univariate| - |plus| |monom|) +(DEFUN |P2DmpAux| + (|u| |source| S |target| |varlist| |vars| T$ |univariate| |plus| + |monom|) (PROG (|LETTMP#1| |x| |sup| |ISTMP#1| |var| |e| |c| |u''| |u'|) - (RETURN - (SEQ - (COND - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 0) - (PROGN (SPADLET |c| (QCDR |u|)) (QUOTE T))) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)) - ((NULL |vars|) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |u| |source|) T$)) - (|coercionFailure|)) - (OR - (SPADLET |u'| (|coerceByFunction| |u'| |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)) - ((QUOTE T) - (SPADLET |LETTMP#1| |vars|) - (SPADLET |x| (CAR |LETTMP#1|)) - (SPADLET |vars| (CDR |LETTMP#1|)) - (SPADLET |sup| (SPADCALL |u| |x| |univariate|)) - (COND - ((NULL |sup|) (|domainZero| |target|)) - ((AND - (NULL (CDR |sup|)) - (PROGN - (SPADLET |ISTMP#1| (CAR |sup|)) - (AND - (PAIRP |ISTMP#1|) - (EQUAL (QCAR |ISTMP#1|) 0) - (PROGN (SPADLET |c| (QCDR |ISTMP#1|)) (QUOTE T))))) - (|P2DmpAux| |c| |source| S |target| |varlist| |vars| T$ - |univariate| |plus| |monom|)) - ((QUOTE T) - (SPADLET |var| (|position1| |x| |varlist|)) - (SPADLET |u'| (|domainZero| |target|)) - (DO ((#0=#:G169021 |sup| (CDR #0#)) (#1=#:G169010 NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN - (SPADLET |e| (CAR #1#)) - (SPADLET |c| (CDR #1#)) - #1#) - NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |u''| - (SPADCALL - (|P2DmpAux| |c| |source| S |target| |varlist| |vars| T$ - |univariate| |plus| |monom|) - |var| - |e| - |monom|)) - (SPADLET |u'| (SPADCALL |u'| |u''| |plus|)))))) - |u'|)))))))) + (RETURN + (SEQ (COND + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 0) + (PROGN (SPADLET |c| (QCDR |u|)) 'T)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)) + ((NULL |vars|) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |u| |source|) T$)) + (|coercionFailure|)) + (OR (SPADLET |u'| (|coerceByFunction| |u'| |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)) + ('T (SPADLET |LETTMP#1| |vars|) + (SPADLET |x| (CAR |LETTMP#1|)) + (SPADLET |vars| (CDR |LETTMP#1|)) + (SPADLET |sup| (SPADCALL |u| |x| |univariate|)) + (COND + ((NULL |sup|) (|domainZero| |target|)) + ((AND (NULL (CDR |sup|)) + (PROGN + (SPADLET |ISTMP#1| (CAR |sup|)) + (AND (PAIRP |ISTMP#1|) + (EQUAL (QCAR |ISTMP#1|) 0) + (PROGN (SPADLET |c| (QCDR |ISTMP#1|)) 'T)))) + (|P2DmpAux| |c| |source| S |target| |varlist| |vars| + T$ |univariate| |plus| |monom|)) + ('T (SPADLET |var| (|position1| |x| |varlist|)) + (SPADLET |u'| (|domainZero| |target|)) + (DO ((G169021 |sup| (CDR G169021)) + (G169010 NIL)) + ((OR (ATOM G169021) + (PROGN (SETQ G169010 (CAR G169021)) NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G169010)) + (SPADLET |c| (CDR G169010)) + G169010) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |u''| + (SPADCALL + (|P2DmpAux| |c| |source| S + |target| |varlist| |vars| T$ + |univariate| |plus| |monom|) + |var| |e| |monom|)) + (SPADLET |u'| + (SPADCALL |u'| |u''| |plus|)))))) + |u'|)))))))) + ;P2Mp(u, source is [., S], target is [., y, T]) == ; u = '_$fromCoerceable_$ => @@ -3645,21 +3917,22 @@ all these coercion functions have the following result: ; P2MpAux(u,source,S,target,copy y,y,T,univariate) (DEFUN |P2Mp| (|u| |source| |target|) - (PROG (|y| T$ S |univariate|) - (RETURN - (PROGN - (SPADLET |y| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| |source| T$)) - ((QUOTE T) - (SPADLET |univariate| - (|getFunctionFromDomain| - (QUOTE |univariate|) - |source| - (CONS |source| (CONS |$Symbol| NIL)))) - (|P2MpAux| |u| |source| S |target| (COPY |y|) |y| T$ |univariate|))))))) + (PROG (|y| T$ S |univariate|) + (DECLARE (SPECIAL |$Symbol|)) + (RETURN + (PROGN + (SPADLET |y| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| |source| T$)) + ('T + (SPADLET |univariate| + (|getFunctionFromDomain| '|univariate| |source| + (CONS |source| (CONS |$Symbol| NIL)))) + (|P2MpAux| |u| |source| S |target| (COPY |y|) |y| T$ + |univariate|))))))) ;P2MpAux(u,source,S,target,varlist,vars,T,univariate) == ; u is [ =0,:c] => -- polynomial is a constant @@ -3685,62 +3958,63 @@ all these coercion functions have the following result: ; [e,:c] in sup] ; [1, position1(x,varlist), :terms] -(DEFUN |P2MpAux| (|u| |source| S |target| |varlist| |vars| T$ |univariate|) - (PROG (|u'| |LETTMP#1| |x| |sup| |ISTMP#1| |e| |c| |terms|) - (RETURN - (SEQ - (COND - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 0) - (PROGN (SPADLET |c| (QCDR |u|)) (QUOTE T))) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)) - ((NULL |vars|) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |u| |source|) T$)) - (|coercionFailure|)) - (CONS 0 (|objValUnwrap| |u'|))) - ((QUOTE T) - (SPADLET |LETTMP#1| |vars|) - (SPADLET |x| (CAR |LETTMP#1|)) - (SPADLET |vars| (CDR |LETTMP#1|)) - (SPADLET |sup| (SPADCALL |u| |x| |univariate|)) - (COND - ((NULL |sup|) (|domainZero| |target|)) - ((AND (NULL (CDR |sup|)) - (PROGN - (SPADLET |ISTMP#1| (CAR |sup|)) - (AND - (PAIRP |ISTMP#1|) - (EQUAL (QCAR |ISTMP#1|) 0) - (PROGN (SPADLET |c| (QCDR |ISTMP#1|)) (QUOTE T))))) - (|P2MpAux| |c| |source| S |target| |varlist| |vars| T$ |univariate|)) - ((QUOTE T) - (SPADLET |terms| - (PROG (#0=#:G169095) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G169101 |sup| (CDR #1#)) (#2=#:G169085 NIL)) - ((OR (ATOM #1#) - (PROGN (SETQ #2# (CAR #1#)) NIL) - (PROGN - (PROGN - (SPADLET |e| (CAR #2#)) - (SPADLET |c| (CDR #2#)) - #2#) - NIL)) - (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS - (CONS |e| - (|P2MpAux| |c| |source| S |target| |varlist| - |vars| T$ |univariate|)) - #0#)))))))) - (CONS 1 (CONS (|position1| |x| |varlist|) |terms|)))))))))) +(DEFUN |P2MpAux| + (|u| |source| S |target| |varlist| |vars| T$ |univariate|) + (PROG (|u'| |LETTMP#1| |x| |sup| |ISTMP#1| |e| |c| |terms|) + (RETURN + (SEQ (COND + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 0) + (PROGN (SPADLET |c| (QCDR |u|)) 'T)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)) + ((NULL |vars|) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |u| |source|) T$)) + (|coercionFailure|)) + (CONS 0 (|objValUnwrap| |u'|))) + ('T (SPADLET |LETTMP#1| |vars|) + (SPADLET |x| (CAR |LETTMP#1|)) + (SPADLET |vars| (CDR |LETTMP#1|)) + (SPADLET |sup| (SPADCALL |u| |x| |univariate|)) + (COND + ((NULL |sup|) (|domainZero| |target|)) + ((AND (NULL (CDR |sup|)) + (PROGN + (SPADLET |ISTMP#1| (CAR |sup|)) + (AND (PAIRP |ISTMP#1|) + (EQUAL (QCAR |ISTMP#1|) 0) + (PROGN (SPADLET |c| (QCDR |ISTMP#1|)) 'T)))) + (|P2MpAux| |c| |source| S |target| |varlist| |vars| T$ + |univariate|)) + ('T + (SPADLET |terms| + (PROG (G169095) + (SPADLET G169095 NIL) + (RETURN + (DO ((G169101 |sup| (CDR G169101)) + (G169085 NIL)) + ((OR (ATOM G169101) + (PROGN + (SETQ G169085 (CAR G169101)) + NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G169085)) + (SPADLET |c| (CDR G169085)) + G169085) + NIL)) + (NREVERSE0 G169095)) + (SEQ (EXIT + (SETQ G169095 + (CONS + (CONS |e| + (|P2MpAux| |c| |source| S + |target| |varlist| |vars| T$ + |univariate|)) + G169095)))))))) + (CONS 1 (CONS (|position1| |x| |varlist|) |terms|)))))))))) ;varIsOnlyVarInPoly(u, var) == ; u is [ =1, v, :termlist] => @@ -3749,40 +4023,42 @@ all these coercion functions have the following result: ; true (DEFUN |varIsOnlyVarInPoly| (|u| |var|) - (PROG (|ISTMP#1| |v| |termlist| |e| |c|) - (RETURN - (SEQ - (COND - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 1) - (PROGN - (SPADLET |ISTMP#1| (QCDR |u|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |v| (QCAR |ISTMP#1|)) - (SPADLET |termlist| (QCDR |ISTMP#1|)) - (QUOTE T))))) - (COND - ((NEQUAL |v| |var|) NIL) - ((QUOTE T) - (PROG (#0=#:G169138) - (SPADLET #0# (QUOTE T)) - (RETURN - (DO ((#1=#:G169145 NIL (NULL #0#)) - (#2=#:G169146 |termlist| (CDR #2#)) - (#3=#:G169132 NIL)) - ((OR #1# - (ATOM #2#) - (PROGN (SETQ #3# (CAR #2#)) NIL) + (PROG (|ISTMP#1| |v| |termlist| |e| |c|) + (RETURN + (SEQ (COND + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 1) (PROGN - (PROGN (SPADLET |e| (CAR #3#)) (SPADLET |c| (CDR #3#)) #3#) - NIL)) - #0#) - (SEQ - (EXIT - (SETQ #0# (AND #0# (|varIsOnlyVarInPoly| |c| |var|))))))))))) - ((QUOTE T) (QUOTE T))))))) + (SPADLET |ISTMP#1| (QCDR |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |v| (QCAR |ISTMP#1|)) + (SPADLET |termlist| (QCDR |ISTMP#1|)) + 'T)))) + (COND + ((NEQUAL |v| |var|) NIL) + ('T + (PROG (G169138) + (SPADLET G169138 'T) + (RETURN + (DO ((G169145 NIL (NULL G169138)) + (G169146 |termlist| (CDR G169146)) + (G169132 NIL)) + ((OR G169145 (ATOM G169146) + (PROGN + (SETQ G169132 (CAR G169146)) + NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G169132)) + (SPADLET |c| (CDR G169132)) + G169132) + NIL)) + G169138) + (SEQ (EXIT (SETQ G169138 + (AND G169138 + (|varIsOnlyVarInPoly| |c| + |var|))))))))))) + ('T 'T)))))) ;P2Up(u,source is [.,S],target is [.,x,T]) == ; u = '_$fromCoerceable_$ => canCoerce(source,T) @@ -3804,49 +4080,46 @@ all these coercion functions have the following result: ; objValUnwrap(u') (DEFUN |P2Up| (|u| |source| |target|) - (PROG (|x| T$ S |c| |varsFun| |vars| UPP |univariate| |upU| |u'|) - (RETURN - (PROGN - (SPADLET |x| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| |source| T$)) - ((AND (PAIRP |u|) - (EQUAL (QCAR |u|) 0) - (PROGN (SPADLET |c| (QCDR |u|)) (QUOTE T))) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)) - ((QUOTE T) - (SPADLET |varsFun| - (|getFunctionFromDomain| - (QUOTE |variables|) - |source| - (CONS |source| NIL))) - (SPADLET |vars| (SPADCALL |u| |varsFun|)) - (COND - ((NULL (|member| |x| |vars|)) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |u| |source|) T$)) - (|coercionFailure|)) - (CONS (CONS 0 (|objValUnwrap| |u'|)) NIL)) - ((QUOTE T) - (SPADLET UPP - (CONS - (QUOTE |UnivariatePolynomial|) - (CONS |x| (CONS |source| NIL)))) - (SPADLET |univariate| - (|getFunctionFromDomain| - (QUOTE |univariate|) - |source| - (CONS |source| (CONS |$Symbol| NIL)))) - (SPADLET |upU| (SPADCALL |u| |x| |univariate|)) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |upU| UPP) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|))))))))) + (PROG (|x| T$ S |c| |varsFun| |vars| UPP |univariate| |upU| |u'|) + (DECLARE (SPECIAL |$Symbol|)) + (RETURN + (PROGN + (SPADLET |x| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| |source| T$)) + ((AND (PAIRP |u|) (EQUAL (QCAR |u|) 0) + (PROGN (SPADLET |c| (QCDR |u|)) 'T)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)) + ('T + (SPADLET |varsFun| + (|getFunctionFromDomain| '|variables| |source| + (CONS |source| NIL))) + (SPADLET |vars| (SPADCALL |u| |varsFun|)) + (COND + ((NULL (|member| |x| |vars|)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |u| |source|) T$)) + (|coercionFailure|)) + (CONS (CONS 0 (|objValUnwrap| |u'|)) NIL)) + ('T + (SPADLET UPP + (CONS '|UnivariatePolynomial| + (CONS |x| (CONS |source| NIL)))) + (SPADLET |univariate| + (|getFunctionFromDomain| '|univariate| |source| + (CONS |source| (CONS |$Symbol| NIL)))) + (SPADLET |upU| (SPADCALL |u| |x| |univariate|)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |upU| UPP) + |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|))))))))) ;--% Fraction ;Qf2PF(u,source is [.,D],target) == @@ -3862,27 +4135,29 @@ all these coercion functions have the following result: ; SPADCALL(num',den', getFunctionFromDomain("/",target,[target,target])) (DEFUN |Qf2PF| (|u| |source| |target|) - (PROG (D |num| |den| |num'| |den'|) - (RETURN - (PROGN - (SPADLET D (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| D |target|)) - ((QUOTE T) - (SPADLET |num| (CAR |u|)) - (SPADLET |den| (CDR |u|)) - (SPADLET |num'| - (OR (|coerceInt| (|objNewWrap| |num| D) |target|) (|coercionFailure|))) - (SPADLET |num'| (|objValUnwrap| |num'|)) - (SPADLET |den'| - (OR (|coerceInt| (|objNewWrap| |den| D) |target|) (|coercionFailure|))) - (SPADLET |den'| (|objValUnwrap| |den'|)) - (COND - ((|equalZero| |den'| |target|) (|throwKeyedMsg| (QUOTE S2IA0001) NIL)) - ((QUOTE T) - (SPADCALL |num'| |den'| - (|getFunctionFromDomain| (QUOTE /) |target| - (CONS |target| (CONS |target| NIL)))))))))))) + (PROG (D |num| |den| |num'| |den'|) + (RETURN + (PROGN + (SPADLET D (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| D |target|)) + ('T (SPADLET |num| (CAR |u|)) (SPADLET |den| (CDR |u|)) + (SPADLET |num'| + (OR (|coerceInt| (|objNewWrap| |num| D) |target|) + (|coercionFailure|))) + (SPADLET |num'| (|objValUnwrap| |num'|)) + (SPADLET |den'| + (OR (|coerceInt| (|objNewWrap| |den| D) |target|) + (|coercionFailure|))) + (SPADLET |den'| (|objValUnwrap| |den'|)) + (COND + ((|equalZero| |den'| |target|) + (|throwKeyedMsg| 'S2IA0001 NIL)) + ('T + (SPADCALL |num'| |den'| + (|getFunctionFromDomain| '/ |target| + (CONS |target| (CONS |target| NIL)))))))))))) ;Qf2F(u,source is [.,D,:.],target) == ; D = $Integer => @@ -3895,34 +4170,36 @@ all these coercion functions have the following result: ; [.,:den']:= coerceInt(objNewWrap(den,D),target) or ; coercionFailure() ; (unwrap num') * 1.0 / (unwrap den') - (DEFUN |Qf2F| (|u| |source| |target|) - (PROG (D |num| |den| |num'| |LETTMP#1| |den'|) - (RETURN - (PROGN - (SPADLET D (CADR |source|)) - (COND - ((BOOT-EQUAL D |$Integer|) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (QUOTE T)) - ((QUOTE T) (|Rn2F| |u| |source| |target|)))) - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| D |target|)) - ((QUOTE T) - (SPADLET |num| (CAR |u|)) - (SPADLET |den| (CDR |u|)) - (SPADLET |LETTMP#1| - (OR (|coerceInt| (|objNewWrap| |num| D) |target|) (|coercionFailure|))) - (SPADLET |num'| (CDR |LETTMP#1|)) - (SPADLET |LETTMP#1| - (OR (|coerceInt| (|objNewWrap| |den| D) |target|) (|coercionFailure|))) - (SPADLET |den'| (CDR |LETTMP#1|)) - (QUOTIENT (TIMES (|unwrap| |num'|) 1.0) (|unwrap| |den'|)))))))) + (PROG (D |num| |den| |num'| |LETTMP#1| |den'|) + (DECLARE (SPECIAL |$Integer|)) + (RETURN + (PROGN + (SPADLET D (CADR |source|)) + (COND + ((BOOT-EQUAL D |$Integer|) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) 'T) + ('T (|Rn2F| |u| |source| |target|)))) + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| D |target|)) + ('T (SPADLET |num| (CAR |u|)) (SPADLET |den| (CDR |u|)) + (SPADLET |LETTMP#1| + (OR (|coerceInt| (|objNewWrap| |num| D) |target|) + (|coercionFailure|))) + (SPADLET |num'| (CDR |LETTMP#1|)) + (SPADLET |LETTMP#1| + (OR (|coerceInt| (|objNewWrap| |den| D) |target|) + (|coercionFailure|))) + (SPADLET |den'| (CDR |LETTMP#1|)) + (QUOTIENT (TIMES (|unwrap| |num'|) 1.0) (|unwrap| |den'|)))))))) ;Rn2F(rnum, source, target) == ; float(CAR(rnum)/CDR(rnum)) (DEFUN |Rn2F| (|rnum| |source| |target|) - (|float| (QUOTIENT (CAR |rnum|) (CDR |rnum|)))) + (DECLARE (IGNORE |source| |target|)) + (|float| (QUOTIENT (CAR |rnum|) (CDR |rnum|)))) ;-- next function is needed in RN algebra code ;--Rn2F([a,:b],source,target) == @@ -3960,82 +4237,80 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |Qf2domain| (|u| |source| |target|) - (PROG (D |ut| |useUnder| |num| |den| |num'| |ISTMP#1| |ISTMP#2| |ISTMP#3| - |ISTMP#4| T$ |den'| |timesfunc|) - (RETURN - (PROGN - (SPADLET D (CADR |source|)) - (SPADLET |useUnder| - (AND - (SPADLET |ut| (|underDomainOf| |target|)) - (|canCoerce| |source| |ut|))) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) |useUnder|) - ((AND - (NULL (AND (|containsPolynomial| D) (|containsPolynomial| |target|))) - |useUnder|) - (|coercionFailure|)) - ((QUOTE T) - (SPADLET |num| (CAR |u|)) - (SPADLET |den| (CDR |u|)) - (OR - (SPADLET |num'| (|coerceInt| (|objNewWrap| |num| D) |target|)) - (|coercionFailure|)) - (SPADLET |num'| (|objValUnwrap| |num'|)) - (COND - ((|equalOne| |den| D) |num'|) - ((OR - (AND - (PAIRP |target|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |target|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQUAL (QCAR |ISTMP#2|) |$QuotientField|) - (PROGN - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND - (PAIRP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (PROGN (SPADLET T$ (QCAR |ISTMP#3|)) (QUOTE T))))))))) - (AND - (PAIRP |target|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |target|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) - (AND - (PAIRP |ISTMP#3|) - (EQUAL (QCAR |ISTMP#3|) |$QuotientField|) - (PROGN - (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) - (AND - (PAIRP |ISTMP#4|) - (EQ (QCDR |ISTMP#4|) NIL) - (PROGN (SPADLET T$ (QCAR |ISTMP#4|)) (QUOTE T)))))))))))) - (OR - (SPADLET |den'| (|coerceInt| (|objNewWrap| |den| D) T$)) - (|coercionFailure|)) - (SPADLET |den'| (CONS (|domainOne| T$) (|objValUnwrap| |den'|))) - (SPADLET |timesfunc| - (|getFunctionFromDomain| - (QUOTE *) - |target| - (CONS (CONS |$QuotientField| (CONS T$ NIL)) (CONS |target| NIL)))) - (SPADCALL |den'| |num'| |timesfunc|)) - ((QUOTE T) (|coercionFailure|))))))))) + (PROG (D |ut| |useUnder| |num| |den| |num'| |ISTMP#1| |ISTMP#2| + |ISTMP#3| |ISTMP#4| T$ |den'| |timesfunc|) + (DECLARE (SPECIAL |$QuotientField|)) + (RETURN + (PROGN + (SPADLET D (CADR |source|)) + (SPADLET |useUnder| + (AND (SPADLET |ut| (|underDomainOf| |target|)) + (|canCoerce| |source| |ut|))) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) |useUnder|) + ((AND (NULL (AND (|containsPolynomial| D) + (|containsPolynomial| |target|))) + |useUnder|) + (|coercionFailure|)) + ('T (SPADLET |num| (CAR |u|)) (SPADLET |den| (CDR |u|)) + (OR (SPADLET |num'| + (|coerceInt| (|objNewWrap| |num| D) |target|)) + (|coercionFailure|)) + (SPADLET |num'| (|objValUnwrap| |num'|)) + (COND + ((|equalOne| |den| D) |num'|) + ((OR (AND (PAIRP |target|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |target|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQUAL (QCAR |ISTMP#2|) + |$QuotientField|) + (PROGN + (SPADLET |ISTMP#3| + (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (EQ (QCDR |ISTMP#3|) NIL) + (PROGN + (SPADLET T$ (QCAR |ISTMP#3|)) + 'T)))))))) + (AND (PAIRP |target|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |target|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |ISTMP#3| + (QCAR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (EQUAL (QCAR |ISTMP#3|) + |$QuotientField|) + (PROGN + (SPADLET |ISTMP#4| + (QCDR |ISTMP#3|)) + (AND (PAIRP |ISTMP#4|) + (EQ (QCDR |ISTMP#4|) NIL) + (PROGN + (SPADLET T$ + (QCAR |ISTMP#4|)) + 'T))))))))))) + (OR (SPADLET |den'| + (|coerceInt| (|objNewWrap| |den| D) T$)) + (|coercionFailure|)) + (SPADLET |den'| + (CONS (|domainOne| T$) (|objValUnwrap| |den'|))) + (SPADLET |timesfunc| + (|getFunctionFromDomain| '* |target| + (CONS (CONS |$QuotientField| (CONS T$ NIL)) + (CONS |target| NIL)))) + (SPADCALL |den'| |num'| |timesfunc|)) + ('T (|coercionFailure|))))))))) ;Qf2EF(u,[.,S],target) == ; u = '_$fromCoerceable_$ => canCoerce(S,target) @@ -4047,31 +4322,26 @@ all these coercion functions have the following result: ; divfun := getFunctionFromDomain("/",target,[target,target]) ; SPADCALL(objValUnwrap(num'),objValUnwrap(den'),divfun) -(DEFUN |Qf2EF| (|u| #0=#:G169372 |target|) - (PROG (S |num| |den| |num'| |den'| |divfun|) - (RETURN - (PROGN - (SPADLET S (CADR #0#)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| S |target|)) - ((QUOTE T) - (SPADLET |num| (CAR |u|)) - (SPADLET |den| (CDR |u|)) - (OR - (SPADLET |num'| (|coerceInt| (|objNewWrap| |num| S) |target|)) - (|coercionFailure|)) - (OR - (SPADLET |den'| (|coerceInt| (|objNewWrap| |den| S) |target|)) - (|coercionFailure|)) - (SPADLET |divfun| - (|getFunctionFromDomain| - (QUOTE /) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADCALL - (|objValUnwrap| |num'|) - (|objValUnwrap| |den'|) - |divfun|))))))) +(DEFUN |Qf2EF| (|u| G169372 |target|) + (PROG (S |num| |den| |num'| |den'| |divfun|) + (RETURN + (PROGN + (SPADLET S (CADR G169372)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| S |target|)) + ('T (SPADLET |num| (CAR |u|)) (SPADLET |den| (CDR |u|)) + (OR (SPADLET |num'| + (|coerceInt| (|objNewWrap| |num| S) |target|)) + (|coercionFailure|)) + (OR (SPADLET |den'| + (|coerceInt| (|objNewWrap| |den| S) |target|)) + (|coercionFailure|)) + (SPADLET |divfun| + (|getFunctionFromDomain| '/ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADCALL (|objValUnwrap| |num'|) (|objValUnwrap| |den'|) + |divfun|))))))) ;Qf2Qf(u0,[.,S],target is [.,T]) == ; u0 = '_$fromCoerceable_$ => @@ -4093,51 +4363,52 @@ all these coercion functions have the following result: ; coercionFailure() ; coercionFailure() -(DEFUN |Qf2Qf| (|u0| #0=#:G169409 |target|) - (PROG (S T$ |a| |b| |divfunc| |a'| |b'|) - (RETURN - (PROGN - (SPADLET S (CADR #0#)) - (SPADLET T$ (CADR |target|)) - (COND - ((BOOT-EQUAL |u0| (QUOTE |$fromCoerceable$|)) - (COND - ((AND - (BOOT-EQUAL S - (CONS - (QUOTE |Polynomial|) - (CONS (CONS |$QuotientField| (CONS |$Integer| NIL)) NIL))) - (BOOT-EQUAL T$ (QUOTE (|Polynomial| (|Integer|))))) - (QUOTE T)) - ((QUOTE T) (|canCoerce| S T$)))) - ((QUOTE T) - (SPADLET |a| (CAR |u0|)) - (SPADLET |b| (CDR |u0|)) - (COND - ((AND - (BOOT-EQUAL S - (CONS - (QUOTE |Polynomial|) - (CONS (CONS |$QuotientField| (CONS |$Integer| NIL)) NIL))) - (BOOT-EQUAL T$ (QUOTE (|Polynomial| (|Integer|))))) - (COND - ((SPADLET |a'| (|coerceInt| (|objNewWrap| |a| S) |target|)) - (COND - ((SPADLET |b'| (|coerceInt| (|objNewWrap| |b| S) |target|)) - (SPADLET |divfunc| - (|getFunctionFromDomain| - (QUOTE /) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADCALL (|objValUnwrap| |a'|) (|objValUnwrap| |b'|) |divfunc|)) - ((QUOTE T) (|coercionFailure|)))) - ((QUOTE T) (|coercionFailure|)))) - ((SPADLET |a'| (|coerceInt| (|objNewWrap| |a| S) T$)) +(DEFUN |Qf2Qf| (|u0| G169409 |target|) + (PROG (S T$ |a| |b| |divfunc| |a'| |b'|) + (DECLARE (SPECIAL |$QuotientField| |$Integer|)) + (RETURN + (PROGN + (SPADLET S (CADR G169409)) + (SPADLET T$ (CADR |target|)) (COND - ((SPADLET |b'| (|coerceInt| (|objNewWrap| |b| S) T$)) - (CONS (|objValUnwrap| |a'|) (|objValUnwrap| |b'|))) - ((QUOTE T) (|coercionFailure|)))) - ((QUOTE T) (|coercionFailure|))))))))) + ((BOOT-EQUAL |u0| '|$fromCoerceable$|) + (COND + ((AND (BOOT-EQUAL S + (CONS '|Polynomial| + (CONS (CONS |$QuotientField| + (CONS |$Integer| NIL)) + NIL))) + (BOOT-EQUAL T$ '(|Polynomial| (|Integer|)))) + 'T) + ('T (|canCoerce| S T$)))) + ('T (SPADLET |a| (CAR |u0|)) (SPADLET |b| (CDR |u0|)) + (COND + ((AND (BOOT-EQUAL S + (CONS '|Polynomial| + (CONS (CONS |$QuotientField| + (CONS |$Integer| NIL)) + NIL))) + (BOOT-EQUAL T$ '(|Polynomial| (|Integer|)))) + (COND + ((SPADLET |a'| + (|coerceInt| (|objNewWrap| |a| S) |target|)) + (COND + ((SPADLET |b'| + (|coerceInt| (|objNewWrap| |b| S) + |target|)) + (SPADLET |divfunc| + (|getFunctionFromDomain| '/ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADCALL (|objValUnwrap| |a'|) + (|objValUnwrap| |b'|) |divfunc|)) + ('T (|coercionFailure|)))) + ('T (|coercionFailure|)))) + ((SPADLET |a'| (|coerceInt| (|objNewWrap| |a| S) T$)) + (COND + ((SPADLET |b'| (|coerceInt| (|objNewWrap| |b| S) T$)) + (CONS (|objValUnwrap| |a'|) (|objValUnwrap| |b'|))) + ('T (|coercionFailure|)))) + ('T (|coercionFailure|))))))))) ;-- partOf(x,i) == ;-- VECP x => x.i @@ -4147,22 +4418,22 @@ all these coercion functions have the following result: ;--% RectangularMatrix ;Rm2L(x,[.,.,.,R],target) == M2L(x,['Matrix,R],target) -(DEFUN |Rm2L| (|x| #0=#:G169434 |target|) - (PROG (R) - (RETURN - (PROGN - (SPADLET R (CADDDR #0#)) - (M2L |x| (CONS (QUOTE |Matrix|) (CONS R NIL)) |target|))))) +(DEFUN |Rm2L| (|x| G169434 |target|) + (PROG (R) + (RETURN + (PROGN + (SPADLET R (CADDDR G169434)) + (M2L |x| (CONS '|Matrix| (CONS R NIL)) |target|))))) ;Rm2M(x,[.,.,.,R],target is [.,S]) == M2M(x,[nil,R],target) -(DEFUN |Rm2M| (|x| #0=#:G169451 |target|) - (PROG (R S) - (RETURN - (PROGN - (SPADLET R (CADDDR #0#)) - (SPADLET S (CADR |target|)) - (M2M |x| (CONS NIL (CONS R NIL)) |target|))))) +(DEFUN |Rm2M| (|x| G169451 |target|) + (PROG (R S) + (RETURN + (PROGN + (SPADLET R (CADDDR G169451)) + (SPADLET S (CADR |target|)) + (M2M |x| (CONS NIL (CONS R NIL)) |target|))))) ;Rm2Sm(x,[.,n,m,S],[.,p,R]) == ; x = '_$fromCoerceable_$ => n=m and m=p and canCoerce(S,R) @@ -4170,30 +4441,31 @@ all these coercion functions have the following result: ; M2M(x,[nil,S],[nil,R]) ; coercionFailure() -(DEFUN |Rm2Sm| (|x| #0=#:G169467 #1=#:G169478) - (PROG (|p| R |n| |m| S) - (RETURN - (PROGN - (SPADLET |p| (CADR #1#)) - (SPADLET R (CADDR #1#)) - (SPADLET |n| (CADR #0#)) - (SPADLET |m| (CADDR #0#)) - (SPADLET S (CADDDR #0#)) - (COND - ((BOOT-EQUAL |x| (QUOTE |$fromCoerceable$|)) - (AND (BOOT-EQUAL |n| |m|) (BOOT-EQUAL |m| |p|) (|canCoerce| S R))) - ((AND (BOOT-EQUAL |n| |m|) (BOOT-EQUAL |m| |p|)) - (M2M |x| (CONS NIL (CONS S NIL)) (CONS NIL (CONS R NIL)))) - ((QUOTE T) (|coercionFailure|))))))) +(DEFUN |Rm2Sm| (|x| G169467 G169478) + (PROG (|p| R |n| |m| S) + (RETURN + (PROGN + (SPADLET |p| (CADR G169478)) + (SPADLET R (CADDR G169478)) + (SPADLET |n| (CADR G169467)) + (SPADLET |m| (CADDR G169467)) + (SPADLET S (CADDDR G169467)) + (COND + ((BOOT-EQUAL |x| '|$fromCoerceable$|) + (AND (BOOT-EQUAL |n| |m|) (BOOT-EQUAL |m| |p|) + (|canCoerce| S R))) + ((AND (BOOT-EQUAL |n| |m|) (BOOT-EQUAL |m| |p|)) + (M2M |x| (CONS NIL (CONS S NIL)) (CONS NIL (CONS R NIL)))) + ('T (|coercionFailure|))))))) ;Rm2V(x,[.,.,.,R],target) == M2V(x,['Matrix,R],target) -(DEFUN |Rm2V| (|x| #0=#:G169500 |target|) - (PROG (R) - (RETURN - (PROGN - (SPADLET R (CADDDR #0#)) - (M2V |x| (CONS (QUOTE |Matrix|) (CONS R NIL)) |target|))))) +(DEFUN |Rm2V| (|x| G169500 |target|) + (PROG (R) + (RETURN + (PROGN + (SPADLET R (CADDDR G169500)) + (M2V |x| (CONS '|Matrix| (CONS R NIL)) |target|))))) ;--% Script ;Scr2Scr(u, source is [.,S], target is [.,T]) == @@ -4203,16 +4475,17 @@ all these coercion functions have the following result: ; [CAR u, :objValUnwrap(v)] (DEFUN |Scr2Scr| (|u| |source| |target|) - (PROG (T$ S |v|) - (RETURN - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| S T$)) - ((NULL (SPADLET |v| (|coerceInt| (|objNewWrap| (CDR |u|) S) T$))) - (|coercionFailure|)) - ((QUOTE T) (CONS (CAR |u|) (|objValUnwrap| |v|)))))))) + (PROG (T$ S |v|) + (RETURN + (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) (|canCoerce| S T$)) + ((NULL (SPADLET |v| + (|coerceInt| (|objNewWrap| (CDR |u|) S) T$))) + (|coercionFailure|)) + ('T (CONS (CAR |u|) (|objValUnwrap| |v|)))))))) ;--% SparseUnivariatePolynomialnimial ;SUP2Up(u,source is [.,S],target is [.,x,T]) == @@ -4233,60 +4506,67 @@ all these coercion functions have the following result: ; [[0,:objValUnwrap u']] (DEFUN |SUP2Up| (|u| |source| |target|) - (PROG (|x| T$ S |zero| |e| |c| |c'| |u'|) - (RETURN - (SEQ - (PROGN - (SPADLET |x| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (OR (|canCoerce| |source| T$) (|canCoerce| S T$))) - ((NULL |u|) |u|) - ((BOOT-EQUAL S T$) |u|) - ((NULL (SPADLET |u'| (|coerceInt| (|objNewWrap| |u| |source|) T$))) - (SPADLET |u'| NIL) - (SPADLET |zero| (|getConstantFromDomain| (QUOTE (|Zero|)) T$)) - (DO ((#0=#:G169569 |u| (CDR #0#)) (#1=#:G169534 NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN (SPADLET |e| (CAR #1#)) (SPADLET |c| (CDR #1#)) #1#) - NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |c'| - (|objValUnwrap| - (OR (|coerceInt| (|objNewWrap| |c| S) T$) (|coercionFailure|)))) - (COND - ((BOOT-EQUAL |c'| |zero|) (QUOTE |iterate|)) - ((QUOTE T) (SPADLET |u'| (CONS (CONS |e| |c'|) |u'|)))))))) - (NREVERSE |u'|)) - ((QUOTE T) (CONS (CONS 0 (|objValUnwrap| |u'|)) NIL)))))))) + (PROG (|x| T$ S |zero| |e| |c| |c'| |u'|) + (RETURN + (SEQ (PROGN + (SPADLET |x| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET S (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (OR (|canCoerce| |source| T$) (|canCoerce| S T$))) + ((NULL |u|) |u|) + ((BOOT-EQUAL S T$) |u|) + ((NULL (SPADLET |u'| + (|coerceInt| (|objNewWrap| |u| |source|) + T$))) + (SPADLET |u'| NIL) + (SPADLET |zero| (|getConstantFromDomain| '(|Zero|) T$)) + (DO ((G169569 |u| (CDR G169569)) (G169534 NIL)) + ((OR (ATOM G169569) + (PROGN (SETQ G169534 (CAR G169569)) NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G169534)) + (SPADLET |c| (CDR G169534)) + G169534) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |c'| + (|objValUnwrap| + (OR + (|coerceInt| + (|objNewWrap| |c| S) T$) + (|coercionFailure|)))) + (COND + ((BOOT-EQUAL |c'| |zero|) '|iterate|) + ('T + (SPADLET |u'| + (CONS (CONS |e| |c'|) |u'|)))))))) + (NREVERSE |u'|)) + ('T (CONS (CONS 0 (|objValUnwrap| |u'|)) NIL)))))))) ;--% SquareMatrix ;Sm2L(x,[.,.,R],target) == M2L(x,['Matrix,R],target) -(DEFUN |Sm2L| (|x| #0=#:G169589 |target|) - (PROG (R) - (RETURN - (PROGN - (SPADLET R (CADDR #0#)) - (M2L |x| (CONS (QUOTE |Matrix|) (CONS R NIL)) |target|))))) +(DEFUN |Sm2L| (|x| G169589 |target|) + (PROG (R) + (RETURN + (PROGN + (SPADLET R (CADDR G169589)) + (M2L |x| (CONS '|Matrix| (CONS R NIL)) |target|))))) ;Sm2M(x,[.,n,R],target is [.,S]) == M2M(x,[nil,R],target) -(DEFUN |Sm2M| (|x| #0=#:G169606 |target|) - (PROG (|n| R S) - (RETURN - (PROGN - (SPADLET |n| (CADR #0#)) - (SPADLET R (CADDR #0#)) - (SPADLET S (CADR |target|)) - (M2M |x| (CONS NIL (CONS R NIL)) |target|))))) +(DEFUN |Sm2M| (|x| G169606 |target|) + (PROG (|n| R S) + (RETURN + (PROGN + (SPADLET |n| (CADR G169606)) + (SPADLET R (CADDR G169606)) + (SPADLET S (CADR |target|)) + (M2M |x| (CONS NIL (CONS R NIL)) |target|))))) ;Sm2PolyType(u,source is [sm,n,S], target is [pol,vl,T]) == ; -- only really handles cases like: @@ -4315,68 +4595,86 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |Sm2PolyType| (|u| |source| |target|) - (PROG (|pol| |vl| T$ |sm| |n| S |ISTMP#1| |S'| |vl'| |varsUsed| - |novars| |source'| |u'|) - (RETURN - (SEQ - (PROGN - (SPADLET |pol| (CAR |target|)) - (SPADLET |vl| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |sm| (CAR |source|)) - (SPADLET |n| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| |source| T$)) - ((AND (PAIRP S) - (EQ (QCAR S) (QUOTE |Polynomial|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR S)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |S'| (QCAR |ISTMP#1|)) (QUOTE T))))) - (COND - ((ATOM |vl|) (SPADLET |vl'| (CONS |vl| NIL))) - ((QUOTE T) (SPADLET |vl'| |vl|))) - (SPADLET |novars| (QUOTE T)) - (DO ((#0=#:G169670 (SPADDIFFERENCE |n| 1)) (|i| 0 (QSADD1 |i|))) - ((OR (QSGREATERP |i| #0#) (NULL |novars|)) NIL) - (SEQ - (EXIT - (DO ((#1=#:G169681 (SPADDIFFERENCE |n| 1)) (|j| 0 (QSADD1 |j|))) - ((OR (QSGREATERP |j| #1#) (NULL |novars|)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |varsUsed| (|varsInPoly| (ELT (ELT |u| |i|) |j|))) - (COND - ((PROG (#2=#:G169686) - (SPADLET #2# NIL) - (RETURN - (DO ((#3=#:G169692 NIL #2#) - (#4=#:G169693 |vl'| (CDR #4#)) - (|x| NIL)) - ((OR #3# (ATOM #4#) (PROGN (SETQ |x| (CAR #4#)) NIL)) - #2#) - (SEQ - (EXIT - (SETQ #2# (OR #2# (|member| |x| |varsUsed|)))))))) - (SPADLET |novars| NIL)))))))))) - (COND - (|novars| (|coercionFailure|)) - ((QUOTE T) - (SPADLET |source'| - (CONS |sm| - (CONS |n| (CONS (CONS |pol| (CONS |vl| (CONS S NIL))) NIL)))) - (COND - ((NULL - (SPADLET |u'| (|coerceInt| (|objNewWrap| |u| |source|) |source'|))) - (|coercionFailure|)) - ((NULL (SPADLET |u'| (|coerceInt| |u'| |target|))) - (|coercionFailure|)) - ((QUOTE T) (|objValUnwrap| |u'|)))))) - ((QUOTE T) (|coercionFailure|)))))))) + (PROG (|pol| |vl| T$ |sm| |n| S |ISTMP#1| |S'| |vl'| |varsUsed| + |novars| |source'| |u'|) + (RETURN + (SEQ (PROGN + (SPADLET |pol| (CAR |target|)) + (SPADLET |vl| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |sm| (CAR |source|)) + (SPADLET |n| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| |source| T$)) + ((AND (PAIRP S) (EQ (QCAR S) '|Polynomial|) + (PROGN + (SPADLET |ISTMP#1| (QCDR S)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |S'| (QCAR |ISTMP#1|)) 'T)))) + (COND + ((ATOM |vl|) (SPADLET |vl'| (CONS |vl| NIL))) + ('T (SPADLET |vl'| |vl|))) + (SPADLET |novars| 'T) + (DO ((G169670 (SPADDIFFERENCE |n| 1)) + (|i| 0 (QSADD1 |i|))) + ((OR (QSGREATERP |i| G169670) (NULL |novars|)) + NIL) + (SEQ (EXIT (DO ((G169681 (SPADDIFFERENCE |n| 1)) + (|j| 0 (QSADD1 |j|))) + ((OR (QSGREATERP |j| G169681) + (NULL |novars|)) + NIL) + (SEQ (EXIT + (PROGN + (SPADLET |varsUsed| + (|varsInPoly| + (ELT (ELT |u| |i|) |j|))) + (COND + ((PROG (G169686) + (SPADLET G169686 NIL) + (RETURN + (DO + ((G169692 NIL + G169686) + (G169693 |vl'| + (CDR G169693)) + (|x| NIL)) + ((OR G169692 + (ATOM G169693) + (PROGN + (SETQ |x| + (CAR G169693)) + NIL)) + G169686) + (SEQ + (EXIT + (SETQ G169686 + (OR G169686 + (|member| |x| + |varsUsed|)))))))) + (SPADLET |novars| NIL)))))))))) + (COND + (|novars| (|coercionFailure|)) + ('T + (SPADLET |source'| + (CONS |sm| + (CONS |n| + (CONS + (CONS |pol| + (CONS |vl| (CONS S NIL))) + NIL)))) + (COND + ((NULL (SPADLET |u'| + (|coerceInt| + (|objNewWrap| |u| |source|) + |source'|))) + (|coercionFailure|)) + ((NULL (SPADLET |u'| (|coerceInt| |u'| |target|))) + (|coercionFailure|)) + ('T (|objValUnwrap| |u'|)))))) + ('T (|coercionFailure|)))))))) ;Sm2Rm(x,[.,n,R],[.,p,q,S]) == ; x = '_$fromCoerceable_$ => p=q and p=n and canCoerce(R,S) @@ -4384,30 +4682,31 @@ all these coercion functions have the following result: ; M2M(x,[nil,R],[nil,S]) ; coercionFailure() -(DEFUN |Sm2Rm| (|x| #0=#:G169721 #1=#:G169730) - (PROG (|p| |q| S |n| R) - (RETURN - (PROGN - (SPADLET |p| (CADR #1#)) - (SPADLET |q| (CADDR #1#)) - (SPADLET S (CADDDR #1#)) - (SPADLET |n| (CADR #0#)) - (SPADLET R (CADDR #0#)) - (COND - ((BOOT-EQUAL |x| (QUOTE |$fromCoerceable$|)) - (AND (BOOT-EQUAL |p| |q|) (BOOT-EQUAL |p| |n|) (|canCoerce| R S))) - ((AND (BOOT-EQUAL |p| |q|) (BOOT-EQUAL |p| |n|)) - (M2M |x| (CONS NIL (CONS R NIL)) (CONS NIL (CONS S NIL)))) - ((QUOTE T) (|coercionFailure|))))))) +(DEFUN |Sm2Rm| (|x| G169721 G169730) + (PROG (|p| |q| S |n| R) + (RETURN + (PROGN + (SPADLET |p| (CADR G169730)) + (SPADLET |q| (CADDR G169730)) + (SPADLET S (CADDDR G169730)) + (SPADLET |n| (CADR G169721)) + (SPADLET R (CADDR G169721)) + (COND + ((BOOT-EQUAL |x| '|$fromCoerceable$|) + (AND (BOOT-EQUAL |p| |q|) (BOOT-EQUAL |p| |n|) + (|canCoerce| R S))) + ((AND (BOOT-EQUAL |p| |q|) (BOOT-EQUAL |p| |n|)) + (M2M |x| (CONS NIL (CONS R NIL)) (CONS NIL (CONS S NIL)))) + ('T (|coercionFailure|))))))) ;Sm2V(x,[.,.,R],target) == M2V(x,['Matrix,R],target) -(DEFUN |Sm2V| (|x| #0=#:G169753 |target|) - (PROG (R) - (RETURN - (PROGN - (SPADLET R (CADDR #0#)) - (M2V |x| (CONS (QUOTE |Matrix|) (CONS R NIL)) |target|))))) +(DEFUN |Sm2V| (|x| G169753 |target|) + (PROG (R) + (RETURN + (PROGN + (SPADLET R (CADDR G169753)) + (M2V |x| (CONS '|Matrix| (CONS R NIL)) |target|))))) ;--% Symbol ;Sy2OV(u,source,target is [.,vl]) == @@ -4415,13 +4714,14 @@ all these coercion functions have the following result: ; position1(u,vl) (DEFUN |Sy2OV| (|u| |source| |target|) - (PROG (|vl|) - (RETURN - (PROGN - (SPADLET |vl| (CADR |target|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) NIL) - ((QUOTE T) (|position1| |u| |vl|))))))) + (DECLARE (IGNORE |source|)) + (PROG (|vl|) + (RETURN + (PROGN + (SPADLET |vl| (CADR |target|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) NIL) + ('T (|position1| |u| |vl|))))))) ;Sy2Dmp(u,source,target is [dmp,vl,S]) == ; u = '_$fromCoerceable_$ => canCoerce(source,S) @@ -4433,47 +4733,57 @@ all these coercion functions have the following result: ; [[Zeros len,:objValUnwrap u]] (DEFUN |Sy2Dmp| (|u| |source| |target|) - (PROG (|dmp| |vl| S |len| |n|) - (RETURN - (SEQ - (PROGN - (SPADLET |dmp| (CAR |target|)) - (SPADLET |vl| (CADR |target|)) - (SPADLET S (CADDR |target|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| |source| S)) - ((QUOTE T) - (SPADLET |len| (|#| |vl|)) - (COND - ((NEQUAL (SPADDIFFERENCE 1) (SPADLET |n| (|position| |u| |vl|))) - (SPADLET |u| - (|wrap| - (LIST - (CONS - (LIST2VEC - (PROG (#0=#:G169792) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G169797 (SPADDIFFERENCE |len| 1)) - (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| #1#) (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS - (COND - ((BOOT-EQUAL |n| |i|) 1) - ((QUOTE T) 0)) #0#)))))))) - 1)))) - (|objValUnwrap| - (|coerceInt| - (|objNew| |u| (CONS |dmp| (CONS |vl| (CONS |$Integer| NIL)))) - |target|))) - ((QUOTE T) - (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |u| |source|) S)) - (|coercionFailure|)) - (CONS (CONS (|Zeros| |len|) (|objValUnwrap| |u|)) NIL)))))))))) + (PROG (|dmp| |vl| S |len| |n|) + (DECLARE (SPECIAL |$Integer|)) + (RETURN + (SEQ (PROGN + (SPADLET |dmp| (CAR |target|)) + (SPADLET |vl| (CADR |target|)) + (SPADLET S (CADDR |target|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| |source| S)) + ('T (SPADLET |len| (|#| |vl|)) + (COND + ((NEQUAL (SPADDIFFERENCE 1) + (SPADLET |n| (|position| |u| |vl|))) + (SPADLET |u| + (|wrap| (LIST + (CONS + (LIST2VEC + (PROG (G169792) + (SPADLET G169792 NIL) + (RETURN + (DO + ((G169797 + (SPADDIFFERENCE |len| 1)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G169797) + (NREVERSE0 G169792)) + (SEQ + (EXIT + (SETQ G169792 + (CONS + (COND + ((BOOT-EQUAL |n| + |i|) + 1) + ('T 0)) + G169792)))))))) + 1)))) + (|objValUnwrap| + (|coerceInt| + (|objNew| |u| + (CONS |dmp| + (CONS |vl| (CONS |$Integer| NIL)))) + |target|))) + ('T + (OR (SPADLET |u| + (|coerceInt| + (|objNewWrap| |u| |source|) S)) + (|coercionFailure|)) + (CONS (CONS (|Zeros| |len|) (|objValUnwrap| |u|)) + NIL)))))))))) ;Sy2Mp(u,source,target is [mp,vl,S]) == ; u = '_$fromCoerceable_$ => canCoerce(source,S) @@ -4509,47 +4819,57 @@ all these coercion functions have the following result: ; [[Zeros len,:objValUnwrap(u)]] (DEFUN |Sy2NDmp| (|u| |source| |target|) - (PROG (|ndmp| |vl| S |len| |n|) - (RETURN - (SEQ - (PROGN - (SPADLET |ndmp| (CAR |target|)) - (SPADLET |vl| (CADR |target|)) - (SPADLET S (CADDR |target|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| |source| S)) - ((QUOTE T) - (SPADLET |len| (|#| |vl|)) - (COND - ((NEQUAL (SPADDIFFERENCE 1) (SPADLET |n| (|position| |u| |vl|))) - (SPADLET |u| - (|wrap| - (LIST - (CONS - (LIST2VEC - (PROG (#0=#:G169848) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G169853 (SPADDIFFERENCE |len| 1)) - (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| #1#) (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS - (COND - ((BOOT-EQUAL |n| |i|) 1) - ((QUOTE T) 0)) #0#)))))))) - 1)))) - (|objValUnwrap| - (|coerceInt| - (|objNew| |u| (CONS |ndmp| (CONS |vl| (CONS |$Integer| NIL)))) - |target|))) - ((QUOTE T) - (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |u| |source|) S)) - (|coercionFailure|)) - (CONS (CONS (|Zeros| |len|) (|objValUnwrap| |u|)) NIL)))))))))) + (PROG (|ndmp| |vl| S |len| |n|) + (DECLARE (SPECIAL |$Integer|)) + (RETURN + (SEQ (PROGN + (SPADLET |ndmp| (CAR |target|)) + (SPADLET |vl| (CADR |target|)) + (SPADLET S (CADDR |target|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| |source| S)) + ('T (SPADLET |len| (|#| |vl|)) + (COND + ((NEQUAL (SPADDIFFERENCE 1) + (SPADLET |n| (|position| |u| |vl|))) + (SPADLET |u| + (|wrap| (LIST + (CONS + (LIST2VEC + (PROG (G169848) + (SPADLET G169848 NIL) + (RETURN + (DO + ((G169853 + (SPADDIFFERENCE |len| 1)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G169853) + (NREVERSE0 G169848)) + (SEQ + (EXIT + (SETQ G169848 + (CONS + (COND + ((BOOT-EQUAL |n| + |i|) + 1) + ('T 0)) + G169848)))))))) + 1)))) + (|objValUnwrap| + (|coerceInt| + (|objNew| |u| + (CONS |ndmp| + (CONS |vl| (CONS |$Integer| NIL)))) + |target|))) + ('T + (OR (SPADLET |u| + (|coerceInt| + (|objNewWrap| |u| |source|) S)) + (|coercionFailure|)) + (CONS (CONS (|Zeros| |len|) (|objValUnwrap| |u|)) + NIL)))))))))) ;Sy2P(u,source,target is [poly,S]) == ; u = '_$fromCoerceable_$ => true @@ -4561,19 +4881,25 @@ all these coercion functions have the following result: ; [1,u,[1,0,:domainOne(S)]] (DEFUN |Sy2P| (|u| |source| |target|) - (PROG (|poly| S |u'|) - (RETURN - (PROGN - (SPADLET |poly| (CAR |target|)) - (SPADLET S (CADR |target|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (QUOTE T)) - ((QUOTE T) - (COND - ((NEQUAL S |$Integer|) - (SPADLET |u'| (|coerceInt| (|objNewWrap| |u| |source|) S)) - (COND (|u'| (RETURN (CONS 0 (|objValUnwrap| |u'|)))) ((QUOTE T) NIL)))) - (CONS 1 (CONS |u| (CONS (CONS 1 (CONS 0 (|domainOne| S))) NIL))))))))) + (PROG (|poly| S |u'|) + (DECLARE (SPECIAL |$Integer|)) + (RETURN + (PROGN + (SPADLET |poly| (CAR |target|)) + (SPADLET S (CADR |target|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) 'T) + ('T + (COND + ((NEQUAL S |$Integer|) + (SPADLET |u'| + (|coerceInt| (|objNewWrap| |u| |source|) S)) + (COND + (|u'| (RETURN (CONS 0 (|objValUnwrap| |u'|)))) + ('T NIL)))) + (CONS 1 + (CONS |u| + (CONS (CONS 1 (CONS 0 (|domainOne| S))) NIL))))))))) ;Sy2Up(u,source,target is [up,x,S]) == ; u = '_$fromCoerceable_$ => canCoerce(source,S) @@ -4582,20 +4908,21 @@ all these coercion functions have the following result: ; [[0,:objValUnwrap u]] (DEFUN |Sy2Up| (|u| |source| |target|) - (PROG (|up| |x| S) - (RETURN - (PROGN - (SPADLET |up| (CAR |target|)) - (SPADLET |x| (CADR |target|)) - (SPADLET S (CADDR |target|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| |source| S)) - ((BOOT-EQUAL |u| |x|) (CONS (CONS 1 (|domainOne| S)) NIL)) - ((QUOTE T) - (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |u| |source|) S)) - (|coercionFailure|)) - (CONS (CONS 0 (|objValUnwrap| |u|)) NIL))))))) + (PROG (|up| |x| S) + (RETURN + (PROGN + (SPADLET |up| (CAR |target|)) + (SPADLET |x| (CADR |target|)) + (SPADLET S (CADDR |target|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| |source| S)) + ((BOOT-EQUAL |u| |x|) (CONS (CONS 1 (|domainOne| S)) NIL)) + ('T + (OR (SPADLET |u| + (|coerceInt| (|objNewWrap| |u| |source|) S)) + (|coercionFailure|)) + (CONS (CONS 0 (|objValUnwrap| |u|)) NIL))))))) ;Sy2Var(u,source,target is [.,x]) == ; u = '_$fromCoerceable_$ => NIL @@ -4603,14 +4930,15 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |Sy2Var| (|u| |source| |target|) - (PROG (|x|) - (RETURN - (PROGN - (SPADLET |x| (CADR |target|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) NIL) - ((BOOT-EQUAL |u| |x|) |u|) - ((QUOTE T) (|coercionFailure|))))))) + (DECLARE (IGNORE |source|)) + (PROG (|x|) + (RETURN + (PROGN + (SPADLET |x| (CADR |target|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) NIL) + ((BOOT-EQUAL |u| |x|) |u|) + ('T (|coercionFailure|))))))) ;--% Univariate Polynomial ;Up2Dmp(u,source is ['UnivariatePolynomial,var,S], @@ -4639,94 +4967,104 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |Up2Dmp| (|u| |source| |target|) - (PROG (|vl| T$ |var| S |ISTMP#1| |one| |plusfunc| |multfunc| |n| |p| |l1| - |l2| |e| |c| |z| |y| |x|) - (RETURN - (SEQ - (PROGN - (SPADLET |vl| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |var| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (AND (|member| |var| |vl|) (|canCoerce| S |target|))) - ((NULL |u|) (|domainZero| |target|)) - ((AND (PAIRP |u|) - (EQ (QCDR |u|) NIL) - (PROGN - (SPADLET |ISTMP#1| (QCAR |u|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |e| (QCAR |ISTMP#1|)) - (SPADLET |c| (QCDR |ISTMP#1|)) - (QUOTE T)))) - (EQL |e| 0)) - (COND - ((SPADLET |z| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|objValUnwrap| |z|)) - ((QUOTE T) (|coercionFailure|)))) - ((|member| |var| |vl|) - (SPADLET |x| (|domainZero| |target|)) - (SPADLET |one| (|domainOne| T$)) - (SPADLET |plusfunc| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |multfunc| - (|getFunctionFromDomain| - (QUOTE *) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |n| (|#| |vl|)) - (SPADLET |p| (POSN1 |var| |vl|)) - (SPADLET |l1| - (AND - (NULL (EQL |p| 0)) - (PROG (#0=#:G169969) - (SPADLET #0# NIL) - (RETURN - (DO ((|m| 1 (QSADD1 |m|))) - ((QSGREATERP |m| |p|) (NREVERSE0 #0#)) - (SEQ (EXIT (SETQ #0# (CONS 0 #0#))))))))) - (SPADLET |l2| - (AND - (NULL (BOOT-EQUAL |p| (SPADDIFFERENCE |n| 1))) - (PROG (#1=#:G169981) - (SPADLET #1# NIL) - (RETURN - (DO ((#2=#:G169986 (SPADDIFFERENCE |n| 2)) (|m| |p| (+ |m| 1))) - ((> |m| #2#) (NREVERSE0 #1#)) - (SEQ (EXIT (SETQ #1# (CONS 0 #1#))))))))) - (SEQ - (DO ((#3=#:G169997 |u| (CDR #3#)) - (#4=#:G169923 NIL) - (#5=#:G169998 NIL (NULL |z|))) - ((OR (ATOM #3#) - (PROGN (SETQ #4# (CAR #3#)) NIL) - (PROGN - (PROGN (SPADLET |e| (CAR #4#)) (SPADLET |c| (CDR #4#)) #4#) - NIL) - #5#) - NIL) - (SEQ - (EXIT - (COND - ((SPADLET |z| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (EXIT - (PROGN - (SPADLET |y| - (SPADCALL - (|objValUnwrap| |z|) - (CONS - (CONS (LIST2VEC (APPEND |l1| (CONS |e| |l2|))) |one|) - NIL) - |multfunc|)) - (SPADLET |x| (SPADCALL |x| |y| |plusfunc|))))))))) - (COND (|z| (EXIT |x|))) (|coercionFailure|))) - ((QUOTE T) (|coercionFailure|)))))))) + (PROG (|vl| T$ |var| S |ISTMP#1| |one| |plusfunc| |multfunc| |n| |p| + |l1| |l2| |e| |c| |z| |y| |x|) + (RETURN + (SEQ (PROGN + (SPADLET |vl| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |var| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (AND (|member| |var| |vl|) (|canCoerce| S |target|))) + ((NULL |u|) (|domainZero| |target|)) + ((AND (PAIRP |u|) (EQ (QCDR |u|) NIL) + (PROGN + (SPADLET |ISTMP#1| (QCAR |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |e| (QCAR |ISTMP#1|)) + (SPADLET |c| (QCDR |ISTMP#1|)) + 'T))) + (EQL |e| 0)) + (COND + ((SPADLET |z| + (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|objValUnwrap| |z|)) + ('T (|coercionFailure|)))) + ((|member| |var| |vl|) + (SPADLET |x| (|domainZero| |target|)) + (SPADLET |one| (|domainOne| T$)) + (SPADLET |plusfunc| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |multfunc| + (|getFunctionFromDomain| '* |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |n| (|#| |vl|)) + (SPADLET |p| (POSN1 |var| |vl|)) + (SPADLET |l1| + (AND (NULL (EQL |p| 0)) + (PROG (G169969) + (SPADLET G169969 NIL) + (RETURN + (DO ((|m| 1 (QSADD1 |m|))) + ((QSGREATERP |m| |p|) + (NREVERSE0 G169969)) + (SEQ + (EXIT + (SETQ G169969 + (CONS 0 G169969))))))))) + (SPADLET |l2| + (AND (NULL (BOOT-EQUAL |p| + (SPADDIFFERENCE |n| 1))) + (PROG (G169981) + (SPADLET G169981 NIL) + (RETURN + (DO ((G169986 + (SPADDIFFERENCE |n| 2)) + (|m| |p| (+ |m| 1))) + ((> |m| G169986) + (NREVERSE0 G169981)) + (SEQ + (EXIT + (SETQ G169981 + (CONS 0 G169981))))))))) + (SEQ (DO ((G169997 |u| (CDR G169997)) + (G169923 NIL) (G169998 NIL (NULL |z|))) + ((OR (ATOM G169997) + (PROGN + (SETQ G169923 (CAR G169997)) + NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G169923)) + (SPADLET |c| (CDR G169923)) + G169923) + NIL) + G169998) + NIL) + (SEQ (EXIT (COND + ((SPADLET |z| + (|coerceInt| (|objNewWrap| |c| S) + |target|)) + (EXIT + (PROGN + (SPADLET |y| + (SPADCALL (|objValUnwrap| |z|) + (CONS + (CONS + (LIST2VEC + (APPEND |l1| + (CONS |e| |l2|))) + |one|) + NIL) + |multfunc|)) + (SPADLET |x| + (SPADCALL |x| |y| |plusfunc|))))))))) + (COND (|z| (EXIT |x|))) (|coercionFailure|))) + ('T (|coercionFailure|)))))))) ;Up2Expr(u,source is [up,var,S], target is [Expr,T]) == ; u = '_$fromCoerceable_$ => canCoerce(S, target) @@ -4759,92 +5097,104 @@ all these coercion functions have the following result: ; SPADCALL(SPADCALL(sym, e1, expn), c1, mult) (DEFUN |Up2Expr| (|u| |source| |target|) - (PROG (|Expr| T$ |up| |var| S |ISTMP#1| |e| |c| |z| |sym| |plus| |mult| - |expn| |LETTMP#1| |e2| |c2| |coef| |e1| |c1|) - (RETURN - (SEQ - (PROGN - (SPADLET |Expr| (CAR |target|)) - (SPADLET T$ (CADR |target|)) - (SPADLET |up| (CAR |source|)) - (SPADLET |var| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| S |target|)) - ((NULL |u|) (|domainZero| |target|)) - ((AND (PAIRP |u|) - (EQ (QCDR |u|) NIL) - (PROGN - (SPADLET |ISTMP#1| (QCAR |u|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |e| (QCAR |ISTMP#1|)) - (SPADLET |c| (QCDR |ISTMP#1|)) - (QUOTE T)))) - (EQL |e| 0)) - (COND - ((SPADLET |z| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|objValUnwrap| |z|)) - ((QUOTE T) (|coercionFailure|)))) - ((QUOTE T) - (SPADLET |sym| - (|objValUnwrap| (|coerceInt| (|objNewWrap| |var| |$Symbol|) |target|))) - (SPADLET |plus| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |mult| - (|getFunctionFromDomain| - (QUOTE *) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |expn| - (|getFunctionFromDomain| - (QUOTE **) - |target| - (CONS |target| (CONS |$Integer| NIL)))) - (SPADLET |LETTMP#1| (CAR |u|)) - (SPADLET |e1| (CAR |LETTMP#1|)) - (SPADLET |c1| (CDR |LETTMP#1|)) - (COND - ((NULL (BOOT-EQUAL S |target|)) - (COND - ((NULL (SPADLET |c1| (|coerceInt| (|objNewWrap| |c1| S) |target|))) - (|coercionFailure|)) - ((QUOTE T) (SPADLET |c1| (|objValUnwrap| |c1|)))))) - (DO ((#0=#:G170113 (CDR |u|) (CDR #0#)) (#1=#:G170052 NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN - (SPADLET |e2| (CAR #1#)) - (SPADLET |c2| (CDR #1#)) - #1#) - NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |coef| - (COND - ((EQL (SPADDIFFERENCE |e1| |e2|) 1) |sym|) - ((QUOTE T) (SPADCALL |sym| (SPADDIFFERENCE |e1| |e2|) |expn|)))) - (COND - ((NULL (BOOT-EQUAL S |target|)) + (PROG (|Expr| T$ |up| |var| S |ISTMP#1| |e| |c| |z| |sym| |plus| + |mult| |expn| |LETTMP#1| |e2| |c2| |coef| |e1| |c1|) + (DECLARE (SPECIAL |$Integer| |$Symbol|)) + (RETURN + (SEQ (PROGN + (SPADLET |Expr| (CAR |target|)) + (SPADLET T$ (CADR |target|)) + (SPADLET |up| (CAR |source|)) + (SPADLET |var| (CADR |source|)) + (SPADLET S (CADDR |source|)) (COND - ((NULL - (SPADLET |c2| (|coerceInt| (|objNewWrap| |c2| S) |target|))) - (|coercionFailure|)) - ((QUOTE T) (SPADLET |c2| (|objValUnwrap| |c2|)))))) - (SPADLET |coef| - (SPADCALL (SPADCALL |c1| |coef| |mult|) |c2| |plus|)) - (SPADLET |e1| |e2|) (SPADLET |c1| |coef|))))) - (COND - ((EQL |e1| 0) |c1|) - ((EQL |e1| 1) (SPADCALL |sym| |c1| |mult|)) - ((QUOTE T) - (SPADCALL (SPADCALL |sym| |e1| |expn|) |c1| |mult|)))))))))) + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| S |target|)) + ((NULL |u|) (|domainZero| |target|)) + ((AND (PAIRP |u|) (EQ (QCDR |u|) NIL) + (PROGN + (SPADLET |ISTMP#1| (QCAR |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |e| (QCAR |ISTMP#1|)) + (SPADLET |c| (QCDR |ISTMP#1|)) + 'T))) + (EQL |e| 0)) + (COND + ((SPADLET |z| + (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|objValUnwrap| |z|)) + ('T (|coercionFailure|)))) + ('T + (SPADLET |sym| + (|objValUnwrap| + (|coerceInt| + (|objNewWrap| |var| |$Symbol|) + |target|))) + (SPADLET |plus| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |mult| + (|getFunctionFromDomain| '* |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |expn| + (|getFunctionFromDomain| '** |target| + (CONS |target| (CONS |$Integer| NIL)))) + (SPADLET |LETTMP#1| (CAR |u|)) + (SPADLET |e1| (CAR |LETTMP#1|)) + (SPADLET |c1| (CDR |LETTMP#1|)) + (COND + ((NULL (BOOT-EQUAL S |target|)) + (COND + ((NULL (SPADLET |c1| + (|coerceInt| (|objNewWrap| |c1| S) + |target|))) + (|coercionFailure|)) + ('T (SPADLET |c1| (|objValUnwrap| |c1|)))))) + (DO ((G170113 (CDR |u|) (CDR G170113)) + (G170052 NIL)) + ((OR (ATOM G170113) + (PROGN (SETQ G170052 (CAR G170113)) NIL) + (PROGN + (PROGN + (SPADLET |e2| (CAR G170052)) + (SPADLET |c2| (CDR G170052)) + G170052) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |coef| + (COND + ((EQL + (SPADDIFFERENCE |e1| |e2|) + 1) + |sym|) + ('T + (SPADCALL |sym| + (SPADDIFFERENCE |e1| |e2|) + |expn|)))) + (COND + ((NULL (BOOT-EQUAL S |target|)) + (COND + ((NULL + (SPADLET |c2| + (|coerceInt| + (|objNewWrap| |c2| S) |target|))) + (|coercionFailure|)) + ('T + (SPADLET |c2| + (|objValUnwrap| |c2|)))))) + (SPADLET |coef| + (SPADCALL + (SPADCALL |c1| |coef| |mult|) + |c2| |plus|)) + (SPADLET |e1| |e2|) + (SPADLET |c1| |coef|))))) + (COND + ((EQL |e1| 0) |c1|) + ((EQL |e1| 1) (SPADCALL |sym| |c1| |mult|)) + ('T + (SPADCALL (SPADCALL |sym| |e1| |expn|) |c1| |mult|)))))))))) ;Up2FR(u,S is [.,x,R],target is [.,T]) == ; u = '_$fromCoerceable_$ => @@ -4860,30 +5210,34 @@ all these coercion functions have the following result: ; SPADCALL(u,factor) (DEFUN |Up2FR| (|u| S |target|) - (PROG (T$ |x| R |package| |factor|) - (RETURN - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET |x| (CADR S)) - (SPADLET R (CADDR S)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (COND - ((NEQUAL S T$) NIL) - ((|member| R (QUOTE ((|Integer|) (|Fraction| (|Integer|))))) (QUOTE T)) - ((QUOTE T) NIL))) - ((NEQUAL S T$) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |package| - (COND - ((BOOT-EQUAL R |$Integer|) - (CONS (QUOTE |UnivariateFactorize|) (CONS S NIL))) - ((BOOT-EQUAL R |$RationalNumber|) - (SPADLET |package| (CONS (QUOTE |RationalFactorize|) (CONS S NIL)))) - ((QUOTE T) (|coercionFailure|)))) - (SPADLET |factor| - (|getFunctionFromDomain| (QUOTE |factor|) |package| (CONS S NIL))) - (SPADCALL |u| |factor|))))))) + (PROG (T$ |x| R |package| |factor|) + (DECLARE (SPECIAL |$RationalNumber| |$Integer|)) + (RETURN + (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET |x| (CADR S)) + (SPADLET R (CADDR S)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (COND + ((NEQUAL S T$) NIL) + ((|member| R '((|Integer|) (|Fraction| (|Integer|)))) 'T) + ('T NIL))) + ((NEQUAL S T$) (|coercionFailure|)) + ('T + (SPADLET |package| + (COND + ((BOOT-EQUAL R |$Integer|) + (CONS '|UnivariateFactorize| (CONS S NIL))) + ((BOOT-EQUAL R |$RationalNumber|) + (SPADLET |package| + (CONS '|RationalFactorize| + (CONS S NIL)))) + ('T (|coercionFailure|)))) + (SPADLET |factor| + (|getFunctionFromDomain| '|factor| |package| + (CONS S NIL))) + (SPADCALL |u| |factor|))))))) ;Up2Mp(u,source is [.,x,S], target is [.,vl,T]) == ; u = '_$fromCoerceable_$ => @@ -4908,75 +5262,75 @@ all these coercion functions have the following result: ; sum (DEFUN |Up2Mp| (|u| |source| |target|) - (PROG (|vl| T$ S |ISTMP#1| |x| |plus| |monom| |pos| |e| |c| |p| |mon| |sum|) - (RETURN - (SEQ - (PROGN - (SPADLET |vl| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |x| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (COND - ((|member| |x| |vl|) (|canCoerce| S T$)) - ((QUOTE T) (|canCoerce| |source| T$)))) - ((NULL |u|) (|domainZero| |target|)) - ((AND (NULL (CDR |u|)) - (PROGN - (SPADLET |ISTMP#1| (CAR |u|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |e| (QCAR |ISTMP#1|)) - (SPADLET |c| (QCDR |ISTMP#1|)) - (QUOTE T)))) - (EQL |e| 0)) - (COND - ((SPADLET |x| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|objValUnwrap| |x|)) - ((QUOTE T) (|coercionFailure|)))) - ((NULL (|member| |x| |vl|)) - (OR - (SPADLET |x| (|coerceInt| (|objNewWrap| |u| |source|) T$)) - (|coercionFailure|)) - (CONS 0 (|objValUnwrap| |x|))) - ((QUOTE T) - (SPADLET |plus| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |monom| - (|getFunctionFromDomain| - (QUOTE |monomial|) - |target| - (CONS - |target| - (CONS - (CONS (QUOTE |OrderedVariableList|) (CONS |vl| NIL)) - (CONS |$NonNegativeInteger| NIL))))) - (SPADLET |sum| (|domainZero| |target|)) - (SPADLET |pos| (|position1| |x| |vl|)) - (DO ((#0=#:G170239 |u| (CDR #0#)) (#1=#:G170191 NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN - (SPADLET |e| (CAR #1#)) - (SPADLET |c| (CDR #1#)) - #1#) - NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (OR - (SPADLET |p| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|coercionFailure|)) - (SPADLET |mon| (SPADCALL (|objValUnwrap| |p|) |pos| |e| |monom|)) - (SPADLET |sum| (SPADCALL |sum| |mon| |plus|)))))) - |sum|))))))) + (PROG (|vl| T$ S |ISTMP#1| |x| |plus| |monom| |pos| |e| |c| |p| |mon| + |sum|) + (DECLARE (SPECIAL |$NonNegativeInteger|)) + (RETURN + (SEQ (PROGN + (SPADLET |vl| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |x| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (COND + ((|member| |x| |vl|) (|canCoerce| S T$)) + ('T (|canCoerce| |source| T$)))) + ((NULL |u|) (|domainZero| |target|)) + ((AND (NULL (CDR |u|)) + (PROGN + (SPADLET |ISTMP#1| (CAR |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |e| (QCAR |ISTMP#1|)) + (SPADLET |c| (QCDR |ISTMP#1|)) + 'T))) + (EQL |e| 0)) + (COND + ((SPADLET |x| + (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|objValUnwrap| |x|)) + ('T (|coercionFailure|)))) + ((NULL (|member| |x| |vl|)) + (OR (SPADLET |x| + (|coerceInt| (|objNewWrap| |u| |source|) + T$)) + (|coercionFailure|)) + (CONS 0 (|objValUnwrap| |x|))) + ('T + (SPADLET |plus| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |monom| + (|getFunctionFromDomain| '|monomial| |target| + (CONS |target| + (CONS + (CONS '|OrderedVariableList| + (CONS |vl| NIL)) + (CONS |$NonNegativeInteger| NIL))))) + (SPADLET |sum| (|domainZero| |target|)) + (SPADLET |pos| (|position1| |x| |vl|)) + (DO ((G170239 |u| (CDR G170239)) (G170191 NIL)) + ((OR (ATOM G170239) + (PROGN (SETQ G170191 (CAR G170239)) NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G170191)) + (SPADLET |c| (CDR G170191)) + G170191) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (OR (SPADLET |p| + (|coerceInt| (|objNewWrap| |c| S) + |target|)) + (|coercionFailure|)) + (SPADLET |mon| + (SPADCALL (|objValUnwrap| |p|) + |pos| |e| |monom|)) + (SPADLET |sum| + (SPADCALL |sum| |mon| |plus|)))))) + |sum|))))))) ;Up2P(u,source is [.,var,S],target is [.,T]) == ; u = '_$fromCoerceable_$ => canCoerce(S,target) @@ -4997,72 +5351,70 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |Up2P| (|u| |source| |target|) - (PROG (T$ |var| S |ISTMP#1| |one| |plusfunc| |multfunc| |e| |c| |x| - |term| |pol|) - (RETURN - (SEQ - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET |var| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| S |target|)) - ((NULL |u|) (|domainZero| |target|)) - ((AND (PAIRP |u|) - (EQ (QCDR |u|) NIL) - (PROGN - (SPADLET |ISTMP#1| (QCAR |u|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |e| (QCAR |ISTMP#1|)) - (SPADLET |c| (QCDR |ISTMP#1|)) - (QUOTE T)))) - (EQL |e| 0)) - (COND - ((SPADLET |x| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|objValUnwrap| |x|)) - ((QUOTE T) (|coercionFailure|)))) - ((QUOTE T) - (SPADLET |pol| (|domainZero| |target|)) - (SPADLET |one| (|domainOne| T$)) - (SPADLET |plusfunc| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |multfunc| - (|getFunctionFromDomain| - (QUOTE *) - |target| - (CONS |target| (CONS |target| NIL)))) - (DO ((#0=#:G170322 |u| (CDR #0#)) - (#1=#:G170278 NIL) - (#2=#:G170323 NIL (NULL |x|))) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN - (SPADLET |e| (CAR #1#)) - (SPADLET |c| (CDR #1#)) - #1#) - NIL) - #2#) - NIL) - (SEQ - (EXIT - (COND - ((SPADLET |x| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (SPADLET |term| - (SPADCALL - (CONS 1 (CONS |var| (CONS (CONS |e| (CONS 0 |one|)) NIL))) - (|objValUnwrap| |x|) - |multfunc|)) - (SPADLET |pol| (SPADCALL |pol| |term| |plusfunc|))) - ((QUOTE T) (|coercionFailure|)))))) - (COND - (|x| |pol|) - ((QUOTE T) (|coercionFailure|)))))))))) + (PROG (T$ |var| S |ISTMP#1| |one| |plusfunc| |multfunc| |e| |c| |x| + |term| |pol|) + (RETURN + (SEQ (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET |var| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| S |target|)) + ((NULL |u|) (|domainZero| |target|)) + ((AND (PAIRP |u|) (EQ (QCDR |u|) NIL) + (PROGN + (SPADLET |ISTMP#1| (QCAR |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |e| (QCAR |ISTMP#1|)) + (SPADLET |c| (QCDR |ISTMP#1|)) + 'T))) + (EQL |e| 0)) + (COND + ((SPADLET |x| + (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|objValUnwrap| |x|)) + ('T (|coercionFailure|)))) + ('T (SPADLET |pol| (|domainZero| |target|)) + (SPADLET |one| (|domainOne| T$)) + (SPADLET |plusfunc| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |multfunc| + (|getFunctionFromDomain| '* |target| + (CONS |target| (CONS |target| NIL)))) + (DO ((G170322 |u| (CDR G170322)) (G170278 NIL) + (G170323 NIL (NULL |x|))) + ((OR (ATOM G170322) + (PROGN (SETQ G170278 (CAR G170322)) NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G170278)) + (SPADLET |c| (CDR G170278)) + G170278) + NIL) + G170323) + NIL) + (SEQ (EXIT (COND + ((SPADLET |x| + (|coerceInt| + (|objNewWrap| |c| S) + |target|)) + (SPADLET |term| + (SPADCALL + (CONS 1 + (CONS |var| + (CONS + (CONS |e| (CONS 0 |one|)) + NIL))) + (|objValUnwrap| |x|) + |multfunc|)) + (SPADLET |pol| + (SPADCALL |pol| |term| + |plusfunc|))) + ('T (|coercionFailure|)))))) + (COND (|x| |pol|) ('T (|coercionFailure|)))))))))) ;Up2SUP(u,source is [.,x,S],target is [.,T]) == ; u = '_$fromCoerceable_$ => canCoerce(source,T) or canCoerce(S,T) @@ -5081,39 +5433,46 @@ all these coercion functions have the following result: ; [[0,:objValUnwrap u']] (DEFUN |Up2SUP| (|u| |source| |target|) - (PROG (T$ |x| S |zero| |e| |c| |c'| |u'|) - (RETURN - (SEQ - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET |x| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (OR (|canCoerce| |source| T$) (|canCoerce| S T$))) - ((NULL |u|) |u|) - ((BOOT-EQUAL S T$) |u|) - ((NULL (SPADLET |u'| (|coerceInt| (|objNewWrap| |u| |source|) T$))) - (SPADLET |u'| NIL) - (SPADLET |zero| (|getConstantFromDomain| (QUOTE (|Zero|)) T$)) - (DO ((#0=#:G170387 |u| (CDR #0#)) (#1=#:G170351 NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN (SPADLET |e| (CAR #1#)) (SPADLET |c| (CDR #1#)) #1#) - NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |c'| - (|objValUnwrap| - (OR (|coerceInt| (|objNewWrap| |c| S) T$) (|coercionFailure|)))) - (COND - ((BOOT-EQUAL |c'| |zero|) (QUOTE |iterate|)) - ((QUOTE T) (SPADLET |u'| (CONS (CONS |e| |c'|) |u'|)))))))) - (NREVERSE |u'|)) - ((QUOTE T) (CONS (CONS 0 (|objValUnwrap| |u'|)) NIL)))))))) + (PROG (T$ |x| S |zero| |e| |c| |c'| |u'|) + (RETURN + (SEQ (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET |x| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (OR (|canCoerce| |source| T$) (|canCoerce| S T$))) + ((NULL |u|) |u|) + ((BOOT-EQUAL S T$) |u|) + ((NULL (SPADLET |u'| + (|coerceInt| (|objNewWrap| |u| |source|) + T$))) + (SPADLET |u'| NIL) + (SPADLET |zero| (|getConstantFromDomain| '(|Zero|) T$)) + (DO ((G170387 |u| (CDR G170387)) (G170351 NIL)) + ((OR (ATOM G170387) + (PROGN (SETQ G170351 (CAR G170387)) NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G170351)) + (SPADLET |c| (CDR G170351)) + G170351) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |c'| + (|objValUnwrap| + (OR + (|coerceInt| + (|objNewWrap| |c| S) T$) + (|coercionFailure|)))) + (COND + ((BOOT-EQUAL |c'| |zero|) '|iterate|) + ('T + (SPADLET |u'| + (CONS (CONS |e| |c'|) |u'|)))))))) + (NREVERSE |u'|)) + ('T (CONS (CONS 0 (|objValUnwrap| |u'|)) NIL)))))))) ;Up2Up(u,source is [.,v1,S], target is [.,v2,T]) == ; -- if v1 = v2 then this is handled by coerceIntByMap @@ -5128,35 +5487,33 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |Up2Up| (|u| |source| |target|) - (PROG (|v2| T$ |v1| S |ISTMP#1| |e| |c| |x|) - (RETURN - (PROGN - (SPADLET |v2| (CADR |target|)) - (SPADLET T$ (CADDR |target|)) - (SPADLET |v1| (CADR |source|)) - (SPADLET S (CADDR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (COND - ((BOOT-EQUAL |v1| |v2|) (|canCoerce| S T$)) - ((QUOTE T) (|canCoerce| |source| T$)))) - ((NULL |u|) |u|) - ((AND (PAIRP |u|) - (EQ (QCDR |u|) NIL) - (PROGN - (SPADLET |ISTMP#1| (QCAR |u|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |e| (QCAR |ISTMP#1|)) - (SPADLET |c| (QCDR |ISTMP#1|)) - (QUOTE T)))) - (EQL |e| 0)) - (COND - ((SPADLET |x| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|objValUnwrap| |x|)) - ((QUOTE T) (|coercionFailure|)))) - ((QUOTE T) (|coercionFailure|))))))) + (PROG (|v2| T$ |v1| S |ISTMP#1| |e| |c| |x|) + (RETURN + (PROGN + (SPADLET |v2| (CADR |target|)) + (SPADLET T$ (CADDR |target|)) + (SPADLET |v1| (CADR |source|)) + (SPADLET S (CADDR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (COND + ((BOOT-EQUAL |v1| |v2|) (|canCoerce| S T$)) + ('T (|canCoerce| |source| T$)))) + ((NULL |u|) |u|) + ((AND (PAIRP |u|) (EQ (QCDR |u|) NIL) + (PROGN + (SPADLET |ISTMP#1| (QCAR |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |e| (QCAR |ISTMP#1|)) + (SPADLET |c| (QCDR |ISTMP#1|)) + 'T))) + (EQL |e| 0)) + (COND + ((SPADLET |x| (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|objValUnwrap| |x|)) + ('T (|coercionFailure|)))) + ('T (|coercionFailure|))))))) ;insertAlist(a,b,l) == ; null l => [[a,:b]] @@ -5169,21 +5526,20 @@ all these coercion functions have the following result: ; fn(a,b,rest l) (DEFUN |insertAlist,fn| (|a| |b| |l|) - (SEQ - (IF (NULL (CDR |l|)) - (EXIT (RPLAC (CDR |l|) (CONS (CONS |a| |b|) NIL)))) - (IF (BOOT-EQUAL |a| (ELT (ELT |l| 1) 0)) - (EXIT (RPLAC (CDR (ELT |l| 1)) |b|))) - (IF (?ORDER (ELT (ELT |l| 1) 0) |a|) - (EXIT (RPLAC (CDR |l|) (CONS (CONS |a| |b|) (CDR |l|))))) - (EXIT (|insertAlist,fn| |a| |b| (CDR |l|))))) + (SEQ (IF (NULL (CDR |l|)) + (EXIT (RPLAC (CDR |l|) (CONS (CONS |a| |b|) NIL)))) + (IF (BOOT-EQUAL |a| (ELT (ELT |l| 1) 0)) + (EXIT (RPLAC (CDR (ELT |l| 1)) |b|))) + (IF (?ORDER (ELT (ELT |l| 1) 0) |a|) + (EXIT (RPLAC (CDR |l|) (CONS (CONS |a| |b|) (CDR |l|))))) + (EXIT (|insertAlist,fn| |a| |b| (CDR |l|))))) (DEFUN |insertAlist| (|a| |b| |l|) - (COND - ((NULL |l|) (CONS (CONS |a| |b|) NIL)) - ((BOOT-EQUAL |a| (ELT (ELT |l| 0) 0)) (RPLAC (CDAR |l|) |b|) |l|) - ((?ORDER (ELT (ELT |l| 0) 0) |a|) (CONS (CONS |a| |b|) |l|)) - ((QUOTE T) (|insertAlist,fn| |a| |b| |l|) |l|))) + (COND + ((NULL |l|) (CONS (CONS |a| |b|) NIL)) + ((BOOT-EQUAL |a| (ELT (ELT |l| 0) 0)) (RPLAC (CDAR |l|) |b|) |l|) + ((?ORDER (ELT (ELT |l| 0) 0) |a|) (CONS (CONS |a| |b|) |l|)) + ('T (|insertAlist,fn| |a| |b| |l|) |l|))) ;--% Union ;Un2E(x,source,target) == @@ -5193,26 +5549,27 @@ all these coercion functions have the following result: ; coerceUn2E(x,source) (DEFUN |Un2E| (|x| |source| |target|) - (PROG (|branches|) - (RETURN - (SEQ - (PROGN - (SPADLET |branches| (CDR |source|)) - (COND - ((BOOT-EQUAL |x| (QUOTE |$fromCoerceable$|)) - (PROG (#0=#:G170473) - (SPADLET #0# (QUOTE T)) - (RETURN - (DO ((#1=#:G170480 NIL (NULL #0#)) - (#2=#:G170481 |branches| (CDR #2#)) - (|t| NIL)) - ((OR #1# (ATOM #2#) (PROGN (SETQ |t| (CAR #2#)) NIL)) #0#) - (SEQ - (EXIT - (COND - ((NULL (STRINGP |t|)) - (SETQ #0# (AND #0# (|canCoerce| |t| |target|))))))))))) - ((QUOTE T) (|coerceUn2E| |x| |source|)))))))) + (PROG (|branches|) + (RETURN + (SEQ (PROGN + (SPADLET |branches| (CDR |source|)) + (COND + ((BOOT-EQUAL |x| '|$fromCoerceable$|) + (PROG (G170473) + (SPADLET G170473 'T) + (RETURN + (DO ((G170480 NIL (NULL G170473)) + (G170481 |branches| (CDR G170481)) + (|t| NIL)) + ((OR G170480 (ATOM G170481) + (PROGN (SETQ |t| (CAR G170481)) NIL)) + G170473) + (SEQ (EXIT (COND + ((NULL (STRINGP |t|)) + (SETQ G170473 + (AND G170473 + (|canCoerce| |t| |target|))))))))))) + ('T (|coerceUn2E| |x| |source|)))))))) ;--% Variable ;Var2OV(u,source,target is [.,vl]) == @@ -5222,15 +5579,15 @@ all these coercion functions have the following result: ; coercionFailure() (DEFUN |Var2OV| (|u| |source| |target|) - (PROG (|vl| |sym|) - (RETURN - (PROGN - (SPADLET |vl| (CADR |target|)) - (SPADLET |sym| (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|member| |sym| |vl|)) - ((|member| |sym| |vl|) (|position1| |sym| |vl|)) - ((QUOTE T) (|coercionFailure|))))))) + (PROG (|vl| |sym|) + (RETURN + (PROGN + (SPADLET |vl| (CADR |target|)) + (SPADLET |sym| (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) (|member| |sym| |vl|)) + ((|member| |sym| |vl|) (|position1| |sym| |vl|)) + ('T (|coercionFailure|))))))) ;Var2Dmp(u,source,target is [dmp,vl,S]) == ; sym := CADR source @@ -5243,41 +5600,46 @@ all these coercion functions have the following result: ; [[Zeros len,:objValUnwrap u]] (DEFUN |Var2Dmp| (|u| |source| |target|) - (PROG (|dmp| |vl| S |sym| |len| |n|) - (RETURN - (SEQ - (PROGN - (SPADLET |dmp| (CAR |target|)) - (SPADLET |vl| (CADR |target|)) - (SPADLET S (CADDR |target|)) - (SPADLET |sym| (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (OR (|member| |sym| |vl|) (|canCoerce| |source| S))) - ((QUOTE T) - (SPADLET |len| (|#| |vl|)) - (COND - ((NEQUAL (SPADDIFFERENCE 1) (SPADLET |n| (|position| |sym| |vl|))) - (LIST - (CONS - (LIST2VEC - (PROG (#0=#:G170521) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G170526 (SPADDIFFERENCE |len| 1)) - (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| #1#) (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS - (COND ((BOOT-EQUAL |n| |i|) 1) ((QUOTE T) 0)) #0#)))))))) - (|getConstantFromDomain| (QUOTE (|One|)) S)))) - ((QUOTE T) - (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |u| |source|) S)) - (|coercionFailure|)) - (CONS (CONS (|Zeros| |len|) (|objValUnwrap| |u|)) NIL)))))))))) + (PROG (|dmp| |vl| S |sym| |len| |n|) + (RETURN + (SEQ (PROGN + (SPADLET |dmp| (CAR |target|)) + (SPADLET |vl| (CADR |target|)) + (SPADLET S (CADDR |target|)) + (SPADLET |sym| (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (OR (|member| |sym| |vl|) (|canCoerce| |source| S))) + ('T (SPADLET |len| (|#| |vl|)) + (COND + ((NEQUAL (SPADDIFFERENCE 1) + (SPADLET |n| (|position| |sym| |vl|))) + (LIST (CONS (LIST2VEC + (PROG (G170521) + (SPADLET G170521 NIL) + (RETURN + (DO + ((G170526 + (SPADDIFFERENCE |len| 1)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G170526) + (NREVERSE0 G170521)) + (SEQ + (EXIT + (SETQ G170521 + (CONS + (COND + ((BOOT-EQUAL |n| |i|) 1) + ('T 0)) + G170521)))))))) + (|getConstantFromDomain| '(|One|) S)))) + ('T + (OR (SPADLET |u| + (|coerceInt| + (|objNewWrap| |u| |source|) S)) + (|coercionFailure|)) + (CONS (CONS (|Zeros| |len|) (|objValUnwrap| |u|)) + NIL)))))))))) ;Var2Gdmp(u,source,target is [dmp,vl,S]) == ; sym := CADR source @@ -5290,42 +5652,46 @@ all these coercion functions have the following result: ; [[Zeros len,:objValUnwrap u]] (DEFUN |Var2Gdmp| (|u| |source| |target|) - (PROG (|dmp| |vl| S |sym| |len| |n|) - (RETURN - (SEQ - (PROGN - (SPADLET |dmp| (CAR |target|)) - (SPADLET |vl| (CADR |target|)) - (SPADLET S (CADDR |target|)) - (SPADLET |sym| (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (OR (|member| |sym| |vl|) (|canCoerce| |source| S))) - ((QUOTE T) - (SPADLET |len| (|#| |vl|)) - (COND - ((NEQUAL (SPADDIFFERENCE 1) (SPADLET |n| (|position| |sym| |vl|))) - (LIST - (CONS - (LIST2VEC - (PROG (#0=#:G170557) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G170562 (SPADDIFFERENCE |len| 1)) - (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| #1#) (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS - (COND ((BOOT-EQUAL |n| |i|) 1) ((QUOTE T) 0)) - #0#)))))))) - (|getConstantFromDomain| (QUOTE (|One|)) S)))) - ((QUOTE T) - (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |u| |source|) S)) - (|coercionFailure|)) - (CONS (CONS (|Zeros| |len|) (|objValUnwrap| |u|)) NIL)))))))))) + (PROG (|dmp| |vl| S |sym| |len| |n|) + (RETURN + (SEQ (PROGN + (SPADLET |dmp| (CAR |target|)) + (SPADLET |vl| (CADR |target|)) + (SPADLET S (CADDR |target|)) + (SPADLET |sym| (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (OR (|member| |sym| |vl|) (|canCoerce| |source| S))) + ('T (SPADLET |len| (|#| |vl|)) + (COND + ((NEQUAL (SPADDIFFERENCE 1) + (SPADLET |n| (|position| |sym| |vl|))) + (LIST (CONS (LIST2VEC + (PROG (G170557) + (SPADLET G170557 NIL) + (RETURN + (DO + ((G170562 + (SPADDIFFERENCE |len| 1)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G170562) + (NREVERSE0 G170557)) + (SEQ + (EXIT + (SETQ G170557 + (CONS + (COND + ((BOOT-EQUAL |n| |i|) 1) + ('T 0)) + G170557)))))))) + (|getConstantFromDomain| '(|One|) S)))) + ('T + (OR (SPADLET |u| + (|coerceInt| + (|objNewWrap| |u| |source|) S)) + (|coercionFailure|)) + (CONS (CONS (|Zeros| |len|) (|objValUnwrap| |u|)) + NIL)))))))))) ;Var2Mp(u,source,target is [mp,vl,S]) == ; sym := CADR source @@ -5336,27 +5702,29 @@ all these coercion functions have the following result: ; [0,:objValUnwrap u] (DEFUN |Var2Mp| (|u| |source| |target|) - (PROG (|mp| |vl| S |sym| |n|) - (RETURN - (PROGN - (SPADLET |mp| (CAR |target|)) - (SPADLET |vl| (CADR |target|)) - (SPADLET S (CADDR |target|)) - (SPADLET |sym| (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (OR (|member| |sym| |vl|) (|canCoerce| |source| S))) - ((NEQUAL (SPADLET |n| (|position1| |u| |vl|)) 0) - (CONS 1 - (CONS |n| - (CONS - (CONS 1 (CONS 0 (|getConstantFromDomain| (QUOTE (|One|)) S))) - NIL)))) - ((QUOTE T) - (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |u| |source|) S)) - (|coercionFailure|)) - (CONS 0 (|objValUnwrap| |u|)))))))) + (PROG (|mp| |vl| S |sym| |n|) + (RETURN + (PROGN + (SPADLET |mp| (CAR |target|)) + (SPADLET |vl| (CADR |target|)) + (SPADLET S (CADDR |target|)) + (SPADLET |sym| (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (OR (|member| |sym| |vl|) (|canCoerce| |source| S))) + ((NEQUAL (SPADLET |n| (|position1| |u| |vl|)) 0) + (CONS 1 + (CONS |n| + (CONS (CONS 1 + (CONS 0 + (|getConstantFromDomain| '(|One|) + S))) + NIL)))) + ('T + (OR (SPADLET |u| + (|coerceInt| (|objNewWrap| |u| |source|) S)) + (|coercionFailure|)) + (CONS 0 (|objValUnwrap| |u|)))))))) ;Var2NDmp(u,source,target is [ndmp,vl,S]) == ; sym := CADR source @@ -5369,42 +5737,46 @@ all these coercion functions have the following result: ; [[Zeros len,:objValUnwrap(u)]] (DEFUN |Var2NDmp| (|u| |source| |target|) - (PROG (|ndmp| |vl| S |sym| |len| |n|) - (RETURN - (SEQ - (PROGN - (SPADLET |ndmp| (CAR |target|)) - (SPADLET |vl| (CADR |target|)) - (SPADLET S (CADDR |target|)) - (SPADLET |sym| (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (OR (|member| |sym| |vl|) (|canCoerce| |source| S))) - ((QUOTE T) - (SPADLET |len| (|#| |vl|)) - (COND - ((NEQUAL (SPADDIFFERENCE 1) (SPADLET |n| (|position| |u| |vl|))) - (LIST - (CONS - (LIST2VEC - (PROG (#0=#:G170613) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G170618 (SPADDIFFERENCE |len| 1)) - (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| #1#) (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS - (COND ((BOOT-EQUAL |n| |i|) 1) ((QUOTE T) 0)) - #0#)))))))) - (|getConstantFromDomain| (QUOTE (|One|)) S)))) - ((QUOTE T) - (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |u| |source|) S)) - (|coercionFailure|)) - (CONS (CONS (|Zeros| |len|) (|objValUnwrap| |u|)) NIL)))))))))) + (PROG (|ndmp| |vl| S |sym| |len| |n|) + (RETURN + (SEQ (PROGN + (SPADLET |ndmp| (CAR |target|)) + (SPADLET |vl| (CADR |target|)) + (SPADLET S (CADDR |target|)) + (SPADLET |sym| (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (OR (|member| |sym| |vl|) (|canCoerce| |source| S))) + ('T (SPADLET |len| (|#| |vl|)) + (COND + ((NEQUAL (SPADDIFFERENCE 1) + (SPADLET |n| (|position| |u| |vl|))) + (LIST (CONS (LIST2VEC + (PROG (G170613) + (SPADLET G170613 NIL) + (RETURN + (DO + ((G170618 + (SPADDIFFERENCE |len| 1)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G170618) + (NREVERSE0 G170613)) + (SEQ + (EXIT + (SETQ G170613 + (CONS + (COND + ((BOOT-EQUAL |n| |i|) 1) + ('T 0)) + G170613)))))))) + (|getConstantFromDomain| '(|One|) S)))) + ('T + (OR (SPADLET |u| + (|coerceInt| + (|objNewWrap| |u| |source|) S)) + (|coercionFailure|)) + (CONS (CONS (|Zeros| |len|) (|objValUnwrap| |u|)) + NIL)))))))))) ;Var2P(u,source,target is [poly,S]) == ; sym := CADR source @@ -5417,24 +5789,30 @@ all these coercion functions have the following result: ; [1,sym,[1,0,:getConstantFromDomain('(One),S)]] (DEFUN |Var2P| (|u| |source| |target|) - (PROG (|poly| S |sym| |u'|) - (RETURN - (PROGN - (SPADLET |poly| (CAR |target|)) - (SPADLET S (CADR |target|)) - (SPADLET |sym| (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (QUOTE T)) - ((QUOTE T) - (COND - ((NEQUAL S |$Integer|) - (SPADLET |u'| (|coerceInt| (|objNewWrap| |u| |source|) S)) - (COND (|u'| (RETURN (CONS 0 (|objValUnwrap| |u'|)))) ((QUOTE T) NIL)))) - (CONS 1 - (CONS |sym| - (CONS - (CONS 1 (CONS 0 (|getConstantFromDomain| (QUOTE (|One|)) S))) - NIL))))))))) + (PROG (|poly| S |sym| |u'|) + (DECLARE (SPECIAL |$Integer|)) + (RETURN + (PROGN + (SPADLET |poly| (CAR |target|)) + (SPADLET S (CADR |target|)) + (SPADLET |sym| (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) 'T) + ('T + (COND + ((NEQUAL S |$Integer|) + (SPADLET |u'| + (|coerceInt| (|objNewWrap| |u| |source|) S)) + (COND + (|u'| (RETURN (CONS 0 (|objValUnwrap| |u'|)))) + ('T NIL)))) + (CONS 1 + (CONS |sym| + (CONS (CONS 1 + (CONS 0 + (|getConstantFromDomain| '(|One|) + S))) + NIL))))))))) ;Var2QF(u,source,target is [qf,S]) == ; u = '_$fromCoerceable_$ => canCoerce(source,S) @@ -5444,22 +5822,22 @@ all these coercion functions have the following result: ; [objValUnwrap u',:getConstantFromDomain('(One),S)] (DEFUN |Var2QF| (|u| |source| |target|) - (PROG (|qf| S |sym| |u'|) - (RETURN - (PROGN - (SPADLET |qf| (CAR |target|)) - (SPADLET S (CADR |target|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| |source| S)) - ((BOOT-EQUAL S |$Integer|) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |sym| (CADR |source|)) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |u| |source|) S)) - (|coercionFailure|)) - (CONS - (|objValUnwrap| |u'|) - (|getConstantFromDomain| (QUOTE (|One|)) S)))))))) + (PROG (|qf| S |sym| |u'|) + (DECLARE (SPECIAL |$Integer|)) + (RETURN + (PROGN + (SPADLET |qf| (CAR |target|)) + (SPADLET S (CADR |target|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (|canCoerce| |source| S)) + ((BOOT-EQUAL S |$Integer|) (|coercionFailure|)) + ('T (SPADLET |sym| (CADR |source|)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |u| |source|) S)) + (|coercionFailure|)) + (CONS (|objValUnwrap| |u'|) + (|getConstantFromDomain| '(|One|) S)))))))) ;Var2FS(u,source,target is [fs,S]) == ; u = '_$fromCoerceable_$ => true @@ -5469,22 +5847,21 @@ all these coercion functions have the following result: ; objValUnwrap v (DEFUN |Var2FS| (|u| |source| |target|) - (PROG (|fs| S |v|) - (RETURN - (PROGN - (SPADLET |fs| (CAR |target|)) - (SPADLET S (CADR |target|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (QUOTE T)) - ((QUOTE T) - (OR - (SPADLET |v| - (|coerceInt| - (|objNewWrap| |u| |source|) - (CONS (QUOTE |Polynomial|) (CONS S NIL)))) - (|coercionFailure|)) - (OR (SPADLET |v| (|coerceInt| |v| |target|)) (|coercionFailure|)) - (|objValUnwrap| |v|))))))) + (PROG (|fs| S |v|) + (RETURN + (PROGN + (SPADLET |fs| (CAR |target|)) + (SPADLET S (CADR |target|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) 'T) + ('T + (OR (SPADLET |v| + (|coerceInt| (|objNewWrap| |u| |source|) + (CONS '|Polynomial| (CONS S NIL)))) + (|coercionFailure|)) + (OR (SPADLET |v| (|coerceInt| |v| |target|)) + (|coercionFailure|)) + (|objValUnwrap| |v|))))))) ;Var2Up(u,source,target is [up,x,S]) == ; sym := CADR source @@ -5494,23 +5871,23 @@ all these coercion functions have the following result: ; [[0,:objValUnwrap u]] (DEFUN |Var2Up| (|u| |source| |target|) - (PROG (|up| |x| S |sym|) - (RETURN - (PROGN - (SPADLET |up| (CAR |target|)) - (SPADLET |x| (CADR |target|)) - (SPADLET S (CADDR |target|)) - (SPADLET |sym| (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (OR (BOOT-EQUAL |sym| |x|) (|canCoerce| |source| S))) - ((BOOT-EQUAL |x| |sym|) - (CONS (CONS 1 (|getConstantFromDomain| (QUOTE (|One|)) S)) NIL)) - ((QUOTE T) - (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |u| |source|) S)) - (|coercionFailure|)) - (CONS (CONS 0 (|objValUnwrap| |u|)) NIL))))))) + (PROG (|up| |x| S |sym|) + (RETURN + (PROGN + (SPADLET |up| (CAR |target|)) + (SPADLET |x| (CADR |target|)) + (SPADLET S (CADDR |target|)) + (SPADLET |sym| (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (OR (BOOT-EQUAL |sym| |x|) (|canCoerce| |source| S))) + ((BOOT-EQUAL |x| |sym|) + (CONS (CONS 1 (|getConstantFromDomain| '(|One|) S)) NIL)) + ('T + (OR (SPADLET |u| + (|coerceInt| (|objNewWrap| |u| |source|) S)) + (|coercionFailure|)) + (CONS (CONS 0 (|objValUnwrap| |u|)) NIL))))))) ;Var2SUP(u,source,target is [sup,S]) == ; sym := CADR source @@ -5520,22 +5897,22 @@ all these coercion functions have the following result: ; [[0,:objValUnwrap u]] (DEFUN |Var2SUP| (|u| |source| |target|) - (PROG (|sup| S |sym|) - (RETURN - (PROGN - (SPADLET |sup| (CAR |target|)) - (SPADLET S (CADR |target|)) - (SPADLET |sym| (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (OR (BOOT-EQUAL |sym| (QUOTE ?)) (|canCoerce| |source| S))) - ((BOOT-EQUAL |sym| (QUOTE ?)) - (CONS (CONS 1 (|getConstantFromDomain| (QUOTE (|One|)) S)) NIL)) - ((QUOTE T) - (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |u| |source|) S)) - (|coercionFailure|)) - (CONS (CONS 0 (|objValUnwrap| |u|)) NIL))))))) + (PROG (|sup| S |sym|) + (RETURN + (PROGN + (SPADLET |sup| (CAR |target|)) + (SPADLET S (CADR |target|)) + (SPADLET |sym| (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (OR (BOOT-EQUAL |sym| '?) (|canCoerce| |source| S))) + ((BOOT-EQUAL |sym| '?) + (CONS (CONS 1 (|getConstantFromDomain| '(|One|) S)) NIL)) + ('T + (OR (SPADLET |u| + (|coerceInt| (|objNewWrap| |u| |source|) S)) + (|coercionFailure|)) + (CONS (CONS 0 (|objValUnwrap| |u|)) NIL))))))) ;Var2UpS(u,source,target is [ups,x,S]) == ; sym := CADR source @@ -5550,34 +5927,35 @@ all these coercion functions have the following result: ; objValUnwrap u (DEFUN |Var2UpS| (|u| |source| |target|) - (PROG (|ups| |x| S |sym| |mid|) - (RETURN - (PROGN - (SPADLET |ups| (CAR |target|)) - (SPADLET |x| (CADR |target|)) - (SPADLET S (CADDR |target|)) - (SPADLET |sym| (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (OR (BOOT-EQUAL |sym| |x|) (|canCoerce| |source| S))) - ((QUOTE T) - (SPADLET |mid| - (CONS (QUOTE |UnivariatePolynomial|) (CONS |x| (CONS S NIL)))) - (COND - ((BOOT-EQUAL |x| |sym|) - (SPADLET |u| (|Var2Up| |u| |source| |mid|)) - (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |u| |mid|) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u|)) - ((QUOTE T) - (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |u| |source|) S)) - (|coercionFailure|)) - (OR - (SPADLET |u| (|coerceInt| |u| |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u|))))))))) + (PROG (|ups| |x| S |sym| |mid|) + (RETURN + (PROGN + (SPADLET |ups| (CAR |target|)) + (SPADLET |x| (CADR |target|)) + (SPADLET S (CADDR |target|)) + (SPADLET |sym| (CADR |source|)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (OR (BOOT-EQUAL |sym| |x|) (|canCoerce| |source| S))) + ('T + (SPADLET |mid| + (CONS '|UnivariatePolynomial| + (CONS |x| (CONS S NIL)))) + (COND + ((BOOT-EQUAL |x| |sym|) + (SPADLET |u| (|Var2Up| |u| |source| |mid|)) + (OR (SPADLET |u| + (|coerceInt| (|objNewWrap| |u| |mid|) + |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u|)) + ('T + (OR (SPADLET |u| + (|coerceInt| (|objNewWrap| |u| |source|) S)) + (|coercionFailure|)) + (OR (SPADLET |u| (|coerceInt| |u| |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u|))))))))) ;Var2OtherPS(u,source,target is [.,x,S]) == ; sym := CADR source @@ -5589,25 +5967,25 @@ all these coercion functions have the following result: ; objValUnwrap u (DEFUN |Var2OtherPS| (|u| |source| |target|) - (PROG (|x| S |sym| |mid|) - (RETURN - (PROGN - (SPADLET |x| (CADR |target|)) - (SPADLET S (CADDR |target|)) - (SPADLET |sym| (CADR |source|)) - (SPADLET |mid| - (CONS (QUOTE |UnivariatePowerSeries|) (CONS |x| (CONS S NIL)))) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (OR - (BOOT-EQUAL |sym| |x|) - (AND (|canCoerce| |source| |mid|) (|canCoerce| |mid| |target|)))) - ((QUOTE T) - (SPADLET |u| (|Var2UpS| |u| |source| |mid|)) - (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |u| |mid|) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u|))))))) + (PROG (|x| S |sym| |mid|) + (RETURN + (PROGN + (SPADLET |x| (CADR |target|)) + (SPADLET S (CADDR |target|)) + (SPADLET |sym| (CADR |source|)) + (SPADLET |mid| + (CONS '|UnivariatePowerSeries| + (CONS |x| (CONS S NIL)))) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (OR (BOOT-EQUAL |sym| |x|) + (AND (|canCoerce| |source| |mid|) + (|canCoerce| |mid| |target|)))) + ('T (SPADLET |u| (|Var2UpS| |u| |source| |mid|)) + (OR (SPADLET |u| + (|coerceInt| (|objNewWrap| |u| |mid|) |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u|))))))) ;--% Vector ;V2M(u,[.,D],[.,R]) == @@ -5623,53 +6001,59 @@ all these coercion functions have the following result: ; -- if not, try making it into a 1 by n matrix ; coercionFailure() -(DEFUN V2M (|u| #0=#:G170765 #1=#:G170776) - (PROG (R D |ISTMP#1| E |x|) - (RETURN - (SEQ - (PROGN - (SPADLET R (CADR #1#)) - (SPADLET D (CADR #0#)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (COND - ((AND (PAIRP D) (EQ (QCAR D) (QUOTE |Vector|))) NIL) - ((QUOTE T) (|canCoerce| D R)))) - ((AND (PAIRP D) - (EQ (QCAR D) (QUOTE |Vector|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR D)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET E (QCAR |ISTMP#1|)) (QUOTE T)))) - (|isRectangularVector| |u| (MAXINDEX |u|) (MAXINDEX (ELT |u| 0)))) - (LIST2VEC - (PROG (#2=#:G170794) - (SPADLET #2# NIL) - (RETURN - (DO ((#3=#:G170799 (MAXINDEX |u|)) (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| #3#) (NREVERSE0 #2#)) - (SEQ - (EXIT - (SETQ #2# - (CONS - (LIST2VEC - (PROG (#4=#:G170807) - (SPADLET #4# NIL) - (RETURN - (DO ((#5=#:G170812 (MAXINDEX (SPADLET |x| (ELT |u| |i|)))) - (|j| 0 (QSADD1 |j|))) - ((QSGREATERP |j| #5#) (NREVERSE0 #4#)) - (SEQ - (EXIT - (SETQ #4# - (CONS - (|objValUnwrap| - (|coerceInt| (|objNewWrap| (ELT |x| |j|) E) R)) - #4#)))))))) - #2#))))))))) - ((QUOTE T) (|coercionFailure|)))))))) +(DEFUN V2M (|u| G170765 G170776) + (PROG (R D |ISTMP#1| E |x|) + (RETURN + (SEQ (PROGN + (SPADLET R (CADR G170776)) + (SPADLET D (CADR G170765)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (COND + ((AND (PAIRP D) (EQ (QCAR D) '|Vector|)) NIL) + ('T (|canCoerce| D R)))) + ((AND (PAIRP D) (EQ (QCAR D) '|Vector|) + (PROGN + (SPADLET |ISTMP#1| (QCDR D)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET E (QCAR |ISTMP#1|)) 'T))) + (|isRectangularVector| |u| (MAXINDEX |u|) + (MAXINDEX (ELT |u| 0)))) + (LIST2VEC + (PROG (G170794) + (SPADLET G170794 NIL) + (RETURN + (DO ((G170799 (MAXINDEX |u|)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G170799) + (NREVERSE0 G170794)) + (SEQ (EXIT (SETQ G170794 + (CONS + (LIST2VEC + (PROG (G170807) + (SPADLET G170807 NIL) + (RETURN + (DO + ((G170812 + (MAXINDEX + (SPADLET |x| + (ELT |u| |i|)))) + (|j| 0 (QSADD1 |j|))) + ((QSGREATERP |j| + G170812) + (NREVERSE0 G170807)) + (SEQ + (EXIT + (SETQ G170807 + (CONS + (|objValUnwrap| + (|coerceInt| + (|objNewWrap| + (ELT |x| |j|) E) + R)) + G170807)))))))) + G170794))))))))) + ('T (|coercionFailure|)))))))) ;--LIST2VEC [LIST2VEC [objValUnwrap(coerceInt(objNewWrap(u.i,D),R)) ;-- for i in 0..MAXINDEX(u)]] @@ -5681,52 +6065,58 @@ all these coercion functions have the following result: ; for j in 0..MAXINDEX(x:=u.i)] for i in 0..MAXINDEX u] ; coercionFailure() -(DEFUN |V2Rm| (|u| #0=#:G170831 #1=#:G170842) - (PROG (|n| |m| R D |ISTMP#1| E |x|) - (RETURN - (SEQ - (PROGN - (SPADLET |n| (CADR #1#)) - (SPADLET |m| (CADDR #1#)) - (SPADLET R (CADDDR #1#)) - (SPADLET D (CADR #0#)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) NIL) - ((AND (PAIRP D) - (PROGN - (SPADLET |ISTMP#1| (QCDR D)) - (AND - (PAIRP |ISTMP#1|) - (PROGN (SPADLET E (QCAR |ISTMP#1|)) (QUOTE T)))) - (|isRectangularVector| |u| - (SPADDIFFERENCE |n| 1) - (SPADDIFFERENCE |m| 1))) - (LIST2VEC - (PROG (#2=#:G170864) - (SPADLET #2# NIL) - (RETURN - (DO ((#3=#:G170869 (MAXINDEX |u|)) (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| #3#) (NREVERSE0 #2#)) - (SEQ - (EXIT - (SETQ #2# - (CONS - (LIST2VEC - (PROG (#4=#:G170877) - (SPADLET #4# NIL) - (RETURN - (DO ((#5=#:G170882 (MAXINDEX (SPADLET |x| (ELT |u| |i|)))) - (|j| 0 (QSADD1 |j|))) - ((QSGREATERP |j| #5#) (NREVERSE0 #4#)) - (SEQ - (EXIT - (SETQ #4# - (CONS - (|objValUnwrap| - (|coerceInt| (|objNewWrap| (ELT |x| |j|) E) R)) - #4#)))))))) - #2#))))))))) - ((QUOTE T) (|coercionFailure|)))))))) +(DEFUN |V2Rm| (|u| G170831 G170842) + (PROG (|n| |m| R D |ISTMP#1| E |x|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (CADR G170842)) + (SPADLET |m| (CADDR G170842)) + (SPADLET R (CADDDR G170842)) + (SPADLET D (CADR G170831)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) NIL) + ((AND (PAIRP D) + (PROGN + (SPADLET |ISTMP#1| (QCDR D)) + (AND (PAIRP |ISTMP#1|) + (PROGN (SPADLET E (QCAR |ISTMP#1|)) 'T))) + (|isRectangularVector| |u| (SPADDIFFERENCE |n| 1) + (SPADDIFFERENCE |m| 1))) + (LIST2VEC + (PROG (G170864) + (SPADLET G170864 NIL) + (RETURN + (DO ((G170869 (MAXINDEX |u|)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G170869) + (NREVERSE0 G170864)) + (SEQ (EXIT (SETQ G170864 + (CONS + (LIST2VEC + (PROG (G170877) + (SPADLET G170877 NIL) + (RETURN + (DO + ((G170882 + (MAXINDEX + (SPADLET |x| + (ELT |u| |i|)))) + (|j| 0 (QSADD1 |j|))) + ((QSGREATERP |j| + G170882) + (NREVERSE0 G170877)) + (SEQ + (EXIT + (SETQ G170877 + (CONS + (|objValUnwrap| + (|coerceInt| + (|objNewWrap| + (ELT |x| |j|) E) + R)) + G170877)))))))) + G170864))))))))) + ('T (|coercionFailure|)))))))) ;V2Sm(u,[.,D],[.,n,R]) == ; u = '_$fromCoerceable_$ => nil @@ -5736,91 +6126,97 @@ all these coercion functions have the following result: ; for j in 0..MAXINDEX(x:=u.i)] for i in 0..MAXINDEX u] ; coercionFailure() -(DEFUN |V2Sm| (|u| #0=#:G170903 #1=#:G170914) - (PROG (|n| R D |ISTMP#1| E |x|) - (RETURN - (SEQ - (PROGN - (SPADLET |n| (CADR #1#)) - (SPADLET R (CADDR #1#)) - (SPADLET D (CADR #0#)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) NIL) - ((AND (PAIRP D) - (PROGN - (SPADLET |ISTMP#1| (QCDR D)) - (AND - (PAIRP |ISTMP#1|) - (PROGN (SPADLET E (QCAR |ISTMP#1|)) (QUOTE T)))) - (|isRectangularVector| |u| - (SPADDIFFERENCE |n| 1) - (SPADDIFFERENCE |n| 1))) - (LIST2VEC - (PROG (#2=#:G170934) - (SPADLET #2# NIL) - (RETURN - (DO ((#3=#:G170939 (MAXINDEX |u|)) (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| #3#) (NREVERSE0 #2#)) - (SEQ - (EXIT - (SETQ #2# - (CONS - (LIST2VEC - (PROG (#4=#:G170947) - (SPADLET #4# NIL) - (RETURN - (DO ((#5=#:G170952 (MAXINDEX (SPADLET |x| (ELT |u| |i|)))) - (|j| 0 (QSADD1 |j|))) - ((QSGREATERP |j| #5#) (NREVERSE0 #4#)) - (SEQ - (EXIT - (SETQ #4# - (CONS - (|objValUnwrap| - (|coerceInt| (|objNewWrap| (ELT |x| |j|) E) R)) - #4#)))))))) - #2#))))))))) - ((QUOTE T) (|coercionFailure|)))))))) +(DEFUN |V2Sm| (|u| G170903 G170914) + (PROG (|n| R D |ISTMP#1| E |x|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (CADR G170914)) + (SPADLET R (CADDR G170914)) + (SPADLET D (CADR G170903)) + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) NIL) + ((AND (PAIRP D) + (PROGN + (SPADLET |ISTMP#1| (QCDR D)) + (AND (PAIRP |ISTMP#1|) + (PROGN (SPADLET E (QCAR |ISTMP#1|)) 'T))) + (|isRectangularVector| |u| (SPADDIFFERENCE |n| 1) + (SPADDIFFERENCE |n| 1))) + (LIST2VEC + (PROG (G170934) + (SPADLET G170934 NIL) + (RETURN + (DO ((G170939 (MAXINDEX |u|)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G170939) + (NREVERSE0 G170934)) + (SEQ (EXIT (SETQ G170934 + (CONS + (LIST2VEC + (PROG (G170947) + (SPADLET G170947 NIL) + (RETURN + (DO + ((G170952 + (MAXINDEX + (SPADLET |x| + (ELT |u| |i|)))) + (|j| 0 (QSADD1 |j|))) + ((QSGREATERP |j| + G170952) + (NREVERSE0 G170947)) + (SEQ + (EXIT + (SETQ G170947 + (CONS + (|objValUnwrap| + (|coerceInt| + (|objNewWrap| + (ELT |x| |j|) E) + R)) + G170947)))))))) + G170934))))))))) + ('T (|coercionFailure|)))))))) ;isRectangularVector(x,p,q) == ; MAXINDEX x = p => ; and/[q=MAXINDEX x.i for i in 0..p] (DEFUN |isRectangularVector| (|x| |p| |q|) - (PROG NIL - (RETURN - (SEQ - (COND - ((BOOT-EQUAL (MAXINDEX |x|) |p|) - (EXIT - (PROG (#0=#:G170967) - (SPADLET #0# (QUOTE T)) - (RETURN - (DO ((#1=#:G170973 NIL (NULL #0#)) (|i| 0 (QSADD1 |i|))) - ((OR #1# (QSGREATERP |i| |p|)) #0#) - (SEQ - (EXIT - (SETQ #0# - (AND #0# (BOOT-EQUAL |q| (MAXINDEX (ELT |x| |i|))))))))))))))))) + (PROG () + (RETURN + (SEQ (COND + ((BOOT-EQUAL (MAXINDEX |x|) |p|) + (EXIT (PROG (G170967) + (SPADLET G170967 'T) + (RETURN + (DO ((G170973 NIL (NULL G170967)) + (|i| 0 (QSADD1 |i|))) + ((OR G170973 (QSGREATERP |i| |p|)) + G170967) + (SEQ (EXIT (SETQ G170967 + (AND G170967 + (BOOT-EQUAL |q| + (MAXINDEX (ELT |x| |i|))))))))))))))))) ;-- Polynomial and Expression to Univariate series types ;P2Uts(u, source, target) == ; P2Us(u,source, target, 'taylor) (DEFUN |P2Uts| (|u| |source| |target|) - (|P2Us| |u| |source| |target| (QUOTE |taylor|))) + (|P2Us| |u| |source| |target| '|taylor|)) ;P2Uls(u, source, target) == ; P2Us(u,source, target, 'laurent) (DEFUN |P2Uls| (|u| |source| |target|) - (|P2Us| |u| |source| |target| (QUOTE |laurent|))) + (|P2Us| |u| |source| |target| '|laurent|)) ;P2Upxs(u, source, target) == ; P2Us(u,source, target, 'puiseux) (DEFUN |P2Upxs| (|u| |source| |target|) - (|P2Us| |u| |source| |target| (QUOTE |puiseux|))) + (|P2Us| |u| |source| |target| '|puiseux|)) ;P2Us(u, source is [.,S], target is [.,T,var,cen], type) == ; u = '_$fromCoerceable_$ => @@ -5850,61 +6246,64 @@ all these coercion functions have the following result: ; objValUnwrap finalObj (DEFUN |P2Us| (|u| |source| |target| |type|) - (PROG (T$ |var| |cen| S |obj| E |newU| |EQtype| |eqfun| |varE| |cenE| |eq| - |package| |func| |newObj| |newType| |newVal| |finalObj|) - (RETURN - (PROGN - (SPADLET T$ (CADR |target|)) - (SPADLET |var| (CADDR |target|)) - (SPADLET |cen| (CADDDR |target|)) - (SPADLET S (CADR |source|)) - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| S T$)) - ((NULL (AND (PAIRP T$) (EQ (QCAR T$) (QUOTE |Expression|)))) - (|coercionFailure|)) - ((QUOTE T) - (COND ((NEQUAL S (QUOTE (|Float|))) (SPADLET S |$Integer|))) - (SPADLET |obj| (|objNewWrap| |u| |source|)) - (SPADLET E (CONS (QUOTE |Expression|) (CONS S NIL))) - (SPADLET |newU| (|coerceInt| |obj| E)) - (COND - ((NULL |newU|) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |EQtype| (CONS (QUOTE |Equation|) (CONS E NIL))) - (SPADLET |eqfun| - (|getFunctionFromDomain| (QUOTE =) |EQtype| (CONS E (CONS E NIL)))) - (SPADLET |varE| - (|coerceInt| (|objNewWrap| |var| (QUOTE (|Symbol|))) E)) + (PROG (T$ |var| |cen| S |obj| E |newU| |EQtype| |eqfun| |varE| |cenE| + |eq| |package| |func| |newObj| |newType| |newVal| + |finalObj|) + (DECLARE (SPECIAL |$Integer|)) + (RETURN + (PROGN + (SPADLET T$ (CADR |target|)) + (SPADLET |var| (CADDR |target|)) + (SPADLET |cen| (CADDDR |target|)) + (SPADLET S (CADR |source|)) (COND - ((NULL |varE|) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |cenE| (|coerceInt| (|objNewWrap| |cen| T$) E)) - (COND - ((NULL |cenE|) (|coercionFailure|)) - ((QUOTE T) - (SPADLET |eq| - (SPADCALL - (|objValUnwrap| |varE|) - (|objValUnwrap| |cenE|) - |eqfun|)) - (SPADLET |package| - (CONS - (QUOTE |ExpressionToUnivariatePowerSeries|) - (CONS S (CONS E NIL)))) - (SPADLET |func| - (|getFunctionFromDomain| |type| |package| - (CONS E (CONS |EQtype| NIL)))) - (SPADLET |newObj| (SPADCALL (|objValUnwrap| |newU|) |eq| |func|)) - (SPADLET |newType| (CAR |newObj|)) - (SPADLET |newVal| (CDR |newObj|)) - (COND - ((BOOT-EQUAL |newType| |target|) |newVal|) - ((QUOTE T) - (SPADLET |finalObj| - (|coerceInt| (|objNewWrap| |newVal| |newType|) |target|)) + ((BOOT-EQUAL |u| '|$fromCoerceable$|) (|canCoerce| S T$)) + ((NULL (AND (PAIRP T$) (EQ (QCAR T$) '|Expression|))) + (|coercionFailure|)) + ('T (COND ((NEQUAL S '(|Float|)) (SPADLET S |$Integer|))) + (SPADLET |obj| (|objNewWrap| |u| |source|)) + (SPADLET E (CONS '|Expression| (CONS S NIL))) + (SPADLET |newU| (|coerceInt| |obj| E)) + (COND + ((NULL |newU|) (|coercionFailure|)) + ('T (SPADLET |EQtype| (CONS '|Equation| (CONS E NIL))) + (SPADLET |eqfun| + (|getFunctionFromDomain| '= |EQtype| + (CONS E (CONS E NIL)))) + (SPADLET |varE| + (|coerceInt| (|objNewWrap| |var| '(|Symbol|)) E)) (COND - ((NULL |finalObj|) (|coercionFailure|)) - ((QUOTE T) (|objValUnwrap| |finalObj|))))))))))))))))) + ((NULL |varE|) (|coercionFailure|)) + ('T + (SPADLET |cenE| + (|coerceInt| (|objNewWrap| |cen| T$) E)) + (COND + ((NULL |cenE|) (|coercionFailure|)) + ('T + (SPADLET |eq| + (SPADCALL (|objValUnwrap| |varE|) + (|objValUnwrap| |cenE|) |eqfun|)) + (SPADLET |package| + (CONS '|ExpressionToUnivariatePowerSeries| + (CONS S (CONS E NIL)))) + (SPADLET |func| + (|getFunctionFromDomain| |type| |package| + (CONS E (CONS |EQtype| NIL)))) + (SPADLET |newObj| + (SPADCALL (|objValUnwrap| |newU|) |eq| + |func|)) + (SPADLET |newType| (CAR |newObj|)) + (SPADLET |newVal| (CDR |newObj|)) + (COND + ((BOOT-EQUAL |newType| |target|) |newVal|) + ('T + (SPADLET |finalObj| + (|coerceInt| + (|objNewWrap| |newVal| |newType|) + |target|)) + (COND + ((NULL |finalObj|) (|coercionFailure|)) + ('T (|objValUnwrap| |finalObj|))))))))))))))))) ;--% General Coercion Commutation Functions ;-- general commutation functions are called with 5 values @@ -5931,37 +6330,33 @@ all these coercion functions have the following result: ; SPADCALL(objValUnwrap real,i,f) (DEFUN |commuteComplex| (|u| |source| S |target| T$) - (PROG (|real| |imag| |T'| |i| |f|) - (RETURN - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (AND (|canCoerce| S |target|) (|canCoerce| T$ |target|))) - ((QUOTE T) - (SPADLET |real| (CAR |u|)) - (SPADLET |imag| (CDR |u|)) - (OR - (SPADLET |real| (|coerceInt| (|objNewWrap| |real| S) |target|)) - (|coercionFailure|)) - (OR - (SPADLET |imag| (|coerceInt| (|objNewWrap| |imag| S) |target|)) - (|coercionFailure|)) - (SPADLET |T'| (|underDomainOf| T$)) - (SPADLET |i| (CONS (|domainZero| |T'|) (|domainOne| |T'|))) - (OR - (SPADLET |i| (|coerceInt| (|objNewWrap| |i| T$) |target|)) - (|coercionFailure|)) - (SPADLET |f| - (|getFunctionFromDomain| - (QUOTE *) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |i| (SPADCALL (|objValUnwrap| |i|) (|objValUnwrap| |imag|) |f|)) - (SPADLET |f| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADCALL (|objValUnwrap| |real|) |i| |f|)))))) + (DECLARE (IGNORE |source|)) + (PROG (|real| |imag| |T'| |i| |f|) + (RETURN + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (AND (|canCoerce| S |target|) (|canCoerce| T$ |target|))) + ('T (SPADLET |real| (CAR |u|)) (SPADLET |imag| (CDR |u|)) + (OR (SPADLET |real| + (|coerceInt| (|objNewWrap| |real| S) |target|)) + (|coercionFailure|)) + (OR (SPADLET |imag| + (|coerceInt| (|objNewWrap| |imag| S) |target|)) + (|coercionFailure|)) + (SPADLET |T'| (|underDomainOf| T$)) + (SPADLET |i| (CONS (|domainZero| |T'|) (|domainOne| |T'|))) + (OR (SPADLET |i| (|coerceInt| (|objNewWrap| |i| T$) |target|)) + (|coercionFailure|)) + (SPADLET |f| + (|getFunctionFromDomain| '* |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |i| + (SPADCALL (|objValUnwrap| |i|) + (|objValUnwrap| |imag|) |f|)) + (SPADLET |f| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADCALL (|objValUnwrap| |real|) |i| |f|)))))) ;--% Quaternion ;commuteQuaternion(u,source,S,target,T) == @@ -5982,89 +6377,102 @@ all these coercion functions have the following result: ; u' (DEFUN |commuteQuaternion| (|u| |source| S |target| T$) - (PROG (|c| |q| |e| |mult| |plus| |u'|) - (RETURN - (SEQ - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (AND (|canCoerce| S |target|) (|canCoerce| T$ |target|))) - ((QUOTE T) - (SPADLET |c| - (PROG (#0=#:G171055) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G171060 (VEC2LIST |u|) (CDR #1#)) (|x| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS - (|objValUnwrap| - (OR - (|coerceInt| (|objNewWrap| |x| S) |target|) - (|coercionFailure|))) - #0#)))))))) - (SPADLET |q| (QUOTE (|Quaternion| (|Integer|)))) - (SPADLET |e| - (CONS - (CONS 1 (CONS 0 (CONS 0 (CONS 0 NIL)))) - (CONS - (CONS 0 (CONS 1 (CONS 0 (CONS 0 NIL)))) - (CONS - (CONS 0 (CONS 0 (CONS 1 (CONS 0 NIL)))) - (CONS (CONS 0 (CONS 0 (CONS 0 (CONS 1 NIL)))) NIL))))) - (SPADLET |e| - (PROG (#2=#:G171070) - (SPADLET #2# NIL) - (RETURN - (DO ((#3=#:G171075 |e| (CDR #3#)) (|x| NIL)) - ((OR (ATOM #3#) (PROGN (SETQ |x| (CAR #3#)) NIL)) (NREVERSE0 #2#)) - (SEQ - (EXIT - (SETQ #2# - (CONS - (OR - (|coerceInt| (|objNewWrap| (LIST2VEC |x|) |q|) T$) - (|coercionFailure|)) - #2#)))))))) - (SPADLET |e| - (PROG (#4=#:G171085) - (SPADLET #4# NIL) - (RETURN - (DO ((#5=#:G171090 |e| (CDR #5#)) (|x| NIL)) - ((OR (ATOM #5#) (PROGN (SETQ |x| (CAR #5#)) NIL)) - (NREVERSE0 #4#)) - (SEQ - (EXIT - (SETQ #4# - (CONS - (|objValUnwrap| - (OR (|coerceInt| |x| |target|) (|coercionFailure|))) - #4#)))))))) - (SPADLET |u'| (|domainZero| |target|)) - (SPADLET |mult| - (|getFunctionFromDomain| - (QUOTE *) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |plus| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (DO ((#6=#:G171100 |c| (CDR #6#)) - (|x| NIL) - (#7=#:G171101 |e| (CDR #7#)) - (|y| NIL)) - ((OR (ATOM #6#) - (PROGN (SETQ |x| (CAR #6#)) NIL) - (ATOM #7#) - (PROGN (SETQ |y| (CAR #7#)) NIL)) - NIL) - (SEQ - (EXIT - (SPADLET |u'| (SPADCALL |u'| (SPADCALL |x| |y| |mult|) |plus|))))) - |u'|)))))) + (DECLARE (IGNORE |source|)) + (PROG (|c| |q| |e| |mult| |plus| |u'|) + (RETURN + (SEQ (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (AND (|canCoerce| S |target|) (|canCoerce| T$ |target|))) + ('T + (SPADLET |c| + (PROG (G171055) + (SPADLET G171055 NIL) + (RETURN + (DO ((G171060 (VEC2LIST |u|) + (CDR G171060)) + (|x| NIL)) + ((OR (ATOM G171060) + (PROGN + (SETQ |x| (CAR G171060)) + NIL)) + (NREVERSE0 G171055)) + (SEQ (EXIT (SETQ G171055 + (CONS + (|objValUnwrap| + (OR + (|coerceInt| + (|objNewWrap| |x| S) + |target|) + (|coercionFailure|))) + G171055)))))))) + (SPADLET |q| '(|Quaternion| (|Integer|))) + (SPADLET |e| + (CONS (CONS 1 (CONS 0 (CONS 0 (CONS 0 NIL)))) + (CONS (CONS 0 + (CONS 1 (CONS 0 (CONS 0 NIL)))) + (CONS + (CONS 0 + (CONS 0 (CONS 1 (CONS 0 NIL)))) + (CONS + (CONS 0 + (CONS 0 (CONS 0 (CONS 1 NIL)))) + NIL))))) + (SPADLET |e| + (PROG (G171070) + (SPADLET G171070 NIL) + (RETURN + (DO ((G171075 |e| (CDR G171075)) + (|x| NIL)) + ((OR (ATOM G171075) + (PROGN + (SETQ |x| (CAR G171075)) + NIL)) + (NREVERSE0 G171070)) + (SEQ (EXIT (SETQ G171070 + (CONS + (OR + (|coerceInt| + (|objNewWrap| + (LIST2VEC |x|) |q|) + T$) + (|coercionFailure|)) + G171070)))))))) + (SPADLET |e| + (PROG (G171085) + (SPADLET G171085 NIL) + (RETURN + (DO ((G171090 |e| (CDR G171090)) + (|x| NIL)) + ((OR (ATOM G171090) + (PROGN + (SETQ |x| (CAR G171090)) + NIL)) + (NREVERSE0 G171085)) + (SEQ (EXIT (SETQ G171085 + (CONS + (|objValUnwrap| + (OR + (|coerceInt| |x| |target|) + (|coercionFailure|))) + G171085)))))))) + (SPADLET |u'| (|domainZero| |target|)) + (SPADLET |mult| + (|getFunctionFromDomain| '* |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |plus| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (DO ((G171100 |c| (CDR G171100)) (|x| NIL) + (G171101 |e| (CDR G171101)) (|y| NIL)) + ((OR (ATOM G171100) + (PROGN (SETQ |x| (CAR G171100)) NIL) + (ATOM G171101) + (PROGN (SETQ |y| (CAR G171101)) NIL)) + NIL) + (SEQ (EXIT (SPADLET |u'| + (SPADCALL |u'| + (SPADCALL |x| |y| |mult|) |plus|))))) + |u'|)))))) ;--% Fraction ;commuteFraction(u,source,S,target,T) == @@ -6094,54 +6502,49 @@ all these coercion functions have the following result: ; SPADCALL(objValUnwrap d',objValUnwrap n',multfunc) (DEFUN |commuteFraction| (|u| |source| S |target| T$) - (PROG (|n| |d| |inv| |d'| |n'| |multfunc|) - (RETURN - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (COND - ((|ofCategory| |target| (QUOTE (|Field|))) (|canCoerce| S |target|)) - ((QUOTE T) (AND (|canCoerce| S T$) (|canCoerce| T$ |target|))))) - ((QUOTE T) - (SPADLET |n| (CAR |u|)) - (SPADLET |d| (CDR |u|)) - (COND - ((|ofCategory| |target| (QUOTE (|Field|))) - (OR - (SPADLET |d'| (|coerceInt| (|objNewWrap| |d| S) |target|)) - (|coercionFailure|)) - (SPADLET |inv| - (|getFunctionFromDomain| (QUOTE |inv|) |target| (CONS |target| NIL))) - (SPADLET |d'| (SPADCALL (|objValUnwrap| |d'|) |inv|)) - (OR - (SPADLET |n'| (|coerceInt| (|objNewWrap| |n| S) |target|)) - (|coercionFailure|)) - (SPADLET |multfunc| - (|getFunctionFromDomain| - (QUOTE *) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADCALL |d'| (|objValUnwrap| |n'|) |multfunc|)) - ((QUOTE T) - (OR - (SPADLET |d'| (|coerceInt| (|objNewWrap| |d| S) T$)) - (|coercionFailure|)) - (SPADLET |inv| (|getFunctionFromDomain| (QUOTE |inv|) T$ (CONS T$ NIL))) - (SPADLET |d'| (SPADCALL (|objValUnwrap| |d'|) |inv|)) - (OR - (SPADLET |d'| (|coerceInt| (|objNewWrap| |d'| T$) |target|)) - (|coercionFailure|)) - (OR - (SPADLET |n'| (|coerceInt| (|objNewWrap| |n| S) |target|)) - (|coercionFailure|)) - (SPADLET |multfunc| - (|getFunctionFromDomain| - (QUOTE *) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADCALL - (|objValUnwrap| |d'|) - (|objValUnwrap| |n'|) - |multfunc|)))))))) + (DECLARE (IGNORE |source|)) + (PROG (|n| |d| |inv| |d'| |n'| |multfunc|) + (RETURN + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (COND + ((|ofCategory| |target| '(|Field|)) + (|canCoerce| S |target|)) + ('T (AND (|canCoerce| S T$) (|canCoerce| T$ |target|))))) + ('T (SPADLET |n| (CAR |u|)) (SPADLET |d| (CDR |u|)) + (COND + ((|ofCategory| |target| '(|Field|)) + (OR (SPADLET |d'| + (|coerceInt| (|objNewWrap| |d| S) |target|)) + (|coercionFailure|)) + (SPADLET |inv| + (|getFunctionFromDomain| '|inv| |target| + (CONS |target| NIL))) + (SPADLET |d'| (SPADCALL (|objValUnwrap| |d'|) |inv|)) + (OR (SPADLET |n'| + (|coerceInt| (|objNewWrap| |n| S) |target|)) + (|coercionFailure|)) + (SPADLET |multfunc| + (|getFunctionFromDomain| '* |target| + (CONS |target| (CONS |target| NIL)))) + (SPADCALL |d'| (|objValUnwrap| |n'|) |multfunc|)) + ('T + (OR (SPADLET |d'| (|coerceInt| (|objNewWrap| |d| S) T$)) + (|coercionFailure|)) + (SPADLET |inv| + (|getFunctionFromDomain| '|inv| T$ (CONS T$ NIL))) + (SPADLET |d'| (SPADCALL (|objValUnwrap| |d'|) |inv|)) + (OR (SPADLET |d'| + (|coerceInt| (|objNewWrap| |d'| T$) |target|)) + (|coercionFailure|)) + (OR (SPADLET |n'| + (|coerceInt| (|objNewWrap| |n| S) |target|)) + (|coercionFailure|)) + (SPADLET |multfunc| + (|getFunctionFromDomain| '* |target| + (CONS |target| (CONS |target| NIL)))) + (SPADCALL (|objValUnwrap| |d'|) (|objValUnwrap| |n'|) + |multfunc|)))))))) ;--% SquareMatrix ;commuteSquareMatrix(u,source,S,target,T) == @@ -6169,62 +6572,72 @@ all these coercion functions have the following result: ; u' (DEFUN |commuteSquareMatrix| (|u| |source| S |target| T$) - (PROG (|plusfunc| |multfunc| |zero| |sm| |n| |S'| |e| |Eij| |e'| |u'|) - (RETURN - (SEQ - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (AND (|canCoerce| S |target|) (|canCoerce| T$ |target|))) - ((AND (PAIRP S) (EQ (QCAR S) (QUOTE |SquareMatrix|))) - (COND - ((BOOT-EQUAL |source| |target|) |u|) - ((QUOTE T) (|coercionFailure|)))) - ((QUOTE T) - (SPADLET |u'| (|domainZero| |target|)) - (SPADLET |plusfunc| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |multfunc| - (|getFunctionFromDomain| - (QUOTE *) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |zero| (|domainZero| S)) - (SPADLET |sm| (CAR |source|)) - (SPADLET |n| (CADR |source|)) - (SPADLET |S'| (CONS |sm| (CONS |n| (CONS |$Integer| NIL)))) - (DO ((#0=#:G171156 (SPADDIFFERENCE |n| 1)) (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| #0#) NIL) - (SEQ - (EXIT - (DO ((#1=#:G171163 (SPADDIFFERENCE |n| 1)) (|j| 0 (QSADD1 |j|))) - ((QSGREATERP |j| #1#) NIL) - (SEQ - (EXIT - (COND - ((BOOT-EQUAL (SPADLET |e| (ELT (ELT |u| |i|) |j|)) |zero|) - (QUOTE |iterate|)) - ((QUOTE T) - (OR - (SPADLET |e'| (|coerceInt| (|objNewWrap| |e| S) |target|)) - (|coercionFailure|)) - (OR - (SPADLET |Eij| - (|coerceInt| - (|objNewWrap| (|makeEijSquareMatrix| |i| |j| |n|) |S'|) T$)) - (|coercionFailure|)) - (OR - (SPADLET |Eij| (|coerceInt| |Eij| |target|)) - (|coercionFailure|)) - (SPADLET |e'| - (SPADCALL - (|objValUnwrap| |e'|) - (|objValUnwrap| |Eij|) - |multfunc|)) - (SPADLET |u'| (SPADCALL |e'| |u'| |plusfunc|)))))))))) - |u'|)))))) + (PROG (|plusfunc| |multfunc| |zero| |sm| |n| |S'| |e| |Eij| |e'| + |u'|) + (DECLARE (SPECIAL |$Integer|)) + (RETURN + (SEQ (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (AND (|canCoerce| S |target|) (|canCoerce| T$ |target|))) + ((AND (PAIRP S) (EQ (QCAR S) '|SquareMatrix|)) + (COND + ((BOOT-EQUAL |source| |target|) |u|) + ('T (|coercionFailure|)))) + ('T (SPADLET |u'| (|domainZero| |target|)) + (SPADLET |plusfunc| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |multfunc| + (|getFunctionFromDomain| '* |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |zero| (|domainZero| S)) + (SPADLET |sm| (CAR |source|)) + (SPADLET |n| (CADR |source|)) + (SPADLET |S'| + (CONS |sm| (CONS |n| (CONS |$Integer| NIL)))) + (DO ((G171156 (SPADDIFFERENCE |n| 1)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G171156) NIL) + (SEQ (EXIT (DO ((G171163 (SPADDIFFERENCE |n| 1)) + (|j| 0 (QSADD1 |j|))) + ((QSGREATERP |j| G171163) NIL) + (SEQ (EXIT (COND + ((BOOT-EQUAL + (SPADLET |e| + (ELT (ELT |u| |i|) |j|)) + |zero|) + '|iterate|) + ('T + (OR + (SPADLET |e'| + (|coerceInt| + (|objNewWrap| |e| S) + |target|)) + (|coercionFailure|)) + (OR + (SPADLET |Eij| + (|coerceInt| + (|objNewWrap| + (|makeEijSquareMatrix| + |i| |j| |n|) + |S'|) + T$)) + (|coercionFailure|)) + (OR + (SPADLET |Eij| + (|coerceInt| |Eij| + |target|)) + (|coercionFailure|)) + (SPADLET |e'| + (SPADCALL + (|objValUnwrap| |e'|) + (|objValUnwrap| |Eij|) + |multfunc|)) + (SPADLET |u'| + (SPADCALL |e'| |u'| + |plusfunc|)))))))))) + |u'|)))))) + ;makeEijSquareMatrix(i, j, dim) == ; -- assume using 0 based scale, makes a dim by dim matrix with a ; -- 1 in the i,j position, zeros elsewhere @@ -6232,41 +6645,50 @@ all these coercion functions have the following result: ; for c in 0..(dim-1)] for r in 0..(dim-1)] (DEFUN |makeEijSquareMatrix| (|i| |j| |dim|) - (PROG NIL - (RETURN - (SEQ - (LIST2VEC - (PROG (#0=#:G171188) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G171193 (SPADDIFFERENCE |dim| 1)) (|r| 0 (QSADD1 |r|))) - ((QSGREATERP |r| #1#) (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS - (LIST2VEC - (PROG (#2=#:G171201) - (SPADLET #2# NIL) - (RETURN - (DO ((#3=#:G171206 (SPADDIFFERENCE |dim| 1)) - (|c| 0 (QSADD1 |c|))) - ((QSGREATERP |c| #3#) (NREVERSE0 #2#)) - (SEQ - (EXIT - (SETQ #2# - (CONS - (COND - ((AND (BOOT-EQUAL |i| |r|) (BOOT-EQUAL |j| |c|)) 1) - ((QUOTE T) 0)) #2#)))))))) - #0#)))))))))))) + (PROG () + (RETURN + (SEQ (LIST2VEC + (PROG (G171188) + (SPADLET G171188 NIL) + (RETURN + (DO ((G171193 (SPADDIFFERENCE |dim| 1)) + (|r| 0 (QSADD1 |r|))) + ((QSGREATERP |r| G171193) + (NREVERSE0 G171188)) + (SEQ (EXIT (SETQ G171188 + (CONS + (LIST2VEC + (PROG (G171201) + (SPADLET G171201 NIL) + (RETURN + (DO + ((G171206 + (SPADDIFFERENCE |dim| 1)) + (|c| 0 (QSADD1 |c|))) + ((QSGREATERP |c| + G171206) + (NREVERSE0 G171201)) + (SEQ + (EXIT + (SETQ G171201 + (CONS + (COND + ((AND + (BOOT-EQUAL |i| + |r|) + (BOOT-EQUAL |j| + |c|)) + 1) + ('T 0)) + G171201)))))))) + G171188)))))))))))) ;--% Univariate Polynomial and Sparse Univariate Polynomial ;commuteUnivariatePolynomial(u,source,S,target,T) == ; commuteSparseUnivariatePolynomial(u,source,S,target,T) (DEFUN |commuteUnivariatePolynomial| (|u| |source| S |target| T$) - (|commuteSparseUnivariatePolynomial| |u| |source| S |target| T$)) + (|commuteSparseUnivariatePolynomial| |u| |source| S |target| T$)) ;commuteSparseUnivariatePolynomial(u,source,S,target,T) == ; u = '_$fromCoerceable_$ => @@ -6288,75 +6710,75 @@ all these coercion functions have the following result: ; u' (DEFUN |commuteSparseUnivariatePolynomial| (|u| |source| S |target| T$) - (PROG (|T'| |one| |monom| |plus| |times| |e| |c| |m| |u'|) - (RETURN - (SEQ - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) - (AND (|canCoerce| S |target|) (|canCoerce| T$ |target|))) - ((QUOTE T) - (SPADLET |u'| (|domainZero| |target|)) - (COND - ((NULL |u|) |u'|) - ((QUOTE T) - (SPADLET |T'| (|underDomainOf| T$)) - (SPADLET |one| (|domainOne| |T'|)) - (SPADLET |monom| - (|getFunctionFromDomain| - (QUOTE |monomial|) - T$ - (CONS |T'| (CONS |$NonNegativeInteger| NIL)))) - (SPADLET |plus| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |times| - (|getFunctionFromDomain| - (QUOTE *) - |target| - (CONS |target| (CONS |target| NIL)))) - (DO ((#0=#:G171234 |u| (CDR #0#)) (#1=#:G171219 NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN (SPADLET |e| (CAR #1#)) (SPADLET |c| (CDR #1#)) #1#) - NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (OR - (SPADLET |c| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|coercionFailure|)) - (SPADLET |m| (SPADCALL |one| |e| |monom|)) - (OR - (SPADLET |m| (|coerceInt| (|objNewWrap| |m| T$) |target|)) - (|coercionFailure|)) - (SPADLET |c| (|objValUnwrap| |c|)) - (SPADLET |m| (|objValUnwrap| |m|)) - (SPADLET |u'| - (SPADCALL |u'| (SPADCALL |c| |m| |times|) |plus|)))))) - |u'|)))))))) + (DECLARE (IGNORE |source|)) + (PROG (|T'| |one| |monom| |plus| |times| |e| |c| |m| |u'|) + (DECLARE (SPECIAL |$NonNegativeInteger|)) + (RETURN + (SEQ (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) + (AND (|canCoerce| S |target|) (|canCoerce| T$ |target|))) + ('T (SPADLET |u'| (|domainZero| |target|)) + (COND + ((NULL |u|) |u'|) + ('T (SPADLET |T'| (|underDomainOf| T$)) + (SPADLET |one| (|domainOne| |T'|)) + (SPADLET |monom| + (|getFunctionFromDomain| '|monomial| T$ + (CONS |T'| + (CONS |$NonNegativeInteger| NIL)))) + (SPADLET |plus| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |times| + (|getFunctionFromDomain| '* |target| + (CONS |target| (CONS |target| NIL)))) + (DO ((G171234 |u| (CDR G171234)) (G171219 NIL)) + ((OR (ATOM G171234) + (PROGN (SETQ G171219 (CAR G171234)) NIL) + (PROGN + (PROGN + (SPADLET |e| (CAR G171219)) + (SPADLET |c| (CDR G171219)) + G171219) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (OR (SPADLET |c| + (|coerceInt| (|objNewWrap| |c| S) + |target|)) + (|coercionFailure|)) + (SPADLET |m| + (SPADCALL |one| |e| |monom|)) + (OR (SPADLET |m| + (|coerceInt| (|objNewWrap| |m| T$) + |target|)) + (|coercionFailure|)) + (SPADLET |c| (|objValUnwrap| |c|)) + (SPADLET |m| (|objValUnwrap| |m|)) + (SPADLET |u'| + (SPADCALL |u'| + (SPADCALL |c| |m| |times|) + |plus|)))))) + |u'|)))))))) ;--% Multivariate Polynomials ;commutePolynomial(u,source,S,target,T) == ; commuteMPolyCat(u,source,S,target,T) (DEFUN |commutePolynomial| (|u| |source| S |target| T$) - (|commuteMPolyCat| |u| |source| S |target| T$)) + (|commuteMPolyCat| |u| |source| S |target| T$)) ;commuteMultivariatePolynomial(u,source,S,target,T) == ; commuteMPolyCat(u,source,S,target,T) (DEFUN |commuteMultivariatePolynomial| (|u| |source| S |target| T$) - (|commuteMPolyCat| |u| |source| S |target| T$)) + (|commuteMPolyCat| |u| |source| S |target| T$)) ;commuteDistributedMultivariatePolynomial(u,source,S,target,T) == ; commuteMPolyCat(u,source,S,target,T) (DEFUN |commuteDistributedMultivariatePolynomial| (|u| |source| S |target| T$) - (|commuteMPolyCat| |u| |source| S |target| T$)) + (|commuteMPolyCat| |u| |source| S |target| T$)) ;commuteNewDistributedMultivariatePolynomial(u,source,S,target,T) == ; commuteMPolyCat(u,source,S,target,T) @@ -6394,75 +6816,64 @@ all these coercion functions have the following result: ; SPADCALL(SPADCALL(lc',lm',multfun),rd',plusfun) (DEFUN |commuteMPolyCat| (|u| |source| S |target| T$) - (PROG (|isconstfun| |constfun| |c| |u'| |lmfun| |lcfun| |lc| |pmfun| |lm| - |rdfun| |rd| |lc'| |lm'| |rd'| |plusfun| |multfun|) - (RETURN - (COND - ((BOOT-EQUAL |u| (QUOTE |$fromCoerceable$|)) (|canCoerce| S |target|)) - ((QUOTE T) - (SPADLET |isconstfun| - (|getFunctionFromDomain| (QUOTE |ground?|) |source| (CONS |source| NIL))) - (COND - ((SPADCALL |u| |isconstfun|) - (SPADLET |constfun| - (|getFunctionFromDomain| - (QUOTE |ground|) - |source| - (CONS |source| NIL))) - (SPADLET |c| (SPADCALL |u| |constfun|)) - (OR - (SPADLET |u'| (|coerceInt| (|objNewWrap| |c| S) |target|)) - (|coercionFailure|)) - (|objValUnwrap| |u'|)) - ((QUOTE T) - (SPADLET |lmfun| - (|getFunctionFromDomain| - (QUOTE |leadingMonomial|) - |source| - (CONS |source| NIL))) - (SPADLET |lm| (SPADCALL |u| |lmfun|)) - (SPADLET |lcfun| - (|getFunctionFromDomain| - (QUOTE |leadingCoefficient|) - |source| - (CONS |source| NIL))) - (SPADLET |lc| (SPADCALL |lm| |lcfun|)) - (OR - (SPADLET |lc'| (|coerceInt| (|objNewWrap| |lc| S) |target|)) - (|coercionFailure|)) - (SPADLET |pmfun| - (|getFunctionFromDomain| - (QUOTE |primitiveMonomials|) - |source| - (CONS |source| NIL))) - (SPADLET |lm| (CAR (SPADCALL |lm| |pmfun|))) - (OR - (SPADLET |lm'| (|coerceInt| (|objNewWrap| |lm| |source|) T$)) - (|coercionFailure|)) - (OR (SPADLET |lm'| (|coerceInt| |lm'| |target|)) (|coercionFailure|)) - (SPADLET |rdfun| - (|getFunctionFromDomain| - (QUOTE |reductum|) - |source| - (CONS |source| NIL))) - (SPADLET |rd| (SPADCALL |u| |rdfun|)) - (OR - (SPADLET |rd'| (|coerceInt| (|objNewWrap| |rd| |source|) |target|)) - (|coercionFailure|)) - (SPADLET |lc'| (|objValUnwrap| |lc'|)) - (SPADLET |lm'| (|objValUnwrap| |lm'|)) - (SPADLET |rd'| (|objValUnwrap| |rd'|)) - (SPADLET |plusfun| - (|getFunctionFromDomain| - (QUOTE +) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADLET |multfun| - (|getFunctionFromDomain| - (QUOTE *) - |target| - (CONS |target| (CONS |target| NIL)))) - (SPADCALL (SPADCALL |lc'| |lm'| |multfun|) |rd'| |plusfun|)))))))) + (PROG (|isconstfun| |constfun| |c| |u'| |lmfun| |lcfun| |lc| |pmfun| + |lm| |rdfun| |rd| |lc'| |lm'| |rd'| |plusfun| |multfun|) + (RETURN + (COND + ((BOOT-EQUAL |u| '|$fromCoerceable$|) (|canCoerce| S |target|)) + ('T + (SPADLET |isconstfun| + (|getFunctionFromDomain| '|ground?| |source| + (CONS |source| NIL))) + (COND + ((SPADCALL |u| |isconstfun|) + (SPADLET |constfun| + (|getFunctionFromDomain| '|ground| |source| + (CONS |source| NIL))) + (SPADLET |c| (SPADCALL |u| |constfun|)) + (OR (SPADLET |u'| + (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coercionFailure|)) + (|objValUnwrap| |u'|)) + ('T + (SPADLET |lmfun| + (|getFunctionFromDomain| '|leadingMonomial| + |source| (CONS |source| NIL))) + (SPADLET |lm| (SPADCALL |u| |lmfun|)) + (SPADLET |lcfun| + (|getFunctionFromDomain| '|leadingCoefficient| + |source| (CONS |source| NIL))) + (SPADLET |lc| (SPADCALL |lm| |lcfun|)) + (OR (SPADLET |lc'| + (|coerceInt| (|objNewWrap| |lc| S) |target|)) + (|coercionFailure|)) + (SPADLET |pmfun| + (|getFunctionFromDomain| '|primitiveMonomials| + |source| (CONS |source| NIL))) + (SPADLET |lm| (CAR (SPADCALL |lm| |pmfun|))) + (OR (SPADLET |lm'| + (|coerceInt| (|objNewWrap| |lm| |source|) T$)) + (|coercionFailure|)) + (OR (SPADLET |lm'| (|coerceInt| |lm'| |target|)) + (|coercionFailure|)) + (SPADLET |rdfun| + (|getFunctionFromDomain| '|reductum| |source| + (CONS |source| NIL))) + (SPADLET |rd| (SPADCALL |u| |rdfun|)) + (OR (SPADLET |rd'| + (|coerceInt| (|objNewWrap| |rd| |source|) + |target|)) + (|coercionFailure|)) + (SPADLET |lc'| (|objValUnwrap| |lc'|)) + (SPADLET |lm'| (|objValUnwrap| |lm'|)) + (SPADLET |rd'| (|objValUnwrap| |rd'|)) + (SPADLET |plusfun| + (|getFunctionFromDomain| '+ |target| + (CONS |target| (CONS |target| NIL)))) + (SPADLET |multfun| + (|getFunctionFromDomain| '* |target| + (CONS |target| (CONS |target| NIL)))) + (SPADCALL (SPADCALL |lc'| |lm'| |multfun|) |rd'| |plusfun|)))))))) @ \begin{verbatim} @@ -6563,73 +6974,63 @@ all these coercion functions have the following result: ; )) (SETANDFILEQ |$CoerceTable| - (QUOTE ( - (|Complex| - (|Expression| |indeterm| |Complex2Expr|) - (|Factored| |indeterm| |Complex2FR|) - (|Integer| |partial| |Complex2underDomain|) - (|PrimeField| |partial| |Complex2underDomain|)) - (|DirectProduct| - (|DirectProduct| |partial| DP2DP)) - (|DistributedMultivariatePolynomial| - (|DistributedMultivariatePolynomial| |indeterm| |Dmp2Dmp|) - (|Expression| |indeterm| |Dmp2Expr|) - (|Factored| |indeterm| |Mp2FR|) - (|HomogeneousDistributedMultivariatePolynomial| |indeterm| |Dmp2NDmp|) - (|MultivariatePolynomial| |indeterm| |Dmp2Mp|) - (|Polynomial| |indeterm| |Dmp2P|) - (|UnivariatePolynomial| |indeterm| |Dmp2Up|)) - (|Expression| - (|Complex| |partial| |Expr2Complex|) - (|DistributedMultivariatePolynomial| |indeterm| |Expr2Dmp|) - (|HomogeneousDistributedMultivariatePolynomial| |indeterm| |Expr2Dmp|) - (|MultivariatePolynomial| |indeterm| |Expr2Mp|) - (|UnivariateLaurentSeries| |indeterm| |P2Uls|) - (|UnivariatePolynomial| |indeterm| |Expr2Up|) - (|UnivariatePuiseuxSeries| |indeterm| |P2Upxs|) - (|UnivariateTaylorSeries| |indeterm| |P2Uts|)) - (|Kernel| - (|Kernel| |indeterm| |Ker2Ker|) - (|Expression| |indeterm| |Ker2Expr|)) - (|Factored| - (|Factored| |indeterm| |Factored2Factored|)) - (|Fraction| - (|DistributedMultivariatePolynomial| |partial| |Qf2domain|) - (|ElementaryFunction| |indeterm| |Qf2EF|) - (|Expression| |indeterm| |Qf2EF|) - (|Fraction| |indeterm| |Qf2Qf|) - (|HomogeneousDistributedMultivariatePolynomial| |partial| |Qf2domain|) - (|Integer| |partial| |Qf2domain|) - (|MultivariatePolynomial| |partial| |Qf2domain|) - (|Polynomial| |partial| |Qf2domain|) - (|PrimeField| |indeterm| |Qf2PF|) - (|UnivariateLaurentSeries| |indeterm| |P2Uls|) - (|UnivariatePolynomial| |partial| |Qf2domain|) - (|UnivariatePuiseuxSeries| |indeterm| |P2Upxs|) - (|UnivariateTaylorSeries| |indeterm| |P2Uts|)) - (|Int| - (|Expression| |total| |ncI2E|) - (|Integer| |total| |ncI2I|)) - (|Baby| - (|Expression| |total| |ncI2E|) - (|Integer| |total| |ncI2I|)) - (|Integer| - (|Baby| |total| |I2ncI|) - (|EvenInteger| |partial| I2EI) - (|Int| |total| |I2ncI|) - (|NonNegativeInteger| |partial| I2NNI) - (|OddInteger| |partial| I2OI) - (|PositiveInteger| |partial| I2PI)) - (|List| - (|DirectProduct| |indeterm| L2DP) - (|Matrix| |partial| L2M) - (|Record| |partial| |L2Record|) - (|RectangularMatrix| |partial| |L2Rm|) - (|Set| |indeterm| |L2Set|) - (|SquareMatrix| |partial| |L2Sm|) - (|Stream| |indeterm| |Agg2Agg|) - (|Tuple| |indeterm| |L2Tuple|) - (|Vector| |indeterm| L2V))))) + '((|Complex| (|Expression| |indeterm| |Complex2Expr|) + (|Factored| |indeterm| |Complex2FR|) + (|Integer| |partial| |Complex2underDomain|) + (|PrimeField| |partial| |Complex2underDomain|)) + (|DirectProduct| (|DirectProduct| |partial| DP2DP)) + (|DistributedMultivariatePolynomial| + (|DistributedMultivariatePolynomial| |indeterm| |Dmp2Dmp|) + (|Expression| |indeterm| |Dmp2Expr|) + (|Factored| |indeterm| |Mp2FR|) + (|HomogeneousDistributedMultivariatePolynomial| |indeterm| + |Dmp2NDmp|) + (|MultivariatePolynomial| |indeterm| |Dmp2Mp|) + (|Polynomial| |indeterm| |Dmp2P|) + (|UnivariatePolynomial| |indeterm| |Dmp2Up|)) + (|Expression| (|Complex| |partial| |Expr2Complex|) + (|DistributedMultivariatePolynomial| |indeterm| |Expr2Dmp|) + (|HomogeneousDistributedMultivariatePolynomial| |indeterm| + |Expr2Dmp|) + (|MultivariatePolynomial| |indeterm| |Expr2Mp|) + (|UnivariateLaurentSeries| |indeterm| |P2Uls|) + (|UnivariatePolynomial| |indeterm| |Expr2Up|) + (|UnivariatePuiseuxSeries| |indeterm| |P2Upxs|) + (|UnivariateTaylorSeries| |indeterm| |P2Uts|)) + (|Kernel| (|Kernel| |indeterm| |Ker2Ker|) + (|Expression| |indeterm| |Ker2Expr|)) + (|Factored| (|Factored| |indeterm| |Factored2Factored|)) + (|Fraction| + (|DistributedMultivariatePolynomial| |partial| |Qf2domain|) + (|ElementaryFunction| |indeterm| |Qf2EF|) + (|Expression| |indeterm| |Qf2EF|) + (|Fraction| |indeterm| |Qf2Qf|) + (|HomogeneousDistributedMultivariatePolynomial| |partial| + |Qf2domain|) + (|Integer| |partial| |Qf2domain|) + (|MultivariatePolynomial| |partial| |Qf2domain|) + (|Polynomial| |partial| |Qf2domain|) + (|PrimeField| |indeterm| |Qf2PF|) + (|UnivariateLaurentSeries| |indeterm| |P2Uls|) + (|UnivariatePolynomial| |partial| |Qf2domain|) + (|UnivariatePuiseuxSeries| |indeterm| |P2Upxs|) + (|UnivariateTaylorSeries| |indeterm| |P2Uts|)) + (|Int| (|Expression| |total| |ncI2E|) + (|Integer| |total| |ncI2I|)) + (|Baby| (|Expression| |total| |ncI2E|) + (|Integer| |total| |ncI2I|)) + (|Integer| (|Baby| |total| |I2ncI|) + (|EvenInteger| |partial| I2EI) (|Int| |total| |I2ncI|) + (|NonNegativeInteger| |partial| I2NNI) + (|OddInteger| |partial| I2OI) + (|PositiveInteger| |partial| I2PI)) + (|List| (|DirectProduct| |indeterm| L2DP) + (|Matrix| |partial| L2M) (|Record| |partial| |L2Record|) + (|RectangularMatrix| |partial| |L2Rm|) + (|Set| |indeterm| |L2Set|) + (|SquareMatrix| |partial| |L2Sm|) + (|Stream| |indeterm| |Agg2Agg|) + (|Tuple| |indeterm| |L2Tuple|) (|Vector| |indeterm| L2V)))) ;SETANDFILEQ($CoerceTable,NCONC($CoerceTable,'( _ ; (Matrix . ( _ @@ -6755,111 +7156,124 @@ all these coercion functions have the following result: ; ) ) ) (SETANDFILEQ |$CoerceTable| - (NCONC |$CoerceTable| - (QUOTE ( - (|Matrix| - (|List| |indeterm| M2L) - (|RectangularMatrix| |partial| |M2Rm|) - (|SquareMatrix| |partial| |M2Sm|) - (|Vector| |indeterm| M2L)) - (|MultivariatePolynomial| - (|DistributedMultivariatePolynomial| |indeterm| |Mp2Dmp|) - (|Expression| |indeterm| |Mp2Expr|) - (|Factored| |indeterm| |Mp2FR|) - (|HomogeneousDistributedMultivariatePolynomial| |indeterm| |domain2NDmp|) - (|MultivariatePolynomial| |indeterm| |Mp2Mp|) - (|Polynomial| |indeterm| |Mp2P|) - (|UnivariatePolynomial| |indeterm| |Mp2Up|)) - (|HomogeneousDirectProduct| (|HomogeneousDirectProduct| |indeterm| DP2DP)) - (|HomogeneousDistributedMultivariatePolynomial| - (|Complex| |indeterm| |NDmp2domain|) - (|DistributedMultivariatePolynomial| |indeterm| |NDmp2domain|) - (|Expression| |indeterm| |Dmp2Expr|) - (|Factored| |indeterm| |Mp2FR|) - (|Fraction| |indeterm| |NDmp2domain|) - (|HomogeneousDistributedMultivariatePolynomial| |indeterm| |NDmp2NDmp|) - (|MultivariatePolynomial| |indeterm| |NDmp2domain|) - (|Polynomial| |indeterm| |NDmp2domain|) - (|Quaternion| |indeterm| |NDmp2domain|) - (|UnivariatePolynomial| |indeterm| |NDmp2domain|)) - (|OrderedVariableList| - (|DistributedMultivariatePolynomial| |indeterm| |OV2poly|) - (|HomogeneousDistributedMultivariatePolynomial| |indeterm| |OV2poly|) - (|MultivariatePolynomial| |indeterm| |OV2poly|) - (|OrderedVariableList| |indeterm| OV2OV) - (|Polynomial| |total| OV2P) - (|Symbol| |total| |OV2Sy|) - (|UnivariatePolynomial| |indeterm| |OV2poly|)) - (|Polynomial| - (|DistributedMultivariatePolynomial| |indeterm| |P2Dmp|) - (|Expression| |indeterm| |P2Expr|) - (|Factored| |indeterm| P2FR) - (|HomogeneousDistributedMultivariatePolynomial| |partial| |domain2NDmp|) - (|MultivariatePolynomial| |indeterm| |P2Mp|) - (|UnivariateLaurentSeries| |indeterm| |P2Uls|) - (|UnivariatePolynomial| |indeterm| |P2Up|) - (|UnivariatePuiseuxSeries| |indeterm| |P2Upxs|) - (|UnivariateTaylorSeries| |indeterm| |P2Uts|)) - (|Set| - (|List| |indeterm| |Set2L|) - (|Vector| |indeterm| |Agg2L2Agg|)) - (|RectangularMatrix| - (|List| |indeterm| |Rm2L|) - (|Matrix| |indeterm| |Rm2M|) - (|SquareMatrix| |indeterm| |Rm2Sm|) - (|Vector| |indeterm| |Rm2V|)) - (|SparseUnivariatePolynomial| (|UnivariatePolynomial| |indeterm| |SUP2Up|)) - (|SquareMatrix| - (|DistributedMultivariatePolynomial| |partial| |Sm2PolyType|) - (|HomogeneousDistributedMultivariatePolynomial| |partial| |Sm2PolyType|) - (|List| |indeterm| |Sm2L|) - (|Matrix| |indeterm| |Sm2M|) - (|MultivariatePolynomial| |partial| |Sm2PolyType|) - (|RectangularMatrix| |indeterm| |Sm2Rm|) - (|UnivariatePolynomial| |indeterm| |Sm2PolyType|) - (|Vector| |indeterm| |Sm2V|)) - (|Symbol| - (|DistributedMultivariatePolynomial| |indeterm| |Sy2Dmp|) - (|HomogeneousDistributedMultivariatePolynomial| |indeterm| |Sy2NDmp|) - (|MultivariatePolynomial| |indeterm| |Sy2Mp|) - (|OrderedVariableList| |partial| |Sy2OV|) - (|Polynomial| |total| |Sy2P|) - (|UnivariatePolynomial| |indeterm| |Sy2Up|) - (|Variable| |indeterm| |Sy2Var|)) - (|UnivariatePolynomial| - (|DistributedMultivariatePolynomial| |indeterm| |Up2Dmp|) - (|Expression| |indeterm| |Up2Expr|) - (|Factored| |indeterm| |Up2FR|) - (|HomogeneousDistributedMultivariatePolynomial| |indeterm| |domain2NDmp|) - (|MultivariatePolynomial| |indeterm| |Up2Mp|) - (|Polynomial| |indeterm| |Up2P|) - (|SparseUnivariatePolynomial| |indeterm| |Up2SUP|) - (|UnivariatePolynomial| |indeterm| |Up2Up|)) - (|Variable| - (|AlgebraicFunction| |total| |Var2FS|) - (|ContinuedFractionPowerSeries| |indeterm| |Var2OtherPS|) - (|DistributedMultivariatePolynomial| |indeterm| |Var2Dmp|) - (|ElementaryFunction| |total| |Var2FS|) - (|Fraction| |indeterm| |Var2QF|) - (|FunctionalExpression| |total| |Var2FS|) - (|GeneralDistributedMultivariatePolynomial| |indeterm| |Var2Gdmp|) - (|HomogeneousDistributedMultivariatePolynomial| |indeterm| |Var2NDmp|) - (|LiouvillianFunction| |total| |Var2FS|) - (|MultivariatePolynomial| |indeterm| |Var2Mp|) - (|OrderedVariableList| |indeterm| |Var2OV|) - (|Polynomial| |total| |Var2P|) - (|SparseUnivariatePolynomial| |indeterm| |Var2SUP|) - (|Symbol| |total| |Identity|) - (|UnivariatePolynomial| |indeterm| |Var2Up|) - (|UnivariatePowerSeries| |indeterm| |Var2UpS|)) - (|Vector| - (|DirectProduct| |indeterm| V2DP) - (|List| |indeterm| V2L) - (|Matrix| |indeterm| V2M) - (|RectangularMatrix| |indeterm| |V2Rm|) - (|Set| |indeterm| |Agg2L2Agg|) - (|SquareMatrix| |indeterm| |V2Sm|) - (|Stream| |indeterm| |Agg2Agg|)))))) + (NCONC |$CoerceTable| + '((|Matrix| (|List| |indeterm| M2L) + (|RectangularMatrix| |partial| |M2Rm|) + (|SquareMatrix| |partial| |M2Sm|) + (|Vector| |indeterm| M2L)) + (|MultivariatePolynomial| + (|DistributedMultivariatePolynomial| |indeterm| + |Mp2Dmp|) + (|Expression| |indeterm| |Mp2Expr|) + (|Factored| |indeterm| |Mp2FR|) + (|HomogeneousDistributedMultivariatePolynomial| + |indeterm| |domain2NDmp|) + (|MultivariatePolynomial| |indeterm| |Mp2Mp|) + (|Polynomial| |indeterm| |Mp2P|) + (|UnivariatePolynomial| |indeterm| |Mp2Up|)) + (|HomogeneousDirectProduct| + (|HomogeneousDirectProduct| |indeterm| DP2DP)) + (|HomogeneousDistributedMultivariatePolynomial| + (|Complex| |indeterm| |NDmp2domain|) + (|DistributedMultivariatePolynomial| |indeterm| + |NDmp2domain|) + (|Expression| |indeterm| |Dmp2Expr|) + (|Factored| |indeterm| |Mp2FR|) + (|Fraction| |indeterm| |NDmp2domain|) + (|HomogeneousDistributedMultivariatePolynomial| + |indeterm| |NDmp2NDmp|) + (|MultivariatePolynomial| |indeterm| |NDmp2domain|) + (|Polynomial| |indeterm| |NDmp2domain|) + (|Quaternion| |indeterm| |NDmp2domain|) + (|UnivariatePolynomial| |indeterm| |NDmp2domain|)) + (|OrderedVariableList| + (|DistributedMultivariatePolynomial| |indeterm| + |OV2poly|) + (|HomogeneousDistributedMultivariatePolynomial| + |indeterm| |OV2poly|) + (|MultivariatePolynomial| |indeterm| |OV2poly|) + (|OrderedVariableList| |indeterm| OV2OV) + (|Polynomial| |total| OV2P) (|Symbol| |total| |OV2Sy|) + (|UnivariatePolynomial| |indeterm| |OV2poly|)) + (|Polynomial| + (|DistributedMultivariatePolynomial| |indeterm| + |P2Dmp|) + (|Expression| |indeterm| |P2Expr|) + (|Factored| |indeterm| P2FR) + (|HomogeneousDistributedMultivariatePolynomial| + |partial| |domain2NDmp|) + (|MultivariatePolynomial| |indeterm| |P2Mp|) + (|UnivariateLaurentSeries| |indeterm| |P2Uls|) + (|UnivariatePolynomial| |indeterm| |P2Up|) + (|UnivariatePuiseuxSeries| |indeterm| |P2Upxs|) + (|UnivariateTaylorSeries| |indeterm| |P2Uts|)) + (|Set| (|List| |indeterm| |Set2L|) + (|Vector| |indeterm| |Agg2L2Agg|)) + (|RectangularMatrix| (|List| |indeterm| |Rm2L|) + (|Matrix| |indeterm| |Rm2M|) + (|SquareMatrix| |indeterm| |Rm2Sm|) + (|Vector| |indeterm| |Rm2V|)) + (|SparseUnivariatePolynomial| + (|UnivariatePolynomial| |indeterm| |SUP2Up|)) + (|SquareMatrix| + (|DistributedMultivariatePolynomial| |partial| + |Sm2PolyType|) + (|HomogeneousDistributedMultivariatePolynomial| + |partial| |Sm2PolyType|) + (|List| |indeterm| |Sm2L|) + (|Matrix| |indeterm| |Sm2M|) + (|MultivariatePolynomial| |partial| |Sm2PolyType|) + (|RectangularMatrix| |indeterm| |Sm2Rm|) + (|UnivariatePolynomial| |indeterm| |Sm2PolyType|) + (|Vector| |indeterm| |Sm2V|)) + (|Symbol| + (|DistributedMultivariatePolynomial| |indeterm| + |Sy2Dmp|) + (|HomogeneousDistributedMultivariatePolynomial| + |indeterm| |Sy2NDmp|) + (|MultivariatePolynomial| |indeterm| |Sy2Mp|) + (|OrderedVariableList| |partial| |Sy2OV|) + (|Polynomial| |total| |Sy2P|) + (|UnivariatePolynomial| |indeterm| |Sy2Up|) + (|Variable| |indeterm| |Sy2Var|)) + (|UnivariatePolynomial| + (|DistributedMultivariatePolynomial| |indeterm| + |Up2Dmp|) + (|Expression| |indeterm| |Up2Expr|) + (|Factored| |indeterm| |Up2FR|) + (|HomogeneousDistributedMultivariatePolynomial| + |indeterm| |domain2NDmp|) + (|MultivariatePolynomial| |indeterm| |Up2Mp|) + (|Polynomial| |indeterm| |Up2P|) + (|SparseUnivariatePolynomial| |indeterm| |Up2SUP|) + (|UnivariatePolynomial| |indeterm| |Up2Up|)) + (|Variable| (|AlgebraicFunction| |total| |Var2FS|) + (|ContinuedFractionPowerSeries| |indeterm| + |Var2OtherPS|) + (|DistributedMultivariatePolynomial| |indeterm| + |Var2Dmp|) + (|ElementaryFunction| |total| |Var2FS|) + (|Fraction| |indeterm| |Var2QF|) + (|FunctionalExpression| |total| |Var2FS|) + (|GeneralDistributedMultivariatePolynomial| |indeterm| + |Var2Gdmp|) + (|HomogeneousDistributedMultivariatePolynomial| + |indeterm| |Var2NDmp|) + (|LiouvillianFunction| |total| |Var2FS|) + (|MultivariatePolynomial| |indeterm| |Var2Mp|) + (|OrderedVariableList| |indeterm| |Var2OV|) + (|Polynomial| |total| |Var2P|) + (|SparseUnivariatePolynomial| |indeterm| |Var2SUP|) + (|Symbol| |total| |Identity|) + (|UnivariatePolynomial| |indeterm| |Var2Up|) + (|UnivariatePowerSeries| |indeterm| |Var2UpS|)) + (|Vector| (|DirectProduct| |indeterm| V2DP) + (|List| |indeterm| V2L) (|Matrix| |indeterm| V2M) + (|RectangularMatrix| |indeterm| |V2Rm|) + (|Set| |indeterm| |Agg2L2Agg|) + (|SquareMatrix| |indeterm| |V2Sm|) + (|Stream| |indeterm| |Agg2Agg|))))) + ;-- this list is too long for the parser, so it has to be split into parts ;-- specifies the commute functions @@ -6971,33 +7385,34 @@ all these coercion functions have the following result: ; )) (SETANDFILEQ |$CommuteTable| - (QUOTE ( - (|Complex| - (|DistributedMultivariatePolynomial| |commute| |commuteG2|) - (|MultivariatePolynomial| |commute| |commuteG2|) - (|HomogeneousDistributedMultivariatePolynomial| |commute| |commuteG2|) - (|Polynomial| |commute| |commuteG1|) - (|Fraction| |commute| |commuteG1|) - (|SquareMatrix| |commute| |commuteG2|) - (|UnivariatePolynomial| |commute| |commuteG2|)) - (|Polynomial| - (|Complex| |commute| |commuteMultPol|) - (|MultivariatePolynomial| |commute| |commuteMultPol|) - (|HomogeneousDistributedMultivariatePolynomial| |commute| |commuteMultPol|) - (|Polynomial| |commute| |commuteMultPol|) - (|Quaternion| |commute| |commuteMultPol|) - (|Fraction| |commute| |commuteMultPol|) - (|SquareMatrix| |commute| |commuteMultPol|) - (|UnivariatePolynomial| |commute| |commuteMultPol|)) - (|SquareMatrix| - (|DistributedMultivariatePolynomial| |commute| |commuteSm2|) - (|Complex| |commute| |commuteSm1|) - (|MultivariatePolynomial| |commute| |commuteSm2|) - (|HomogeneousDistributedMultivariatePolynomial| |commute| |commuteSm2|) - (|Polynomial| |commute| |commuteSm1|) - (|Quaternion| |commute| |commuteSm1|) - (|SparseUnivariatePolynomial| |commute| |commuteSm1|) - (|UnivariatePolynomial| |commute| |commuteSm2|))))) + '((|Complex| + (|DistributedMultivariatePolynomial| |commute| |commuteG2|) + (|MultivariatePolynomial| |commute| |commuteG2|) + (|HomogeneousDistributedMultivariatePolynomial| |commute| + |commuteG2|) + (|Polynomial| |commute| |commuteG1|) + (|Fraction| |commute| |commuteG1|) + (|SquareMatrix| |commute| |commuteG2|) + (|UnivariatePolynomial| |commute| |commuteG2|)) + (|Polynomial| (|Complex| |commute| |commuteMultPol|) + (|MultivariatePolynomial| |commute| |commuteMultPol|) + (|HomogeneousDistributedMultivariatePolynomial| |commute| + |commuteMultPol|) + (|Polynomial| |commute| |commuteMultPol|) + (|Quaternion| |commute| |commuteMultPol|) + (|Fraction| |commute| |commuteMultPol|) + (|SquareMatrix| |commute| |commuteMultPol|) + (|UnivariatePolynomial| |commute| |commuteMultPol|)) + (|SquareMatrix| + (|DistributedMultivariatePolynomial| |commute| |commuteSm2|) + (|Complex| |commute| |commuteSm1|) + (|MultivariatePolynomial| |commute| |commuteSm2|) + (|HomogeneousDistributedMultivariatePolynomial| |commute| + |commuteSm2|) + (|Polynomial| |commute| |commuteSm1|) + (|Quaternion| |commute| |commuteSm1|) + (|SparseUnivariatePolynomial| |commute| |commuteSm1|) + (|UnivariatePolynomial| |commute| |commuteSm2|)))) @ \eject