diff options
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) |