diff options
| -rw-r--r-- | src/boot/ast.boot | 6 | ||||
| -rw-r--r-- | src/boot/parser.boot | 6 | ||||
| -rw-r--r-- | src/boot/tokens.boot | 3 | ||||
| -rw-r--r-- | src/interp/buildom.boot | 2 | ||||
| -rw-r--r-- | src/interp/hashcode.boot | 2 | ||||
| -rw-r--r-- | src/interp/i-output.boot | 2 | ||||
| -rw-r--r-- | src/interp/interop.boot | 24 | ||||
| -rw-r--r-- | src/interp/sys-utility.boot | 10 |
8 files changed, 29 insertions, 26 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 3dce3667..3c921466 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -485,7 +485,7 @@ bfSUBLIS(p,e)== bfSUBLIS1(p,e)== p = nil => e f := first p - EQ(first f,e) => bfSUBLIS(p, rest f) + sameObject?(first f,e) => bfSUBLIS(p, rest f) bfSUBLIS1(rest p,e) defSheepAndGoats(x)== @@ -540,7 +540,7 @@ bfLET1(lhs,rhs) == bfMKPROGN [rhs1,:let1,g] bfCONTAINED(x,y)== - EQ(x,y) => true + sameObject?(x,y) => true atom y=> false bfCONTAINED(x,first y) or bfCONTAINED(x,rest y) @@ -1146,7 +1146,7 @@ bfCase(x,y)== atom x => x bfGenSymbol() body := ["CASE",["CAR", g], :bfCaseItems(g,y)] - EQ(g,x) => body + sameObject?(g,x) => body ["LET",[[g,x]],body] bfCaseItems: (%Thing,%List) -> %List diff --git a/src/boot/parser.boot b/src/boot/parser.boot index 03c2f639..cfa034d8 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -240,13 +240,13 @@ bpBacksetElse()== bpEqKey "ELSE" bpEqPeek s == - $stok is ["KEY",:.] and EQ(s,$ttok) + $stok is ["KEY",:.] and sameObject?(s,$ttok) bpEqKey s == - $stok is ["KEY",:.] and EQ(s,$ttok) and bpNext() + $stok is ["KEY",:.] and sameObject?(s,$ttok) and bpNext() bpEqKeyNextTok s == - $stok is ["KEY",:.] and EQ(s,$ttok) and bpNextToken() + $stok is ["KEY",:.] and sameObject?(s,$ttok) and bpNextToken() bpPileTrap() == bpMissing "BACKTAB" bpBrackTrap(x) == bpMissingMate("]",x) diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index 4b2cd544..c4cf1664 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -262,8 +262,10 @@ for i in [ _ ["exit", "EXIT"] , _ ["false", 'NIL] , _ ["first", "CAR"] , _ + ["float?", "FLOATP"] , _ ["fourth", "CADDDR"] , _ ["function","FUNCTION"] , _ + ["function?","FUNCTIONP"] , _ ["gensym", "GENSYM"] , _ ["genvar", "GENVAR"] , _ ["integer?","INTEGERP"] , _ @@ -292,6 +294,7 @@ for i in [ _ ["rest", "CDR"] , _ ["reverse", "REVERSE"] , _ ["sameObject?", "EQ" ] , _ + ["scalarEqual?","EQL" ] , _ ["second", "CADR"] , _ ["setDifference", "SETDIFFERENCE"] , _ ["setIntersection", "INTERSECTION"] , _ diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index 3f1db902..a9c89ca5 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -472,7 +472,7 @@ MappingPrint(x, dom) == coerceMap2E(x) coerceMap2E(x) == -- nrlib domain - ARRAYP rest x => ["theMap", BPINAME first x, + array? rest x => ["theMap", BPINAME first x, if $testingSystem then 0 else HASHEQ(rest x) rem 1000] -- aldor ["theMap", BPINAME first x ] diff --git a/src/interp/hashcode.boot b/src/interp/hashcode.boot index 414ad5fa..70ce9e6d 100644 --- a/src/interp/hashcode.boot +++ b/src/interp/hashcode.boot @@ -63,7 +63,7 @@ hashType(type, percentHash) == for arg in mapArgs repeat hash := hashCombine(hashType(arg, percentHash), hash) retCode := hashType(retType, percentHash) - EQL(retCode, $VoidHash) => hash + scalarEqual?(retCode, $VoidHash) => hash hashCombine(retCode, hash) op = 'Enumeration => for arg in args repeat diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index f0ec5a6b..6416f7ef 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -1583,7 +1583,7 @@ output(expr,domain) == mathprintWithNumber(x,domain) if $texFormat then texFormat x if $mathmlFormat then mathmlFormat x - (FUNCTIONP(opOf domain)) and + (function?(opOf domain)) and (printfun := compiledLookup("<<",'(TextWriter TextWriter $), evalDomain domain)) and (textwrit := compiledLookup("print", '($), TextWriter())) => sayMSGNT [:bright '"AXIOM-XL",'"output: "] diff --git a/src/interp/interop.boot b/src/interp/interop.boot index eb6e14bd..b700041d 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -200,7 +200,7 @@ quoteCatOp cat == oldAxiomCategoryLookupExport(catenv, self, op, sig, box, env) == [catform,hash, pack,:.] := catenv - opIsHasCat op => if EQL(sig, hash) then [self] else nil + opIsHasCat op => if scalarEqual?(sig, hash) then [self] else nil null(pack) => nil if not vector? pack then pack:=apply(pack, [self, :rest catform]) @@ -236,7 +236,7 @@ attributeDevaluate(attrObj, env) == attributeLookupExport(attrObj, self, op, sig, box, env) == [name, hash] := attrObj - opIsHasCat op => if EQL(hash, sig) then [self] else nil + opIsHasCat op => if scalarEqual?(hash, sig) then [self] else nil attributeHashCode(attrObj, env) == [name, hash] := attrObj @@ -363,13 +363,13 @@ oldAxiomDomainLookupExport _ (domenv, self, op, sig, box, skipdefaults, env) == domainVec := rest domenv if hashCode? op then - EQL(op, $hashOp1) => op := 'One - EQL(op, $hashOp0) => op := 'Zero - EQL(op, $hashOpApply) => op := 'elt - EQL(op, $hashOpSet) => op := 'setelt - EQL(op, $hashSeg) => op := 'SEGMENT + scalarEqual?(op, $hashOp1) => op := 'One + scalarEqual?(op, $hashOp0) => op := 'Zero + scalarEqual?(op, $hashOpApply) => op := 'elt + scalarEqual?(op, $hashOpSet) => op := 'setelt + scalarEqual?(op, $hashSeg) => op := 'SEGMENT constant := nil - if hashCode? sig and self and EQL(sig, getDomainHash self) then + if hashCode? sig and self and scalarEqual?(sig, getDomainHash self) then sig := '($) constant := true val := @@ -419,7 +419,7 @@ basicLookupCheckDefaults(op,sig,domain,dollar) == $hasCatOpHash := hashString '"%%" opIsHasCat op == - hashCode? op => EQL(op, $hasCatOpHash) + hashCode? op => scalarEqual?(op, $hasCatOpHash) op = "%%" -- has cat questions lookup up twice if false @@ -440,12 +440,12 @@ oldCompLookupNoDefaults(op, sig, domvec, dollar) == hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) == opIsHasCat op => HasCategory(domain, sig) - if hashCode? op and EQL(op, $hashOp1) then op := 'One - if hashCode? op and EQL(op, $hashOp0) then op := 'Zero + if hashCode? op and scalarEqual?(op, $hashOp1) then op := 'One + if hashCode? op and scalarEqual?(op, $hashOp0) then op := 'Zero hashPercent := vector? dollar => hashType(dollar.0,0) hashType(dollar,0) - if hashCode? sig and EQL(sig, hashPercent) then + if hashCode? sig and scalarEqual?(sig, hashPercent) then sig := hashType('(Mapping $), hashPercent) dollar = nil => systemError() $lookupDefaults = true => diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index d6b0d6ed..9bff9b41 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -114,14 +114,14 @@ macrop f == functionp: %Thing -> %Boolean functionp f == IDENTP f => FBOUNDP f and null MACRO_-FUNCTION f - FUNCTIONP f + function? f ++ remove `item' from `sequence'. delete: (%Thing,%Sequence) -> %Sequence delete(item,sequence) == symbol? item => - REMOVE(item,sequence,KEYWORD::TEST,function EQ) - atom item and not ARRAYP item => + REMOVE(item,sequence,KEYWORD::TEST,function sameObject?) + atom item and not array? item => REMOVE(item,sequence) REMOVE(item,sequence,KEYWORD::TEST,function EQUALP) @@ -274,8 +274,8 @@ PRINT_-AND_-EVAL_-DEFUN(name,body) == hashTable cmp == testFun := - cmp in '(ID EQ) => function EQ - cmp = 'EQL => function EQL + cmp in '(ID EQ) => function sameObject? + cmp = 'EQL => function scalarEqual? cmp = 'EQUAL => function EQUAL error '"bad arg to hashTable" MAKE_-HASH_-TABLE(KEYWORD::TEST,testFun) |