aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-04-15 21:56:20 +0000
committerdos-reis <gdr@axiomatics.org>2011-04-15 21:56:20 +0000
commit53356dde96d8bc9e264dbd291df8b9b3a75aa5d1 (patch)
tree2ff719aaa40e8978033107dbad034189c2c296ba
parent63a250a0a3b189e6e315008936aa9e53984b5ba5 (diff)
downloadopen-axiom-53356dde96d8bc9e264dbd291df8b9b3a75aa5d1.tar.gz
misc cleanup
-rw-r--r--src/boot/strap/tokens.clisp8
-rw-r--r--src/boot/tokens.boot1
-rw-r--r--src/interp/br-data.boot2
-rw-r--r--src/interp/buildom.boot4
-rw-r--r--src/interp/c-doc.boot2
-rw-r--r--src/interp/c-util.boot14
-rw-r--r--src/interp/clam.boot24
-rw-r--r--src/interp/compiler.boot2
-rw-r--r--src/interp/cparse.boot4
-rw-r--r--src/interp/define.boot2
-rw-r--r--src/interp/format.boot4
-rw-r--r--src/interp/functor.boot4
-rw-r--r--src/interp/g-cndata.boot6
-rw-r--r--src/interp/g-opt.boot2
-rw-r--r--src/interp/g-util.boot14
-rw-r--r--src/interp/i-coerce.boot10
-rw-r--r--src/interp/i-eval.boot2
-rw-r--r--src/interp/i-funsel.boot4
-rw-r--r--src/interp/i-output.boot14
-rw-r--r--src/interp/i-resolv.boot6
-rw-r--r--src/interp/i-special.boot2
-rw-r--r--src/interp/i-syscmd.boot6
-rw-r--r--src/interp/i-util.boot2
-rw-r--r--src/interp/interop.boot2
-rw-r--r--src/interp/lisp-backend.boot2
-rw-r--r--src/interp/macex.boot2
-rw-r--r--src/interp/modemap.boot2
-rw-r--r--src/interp/msgdb.boot2
-rw-r--r--src/interp/nrunfast.boot14
-rw-r--r--src/interp/packtran.boot2
-rw-r--r--src/interp/pf2sex.boot2
-rw-r--r--src/interp/posit.boot2
-rw-r--r--src/interp/ptrees.boot2
-rw-r--r--src/interp/slam.boot14
-rw-r--r--src/interp/sys-utility.boot4
-rw-r--r--src/interp/termrw.boot10
36 files changed, 101 insertions, 98 deletions
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 5eb38696..3ba257e5 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -200,8 +200,9 @@
(LIST '|alphabetic?| 'ALPHA-CHAR-P)
(LIST '|alphanumeric?| 'ALPHANUMERICP)
(LIST '|and| 'AND) (LIST '|append| 'APPEND)
- (LIST '|apply| 'APPLY) (LIST '|arrayRef| 'AREF)
- (LIST '|atom| 'ATOM) (LIST '|bitmask| 'SBIT)
+ (LIST '|apply| 'APPLY) (LIST '|array?| 'ARRAYP)
+ (LIST '|arrayRef| 'AREF) (LIST '|atom| 'ATOM)
+ (LIST '|bitmask| 'SBIT)
(LIST '|canonicalFilename| 'PROBE-FILE)
(LIST '|charByName| 'NAME-CHAR)
(LIST '|charString| 'STRING)
@@ -230,7 +231,7 @@
(LIST '|readOnly?| 'CONSTANTP)
(LIST '|removeDuplicates| 'REMDUP)
(LIST '|rest| 'CDR) (LIST '|reverse| 'REVERSE)
- (LIST '|second| 'CADR)
+ (LIST '|sameObject?| 'EQ) (LIST '|second| 'CADR)
(LIST '|setDifference| 'SETDIFFERENCE)
(LIST '|setIntersection| 'INTERSECTION)
(LIST '|setPart| 'SETELT) (LIST '|setUnion| 'UNION)
@@ -239,6 +240,7 @@
(LIST '|subSequence| 'SUBSEQ)
(LIST '|substitute| 'SUBST)
(LIST '|substitute!| 'NSUBST)
+ (LIST '|symbolEqual?| 'EQ)
(LIST '|symbolFunction| 'SYMBOL-FUNCTION)
(LIST '|symbolName| 'SYMBOL-NAME)
(LIST '|symbolValue| 'SYMBOL-VALUE)
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index 3ba54900..4b2cd544 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -291,6 +291,7 @@ for i in [ _
["removeDuplicates", "REMDUP"] , _
["rest", "CDR"] , _
["reverse", "REVERSE"] , _
+ ["sameObject?", "EQ" ] , _
["second", "CADR"] , _
["setDifference", "SETDIFFERENCE"] , _
["setIntersection", "INTERSECTION"] , _
diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot
index 8ca1a18d..7484ff44 100644
--- a/src/interp/br-data.boot
+++ b/src/interp/br-data.boot
@@ -749,7 +749,7 @@ sublisFormal(args,exp,:options) == main where
nd.rest := sublisFormal1(args,y,n)
r
IDENTP x =>
- j := or/[i for f in $formals for i in 0..n | EQ(f,x)] =>
+ j := or/[i for f in $formals for i in 0..n | sameObject?(f,x)] =>
args.j
x
x
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index d8ab5e6c..3f1db902 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -283,7 +283,7 @@ lookupInTable(op,sig,dollar,[domain,table]) ==
lookupInAddChain(op,sig,domain,dollar) or 'failed
lookupDisplay(op,sig,domain,'" !! found in NEW table!!")
slot
- NE(success,'failed) and success => success
+ success ~= 'failed and success => success
subsumptionSig and (u:= SPADCALL(op,subsumptionSig,dollar,domain.1)) => u
someMatch => lookupInAddChain(op,sig,domain,dollar)
nil
@@ -467,7 +467,7 @@ Mapping(:args) ==
vectorRef(dom,$FirstParamSlot + nargs + 2) := [function Undef, :dom]
dom
-MappingEqual(x, y, dom) == EQ(x,y)
+MappingEqual(x, y, dom) == sameObject?(x,y)
MappingPrint(x, dom) == coerceMap2E(x)
coerceMap2E(x) ==
diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot
index 206995d9..41450e08 100644
--- a/src/interp/c-doc.boot
+++ b/src/interp/c-doc.boot
@@ -268,7 +268,7 @@ escapePercent x ==
x is [y, :z] =>
y1 := escapePercent y
z1 := escapePercent z
- EQ(y, y1) and EQ(z, z1) => x
+ sameObject?(y, y1) and sameObject?(z, z1) => x
[y1, :z1]
x = "%" => "%%"
x
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 7525bdb5..08e48948 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -304,10 +304,10 @@ intersectionEnvironment(e,e') ==
ce
deltaContour([[c,:cl],:el],[[c',:cl'],:el']) ==
- not EQ(el,el') => systemError '"deltaContour" --a cop out for now
+ not sameObject?(el,el') => systemError '"deltaContour" --a cop out for now
eliminateDuplicatePropertyLists contourDifference(c,c') where
contourDifference(c,c') ==
- [first x for x in tails c while not EQ(x,c')]
+ [first x for x in tails c while not sameObject?(x,c')]
eliminateDuplicatePropertyLists contour ==
contour is [[x,:.],:contour'] =>
LASSOC(x,contour') =>
@@ -397,15 +397,15 @@ addContour(c,E is [cur,:tail]) ==
makeCommonEnvironment(e,e') ==
interE makeSameLength(e,e') where
interE [e,e'] ==
- EQ(rest e,rest e') =>
+ sameObject?(rest e,rest e') =>
[interLocalE makeSameLength(first e,first e'),:rest e]
interE [rest e,rest e']
interLocalE [le,le'] ==
- EQ(rest le,rest le') =>
+ sameObject?(rest le,rest le') =>
[interC makeSameLength(first le,first le'),:rest le]
interLocalE [rest le,rest le']
interC [c,c'] ==
- EQ(c,c') => c
+ sameObject?(c,c') => c
interC [rest c,rest c']
makeSameLength(x,y) ==
fn(x,y,#x,#y) where
@@ -953,7 +953,7 @@ sublisV(p,e) ==
atom e => (y:= ASSQ(e,p) => rest y; e)
u:= suba(p,first e)
v:= suba(p,rest e)
- EQ(first e,u) and EQ(rest e,v) => e
+ sameObject?(first e,u) and sameObject?(rest e,v) => e
[u,:v]
--% DEBUGGING PRINT ROUTINES used in breaks
@@ -1103,7 +1103,7 @@ middleEndExpand x ==
middleEndExpand MACROEXPAND_-1 x
a := middleEndExpand op
b := middleEndExpand args
- EQ(a,op) and EQ(b,args) => x
+ sameObject?(a,op) and sameObject?(b,args) => x
[a,:b]
diff --git a/src/interp/clam.boot b/src/interp/clam.boot
index 6a014d9f..cd7713f0 100644
--- a/src/interp/clam.boot
+++ b/src/interp/clam.boot
@@ -436,7 +436,7 @@ assocCache(x,cacheName,fn) ==
al:= eval cacheName
forwardPointer:= al
val:= nil
- until EQ(forwardPointer,al) repeat
+ until sameObject?(forwardPointer,al) repeat
FUNCALL(fn,CAAR forwardPointer,x) => return (val:= first forwardPointer)
backPointer:= forwardPointer
forwardPointer:= rest forwardPointer
@@ -449,9 +449,9 @@ assocCacheShift(x,cacheName,fn) == --like ASSOC except that al is circular
al:= eval cacheName
forwardPointer:= al
val:= nil
- until EQ(forwardPointer,al) repeat
+ until sameObject?(forwardPointer,al) repeat
FUNCALL(fn, first (y:=first forwardPointer),x) =>
- if not EQ(forwardPointer,al) then --shift referenced entry to front
+ if not sameObject?(forwardPointer,al) then --shift referenced entry to front
forwardPointer.first := first al
al.first := y
return (val:= y)
@@ -469,7 +469,7 @@ assocCacheShiftCount(x,al,fn) ==
forwardPointer:= al
val:= nil
minCount:= 10000 --preset minCount but not newFrontPointer here
- until EQ(forwardPointer,al) repeat
+ until sameObject?(forwardPointer,al) repeat
FUNCALL(fn, first (y:=first forwardPointer),x) =>
newFrontPointer := forwardPointer
y.rest.first := second y + 1 --increment use count
@@ -478,7 +478,7 @@ assocCacheShiftCount(x,al,fn) ==
minCount := c
newFrontPointer := forwardPointer --CAR is slot replaced on failure
forwardPointer:= rest forwardPointer
- if not EQ(newFrontPointer,al) then --shift referenced entry to front
+ if not sameObject?(newFrontPointer,al) then --shift referenced entry to front
temp:= first newFrontPointer --or entry with smallest count
newFrontPointer.first := first al
al.first := temp
@@ -506,7 +506,7 @@ clamStats() ==
numberOfEmptySlots cache==
count:= (CAAR cache ='$failed => 1; 0)
- for x in tails rest cache while NE(x,cache) repeat
+ for x in tails rest cache while not sameObject?(x,cache) repeat
if CAAR x='$failed then count:= count+1
count
@@ -624,7 +624,7 @@ lassocShift(x,l) ==
x = first first y => return (result := first y)
y:= rest y
result =>
- if not EQ(y,l) then
+ if not sameObject?(y,l) then
y.first := first l
l.first := result
rest result
@@ -636,7 +636,7 @@ lassocShiftWithFunction(x,l,fn) ==
FUNCALL(fn,x,first first y) => return (result := first y)
y:= rest y
result =>
- if not EQ(y,l) then
+ if not sameObject?(y,l) then
y.first := first l
l.first := result
rest result
@@ -645,10 +645,10 @@ lassocShiftWithFunction(x,l,fn) ==
lassocShiftQ(x,l) ==
y:= l
while cons? y repeat
- EQ(x,first first y) => return (result := first y)
+ sameObject?(x,first first y) => return (result := first y)
y:= rest y
result =>
- if not EQ(y,l) then
+ if not sameObject?(y,l) then
y.first := first l
l.first := result
rest result
@@ -657,10 +657,10 @@ lassocShiftQ(x,l) ==
-- rassocShiftQ(x,l) ==
-- y:= l
-- while cons? y repeat
--- EQ(x,rest first y) => return (result := first y)
+-- sameObject?(x,rest first y) => return (result := first y)
-- y:= rest y
-- result =>
--- if not EQ(y,l) then
+-- if not sameObject?(y,l) then
-- y.first := first l
-- l.first := result
-- first result
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index b0fc14e4..5ab85ec7 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -609,7 +609,7 @@ compFormWithModemap(form,m,e,modemap) ==
op = "elt" and f is ['XLAM,:.] and IDENTP(z := first argl) and
(c := get(z,'condition,e)) and
c is [["case",=z,c1]] and
- (c1 is [":",=(second argl),=m] or EQ(c1,second argl) ) =>
+ (c1 is [":",=(second argl),=m] or sameObject?(c1,second argl) ) =>
-- first is a full tag, as placed by getInverseEnvironment
-- second is what getSuccessEnvironment will place there
['%tail,z]
diff --git a/src/interp/cparse.boot b/src/interp/cparse.boot
index 07640279..1ae46824 100644
--- a/src/interp/cparse.boot
+++ b/src/interp/cparse.boot
@@ -379,12 +379,12 @@ npQuantified f ==
-- peek for keyword s, no advance of token stream
npEqPeek s ==
- $stok.first.first = "key" and EQ(s,$ttok)
+ $stok.first.first = "key" and sameObject?(s,$ttok)
-- test for keyword s, if found advance token stream
npEqKey s ==
- $stok.first.first = "key" and EQ(s,$ttok) and npNext()
+ $stok.first.first = "key" and sameObject?(s,$ttok) and npNext()
$npTokToNames ==
["~","#","[]","{}", "[||]","{||}"]
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 65f6fd3c..6875e76e 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1849,7 +1849,7 @@ doItIf(item is [.,p,x,y],$predl,$e) ==
item.op := '%when
item.rest := [[p',x,:x'],['%otherwise,y,:y']]
where localExtras(oldFLP) ==
- EQ(oldFLP,$functorLocalParameters) => nil
+ sameObject?(oldFLP,$functorLocalParameters) => nil
flp1:=$functorLocalParameters
oldFLP':=oldFLP
n:=0
diff --git a/src/interp/format.boot b/src/interp/format.boot
index 9f225f0c..fd82de57 100644
--- a/src/interp/format.boot
+++ b/src/interp/format.boot
@@ -288,7 +288,7 @@ dollarPercentTran x ==
x is [y,:z] =>
y1 := dollarPercentTran y
z1 := dollarPercentTran z
- EQ(y, y1) and EQ(z, z1) => x
+ sameObject?(y, y1) and sameObject?(z, z1) => x
[y1, :z1]
x is "$" or x is '"$" => "%%"
x is "T$" or x is '"T$" => "T"
@@ -476,7 +476,7 @@ formDecl2String(left,right) ==
whereBefore := $whereList
ls:= form2StringLocal left
rs:= form2StringLocal right
- NE($whereList,whereBefore) and $permitWhere => ls
+ not sameObject?($whereList,whereBefore) and $permitWhere => ls
concat(ls,'": ",rs)
formJoin1(op,u) ==
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 9f78f0c9..91db6581 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -149,7 +149,7 @@ DomainPrintSubst(item,Sublis) ==
item is [a,:b] =>
c1:= DomainPrintSubst(a,Sublis)
c2:= DomainPrintSubst(b,Sublis)
- EQ(c1,a) and EQ(c2,b) => item
+ sameObject?(c1,a) and sameObject?(c2,b) => item
[c1,:c2]
l:= ASSQ(item,Sublis)
l => rest l
@@ -355,7 +355,7 @@ sublisProp(subst,props) ==
cp
not a' => sublisProp(subst,props')
props' := sublisProp(subst,props')
- EQ(a',cp) and EQ(props',rest props) => props
+ sameObject?(a',cp) and sameObject?(props',rest props) => props
[a',:props']
setVector3(name,instantiator) ==
diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot
index 8e922224..245ef37f 100644
--- a/src/interp/g-cndata.boot
+++ b/src/interp/g-cndata.boot
@@ -58,8 +58,8 @@ getCDTEntry(info,isName) ==
not IDENTP info => NIL
(entry := HGET($lowerCaseConTb,info)) =>
[name,abb,:.] := entry
- isName and EQ(name,info) => entry
- not isName and EQ(abb,info) => entry
+ isName and sameObject?(name,info) => entry
+ not isName and sameObject?(abb,info) => entry
NIL
entry
@@ -255,7 +255,7 @@ isConstructorName op ==
nAssocQ(x,l,n) ==
repeat
if atom l then return nil
- if EQ(x,first(l).n) then return first l
+ if sameObject?(x,first(l).n) then return first l
l:= rest l
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 2d1f9151..46faf47b 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -168,7 +168,7 @@ optimizeFunctionDef(def) ==
resetTo(x,y) ==
atom y => x := y
- EQ(x,y) => x
+ sameObject?(x,y) => x
x.first := y.first
x.rest := y.rest
x
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 3859a8ca..89aceabc 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -251,7 +251,7 @@ putIntSymTab: (%Thing,%Symbol,%Form,%Env) -> %Env
addIntSymTabBinding: (%Thing,%List,%Env) -> %Env
put(x,prop,val,e) ==
- $InteractiveMode and not EQ(e,$CategoryFrame) =>
+ $InteractiveMode and not sameObject?(e,$CategoryFrame) =>
putIntSymTab(x,prop,val,e)
--e must never be $CapsuleModemapFrame
cons? x => put(first x,prop,val,e)
@@ -276,7 +276,7 @@ putIntSymTab(x,prop,val,e) ==
u := [[prop,:val]]
lp.rest := u
pl
- EQ(pl0,pl) => e
+ sameObject?(pl0,pl) => e
addIntSymTabBinding(x,pl,e)
addIntSymTabBinding(var,proplist,e is [[curContour,:.],:.]) ==
@@ -420,7 +420,7 @@ REMALIST(alist,prop) ==
deleteLassoc(x,y) ==
y is [[a,:.],:y'] =>
- EQ(x,a) => y'
+ sameObject?(x,a) => y'
[first y,:deleteLassoc(x,y')]
y
@@ -657,12 +657,12 @@ sublisNQ(al,e) ==
fn(al,e) where fn(al,e) ==
atom e =>
for x in al repeat
- EQ(first x,e) => return (e := rest x)
+ sameObject?(first x,e) => return (e := rest x)
e
- EQ(a := first e,'QUOTE) => e
+ sameObject?(a := first e,'QUOTE) => e
u := fn(al,a)
v := fn(al,rest e)
- EQ(a,u) and EQ(rest e,v) => e
+ sameObject?(a,u) and sameObject?(rest e,v) => e
[u,:v]
opOf: %Thing -> %Thing
@@ -723,7 +723,7 @@ semchkProplist(x,proplist,prop,val) ==
LASSOC("isLiteral",proplist) => warnLiteral x
addBinding(var,proplist,e is [[curContour,:tailContour],:tailEnv]) ==
- EQ(proplist,getProplist(var,e)) => e
+ sameObject?(proplist,getProplist(var,e)) => e
$InteractiveMode => addBindingInteractive(var,proplist,e)
if curContour is [[ =var,:.],:.] then curContour:= rest curContour
--Previous line should save some space
diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot
index a56ae5d1..e179fae8 100644
--- a/src/interp/i-coerce.boot
+++ b/src/interp/i-coerce.boot
@@ -109,7 +109,7 @@ retract1 object ==
type = $NonNegativeInteger => objNew(val,$Integer)
type = $Integer and SINTP unwrap val => objNew(val, $SingleInteger)
type' := equiType(type)
- if not EQ(type,type') then object := objNew(val,type')
+ if not sameObject?(type,type') then object := objNew(val,type')
(1 = #type') or (type' is ['Union,:.]) or
(type' is ['FunctionCalled,.])
or (type' is ['OrderedVariableList,.]) or (type is ['Variable,.]) =>
@@ -489,7 +489,7 @@ canCoerceTopMatching(t1,t2,tt1,tt2) ==
-- returns true, nil or maybe
-- for example, if t1 = P[x] D1 and t2 = P[y] D2 and x = y then
-- canCoerce will only be true if D1 = D2
- not EQ(tt1,tt2) => 'maybe
+ not sameObject?(tt1,tt2) => 'maybe
doms := '(Polynomial List Matrix FiniteSet Vector Stream Gaussian)
MEMQ(tt1,doms) => canCoerce(second t1, second t2)
not (MEMQ(tt1,$univariateDomains) or MEMQ(tt2,$multivariateDomains)) =>
@@ -791,9 +791,9 @@ coerceInt0(triple,t2) ==
intCodeGenCOERCE(triple,t2)
t1 = $Any and t2 ~= $OutputForm and ([t1',:val'] := unwrap val) and
(ans := coerceInt0(objNewWrap(val',t1'),t2)) => ans
- if not EQ(s1,t1) then triple := objNew(val,s1)
+ if not sameObject?(s1,t1) then triple := objNew(val,s1)
x := coerceInt(triple,s2) =>
- EQ(s2,t2) => x
+ sameObject?(s2,t2) => x
objSetMode(x,t2)
x
NIL
@@ -902,7 +902,7 @@ coerceInt1(triple,t2) ==
NIL
NIL
- EQ(first(t1),'Variable) and cons?(t2) and
+ sameObject?(first(t1),'Variable) and cons?(t2) and
(isEqualOrSubDomain(t2,$Integer) or
(t2 = [$QuotientField, $Integer]) or MEMQ(first(t2),
'(RationalNumber BigFloat NewFloat Float DoubleFloat))) => NIL
diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot
index 56e5fc33..67b076fa 100644
--- a/src/interp/i-eval.boot
+++ b/src/interp/i-eval.boot
@@ -260,7 +260,7 @@ evalForm(op,opName,argl,mmS) ==
NRTcompileEvalForm(opName,fun,dcVector)
null fun0 => throwKeyedMsg("S2IE0008",[opName])
[bpi,:domain] := fun0
- EQ(bpi,function Undef) =>
+ sameObject?(bpi,function Undef) =>
sayKeyedMsg("S2IE0009",[opName,formatSignature rest sig,first sig])
NIL
if $NRTmonitorIfTrue = true then
diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot
index b52f11b9..1ccb97c0 100644
--- a/src/interp/i-funsel.boot
+++ b/src/interp/i-funsel.boot
@@ -529,7 +529,7 @@ CONTAINEDisDomain(symbol,cond) ==
cond.op in '(AND OR and or %and %or) =>
or/[CONTAINEDisDomain(symbol, u) for u in cond.args]
cond.op = 'isDomain =>
- EQ(symbol,second cond) and cons?(dom:=third cond) and
+ sameObject?(symbol,second cond) and cons?(dom:=third cond) and
dom in '(PositiveInteger NonNegativeInteger)
false
@@ -882,7 +882,7 @@ findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) ==
maxargs := -1
impls := nil
for [a,b,d] in funlist repeat
- not EQ(a,op) => nil
+ not sameObject?(a,op) => nil
d is ['XLAM,xargs,:.] =>
if cons?(xargs) then maxargs := MAX(maxargs,#xargs)
else maxargs := MAX(maxargs,1)
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index e36eb56b..f0ec5a6b 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -1749,7 +1749,7 @@ sublisMatAlist(m,m1,u) ==
charyTrouble1(u,v,start,linelength) ==
integer? u => outputNumber(start,linelength,atom2String u)
atom u => outputString(start,linelength,atom2String u)
- EQ(x:= keyp u,'_-) => charyMinus(u,v,start,linelength)
+ sameObject?(x:= keyp u,'_-) => charyMinus(u,v,start,linelength)
x in '(_+ _* AGGLST) => charySplit(u,v,start,linelength)
x='EQUATNUM => charyEquatnum(u,v,start,linelength)
d := GETL(x,'INFIXOP) => charyBinary(d,u,v,start,linelength)
@@ -1771,14 +1771,14 @@ charyTrouble1(u,v,start,linelength) ==
concatTrouble(rest v,d,start,linelength,true)
GETL(x,'INFIXOP) => charySplit(u,v,start,linelength)
x='PAREN and
- (EQ(keyp u.1,'AGGLST) and (v:= ",") or EQ(keyp u.1,'AGGSET) and
+ (sameObject?(keyp u.1,'AGGLST) and (v:= ",") or sameObject?(keyp u.1,'AGGSET) and
(v:= ";")) => bracketagglist(rest u.1,start,linelength,v,"_(","_)")
- x='PAREN and EQ(keyp u.1,'CONCATB) =>
+ x='PAREN and sameObject?(keyp u.1,'CONCATB) =>
bracketagglist(rest u.1,start,linelength," ","_(","_)")
- x='BRACKET and (EQ(keyp u.1,'AGGLST) and (v:= ",")) =>
+ x='BRACKET and (sameObject?(keyp u.1,'AGGLST) and (v:= ",")) =>
bracketagglist(rest u.1,start,linelength,v,
specialChar 'lbrk, specialChar 'rbrk)
- x='BRACE and (EQ(keyp u.1,'AGGLST) and (v:= ",")) =>
+ x='BRACE and (sameObject?(keyp u.1,'AGGLST) and (v:= ",")) =>
bracketagglist(rest u.1,start,linelength,v,
specialChar 'lbrc, specialChar 'rbrc)
x='EXT => longext(u,start,linelength)
@@ -1988,7 +1988,7 @@ apphor(x1,x2,y,d,char) ==
syminusp x ==
integer? x => MINUSP x
- cons? x and EQ(keyp x,'_-)
+ cons? x and sameObject?(keyp x,'_-)
appsum(u, x, y, d) ==
null u => d
@@ -2347,7 +2347,7 @@ bracketagglist(u, start, linelength, tchr, open, close) ==
null rest x => return(s := -1)
nil or
s = -1 => (nextu := nil)
- EQ(lastx, u) => ((nextu := rest u); u.rest := nil)
+ sameObject?(lastx, u) => ((nextu := rest u); u.rest := nil)
true => ((nextu := lastx); PREDECESSOR(lastx, u).rest := nil)
for x in tails u repeat
x.first := ['CONCAT, first x, tchr]
diff --git a/src/interp/i-resolv.boot b/src/interp/i-resolv.boot
index e76456b5..dd974b3e 100644
--- a/src/interp/i-resolv.boot
+++ b/src/interp/i-resolv.boot
@@ -305,8 +305,8 @@ resolveTTRed(t1,t2) ==
resolveTTRed1(t1,t2,TL) ==
-- tries to apply a reduction rule on (Resolve t1 t2)
-- then it creates a type using the result and TL
- EQ(t,term1RW(t := ['Resolve,t1,t2],$Res)) and
- EQ(t,term1RW(t := ['Resolve,t2,t1],$Res)) => NIL
+ sameObject?(t,term1RW(t := ['Resolve,t1,t2],$Res)) and
+ sameObject?(t,term1RW(t := ['Resolve,t2,t1],$Res)) => NIL
[c2,:arg2] := deconstructT t2
[c2,arg2,:TL] := bubbleType [c2,arg2,:TL]
t2 := constructM(c2,arg2)
@@ -664,7 +664,7 @@ resolveTMRed(t,m) ==
TL := NIL
until b or not t repeat
[ct,:argt] := deconstructT t
- b := not EQ(t,term1RW(['Resolve,t,m],$ResMode)) and
+ b := not sameObject?(t,term1RW(['Resolve,t,m],$ResMode)) and
[c0,arg0,:TL0] := bubbleType [ct,argt,:TL]
null TL0 and
l := term1RWall(['Resolve,constructM(c0,arg0),m],$ResMode)
diff --git a/src/interp/i-special.boot b/src/interp/i-special.boot
index 03238888..8e029a45 100644
--- a/src/interp/i-special.boot
+++ b/src/interp/i-special.boot
@@ -2104,7 +2104,7 @@ NRTtypeHack t ==
NRTgetMinivectorIndex(u,op,sig,domVector) ==
s := # $minivector
k := or/[k for k in 0..(s-1)
- for x in $minivector | EQ(x,u)] => k
+ for x in $minivector | sameObject?(x,u)] => k
$minivector := [:$minivector,u]
s
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index 527dc5ae..378d8059 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -2074,8 +2074,8 @@ writify ob ==
THROW('writifyTag, 'writifyFailed)
-- Default case: return the object itself.
string? ob =>
- EQ(ob, $NullStream) => ['WRITIFIED_!_!, 'NULLSTREAM]
- EQ(ob, $NonNullStream) => ['WRITIFIED_!_!, 'NONNULLSTREAM]
+ sameObject?(ob, $NullStream) => ['WRITIFIED_!_!, 'NULLSTREAM]
+ sameObject?(ob, $NonNullStream) => ['WRITIFIED_!_!, 'NONNULLSTREAM]
ob
FLOATP ob =>
ob = READ_-FROM_-STRING STRINGIMAGE ob => ob
@@ -2644,7 +2644,7 @@ diffAlist(new,old) ==
for (propval := [prop,:val]) in proplist repeat
null (oldPropval := assoc(prop,oldProplist)) => --missing property
deltas := [[prop],:deltas]
- EQ(rest oldPropval,val) => 'skip
+ sameObject?(rest oldPropval,val) => 'skip
deltas := [oldPropval,:deltas]
deltas => acc := [[name,:nreverse deltas],:acc]
acc := [[name,:[[prop] for [prop,:.] in proplist]],:acc]
diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot
index f9839d55..3204a731 100644
--- a/src/interp/i-util.boot
+++ b/src/interp/i-util.boot
@@ -130,7 +130,7 @@ Undef(:u) ==
u':= last u
[[domain,slot],op,sig]:= u'
domain':=eval mkEvalable domain
- not EQ(first domain'.slot, function Undef) =>
+ not sameObject?(first domain'.slot, function Undef) =>
-- OK - thefunction is now defined
[:u'',.]:=u
if $reportBottomUpFlag then
diff --git a/src/interp/interop.boot b/src/interp/interop.boot
index 90049e8e..eb6e14bd 100644
--- a/src/interp/interop.boot
+++ b/src/interp/interop.boot
@@ -501,7 +501,7 @@ hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
cons? slot =>
slot.op = 'newGoGet => someMatch:=true
--treat as if operation were not there
- --if EQ(QCAR slot,'newGoGet) then
+ --if sameObject?(QCAR slot,'newGoGet) then
-- UNWIND_-PROTECT --break infinite recursion
-- ((SETELT(domain,loc,'skip); slot := replaceGoGetSlot rest slot),
-- if domain.loc = 'skip then domain.loc := slot)
diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot
index b5c47b39..eee7acd5 100644
--- a/src/interp/lisp-backend.boot
+++ b/src/interp/lisp-backend.boot
@@ -690,7 +690,7 @@ expandToVMForm x ==
IDENTP op and (fun:= getOpcodeExpander op) => apply(fun,x,nil)
op' := expandToVMForm op
args' := expandToVMForm args
- EQ(op,op') and EQ(args,args') => x
+ sameObject?(op,op') and sameObject?(args,args') => x
[op',:args']
diff --git a/src/interp/macex.boot b/src/interp/macex.boot
index 6a0c727e..2e8c764d 100644
--- a/src/interp/macex.boot
+++ b/src/interp/macex.boot
@@ -130,7 +130,7 @@ mac0GetName body ==
for [sy,st,bd] in $pfMacros while not name repeat
if st = 'mlambda then
bd := pfMLambdaBody bd
- EQ(bd, body) => name := [sy,st]
+ sameObject?(bd, body) => name := [sy,st]
name
macId pf ==
diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot
index fcf08109..c6f6f50c 100644
--- a/src/interp/modemap.boot
+++ b/src/interp/modemap.boot
@@ -191,7 +191,7 @@ mergeModemap(entry is [[mc,:sig],[pred,:.],:.],modemapList,e) ==
mc=mc' or isSubset(mc,mc',e) =>
newmm:= nil
mm:= modemapList
- while (not EQ(mm,mmtail)) repeat (newmm:= [first mm,:newmm]; mm:= rest mm)
+ while (not sameObject?(mm,mmtail)) repeat (newmm:= [first mm,:newmm]; mm:= rest mm)
if (mc=mc') and (sig=sig') then
--We only need one of these, unless the conditions are hairy
not $forceAdd and TruthP pred' =>
diff --git a/src/interp/msgdb.boot b/src/interp/msgdb.boot
index fde20a6e..8c12fa01 100644
--- a/src/interp/msgdb.boot
+++ b/src/interp/msgdb.boot
@@ -137,7 +137,7 @@ segmentedMsgPreprocess x ==
[head1,:segmentedMsgPreprocess tail]
head1 := segmentedMsgPreprocess head
tail1 := segmentedMsgPreprocess tail
- EQ(head,head1) and EQ(tail,tail1) => x
+ sameObject?(head,head1) and sameObject?(tail,tail1) => x
[head1,:tail1]
removeAttributes msg ==
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 834c6365..e74132fb 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -84,7 +84,7 @@ getOpCode(op,vec,max) ==
--search Op vector for "op" returning code if found, nil otherwise
res := nil
for i in 0..max by 2 repeat
- EQ(vectorRef(vec,i),op) => return (res := i + 1)
+ sameObject?(vectorRef(vec,i),op) => return (res := i + 1)
res
evalSlotDomain(u,dollar) ==
@@ -204,7 +204,7 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
i := start
numArgs ~= (numTableArgs :=numvec.i) => nil
predIndex := numvec.(i := i + 1)
- NE(predIndex,0) and not testBitVector(predvec,predIndex) => nil
+ predIndex ~= 0 and not testBitVector(predvec,predIndex) => nil
loc := newCompareSig(sig,numvec,(i := i + 1),dollar,domain)
null loc => nil --signifies no match
loc = 1 => (someMatch := true)
@@ -223,7 +223,7 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
cons? slot =>
slot.op = 'newGoGet => someMatch:=true
--treat as if operation were not there
- --if EQ(QCAR slot,'newGoGet) then
+ --if sameObject?(QCAR slot,'newGoGet) then
-- UNWIND_-PROTECT --break infinite recursion
-- ((SETELT(domain,loc,'skip); slot := replaceGoGetSlot rest slot),
-- if domain.loc = 'skip then domain.loc := slot)
@@ -232,7 +232,7 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
return (success := newLookupInAddChain(op,sig,domain,dollar))
systemError '"unexpected format"
start := QSPLUS(start,QSPLUS(numTableArgs,4))
- NE(success,'failed) and success =>
+ success ~= 'failed and success =>
if $monitorNewWorld then
sayLooking1('"<----",uu) where uu() ==
cons? success => [first success,:devaluate rest success]
@@ -393,7 +393,7 @@ newLookupInCategories1(op,sig,dom,dollar) ==
nsig := MSUBST(dom.0,dollar.0,sig)
for i in 0..MAXINDEX packageVec | (entry := packageVec.i)
and (vector? entry or (predIndex := rest (node := catVec.i)) and
- (EQ(predIndex,0) or testBitVector(predvec,predIndex))) repeat
+ (predIndex = 0 or testBitVector(predvec,predIndex))) repeat
package :=
vector? entry =>
if $monitorNewWorld then
@@ -558,11 +558,11 @@ lookupInDomainByName(op,domain,arg) ==
i := start
numberOfArgs :=numvec.i
predIndex := numvec.(i := i + 1)
- NE(predIndex,0) and not testBitVector(predvec,predIndex) => nil
+ predIndex ~= 0 and not testBitVector(predvec,predIndex) => nil
slotIndex := numvec.(i + 2 + numberOfArgs)
newStart := QSPLUS(start,QSPLUS(numberOfArgs,4))
slot := domain.slotIndex
- cons? slot and EQ(first slot,first arg) and EQ(rest slot,rest arg) => return (success := true)
+ cons? slot and sameObject?(first slot,first arg) and sameObject?(rest slot,rest arg) => return (success := true)
start := QSPLUS(start,QSPLUS(numberOfArgs,4))
success
diff --git a/src/interp/packtran.boot b/src/interp/packtran.boot
index d8ef9d69..4b005cb8 100644
--- a/src/interp/packtran.boot
+++ b/src/interp/packtran.boot
@@ -43,7 +43,7 @@ packageTran sex ==
-- destructively translate all the symbols in the given s-expression to the
-- current package
symbol? sex =>
- EQ(_*PACKAGE_*, SYMBOL_-PACKAGE sex) => sex
+ sameObject?(_*PACKAGE_*, SYMBOL_-PACKAGE sex) => sex
makeSymbol symbolName sex
cons? sex =>
sex.first := packageTran first sex
diff --git a/src/interp/pf2sex.boot b/src/interp/pf2sex.boot
index 1faf14fa..acc5275a 100644
--- a/src/interp/pf2sex.boot
+++ b/src/interp/pf2sex.boot
@@ -200,7 +200,7 @@ pfLiteral2Sex pf ==
["QUOTE", pfLeafToken pf]
keyedSystemError('"S2GE0017", ['"pfLiteral2Sex: unexpected form"])
-symEqual(sym, sym2) == EQ(sym, sym2)
+symEqual(sym, sym2) == sameObject?(sym, sym2)
SymMemQ(sy, l) == MEMQ(sy, l)
diff --git a/src/interp/posit.boot b/src/interp/posit.boot
index b5582f78..114916ee 100644
--- a/src/interp/posit.boot
+++ b/src/interp/posit.boot
@@ -138,7 +138,7 @@ pfAbSynOp form ==
pfAbSynOp?(form, op) ==
hd := first form
- EQ(hd, op) or hd is [=op,:.]
+ sameObject?(hd, op) or hd is [=op,:.]
pfLeaf? form ==
pfAbSynOp form in
diff --git a/src/interp/ptrees.boot b/src/interp/ptrees.boot
index 7549f80d..cbd4ac4f 100644
--- a/src/interp/ptrees.boot
+++ b/src/interp/ptrees.boot
@@ -783,7 +783,7 @@ pfMapParts(f, pform) ==
parts1 := [FUNCALL(f, p) for p in parts0]
-- Return the original if no changes.
same := true
- for p0 in parts0 for p1 in parts1 while same repeat same := EQ(p0,p1)
+ for p0 in parts0 for p1 in parts1 while same repeat same := sameObject?(p0,p1)
same => pform
pfTree(pfAbSynOp pform, parts1)
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index 45cf192e..545c7b4d 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -62,7 +62,7 @@ isRecurrenceRelation(op,body,minivectorName) ==
for [p,c] in pcl repeat
p is ['SPADCALL,sharpVar,n1,
["ELT",["%dynval",=MKQ minivectorName],slot]]
- and EQ(iequalSlot,$minivector.slot) =>
+ and sameObject?(iequalSlot,$minivector.slot) =>
initList:= [[n1,:c],:initList]
sharpList := insert(sharpVar,sharpList)
n:=n1
@@ -89,15 +89,15 @@ isRecurrenceRelation(op,body,minivectorName) ==
generalPred = '%true => true
generalPred is ['SPADCALL,m,=sharpArg,
["ELT",["%dynval",=MKQ minivectorName],slot]]
- and EQ(lesspSlot,$minivector.slot)=> m+1
+ and sameObject?(lesspSlot,$minivector.slot)=> m+1
generalPred is ['SPADCALL,['SPADCALL,=sharpArg,m,
["ELT",["%dynval",=MKQ minivectorName],slot]],
["ELT",["%dynval",=MKQ minivectorName],notSlot]]
- and EQ(lesspSlot,$minivector.slot)
- and EQ(notpSlot,$minivector.notSlot) => m
+ and sameObject?(lesspSlot,$minivector.slot)
+ and sameObject?(notpSlot,$minivector.notSlot) => m
generalPred is ['NOT,['SPADCALL,=sharpArg,m,
["ELT",["%dynval",=MKQ minivectorName], =lesspSlot]]]
- and EQ(lesspSlot,$minivector.slot) => m
+ and sameObject?(lesspSlot,$minivector.slot) => m
return nil
integer? predOk and predOk ~= n =>
sayKeyedMsg("S2IX0006",[n,m])
@@ -105,7 +105,7 @@ isRecurrenceRelation(op,body,minivectorName) ==
--Check general term for references to just the k previous values
diffCell:=compiledLookupCheck("-",'($ $ $),integer)
- diffSlot := or/[i for i in 0.. for x in $minivector | EQ(x,diffCell)]
+ diffSlot := or/[i for i in 0.. for x in $minivector | sameObject?(x,diffCell)]
or return nil
--Check general term for references to just the k previous values
sharpPosition := readInteger subString(sharpArg,1)
@@ -253,7 +253,7 @@ predCircular(al,n) ==
assocCircular(x,al) == --like ASSOC except that al is circular
forwardPointer:= al
val:= nil
- until EQ(forwardPointer,al) repeat
+ until sameObject?(forwardPointer,al) repeat
CAAR forwardPointer = x => return (val:= first forwardPointer)
forwardPointer:= rest forwardPointer
val
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index db742d49..d6b0d6ed 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -289,9 +289,9 @@ minimalise x ==
y => y
cons? x =>
z := min(first x,ht)
- if not EQ(z,first x) then x.first := z
+ if not sameObject?(z,first x) then x.first := z
z := min(rest x,ht)
- if not EQ(z,rest x) then x.rest := z
+ if not sameObject?(z,rest x) then x.rest := z
hashCheck(x,ht)
vector? x =>
for i in 0..MAXINDEX x repeat
diff --git a/src/interp/termrw.boot b/src/interp/termrw.boot
index 243812b7..d4f3f0a0 100644
--- a/src/interp/termrw.boot
+++ b/src/interp/termrw.boot
@@ -38,18 +38,18 @@ termRW(t,R) ==
-- reduce t by rewrite system R
until b repeat
t0:= termRW1(t,R)
- b:= EQ(t,t0)
+ b:= sameObject?(t,t0)
t:= t0
t
termRW1(t,R) ==
-- tries to do one reduction on the leftmost outermost subterm of t
t0:= term1RW(t,R)
- not EQ(t0,t) or atom t => t0
+ not sameObject?(t0,t) or atom t => t0
[t1,:t2]:= t
tt1:= termRW1(t1,R)
tt2:= t2 and termRW1(t2,R)
- EQ(t1,tt1) and EQ(t2,tt2) => t
+ sameObject?(t1,tt1) and sameObject?(t2,tt2) => t
[tt1,:tt2]
term1RW(t,R) ==
@@ -65,7 +65,7 @@ term1RWall(t,R) ==
-- same as term1RW, but returns a list
[vars,:varRules]:= R
[not (SL='failed) and subCopy(copy rest r,SL) for r in varRules |
- not EQ(SL:= termMatch(first r,t,NIL,vars),'failed)]
+ not sameObject?(SL:= termMatch(first r,t,NIL,vars),'failed)]
termMatch(tp,t,SL,vars) ==
-- t is a term pattern, t a term
@@ -91,7 +91,7 @@ termMatch(tp,t,SL,vars) ==
-- isContained(v,t) ==
-- -- tests (by EQ), whether v occurs in term t
-- -- v must not be NIL
--- EQ(v,t) => 'T
+-- sameObject?(v,t) => 'T
-- atom t => NIL
-- isContained(v,first t) or isContained(v,rest t)