aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog4
-rw-r--r--src/algebra/strap/EUCDOM-.lsp29
-rw-r--r--src/algebra/strap/FFIELDC-.lsp8
-rw-r--r--src/algebra/strap/GCDDOM-.lsp26
-rw-r--r--src/algebra/strap/INT.lsp5
-rw-r--r--src/algebra/strap/INTDOM-.lsp8
-rw-r--r--src/algebra/strap/POLYCAT-.lsp87
-rw-r--r--src/algebra/strap/QFCAT-.lsp12
-rw-r--r--src/algebra/strap/RNS-.lsp4
-rw-r--r--src/algebra/strap/SYMBOL.lsp4
-rw-r--r--src/interp/buildom.boot10
-rw-r--r--src/interp/compiler.boot2
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])
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-05 17:02:48 +0000