aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-04-19 16:12:17 +0000
committerdos-reis <gdr@axiomatics.org>2011-04-19 16:12:17 +0000
commit9430f000bbcedcd6f0edbe1c4852cb2b51c50ccc (patch)
tree97ad3fbf69b7c15f20c2dbef3f2a11860ec6fd0b /src/interp
parentb893a938b4051bc30a9c44bdcf6000bff11969c4 (diff)
downloadopen-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.boot4
-rw-r--r--src/interp/br-data.boot2
-rw-r--r--src/interp/br-search.boot2
-rw-r--r--src/interp/br-util.boot2
-rw-r--r--src/interp/category.boot6
-rw-r--r--src/interp/g-cndata.boot2
-rw-r--r--src/interp/guess.boot6
-rw-r--r--src/interp/hashcode.boot2
-rw-r--r--src/interp/i-syscmd.boot2
-rw-r--r--src/interp/interop.boot24
-rw-r--r--src/interp/newfort.boot2
-rw-r--r--src/interp/pathname.boot2
-rw-r--r--src/interp/sys-utility.boot4
-rw-r--r--src/interp/word.boot5
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]