aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/boot/strap/tokens.clisp3
-rw-r--r--src/boot/strap/translator.clisp12
-rw-r--r--src/boot/tokens.boot2
-rw-r--r--src/boot/translator.boot10
-rw-r--r--src/interp/as.boot24
-rw-r--r--src/interp/br-con.boot4
-rw-r--r--src/interp/br-data.boot22
-rw-r--r--src/interp/br-op2.boot2
-rw-r--r--src/interp/c-doc.boot8
-rw-r--r--src/interp/cattable.boot18
-rw-r--r--src/interp/clam.boot4
-rw-r--r--src/interp/g-cndata.boot10
-rw-r--r--src/interp/g-util.boot4
-rw-r--r--src/interp/guess.boot8
-rw-r--r--src/interp/htcheck.boot4
-rw-r--r--src/interp/i-coerce.boot2
-rw-r--r--src/interp/i-syscmd.boot52
-rw-r--r--src/interp/interop.boot4
-rw-r--r--src/interp/newfort.boot2
-rw-r--r--src/interp/nruncomp.boot3
-rw-r--r--src/interp/profile.boot2
-rw-r--r--src/interp/scan.boot2
-rw-r--r--src/interp/sys-utility.boot2
-rw-r--r--src/interp/topics.boot20
-rw-r--r--src/interp/word.boot10
-rw-r--r--src/lisp/core.lisp.in7
26 files changed, 126 insertions, 115 deletions
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 0207ed51..2891cea0 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -65,7 +65,8 @@
((OR (ATOM |bfVar#2|)
(PROGN (SETQ |st| (CAR |bfVar#2|)) NIL))
(RETURN NIL))
- (T (HPUT |KeyTable| (CAR |st|) (CADR |st|))))
+ (T (SETF (|tableValue| |KeyTable| (CAR |st|))
+ (CADR |st|))))
(SETQ |bfVar#2| (CDR |bfVar#2|))))
|KeyTable|))))
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 7c48e9fe..0d3d6a67 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -844,7 +844,7 @@
((NULL |a|) (|shoeNotFound| |fn|))
(T (SETQ |$lispWordTable| (MAKE-HASHTABLE 'EQ))
(DO-SYMBOLS (|i| (FIND-PACKAGE 'LISP))
- (HPUT |$lispWordTable| |i| T))
+ (SETF (|tableValue| |$lispWordTable| |i|) T))
(SETQ |$bootDefined| (MAKE-HASHTABLE 'EQ))
(SETQ |$bootUsed| (MAKE-HASHTABLE 'EQ))
(SETQ |$bootDefinedTwice| NIL) (SETQ |$GenVarCounter| 0)
@@ -1004,7 +1004,7 @@
(COND
((EQ |nee| 'TOP-LEVEL) |$bootDefinedTwice|)
(T (CONS |nee| |$bootDefinedTwice|)))))
- (T (HPUT |$bootDefined| |nee| T)))
+ (T (SETF (|tableValue| |$bootDefined| |nee|) T)))
(|defuse1| |e| |niens|)
(LET ((|bfVar#28| |$used|) (|i| NIL))
(LOOP
@@ -1012,8 +1012,8 @@
((OR (ATOM |bfVar#28|)
(PROGN (SETQ |i| (CAR |bfVar#28|)) NIL))
(RETURN NIL))
- (T (HPUT |$bootUsed| |i|
- (CONS |nee| (GETHASH |i| |$bootUsed|)))))
+ (T (SETF (|tableValue| |$bootUsed| |i|)
+ (CONS |nee| (|tableValue| |$bootUsed| |i|)))))
(SETQ |bfVar#28| (CDR |bfVar#28|))))))))
(DEFUN |defuse1| (|e| |y|)
@@ -1056,7 +1056,7 @@
((OR (ATOM |bfVar#29|)
(PROGN (SETQ |i| (CAR |bfVar#29|)) NIL))
(RETURN NIL))
- (T (HPUT |$bootDefined| |i| T)))
+ (T (SETF (|tableValue| |$bootDefined| |i|) T)))
(SETQ |bfVar#29| (CDR |bfVar#29|))))
(|defuse1| (|append| |ndol| |e|) |b|))
((AND (CONSP |y|) (EQ (CAR |y|) 'QUOTE)) (SETQ |a| (CDR |y|))
@@ -1146,7 +1146,7 @@
((NULL |a|) (|shoeNotFound| |fn|))
(T (SETQ |$lispWordTable| (MAKE-HASHTABLE 'EQ))
(DO-SYMBOLS (|i| (FIND-PACKAGE 'LISP))
- (HPUT |$lispWordTable| |i| T))
+ (SETF (|tableValue| |$lispWordTable| |i|) T))
(SETQ |$bootDefined| (MAKE-HASHTABLE 'EQ))
(SETQ |$bootUsed| (MAKE-HASHTABLE 'EQ))
(SETQ |$GenVarCounter| 0) (SETQ |$bfClamming| NIL)
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index 0b4946d5..f0dbe004 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -130,7 +130,7 @@ shoeKeyWords == [ _
shoeKeyTableCons()==
KeyTable:=MAKE_-HASHTABLE("CVEC")
for st in shoeKeyWords repeat
- HPUT(KeyTable,first st,second st)
+ tableValue(KeyTable,first st) := second st
KeyTable
shoeKeyTable:=shoeKeyTableCons()
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index d52ead6c..d258a78d 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -526,7 +526,7 @@ $lispWordTable := nil
shoeDfu(a,fn)==
a=nil => shoeNotFound fn
$lispWordTable: local := MAKE_-HASHTABLE ("EQ")
- DO_-SYMBOLS(i(FIND_-PACKAGE "LISP"),HPUT($lispWordTable,i,true))
+ DO_-SYMBOLS(i(FIND_-PACKAGE "LISP"),tableValue($lispWordTable,i) := true)
$bootDefined: local :=MAKE_-HASHTABLE "EQ"
$bootUsed:local := MAKE_-HASHTABLE "EQ"
$bootDefinedTwice: local := nil
@@ -572,10 +572,10 @@ defuse(e,x)==
$bootDefinedTwice:=
nee="TOP-LEVEL"=> $bootDefinedTwice
[nee,:$bootDefinedTwice]
- else HPUT($bootDefined,nee,true)
+ else tableValue($bootDefined,nee) := true
defuse1 (e,niens)
for i in $used repeat
- HPUT($bootUsed,i,[nee,:GETHASH(i,$bootUsed)])
+ tableValue($bootUsed,i) := [nee,:tableValue($bootUsed,i)]
defuse1(e,y)==
atom y =>
@@ -590,7 +590,7 @@ defuse1(e,y)==
y is ["PROG",a,:b]=>
[dol,ndol]:=defSeparate a
for i in dol repeat
- HPUT($bootDefined,i,true)
+ tableValue($bootDefined,i) := true
defuse1 (append(ndol,e),b)
y is ["QUOTE",:a] => []
y is ["+LINE",:a] => []
@@ -643,7 +643,7 @@ XREF fn==
shoeXref(a,fn)==
a = nil => shoeNotFound fn
$lispWordTable: local := MAKE_-HASHTABLE ("EQ")
- DO_-SYMBOLS(i(FIND_-PACKAGE "LISP"),HPUT($lispWordTable,i,true))
+ DO_-SYMBOLS(i(FIND_-PACKAGE "LISP"),tableValue($lispWordTable,i) := true)
$bootDefined: local := MAKE_-HASHTABLE "EQ"
$bootUsed: local := MAKE_-HASHTABLE "EQ"
$GenVarCounter: local := 0
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
diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in
index d4bf2df8..6e56a993 100644
--- a/src/lisp/core.lisp.in
+++ b/src/lisp/core.lisp.in
@@ -82,6 +82,9 @@
"%BitVector"
"%SimpleArray"
+ ;; Some common data structures
+ "tableValue" ; value associated with a key in a table
+
;; IO
"$InputStream"
"$OutputStream"
@@ -448,6 +451,10 @@
(cond (ver (symbol-value ver))
(t -1))))
+;; -*- Hash table -*-
+(defmacro |tableValue| (ht k)
+ `(gethash ,k ,ht))
+
;; -*- File IO -*-
(defparameter |$InputStream| (make-synonym-stream '*standard-input*))
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-26 03:21:19 +0000