diff --git a/changelog b/changelog index a98e7e9..dbc5bb3 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ +20091009 tpd src/axiom-website/patches.html 20091009.03.tpd.patch +20091009 tpd src/interp/clammed.lisp cleanup 20091009 tpd src/axiom-website/patches.html 20091009.02.tpd.patch 20091009 tpd src/interp/compress.lisp cleanup 20091009 tpd src/axiom-website/patches.html 20091009.01.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 0eb6ddd..7ce879b 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2139,5 +2139,7 @@ src/interp/format.lisp cleanup
src/interp/database.lisp cleanup
20091009.02.tpd.patch src/interp/compress.lisp cleanup
+20091009.03.tpd.patch +src/interp/clammed.lisp cleanup
diff --git a/src/interp/clammed.lisp.pamphlet b/src/interp/clammed.lisp.pamphlet index edd0f0e..a0c487e 100644 --- a/src/interp/clammed.lisp.pamphlet +++ b/src/interp/clammed.lisp.pamphlet @@ -23,35 +23,38 @@ ; $insideCanCoerceFrom: local := [mr,m] ; canCoerceFrom0(mr,m) -(DEFUN |canCoerceFrom| (&REST #0=#:G166069 &AUX #1=#:G166064) - (DSETQ #1# #0#) - (PROG () - (RETURN - (PROG (#2=#:G166065) +(DEFUN |canCoerceFrom| (&REST G166069 &AUX G166064) + (DSETQ G166064 G166069) + (PROG () (RETURN - (COND - ((SETQ #2# (HGET |canCoerceFrom;AL| #1#)) (|CDRwithIncrement| #2#)) - ((QUOTE T) - (CDR (HPUT |canCoerceFrom;AL| #1# - (CONS 1 (APPLY (|function| |canCoerceFrom;|) #1#))))))))))) + (PROG (G166065) + (RETURN + (COND + ((SETQ G166065 (HGET |canCoerceFrom;AL| G166064)) + (|CDRwithIncrement| G166065)) + ('T + (CDR (HPUT |canCoerceFrom;AL| G166064 + (CONS 1 + (APPLY (|function| |canCoerceFrom;|) + G166064))))))))))) (DEFUN |canCoerceFrom;| (|mr| |m|) - (PROG (|$insideCanCoerceFrom|) - (DECLARE (SPECIAL |$insideCanCoerceFrom|)) - (RETURN - (PROGN - (SPADLET |$insideCanCoerceFrom| (CONS |mr| (CONS |m| NIL))) - (|canCoerceFrom0| |mr| |m|))))) - -(PUT - (QUOTE |canCoerceFrom|) - (QUOTE |cacheInfo|) - (QUOTE (|canCoerceFrom| |canCoerceFrom;AL| |hash-tableWithCounts| - (SETQ |canCoerceFrom;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) - (|hashCount| |canCoerceFrom;AL|)))) + (PROG (|$insideCanCoerceFrom|) + (DECLARE (SPECIAL |$insideCanCoerceFrom|)) + (RETURN + (PROGN + (SPADLET |$insideCanCoerceFrom| (CONS |mr| (CONS |m| NIL))) + (|canCoerceFrom0| |mr| |m|))))) + +(PUT '|canCoerceFrom| '|cacheInfo| + '(|canCoerceFrom| |canCoerceFrom;AL| |hash-tableWithCounts| + (SETQ |canCoerceFrom;AL| (MAKE-HASHTABLE 'UEQUAL)) + (|hashCount| |canCoerceFrom;AL|))) (SETQ |canCoerceFrom;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) +(SETQ |canCoerceFrom;AL| (MAKE-HASHTABLE 'UEQUAL)) + ;canCoerce(t1, t2) == ; val := canCoerce1(t1, t2) => val ; t1 is ['Variable, :.] => @@ -59,36 +62,38 @@ ; canCoerce1(t1, newMode) and canCoerce1(newMode, t2) ; nil -(DEFUN |canCoerce| (&REST #0=#:G166082 &AUX #1=#:G166077) - (DSETQ #1# #0#) - (PROG () - (RETURN - (PROG (#2=#:G166078) +(DEFUN |canCoerce| (&REST G166082 &AUX G166077) + (DSETQ G166077 G166082) + (PROG () (RETURN - (COND - ((SETQ #2# (HGET |canCoerce;AL| #1#)) (|CDRwithIncrement| #2#)) - ((QUOTE T) - (CDR (HPUT |canCoerce;AL| #1# - (CONS 1 (APPLY (|function| |canCoerce;|) #1#))))))))))) + (PROG (G166078) + (RETURN + (COND + ((SETQ G166078 (HGET |canCoerce;AL| G166077)) + (|CDRwithIncrement| G166078)) + ('T + (CDR (HPUT |canCoerce;AL| G166077 + (CONS 1 + (APPLY (|function| |canCoerce;|) + G166077))))))))))) (DEFUN |canCoerce;| (|t1| |t2|) - (PROG (|val| |newMode|) - (RETURN - (COND - ((SPADLET |val| (|canCoerce1| |t1| |t2|)) |val|) - ((AND (PAIRP |t1|) (EQ (QCAR |t1|) (QUOTE |Variable|))) - (SPADLET |newMode| (|getMinimalVarMode| |t1| NIL)) - (AND (|canCoerce1| |t1| |newMode|) (|canCoerce1| |newMode| |t2|))) - ((QUOTE T) NIL))))) - -(PUT - (QUOTE |canCoerce|) - (QUOTE |cacheInfo|) - (QUOTE (|canCoerce| |canCoerce;AL| |hash-tableWithCounts| - (SETQ |canCoerce;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) - (|hashCount| |canCoerce;AL|)))) - -(SETQ |canCoerce;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) + (PROG (|val| |newMode|) + (RETURN + (COND + ((SPADLET |val| (|canCoerce1| |t1| |t2|)) |val|) + ((AND (PAIRP |t1|) (EQ (QCAR |t1|) '|Variable|)) + (SPADLET |newMode| (|getMinimalVarMode| |t1| NIL)) + (AND (|canCoerce1| |t1| |newMode|) + (|canCoerce1| |newMode| |t2|))) + ('T NIL))))) + +(PUT '|canCoerce| '|cacheInfo| + '(|canCoerce| |canCoerce;AL| |hash-tableWithCounts| + (SETQ |canCoerce;AL| (MAKE-HASHTABLE 'UEQUAL)) + (|hashCount| |canCoerce;AL|))) + +(SETQ |canCoerce;AL| (MAKE-HASHTABLE 'UEQUAL)) ;coerceConvertMmSelection(funName,m1,m2) == ; -- calls selectMms with $Coerce=NIL and tests for required @@ -100,98 +105,111 @@ ; sig is [dc,targ,oarg] and isEqualOrSubDomain(m1,oarg)] ; mmS and CAR mmS -(DEFUN |coerceConvertMmSelection| (&REST #0=#:G166148 &AUX #1=#:G166143) - (DSETQ #1# #0#) - (PROG () - (RETURN - (PROG (#2=#:G166144) +(DEFUN |coerceConvertMmSelection| (&REST G166148 &AUX G166143) + (DSETQ G166143 G166148) + (PROG () (RETURN - (COND - ((SETQ #2# (HGET |coerceConvertMmSelection;AL| #1#)) - (|CDRwithIncrement| #2#)) - ((QUOTE T) - (CDR (HPUT |coerceConvertMmSelection;AL| #1# - (CONS 1 (APPLY (|function| |coerceConvertMmSelection;|) #1#))))))))))) + (PROG (G166144) + (RETURN + (COND + ((SETQ G166144 + (HGET |coerceConvertMmSelection;AL| G166143)) + (|CDRwithIncrement| G166144)) + ('T + (CDR (HPUT |coerceConvertMmSelection;AL| G166143 + (CONS 1 + (APPLY (|function| + |coerceConvertMmSelection;|) + G166143))))))))))) (DEFUN |coerceConvertMmSelection;| (|funName| |m1| |m2|) - (PROG (|$declaredMode| |$reportBottomUpFlag| |l| |sig| |dc| |ISTMP#1| - |targ| |ISTMP#2| |oarg| |mmS|) - (DECLARE (SPECIAL |$declaredMode| |$reportBottomUpFlag|)) - (RETURN - (SEQ - (PROGN - (SPADLET |$declaredMode| NIL) - (SPADLET |$reportBottomUpFlag| NIL) - (SPADLET |l| - (|selectMms1| |funName| |m2| (CONS |m1| NIL) (CONS |m1| NIL) NIL)) - (SPADLET |mmS| - (PROG (#0=#:G166113) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166119 |l| (CDR #1#)) (|x| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) - (SEQ - (EXIT - (COND - ((AND - (PAIRP |x|) - (PROGN (SPADLET |sig| (QCAR |x|)) (QUOTE T)) - (|hasCorrectTarget| |m2| |sig|) - (PAIRP |sig|) - (PROGN - (SPADLET |dc| (QCAR |sig|)) - (SPADLET |ISTMP#1| (QCDR |sig|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |targ| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |oarg| (QCAR |ISTMP#2|)) (QUOTE T)))))) - (|isEqualOrSubDomain| |m1| |oarg|)) - (SETQ #0# (CONS |x| #0#)))))))))) - (AND |mmS| (CAR |mmS|))))))) - -(PUT - (QUOTE |coerceConvertMmSelection|) - (QUOTE |cacheInfo|) - (QUOTE (|coerceConvertMmSelection| - |coerceConvertMmSelection;AL| - |hash-tableWithCounts| - (SETQ |coerceConvertMmSelection;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) - (|hashCount| |coerceConvertMmSelection;AL|)))) - -(SETQ |coerceConvertMmSelection;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) + (PROG (|$declaredMode| |$reportBottomUpFlag| |l| |sig| |dc| |ISTMP#1| + |targ| |ISTMP#2| |oarg| |mmS|) + (DECLARE (SPECIAL |$declaredMode| |$reportBottomUpFlag|)) + (RETURN + (SEQ (PROGN + (SPADLET |$declaredMode| NIL) + (SPADLET |$reportBottomUpFlag| NIL) + (SPADLET |l| + (|selectMms1| |funName| |m2| (CONS |m1| NIL) + (CONS |m1| NIL) NIL)) + (SPADLET |mmS| + (PROG (G166113) + (SPADLET G166113 NIL) + (RETURN + (DO ((G166119 |l| (CDR G166119)) + (|x| NIL)) + ((OR (ATOM G166119) + (PROGN + (SETQ |x| (CAR G166119)) + NIL)) + (NREVERSE0 G166113)) + (SEQ (EXIT (COND + ((AND (PAIRP |x|) + (PROGN + (SPADLET |sig| (QCAR |x|)) + 'T) + (|hasCorrectTarget| |m2| + |sig|) + (PAIRP |sig|) + (PROGN + (SPADLET |dc| + (QCAR |sig|)) + (SPADLET |ISTMP#1| + (QCDR |sig|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |targ| + (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) + NIL) + (PROGN + (SPADLET |oarg| + (QCAR |ISTMP#2|)) + 'T))))) + (|isEqualOrSubDomain| |m1| + |oarg|)) + (SETQ G166113 + (CONS |x| G166113)))))))))) + (AND |mmS| (CAR |mmS|))))))) + +(PUT '|coerceConvertMmSelection| '|cacheInfo| + '(|coerceConvertMmSelection| |coerceConvertMmSelection;AL| + |hash-tableWithCounts| + (SETQ |coerceConvertMmSelection;AL| (MAKE-HASHTABLE 'UEQUAL)) + (|hashCount| |coerceConvertMmSelection;AL|))) + +(SETQ |coerceConvertMmSelection;AL| (MAKE-HASHTABLE 'UEQUAL)) ;hasFileProperty(p,id,abbrev) == hasFilePropertyNoCache(p,id,abbrev) -(DEFUN |hasFileProperty| (&REST #0=#:G166157 &AUX #1=#:G166152) - (DSETQ #1# #0#) - (PROG () - (RETURN - (PROG (#2=#:G166153) +(DEFUN |hasFileProperty| (&REST G166157 &AUX G166152) + (DSETQ G166152 G166157) + (PROG () (RETURN - (COND - ((SETQ #2# (HGET |hasFileProperty;AL| #1#)) (|CDRwithIncrement| #2#)) - ((QUOTE T) - (CDR (HPUT |hasFileProperty;AL| #1# - (CONS 1 (APPLY (|function| |hasFileProperty;|) #1#))))))))))) + (PROG (G166153) + (RETURN + (COND + ((SETQ G166153 (HGET |hasFileProperty;AL| G166152)) + (|CDRwithIncrement| G166153)) + ('T + (CDR (HPUT |hasFileProperty;AL| G166152 + (CONS 1 + (APPLY (|function| |hasFileProperty;|) + G166152))))))))))) (DEFUN |hasFileProperty;| (|p| |id| |abbrev|) - (|hasFilePropertyNoCache| |p| |id| |abbrev|)) + (|hasFilePropertyNoCache| |p| |id| |abbrev|)) -(PUT - (QUOTE |hasFileProperty|) - (QUOTE |cacheInfo|) - (QUOTE (|hasFileProperty| - |hasFileProperty;AL| - |hash-tableWithCounts| - (SETQ |hasFileProperty;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) - (|hashCount| |hasFileProperty;AL|)))) +(PUT '|hasFileProperty| '|cacheInfo| + '(|hasFileProperty| |hasFileProperty;AL| |hash-tableWithCounts| + (SETQ |hasFileProperty;AL| (MAKE-HASHTABLE 'UEQUAL)) + (|hashCount| |hasFileProperty;AL|))) -(SETQ |hasFileProperty;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) +(SETQ |hasFileProperty;AL| (MAKE-HASHTABLE 'UEQUAL)) ;isValidType form == ; -- returns true IFF form is a type whose arguments satisfy the @@ -244,244 +262,276 @@ ; evalCategory(x,MSUBSTQ(x,'_$,c)) and isValidType x ; not GETDATABASE(opOf x,'CONSTRUCTORKIND) = 'domain -(DEFUN |isValidType| (#0=#:G166397) - (PROG () - (RETURN - (PROG (#1=#:G166398) +(DEFUN |isValidType| (G166397) + (PROG () (RETURN - (COND - ((SETQ #1# (HGET |isValidType;AL| #0#)) (|CDRwithIncrement| #1#)) - ((QUOTE T) - (CDR (HPUT |isValidType;AL| #0# (CONS 1 (|isValidType;| #0#))))))))))) + (PROG (G166398) + (RETURN + (COND + ((SETQ G166398 (HGET |isValidType;AL| G166397)) + (|CDRwithIncrement| G166398)) + ('T + (CDR (HPUT |isValidType;AL| G166397 + (CONS 1 (|isValidType;| G166397))))))))))) (DEFUN |isValidType;| (|form|) - (PROG (|selectors| |mapargs| |args| |LETTMP#1| |type| |badDoubles| T1 T2 D - |x| |ISTMP#4| |y| |ISTMP#5| |ISTMP#1| |ISTMP#2| |ISTMP#3| |op| - |cosig| |sig| |argl| |cl|) - (RETURN - (SEQ - (COND - ((STRINGP |form|) (QUOTE T)) - ((IDENTP |form|) NIL) - ((|member| |form| (QUOTE ((|Mode|) (|Domain|) (|SubDomain| (|Domain|))))) - (QUOTE T)) - ((AND (PAIRP |form|) - (EQ (QCAR |form|) (QUOTE |Record|)) - (PROGN (SPADLET |selectors| (QCDR |form|)) (QUOTE T))) - (PROG (#0=#:G166262) - (SPADLET #0# #1=(QUOTE T)) - (RETURN - (DO ((#2=#:G166269 NIL (NULL #0#)) - (#3=#:G166270 |selectors| (CDR #3#)) - (#4=#:G166158 NIL)) - ((OR #2# - (ATOM #3#) - (PROGN (SETQ #4# (CAR #3#)) NIL) - (PROGN - (PROGN - (SPADLET |LETTMP#1| (REVERSE #4#)) - (SPADLET |type| (CAR |LETTMP#1|)) #4#) - NIL)) - #0#) - (SEQ (EXIT (SETQ #0# (AND #0# (|isValidType| |type|))))))))) - ((AND (PAIRP |form|) - (EQ (QCAR |form|) (QUOTE |Enumeration|)) - (PROGN (SPADLET |args| (QCDR |form|)) (QUOTE T))) - (COND - ((NULL - (PROG (#5=#:G166278) - (SPADLET #5# #1#) - (RETURN - (DO ((#6=#:G166284 NIL (NULL #5#)) - (#7=#:G166285 |args| (CDR #7#)) - (|x| NIL)) - ((OR #6# (ATOM #7#) (PROGN (SETQ |x| (CAR #7#)) NIL)) #5#) - (SEQ (EXIT (SETQ #5# (AND #5# (IDENTP |x|))))))))) - NIL) - ((BOOT-EQUAL (|#| |args|) (|#| (REMDUP |args|))) (QUOTE T)) - ((QUOTE T) NIL))) - ((AND (PAIRP |form|) - (EQ (QCAR |form|) (QUOTE |Mapping|)) - (PROGN (SPADLET |mapargs| (QCDR |form|)) (QUOTE T))) - (COND - ((NULL |mapargs|) NIL) - ((QUOTE T) - (PROG (#8=#:G166292) - (SPADLET #8# #1#) - (RETURN - (DO ((#9=#:G166298 NIL (NULL #8#)) - (#10=#:G166299 |mapargs| (CDR #10#)) - (|type| NIL)) - ((OR #9# (ATOM #10#) (PROGN (SETQ |type| (CAR #10#)) NIL)) #8#) - (SEQ (EXIT (SETQ #8# (AND #8# (|isValidType| |type|))))))))))) - ((AND (PAIRP |form|) - (EQ (QCAR |form|) (QUOTE |Union|)) - (PROGN (SPADLET |args| (QCDR |form|)) (QUOTE T))) - (COND - ((AND |args| - (PROGN - (SPADLET |ISTMP#1| (CAR |args|)) - (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |:|))))) - (PROG (#11=#:G166306) - (SPADLET #11# #1#) - (RETURN - (DO ((#12=#:G166313 NIL (NULL #11#)) - (#13=#:G166314 |args| (CDR #13#)) - (#14=#:G166166 NIL)) - ((OR #12# - (ATOM #13#) - (PROGN (SETQ #14# (CAR #13#)) NIL) - (PROGN + (PROG (|selectors| |mapargs| |args| |LETTMP#1| |type| |badDoubles| T1 + T2 D |x| |ISTMP#4| |y| |ISTMP#5| |ISTMP#1| |ISTMP#2| + |ISTMP#3| |op| |cosig| |sig| |argl| |cl|) + (DECLARE (SPECIAL |$QuotientField|)) + (RETURN + (SEQ (COND + ((STRINGP |form|) 'T) + ((IDENTP |form|) NIL) + ((|member| |form| + '((|Mode|) (|Domain|) (|SubDomain| (|Domain|)))) + 'T) + ((AND (PAIRP |form|) (EQ (QCAR |form|) '|Record|) + (PROGN (SPADLET |selectors| (QCDR |form|)) 'T)) + (PROG (G166262) + (SPADLET G166262 'T) + (RETURN + (DO ((G166269 NIL (NULL G166262)) + (G166270 |selectors| (CDR G166270)) + (G166158 NIL)) + ((OR G166269 (ATOM G166270) + (PROGN + (SETQ G166158 (CAR G166270)) + NIL) + (PROGN + (PROGN + (SPADLET |LETTMP#1| (REVERSE G166158)) + (SPADLET |type| (CAR |LETTMP#1|)) + G166158) + NIL)) + G166262) + (SEQ (EXIT (SETQ G166262 + (AND G166262 + (|isValidType| |type|))))))))) + ((AND (PAIRP |form|) (EQ (QCAR |form|) '|Enumeration|) + (PROGN (SPADLET |args| (QCDR |form|)) 'T)) + (COND + ((NULL (PROG (G166278) + (SPADLET G166278 'T) + (RETURN + (DO ((G166284 NIL (NULL G166278)) + (G166285 |args| (CDR G166285)) + (|x| NIL)) + ((OR G166284 (ATOM G166285) + (PROGN + (SETQ |x| (CAR G166285)) + NIL)) + G166278) + (SEQ (EXIT (SETQ G166278 + (AND G166278 (IDENTP |x|))))))))) + NIL) + ((BOOT-EQUAL (|#| |args|) (|#| (REMDUP |args|))) 'T) + ('T NIL))) + ((AND (PAIRP |form|) (EQ (QCAR |form|) '|Mapping|) + (PROGN (SPADLET |mapargs| (QCDR |form|)) 'T)) + (COND + ((NULL |mapargs|) NIL) + ('T + (PROG (G166292) + (SPADLET G166292 'T) + (RETURN + (DO ((G166298 NIL (NULL G166292)) + (G166299 |mapargs| (CDR G166299)) + (|type| NIL)) + ((OR G166298 (ATOM G166299) + (PROGN + (SETQ |type| (CAR G166299)) + NIL)) + G166292) + (SEQ (EXIT (SETQ G166292 + (AND G166292 + (|isValidType| |type|))))))))))) + ((AND (PAIRP |form|) (EQ (QCAR |form|) '|Union|) + (PROGN (SPADLET |args| (QCDR |form|)) 'T)) + (COND + ((AND |args| (PROGN - (SPADLET |LETTMP#1| (REVERSE #14#)) - (SPADLET |type| (CAR |LETTMP#1|)) - #14#) - NIL)) - #11#) - (SEQ (EXIT (SETQ #11# (AND #11# (|isValidType| |type|))))))))) - ((NULL - (PROG (#15=#:G166322) - (SPADLET #15# #1#) - (RETURN - (DO ((#16=#:G166328 NIL (NULL #15#)) - (#17=#:G166329 |args| (CDR #17#)) - (|arg| NIL)) - ((OR #16# - (ATOM #17#) - (PROGN (SETQ |arg| (CAR #17#)) NIL)) - #15#) - (SEQ (EXIT (SETQ #15# (AND #15# (|isValidType| |arg|))))))))) - NIL) - ((BOOT-EQUAL (|#| |args|) (|#| (REMDUP |args|))) (QUOTE T)) - ((QUOTE T) (|sayKeyedMsg| (QUOTE S2IR0005) (CONS |form| NIL)) NIL))) - ((QUOTE T) - (SPADLET |badDoubles| - (CONS |$QuotientField| - (QUOTE (|Gaussian| |Complex| |Polynomial| |Expression|)))) - (COND - ((AND (PAIRP |form|) - (PROGN - (SPADLET T1 (QCAR |form|)) - (SPADLET |ISTMP#1| (QCDR |form|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN - (SPADLET T2 (QCAR |ISTMP#2|)) - (QUOTE T)))))) - (BOOT-EQUAL T1 T2) - (|member| T1 |badDoubles|)) - NIL) - ((AND (PAIRP |form|) - (EQUAL (QCAR |form|) |$QuotientField|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |form|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET D (QCAR |ISTMP#1|)) (QUOTE T)))) - (NULL (|isPartialMode| D)) (|ofCategory| D (QUOTE (|Field|)))) - NIL) - ((AND (PAIRP |form|) - (EQ (QCAR |form|) (QUOTE |UnivariatePolynomial|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |form|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |x| (QCAR |ISTMP#1|)) - (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|) - (EQ (QCAR |ISTMP#3|) - (QUOTE |UnivariatePolynomial|)) - (PROGN - (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) - (AND (PAIRP |ISTMP#4|) - (PROGN - (SPADLET |y| (QCAR |ISTMP#4|)) - (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) - (AND (PAIRP |ISTMP#5|) - (EQ (QCDR |ISTMP#5|) NIL))))))))))) - (BOOT-EQUAL |x| |y|)) - NIL) - ((BOOT-EQUAL |form| (QUOTE (|Complex| (|AlgebraicNumber|)))) - NIL) - ((AND (PAIRP |form|) - (EQ (QCAR |form|) (QUOTE |Expression|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |form|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCAR |ISTMP#2|) (QUOTE |Kernel|)) + (SPADLET |ISTMP#1| (CAR |args|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCAR |ISTMP#1|) '|:|)))) + (PROG (G166306) + (SPADLET G166306 'T) + (RETURN + (DO ((G166313 NIL (NULL G166306)) + (G166314 |args| (CDR G166314)) + (G166166 NIL)) + ((OR G166313 (ATOM G166314) + (PROGN + (SETQ G166166 (CAR G166314)) + NIL) + (PROGN + (PROGN + (SPADLET |LETTMP#1| + (REVERSE G166166)) + (SPADLET |type| (CAR |LETTMP#1|)) + G166166) + NIL)) + G166306) + (SEQ (EXIT (SETQ G166306 + (AND G166306 + (|isValidType| |type|))))))))) + ((NULL (PROG (G166322) + (SPADLET G166322 'T) + (RETURN + (DO ((G166328 NIL (NULL G166322)) + (G166329 |args| (CDR G166329)) + (|arg| NIL)) + ((OR G166328 (ATOM G166329) + (PROGN + (SETQ |arg| (CAR G166329)) + NIL)) + G166322) + (SEQ (EXIT (SETQ G166322 + (AND G166322 + (|isValidType| |arg|))))))))) + NIL) + ((BOOT-EQUAL (|#| |args|) (|#| (REMDUP |args|))) 'T) + ('T (|sayKeyedMsg| 'S2IR0005 (CONS |form| NIL)) NIL))) + ('T + (SPADLET |badDoubles| + (CONS |$QuotientField| + '(|Gaussian| |Complex| |Polynomial| + |Expression|))) + (COND + ((AND (PAIRP |form|) (PROGN - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL)))))))) - NIL) - ((AND (PAIRP |form|) - (PROGN - (SPADLET |op| (QCAR |form|)) - (SPADLET |argl| (QCDR |form|)) - (QUOTE T))) - (COND - ((NULL (|constructor?| |op|)) NIL) - ((QUOTE T) - (SPADLET |cosig| (GETDATABASE |op| (QUOTE COSIG))) - (COND - ((AND |cosig| (NULL (CDR |cosig|))) - (COND ((NULL |argl|) (QUOTE T)) ((QUOTE T) NIL))) - ((NULL (SPADLET |sig| (|getConstructorSignature| |form|))) NIL) - ((QUOTE T) - (SPADLET |cl| (CDR |sig|)) - (COND - ((AND (NEQUAL (|#| |cl|) (|#| |argl|)) (GENSYMP (|last| |argl|))) - (SPADLET |argl| (DROP (SPADDIFFERENCE 1) |argl|)))) - (COND - ((NEQUAL (|#| |cl|) (|#| |argl|)) NIL) - ((QUOTE T) - (SPADLET |cl| (|replaceSharps| |cl| |form|)) - (PROG (#18=#:G166336) - (SPADLET #18# #1#) - (RETURN - (DO ((#19=#:G166343 NIL (NULL #18#)) - (#20=#:G166344 |argl| (CDR #20#)) - (|x| NIL) - (#21=#:G166345 |cl| (CDR #21#)) (|c| NIL)) - ((OR #19# - (ATOM #20#) - (PROGN (SETQ |x| (CAR #20#)) NIL) - (ATOM #21#) - (PROGN (SETQ |c| (CAR #21#)) NIL)) - #18#) - (SEQ - (EXIT - (SETQ #18# - (AND #18# - (COND - ((|categoryForm?| |c|) - (AND - (|evalCategory| |x| (MSUBSTQ |x| (QUOTE $) |c|)) - (|isValidType| |x|))) - ((QUOTE T) - (NULL - (BOOT-EQUAL - (GETDATABASE (|opOf| |x|) 'CONSTRUCTORKIND) - (QUOTE |domain|)))))))))))))))))))))))))) - -(PUT - (QUOTE |isValidType|) - (QUOTE |cacheInfo|) - (QUOTE (|isValidType| |isValidType;AL| |hash-tableWithCounts| - (SETQ |isValidType;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) - (|hashCount| |isValidType;AL|)))) - -(SETQ |isValidType;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) + (SPADLET T1 (QCAR |form|)) + (SPADLET |ISTMP#1| (QCDR |form|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET T2 (QCAR |ISTMP#2|)) + 'T))))) + (BOOT-EQUAL T1 T2) (|member| T1 |badDoubles|)) + NIL) + ((AND (PAIRP |form|) + (EQUAL (QCAR |form|) |$QuotientField|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |form|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET D (QCAR |ISTMP#1|)) 'T))) + (NULL (|isPartialMode| D)) + (|ofCategory| D '(|Field|))) + NIL) + ((AND (PAIRP |form|) + (EQ (QCAR |form|) '|UnivariatePolynomial|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |form|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |x| (QCAR |ISTMP#1|)) + (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|) + (EQ (QCAR |ISTMP#3|) + '|UnivariatePolynomial|) + (PROGN + (SPADLET |ISTMP#4| + (QCDR |ISTMP#3|)) + (AND (PAIRP |ISTMP#4|) + (PROGN + (SPADLET |y| + (QCAR |ISTMP#4|)) + (SPADLET |ISTMP#5| + (QCDR |ISTMP#4|)) + (AND (PAIRP |ISTMP#5|) + (EQ (QCDR |ISTMP#5|) NIL))))))))))) + (BOOT-EQUAL |x| |y|)) + NIL) + ((BOOT-EQUAL |form| '(|Complex| (|AlgebraicNumber|))) + NIL) + ((AND (PAIRP |form|) (EQ (QCAR |form|) '|Expression|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |form|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCAR |ISTMP#2|) '|Kernel|) + (PROGN + (SPADLET |ISTMP#3| + (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (EQ (QCDR |ISTMP#3|) NIL)))))))) + NIL) + ((AND (PAIRP |form|) + (PROGN + (SPADLET |op| (QCAR |form|)) + (SPADLET |argl| (QCDR |form|)) + 'T)) + (COND + ((NULL (|constructor?| |op|)) NIL) + ('T (SPADLET |cosig| (GETDATABASE |op| 'COSIG)) + (COND + ((AND |cosig| (NULL (CDR |cosig|))) + (COND ((NULL |argl|) 'T) ('T NIL))) + ((NULL (SPADLET |sig| + (|getConstructorSignature| + |form|))) + NIL) + ('T (SPADLET |cl| (CDR |sig|)) + (COND + ((AND (NEQUAL (|#| |cl|) (|#| |argl|)) + (GENSYMP (|last| |argl|))) + (SPADLET |argl| + (DROP (SPADDIFFERENCE 1) |argl|)))) + (COND + ((NEQUAL (|#| |cl|) (|#| |argl|)) NIL) + ('T + (SPADLET |cl| (|replaceSharps| |cl| |form|)) + (PROG (G166336) + (SPADLET G166336 'T) + (RETURN + (DO ((G166343 NIL (NULL G166336)) + (G166344 |argl| (CDR G166344)) + (|x| NIL) + (G166345 |cl| (CDR G166345)) + (|c| NIL)) + ((OR G166343 (ATOM G166344) + (PROGN + (SETQ |x| (CAR G166344)) + NIL) + (ATOM G166345) + (PROGN + (SETQ |c| (CAR G166345)) + NIL)) + G166336) + (SEQ (EXIT + (SETQ G166336 + (AND G166336 + (COND + ((|categoryForm?| |c|) + (AND + (|evalCategory| |x| + (MSUBSTQ |x| '$ |c|)) + (|isValidType| |x|))) + ('T + (NULL + (BOOT-EQUAL + (GETDATABASE (|opOf| |x|) + 'CONSTRUCTORKIND) + '|domain|))))))))))))))))))))))))) + +(PUT '|isValidType| '|cacheInfo| + '(|isValidType| |isValidType;AL| |hash-tableWithCounts| + (SETQ |isValidType;AL| (MAKE-HASHTABLE 'UEQUAL)) + (|hashCount| |isValidType;AL|))) + +(SETQ |isValidType;AL| (MAKE-HASHTABLE 'UEQUAL)) ;selectMms1(op,tar,args1,args2,$Coerce) == ; -- for new compiler/old world compatibility, sometimes have to look @@ -493,36 +543,35 @@ ; -- NEW COMPILER COMPATIBILITY OFF ; selectMms2(op,tar,args1,args2,$Coerce) -(DEFUN |selectMms1| (&REST #0=#:G166411 &AUX #1=#:G166406) - (DSETQ #1# #0#) - (PROG NIL - (RETURN - (PROG (#2=#:G166407) +(DEFUN |selectMms1| (&REST G166411 &AUX G166406) + (DSETQ G166406 G166411) + (PROG () (RETURN - (COND - ((SETQ #2# (HGET |selectMms1;AL| #1#)) (|CDRwithIncrement| #2#)) - ((QUOTE T) - (CDR (HPUT |selectMms1;AL| #1# - (CONS 1 (APPLY (|function| |selectMms1;|) #1#))))))))))) + (PROG (G166407) + (RETURN + (COND + ((SETQ G166407 (HGET |selectMms1;AL| G166406)) + (|CDRwithIncrement| G166407)) + ('T + (CDR (HPUT |selectMms1;AL| G166406 + (CONS 1 + (APPLY (|function| |selectMms1;|) + G166406))))))))))) (DEFUN |selectMms1;| (|op| |tar| |args1| |args2| |$Coerce|) - (DECLARE (SPECIAL |$Coerce|)) - (COND - ((OR (BOOT-EQUAL |op| (QUOTE ^)) (BOOT-EQUAL |op| (QUOTE **))) - (APPEND - (|selectMms2| (QUOTE **) |tar| |args1| |args2| |$Coerce|) - (|selectMms2| (QUOTE ^) |tar| |args1| |args2| |$Coerce|))) - ((QUOTE T) - (|selectMms2| |op| |tar| |args1| |args2| |$Coerce|)))) - -(PUT - (QUOTE |selectMms1|) - (QUOTE |cacheInfo|) - (QUOTE (|selectMms1| |selectMms1;AL| |hash-tableWithCounts| - (SETQ |selectMms1;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) - (|hashCount| |selectMms1;AL|)))) - -(SETQ |selectMms1;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) + (DECLARE (SPECIAL |$Coerce|)) + (COND + ((OR (BOOT-EQUAL |op| '^) (BOOT-EQUAL |op| '**)) + (APPEND (|selectMms2| '** |tar| |args1| |args2| |$Coerce|) + (|selectMms2| '^ |tar| |args1| |args2| |$Coerce|))) + ('T (|selectMms2| |op| |tar| |args1| |args2| |$Coerce|)))) + +(PUT '|selectMms1| '|cacheInfo| + '(|selectMms1| |selectMms1;AL| |hash-tableWithCounts| + (SETQ |selectMms1;AL| (MAKE-HASHTABLE 'UEQUAL)) + (|hashCount| |selectMms1;AL|))) + +(SETQ |selectMms1;AL| (MAKE-HASHTABLE 'UEQUAL)) ;resolveTT(t1,t2) == ; -- resolves two types @@ -541,41 +590,41 @@ ; stopTimingProcess 'resolve ; nil -(DEFUN |resolveTT| (&REST #0=#:G166428 &AUX #1=#:G166423) - (DSETQ #1# #0#) - (PROG NIL - (RETURN - (PROG (#2=#:G166424) +(DEFUN |resolveTT| (&REST G166428 &AUX G166423) + (DSETQ G166423 G166428) + (PROG () (RETURN - (COND - ((SETQ #2# (HGET |resolveTT;AL| #1#)) (|CDRwithIncrement| #2#)) - ((QUOTE T) - (CDR (HPUT |resolveTT;AL| #1# - (CONS 1 (APPLY (|function| |resolveTT;|) #1#))))))))))) + (PROG (G166424) + (RETURN + (COND + ((SETQ G166424 (HGET |resolveTT;AL| G166423)) + (|CDRwithIncrement| G166424)) + ('T + (CDR (HPUT |resolveTT;AL| G166423 + (CONS 1 + (APPLY (|function| |resolveTT;|) + G166423))))))))))) (DEFUN |resolveTT;| (|t1| |t2|) - (PROG (|t|) - (RETURN - (PROGN - (|startTimingProcess| (QUOTE |resolve|)) - (SPADLET |t1| (|eqType| |t1|)) - (SPADLET |t2| (|eqType| |t2|)) - (COND - ((NULL (SPADLET |t| (|resolveTT1| |t1| |t2|))) - (|stopTimingProcess| (QUOTE |resolve|)) NIL) - ((|isValidType| (SPADLET |t| (|eqType| |t|))) - (|stopTimingProcess| (QUOTE |resolve|)) |t|) - ((QUOTE T) - (|stopTimingProcess| (QUOTE |resolve|)) NIL)))))) - -(PUT - (QUOTE |resolveTT|) - (QUOTE |cacheInfo|) - (QUOTE (|resolveTT| |resolveTT;AL| |hash-tableWithCounts| - (SETQ |resolveTT;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) - (|hashCount| |resolveTT;AL|)))) - -(SETQ |resolveTT;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) + (PROG (|t|) + (RETURN + (PROGN + (|startTimingProcess| '|resolve|) + (SPADLET |t1| (|eqType| |t1|)) + (SPADLET |t2| (|eqType| |t2|)) + (COND + ((NULL (SPADLET |t| (|resolveTT1| |t1| |t2|))) + (|stopTimingProcess| '|resolve|) NIL) + ((|isValidType| (SPADLET |t| (|eqType| |t|))) + (|stopTimingProcess| '|resolve|) |t|) + ('T (|stopTimingProcess| '|resolve|) NIL)))))) + +(PUT '|resolveTT| '|cacheInfo| + '(|resolveTT| |resolveTT;AL| |hash-tableWithCounts| + (SETQ |resolveTT;AL| (MAKE-HASHTABLE 'UEQUAL)) + (|hashCount| |resolveTT;AL|))) + +(SETQ |resolveTT;AL| (MAKE-HASHTABLE 'UEQUAL)) ;isLegitimateMode(t,hasPolyMode,polyVarList) == ; -- returns true IFF t is a valid type. i.e. if t has no repeated @@ -623,184 +672,209 @@ ; false ; false -(DEFUN |isLegitimateMode| (&REST #0=#:G166540 &AUX #1=#:G166535) - (DSETQ #1# #0#) - (PROG NIL - (RETURN - (PROG (#2=#:G166536) +(DEFUN |isLegitimateMode| (&REST G166540 &AUX G166535) + (DSETQ G166535 G166540) + (PROG () (RETURN - (COND - ((SETQ #2# (HGET |isLegitimateMode;AL| #1#)) (|CDRwithIncrement| #2#)) - ((QUOTE T) - (CDR (HPUT |isLegitimateMode;AL| #1# - (CONS 1 (APPLY (|function| |isLegitimateMode;|) #1#))))))))))) + (PROG (G166536) + (RETURN + (COND + ((SETQ G166536 (HGET |isLegitimateMode;AL| G166535)) + (|CDRwithIncrement| G166536)) + ('T + (CDR (HPUT |isLegitimateMode;AL| G166535 + (CONS 1 + (APPLY (|function| |isLegitimateMode;|) + G166535))))))))))) (DEFUN |isLegitimateMode;| (|t| |hasPolyMode| |polyVarList|) - (PROG (|badDoubles| T1 |ISTMP#2| T2 D |vl| |var| |con| |poly?| - |ml| |ISTMP#1| |r|) - (RETURN - (SEQ - (COND - ((NULL |t|) (QUOTE T)) - ((BOOT-EQUAL |t| |$EmptyMode|) (QUOTE T)) - ((STRINGP |t|) (QUOTE T)) - ((ATOM |t|) NIL) - ((QUOTE T) - (SPADLET |badDoubles| - (CONS |$QuotientField| - (QUOTE (|Gaussian| |Complex| |Polynomial| |Expression|)))) - (COND - ((AND (PAIRP |t|) - (PROGN - (SPADLET T1 (QCAR |t|)) - (SPADLET |ISTMP#1| (QCDR |t|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (PROGN (SPADLET T2 (QCAR |ISTMP#2|)) (QUOTE T)))))) - (BOOT-EQUAL T1 T2) - (|member| T1 |badDoubles|)) - NIL) - ((AND (PAIRP |t|) - (EQUAL (QCAR |t|) |$QuotientField|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |t|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET D (QCAR |ISTMP#1|)) (QUOTE T)))) - (NULL (|isPartialMode| D)) - (|ofCategory| D (QUOTE (|Field|)))) - NIL) - ((BOOT-EQUAL |t| (QUOTE (|Complex| (|AlgebraicNumber|)))) - NIL) - ((QUOTE T) - (SPADLET |t| (|equiType| |t|)) - (SEQ - (COND - ((SPADLET |vl| (|isPolynomialMode| |t|)) - (PROGN - (COND - ((NEQUAL |vl| (QUOTE |all|)) - (COND - ((SPADLET |var| - (PROG (#0=#:G166460) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166466 NIL #0#) - (#2=#:G166467 |vl| (CDR #2#)) - (|x| NIL)) - ((OR #1# - (ATOM #2#) - (PROGN (SETQ |x| (CAR #2#)) NIL)) - #0#) - (SEQ - (EXIT - (SETQ #0# - (OR #0# - (COND - ((|member| |x| |polyVarList|) |x|) - ((QUOTE T) NIL)))))))))) - (RETURN NIL)) - ((|listOfDuplicates| |vl|) - (RETURN NIL)) - ((QUOTE T) - (SPADLET |polyVarList| (|union| |vl| |polyVarList|)))))) - (COND - (|hasPolyMode| NIL) - ((QUOTE T) - (SPADLET |con| (CAR |t|)) - (SPADLET |poly?| - (OR - (BOOT-EQUAL |con| (QUOTE |Polynomial|)) - (BOOT-EQUAL |con| (QUOTE |Expression|)))) - (|isLegitimateMode| - (|underDomainOf| |t|) |poly?| |polyVarList|))))) - ((|constructor?| (CAR |t|)) - (COND - ((|isLegitimateMode| - (|underDomainOf| |t|) - |hasPolyMode| - |polyVarList|) - (EXIT |t|)))) - ((AND (PAIRP |t|) - (EQ (QCAR |t|) (QUOTE |Mapping|)) - (PROGN (SPADLET |ml| (QCDR |t|)) (QUOTE T))) - (COND - ((NULL |ml|) NIL) - ((NULL (|isLegitimateMode| (CAR |ml|) NIL NIL)) NIL) - ((QUOTE T) - (DO ((#3=#:G166477 (CDR |ml|) (CDR #3#)) (|m| NIL)) - ((OR (ATOM #3#) (PROGN (SETQ |m| (CAR #3#)) NIL)) NIL) - (SEQ - (EXIT - (COND - ((BOOT-EQUAL |m| |$Void|) (RETURN NIL)) - ((NULL (|isLegitimateMode| |m| NIL NIL)) (RETURN NIL)))))) - (QUOTE T)))) - ((AND (PAIRP |t|) - (EQ (QCAR |t|) (QUOTE |Union|)) - (PROGN (SPADLET |ml| (QCDR |t|)) (QUOTE T))) - (COND - ((AND |ml| - (PROGN - (SPADLET |ISTMP#1| (CAR |ml|)) - (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |:|))))) - (|isLegitimateRecordOrTaggedUnion| |ml|)) - ((NULL - (PROG (#4=#:G166483) - (SPADLET #4# #5=(QUOTE T)) - (RETURN - (DO ((#6=#:G166489 NIL (NULL #4#)) - (#7=#:G166490 |ml| (CDR #7#)) - (|m| NIL)) - ((OR #6# (ATOM #7#) (PROGN (SETQ |m| (CAR #7#)) NIL)) - #4#) - (SEQ - (EXIT - (SETQ #4# (AND #4# (|isLegitimateMode| |m| NIL NIL))))))))) - NIL) - ((BOOT-EQUAL (|#| |ml|) (|#| (REMDUP |ml|))) - (QUOTE T)) - ((QUOTE T) - NIL))) - ((AND (PAIRP |t|) - (EQ (QCAR |t|) (QUOTE |Record|)) - (PROGN (SPADLET |r| (QCDR |t|)) (QUOTE T))) - (|isLegitimateRecordOrTaggedUnion| |r|)) - ((AND (PAIRP |t|) - (EQ (QCAR |t|) (QUOTE |Enumeration|)) - (PROGN (SPADLET |r| (QCDR |t|)) (QUOTE T))) - (COND - ((NULL - (PROG (#8=#:G166497) - (SPADLET #8# #5#) - (RETURN - (DO ((#9=#:G166503 NIL (NULL #8#)) - (#10=#:G166504 |r| (CDR #10#)) - (|x| NIL)) - ((OR #9# - (ATOM #10#) - (PROGN (SETQ |x| (CAR #10#)) NIL)) - #8#) - (SEQ (EXIT (SETQ #8# (AND #8# (IDENTP |x|))))))))) - NIL) - ((BOOT-EQUAL (|#| |r|) (|#| (REMDUP |r|))) (QUOTE T)) - ((QUOTE T) NIL))) - ((QUOTE T) NIL))))))))))) - -(PUT - (QUOTE |isLegitimateMode|) - (QUOTE |cacheInfo|) - (QUOTE (|isLegitimateMode| - |isLegitimateMode;AL| - |hash-tableWithCounts| - (SETQ |isLegitimateMode;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) - (|hashCount| |isLegitimateMode;AL|)))) - -(SETQ |isLegitimateMode;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) + (PROG (|badDoubles| T1 |ISTMP#2| T2 D |vl| |var| |con| |poly?| |ml| + |ISTMP#1| |r|) + (DECLARE (SPECIAL |$Void| |$QuotientField| |$EmptyMode|)) + (RETURN + (SEQ (COND + ((NULL |t|) 'T) + ((BOOT-EQUAL |t| |$EmptyMode|) 'T) + ((STRINGP |t|) 'T) + ((ATOM |t|) NIL) + ('T + (SPADLET |badDoubles| + (CONS |$QuotientField| + '(|Gaussian| |Complex| |Polynomial| + |Expression|))) + (COND + ((AND (PAIRP |t|) + (PROGN + (SPADLET T1 (QCAR |t|)) + (SPADLET |ISTMP#1| (QCDR |t|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET T2 (QCAR |ISTMP#2|)) + 'T))))) + (BOOT-EQUAL T1 T2) (|member| T1 |badDoubles|)) + NIL) + ((AND (PAIRP |t|) (EQUAL (QCAR |t|) |$QuotientField|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |t|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET D (QCAR |ISTMP#1|)) 'T))) + (NULL (|isPartialMode| D)) + (|ofCategory| D '(|Field|))) + NIL) + ((BOOT-EQUAL |t| '(|Complex| (|AlgebraicNumber|))) NIL) + ('T (SPADLET |t| (|equiType| |t|)) + (SEQ (COND + ((SPADLET |vl| (|isPolynomialMode| |t|)) + (PROGN + (COND + ((NEQUAL |vl| '|all|) + (COND + ((SPADLET |var| + (PROG (G166460) + (SPADLET G166460 NIL) + (RETURN + (DO + ((G166466 NIL + G166460) + (G166467 |vl| + (CDR G166467)) + (|x| NIL)) + ((OR G166466 + (ATOM G166467) + (PROGN + (SETQ |x| + (CAR G166467)) + NIL)) + G166460) + (SEQ + (EXIT + (SETQ G166460 + (OR G166460 + (COND + ((|member| |x| + |polyVarList|) + |x|) + ('T NIL)))))))))) + (RETURN NIL)) + ((|listOfDuplicates| |vl|) + (RETURN NIL)) + ('T + (SPADLET |polyVarList| + (|union| |vl| |polyVarList|)))))) + (COND + (|hasPolyMode| NIL) + ('T (SPADLET |con| (CAR |t|)) + (SPADLET |poly?| + (OR + (BOOT-EQUAL |con| + '|Polynomial|) + (BOOT-EQUAL |con| + '|Expression|))) + (|isLegitimateMode| (|underDomainOf| |t|) + |poly?| |polyVarList|))))) + ((|constructor?| (CAR |t|)) + (COND + ((|isLegitimateMode| (|underDomainOf| |t|) + |hasPolyMode| |polyVarList|) + (EXIT |t|)))) + ((AND (PAIRP |t|) (EQ (QCAR |t|) '|Mapping|) + (PROGN (SPADLET |ml| (QCDR |t|)) 'T)) + (COND + ((NULL |ml|) NIL) + ((NULL (|isLegitimateMode| (CAR |ml|) NIL + NIL)) + NIL) + ('T + (DO ((G166477 (CDR |ml|) (CDR G166477)) + (|m| NIL)) + ((OR (ATOM G166477) + (PROGN + (SETQ |m| (CAR G166477)) + NIL)) + NIL) + (SEQ (EXIT + (COND + ((BOOT-EQUAL |m| |$Void|) + (RETURN NIL)) + ((NULL + (|isLegitimateMode| |m| NIL + NIL)) + (RETURN NIL)))))) + 'T))) + ((AND (PAIRP |t|) (EQ (QCAR |t|) '|Union|) + (PROGN (SPADLET |ml| (QCDR |t|)) 'T)) + (COND + ((AND |ml| + (PROGN + (SPADLET |ISTMP#1| (CAR |ml|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCAR |ISTMP#1|) '|:|)))) + (|isLegitimateRecordOrTaggedUnion| |ml|)) + ((NULL (PROG (G166483) + (SPADLET G166483 'T) + (RETURN + (DO + ((G166489 NIL + (NULL G166483)) + (G166490 |ml| + (CDR G166490)) + (|m| NIL)) + ((OR G166489 (ATOM G166490) + (PROGN + (SETQ |m| (CAR G166490)) + NIL)) + G166483) + (SEQ + (EXIT + (SETQ G166483 + (AND G166483 + (|isLegitimateMode| |m| NIL + NIL))))))))) + NIL) + ((BOOT-EQUAL (|#| |ml|) (|#| (REMDUP |ml|))) + 'T) + ('T NIL))) + ((AND (PAIRP |t|) (EQ (QCAR |t|) '|Record|) + (PROGN (SPADLET |r| (QCDR |t|)) 'T)) + (|isLegitimateRecordOrTaggedUnion| |r|)) + ((AND (PAIRP |t|) + (EQ (QCAR |t|) '|Enumeration|) + (PROGN (SPADLET |r| (QCDR |t|)) 'T)) + (COND + ((NULL (PROG (G166497) + (SPADLET G166497 'T) + (RETURN + (DO + ((G166503 NIL + (NULL G166497)) + (G166504 |r| (CDR G166504)) + (|x| NIL)) + ((OR G166503 (ATOM G166504) + (PROGN + (SETQ |x| (CAR G166504)) + NIL)) + G166497) + (SEQ + (EXIT + (SETQ G166497 + (AND G166497 (IDENTP |x|))))))))) + NIL) + ((BOOT-EQUAL (|#| |r|) (|#| (REMDUP |r|))) + 'T) + ('T NIL))) + ('T NIL))))))))))) + +(PUT '|isLegitimateMode| '|cacheInfo| + '(|isLegitimateMode| |isLegitimateMode;AL| |hash-tableWithCounts| + (SETQ |isLegitimateMode;AL| (MAKE-HASHTABLE 'UEQUAL)) + (|hashCount| |isLegitimateMode;AL|))) + +(SETQ |isLegitimateMode;AL| (MAKE-HASHTABLE 'UEQUAL)) ;underDomainOf t == ; t = $RationalNumber => $Integer @@ -810,38 +884,37 @@ ; u := getUnderModeOf(t) => u ; last d -(DEFUN |underDomainOf| (#0=#:G166547) - (PROG NIL - (RETURN - (PROG (#1=#:G166548) +(DEFUN |underDomainOf| (G166547) + (PROG () (RETURN - (COND - ((SETQ #1# (HGET |underDomainOf;AL| #0#)) (|CDRwithIncrement| #1#)) - ((QUOTE T) - (CDR - (HPUT |underDomainOf;AL| #0# (CONS 1 (|underDomainOf;| #0#))))))))))) + (PROG (G166548) + (RETURN + (COND + ((SETQ G166548 (HGET |underDomainOf;AL| G166547)) + (|CDRwithIncrement| G166548)) + ('T + (CDR (HPUT |underDomainOf;AL| G166547 + (CONS 1 (|underDomainOf;| G166547))))))))))) (DEFUN |underDomainOf;| (|t|) - (PROG (|d| |u|) - (RETURN - (COND - ((BOOT-EQUAL |t| |$RationalNumber|) |$Integer|) - ((NULL (PAIRP |t|)) NIL) - ((QUOTE T) - (SPADLET |d| (|deconstructT| |t|)) - (COND - ((EQL 1 (|#| |d|)) NIL) - ((SPADLET |u| (|getUnderModeOf| |t|)) |u|) - ((QUOTE T) (|last| |d|)))))))) - -(PUT - (QUOTE |underDomainOf|) - (QUOTE |cacheInfo|) - (QUOTE (|underDomainOf| |underDomainOf;AL| |hash-tableWithCounts| - (SETQ |underDomainOf;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) - (|hashCount| |underDomainOf;AL|)))) - -(SETQ |underDomainOf;AL| (MAKE-HASHTABLE (QUOTE UEQUAL))) + (PROG (|d| |u|) + (DECLARE (SPECIAL |$RationalNumber| |$Integer|)) + (RETURN + (COND + ((BOOT-EQUAL |t| |$RationalNumber|) |$Integer|) + ((NULL (PAIRP |t|)) NIL) + ('T (SPADLET |d| (|deconstructT| |t|)) + (COND + ((EQL 1 (|#| |d|)) NIL) + ((SPADLET |u| (|getUnderModeOf| |t|)) |u|) + ('T (|last| |d|)))))))) + +(PUT '|underDomainOf| '|cacheInfo| + '(|underDomainOf| |underDomainOf;AL| |hash-tableWithCounts| + (SETQ |underDomainOf;AL| (MAKE-HASHTABLE 'UEQUAL)) + (|hashCount| |underDomainOf;AL|))) + +(SETQ |underDomainOf;AL| (MAKE-HASHTABLE 'UEQUAL)) @ \eject