aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog32
-rw-r--r--src/interp/br-data.boot14
-rw-r--r--src/interp/br-op1.boot2
-rw-r--r--src/interp/cattable.boot26
-rw-r--r--src/interp/clam.boot12
-rw-r--r--src/interp/guess.boot7
-rw-r--r--src/interp/i-syscmd.boot2
-rw-r--r--src/interp/scan.boot9
-rw-r--r--src/interp/slam.boot2
-rw-r--r--src/interp/topics.boot18
-rw-r--r--src/interp/word.boot13
11 files changed, 81 insertions, 56 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index e3ec68bc..0a5660c7 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,37 @@
2011-09-30 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/br-data.boot (lefts): Iterate directly over table.
+ (mkUsersHashTable): Likewise.
+ (mkDependentsHashTable): Likewise.
+ (domainsOf): Likewise.
+ * interp/br-op1.boot (dbShowOpAllDomains): Likewise.
+ * interp/cattable.boot (showCategoryTable): Likewise.
+ (displayCategoryTable): Likewise.
+ (simpTempCategoryTable): Likewise.
+ (simpCategoryTable): Likewise.
+ (genTempCategoryTable): Likewise.
+ (compressHashTable): Likewise.
+ (updateCategoryTableForCategory): Likewise.
+ (clearTempCategoryTable): Likewise.
+ * interp/clam.boot (displayHashtable): Likewise.
+ (reportHashCacheStats): Likewise.
+ (reportInstantiations): Likewise.
+ (globalHashtableStats): Likewise.
+ * interp/guess.boot (buildWordTable): Likewise.
+ * interp/i-syscmd.boot (writify): Likewise.
+ * interp/scan.boot (scanDictCons): Likewise.
+ (scanPunCons): Likewise.
+ * interp/slam.boot (hashCount): Likewise.
+ * interp/topics.boot (mkTopicHashTable): Likewise.
+ (addTopic2Documentation): Likewise.
+ (topics): Likewise.
+ (listOfTopics): Likewise.
+ * interp/word.boot (buildWordTable): Likewise.
+ (writeFunctionTables): Likewise.
+ (bootSearch): Likewise.
+
+2011-09-30 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* boot/ast.boot (bfTableIteratorBindingForm): New.
(bfExpandTableIters): Use it.
* boot/initial-env.lisp (HKEYS): Remove.
diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot
index 0b71c730..5c9ba63b 100644
--- a/src/interp/br-data.boot
+++ b/src/interp/br-data.boot
@@ -36,7 +36,7 @@ import bc_-util
namespace BOOT
lefts u ==
- [x for x in HKEYS _*HASCATEGORY_-HASH_* | rest x = u]
+ [x for [x,:.] in entries _*HASCATEGORY_-HASH_* | rest x = u]
--============================================================================
-- Build Library Database (libdb.text,...)
@@ -418,8 +418,8 @@ mkUsersHashTable() == --called by buildDatabase (database.boot)
name := opOf conform
if not (name in '(QUOTE)) then
tableValue($usersTb,name) := insert(x,tableValue($usersTb,name))
- for k in HKEYS $usersTb repeat
- tableValue($usersTb,k) := listSort(function GLESSEQP,tableValue($usersTb,k))
+ for [k,:v] in entries $usersTb repeat
+ tableValue($usersTb,k) := listSort(function GLESSEQP,v)
for x in allConstructors() | isDefaultPackageName x repeat
tableValue($usersTb,x) := getDefaultPackageClients x
$usersTb
@@ -444,8 +444,8 @@ mkDependentsHashTable() == --called by buildDatabase (database.boot)
for nam in allConstructors() repeat
for con in getArgumentConstructors nam repeat
tableValue($depTb,con) := [nam,:tableValue($depTb,con)]
- for k in HKEYS $depTb repeat
- tableValue($depTb,k) := listSort(function GLESSEQP,tableValue($depTb,k))
+ for [k,:v] in entries $depTb repeat
+ tableValue($depTb,k) := listSort(function GLESSEQP,v)
$depTb
getArgumentConstructors con == --called by mkDependentsHashTable
@@ -594,7 +594,7 @@ childArgCheck(argl, nargl) ==
-- oldPred := tableValue(hash,form) => quickOr(oldPred,pred)
-- pred
-- tableValue(hash,form) := newPred
--- mySort [[key,:tableValue(hash,key)] for key in HKEYS hash]
+-- mySort [[key,:val] for [key,:val] in entries hash]
ancestorsOf(conform,domform) == --called by kcaPage, originsInOrder,...
"category" = getConstructorKindFromDB(conname := opOf conform) =>
@@ -649,7 +649,7 @@ ancestorsAdd(pred,form) == --called by ancestorsRecur
domainsOf(conform,domname,:options) ==
$hasArgList := IFCAR options
conname := opOf conform
- u := [key for key in HKEYS _*HASCATEGORY_-HASH_*
+ u := [key for [key,:.] in entries _*HASCATEGORY_-HASH_*
| key is [anc,: =conname]]
--u is list of pairs (a . b) where b() = conname
--we sort u then replace each b by the predicate for which this is true
diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot
index 0aab1e84..9ccfde7d 100644
--- a/src/interp/br-op1.boot
+++ b/src/interp/br-op1.boot
@@ -530,7 +530,7 @@ dbShowOpAllDomains(htPage,opAlist,which) ==
pred := simpOrDumb(predicate,LASSQ(conname,domOriginAlist) or true)
domOriginAlist := insertAlist(conname,pred,domOriginAlist)
--the following is similar to "domainsOf" but do not sort immediately
- u := [COPY key for key in HKEYS _*HASCATEGORY_-HASH_*
+ u := [COPY key for [key,:.] in entries _*HASCATEGORY_-HASH_*
| LASSQ(rest key,catOriginAlist)]
for pair in u repeat
[dom,:cat] := pair
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index 00505e8f..9a4e4d2d 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -43,17 +43,17 @@ hasCat(dom,cat) ==
or constructorHasCategoryFromDB [dom.op,:cat.op]
showCategoryTable con ==
- [[b,:val] for (key :=[a,:b]) in HKEYS _*HASCATEGORY_-HASH_*
- | symbolEq?(a,con) and (val := tableValue(_*HASCATEGORY_-HASH_*,key))]
+ [[b,:val] for [[a,:b],:val] in entries _*HASCATEGORY_-HASH_*
+ | symbolEq?(a,con) and val ~= nil]
displayCategoryTable(:options) ==
conList := IFCAR options
SETQ($ct,hashTable 'EQ)
- for (key:=[a,:b]) in HKEYS _*HASCATEGORY_-HASH_* repeat
- tableValue($ct,a) := [[b,:tableValue(_*HASCATEGORY_-HASH_*,key)],:tableValue($ct,a)]
- for id in HKEYS $ct | null conList or symbolMember?(id,conList) repeat
+ for [[a,:b],:val] in entries _*HASCATEGORY_-HASH_* repeat
+ tableValue($ct,a) := [[b,:val],:tableValue($ct,a)]
+ for [id,:val] in entries $ct | null conList or symbolMember?(id,conList) repeat
sayMSG [:bright id,'"extends:"]
- PRINT tableValue($ct,id)
+ PRINT val
genCategoryTable() ==
SETQ(_*ANCESTORS_-HASH_*, hashTable 'EQ)
@@ -75,14 +75,13 @@ genCategoryTable() ==
-- compressHashTable _*HASCATEGORY_-HASH_*
simpTempCategoryTable() ==
- for id in HKEYS _*ANCESTORS_-HASH_* repeat
+ for [id,:.] in entries _*ANCESTORS_-HASH_* repeat
for (u:=[a,:b]) in getConstructorAncestorsFromDB id repeat
u.rest := simpHasPred b
simpCategoryTable() == main where
main() ==
- for key in HKEYS _*HASCATEGORY_-HASH_* repeat
- entry := tableValue(_*HASCATEGORY_-HASH_*,key)
+ for [key,:entry] in entries _*HASCATEGORY_-HASH_* repeat
null entry => tableRemove!(_*HASCATEGORY_-HASH_*,key)
change :=
opOf entry isnt [.,:.] => simpHasPred entry
@@ -195,8 +194,7 @@ genTempCategoryTable() ==
for con in allConstructors() repeat
getConstructorKindFromDB con is "category" =>
addToCategoryTable con
- for id in HKEYS _*ANCESTORS_-HASH_* repeat
- item := tableValue(_*ANCESTORS_-HASH_*, id)
+ for [id,:item] in entries _*ANCESTORS_-HASH_* repeat
for (u:=[.,:b]) in item repeat
u.rest := simpCatPredicate simpBool b
tableValue(_*ANCESTORS_-HASH_*,id) := listSort(function GLESSEQP,item)
@@ -416,7 +414,7 @@ compressHashTable ht ==
-- compresses hash table ht, to give maximal sharing of cells
sayBrightlyNT '"compressing hash table..."
$found: local := hashTable 'EQUAL
- for x in HKEYS ht repeat compressSexpr(tableValue(ht,x),nil,nil)
+ for [x,:y] in entries ht repeat compressSexpr(y,nil,nil)
sayBrightly "done"
ht
@@ -466,7 +464,7 @@ updateCategoryTable(cname,kind) ==
updateCategoryTableForCategory(cname) ==
clearTempCategoryTable([[cname,'category]])
addToCategoryTable(cname)
- for id in HKEYS _*ANCESTORS_-HASH_* repeat
+ for [id,:.] in entries _*ANCESTORS_-HASH_* repeat
for (u:=[.,:b]) in getConstructorAncestorsFromDB id repeat
u.rest := simpCatPredicate simpBool b
@@ -486,7 +484,7 @@ clearCategoryTable1(key,val) ==
nil
clearTempCategoryTable(catNames) ==
- for key in HKEYS(_*ANCESTORS_-HASH_*) repeat
+ for [key,:.] in entries _*ANCESTORS_-HASH_* repeat
symbolMember?(key,catNames) => nil
extensions:= nil
for (extension:= [catForm,:.]) in getConstructorAncestorsFromDB key
diff --git a/src/interp/clam.boot b/src/interp/clam.boot
index 14a3d04b..3bde0e83 100644
--- a/src/interp/clam.boot
+++ b/src/interp/clam.boot
@@ -365,7 +365,7 @@ clearCategoryCache catName ==
symbolValue(mkCacheName catName) := nil
displayHashtable x ==
- l:= reverse! SORTBY('CAR,[[opOf tableValue(x,key),key] for key in HKEYS x])
+ l:= reverse! SORTBY('CAR,[[opOf val,key] for [key,:val] in entries x])
for [a,b] in l repeat
sayBrightlyNT ['"%b",a,'"%d"]
pp b
@@ -405,7 +405,7 @@ mkCircularCountAlist(cl,len) ==
reportHashCacheStats fn ==
infovec:= property(fn,'cacheInfo)
ht := eval infovec.cacheName
- hashValues:= [tableValue(ht,key) for key in HKEYS ht]
+ hashValues:= [val for [.,:val] in entries ht]
sayBrightly [:bright fn,'"has",:bright(# hashValues),'"values cached."]
displayCacheFrequency mkHashCountAlist hashValues
TERPRI()
@@ -568,8 +568,8 @@ recordInstantiation1(op,prop,dropIfTrue) ==
reportInstantiations() ==
--assumed to be a hashtable with reference counts
conList:=
- [:[[n,m,[key,:argList]] for [argList,n,:m] in tableValue($instantRecord,key)]
- for key in HKEYS $instantRecord]
+ [:[[n,m,[key,:argList]] for [argList,n,:m] in item]
+ for [key,:item] in entries $instantRecord]
sayBrightly ['"# instantiated/# dropped/domain name",
"%l",'"------------------------------------"]
nTotal:= mTotal:= rTotal := nForms:= 0
@@ -664,9 +664,7 @@ lassocShiftQ(x,l) ==
globalHashtableStats(x,sortFn) ==
--assumed to be a hashtable with reference counts
- keys:= HKEYS x
- for key in keys repeat
- u:= tableValue(x,key)
+ for [key,:u] in entries x repeat
for [argList,n,:.] in u repeat
not integer? n => keyedSystemError("S2GE0013",[x])
argList1:= [constructor2ConstructorForm x for x in argList]
diff --git a/src/interp/guess.boot b/src/interp/guess.boot
index d247f49c..c4956afc 100644
--- a/src/interp/guess.boot
+++ b/src/interp/guess.boot
@@ -47,15 +47,14 @@ buildWordTable u ==
words := wordsOfString s
key := charUpcase stringChar(s,0)
tableValue(table,key) := [[s,:words],:tableValue(table,key)]
- for key in HKEYS table repeat
+ for [key,:val] in entries table repeat
tableValue(table,key) :=
listSort(function GLESSEQP,removeDupOrderedAlist
- listSort(function GLESSEQP, tableValue(table,key),function first),
- function second)
+ listSort(function GLESSEQP,val,function first),function second)
table
measureWordTable u ==
- +/[+/[#entry for entry in tableValue(u,key)] for key in HKEYS u]
+ +/[+/[#entry for entry in item] for [key,:item] in entries u]
removeDupOrderedAlist u ==
-- removes duplicate entries in ordered alist
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index 9c12ef1f..9c5696af 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -1814,7 +1814,7 @@ writify ob ==
nob := ['WRITIFIED!!]
tableValue($seen, ob) := nob
tableValue($seen, nob) := nob
- keys := HKEYS ob
+ keys := [k for [k,:.] in entries ob]
nob.rest :=
['HASHTABLE,
HASHTABLE_-CLASS ob,
diff --git a/src/interp/scan.boot b/src/interp/scan.boot
index 23533311..331cac7a 100644
--- a/src/interp/scan.boot
+++ b/src/interp/scan.boot
@@ -183,7 +183,7 @@ scanDictCons()==
for i in 0..255 repeat
vectorRef(a,i) := b
a
- for s in HKEYS scanKeyTable repeat
+ for [s,:.] in entries scanKeyTable repeat
scanInsert(s,d)
d
@@ -191,13 +191,12 @@ scanDict:=scanDictCons()
scanPunCons()==
- listing := HKEYS scanKeyTable
a := makeBitVector 256
for i in 0..255 repeat
bitmask(a,i) := 0
- for k in listing repeat
- if not startsId? k.0
- then bitmask(a,codePoint stringChar(k,0)) := 1
+ for [k,:.] in entries scanKeyTable repeat
+ if not startsId? stringChar(k,0) then
+ bitmask(a,codePoint stringChar(k,0)) := 1
a
scanPun:=scanPunCons()
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index 6bc36443..7f11f33a 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -239,7 +239,7 @@ reportFunctionCacheAll(op,nam,argl,body) ==
nam
hashCount table ==
- +/[ADD1 nodeCount tableValue(table,key) for key in HKEYS table]
+ +/[ADD1 nodeCount val for [key,:val] in entries table]
mkCircularAlist n ==
l:= [[$failed,:$failed] for i in 1..n]
diff --git a/src/interp/topics.boot b/src/interp/topics.boot
index ef7313aa..31c4bfb2 100644
--- a/src/interp/topics.boot
+++ b/src/interp/topics.boot
@@ -113,9 +113,9 @@ mkTopicHashTable() == --given $groupAssoc = ((extended .
--replace each property list by a topic code
--store under each construct an OR of all codes
- for con in HKEYS $conTopicHash repeat
+ for [con,:item] in entries $conTopicHash repeat
conCode := 0
- for pair in tableValue($conTopicHash,con) repeat
+ for pair in item repeat
pair.rest := code := topicCode rest pair
conCode := LOGIOR(conCode,code)
tableValue($conTopicHash,con) :=
@@ -123,8 +123,8 @@ mkTopicHashTable() == --given $groupAssoc = ((extended .
SHUT instream
--reduce integers stored under names to 1 + its power of 2
- for key in HKEYS $topicHash repeat
- tableValue($topicHash,key) := INTEGER_-LENGTH tableValue($topicHash,key)
+ for [key,:item] in entries $topicHash repeat
+ tableValue($topicHash,key) := INTEGER_-LENGTH item
$conTopicHash --keys are ops or 'constructor', values are codes
@@ -189,7 +189,7 @@ addTopic2Documentation(con,docAlist) ==
--=======================================================================
td con ==
$topicClasses := ASSOCRIGHT mySort
- [[tableValue($topicHash,key),:key] for key in HKEYS $topicHash]
+ [[val,:key] for [key,:val] in entries $topicHash]
hash := hashTable 'EQ
tdAdd(con,hash)
tdPrint hash
@@ -212,13 +212,13 @@ tdPrint hash ==
topics con ==
--assumes that DOCUMENTATION property already has #s added
$topicClasses := ASSOCRIGHT mySort
- [[tableValue($topicHash,key),:key] for key in HKEYS $topicHash]
+ [[val,:key] for [key,:val] in entries $topicHash]
hash := hashTable 'EQ
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
- tableValue(hash,x) := mySort tableValue(hash,x)
+ for [x,:y] in entries hash repeat
+ tableValue(hash,x) := mySort y
tdPrint hash
code2Classes cc ==
@@ -257,5 +257,5 @@ listOfTopics(conname) ==
u := ASSOC('constructor,doc) or return nil
code := myLastAtom u
--not integer? code => nil
- mySort [key for key in HKEYS($topicHash) | LOGBITP(tableValue($topicHash,key),code)]
+ mySort [key for [key,:val] in entries $topicHash | LOGBITP(val,code)]
diff --git a/src/interp/word.boot b/src/interp/word.boot
index 304ad784..ac9132ed 100644
--- a/src/interp/word.boot
+++ b/src/interp/word.boot
@@ -44,11 +44,10 @@ buildWordTable u ==
for s in u repeat
key := charUpcase stringChar(s,0)
tableValue(table,key) := [[s,:wordsOfString s],:tableValue(table,key)]
- for key in HKEYS table repeat
+ for [key,:val] in entries table repeat
tableValue(table,key) :=
listSort(function GLESSEQP,removeDupOrderedAlist
- listSort(function GLESSEQP, tableValue(table,key),function first),
- function second)
+ listSort(function GLESSEQP,val,function first),function second)
table
writeFunctionTables(filemode) ==
@@ -66,8 +65,8 @@ writeFunctionTable(filemode,name,dicts) ==
stream:= writeLib1(name,'DATABASE,filemode)
if not $functionTable then
$functionTable:= buildFunctionTable dicts
- for key in HKEYS $functionTable repeat
- rwrite(object2Identifier key,tableValue($functionTable,key),stream)
+ for [key,:val] in entries $functionTable repeat
+ rwrite(object2Identifier key,val,stream)
RSHUT stream
'done
@@ -200,8 +199,8 @@ bootSearch word ==
pattern.0 ~= char "&" =>
[x for [x,:.] in tableValue($functionTable,UPCASE pattern.0)|
match?(pattern,COPY x)]
- "append"/[[x for [x,:.] in tableValue($functionTable,k)| match?(pattern,COPY x)]
- for k in HKEYS $functionTable]
+ "append"/[[x for [x,:.] in v | match?(pattern,COPY x)]
+ for [k,:v] in entries $functionTable]
findApproximateWords(PNAME word,$functionTable)
list
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 21:00:43 +0000