diff options
author | dos-reis <gdr@axiomatics.org> | 2011-04-19 16:12:17 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-04-19 16:12:17 +0000 |
commit | 9430f000bbcedcd6f0edbe1c4852cb2b51c50ccc (patch) | |
tree | 97ad3fbf69b7c15f20c2dbef3f2a11860ec6fd0b /src/interp | |
parent | b893a938b4051bc30a9c44bdcf6000bff11969c4 (diff) | |
download | open-axiom-9430f000bbcedcd6f0edbe1c4852cb2b51c50ccc.tar.gz |
* boot/tokens.boot: charUpcase, charDowncase, stringUpcase,
singDowncase, valueEq? are new builtin functions.
* boot/ast.boot (bfMembr): Tidy.
Diffstat (limited to 'src/interp')
-rw-r--r-- | src/interp/as.boot | 4 | ||||
-rw-r--r-- | src/interp/br-data.boot | 2 | ||||
-rw-r--r-- | src/interp/br-search.boot | 2 | ||||
-rw-r--r-- | src/interp/br-util.boot | 2 | ||||
-rw-r--r-- | src/interp/category.boot | 6 | ||||
-rw-r--r-- | src/interp/g-cndata.boot | 2 | ||||
-rw-r--r-- | src/interp/guess.boot | 6 | ||||
-rw-r--r-- | src/interp/hashcode.boot | 2 | ||||
-rw-r--r-- | src/interp/i-syscmd.boot | 2 | ||||
-rw-r--r-- | src/interp/interop.boot | 24 | ||||
-rw-r--r-- | src/interp/newfort.boot | 2 | ||||
-rw-r--r-- | src/interp/pathname.boot | 2 | ||||
-rw-r--r-- | src/interp/sys-utility.boot | 4 | ||||
-rw-r--r-- | src/interp/word.boot | 5 |
14 files changed, 33 insertions, 32 deletions
diff --git a/src/interp/as.boot b/src/interp/as.boot index 8b5b240c..cef308e2 100644 --- a/src/interp/as.boot +++ b/src/interp/as.boot @@ -701,12 +701,12 @@ asyAbbreviation(id,n) == chk(id,main) where --> n = number of arguments main() == a := createAbbreviation id => a name := PNAME id --- #name < 8 => makeSymbol UPCASE name +-- #name < 8 => makeSymbol stringUpcase name parts := asySplit(name,maxIndex name) newname := strconc/[asyShorten x for x in parts] #newname < 8 => makeSymbol newname tryname := subString(name,0,7) - not createAbbreviation tryname => makeSymbol UPCASE tryname + not createAbbreviation tryname => makeSymbol stringUpcase tryname nil chk(conname,abb) == (xx := asyGetAbbrevFromComments conname) => xx diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index 7292c350..e6a330b6 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -244,7 +244,7 @@ dbAugmentConstructorDataTable() == dbHasExamplePage conname == sname := STRINGIMAGE conname abb := getConstructorAbbreviationFromDB conname - ucname := UPCASE STRINGIMAGE abb + ucname := stringUpcase STRINGIMAGE abb pathname :=strconc(systemRootDirectory(),'"/share/hypertex/pages/",ucname,'".ht") isExistingFile pathname => makeSymbol strconc(sname,'"XmpPage") nil diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index 7bb7323a..df0a920f 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -244,7 +244,7 @@ mkUpDownPattern s == recurse(s,0,#s) where strconc(fixchar(s.i),recurse(s,i + 1,n)) fixchar(c) == alphabetic? c => - strconc('"[",CHAR_-UPCASE c,CHAR_-DOWNCASE c,'"]") + strconc('"[",charUpdate c,charDowncase c,'"]") c mkGrepPattern(s,key) == diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot index 6b24f2f0..52ec5376 100644 --- a/src/interp/br-util.boot +++ b/src/interp/br-util.boot @@ -106,7 +106,7 @@ capitalize s == ("default package" . "Default Package"))) or res := COPY_-SEQ s - stringChar(res,0) := UPCASE stringChar(res,0) + stringChar(res,0) := charUpcase stringChar(res,0) res escapeSpecialIds u == --very expensive function diff --git a/src/interp/category.boot b/src/interp/category.boot index 46f0b7ea..cf18d703 100644 --- a/src/interp/category.boot +++ b/src/interp/category.boot @@ -164,7 +164,7 @@ SigListUnion(extra,original) == -- The PI map is therefore gives an implementation of "Subsumed" for x in SigListOpSubsume(o,extra) repeat [[xfn,xsig,:.],xpred,:.] := x - symbolEqual?(xfn,ofn) and xsig = osig => + symbolEq?(xfn,ofn) and xsig = osig => --checking name and signature, but not a 'constant' marker xpred = opred => extra:= delete(x,extra) --same signature and same predicate @@ -298,7 +298,7 @@ SigListOpSubsume([[name1,sig1,:.],:.],list) == --if it does, returns the subsumed member lsig1 := #sig1 ans := [] - for (n:=[[name2,sig2,:.],:.]) in list | symbolEqual?(name1,name2) repeat + for (n:=[[name2,sig2,:.],:.]) in list | symbolEq?(name1,name2) repeat lsig1 = #sig2 and sig1 = sig2 => ans := [n,:ans] return ans @@ -306,7 +306,7 @@ MachineLevelSubsume([name1,[out1,:in1],:flag1],[name2,[out2,:in2],:flag2]) == -- Checks for machine-level subsumption in the sense of SYSTEM SCRIPT -- true if the first signature subsumes the second -- flag1 = flag2 and: this really should be checked, but - symbolEqual?(name1,name2) and MachineLevelSubset(out1,out2) and + symbolEq?(name1,name2) and MachineLevelSubset(out1,out2) and (and/[MachineLevelSubset(inarg2,inarg1) for inarg1 in in1 for inarg2 in in2] ) diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot index 60620e81..96060aef 100644 --- a/src/interp/g-cndata.boot +++ b/src/interp/g-cndata.boot @@ -134,7 +134,7 @@ constructorAbbreviationErrorCheck(c,a,typ,errmess) == if typ = "category" and siz > 7 then throwKeyedErrorMsg('precompilation,"S2IL0021",NIL) if siz > 8 then throwKeyedErrorMsg('precompilation,"S2IL0006",NIL) - if s ~= UPCASE s then throwKeyedMsg("S2IL0006",NIL) + if s ~= stringUpcase s then throwKeyedMsg("S2IL0006",NIL) abb := getConstructorAbbreviationFromDB c name:= getConstructorFullNameFromDB a type := getConstructorKindFromDB c diff --git a/src/interp/guess.boot b/src/interp/guess.boot index f5f64ca1..c3bbc571 100644 --- a/src/interp/guess.boot +++ b/src/interp/guess.boot @@ -45,7 +45,7 @@ buildWordTable u == table:= hashTable 'EQ for s in u repeat words := wordsOfString s - key := UPCASE stringChar(s,0) + key := charUpcase stringChar(s,0) HPUT(table,key,[[s,:words],:HGET(table,key)]) for key in HKEYS table repeat HPUT(table,key, @@ -64,7 +64,7 @@ removeDupOrderedAlist u == (y := rest x) and first first x = first first y => x.rest := rest y u -wordsOfString(s) == [UPCASE x for x in wordsOfStringKeepCase s] +wordsOfString(s) == [stringUpcase x for x in wordsOfStringKeepCase s] wordsOfStringKeepCase s == wordsOfString1(s,0) or [COPY s] @@ -83,7 +83,7 @@ wordsOfString1(s,j) == nil wordKeys s == - removeDuplicates [UPCASE stringChar(s,0),:fn(s,1,-1,maxIndex s,nil)] where fn(s,i,lastKeyIndex,n,acc) == + removeDuplicates [charUpcase stringChar(s,0),:fn(s,1,-1,maxIndex s,nil)] where fn(s,i,lastKeyIndex,n,acc) == i > n => acc upperCase? stringChar(s,i) => -- i = lastKeyIndex + 1 => fn(s,i + 1,i,n,[s.i,:rest acc]) diff --git a/src/interp/hashcode.boot b/src/interp/hashcode.boot index 70ce9e6d..915fdae0 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) - scalarEqual?(retCode, $VoidHash) => hash + scalarEq?(retCode, $VoidHash) => hash hashCombine(retCode, hash) op = 'Enumeration => for arg in args repeat diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index 86c3bb67..4c6b618b 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -2310,7 +2310,7 @@ readSpad2Cmd l == throwKeyedMsg("S2IL0003",[namestring l]) ll := pathname ll ft := pathnameType ll - upft := UPCASE ft + upft := stringUpcase ft null member(upft,fileTypes) => fs := namestring l member(upft,devFTs) => throwKeyedMsg("S2IZ0033",[fs]) diff --git a/src/interp/interop.boot b/src/interp/interop.boot index 0fd5a1db..c2bfc566 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 scalarEqual?(sig, hash) then [self] else nil + opIsHasCat op => if scalarEq?(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 scalarEqual?(hash, sig) then [self] else nil + opIsHasCat op => if scalarEq?(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 - 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 + scalarEq?(op, $hashOp1) => op := 'One + scalarEq?(op, $hashOp0) => op := 'Zero + scalarEq?(op, $hashOpApply) => op := 'elt + scalarEq?(op, $hashOpSet) => op := 'setelt + scalarEq?(op, $hashSeg) => op := 'SEGMENT constant := nil - if hashCode? sig and self and scalarEqual?(sig, getDomainHash self) then + if hashCode? sig and self and scalarEq?(sig, getDomainHash self) then sig := '($) constant := true val := @@ -419,7 +419,7 @@ basicLookupCheckDefaults(op,sig,domain,dollar) == $hasCatOpHash := hashString '"%%" opIsHasCat op == - hashCode? op => scalarEqual?(op, $hasCatOpHash) + hashCode? op => scalarEq?(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 scalarEqual?(op, $hashOp1) then op := 'One - if hashCode? op and scalarEqual?(op, $hashOp0) then op := 'Zero + if hashCode? op and scalarEq?(op, $hashOp1) then op := 'One + if hashCode? op and scalarEq?(op, $hashOp0) then op := 'Zero hashPercent := vector? dollar => hashType(dollar.0,0) hashType(dollar,0) - if hashCode? sig and scalarEqual?(sig, hashPercent) then + if hashCode? sig and scalarEq?(sig, hashPercent) then sig := hashType('(Mapping $), hashPercent) dollar = nil => systemError() $lookupDefaults = true => diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot index 38b6c069..9be74bbb 100644 --- a/src/interp/newfort.boot +++ b/src/interp/newfort.boot @@ -662,7 +662,7 @@ fortFormatHead(returnType,name,args) == changeExprLength(-l) checkType ty == - ty := STRING_-UPCASE STRINGIMAGE ty + ty := stringUpcase STRINGIMAGE ty $fortranPrecision = "double" => ty = '"REAL" => '"DOUBLE PRECISION" ty = '"COMPLEX" => '"DOUBLE COMPLEX" diff --git a/src/interp/pathname.boot b/src/interp/pathname.boot index 3a741db8..8df91968 100644 --- a/src/interp/pathname.boot +++ b/src/interp/pathname.boot @@ -117,7 +117,7 @@ newMKINFILENAM(infile) == ans := queryUserKeyedMsg("S2IL0017",NIL) if (#(ans) > 0) and ('")" = subString(ans,0,1)) then n := 2 else n := 1 - nfn := UPCASE STRING2ID_-N(ans,n) + nfn := stringUpcase STRING2ID_-N(ans,n) (nfn = 0) or (nfn = 'QUIT) => sayKeyedMsg("S2IL0018",NIL) THROW('FILENAM,NIL) diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index f5e1e7aa..fb967599 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -133,7 +133,7 @@ CONTAINED(x,y) == main where equal(x,y) eq(x,y) == cons? y => eq(x, first y) or eq(x, rest y) - symbolEqual?(x,y) + symbolEq?(x,y) equal(x,y) == atom y => x = y equal(x, first y) or equal(x, rest y) @@ -275,7 +275,7 @@ PRINT_-AND_-EVAL_-DEFUN(name,body) == hashTable cmp == testFun := cmp in '(ID EQ) => function sameObject? - cmp = 'EQL => function scalarEqual? + cmp = 'EQL => function scalarEq? cmp = 'EQUAL => function EQUAL error '"bad arg to hashTable" MAKE_-HASH_-TABLE(KEYWORD::TEST,testFun) diff --git a/src/interp/word.boot b/src/interp/word.boot index 8d706adc..0b1a3b92 100644 --- a/src/interp/word.boot +++ b/src/interp/word.boot @@ -42,7 +42,7 @@ buildFunctionTable(dicts) == buildWordTable u == table:= hashTable 'EQ for s in u repeat - key := UPCASE s.0 + key := charUpcase stringChar(s,0) HPUT(table,key,[[s,:wordsOfString s],:HGET(table,key)]) for key in HKEYS table repeat HPUT(table,key, @@ -103,7 +103,8 @@ getListOfFunctionNames(fnames) == SHUT stream res -wordsOfString(s) == [UPCASE x for x in wordsOfStringKeepCase s] +wordsOfString(s) == + [stringUpcase x for x in wordsOfStringKeepCase s] wordsOfStringKeepCase s == wordsOfString1(s,0) or [COPY s] |