diff options
author | dos-reis <gdr@axiomatics.org> | 2010-06-04 02:43:19 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2010-06-04 02:43:19 +0000 |
commit | 2504b96ac76f31c60ab32979509e6f3b4b7a8b10 (patch) | |
tree | 303bcf51784f4c93fb5154d2f31632566920c347 | |
parent | b043245231dca601a9a11ae6ddf4e89cc97c3d6c (diff) | |
download | open-axiom-2504b96ac76f31c60ab32979509e6f3b4b7a8b10.tar.gz |
* interp/buildom.boot: Clean up QEQCAR uses.
-rw-r--r-- | src/ChangeLog | 4 | ||||
-rw-r--r-- | src/algebra/strap/EUCDOM-.lsp | 29 | ||||
-rw-r--r-- | src/algebra/strap/FFIELDC-.lsp | 8 | ||||
-rw-r--r-- | src/algebra/strap/GCDDOM-.lsp | 26 | ||||
-rw-r--r-- | src/algebra/strap/INT.lsp | 5 | ||||
-rw-r--r-- | src/algebra/strap/INTDOM-.lsp | 8 | ||||
-rw-r--r-- | src/algebra/strap/POLYCAT-.lsp | 87 | ||||
-rw-r--r-- | src/algebra/strap/QFCAT-.lsp | 12 | ||||
-rw-r--r-- | src/algebra/strap/RNS-.lsp | 4 | ||||
-rw-r--r-- | src/algebra/strap/SYMBOL.lsp | 4 | ||||
-rw-r--r-- | src/interp/buildom.boot | 10 | ||||
-rw-r--r-- | src/interp/compiler.boot | 2 |
12 files changed, 105 insertions, 94 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 81094634..f56ddc92 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,9 @@ 2010-06-03 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/buildom.boot: Clean up QEQCAR uses. + +2010-06-03 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/buildom.boot: Cleanup. * interp/c-util.boot ($SetCategory): New constant. * interp/compiler.boot: Use it. diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp index 182e6cb0..659824d5 100644 --- a/src/algebra/strap/EUCDOM-.lsp +++ b/src/algebra/strap/EUCDOM-.lsp @@ -196,20 +196,20 @@ (|getShellEntry| $ 37)) |EUCDOM-;extendedEuclidean;3SU;8|) (EXIT (COND - ((QEQCAR |w| 1) (CONS 1 "failed")) + ((EQL (CAR |w|) 1) (CONS 1 "failed")) ((SPADCALL |y| (|getShellEntry| $ 8)) (CONS 0 (CONS (SPADCALL (QVELT |s| 0) - (QCDR |w|) + (CDR |w|) (|getShellEntry| $ 29)) (SPADCALL (QVELT |s| 1) - (QCDR |w|) + (CDR |w|) (|getShellEntry| $ 29))))) ('T (SEQ (LETT |qr| (SPADCALL (SPADCALL (QVELT |s| 0) - (QCDR |w|) + (CDR |w|) (|getShellEntry| $ 29)) |y| (|getShellEntry| $ 16)) |EUCDOM-;extendedEuclidean;3SU;8|) @@ -217,7 +217,7 @@ (CONS (QCDR |qr|) (SPADCALL (SPADCALL (QVELT |s| 1) - (QCDR |w|) + (CDR |w|) (|getShellEntry| $ 29)) (SPADCALL (QCAR |qr|) |x| (|getShellEntry| $ 29)) @@ -315,7 +315,7 @@ (|getShellEntry| $ 37)) |EUCDOM-;expressIdealMember;LSU;10|) (EXIT (COND - ((QEQCAR |q| 1) (CONS 1 "failed")) + ((EQL (CAR |q|) 1) (CONS 1 "failed")) ('T (CONS 0 (PROGN @@ -336,7 +336,7 @@ (GO G191))) (LETT #2# (CONS - (SPADCALL (QCDR |q|) |v| + (SPADCALL (CDR |q|) |v| (|getShellEntry| $ 29)) #2#) |EUCDOM-;expressIdealMember;LSU;10|) @@ -446,32 +446,31 @@ |z| (|getShellEntry| $ 62)) |EUCDOM-;multiEuclidean;LSU;11|) (EXIT (COND - ((QEQCAR |u| 1) (CONS 1 "failed")) + ((EQL (CAR |u|) 1) (CONS 1 "failed")) ('T (SEQ (LETT |v1| - (SPADCALL |l1| - (QCDR (QCDR |u|)) + (SPADCALL |l1| (QCDR (CDR |u|)) (|getShellEntry| $ 63)) |EUCDOM-;multiEuclidean;LSU;11|) (EXIT (COND - ((QEQCAR |v1| 1) + ((EQL (CAR |v1|) 1) (CONS 1 "failed")) ('T (SEQ (LETT |v2| (SPADCALL |l2| - (QCAR (QCDR |u|)) + (QCAR (CDR |u|)) (|getShellEntry| $ 63)) |EUCDOM-;multiEuclidean;LSU;11|) (EXIT (COND - ((QEQCAR |v2| 1) + ((EQL (CAR |v2|) 1) (CONS 1 "failed")) ('T (CONS 0 - (SPADCALL (QCDR |v1|) - (QCDR |v2|) + (SPADCALL (CDR |v1|) + (CDR |v2|) (|getShellEntry| $ 64)))))))))))))))))))))) diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp index 7fecd7b2..6064e646 100644 --- a/src/algebra/strap/FFIELDC-.lsp +++ b/src/algebra/strap/FFIELDC-.lsp @@ -318,7 +318,7 @@ |FFIELDC-;discreteLog;SNni;11|) (EXIT (COND - ((QEQCAR |rho| 0) + ((EQL (CAR |rho|) 0) (SEQ (LETT |found| T |FFIELDC-;discreteLog;SNni;11|) @@ -326,7 +326,7 @@ (LETT |disc1| (* (+ (* |n| |i|) - (QCDR |rho|)) + (CDR |rho|)) |mult|) |FFIELDC-;discreteLog;SNni;11|)))) ('T @@ -463,7 +463,7 @@ |FFIELDC-;discreteLog;2SU;12|) (EXIT (COND - ((QEQCAR |rhoHelp| 1) + ((EQL (CAR |rhoHelp|) 1) (PROGN (LETT #2# (CONS 1 "failed") @@ -472,7 +472,7 @@ ('T (SEQ (LETT |rho| - (* (QCDR |rhoHelp|) + (* (CDR |rhoHelp|) |mult|) |FFIELDC-;discreteLog;2SU;12|) (LETT |disclog| diff --git a/src/algebra/strap/GCDDOM-.lsp b/src/algebra/strap/GCDDOM-.lsp index af8bb4ba..f1d298cf 100644 --- a/src/algebra/strap/GCDDOM-.lsp +++ b/src/algebra/strap/GCDDOM-.lsp @@ -29,8 +29,8 @@ (|getShellEntry| $ 12)) |GCDDOM-;lcm;3S;1|) (EXIT (COND - ((QEQCAR LCM 0) - (SPADCALL |x| (QCDR LCM) + ((EQL (CAR LCM) 0) + (SPADCALL |x| (CDR LCM) (|getShellEntry| $ 13))) ('T (|error| "bad gcd in lcm computation"))))))))))) @@ -60,8 +60,8 @@ (SPADCALL |p1| |c1| (|getShellEntry| $ 27)) |GCDDOM-;gcdPolynomial;3Sup;4|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) + (CDR #0#) + (|check-union| (EQL (CAR #0#) 0) (|SparseUnivariatePolynomial| (|getShellEntry| $ 6)) #0#)) @@ -71,8 +71,8 @@ (SPADCALL |p2| |c2| (|getShellEntry| $ 27)) |GCDDOM-;gcdPolynomial;3Sup;4|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) + (CDR #0#) + (|check-union| (EQL (CAR #0#) 0) (|SparseUnivariatePolynomial| (|getShellEntry| $ 6)) #0#)) @@ -91,8 +91,9 @@ (|getShellEntry| $ 34)) (|getShellEntry| $ 35)) |GCDDOM-;gcdPolynomial;3Sup;4|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) + (CDR #0#) + (|check-union| + (EQL (CAR #0#) 0) (|SparseUnivariatePolynomial| (|getShellEntry| $ 6)) #0#)) @@ -111,8 +112,9 @@ (|getShellEntry| $ 34)) (|getShellEntry| $ 35)) |GCDDOM-;gcdPolynomial;3Sup;4|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) + (CDR #0#) + (|check-union| + (EQL (CAR #0#) 0) (|SparseUnivariatePolynomial| (|getShellEntry| $ 6)) #0#)) @@ -169,9 +171,9 @@ (|getShellEntry| $ 27)) |GCDDOM-;gcdPolynomial;3Sup;4|) - (QCDR #0#) + (CDR #0#) (|check-union| - (QEQCAR #0# 0) + (EQL (CAR #0#) 0) (|SparseUnivariatePolynomial| (|getShellEntry| $ 6)) diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp index 172fcd30..23b42bf6 100644 --- a/src/algebra/strap/INT.lsp +++ b/src/algebra/strap/INT.lsp @@ -494,8 +494,9 @@ (|getShellEntry| $ 108)) (|getShellEntry| $ 112)) |INT;factorPolynomial|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) $ #0#)) + (CDR #0#) + (|check-union| (EQL (CAR #0#) 0) $ + #0#)) (|getShellEntry| $ 114)) (|getShellEntry| $ 118)) (|getShellEntry| $ 120))))))))) diff --git a/src/algebra/strap/INTDOM-.lsp b/src/algebra/strap/INTDOM-.lsp index bed677e8..1a7126d9 100644 --- a/src/algebra/strap/INTDOM-.lsp +++ b/src/algebra/strap/INTDOM-.lsp @@ -31,7 +31,9 @@ ('T (SPADCALL (|spadConstant| $ 7) |x| (|getShellEntry| $ 15))))) (DEFUN |INTDOM-;unit?;SB;4| (|x| $) - (COND ((QEQCAR (SPADCALL |x| (|getShellEntry| $ 17)) 1) NIL) ('T T))) + (COND + ((EQL (CAR (SPADCALL |x| (|getShellEntry| $ 17))) 1) NIL) + ('T T))) (DEFUN |INTDOM-;associates?;2SB;5| (|x| |y| $) (SPADCALL (QVELT (SPADCALL |x| (|getShellEntry| $ 10)) 1) @@ -43,8 +45,8 @@ ((SPADCALL |x| (|getShellEntry| $ 13)) (SPADCALL |y| (|getShellEntry| $ 13))) ((OR (SPADCALL |y| (|getShellEntry| $ 13)) - (OR (QEQCAR (SPADCALL |x| |y| (|getShellEntry| $ 15)) 1) - (QEQCAR (SPADCALL |y| |x| (|getShellEntry| $ 15)) 1))) + (OR (EQL (CAR (SPADCALL |x| |y| (|getShellEntry| $ 15))) 1) + (EQL (CAR (SPADCALL |y| |x| (|getShellEntry| $ 15))) 1))) NIL) ('T T))) diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp index cb7b1776..ebf96a67 100644 --- a/src/algebra/strap/POLYCAT-.lsp +++ b/src/algebra/strap/POLYCAT-.lsp @@ -159,11 +159,12 @@ NIL)) (GO G191))) (COND - ((QEQCAR - (SPADCALL - (SPADCALL |e| - (|getShellEntry| $ 14)) - (|getShellEntry| $ 16)) + ((EQL + (CAR + (SPADCALL + (SPADCALL |e| + (|getShellEntry| $ 14)) + (|getShellEntry| $ 16))) 1) (PROGN (LETT #1# @@ -313,18 +314,18 @@ (SEQ (LETT |u| (SPADCALL |p| (|getShellEntry| $ 53)) |POLYCAT-;isExpt;SU;5|) (EXIT (COND - ((OR (QEQCAR |u| 1) + ((OR (EQL (CAR |u|) 1) (NOT (SPADCALL |p| (SPADCALL (|spadConstant| $ 43) - (QCDR |u|) + (CDR |u|) (LETT |d| - (SPADCALL |p| (QCDR |u|) + (SPADCALL |p| (CDR |u|) (|getShellEntry| $ 46)) |POLYCAT-;isExpt;SU;5|) (|getShellEntry| $ 47)) (|getShellEntry| $ 54)))) (CONS 1 "failed")) - ('T (CONS 0 (CONS (QCDR |u|) |d|))))))))) + ('T (CONS 0 (CONS (CDR |u|) |d|))))))))) (DEFUN |POLYCAT-;coefficient;SVarSetNniS;6| (|p| |v| |n| $) (SPADCALL (SPADCALL |p| |v| (|getShellEntry| $ 59)) |n| @@ -363,9 +364,9 @@ (SEQ (LETT |q| (PROG2 (LETT #0# (SPADCALL |p| (|getShellEntry| $ 53)) |POLYCAT-;retract;SVarSet;9|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 9) - #0#)) + (CDR #0#) + (|check-union| (EQL (CAR #0#) 0) + (|getShellEntry| $ 9) #0#)) |POLYCAT-;retract;SVarSet;9|) (EXIT (COND ((SPADCALL (SPADCALL |q| (|getShellEntry| $ 72)) |p| @@ -380,10 +381,10 @@ (SPADCALL |p| (|getShellEntry| $ 53)) |POLYCAT-;retractIfCan;SU;10|) (EXIT (COND - ((QEQCAR |q| 0) + ((EQL (CAR |q|) 0) (COND ((SPADCALL - (SPADCALL (QCDR |q|) + (SPADCALL (CDR |q|) (|getShellEntry| $ 72)) |p| (|getShellEntry| $ 54)) (PROGN @@ -431,8 +432,8 @@ (SPADCALL |p| (|getShellEntry| $ 53)) |POLYCAT-;totalDegree;SNni;13|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) + (CDR #0#) + (|check-union| (EQL (CAR #0#) 0) (|getShellEntry| $ 9) #0#)) (|getShellEntry| $ 59)) |POLYCAT-;totalDegree;SNni;13|) @@ -473,8 +474,8 @@ (SPADCALL |p| (|getShellEntry| $ 53)) |POLYCAT-;totalDegree;SLNni;14|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) + (CDR #0#) + (|check-union| (EQL (CAR #0#) 0) (|getShellEntry| $ 9) #0#)) |POLYCAT-;totalDegree;SLNni;14|) (|getShellEntry| $ 59)) @@ -800,7 +801,7 @@ (SEQ (LETT |v| (SPADCALL |p| (|getShellEntry| $ 53)) |POLYCAT-;factor;SF;26|) (EXIT (COND - ((QEQCAR |v| 1) + ((EQL (CAR |v|) 1) (SEQ (LETT |ansR| (SPADCALL (SPADCALL |p| @@ -847,7 +848,7 @@ (|getShellEntry| $ 159))))) ('T (SEQ (LETT |up| - (SPADCALL |p| (QCDR |v|) + (SPADCALL |p| (CDR |v|) (|getShellEntry| $ 59)) |POLYCAT-;factor;SF;26|) (LETT |ansSUP| @@ -857,7 +858,7 @@ (SPADCALL (SPADCALL |ansSUP| (|getShellEntry| $ 160)) - (QCDR |v|) (|getShellEntry| $ 161)) + (CDR |v|) (|getShellEntry| $ 161)) (PROGN (LETT #2# NIL |POLYCAT-;factor;SF;26|) @@ -882,7 +883,7 @@ (CONS (VECTOR (QVELT |ww| 0) (SPADCALL (QVELT |ww| 1) - (QCDR |v|) + (CDR |v|) (|getShellEntry| $ 161)) (QVELT |ww| 2)) #2#) @@ -1043,7 +1044,7 @@ |POLYCAT-;conditionP;MU;27|) (EXIT (COND - ((QEQCAR |nd| 1) + ((EQL (CAR |nd|) 1) (PROGN (LETT #10# (CONS 1 "failed") @@ -1052,7 +1053,7 @@ ('T (LET ((#20=#:G1612 - (QCDR |nd|))) + (CDR |nd|))) (|check-subtype| (>= #20# 0) '(|NonNegativeInteger|) @@ -1139,7 +1140,7 @@ (|getShellEntry| $ 180)) |POLYCAT-;conditionP;MU;27|) (EXIT (COND - ((QEQCAR |ans| 1) (CONS 1 "failed")) + ((EQL (CAR |ans|) 1) (CONS 1 "failed")) ('T (SEQ (LETT |i| 0 |POLYCAT-;conditionP;MU;27|) @@ -1194,7 +1195,7 @@ (SPADCALL |m| (SPADCALL (SPADCALL - (QCDR |ans|) + (CDR |ans|) (LETT |i| (+ |i| 1) |POLYCAT-;conditionP;MU;27|) @@ -1250,10 +1251,11 @@ (|getShellEntry| $ 185)) |POLYCAT-;charthRoot;SU;28|) (EXIT (COND - ((QEQCAR |ans| 1) (CONS 1 "failed")) + ((EQL (CAR |ans|) 1) + (CONS 1 "failed")) ('T (CONS 0 - (SPADCALL (QCDR |ans|) + (SPADCALL (CDR |ans|) (|getShellEntry| $ 51)))))))) ('T (SEQ (LETT |ch| (|spadConstant| $ 169) @@ -1273,10 +1275,11 @@ (|getShellEntry| $ 185)) |POLYCAT-;charthRootlv|) (EXIT (COND - ((QEQCAR |ans| 1) (CONS 1 "failed")) + ((EQL (CAR |ans|) 1) + (CONS 1 "failed")) ('T (CONS 0 - (SPADCALL (QCDR |ans|) + (SPADCALL (CDR |ans|) (|getShellEntry| $ 51)))))))) ('T (SEQ (LETT |v| (|SPADfirst| |vars|) @@ -1296,7 +1299,7 @@ |POLYCAT-;charthRootlv|) (EXIT (COND - ((QEQCAR |dd| 1) + ((EQL (CAR |dd|) 1) (PROGN (LETT #0# (CONS 1 "failed") |POLYCAT-;charthRootlv|) @@ -1319,7 +1322,7 @@ |POLYCAT-;charthRootlv|) (EXIT (COND - ((QEQCAR |ansx| 1) + ((EQL (CAR |ansx|) 1) (PROGN (LETT #0# (CONS 1 "failed") @@ -1334,11 +1337,11 @@ (EXIT (LETT |ans| (SPADCALL |ans| - (SPADCALL (QCDR |ansx|) + (SPADCALL (CDR |ansx|) |v| (LET ((#1=#:G1640 - (QCDR |dd|))) + (CDR |dd|))) (|check-subtype| (>= #1# 0) '(|NonNegativeInteger|) @@ -1352,7 +1355,7 @@ $) |POLYCAT-;charthRootlv|) (EXIT (COND - ((QEQCAR |ansx| 1) + ((EQL (CAR |ansx|) 1) (PROGN (LETT #0# (CONS 1 "failed") |POLYCAT-;charthRootlv|) @@ -1361,7 +1364,7 @@ (PROGN (LETT #0# (CONS 0 - (SPADCALL |ans| (QCDR |ansx|) + (SPADCALL |ans| (CDR |ansx|) (|getShellEntry| $ 183))) |POLYCAT-;charthRootlv|) (GO #0#))))))))) @@ -1445,9 +1448,9 @@ (|getShellEntry| $ 206)) (|getShellEntry| $ 207)) |POLYCAT-;primitivePart;2S;36|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 6) - #0#)) + (CDR #0#) + (|check-union| (EQL (CAR #0#) 0) + (|getShellEntry| $ 6) #0#)) (|getShellEntry| $ 209)) 1)))) @@ -1461,9 +1464,9 @@ (|getShellEntry| $ 211)) (|getShellEntry| $ 212)) |POLYCAT-;primitivePart;SVarSetS;37|) - (QCDR #0#) - (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 6) - #0#)) + (CDR #0#) + (|check-union| (EQL (CAR #0#) 0) + (|getShellEntry| $ 6) #0#)) (|getShellEntry| $ 209)) 1)))) diff --git a/src/algebra/strap/QFCAT-.lsp b/src/algebra/strap/QFCAT-.lsp index aa8a25a6..ffa5c6e5 100644 --- a/src/algebra/strap/QFCAT-.lsp +++ b/src/algebra/strap/QFCAT-.lsp @@ -101,11 +101,11 @@ (|getShellEntry| $ 18)) |QFCAT-;nextItem;AU;4|) (EXIT (COND - ((QEQCAR |m| 1) + ((EQL (CAR |m|) 1) (|error| "We seem to have a Fraction of a finite object")) ('T (CONS 0 - (SPADCALL (QCDR |m|) (|spadConstant| $ 14) + (SPADCALL (CDR |m|) (|spadConstant| $ 14) (|getShellEntry| $ 15)))))))))) (DEFUN |QFCAT-;map;M2A;5| (|fn| |x| $) @@ -221,8 +221,8 @@ (SEQ (LETT |r| (SPADCALL |x| (|getShellEntry| $ 63)) |QFCAT-;retractIfCan;AU;18|) (EXIT (COND - ((QEQCAR |r| 1) (CONS 1 "failed")) - ('T (SPADCALL (QCDR |r|) (|getShellEntry| $ 65))))))))) + ((EQL (CAR |r|) 1) (CONS 1 "failed")) + ('T (SPADCALL (CDR |r|) (|getShellEntry| $ 65))))))))) (DEFUN |QFCAT-;convert;AP;19| (|x| $) (SPADCALL @@ -264,8 +264,8 @@ (SEQ (LETT |u| (SPADCALL |x| (|getShellEntry| $ 63)) |QFCAT-;retractIfCan;AU;25|) (EXIT (COND - ((QEQCAR |u| 1) (CONS 1 "failed")) - ('T (SPADCALL (QCDR |u|) (|getShellEntry| $ 95))))))))) + ((EQL (CAR |u|) 1) (CONS 1 "failed")) + ('T (SPADCALL (CDR |u|) (|getShellEntry| $ 95))))))))) (DEFUN |QFCAT-;random;A;26| ($) (PROG (|d|) diff --git a/src/algebra/strap/RNS-.lsp b/src/algebra/strap/RNS-.lsp index d0c985f5..de5580c1 100644 --- a/src/algebra/strap/RNS-.lsp +++ b/src/algebra/strap/RNS-.lsp @@ -122,12 +122,12 @@ (SEQ (LETT |r| (SPADCALL |p| (|getShellEntry| $ 51)) |RNS-;patternMatch;SP2Pmr;10|) (EXIT (COND - ((QEQCAR |r| 0) + ((EQL (CAR |r|) 0) (COND ((SPADCALL (SPADCALL |x| (|getShellEntry| $ 33)) - (QCDR |r|) (|getShellEntry| $ 52)) + (CDR |r|) (|getShellEntry| $ 52)) |l|) ('T (SPADCALL (|getShellEntry| $ 53))))) ('T (SPADCALL (|getShellEntry| $ 53))))))) diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp index 1b94a4b0..56acba33 100644 --- a/src/algebra/strap/SYMBOL.lsp +++ b/src/algebra/strap/SYMBOL.lsp @@ -491,8 +491,8 @@ (|getShellEntry| $ 124)) |SYMBOL;new;2$;28|) (EXIT (COND - ((QEQCAR |u| 1) 0) - ('T (+ (QCDR |u|) 1))))) + ((EQL (CAR |u|) 1) 0) + ('T (+ (CDR |u|) 1))))) |SYMBOL;new;2$;28|) (SPADCALL (|getShellEntry| $ 13) |x| |n| (|getShellEntry| $ 127)) diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index d9fb9e15..b76c110a 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -349,15 +349,15 @@ mkNewUnionFunList(name,form is ["Union",:listOfEntries],e) == [[["construct",[name,type],["XLAM",["#1"],["%makepair",i,"#1"]]], ["elt",[type,name,tag],cdownFun], ["case",[$Boolean,name,tag], - ["XLAM",["#1"],["QEQCAR","#1",i]]]] + ["XLAM",["#1"],['%ieq,['%head,"#1"],i]]]] for [.,tag,type] in listOfEntries for i in 0..])] where cdownFun() == gg:=gensym() $InteractiveMode => ["XLAM",["#1"],["PROG1",["%tail","#1"], - ["check-union",["QEQCAR","#1",i],type,"#1"]]] + ["check-union",['%ieq,['%head,"#1"],i],type,"#1"]]] ["XLAM",["#1"],["PROG2",["%LET",gg,"#1"],["%tail",gg], - ["check-union",["QEQCAR",gg,i],type,gg]]] + ["check-union",['%ieq,['%head,gg],i],type,gg]]] [cList,e] mkEnumerationFunList(nam,["Enumeration",:SL],e) == @@ -396,7 +396,7 @@ mkUnionFunList(op,form is ["Union",:listOfEntries],e) == gg:=gensym() if p is ["EQCAR",x,n] then ref:=["%tail",gg] - q:= ["QEQCAR", gg, n] + q:= ['%ieq,['%head,gg],n] else ref:=gg q:= substitute(gg,"#1",p) @@ -408,7 +408,7 @@ mkUnionFunList(op,form is ["Union",:listOfEntries],e) == ["XLAM",["#1"],"#1"] typeFun() == p is ["EQCAR",x,n] => - ["XLAM",["#1"],["QEQCAR",x,n]] + ["XLAM",["#1"],['%ieq,['%head,x],n]] ["XLAM",["#1"],p] cList:= substitute(dollarIfRepHack op,g,cList) [cList,e] diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index c6410bb7..467605ff 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -1975,7 +1975,7 @@ compRetractGuard(x,t,sn,sm,e) == -- the condition and the body of the alternative, so just use -- assignment here and let the rest of the compiler deal with it. z := gensym() - caseCode := ["PROGN",["%LET",z,retractCode],["QEQCAR",z,0]] + caseCode := ["PROGN",["%LET",z,retractCode],['%ieq,['%head,z],0]] restrictCode := ["QCDR",z] -- 1.3. Everything else failed; nice try. else return stackAndThrow('"%1bp is not retractable to %2bp",[sm,t]) |