diff options
author | dos-reis <gdr@axiomatics.org> | 2011-04-18 10:18:42 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-04-18 10:18:42 +0000 |
commit | 18cdfe64dbe07358b58d06a70b8d6bc2c276769d (patch) | |
tree | bd6067535d38995b2df9fcb62fc1cde3d4b98566 | |
parent | c552f9de83083a649b74510b522ceaebbbc0283b (diff) | |
download | open-axiom-18cdfe64dbe07358b58d06a70b8d6bc2c276769d.tar.gz |
cleanup
-rw-r--r-- | src/interp/alql.boot | 3 | ||||
-rw-r--r-- | src/interp/as.boot | 4 | ||||
-rw-r--r-- | src/interp/ax.boot | 2 | ||||
-rw-r--r-- | src/interp/bc-util.boot | 2 | ||||
-rw-r--r-- | src/interp/br-con.boot | 2 | ||||
-rw-r--r-- | src/interp/br-data.boot | 9 | ||||
-rw-r--r-- | src/interp/br-op1.boot | 14 | ||||
-rw-r--r-- | src/interp/br-op2.boot | 2 | ||||
-rw-r--r-- | src/interp/br-prof.boot | 6 | ||||
-rw-r--r-- | src/interp/br-saturn.boot | 4 | ||||
-rw-r--r-- | src/interp/br-search.boot | 58 | ||||
-rw-r--r-- | src/interp/br-util.boot | 8 | ||||
-rw-r--r-- | src/interp/c-doc.boot | 19 | ||||
-rw-r--r-- | src/interp/c-util.boot | 2 | ||||
-rw-r--r-- | src/interp/define.boot | 2 | ||||
-rw-r--r-- | src/interp/format.boot | 2 | ||||
-rw-r--r-- | src/interp/functor.boot | 28 | ||||
-rw-r--r-- | src/interp/g-cndata.boot | 2 | ||||
-rw-r--r-- | src/interp/guess.boot | 8 | ||||
-rw-r--r-- | src/interp/ht-root.boot | 10 | ||||
-rw-r--r-- | src/interp/i-output.boot | 24 | ||||
-rw-r--r-- | src/interp/i-syscmd.boot | 9 | ||||
-rw-r--r-- | src/interp/incl.boot | 2 | ||||
-rw-r--r-- | src/interp/intfile.boot | 4 | ||||
-rw-r--r-- | src/interp/match.boot | 2 | ||||
-rw-r--r-- | src/interp/modemap.boot | 4 | ||||
-rw-r--r-- | src/interp/nruncomp.boot | 33 | ||||
-rw-r--r-- | src/interp/topics.boot | 14 | ||||
-rw-r--r-- | src/interp/word.boot | 11 |
29 files changed, 154 insertions, 136 deletions
diff --git a/src/interp/alql.boot b/src/interp/alql.boot index 43219d0b..89d9a610 100644 --- a/src/interp/alql.boot +++ b/src/interp/alql.boot @@ -45,7 +45,8 @@ stringMatches?(pattern,subject) == false alqlGetKindString(x) == - x.0 = char "a" or x.0 = char "o" => subString(dbPart(x,5,1),0,1) + stringChar(x,0) = char "a" or stringChar(x,0) = char "o" => + subString(dbPart(x,5,1),0,1) subString(x,0,1) alqlGetOrigin(x) == diff --git a/src/interp/as.boot b/src/interp/as.boot index 5c15147c..8b5b240c 100644 --- a/src/interp/as.boot +++ b/src/interp/as.boot @@ -248,7 +248,7 @@ displayDatabase x == main where zeroOneConversion opAlist == opAlist -- for u in opAlist repeat -- [op,:.] := u --- digit? (PNAME op).0 => u.first := string2Integer PNAME op +-- digit? stringChar(PNAME op,0) => u.first := string2Integer PNAME op -- opAlist asyDisplay(con,alist) == @@ -900,7 +900,7 @@ asyTypeJoinPartPred x == asyTypeJoinItem x == result := asyTypeUnit x - isLowerCaseLetter PNAME(opOf result).0 => + isLowerCaseLetter stringChar(symbolName opOf result,0) => $opStack := [[['ATTRIBUTE,result],:$predlist],:$opStack] $conStack := [[result,:$predlist],:$conStack] diff --git a/src/interp/ax.boot b/src/interp/ax.boot index 4b38a678..64364130 100644 --- a/src/interp/ax.boot +++ b/src/interp/ax.boot @@ -177,7 +177,7 @@ axFormatType(typeform) == SUBLISLIS($FormalMapVariableList, $TriangleVariableList, typeform) MEMQ(typeform, $FormalMapVariableList) => typeform axAddLiteral('string, 'Symbol, 'Literal) - ['RestrictTo, ['LitString, PNAME typeform], 'Symbol] + ['RestrictTo, ['LitString, symbolName typeform], 'Symbol] typeform is ['construct,: args] => axAddLiteral('bracket, ['Apply, 'List, 'Symbol], [ 'Apply, 'Tuple, 'Symbol]) axAddLiteral('string, 'Symbol, 'Literal) diff --git a/src/interp/bc-util.boot b/src/interp/bc-util.boot index 74b2e0ec..38a7255b 100644 --- a/src/interp/bc-util.boot +++ b/src/interp/bc-util.boot @@ -50,7 +50,7 @@ bcMkFunction(name,arg,args) == strconc(name,'"(",arg,strconc/[strconc('",", x) for x in args],'")") bcString2HyString2 s == - (string? s) and (s.0 = char "_"") => + string? s and stringChar(s,0) = char "_"" => len := #s strconc('"\_"", subString(s, 1, len-2), '"\_"") s diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index 7ae9a7c6..ca273976 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -621,7 +621,7 @@ kcnPage(htPage,junk) == htpSetProperty(htPage,'heading,heading) conform:= htpProperty(htPage,'conform) pakname := - kind = '"category" => makeDefaultPackageName PNAME name + kind = '"category" => makeDefaultPackageName symbolName name opOf conform domList := getImports pakname if domname then diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index fd098631..7292c350 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -112,7 +112,7 @@ buildLibdbConEntry conname == and t is ['CATEGORY,'package,:.] then kind := 'package $kind := isDefaultPackageName conname => 'x - DOWNCASE symbolName(kind).0 + DOWNCASE stringChar(symbolName kind,0) argl := rest $conform conComments := LASSOC('constructor,$doc) is [[=nil,:r]] => libdbTrim concatWithBlanks r @@ -313,7 +313,7 @@ dbSpreadComments(line,n) == line = '"" => nil k := charPosition(char "-",line,n + 2) k >= maxIndex line => [subString(line,n)] - line.(k + 1) ~= char "-" => + stringChar(line,k + 1) ~= char "-" => u := dbSpreadComments(line,k) [strconc(subString(line,n,k - n),first u),:rest u] [subString(line,n,k - n),:dbSpreadComments(subString(line,k),0)] @@ -403,7 +403,8 @@ getGlossLines instream == #last = 0 => lastLineHadTick => '"" '"\blankline " - #last > 0 and last.(maxIndex last) ~= $charBlank => $charBlank + #last > 0 and stringChar(last,maxIndex last) ~= $charBlank => + $charBlank '"" lastLineHadTick := false text := [strconc(last,fill,line),:rest text] @@ -432,7 +433,7 @@ mkUsersHashTable() == --called by buildDatabase (database.boot) $usersTb getDefaultPackageClients con == --called by mkUsersHashTable - catname := makeSymbol subString(s := PNAME con,0,maxIndex s) + catname := makeSymbol subString(s := symbolName con,0,maxIndex s) for [catAncestor,:.] in childrenOf([catname]) repeat pakname := makeDefaultPackageName symbolName catAncestor if getCDTEntry(pakname,true) then acc := [pakname,:acc] diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index ddd70f07..47252747 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -196,7 +196,7 @@ fromHeading htPage == dnFence := form2Fence dnForm -- upString:= form2StringList updomain upFence := form2Fence updomain - upOp := PNAME opOf updomain + upOp := symbolName opOf updomain ['" {\em from} ",:dbConformGen dnForm,'" {\em under} \ops{",upOp,'"}{",:$pn,:upFence,'"}"] domname := htpProperty(htPage,'domname) numberOfUnderlyingDomains := #[x for x in rest getDualSignatureFromDB(opOf domname) | x] @@ -309,7 +309,8 @@ dbConformGen1(form,opButton?) == unAbbreviateIfNecessary op == IFCAR HGET($lowerCaseConTb, op) or op -conname2StringList form == [PNAME unAbbreviateIfNecessary opOf form] +conname2StringList form == + [PNAME unAbbreviateIfNecessary opOf form] --=========================================================================== -- Data Gathering Code @@ -568,9 +569,10 @@ dbShowKind conform == kind = "domain" => isDefaultPackageName conname => '"default package" '"domain" - PNAME kind + symbolName kind -dbShowOpSignatures(htPage,opAlist,which,data) == dbShowOpSigList(which,data,0) +dbShowOpSignatures(htPage,opAlist,which,data) == + dbShowOpSigList(which,data,0) dbShowOpSigList(which,dataItems,count) == --dataItems is (((op,sig,:.),exposureFlag,...) @@ -689,7 +691,7 @@ dbChooseDomainOp(htPage,which,index) == htSayExpose(op,flag) == $includeUnexposed? => flag => htBlank() - op.0 = char "*" => htSay '"{\em *} " + stringChar(op,0) = char "*" => htSay '"{\em *} " htSayUnexposed() htSay '"" --============================================================================ @@ -846,7 +848,7 @@ dbExpandOpAlistIfNecessary(htPage,opAlist,which,needOrigins?,condition?) == packageSymbol := false domform := htpProperty(htPage,'domname) or htpProperty(htPage,'conform) if isDefaultPackageName opOf domform then - catname := intern subString(s := PNAME opOf domform,0,maxIndex s) + catname := intern subString(s := symbolName opOf domform,0,maxIndex s) packageSymbol := second domform domform := [catname,:rest rest domform] --skip first argument ($) docTable:= dbDocTable domform diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index 84cb23c6..e6b3de61 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -176,7 +176,7 @@ dbChooseOperandName(typ) == kind := name = "$" => 'domain getConstructorKindFromDB name - s := PNAME opOf typ + s := symbolName opOf typ kind ~= 'category => anySubstring?('"Integer",s,0) or anySubstring?('"Number",s,0) => x := first $NumberList diff --git a/src/interp/br-prof.boot b/src/interp/br-prof.boot index b9650ae0..b26f1b18 100644 --- a/src/interp/br-prof.boot +++ b/src/interp/br-prof.boot @@ -213,7 +213,7 @@ dbInfoChoose1(htPage,con,alist) == opAlist := [pair for x in koOps(con,nil) | pair:=dbInfoSigMatch(x,alist)] page := htInitPage(nil,nil) htpSetProperty(page,'conform,con) - htpSetProperty(page,'kind,PNAME getConstructorKindFromDB opOf con) + htpSetProperty(page,'kind,symbolName getConstructorKindFromDB opOf con) dbShowOperationsFromConform(page,'"operation",opAlist) dbInfoSigMatch(x,alist) == @@ -254,10 +254,10 @@ getInfoAlist conname == cat? := getConstructorKindFromDB conname = "category" if cat? then conname := makeDefaultPackageName symbolName conname abb := getConstructorAbbreviationFromDB conname or return '"not a constructor" - fs := strconc(PNAME abb,'".NRLIB/info") + fs := strconc(symbolName abb,'".NRLIB/info") inStream := PROBE_-FILE fs => OPEN fs - filename := strconc('"/spad/int/algebra/",PNAME abb,'".NRLIB/info") + filename := strconc('"/spad/int/algebra/",symbolName abb,'".NRLIB/info") PROBE_-FILE filename => OPEN filename return nil alist := mySort READ inStream diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index ace5f046..721893cc 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -236,7 +236,7 @@ htMakeErrorPage htPage == writeSaturnLines lines == for line in lines repeat - if line ~= '"" and line.0 = char "\" then saturnTERPRI() + if line ~= '"" and stringChar(line,0) = char "\" then saturnTERPRI() saturnPRINTEXP line writeSaturn(line) == @@ -1635,7 +1635,7 @@ bcConform1 form == main where s := string? form => strconc('"_"",form,'"_"") STRINGIMAGE form - (s.0 = char "#") => + stringChar(s,0) = char "#" => (n := POSN1(form, $FormalFunctionParameterList)) => htSay form2HtString ($FormalMapVariableList . n) htSay '"\" diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index 8f6deb7a..7bb7323a 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -101,7 +101,7 @@ grepForAbbrev(s,key) == for x in allConstructors() | test]] where test() == not $includeUnexposed? and not isExposedConstructor x => false a := getConstructorAbbreviationFromDB x - match?(pattern,PNAME a) and not HGET($defaultPackageNamesHT,x) + match?(pattern,symbolName a) and not HGET($defaultPackageNamesHT,x) applyGrep(x,filename) == atom x => grepFile(x,filename,'i) @@ -139,11 +139,11 @@ grepf(pattern,s,not?) == --s=sourceFile or list of strings pmTransFilter s == --result is either a string or (op ..) where op= and,or,not and arg are results if $browseMixedCase = true then s := DOWNCASE s - or/[isFilterDelimiter? s.i or s.i = $charUnderscore for i in 0..maxIndex s] + or/[isFilterDelimiter? stringChar(s,i) or stringChar(s,i) = $charUnderscore for i in 0..maxIndex s] => (parse := pmParseFromString s) and checkPmParse parse or ['error,'"Illegal search string",'"\vspace{3}\center{{\em Your search string} ",escapeSpecialChars s,'" {\em has incorrect syntax}}"] or/[s . i = char "*" and s.(i + 1) = char "*" - and (i=0 or s . (i - 1) ~= char $charUnderscore) for i in 0..(maxIndex s - 1)] + and (i=0 or stringChar(s,i - 1) ~= char $charUnderscore) for i in 0..(maxIndex s - 1)] => ['error,'"Illegal search string",'"\vspace{3}\center{Consecutive {\em *}'s are not allowed in search patterns}"] s @@ -190,7 +190,7 @@ pmPreparse s == hn fn(s,0,#s) where--stupid insertion of chars to get correct pa middle := t in '("and" "or" "not") => t --the following 2 lines make commutative("*") parse correctly!!!! - t.0 = char "_"" => t + stringChar(t,0) = char "_"" => t j < siz - 1 and s.j = char "(" => t strconc('"_"",t,'"_"") strconc(subString(s,n,i - n),middle,fn(s,j,siz)) @@ -199,8 +199,11 @@ pmPreparse s == hn fn(s,0,#s) where--stupid insertion of chars to get correct pa strconc(subString(s,i,n - i + 1),$charUnderscore,gn(s,n + 1,j)) subString(s,i,j - i + 1) -firstNonDelim(s,n) == or/[k for k in n..maxIndex s | not isFilterDelimiter? s.k] -firstDelim(s,n) == or/[k for k in n..maxIndex s | isFilterDelimiter? s.k] +firstNonDelim(s,n) == + or/[k for k in n..maxIndex s | not isFilterDelimiter? stringChar(s,k)] + +firstDelim(s,n) == + or/[k for k in n..maxIndex s | isFilterDelimiter? stringChar(s,k)] isFilterDelimiter? c == MEMQ(c,$pmFilterDelimiters) @@ -259,8 +262,8 @@ mkGrepPattern1(x,:options) == --called by mkGrepPattern (and grepConstructName?) h(sl,nil) g s == --remove "*"s around pattern for text match not ('w in $options) => s - if s.0 = char "*" then s := subString(s,1) - if s.(k := maxIndex s) = char "*" then s := subString(s,0,k) + if stringChar(s,0) = char "*" then s := subString(s,1) + if stringChar(s,k := maxIndex s) = char "*" then s := subString(s,0,k) s h(sl,res) == --helper for wild cards sl is [s,:r] => h(r,[$wild1,s,:res]) @@ -369,7 +372,7 @@ looksLikeDomainForm x == spadSys(x) == --called by \spadsyscom{x} s := PNAME x - if s.0 = char ")" then s := subString(s,1) + if stringChar(s,0) = char ")" then s := subString(s,1) form := ncParseFromString s or systemError ['"Argument: ",s,'" to spadType won't parse"] htSystemCommands PNAME opOf form @@ -392,7 +395,8 @@ genSearch(filter,:options) == --"Complete" from HD (see man0.ht) and aokSearch if includeDoc? then docSearchAlist := grepConstruct(key,'w,true) docSearchAlist is ['error,:.] => bcErrorPage docSearchAlist - docSearchAlist := [x for x in docSearchAlist | x.0 ~= char "x"]--drop defaults + docSearchAlist := [x for x in docSearchAlist + | stringChar(x,0) ~= char "x"]--drop defaults genSearch1(filter,genSearchTran regSearchAlist,genSearchTran docSearchAlist) genSearchTran alist == [[x,y,:y] for [x,:y] in alist] @@ -546,7 +550,8 @@ docSearch filter == --"Documentation" from HD (see man0.ht) key := removeSurroundingStars filter docSearchAlist := grepConstruct(filter,'w,true) docSearchAlist is ['error,:.] => bcErrorPage docSearchAlist - docSearchAlist := [x for x in docSearchAlist | x.0 ~= char "x"] --drop defaults + docSearchAlist := [x for x in docSearchAlist + | stringChar(x,0) ~= char "x"] --drop defaults docSearch1(filter,genSearchTran docSearchAlist) docSearch1(filter,doc) == @@ -570,8 +575,9 @@ docSearch1(filter,doc) == removeSurroundingStars filter == key := STRINGIMAGE filter - if key.0 = char "*" then key := subString(key,1) - if key.(max := maxIndex key) = char "*" then key := subString(key,0,max) + if stringChar(key,0) = char "*" then key := subString(key,1) + if stringChar(key,max := maxIndex key) = char "*" then + key := subString(key,0,max) key showNamedDoc([kind,:lines],index) == @@ -581,9 +587,9 @@ sayDocMessage message == htSay('"{\em ") if message is [leftEnd,left,middle,right,rightEnd] then htSay(leftEnd,left,'"}") - if left ~= '"" and left.(maxIndex left) = $blank then htBlank() + if left ~= '"" and stringChar(left,maxIndex left) = $blank then htBlank() htSay middle - if right ~= '"" and right.0 = $blank then htBlank() + if right ~= '"" and stringChar(right,0) = $blank then htBlank() htSay('"{\em ",right,rightEnd) else htSay message @@ -604,7 +610,7 @@ replaceTicksBySpaces s == n := -1 max := maxIndex s while (n := charPosition(char "`",s,n + 1)) <= max repeat - s.n := char " " + stringChar(s,n) := char " " s checkFilter filter == @@ -700,11 +706,11 @@ $dbDelimiters := [char " " , char "(", char ")"] dbWordFrom(l,i) == idxmax := maxIndex l - while idxmax >= i and l.i = char " " repeat i := i + 1 - if idxmax >= i and member(l.i, $dbDelimiters) then return [l.i, i + 1] - k := or/[j for j in i..idxmax | not member(l.j, $dbDelimiters)] or return nil + while idxmax >= i and stringChar(l,i) = char " " repeat i := i + 1 + if idxmax >= i and member(stringChar(l,i), $dbDelimiters) then return [l.i, i + 1] + k := or/[j for j in i..idxmax | not member(stringChar(l,j), $dbDelimiters)] or return nil buf := '"" - while k <= idxmax and not member(c := l.k, $dbDelimiters) repeat + while k <= idxmax and not member(c := stringChar(l,k), $dbDelimiters) repeat ch := c = char "__" => l.(k := 1+k) --this may exceed bounds c @@ -881,9 +887,9 @@ mkDetailedGrepPattern(kind,name,nargs,argOrSig) == main where strconc(a,$tick,b) simp a == m := maxIndex a - m > 6 and a.(m-5) = char "[" and a.(m-4) = char "^" - and a.(m-3) = $tick and a.(m-2) = char "]" - and a.(m-1) = char "*" and a.m = $tick + m > 6 and stringChar(a,m-5) = char "[" and stringChar(a,m-4) = char "^" + and stringChar(a,m-3) = $tick and stringChar(a,m-2) = char "]" + and stringChar(a,m-1) = char "*" and stringChar(a,m) = $tick => simp subString(a,0,m-5) a @@ -895,9 +901,9 @@ replaceGrepStar s == strconc(subString(s,0,i),'"[^`]*",replaceGrepStar subString(s,i + 1)) standardizeSignature(s) == underscoreDollars - s.0 = char "(" => s + stringChar(s,0) = char "(" => s k := STRPOS('"->",s,0,nil) or return s --will fail except perhaps on constants - s.(k - 1) = char ")" => strconc('"(",s) + stringChar(s,k - 1) = char ")" => strconc('"(",s) strconc('"(",subString(s,0,k),'")",subString(s,k)) underscoreDollars(s) == fn(s,0,maxIndex s) where @@ -987,7 +993,7 @@ dbUnpatchLines lines == --concatenate long lines together, skip blank lines while lines is [line, :lines] repeat #line = 0 => 'skip --skip blank lines acc := - line.0 = dash and line.1 = dash => + stringChar(line,0) = dash and line.1 = dash => [strconc(first acc,subString(line,2)),:rest acc] [line,:acc] -- following call to nreverse needed to keep lines properly sorted diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot index 960d0181..6b24f2f0 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 - res.0 := UPCASE res.0 + stringChar(res,0) := UPCASE stringChar(res,0) res escapeSpecialIds u == --very expensive function @@ -150,7 +150,7 @@ htPred2English(x,:options) == gn(x,op,l,prec) if prec < 5 then htSay '")" x = 'etc => htSay '"..." - IDENTP x and not MEMQ(x,$emList) => htSay escapeSpecialIds PNAME x + IDENTP x and not MEMQ(x,$emList) => htSay escapeSpecialIds symbolName x htSay form2HtString(x,$emList) gn(x,op,l,prec) == op in '(NOT not) => @@ -182,7 +182,7 @@ unMkEvalable u == u lisp2HT u == ['"_'",:fn u] where fn u == - IDENTP u => escapeSpecialIds PNAME u + IDENTP u => escapeSpecialIds symbolName u string? u => escapeString u atom u => systemError() ['"_(",:"append"/[fn x for x in u],'")"] @@ -348,7 +348,7 @@ bcStarSpaceOp(op,exposed?) == null $includeUnexposed? => nil not exposed? => htSayUnexposed() - if op.0 = char "*" then htSay '" " + if stringChar(op,0) = char "*" then htSay '" " htBlank() bcStarConform form == diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index d7812979..036a7111 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -95,7 +95,7 @@ recordSignatureDocumentation(opSig,lineno) == recordAttributeDocumentation(['Attribute,att],lineno) == name := opOf att - upperCase? PNAME(name).0 => nil + upperCase? stringChar(symbolName name,0) => nil recordDocumentation([name,['attribute,:IFCDR postTransform att]],lineno) recordDocumentation(key,lineno) == @@ -351,7 +351,7 @@ checkTexht u == checkRecordHash u == while u repeat x := first u - if string? x and x.0 = $charBack then + if string? x and stringChar(x,0) = $charBack then if member(x,$HTlinks) and (u := checkLookForLeftBrace IFCDR u) and (u := checkLookForRightBrace IFCDR u) and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then @@ -377,7 +377,7 @@ checkRecordHash u == HPUT($glossHash,htname,[first entry,:[[$name,:$origin],:rest entry]]) else if x is '"\spadsys" and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then s := checkGetStringBeforeRightBrace u - if s.0 = char ")" then s := subString(s,1) + if stringChar(s,0) = char ")" then s := subString(s,1) parse := checkGetParse s null parse => checkDocError ['"Unparseable \spadtype: ",s] not member(opOf parse,$currentSysList) => @@ -626,7 +626,7 @@ newString2Words l == [w while newWordFrom(l,i,m) is [w,i]] newWordFrom(l,i,m) == - while i <= m and l.i = char " " repeat i := i + 1 + while i <= m and stringChar(l,i) = char " " repeat i := i + 1 i > m => NIL buf := '"" ch := stringChar(l,i) @@ -649,7 +649,7 @@ checkAddPeriod s == --No, just leave blank at the end (rdj: 10/18/91) s checkGetArgs u == - NOT string? u => nil + not string? u => nil m := maxIndex u k := firstNonBlankPosition(u) k > 0 => checkGetArgs subString(u,k) @@ -814,7 +814,7 @@ checkDecorate u == spadflag => ['",",:acc] ['",{}",:acc] x is '"\spad" => ['"\spad",:acc] - string? x and digit? x.0 => [x,:acc] + string? x and digit? stringChar(x,0) => [x,:acc] not spadflag and (CHARP x and alphabetic? x and not MEMQ(x,$charExclusions) or member(x,$argl)) => [$charRbrace,x,$charLbrace,'"\spad",:acc] @@ -1120,9 +1120,10 @@ checkTransformFirsts(opname,u,margin) == --case 3: form arg --case 4: op arg --case 5: arg op arg - namestring := PNAME opname - if namestring = '"Zero" then namestring := '"0" - else if namestring = '"One" then namestring := '"1" + namestring := + opname is ['Zero] => '"0" + opname is ['One] => '"1" + symbolName opname margin > 0 => s := leftTrim u strconc(fillerSpaces margin,checkTransformFirsts(opname,s,0)) diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 7cdab710..250eb63e 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -633,7 +633,7 @@ isConstantId(name,e) == isFalse() == nil isFluid s == - atom s and char "$" = PNAME(s).0 + atom s and char "$" = stringChar(PNAME s,0) isFunction(x,e) == get(x,"modemap",e) or GETL(x,"SPECIAL") or x="case" or getmode(x,e) is [ diff --git a/src/interp/define.boot b/src/interp/define.boot index 27b9498d..38f6e9c9 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -385,7 +385,7 @@ expandTypeArgs(u,template,domform) == templateVal(template,domform,index) == --returns a domform or a lazy slot index = 0 => BREAK() --template - template.index + vectorRef(template,index) --% Subdomains diff --git a/src/interp/format.boot b/src/interp/format.boot index 9fa054d5..fd0763e2 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -579,7 +579,7 @@ linearFormat x == [linearFormat y for y in x] numOfSpadArguments id == - char "*" = (s:= PNAME id).0 => + char "*" = stringChar(s:= PNAME id,0) => +/[n for i in 1.. while integer? (n:=readInteger PNAME s.i)] keyedSystemError("S2IF0012",[id]) diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 9a72de7f..fea465c8 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -229,10 +229,10 @@ compCategories1(u,v) == error 'compCategories1 NewbFVectorCopy(u,domName) == - v:= newShell # u - for i in 0..5 repeat v.i:= u.i - for i in 6..maxIndex v | cons? u.i repeat - v.i:= [function Undef,[domName,i],:first u.i] + v := newShell # u + for i in 0..5 repeat vectorRef(v,i) := vectorRef(u,i) + for i in 6..maxIndex v | cons? vectorRef(u,i) repeat + vectorRef(v,i) := [function Undef,[domName,i],:first vectorRef(u,i)] v optFunctorBody x == @@ -328,12 +328,12 @@ setVector12 args == false SetDomainSlots124(vec,names,vals) == - l:= pairList(names,vals) - vec.1:= sublisProp(l,vec.1) - vec.2:= sublisProp(l,vec.2) + l := pairList(names,vals) + vec.1 := sublisProp(l,vec.1) + vec.2 := sublisProp(l,vec.2) l:= [[a,:devaluate b] for a in names for b in vals] - vec.4:= SUBLIS(l,vec.4) - vec.1:= SUBLIS(l,vec.1) + vec.4 := SUBLIS(l,vec.4) + vec.1 := SUBLIS(l,vec.1) sublisProp(subst,props) == null props => nil @@ -592,13 +592,13 @@ SetFunctionSlots(sig,body,flag,mode) == --mode is either "original" or "adding" body:= ['%store,['%tref,'$,index],body] not vector? $SetFunctions => nil --packages don't set it if TruthP flag then -- unconditionally defined function - u.index := true - TruthP $SetFunctions.index => -- the function was already assigned + vectorRef(u,index) := true + TruthP vectorRef($SetFunctions,index) => -- the function was already assigned return body := nil - $SetFunctions.index := + vectorRef($SetFunctions,index) := TruthP flag => true - not $SetFunctions.index => flag - ['_or,$SetFunctions.index,flag] + not vectorRef($SetFunctions,index) => flag + ['_or,vectorRef($SetFunctions,index),flag] catImplem is ['Subsumed,:truename] => mode='original => truename is [fn,:.] and fn in '(Zero One) => nil --hack by RDJ 8/90 diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot index 245ef37f..60620e81 100644 --- a/src/interp/g-cndata.boot +++ b/src/interp/g-cndata.boot @@ -130,7 +130,7 @@ constructorNameConflict(name,kind) == "%l",'"please choose another ",kind] constructorAbbreviationErrorCheck(c,a,typ,errmess) == - siz := # (s := PNAME a) + siz := # (s := symbolName a) if typ = "category" and siz > 7 then throwKeyedErrorMsg('precompilation,"S2IL0021",NIL) if siz > 8 then throwKeyedErrorMsg('precompilation,"S2IL0006",NIL) diff --git a/src/interp/guess.boot b/src/interp/guess.boot index 27cf3723..f5f64ca1 100644 --- a/src/interp/guess.boot +++ b/src/interp/guess.boot @@ -39,13 +39,13 @@ $maxThreshold := 7 -- Build Directories --======================================================================= buildOperationWordTable() == - $opWordTable := buildWordTable [PNAME x for x in allOperations()] + $opWordTable := buildWordTable [symbolName x for x in allOperations()] buildWordTable u == table:= hashTable 'EQ for s in u repeat words := wordsOfString s - key := UPCASE s.0 + key := UPCASE stringChar(s,0) HPUT(table,key,[[s,:words],:HGET(table,key)]) for key in HKEYS table repeat HPUT(table,key, @@ -71,7 +71,7 @@ wordsOfStringKeepCase s == wordsOfString1(s,0) or [COPY s] wordsOfString1(s,j) == k := or/[i for i in j..(maxIndex(s)-1) | upperCase? stringChar(s,i)] => tailWords:= - upperCase? s.(k+1) => + upperCase? stringChar(s,k+1) => n:= or/[i for i in (k+2)..(maxIndex(s)-1)| not upperCase? stringChar(s,i)] null n => [subString(s,k)] n > k+1 => [subString(s,k,n-k-1),:wordsOfString1(s,n-1)] @@ -83,7 +83,7 @@ wordsOfString1(s,j) == nil wordKeys s == - removeDuplicates [UPCASE s.0,:fn(s,1,-1,maxIndex s,nil)] where fn(s,i,lastKeyIndex,n,acc) == + removeDuplicates [UPCASE 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/ht-root.boot b/src/interp/ht-root.boot index 2540662d..e7ac3df1 100644 --- a/src/interp/ht-root.boot +++ b/src/interp/ht-root.boot @@ -272,10 +272,12 @@ mkUnixPattern s == starPositions := reverse [i for i in 1..(-1 + maxIndex u) | u.i = $wild] for i in starPositions repeat u := strconc(subString(u,0,i),'".*",subString(u,i + 1)) - if u.0 ~= $wild then u := strconc('"[^a-zA-Z]",u) - else u := subString(u,1) - if u.(k := maxIndex u) ~= $wild then u := strconc(u,'"[^a-zA-Z]") - else u := subString(u,0,k) + if stringChar(u,0) ~= $wild + then u := strconc('"[^a-zA-Z]",u) + else u := subString(u,1) + if stringChar(u,k := maxIndex u) ~= $wild + then u := strconc(u,'"[^a-zA-Z]") + else u := subString(u,0,k) u diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index 6ccde110..d455fad0 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -447,15 +447,15 @@ atom2String x == appChar(string,x,y,d) == if CHARP string then string := PNAME string line:= LASSOC(y,d) => - if maxIndex string = 1 and string.0 = char "%" then - string.1 = char "b" => + if maxIndex string = 1 and stringChar(string,0) = char "%" then + stringChar(string,1) = char "b" => bumpDeltaIfTrue:= true - string.0:= EBCDIC 29 - string.1:= EBCDIC 200 - string.1 = char "d" => + stringChar(string,0) := EBCDIC 29 + stringChar(string,1) := EBCDIC 200 + stringChar(string,1) = char "d" => bumpDeltaIfTrue:= true - string.0:= EBCDIC 29 - string.1:= EBCDIC 65 + stringChar(string,0) := EBCDIC 29 + stringChar(string,1) := EBCDIC 65 shiftedX:= (y=0 => x+$highlightDelta; x) --shift x for brightening characters -- presently only if y=0 RPLACSTR(line,shiftedX,n:=#string,string,0,n) @@ -607,8 +607,8 @@ outputTran x == ['PAREN,["|",['AGGLST,:l],pred]] op="tuple" => ['PAREN,['AGGLST,:l]] op='LISTOF => ['AGGLST,:l] - IDENTP op and not (op in '(_* _*_*) ) and char "*" = (symbolName op).0 => - mkSuperSub(op,l) + IDENTP op and not (op in '(_* _*_*) ) and + char "*" = stringChar(symbolName op,0) => mkSuperSub(op,l) [outputTran op,:l] -- The next two functions are designed to replace successive instances of @@ -1039,7 +1039,8 @@ aggregateApp(u,x,y,d,s) == outformWidth u == --WIDTH as called from OUTFORM to do a COPY string? u => u = $EmptyString => 0 - u.0 = char "%" and ((u.1 = char "b") or (u.1 = char "d")) => 1 + stringChar(u,0) = char "%" and + (stringChar(u,1) = char "b" or stringChar(u,1) = char "d") => 1 #u atom u => # atom2String u WIDTH COPY u @@ -1047,7 +1048,8 @@ outformWidth u == --WIDTH as called from OUTFORM to do a COPY WIDTH u == string? u => u = $EmptyString => 0 - u.0 = char "%" and ((u.1 = char "b") or (u.1 = char "d")) => 1 + stringChar(u,0) = char "%" and + (stringChar(u,1) = char "b" or stringChar(u,1) = char "d") => 1 #u integer? u => if (u < 1) then diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index 08f5e32e..86c3bb67 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -107,7 +107,7 @@ systemCommand [[op,:argl],:options] == $options: local:= options $e:local := $CategoryFrame fun := selectOptionLC(op,$SYSCOMMANDS,'commandError) - argl and (argl.0 = '_?) and fun ~= 'synonym => + argl and (first argl = '_?) and fun ~= 'synonym => helpSpad2Cmd [fun] fun := selectOption(fun,commandsForUserLevel $systemCommands, 'commandUserLevelError) @@ -3157,14 +3157,13 @@ tokTran tok == string? tok => #tok = 0 => nil isIntegerString tok => READ_-FROM_-STRING tok - tok.0 = char "_"" => - subSequence(tok, 1, #tok-1) + stringChar(tok,0) = char "_"" => subSequence(tok, 1, #tok-1) makeSymbol tok tok isIntegerString tok == - for i in 0..#tok-1 repeat - val := digit? tok.i + for i in 0..maxIndex tok repeat + val := digit? stringChar(tok,i) not val => return nil val diff --git a/src/interp/incl.boot b/src/interp/incl.boot index b2e9ca78..8bfe69d9 100644 --- a/src/interp/incl.boot +++ b/src/interp/incl.boot @@ -101,7 +101,7 @@ incPrefix?(prefix, start, whole) == good incCommand?(s) == - #s > 0 and s.0 = char ")" + #s > 0 and stringChar(s,0) = char ")" incCommands := ['"say" , _ diff --git a/src/interp/intfile.boot b/src/interp/intfile.boot index f87b3e5d..34818377 100644 --- a/src/interp/intfile.boot +++ b/src/interp/intfile.boot @@ -45,7 +45,7 @@ shoeIntern (s)== StreamNull s => nil f:=first s # f < 8 => shoeIntern rest s - f.0=char " " =>shoeIntern rest s + stringChar(f,0) = char " " =>shoeIntern rest s a:=makeSymbol subString(f,0,8) [b,c]:= shoeStrings rest s GET(a,"MSGS") := b @@ -54,7 +54,7 @@ shoeIntern (s)== shoeStrings (stream)== StreamNull stream => ['"",stream] a:=first stream - if a.0 ~= char " " + if stringChar(a,0) ~= char " " then ['"",stream] else [h,t]:=shoeStrings(rest stream) diff --git a/src/interp/match.boot b/src/interp/match.boot index 6abf163a..8ca52e2f 100644 --- a/src/interp/match.boot +++ b/src/interp/match.boot @@ -67,7 +67,7 @@ charPosition(c,t,startpos) == rightCharPosition(c,t,startpos) == --startpos often equals maxIndex t (rightmost) k := startpos - for i in startpos..0 by -1 while c ~= ELT(t,i) repeat (k := k - 1) + for i in startpos..0 by -1 while c ~= stringChar(t,i) repeat (k := k - 1) k stringPosition(s,t,startpos) == diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index c6f6f50c..26032507 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -48,8 +48,8 @@ addDomain(domain,e) == atom domain => domain="$EmptyMode" => e domain="$NoValueMode" => e - not IDENTP domain or 2<#(s:= STRINGIMAGE domain) and - char "#" = s.0 and char "#" = s.1 => e + not IDENTP domain or 2 < #(s:= STRINGIMAGE domain) and + char "#" = stringChar(s,0) and char "#" = stringChar(s,1) => e MEMQ(domain,getDomainsInScope e) => e isLiteral(domain,e) => e addNewDomain(domain,e) diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 147f7875..85e471b6 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -85,9 +85,9 @@ NRTaddDeltaCode() == kvec := first $catvecList for i in $NRTbase.. for item in reverse $NRTdeltaList for compItem in reverse $NRTdeltaListComp - |null (s:=kvec.i) repeat - $template.i:= deltaTran(item,compItem) - $template.5 := + | null vectorRef(kvec,i) repeat + vectorRef($template,i) := deltaTran(item,compItem) + vectorRef($template,5) := $NRTaddForm => $NRTaddForm is ["%Comma",:y] => nreverse y NRTencode($NRTaddForm,$addForm) @@ -407,7 +407,7 @@ washFunctorBody form == main form where -- Instantiation Code (Stuffslots) --======================================================================= stuffSlot(dollar,i,item) == - dollar.i := + vectorRef(dollar,i) := atom item => [symbolFunction item,:dollar] item is [n,:op] and integer? n => ['newGoGet,dollar,:item] item is ['CONS,.,['FUNCALL,a,b]] => @@ -425,13 +425,15 @@ stuffDomainSlots dollar == lookupFunction = 'lookupIncomplete => function lookupIncomplete function lookupComplete template := infovec.0 - if template.5 then stuffSlot(dollar,5,template.5) - for i in (6 + # rest domname)..maxIndex template | item := template.i repeat - stuffSlot(dollar,i,item) - dollar.1 := LIST(lookupFunction,dollar,infovec.1) - dollar.2 := infovec.2 + if vectorRef(template,5) then + stuffSlot(dollar,5,vectorRef(template,5)) + for i in (6 + # rest domname)..maxIndex template + | item := vectorRef(template,i) repeat + stuffSlot(dollar,i,item) + vectorRef(dollar,1) := LIST(lookupFunction,dollar,infovec.1) + vectorRef(dollar,2) := infovec.2 proto4 := infovec.3 - dollar.4 := + vectorRef(dollar,4) := vector? CDDR proto4 => [COPY_-SEQ first proto4,:rest proto4] --old style bitVector := dollar.3 predvec := first proto4 @@ -447,7 +449,7 @@ getLookupFun infovec == makeSpadConstant [fn,dollar,slot] == val := FUNCALL(fn,dollar) - u:= dollar.slot + u := vectorRef(dollar,slot) u.first := function IDENTITY u.rest := val val @@ -502,7 +504,8 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) == makeCatvecCode:= first catvecListMaker emptyVector := VECTOR() domainShell := newShell($NRTbase + $NRTdeltaLength) - for i in 0..4 repeat domainShell.i := $domainShell.i + for i in 0..4 repeat + vectorRef(domainShell,i) := vectorRef($domainShell,i) --we will clobber elements; copy since $domainShell may be a cached vector $template := newShell ($NRTbase + $NRTdeltaLength) $catvecList:= [domainShell,:[emptyVector for u in second domainShell.4]] @@ -571,13 +574,13 @@ NRTcheckVector domainShell == -- (b) NIL -- ??? -- (c) categoryForm-- it was a domain view; now irrelevant -- (d) op-signature-- store missing function info in $CheckVectorList - v := domainShell.i + v := vectorRef(domainShell,i) v=true => nil --item is marked; ignore v=nil => nil atom v => systemErrorHere '"CheckVector" atom first v => nil --category form; ignore assoc(first v,alist) => nil - alist := [[first v,:$SetFunctions.i],:alist] + alist := [[first v,:vectorRef($SetFunctions,i)],:alist] alist mkDomainCatName id == makeSymbol strconc(id,'";CAT") @@ -684,7 +687,7 @@ changeDirectoryInSlot1() == --called by buildFunctor COPY_-LIST $lisplibOperationAlist,function second) $lastPred: local := false $newEnv: local := $e - $domainShell.1 := [fn entry for entry in sortedOplist] where + vectorRef($domainShell,1) := [fn entry for entry in sortedOplist] where fn [[op,sig],pred,fnsel] == if $lastPred ~= pred then $newEnv := deepChaseInferences(pred,$e) diff --git a/src/interp/topics.boot b/src/interp/topics.boot index 5e9b04a6..ec4bf203 100644 --- a/src/interp/topics.boot +++ b/src/interp/topics.boot @@ -96,14 +96,14 @@ mkTopicHashTable() == --given $groupAssoc = ((extended . while blankLine? line repeat line := READLINE instream m := maxIndex line --file "topics.data" has form: m = -1 => 'skip --1 ConstructorName: - line.0 = char "-" => 'skip --2 constructorName or operation name + stringChar(line,0) = char "-" => 'skip --2 constructorName or operation name line := trimString line --3-n ... m := maxIndex line -- (blank line) ... - line.m ~= char ":" => systemError('"wrong heading") + stringChar(line,m) ~= char ":" => systemError('"wrong heading") con := makeSymbol subString(line,0,m) alist := [lst while not EOFP instream and not (blankLine? (line := READLINE instream)) and - line.0 ~= char "-" for i in 1.. + stringChar(line,0) ~= char "-" for i in 1.. | lst := string2OpAlist line] alist => HPUT($conTopicHash,con,alist) --initialize table of topic classes @@ -129,12 +129,12 @@ mkTopicHashTable() == --given $groupAssoc = ((extended . $conTopicHash --keys are ops or 'constructor', values are codes blankLine? line == - maxIndex line = -1 or and/[line . j = char " " for j in 0..maxIndex line] + #line = 0 or and/[stringChar(line,j) = char " " for j in 0..maxIndex line] string2OpAlist s == m := #s k := skipBlanks(s,0,m) or return nil - upperCase? s.k => nil --skip constructor names + upperCase? stringChar(s,k) => nil --skip constructor names k := 0 while (k := skipBlanks(s,k,m)) repeat acc := [makeSymbol subString(s,k,-k + (k := charPosition(char " ",s,k + 1))),:acc] @@ -145,8 +145,8 @@ string2OpAlist s == getDefaultProps name == u := HGET($defaultsHash,name) - if (s := PNAME name).(m := maxIndex s) = char "?" then u := ['p,:u] - if s.m = char "!" then u := ['destructive,:u] + if stringChar(s := symbolName name,m := maxIndex s) = char "?" then u := ['p,:u] + if stringChar(s,m) = char "!" then u := ['destructive,:u] u skipBlanks(u,i,m) == diff --git a/src/interp/word.boot b/src/interp/word.boot index f2bbed07..8d706adc 100644 --- a/src/interp/word.boot +++ b/src/interp/word.boot @@ -111,10 +111,10 @@ wordsOfString1(s,j) == k := or/[i for i in j..(maxIndex(s)-1) | isBreakCharacter stringChar(s,i)] => tailWords:= isBreakCharacter s.(k+1) => - n:= or/[i for i in (k+2)..(maxIndex(s)-1)|not isBreakCharacter s.i] + n:= or/[i for i in (k+2)..(maxIndex(s)-1)|not isBreakCharacter stringChar(s,i)] null n => [subString(s,k)] n > k+1 => [subString(s,k,n-k-1),:wordsOfString1(s,n-1)] - m := or/[i for i in (k+2)..(maxIndex(s)-1) | isBreakCharacter s.i] => + m := or/[i for i in (k+2)..(maxIndex(s)-1) | isBreakCharacter stringChar(s,i)] => [subString(s,k,m-k),:wordsOfString1(s,m)] [subString(s,k)] k > j+1 => [subString(s,j,k-j),:tailWords] @@ -368,7 +368,8 @@ patternTran pattern == maskConvert DOWNCASE pattern hasWildCard? str == - or/[str.i = '_? and (i=0 or not(str.(i-1) = '__ )) for i in 0..maxIndex str] + or/[stringChar(str,i) = char "?" and + (i=0 or stringChar(str,i-1) ~= char"__" ) for i in 0..maxIndex str] maskConvert str == --replace all ? not preceded by an underscore by & @@ -376,10 +377,10 @@ maskConvert str == j:= 0 --index into res final := maxIndex str for i in 0..final repeat - c := str.i + c := stringChar(str,i) if c = char "__" and i < final then i := i+1 - c := str.i + c := stringChar(str,i) else if c = char "?" then c := char "&" SUFFIX(c,buf) buf |