diff options
| author | dos-reis <gdr@axiomatics.org> | 2010-05-13 14:47:31 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2010-05-13 14:47:31 +0000 |
| commit | 8f2bad3b8cea97189a9e842ed0f78559aa4be795 (patch) | |
| tree | f355c7ba0711e9cf0e243eecb0be62faf1468347 | |
| parent | 348cdc0022cf9aaf0fc5491ed8d899a7284e07ec (diff) | |
| download | open-axiom-8f2bad3b8cea97189a9e842ed0f78559aa4be795.tar.gz | |
* interp/sys-utility.boot (hashTable): Define.
* interp/word.boot: Use it.
* interp/topics.boot: Likewise.
* interp/sys-driver.boot: Likewise.
* interp/slam.boot: Likewise.
* interp/setvars.boot: Likewise.
* interp/scan.boot: Likewise.
* interp/nrunopt.boot: Likewise.
* interp/nruncomp.boot: Likewise.
* interp/newfort.boot: Likewise.
* interp/mark.boot: Likewise.
* interp/interop.boot: Likewise.
* interp/i-toplev.boot: Likewise.
* interp/i-syscmd.boot: Likewise.
* interp/htcheck.boot: Likewise.
* interp/guess.boot: Likewise.
* interp/g-util.boot: Likewise.
* interp/database.boot: Likewise.
* interp/compress.boot: Likewise.
* interp/clam.boot: Likewise.
* interp/cattable.boot: Likewise.
* interp/c-util.boot: Likewise.
* interp/br-op2.boot: Likewise.
* interp/br-op1.boot: Likewise.
* interp/br-con.boot: Likewise.
* interp/sys-globals.boot ($ConstructorCache): Move elsewhere.
($instantRecord): Likewise.
* algebra/newdata.spad.pamphlet: Use EQUAL as equality function
for hash table.
* algebra/table.spad.pamphlet: Call hashTable builtin function
instead of MAKE-HASHTABLE.
33 files changed, 105 insertions, 59 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 91b45cfc..0b125d03 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,37 @@ +2010-05-13 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/sys-utility.boot (hashTable): Define. + * interp/word.boot: Use it. + * interp/topics.boot: Likewise. + * interp/sys-driver.boot: Likewise. + * interp/slam.boot: Likewise. + * interp/setvars.boot: Likewise. + * interp/scan.boot: Likewise. + * interp/nrunopt.boot: Likewise. + * interp/nruncomp.boot: Likewise. + * interp/newfort.boot: Likewise. + * interp/mark.boot: Likewise. + * interp/interop.boot: Likewise. + * interp/i-toplev.boot: Likewise. + * interp/i-syscmd.boot: Likewise. + * interp/htcheck.boot: Likewise. + * interp/guess.boot: Likewise. + * interp/g-util.boot: Likewise. + * interp/database.boot: Likewise. + * interp/compress.boot: Likewise. + * interp/clam.boot: Likewise. + * interp/cattable.boot: Likewise. + * interp/c-util.boot: Likewise. + * interp/br-op2.boot: Likewise. + * interp/br-op1.boot: Likewise. + * interp/br-con.boot: Likewise. + * interp/sys-globals.boot ($ConstructorCache): Move elsewhere. + ($instantRecord): Likewise. + * algebra/newdata.spad.pamphlet: Use EQUAL as equality function + for hash table. + * algebra/table.spad.pamphlet: Call hashTable builtin function + instead of MAKE-HASHTABLE. + 2010-05-11 Gabriel Dos Reis <gdr@cs.tamu.edu> Add support for interpreter-style anonymous function. diff --git a/src/algebra/newdata.spad.pamphlet b/src/algebra/newdata.spad.pamphlet index 78e3bf36..071fc497 100644 --- a/src/algebra/newdata.spad.pamphlet +++ b/src/algebra/newdata.spad.pamphlet @@ -62,7 +62,7 @@ TabulatedComputationPackage(Key ,Entry): Exports == Implementation where Key: SetCategory Entry: SetCategory N ==> NonNegativeInteger - H ==> HashTable(Key, Entry, "UEQUAL") + H ==> HashTable(Key, Entry, "EQUAL") iprintpack ==> InternalPrintPackage() Exports == with diff --git a/src/algebra/table.spad.pamphlet b/src/algebra/table.spad.pamphlet index b6347545..d69d72c2 100644 --- a/src/algebra/table.spad.pamphlet +++ b/src/algebra/table.spad.pamphlet @@ -29,7 +29,7 @@ HashTable(Key, Entry, hashfn): Exports == Implementation where Key, Entry: SetCategory - hashfn: String -- Union("EQ", "UEQUAL", "CVEC", "ID") + hashfn: String -- Union("EQ", "EQL", "EQUAL", "UEQUAL", "CVEC", "ID") Exports ==> TableAggregate(Key, Entry) with finiteAggregate @@ -51,8 +51,7 @@ HashTable(Key, Entry, hashfn): Exports == Implementation where "failed" empty() == - MAKE_-HASHTABLE(INTERN(hashfn)$Lisp, - INTERN("STRONG")$Lisp)$Lisp + hashTable(INTERN(hashfn)$Lisp)$Lisp search(k:Key, t:%) == r := HGET(t, k, failMsg)$Lisp @@ -110,7 +109,7 @@ Table(Key: SetCategory, Entry: SetCategory):Exports == Implementation where finiteAggregate Implementation ==> InnerTable(Key, Entry, - if hashable(Key)$Lisp then HashTable(Key, Entry, "UEQUAL") + if hashable(Key)$Lisp then HashTable(Key, Entry, "EQUAL") else AssociationList(Key, Entry)) @ @@ -152,7 +151,7 @@ EqTable(Key: SetCategory, Entry: SetCategory) == ++ This domain provides tables where the keys are strings. ++ A specialized hash function for strings is used. StringTable(Entry: SetCategory) == - HashTable(String, Entry, "CVEC") + HashTable(String, Entry, "EQUAL") @ \section{domain GSTBL GeneralSparseTable} diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index c5200ddc..30962fc2 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -370,7 +370,7 @@ cparse.$(FASLEXT): ptrees.$(FASLEXT) macex.$(FASLEXT): ptrees.$(FASLEXT) ptrees.$(FASLEXT): posit.$(FASLEXT) serror.$(FASLEXT) pile.$(FASLEXT): scan.$(FASLEXT) -scan.$(FASLEXT): incl.$(FASLEXT) bits.$(FASLEXT) dq.$(FASLEXT) +scan.$(FASLEXT): incl.$(FASLEXT) bits.$(FASLEXT) dq.$(FASLEXT) sys-utility.$(FASLEXT) incl.$(FASLEXT): cstream.$(FASLEXT) cformat.$(FASLEXT) cformat.$(FASLEXT): unlisp.$(FASLEXT) posit.$(FASLEXT) serror.$(FASLEXT): posit.$(FASLEXT) diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 90d9aa85..b07194c3 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -619,7 +619,7 @@ cparse.$(FASLEXT): ptrees.$(FASLEXT) macex.$(FASLEXT): ptrees.$(FASLEXT) ptrees.$(FASLEXT): posit.$(FASLEXT) serror.$(FASLEXT) pile.$(FASLEXT): scan.$(FASLEXT) -scan.$(FASLEXT): incl.$(FASLEXT) bits.$(FASLEXT) dq.$(FASLEXT) +scan.$(FASLEXT): incl.$(FASLEXT) bits.$(FASLEXT) dq.$(FASLEXT) sys-utility.$(FASLEXT) incl.$(FASLEXT): cstream.$(FASLEXT) cformat.$(FASLEXT) cformat.$(FASLEXT): unlisp.$(FASLEXT) posit.$(FASLEXT) serror.$(FASLEXT): posit.$(FASLEXT) diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index eb85c055..51dcec48 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -840,7 +840,7 @@ dbConstructorDoc(conform,$op,$sig) == fn conform where dbDocTable conform == --assumes $docTableHash bound --see dbExpandOpAlistIfNecessary table := HGET($docTableHash,conform) => table - $docTable : local := MAKE_-HASHTABLE 'ID + $docTable : local := hashTable 'EQ --process in reverse order so that closest cover up farthest for x in originsInOrder conform repeat dbAddDocTable x dbAddDocTable conform diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index d8668ed4..e5fcc1ca 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -517,7 +517,7 @@ $parentsCache := nil parentsOf con == --called by kcpPage, ancestorsRecur if null $parentsCache then - $parentsCache := MAKE_-HASHTABLE 'ID + $parentsCache := hashTable 'EQ HGET($parentsCache,con) or parents := getParentsForDomain con HPUT($parentsCache,con,parents) @@ -594,7 +594,7 @@ childArgCheck(argl, nargl) == --computeDescendantsOf cat == --dynamically generates descendants --- hash := MAKE_-HASHTABLE 'UEQUAL +-- hash := hashTable 'EQUAL -- for [child,:pred] in childrenOf cat repeat -- childForm := getConstructorForm child -- HPUT(hash,childForm,pred) @@ -618,8 +618,8 @@ ancestorsOf(conform,domform) == --called by kcaPage, originsInOrder,... computeAncestorsOf(conform,domform) computeAncestorsOf(conform,domform) == - $done: local := MAKE_-HASHTABLE 'UEQUAL - $if: local := MAKE_-HASHTABLE 'ID + $done: local := hashTable 'EQUAL + $if: local := hashTable 'EQ ancestorsRecur(conform,domform,true,true) acc := nil for op in listSort(function GLESSEQP,HKEYS $if) repeat diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index b75ac711..143782b8 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -842,7 +842,7 @@ dbExpandOpAlistIfNecessary(htPage,opAlist,which,needOrigins?,condition?) == expandFlag = 'lists => --lists are partially expanded -- entry is [sig, predicate, origin, exposeFlag, comments] $value: local := nil - $docTableHash := MAKE_-HASHTABLE 'EQUAL + $docTableHash := hashTable 'EQUAL packageSymbol := false domform := htpProperty(htPage,'domname) or htpProperty(htPage,'conform) if isDefaultPackageName opOf domform then diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index de06e99a..837adb90 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -448,7 +448,7 @@ koCatOps1 alist == [x for item in alist | x := pair] where false koCatAttrs(catform,domname) == - $if: local := MAKE_-HASHTABLE 'ID + $if: local := hashTable 'EQ catname := opOf catform koCatAttrsAdd(domname or catform,true) ancestors := ancestorsOf(catform,domname) diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot index 6f926ab6..41f4f392 100644 --- a/src/interp/br-util.boot +++ b/src/interp/br-util.boot @@ -71,7 +71,7 @@ $predvec := nil --bound in koOps $exposedOnlyIfTrue := nil --see repeatSearch, dbShowOps, dbShowCon $bcMultipleNames := nil --see bcNameConTable $bcConformBincount := nil --see bcConform1 -$docTableHash := MAKE_-HASHTABLE 'EQUAL --see dbExpandOpAlistIfNecessary +$docTableHash := hashTable 'EQUAL --see dbExpandOpAlistIfNecessary $groupChoice := nil --see dbShowOperationsFromConform ------------------> Initial Settings <--------------------- diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 9325efb1..ed49dc05 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -49,6 +49,14 @@ module c_-util where --% + +++ +$ConstructorCache := hashTable 'EQ + +++ +$instantRecord := hashTable 'EQ + + ++ if true continue compiling after errors $scanIfTrue := false diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index 4886ea55..44a51267 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -46,7 +46,7 @@ showCategoryTable con == displayCategoryTable(:options) == conList := IFCAR options - SETQ($ct,MAKE_-HASHTABLE 'ID) + SETQ($ct,hashTable 'EQ) for (key:=[a,:b]) in HKEYS _*HASCATEGORY_-HASH_* repeat HPUT($ct,a,[[b,:HGET(_*HASCATEGORY_-HASH_*,key)],:HGET($ct,a)]) for id in HKEYS $ct | null conList or MEMQ(id,conList) repeat @@ -54,8 +54,8 @@ displayCategoryTable(:options) == PRINT HGET($ct,id) genCategoryTable() == - SETQ(_*ANCESTORS_-HASH_*, MAKE_-HASHTABLE 'ID) - SETQ(_*HASCATEGORY_-HASH_*,MAKE_-HASHTABLE 'UEQUAL) + SETQ(_*ANCESTORS_-HASH_*, hashTable 'EQ) + SETQ(_*HASCATEGORY_-HASH_*,hashTable 'EQUAL) genTempCategoryTable() domainList:= [con for con in allConstructors() @@ -415,7 +415,7 @@ categoryParts(conform,category,:options) == main where compressHashTable ht == -- compresses hash table ht, to give maximal sharing of cells sayBrightlyNT '"compressing hash table..." - $found: local := MAKE_-HASHTABLE 'UEQUAL + $found: local := hashTable 'EQUAL for x in HKEYS ht repeat compressSexpr(HGET(ht,x),nil,nil) sayBrightly "done" ht diff --git a/src/interp/clam.boot b/src/interp/clam.boot index 8fe02a93..0da5ffd9 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -183,7 +183,7 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == if null argl then null cacheNameOrNil => keyedSystemError("S2GE0011",[op]) nil - (not cacheNameOrNil) and not (eqEtc in '(EQ CVEC UEQUAL)) => + (not cacheNameOrNil) and not (eqEtc in '(EQ EQL EQUAL CVEC UEQUAL)) => keyedSystemError("S2GE0012",[op]) --withWithout := (countFl => "with"; "without") --middle:= @@ -270,7 +270,7 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == weakStrong:= (countFl => 'STRONG; 'WEAK) --note: WEAK means that key/value pairs disappear at garbage collection cacheResetCode:= - ['SETQ,cacheName,['MAKE_-HASHTABLE,MKQ eqEtc]] + ['SETQ,cacheName,['hashTable,MKQ eqEtc]] cacheCountCode:= ['hashCount,cacheName] cacheVector:= mkCacheVec(op,cacheName,cacheType,cacheResetCode,cacheCountCode) diff --git a/src/interp/compress.boot b/src/interp/compress.boot index f644c037..3944fc03 100644 --- a/src/interp/compress.boot +++ b/src/interp/compress.boot @@ -39,7 +39,7 @@ namespace BOOT -- to various situations are required minimalise x == - $hash:local:=MAKE_-HASHTABLE 'UEQUAL + $hash:local:=hashTable 'EQUAL min x where min x == y:=HGET($hash,x) diff --git a/src/interp/database.boot b/src/interp/database.boot index 6c7c54c4..3a1c99d0 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -235,7 +235,7 @@ rebuildCDT(filemode) == buildDatabase(filemode,expensive) == $InteractiveMode: local:= true $constructorList := nil --looked at by buildLibdb - $ConstructorCache:= MAKE_-HASHTABLE('ID) + $ConstructorCache:= hashTable 'EQ SAY '"Making constructor autoload" makeConstructorsAutoLoad() SAY '"Building category table" diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index c20466fa..9b2ea472 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -152,7 +152,7 @@ PPtoFile(x, fname) == x ScanOrPairVec(f, ob) == - $seen: local := MAKE_-HASHTABLE 'EQ + $seen: local := hashTable 'EQ CATCH('ScanOrPairVecAnswer, ScanOrInner(f, ob)) where ScanOrInner(f, ob) == diff --git a/src/interp/guess.boot b/src/interp/guess.boot index 21014170..ab1abb8e 100644 --- a/src/interp/guess.boot +++ b/src/interp/guess.boot @@ -42,7 +42,7 @@ buildOperationWordTable() == $opWordTable := buildWordTable [PNAME x for x in allOperations()] buildWordTable u == - table:= MAKE_-HASHTABLE 'ID + table:= hashTable 'EQ for s in u repeat words := wordsOfString s key := UPCASE s.0 diff --git a/src/interp/htcheck.boot b/src/interp/htcheck.boot index c548fcbb..34412254 100644 --- a/src/interp/htcheck.boot +++ b/src/interp/htcheck.boot @@ -84,7 +84,7 @@ $primitiveHtCommands := '( ("\windowlink" . 2)) buildHtMacroTable() == - $htMacroTable := MAKE_-HASHTABLE 'UEQUAL + $htMacroTable := hashTable 'EQUAL fn := strconc(systemRootDirectory(), '"/share/hypertex/pages/util.ht") if PROBE_-FILE(fn) then instream := MAKE_-INSTREAM fn diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index 0df1c81c..71dc1fbb 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -42,7 +42,7 @@ $compileRecurrence := true $errorReportLevel := 'warning $sourceFileTypes := '(INPUT SPAD BOOT LISP LISP370 META) -$existingFiles := MAKE_-HASHTABLE "UEQUAL" +$existingFiles := hashTable "EQUAL" $SYSCOMMANDS := [first x for x in $systemCommands] @@ -299,7 +299,7 @@ clearCmdCompletely() == sayKeyedMsg("S2IZ0013",NIL) clearClams() clearConstructorCaches() - $existingFiles := MAKE_-HASHTABLE 'UEQUAL + $existingFiles := hashTable 'EQUAL sayKeyedMsg("S2IZ0014",NIL) RECLAIM() sayKeyedMsg("S2IZ0015",NIL) @@ -863,7 +863,7 @@ convertSpadToAsFile path == $abbreviationsAlreadyPrinted: local := nil -- for spad -> as translator $convertingSpadFile : local := true $options: local := '((nolib)) -- translator shouldn't create nrlibs - SETQ(HT,MAKE_-HASHTABLE 'UEQUAL) + SETQ(HT,hashTable 'EQUAL) newName := fnameMake(pathnameDirectory path, pathnameName path, '"as") canDoIt := true @@ -1835,7 +1835,7 @@ undoFromFile(n) == updateHist() saveHistory(fn) == - $seen: local := MAKE_-HASHTABLE 'EQ + $seen: local := hashTable 'EQ not $HiFiAccess => sayKeyedMsg("S2IH0016",NIL) not $useInternalHistoryTable and null MAKE_-INPUT_-FILENAME histFileName() => sayKeyedMsg("S2IH0022",NIL) @@ -2046,7 +2046,7 @@ safeWritify ob == writify ob == not ScanOrPairVec(function(unwritable?), ob) => ob - $seen: local := MAKE_-HASHTABLE 'EQ + $seen: local := hashTable 'EQ $writifyComplained: local := false writifyInner ob where @@ -2154,7 +2154,7 @@ dewritify ob == (not ScanOrPairVec(function is?, ob) where is? a == a = 'WRITIFIED_!_!) => ob - $seen: local := MAKE_-HASHTABLE 'EQ + $seen: local := hashTable 'EQ dewritifyInner ob where dewritifyInner ob == @@ -2177,7 +2177,7 @@ dewritify ob == HPUT($seen, ob, f) f type = 'HASHTABLE => - nob := MAKE_-HASHTABLE ob.2 + nob := hashTable ob.2 HPUT($seen, ob, nob) HPUT($seen, nob, nob) for k in ob.3 for e in ob.4 repeat diff --git a/src/interp/i-toplev.boot b/src/interp/i-toplev.boot index 4003151f..a2d0b30c 100644 --- a/src/interp/i-toplev.boot +++ b/src/interp/i-toplev.boot @@ -106,7 +106,7 @@ start(:l) == SAY fillerSpaces($LINELENGTH,'"=") TERPRI() $OLDLINE := NIL - $superHash := MAKE_-HASHTABLE('UEQUAL) + $superHash := hashTable 'EQUAL if null l then runspad() 'EndOfSpad diff --git a/src/interp/interop.boot b/src/interp/interop.boot index be8354c3..c1ae917c 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -262,7 +262,7 @@ $attributeDispatch := orderedDefaults(conform,domform) == - $depthAssocCache : local := MAKE_-HASHTABLE 'ID + $depthAssocCache : local := hashTable 'EQ conList := [x for x in orderCatAnc (op := opOf conform) | hasDefaultPackage op] acc := nil ancestors := ancestorsOf(conform,domform) diff --git a/src/interp/mark.boot b/src/interp/mark.boot index 6c5c5f0e..9217acb2 100644 --- a/src/interp/mark.boot +++ b/src/interp/mark.boot @@ -920,7 +920,7 @@ getNumberTypesInScope() == getCommonImports() == importList := [x for x in $importStack for y in $capsuleStack | KAR KAR y = 'DEF] - hash := MAKE_-HASHTABLE 'EQUAL + hash := hashTable 'EQUAL for x in importList repeat for y in x repeat HPUT(hash,y,1 + (HGET(hash,y) or 0)) threshold := FLOOR (.5 * #importList) diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot index 3c0296fb..c27a4d1f 100644 --- a/src/interp/newfort.boot +++ b/src/interp/newfort.boot @@ -180,7 +180,7 @@ exp2FortOptimize e == exp2FortOptimizeCS e == $fortCsList : local := NIL - $fortCsHash : local := MAKE_-HASHTABLE 'EQ + $fortCsHash : local := hashTable 'EQ $fortCsExprStack : local := NIL $fortCsFuncStack : local := NIL f := exp2FortOptimizeCS1 e diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 948b7b0d..014e757f 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -54,7 +54,7 @@ $insideCategoryPackageIfTrue := false $profileCompiler := false ++ -$Slot1DataBase := MAKE_-HASHTABLE "ID" +$Slot1DataBase := hashTable 'EQ ++ $NRTdeltaList := [] diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot index c373e219..b7997fc3 100644 --- a/src/interp/nrunopt.boot +++ b/src/interp/nrunopt.boot @@ -350,7 +350,7 @@ bitsOf n == -- Generate Slot 4 Constructor Vectors --======================================================================= NRTmakeCategoryAlist() == - $depthAssocCache: local := MAKE_-HASHTABLE 'ID + $depthAssocCache: local := hashTable 'EQ $catAncestorAlist: local := NIL pcAlist := [:[[x,:"T"] for x in $uncondAlist],:$condAlist] $levelAlist: local := depthAssocList [CAAR x for x in pcAlist] diff --git a/src/interp/scan.boot b/src/interp/scan.boot index b1b29cd0..5b04893c 100644 --- a/src/interp/scan.boot +++ b/src/interp/scan.boot @@ -35,6 +35,7 @@ import bits import dq import incl +import sys_-utility namespace BOOT module scan @@ -165,7 +166,7 @@ scanKeyWords == [ _ scanKeyTableCons()== - KeyTable:=MAKE_-HASHTABLE("CVEC",true) + KeyTable := hashTable 'EQUAL for st in scanKeyWords repeat HPUT(KeyTable,first st,second st) KeyTable diff --git a/src/interp/setvars.boot b/src/interp/setvars.boot index cd5cfacb..6aaa0602 100644 --- a/src/interp/setvars.boot +++ b/src/interp/setvars.boot @@ -145,7 +145,7 @@ resetWorkspaceVariables() == SETQ(_/PRETTY , NIL) SETQ(_/SPACELIST , NIL) SETQ(_/TIMERLIST , NIL) - SETQ($existingFiles , MAKE_-HASHTABLE 'UEQUAL) + SETQ($existingFiles , hashTable 'EQUAL) SETQ($functionTable , NIL) SETQ($echoLineStack , NIL) SETQ($slamFlag , NIL) diff --git a/src/interp/slam.boot b/src/interp/slam.boot index b2d2e5a3..42d10194 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -133,7 +133,7 @@ reportFunctionCacheAll(op,nam,argl,body) == compileInteractive mainFunction compileInteractive computeFunction cacheType:= 'hash_-table - cacheResetCode:= ["SETQ",cacheName,['MAKE_-HASHTABLE,''UEQUAL]] + cacheResetCode:= ["SETQ",cacheName,['hashTable,''EQUAL]] cacheCountCode:= ['hashCount,cacheName] cacheVector:= mkCacheVec(op,cacheName,cacheType,cacheResetCode,cacheCountCode) @@ -216,7 +216,7 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) == -- also binds "stateVar" to its current value initialSetCode := initialValueCode := - extraArguments => ["MAKE_-HASHTABLE",''UEQUAL] + extraArguments => ["hashTable",''EQUAL] tripleCode cacheResetCode := ["SETQ",stateNam,initialValueCode] ["COND",[["NULL",["AND",["BOUNDP",MKQ stateNam], _ diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot index e19630d5..11c60b1c 100644 --- a/src/interp/sys-driver.boot +++ b/src/interp/sys-driver.boot @@ -198,7 +198,7 @@ initializeGlobalState() == $defaultOptimizationLevel) GCMSG(NIL) if have_to then - $superHash := MAKE_-HASHTABLE('UEQUAL) + $superHash := hashTable 'EQUAL initNewWorld() -- 1. Macros. diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot index d2a756a7..28e8b594 100644 --- a/src/interp/sys-globals.boot +++ b/src/interp/sys-globals.boot @@ -80,9 +80,6 @@ $compCount := 0 $compUniquelyIfTrue := false ++ -$ConstructorCache := MAKE_-HASHTABLE "ID" - -++ $createUpdateFiles := false ++ @@ -152,9 +149,6 @@ $insideFunctorIfTrue := false $insideWhereIfTrue := false ++ -$instantRecord := MAKE_-HASHTABLE "ID" - -++ $InteractiveFrame := $EmptyEnvironment $e := $EmptyEnvironment $env := [[nil]] diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index ba7aab89..159fe1af 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -268,6 +268,16 @@ PRINT_-AND_-EVAL_-DEFUN(name,body) == PRINT_-DEFUN(name,body) +--% Hash table + +hashTable cmp == + testFun := + cmp in '(ID EQ) => function EQ + cmp = 'EQL => function EQL + cmp = 'EQUAL => function EQUAL + error '"bad arg to hashTable" + MAKE_-HASH_-TABLE(KEYWORD::TEST,testFun) + --% File IO $InputIOMode == KEYWORD::INPUT diff --git a/src/interp/topics.boot b/src/interp/topics.boot index f3959be9..995120ee 100644 --- a/src/interp/topics.boot +++ b/src/interp/topics.boot @@ -64,7 +64,7 @@ $topicSynonyms := '( $groupAssoc := '((extended . 1) (basic . 2) (hidden . 4)) -$topicHash := MAKE_-HASHTABLE "ID" +$topicHash := hashTable 'EQ SETF(GETHASH("basic",$topicHash),2) SETF(GETHASH("algebraic",$topicHash),4) SETF(GETHASH("miscellaneous",$topicHash),13) @@ -85,11 +85,11 @@ SETF(GETHASH("trignometric",$topicHash),11) --======================================================================= --called at build-time before making DOCUMENTATION property mkTopicHashTable() == --given $groupAssoc = ((extended . 1)(basic . 2)(xx . 4)..) - $defaultsHash := MAKE_-HASHTABLE 'ID --keys are ops, value is list of topic names + $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)]) - $conTopicHash := MAKE_-HASHTABLE 'EQL --key is constructor name; value is + $conTopicHash := hashTable 'EQL --key is constructor name; value is instream := OPEN '"topics.data" while not EOFP instream repeat line := READLINE instream @@ -107,7 +107,7 @@ mkTopicHashTable() == --given $groupAssoc = ((extended . | lst := string2OpAlist line] alist => HPUT($conTopicHash,con,alist) --initialize table of topic classes - $topicHash := MAKE_-HASHTABLE 'ID --$topicHash has keys: topic and value: index + $topicHash := hashTable 'EQ --$topicHash has keys: topic and value: index for [x,:c] in $groupAssoc repeat HPUT($topicHash,x,c) $topicIndex := rest LAST $groupAssoc @@ -190,7 +190,7 @@ addTopic2Documentation(con,docAlist) == td con == $topicClasses := ASSOCRIGHT mySort [[HGET($topicHash,key),:key] for key in HKEYS $topicHash] - hash := MAKE_-HASHTABLE 'ID + hash := hashTable 'EQ tdAdd(con,hash) tdPrint hash @@ -212,7 +212,7 @@ topics con == --assumes that DOCUMENTATION property already has #s added $topicClasses := ASSOCRIGHT mySort [[HGET($topicHash,key),:key] for key in HKEYS $topicHash] - hash := MAKE_-HASHTABLE 'ID + hash := hashTable 'EQ tdAdd(con,hash) for x in removeDuplicates [CAAR y for y in ancestorsOf(getConstructorForm con,nil)] repeat tdAdd(x,hash) diff --git a/src/interp/word.boot b/src/interp/word.boot index 2f6feac1..7fa391fd 100644 --- a/src/interp/word.boot +++ b/src/interp/word.boot @@ -40,7 +40,7 @@ buildFunctionTable(dicts) == buildWordTable getListOfFunctionNames dicts buildWordTable u == - table:= MAKE_-HASHTABLE 'ID + table:= hashTable 'EQ for s in u repeat key := UPCASE s.0 HPUT(table,key,[[s,:wordsOfString s],:HGET(table,key)]) @@ -78,7 +78,7 @@ readFunctionTable() == $wordDictionary = 'development => 'SPADD 'SPADC stream:= readLib(name,'DATABASE) - table:= MAKE_-HASHTABLE 'ID + table:= hashTable 'EQ for key in RKEYIDS makePathname(name,'DATABASE,"*") repeat HPUT(table,kk:=object2Identifier key, rread(kk,stream,nil)) RSHUT stream |