diff options
author | dos-reis <gdr@axiomatics.org> | 2011-05-05 15:40:21 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-05-05 15:40:21 +0000 |
commit | 104def0e400bbf3a0daed9e490e41485a9213c9d (patch) | |
tree | 048611db2122fb44a02ed8b4e55a70642e2a95ad /src/interp | |
parent | fb3bb6231462cddfb70301ea1672ebc04c8e829a (diff) | |
download | open-axiom-104def0e400bbf3a0daed9e490e41485a9213c9d.tar.gz |
more cleanup
Diffstat (limited to 'src/interp')
-rw-r--r-- | src/interp/as.boot | 24 | ||||
-rw-r--r-- | src/interp/br-con.boot | 4 | ||||
-rw-r--r-- | src/interp/br-data.boot | 22 | ||||
-rw-r--r-- | src/interp/br-op2.boot | 2 | ||||
-rw-r--r-- | src/interp/c-doc.boot | 8 | ||||
-rw-r--r-- | src/interp/cattable.boot | 18 | ||||
-rw-r--r-- | src/interp/clam.boot | 4 | ||||
-rw-r--r-- | src/interp/g-cndata.boot | 10 | ||||
-rw-r--r-- | src/interp/g-util.boot | 4 | ||||
-rw-r--r-- | src/interp/guess.boot | 8 | ||||
-rw-r--r-- | src/interp/htcheck.boot | 4 | ||||
-rw-r--r-- | src/interp/i-coerce.boot | 2 | ||||
-rw-r--r-- | src/interp/i-syscmd.boot | 52 | ||||
-rw-r--r-- | src/interp/interop.boot | 4 | ||||
-rw-r--r-- | src/interp/newfort.boot | 2 | ||||
-rw-r--r-- | src/interp/nruncomp.boot | 3 | ||||
-rw-r--r-- | src/interp/profile.boot | 2 | ||||
-rw-r--r-- | src/interp/scan.boot | 2 | ||||
-rw-r--r-- | src/interp/sys-utility.boot | 2 | ||||
-rw-r--r-- | src/interp/topics.boot | 20 | ||||
-rw-r--r-- | src/interp/word.boot | 10 |
21 files changed, 105 insertions, 102 deletions
diff --git a/src/interp/as.boot b/src/interp/as.boot index f691cfec..ec59982d 100644 --- a/src/interp/as.boot +++ b/src/interp/as.boot @@ -77,10 +77,10 @@ astran asyFile == --$childrenHash: local := MAKE_-HASH_-TABLE() for con in conlist repeat parents := asyParents con - HPUT($parentsHash,con,asyParents con) + tableValue($parentsHash,con) := asyParents con -- for [parent,:pred] in parents repeat -- parentOp := opOf parent --- HPUT($childrenHash,parentOp,insert([con,:pred],HGET($childrenHash,parentOp))) +-- tableValue($childrenHash,parentOp) := insert([con,:pred],HGET($childrenHash,parentOp)) $newConlist := union(conlist, $newConlist) [[x,:asMakeAlist x] for x in HKEYS $conHash] @@ -376,10 +376,10 @@ asyMakeOperationAlist(con,proplist, key) == [[sig],nil,true,'ASCONST] pred => [sig,nil,asyPredTran pred] [sig] - HPUT(ht,id,[entry,:HGET(ht,id)]) + tableValue(ht,id) := [entry,:HGET(ht,id)] opalist := [[op,:removeDuplicates HGET(ht,op)] for op in HKEYS ht] - --HPUT($opHash,con,[ancestorAlist,attributeAlist,:opalist]) - HPUT($opHash,con,[ancestorAlist,nil,:opalist]) + --tableValue($opHash,con) := [ancestorAlist,attributeAlist,:opalist] + tableValue($opHash,con) := [ancestorAlist,nil,:opalist] hackToRemoveAnd p == ---remove this as soon as .asy files do not contain forms (And pred) forms @@ -428,7 +428,7 @@ asytran fn == $docHashLocal: local := MAKE_-HASH_-TABLE() asytranDeclaration(d,'(top),nil,false) if null name then hohohoho() - HPUT($docHash,name,$docHashLocal) + tableValue($docHash,name) := $docHashLocal closeFile inStream 'done @@ -441,7 +441,7 @@ asytranDeclaration(dform,levels,predlist,local?) == id is 'failed => id KAR dform isnt 'Declare => systemError '"asytranDeclaration" if levels is '(top) then - if form isnt ['Apply,"->",:.] then HPUT($constantHash,id,true) + if form isnt ['Apply,"->",:.] then tableValue($constantHash,id) := true comments := symbolLassoc('documentation,r) or '"" idForm := levels is ['top,:.] => @@ -467,7 +467,7 @@ asytranDeclaration(dform,levels,predlist,local?) == ht := levels is '(top) => $conHash $docHashLocal - HPUT(ht,id,[record,:HGET(ht,id)]) + tableValue(ht,id) := [record,:HGET(ht,id)] if levels is '(top) then asyMakeOperationAlist(id,r, key) ['Declare,id,newsig,r] @@ -483,7 +483,7 @@ asyLooksLikeCatForm? x == -- idForm := -- form is ['Apply,'_-_>,source,target] => [id,:asyArgs source] -- id --- if form isnt ['Apply,"->",:.] then HPUT($constantHash,id,true) +-- if form isnt ['Apply,"->",:.] then tableValue($constantHash,id) := true -- comments := symbolLassoc('documentation,r) or '"" -- newsig := asytranForm(form,[idForm,:levels],local?) -- key := @@ -497,7 +497,7 @@ asyLooksLikeCatForm? x == -- ht := -- levels is '(top) => $conHash -- $docHashLocal --- HPUT(ht,id,[record,:HGET(ht,id)]) +-- tableValue(ht,id) := [record,:HGET(ht,id)] -- if levels is '(top) then asyMakeOperationAlist(id,r) -- ['Declare,id,newsig,r] @@ -607,7 +607,7 @@ asytranCategory(form,levels,predlist,local?) == dform := asytranCategoryItem(x,levels,predlist,local?) null dform => nil dform is ['Declare,id,record,r] => - HPUT(catTable,id,[asyWrap(record,predlist),:HGET(catTable,id)]) + tableValue(catTable,id) := [asyWrap(record,predlist),:HGET(catTable,id)] catList := [asyWrap(dform,predlist),:catList] keys := listSort(function GLESSEQP,HKEYS catTable) right1 := reverse! catList @@ -1098,7 +1098,7 @@ asyComma? op == op in '(Comma Multi) hput(table,name,value) == if null name then systemError() - HPUT(table,name,value) + tableValue(table,name) := value --============================================================================ -- category parts diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index 71bc7940..76f70ce1 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -845,7 +845,7 @@ dbDocTable conform == --process in reverse order so that closest cover up farthest for x in originsInOrder conform repeat dbAddDocTable x dbAddDocTable conform - HPUT($docTableHash,conform,$docTable) + tableValue($docTableHash,conform) := $docTable $docTable originsInOrder conform == --domain = nil or set to live domain @@ -869,7 +869,7 @@ dbAddDocTable conform == op = '(One) => 1 op for [sig,doc] in alist repeat - HPUT($docTable,op1,[[conform,:alist],:HGET($docTable,op1)]) + tableValue($docTable,op1) := [[conform,:alist],:HGET($docTable,op1)] --note opOf is needed!!! for some reason, One and Zero appear within prens dbGetDocTable(op,$sig,docTable,$which,aux) == main where diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index d6573a58..03d6096a 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -422,11 +422,11 @@ mkUsersHashTable() == --called by buildDatabase (database.boot) for conform in getImports x repeat name := opOf conform if not (name in '(QUOTE)) then - HPUT($usersTb,name,insert(x,HGET($usersTb,name))) + tableValue($usersTb,name) := insert(x,HGET($usersTb,name)) for k in HKEYS $usersTb repeat - HPUT($usersTb,k,listSort(function GLESSEQP,HGET($usersTb,k))) + tableValue($usersTb,k) := listSort(function GLESSEQP,HGET($usersTb,k)) for x in allConstructors() | isDefaultPackageName x repeat - HPUT($usersTb,x,getDefaultPackageClients x) + tableValue($usersTb,x) := getDefaultPackageClients x $usersTb getDefaultPackageClients con == --called by mkUsersHashTable @@ -448,9 +448,9 @@ mkDependentsHashTable() == --called by buildDatabase (database.boot) $depTb := MAKE_-HASH_-TABLE() for nam in allConstructors() repeat for con in getArgumentConstructors nam repeat - HPUT($depTb,con,[nam,:HGET($depTb,con)]) + tableValue($depTb,con) := [nam,:HGET($depTb,con)] for k in HKEYS $depTb repeat - HPUT($depTb,k,listSort(function GLESSEQP,HGET($depTb,k))) + tableValue($depTb,k) := listSort(function GLESSEQP,HGET($depTb,k)) $depTb getArgumentConstructors con == --called by mkDependentsHashTable @@ -517,7 +517,7 @@ parentsOf con == --called by kcpPage, ancestorsRecur $parentsCache := hashTable 'EQ HGET($parentsCache,con) or parents := getParentsForDomain con - HPUT($parentsCache,con,parents) + tableValue($parentsCache,con) := parents parents parentsOfForm [op,:argl] == @@ -594,12 +594,12 @@ childArgCheck(argl, nargl) == -- hash := hashTable 'EQUAL -- for [child,:pred] in childrenOf cat repeat -- childForm := getConstructorForm child --- HPUT(hash,childForm,pred) +-- tableValue(hash,childForm) := pred -- for [form,:pred] in descendantsOf(childForm,nil) repeat -- newPred := -- oldPred := HGET(hash,form) => quickOr(oldPred,pred) -- pred --- HPUT(hash,form,newPred) +-- tableValue(hash,form) := newPred -- mySort [[key,:HGET(hash,key)] for key in HKEYS hash] ancestorsOf(conform,domform) == --called by kcaPage, originsInOrder,... @@ -642,7 +642,7 @@ ancestorsRecur(conform,domform,pred,firstTime?) == --called by ancestorsOf newPred := quickAnd(pred,p) ancestorsAdd(simpHasPred newPred,newdomform or newform) ancestorsRecur(newform,newdomform,newPred,false) - HPUT($done,conform,pred) --mark as already processed + tableValue($done,conform) := pred --mark as already processed ancestorsAdd(pred,form) == --called by ancestorsRecur null pred => nil @@ -650,7 +650,7 @@ ancestorsAdd(pred,form) == --called by ancestorsRecur alist := HGET($if,op) existingNode := assoc(form,alist) => existingNode.rest := quickOr(rest existingNode,pred) - HPUT($if,op,[[form,:pred],:alist]) + tableValue($if,op) := [[form,:pred],:alist] domainsOf(conform,domname,:options) == $hasArgList := IFCAR options @@ -758,7 +758,7 @@ sublisFormal(args,exp,:options) == main where buildDefaultPackageNamesHT() == $defaultPackageNamesHT := MAKE_-HASH_-TABLE() for nam in allConstructors() | isDefaultPackageName nam repeat - HPUT($defaultPackageNamesHT,nam,true) + tableValue($defaultPackageNamesHT,nam) := true $defaultPackageNamesHT $defaultPackageNamesHT := buildDefaultPackageNamesHT() diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index 480ea00c..3fa171eb 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -462,7 +462,7 @@ koCatAttrsAdd(catform,pred) == if existingPred := LASSOC(argl,exists)_ then npred := quickOr(npred,existingPred) if not (name in '(nil nothing)) _ - then HPUT($if,name,[[argl,simpHasPred npred],:exists]) + then tableValue($if,name) := [[argl,simpHasPred npred],:exists] --======================================================================= -- Filter by Category diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index c124ff29..2a7bdf16 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -357,13 +357,13 @@ checkRecordHash u == and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then htname := intern IFCAR u entry := HGET($htHash,htname) or [nil] - HPUT($htHash,htname,[first entry,:[[$name,:$origin],:rest entry]]) + tableValue($htHash,htname) := [first entry,:[[$name,:$origin],:rest entry]] else if member(x,$HTlisplinks) and (u := checkLookForLeftBrace IFCDR u) and (u := checkLookForRightBrace IFCDR u) and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then htname := intern checkGetLispFunctionName checkGetStringBeforeRightBrace u entry := HGET($lispHash,htname) or [nil] - HPUT($lispHash,htname,[first entry,:[[$name,:$origin],:rest entry]]) + tableValue($lispHash,htname) := [first entry,:[[$name,:$origin],:rest entry]] else if ((p := member(x,'("\gloss" "\spadglos"))) or (q := member(x,'("\glossSee" "\spadglosSee")))) and (u := checkLookForLeftBrace IFCDR u) @@ -374,7 +374,7 @@ checkRecordHash u == u := IFCDR u htname := intern checkGetStringBeforeRightBrace u entry := HGET($glossHash,htname) or [nil] - HPUT($glossHash,htname,[first entry,:[[$name,:$origin],:rest entry]]) + tableValue($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 stringChar(s,0) = char ")" then s := subString(s,1) @@ -386,7 +386,7 @@ checkRecordHash u == not spadSysChoose($setOptions,arg) => checkDocError ['"Incorrect \spadsys: ",s] entry := HGET($sysHash,htname) or [nil] - HPUT($sysHash,htname,[first entry,:[[$name,:$origin],:rest entry]]) + tableValue($sysHash,htname) := [first entry,:[[$name,:$origin],:rest entry]] else if x is '"\spadtype" and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then s := checkGetStringBeforeRightBrace u parse := checkGetParse s diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index ca0272e1..e2597132 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -50,7 +50,7 @@ displayCategoryTable(:options) == conList := IFCAR options SETQ($ct,hashTable 'EQ) for (key:=[a,:b]) in HKEYS _*HASCATEGORY_-HASH_* repeat - HPUT($ct,a,[[b,:HGET(_*HASCATEGORY_-HASH_*,key)],:HGET($ct,a)]) + tableValue($ct,a) := [[b,:HGET(_*HASCATEGORY_-HASH_*,key)],:HGET($ct,a)] for id in HKEYS $ct | null conList or symbolMember?(id,conList) repeat sayMSG [:bright id,'"extends:"] PRINT HGET($ct,id) @@ -68,7 +68,7 @@ genCategoryTable() == for id in specialDs], :domainTable] for [id,:entry] in domainTable repeat for [a,:b] in encodeCategoryAlist(id,entry) repeat - HPUT(_*HASCATEGORY_-HASH_*,[id,:a],b) + tableValue(_*HASCATEGORY_-HASH_*,[id,:a]) := b simpTempCategoryTable() -- compressHashTable _*ANCESTORS_-HASH_* simpCategoryTable() @@ -87,7 +87,7 @@ simpCategoryTable() == main where change := atom opOf entry => simpHasPred entry [[x,:npred] for [x,:pred] in entry | npred := simpHasPred pred] - HPUT(_*HASCATEGORY_-HASH_*,key,change) + tableValue(_*HASCATEGORY_-HASH_*,key) := change simpHasPred(pred,:options) == main where main() == @@ -187,7 +187,7 @@ addDomainToTable(id,catl) == [id,:alist] domainHput(table,key:=[id,:a],b) == - HPUT(table,key,b) + tableValue(table,key) := b genTempCategoryTable() == --generates hashtable with key=categoryName and value of the form @@ -201,13 +201,13 @@ genTempCategoryTable() == item := HGET(_*ANCESTORS_-HASH_*, id) for (u:=[.,:b]) in item repeat u.rest := simpCatPredicate simpBool b - HPUT(_*ANCESTORS_-HASH_*,id,listSort(function GLESSEQP,item)) + tableValue(_*ANCESTORS_-HASH_*,id) := listSort(function GLESSEQP,item) addToCategoryTable con == -- adds an entry to $tempCategoryTable with key=con and alist entries u := CAAR getConstructorModemapFromDB con --domain alist := getCategoryExtensionAlist u - HPUT(_*ANCESTORS_-HASH_*,first u,alist) + tableValue(_*ANCESTORS_-HASH_*,first u) := alist alist encodeCategoryAlist(id,alist) == @@ -431,7 +431,7 @@ compressSexpr(x,left,right) == nil compressSexpr(first x,x,nil) compressSexpr(rest x,nil,x) - HPUT($found,x,x) + tableValue($found,x) := x squeezeList(l) == -- changes the list l, so that is has maximal sharing of cells @@ -477,7 +477,7 @@ updateCategoryTableForDomain(cname,category) == clearCategoryTable(cname) [cname,:domainEntry]:= addDomainToTable(cname,category) for [a,:b] in encodeCategoryAlist(cname,domainEntry) repeat - HPUT(_*HASCATEGORY_-HASH_*,[cname,:a],b) + tableValue(_*HASCATEGORY_-HASH_*,[cname,:a]) := b $doNotCompressHashTableIfTrue = true => _*HASCATEGORY_-HASH_* -- compressHashTable _*HASCATEGORY_-HASH_* @@ -496,4 +496,4 @@ clearTempCategoryTable(catNames) == repeat symbolMember?(first catForm,catNames) => nil extensions:= [extension,:extensions] - HPUT(_*ANCESTORS_-HASH_*,key,extensions) + tableValue(_*ANCESTORS_-HASH_*,key) := extensions diff --git a/src/interp/clam.boot b/src/interp/clam.boot index 994d882d..20fb3644 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -533,7 +533,7 @@ haddProp(ht,op,prop,val) == $op: local := op listTruncate(u,20) --save at most 20 instantiations val - HPUT(ht,op,[[prop,:val]]) + tableValue(ht,op) := [[prop,:val]] val recordInstantiation(op,prop,dropIfTrue) == @@ -567,7 +567,7 @@ recordInstantiation1(op,prop,dropIfTrue) == val := dropIfTrue => [0,:1] [1,:0] - HPUT($instantRecord,op,[[prop,:val]]) + tableValue($instantRecord,op) := [[prop,:val]] reportInstantiations() == --assumed to be a hashtable with reference counts diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot index ea0c974c..541aa188 100644 --- a/src/interp/g-cndata.boot +++ b/src/interp/g-cndata.boot @@ -51,9 +51,9 @@ mkLowerCaseConTable() == augmentLowerCaseConTable x == y:=getConstructorAbbreviationFromDB x item:=[x,y,nil] - HPUT($lowerCaseConTb,x,item) - HPUT($lowerCaseConTb,DOWNCASE x,item) - HPUT($lowerCaseConTb,y,item) + tableValue($lowerCaseConTb,x) := item + tableValue($lowerCaseConTb,DOWNCASE x) := item + tableValue($lowerCaseConTb,y) := item getCDTEntry(info,isName) == not IDENTP info => nil @@ -122,8 +122,8 @@ installConstructor(cname,type) == (entry := getCDTEntry(cname,true)) => entry item := [cname,getConstructorAbbreviationFromDB cname,nil] if $lowerCaseConTb then - HPUT($lowerCaseConTb,cname,item) - HPUT($lowerCaseConTb,DOWNCASE cname,item) + tableValue($lowerCaseConTb,cname) := item + tableValue($lowerCaseConTb,DOWNCASE cname) := item constructorNameConflict(name,kind) == userError diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index d2636c16..5c1d4605 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -198,12 +198,12 @@ ScanOrPairVec(f, ob) == ScanOrInner(f, ob) == HGET($seen, ob) => nil cons? ob => - HPUT($seen, ob, true) + tableValue($seen, ob) := true ScanOrInner(f, first ob) ScanOrInner(f, rest ob) nil vector? ob => - HPUT($seen, ob, true) + tableValue($seen, ob) := true for i in 0..#ob-1 repeat ScanOrInner(f, ob.i) nil FUNCALL(f, ob) => diff --git a/src/interp/guess.boot b/src/interp/guess.boot index c3bbc571..bf42c23e 100644 --- a/src/interp/guess.boot +++ b/src/interp/guess.boot @@ -46,12 +46,12 @@ buildWordTable u == for s in u repeat words := wordsOfString s key := charUpcase stringChar(s,0) - HPUT(table,key,[[s,:words],:HGET(table,key)]) + tableValue(table,key) := [[s,:words],:HGET(table,key)] for key in HKEYS table repeat - HPUT(table,key, + tableValue(table,key) := listSort(function GLESSEQP,removeDupOrderedAlist listSort(function GLESSEQP, HGET(table,key),function first), - function second)) + function second) table measureWordTable u == @@ -97,7 +97,7 @@ add2WordFunctionTable fn == --called from DEF $functionTable and null LASSOC(s := PNAME fn,HGET($functionTable,(key := UPCASE s.0))) => - HPUT($functionTable,key,[[s,:wordsOfString s],:HGET($functionTable,key)]) + tableValue($functionTable,key) := [[s,:wordsOfString s],:HGET($functionTable,key)] --======================================================================= -- Guess Function Name diff --git a/src/interp/htcheck.boot b/src/interp/htcheck.boot index d416508a..36fc0b40 100644 --- a/src/interp/htcheck.boot +++ b/src/interp/htcheck.boot @@ -91,8 +91,8 @@ buildHtMacroTable() == while not EOFP instream repeat line := READLINE instream getHtMacroItem line is [string,:numOfArgs] => - HPUT($htMacroTable,string,numOfArgs) - for [s,:n] in $primitiveHtCommands repeat HPUT($htMacroTable,s,n) + tableValue($htMacroTable,string) := numOfArgs + for [s,:n] in $primitiveHtCommands repeat tableValue($htMacroTable,s) := n else sayBrightly '"Warning: macro table not found" $htMacroTable diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot index 6d4c84fe..60d86a4e 100644 --- a/src/interp/i-coerce.boot +++ b/src/interp/i-coerce.boot @@ -930,7 +930,7 @@ getSubDomainPredicate(tSuper, tSub, pred) == arg := gensym() [predfn] := compileInteractive [gensym(),['LAM,[arg],substitute(arg,"#1", pred)]] - HPUT($superHash, [tSuper,:tSub], predfn) + tableValue($superHash, [tSuper,:tSub]) := predfn predfn coerceIntX(val,t1, t2) == diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index d7e243f2..b283da6d 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -2019,14 +2019,14 @@ writify ob == (name := spadClosure? ob) => d := writifyInner rest ob nob := ['WRITIFIED!!, 'SPADCLOSURE, d, name] - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) + tableValue($seen, ob) := nob + tableValue($seen, nob) := nob nob (ob is ['LAMBDA_-CLOSURE, ., ., x, :.]) and x => THROW('writifyTag, 'writifyFailed) nob := [qcar,:qcdr] - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) + tableValue($seen, ob) := nob + tableValue($seen, nob) := nob qcar := writifyInner qcar qcdr := writifyInner qcdr nob.first := qcar @@ -2036,13 +2036,13 @@ writify ob == isDomainOrPackage ob => d := mkEvalable devaluate ob nob := ['WRITIFIED!!, 'DEVALUATED, writifyInner d] - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) + tableValue($seen, ob) := nob + tableValue($seen, nob) := nob nob n := maxIndex ob nob := newVector(n+1) - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) + tableValue($seen, ob) := nob + tableValue($seen, nob) := nob for i in 0..n repeat vectorRef(nob, i) := writifyInner vectorRef(ob,i) nob @@ -2055,8 +2055,8 @@ writify ob == THROW('writifyTag, 'writifyFailed) HASHTABLEP ob => nob := ['WRITIFIED!!] - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) + tableValue($seen, ob) := nob + tableValue($seen, nob) := nob keys := HKEYS ob nob.rest := ['HASHTABLE, @@ -2066,8 +2066,8 @@ writify ob == nob PLACEP ob => nob := ['WRITIFIED!!, 'PLACE] - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) + tableValue($seen, ob) := nob + tableValue($seen, nob) := nob nob -- The next three types cause an error on de-writifying. -- Create an object of the right shape, nonetheless. @@ -2133,19 +2133,19 @@ dewritify ob == error '"A required BPI does not exist." #ob > 3 and HASHEQ f ~= ob.3 => error '"A required BPI has been redefined." - HPUT($seen, ob, f) + tableValue($seen, ob) := f f type = 'HASHTABLE => nob := hashTable ob.2 - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) + tableValue($seen, ob) := nob + tableValue($seen, nob) := nob for k in ob.3 for e in ob.4 repeat - HPUT(nob, dewritifyInner k, dewritifyInner e) + tableValue(nob, dewritifyInner k) := dewritifyInner e nob type = 'DEVALUATED => nob := eval dewritifyInner ob.2 - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) + tableValue($seen, ob) := nob + tableValue($seen, nob) := nob nob type = 'SPADCLOSURE => vec := dewritifyInner ob.2 @@ -2153,13 +2153,13 @@ dewritify ob == not FBOUNDP name => error strconc('"undefined function: ", symbolName name) nob := [symbolFunction name,:vec] - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) + tableValue($seen, ob) := nob + tableValue($seen, nob) := nob nob type = 'PLACE => nob := VMREAD MAKE_-INSTREAM nil - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) + tableValue($seen, ob) := nob + tableValue($seen, nob) := nob nob type = 'READTABLE => error '"Cannot de-writify a read table." @@ -2176,16 +2176,16 @@ dewritify ob == qcar := first ob qcdr := rest ob nob := [qcar,:qcdr] - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) + tableValue($seen, ob) := nob + tableValue($seen, nob) := nob nob.first := dewritifyInner qcar nob.rest := dewritifyInner qcdr nob vector? ob => n := maxIndex ob nob := newVector(n+1) - HPUT($seen, ob, nob) - HPUT($seen, nob, nob) + tableValue($seen, ob) := nob + tableValue($seen, nob) := nob for i in 0..n repeat vectorRef(nob,i) := dewritifyInner vectorRef(ob,i) nob diff --git a/src/interp/interop.boot b/src/interp/interop.boot index 847edadd..383ad048 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -275,9 +275,9 @@ depthAssoc x == y := HGET($depthAssocCache,x) => y x is ['Join,:u] or (u := getCatAncestors x) => v := depthAssocList u - HPUT($depthAssocCache,x,[[x,:n],:v]) + tableValue($depthAssocCache,x) := [[x,:n],:v] where n() == 1 + "MAX"/[rest y for y in v] - HPUT($depthAssocCache,x,[[x,:0]]) + tableValue($depthAssocCache,x) := [[x,:0]] getCatAncestors x == [CAAR y for y in parentsOf opOf x] diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot index 7aba6f9e..276c3616 100644 --- a/src/interp/newfort.boot +++ b/src/interp/newfort.boot @@ -246,7 +246,7 @@ exp2FortOptimizeCS1 e == n := HGET($fortCsHash,e) null n => n := VECTOR(1,nil,$fortCsExprStack,$fortCsFuncStack) - HPUT($fortCsHash,e,n) + tableValue($fortCsHash,e) := n e beenHere(e,n) diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 7b9a7efe..51682508 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -734,7 +734,8 @@ NRTsubstDelta(initSig) == -----------------------------SLOT1 DATABASE------------------------------------ -updateSlot1DataBase [name,info] == HPUT($Slot1DataBase,name,info) +updateSlot1DataBase [name,info] == + tableValue($Slot1DataBase,name) := info NRTputInLocalReferences bod == NRTputInHead bod diff --git a/src/interp/profile.boot b/src/interp/profile.boot index 7c1a8a9b..f59297f0 100644 --- a/src/interp/profile.boot +++ b/src/interp/profile.boot @@ -49,7 +49,7 @@ profileTran alist == for [opSig,:info] in alist repeat op := opOf opSig sig := KAR KDR opSig - HPUT($profileHash,op,[[sig,:info],:HGET($profileHash,op)]) + tableValue($profileHash,op) := [[sig,:info],:HGET($profileHash,op)] [[key,:HGET($profileHash,key)] for key in mySort HKEYS $profileHash] profileRecord(label,name,info) == --name: info is var: type or op: sig diff --git a/src/interp/scan.boot b/src/interp/scan.boot index 64b8c4af..8afc4ba6 100644 --- a/src/interp/scan.boot +++ b/src/interp/scan.boot @@ -152,7 +152,7 @@ scanKeyWords == [ _ scanKeyTableCons()== KeyTable := hashTable 'EQUAL for st in scanKeyWords repeat - HPUT(KeyTable,first st,second st) + tableValue(KeyTable,first st) := second st KeyTable scanKeyTable:=scanKeyTableCons() diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index 88c6ac6a..60660ae1 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -294,7 +294,7 @@ minimalise x == hashCheck(x,ht) == y := HGET(ht,x) y => y - HPUT(ht,x,x) + tableValue(ht,x) := x x --% File IO diff --git a/src/interp/topics.boot b/src/interp/topics.boot index 7cc8356d..fbd61ffc 100644 --- a/src/interp/topics.boot +++ b/src/interp/topics.boot @@ -88,7 +88,7 @@ mkTopicHashTable() == --given $groupAssoc = ((extended . $defaultsHash := hashTable 'EQ --keys are ops, value is list of topic names for [kind,:items] in $topicsDefaults repeat --$topicsDefaults is ((<topic> op ...) ..) for item in items repeat - HPUT($defaultsHash,item,[kind,:HGET($defaultsHash,item)]) + tableValue($defaultsHash,item) := [kind,:HGET($defaultsHash,item)] $conTopicHash := hashTable 'EQL --key is constructor name; value is instream := inputTextFile '"topics.data" while not EOFP instream repeat @@ -105,10 +105,10 @@ mkTopicHashTable() == --given $groupAssoc = ((extended . not (blankLine? (line := READLINE instream)) and stringChar(line,0) ~= char "-" for i in 1.. | lst := string2OpAlist line] - alist => HPUT($conTopicHash,con,alist) + alist => tableValue($conTopicHash,con) := alist --initialize table of topic classes $topicHash := hashTable 'EQ --$topicHash has keys: topic and value: index - for [x,:c] in $groupAssoc repeat HPUT($topicHash,x,c) + for [x,:c] in $groupAssoc repeat tableValue($topicHash,x) := c $topicIndex := rest last $groupAssoc --replace each property list by a topic code @@ -118,13 +118,13 @@ mkTopicHashTable() == --given $groupAssoc = ((extended . for pair in HGET($conTopicHash,con) repeat pair.rest := code := topicCode rest pair conCode := LOGIOR(conCode,code) - HPUT($conTopicHash,con, - [['constructor,:conCode],:HGET($conTopicHash,con)]) + tableValue($conTopicHash,con) := + [['constructor,:conCode],:HGET($conTopicHash,con)] SHUT instream --reduce integers stored under names to 1 + its power of 2 for key in HKEYS $topicHash repeat - HPUT($topicHash,key,INTEGER_-LENGTH HGET($topicHash,key)) + tableValue($topicHash,key) := INTEGER_-LENGTH HGET($topicHash,key) $conTopicHash --keys are ops or 'constructor', values are codes @@ -166,7 +166,7 @@ topicCode lst == for x in removeDuplicates u repeat bitIndexList := [fn x,:bitIndexList] where fn x == k := HGET($topicHash,x) => k - HPUT($topicHash,x,$topicIndex := $topicIndex * 2) + tableValue($topicHash,x) := $topicIndex := $topicIndex * 2 $topicIndex code := +/[i for i in bitIndexList] @@ -199,7 +199,8 @@ tdAdd(con,hash) == u := addTopic2Documentation(con,v) --u := getConstructorDocumentationFromDB con for pair in u | integer? (code := myLastAtom pair) and (op := first pair) ~= 'construct repeat - for x in (names := code2Classes code) repeat HPUT(hash,x,insert(op,HGET(hash,x))) + for x in (names := code2Classes code) repeat + tableValue(hash,x) := insert(op,HGET(hash,x)) tdPrint hash == for key in mySort HKEYS hash repeat @@ -216,7 +217,8 @@ topics con == tdAdd(con,hash) for x in removeDuplicates [CAAR y for y in ancestorsOf(getConstructorForm con,nil)] repeat tdAdd(x,hash) - for x in HKEYS hash repeat HPUT(hash,x,mySort HGET(hash,x)) + for x in HKEYS hash repeat + tableValue(hash,x) := mySort HGET(hash,x) tdPrint hash code2Classes cc == diff --git a/src/interp/word.boot b/src/interp/word.boot index 249ccda2..576e3035 100644 --- a/src/interp/word.boot +++ b/src/interp/word.boot @@ -43,12 +43,12 @@ buildWordTable u == table:= hashTable 'EQ for s in u repeat key := charUpcase stringChar(s,0) - HPUT(table,key,[[s,:wordsOfString s],:HGET(table,key)]) + tableValue(table,key) := [[s,:wordsOfString s],:HGET(table,key)] for key in HKEYS table repeat - HPUT(table,key, + tableValue(table,key) := listSort(function GLESSEQP,removeDupOrderedAlist listSort(function GLESSEQP, HGET(table,key),function first), - function second)) + function second) table writeFunctionTables(filemode) == @@ -80,7 +80,7 @@ readFunctionTable() == stream:= readLib(name,'DATABASE) table:= hashTable 'EQ for key in RKEYIDS makePathname(name,'DATABASE,"*") repeat - HPUT(table,kk:=object2Identifier key, rread(kk,stream,nil)) + tableValue(table,kk:=object2Identifier key) := rread(kk,stream,nil) RSHUT stream table @@ -133,7 +133,7 @@ add2WordFunctionTable fn == --called from DEF $functionTable and null LASSOC(s := PNAME fn,HGET($functionTable,(key := UPCASE s.0))) => - HPUT($functionTable,key,[[s,:wordsOfString s],:HGET($functionTable,key)]) + tableValue($functionTable,key) := [[s,:wordsOfString s],:HGET($functionTable,key)] --======================================================================= -- Guess Function Name |