From a8b9a2f5f65820ce836353e0d25070fa8eaeece9 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sat, 7 May 2011 16:08:31 +0000 Subject: * algebra/table.spad.pamphlet (HashTable): Use tableValue instead of HGET. Use tableLength instead of HCOUNT. --- src/ChangeLog | 5 +++++ src/algebra/table.spad.pamphlet | 7 +++++-- src/interp/cattable.boot | 4 ++-- src/interp/clam.boot | 22 ++++++++++++---------- src/interp/hash.lisp | 2 -- src/interp/slam.boot | 11 +++++++---- src/lisp/core.lisp.in | 8 ++++++++ 7 files changed, 39 insertions(+), 20 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index 518fcd38..a785fd16 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2011-05-07 Gabriel Dos Reis + + * algebra/table.spad.pamphlet (HashTable): Use tableValue instead + of HGET. Use tableLength instead of HCOUNT. + 2011-05-04 Gabriel Dos Reis * boot/initial-env.lisp (shoeOpenOutputFile): Remove. Adjust diff --git a/src/algebra/table.spad.pamphlet b/src/algebra/table.spad.pamphlet index 12adc7f0..22984b89 100644 --- a/src/algebra/table.spad.pamphlet +++ b/src/algebra/table.spad.pamphlet @@ -35,14 +35,17 @@ HashTable(Key, Entry, hashfn): Exports == Implementation where finiteAggregate Implementation ==> add + import tableValue: (%,Key) -> Entry from Foreign Builtin + import tableLength: % -> NonNegativeInteger from Foreign Builtin + Pair ==> Record(key: Key, entry: Entry) Ex ==> OutputForm failMsg := GENSYM()$Lisp t1 = t2 == %peq(t1,t2)$Foreign(Builtin) keys t == HKEYS(t)$Lisp - # t == HCOUNT(t)$Lisp - setelt(t, k, e) == HPUT(t,k,e)$Lisp + # t == tableLength t + setelt(t, k, e) == %store(tableValue(t,k),e)$Foreign(Builtin) remove!(k:Key, t:%) == r := HGET(t,k,failMsg)$Lisp not %peq(r,failMsg)$Foreign(Builtin) => diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index a9a9e949..3e35fdb4 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -83,7 +83,7 @@ simpCategoryTable() == main where main() == for key in HKEYS _*HASCATEGORY_-HASH_* repeat entry := tableValue(_*HASCATEGORY_-HASH_*,key) - null entry => HREM(_*HASCATEGORY_-HASH_*,key) + null entry => tableRemove!(_*HASCATEGORY_-HASH_*,key) change := atom opOf entry => simpHasPred entry [[x,:npred] for [x,:pred] in entry | npred := simpHasPred pred] @@ -485,7 +485,7 @@ clearCategoryTable($cname) == MAPHASH('clearCategoryTable1,_*HASCATEGORY_-HASH_*) clearCategoryTable1(key,val) == - (first key=$cname)=> HREM(_*HASCATEGORY_-HASH_*,key) + (first key=$cname)=> tableRemove!(_*HASCATEGORY_-HASH_*,key) nil clearTempCategoryTable(catNames) == diff --git a/src/interp/clam.boot b/src/interp/clam.boot index db94674c..c5774c8e 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -234,17 +234,18 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == null argl => cacheNameOrNil => countFl => - ['CDDAR,['HPUT,cacheNameOrNil,MKQ op, + ['CDDAR,['%store,['tableValue,cacheNameOrNil,MKQ op], ['%list,['%pair,'%nil,['%pair,1,computeValue]]]]] - ['HPUT,cacheNameOrNil,MKQ op, + ['%store,['tableValue,cacheNameOrNil,MKQ op], ['%list,['%pair,'%nil,computeValue]]] systemError '"unexpected" cacheNameOrNil => computeValue - countFl => ['%tail,['HPUT,cacheName,g1,['%pair,1,computeValue]]] - ['HPUT,cacheName,g1,computeValue] + countFl => + ['%tail,['%store,['tableValue,cacheName,g1],['%pair,1,computeValue]]] + ['%store,['tableValue,cacheName,g1],computeValue] if cacheNameOrNil then putCode := ['UNWIND_-PROTECT,['PROG1,putCode,['%store,g2,'%true]], - ['%when,[['%not,g2],['HREM,cacheName,MKQ op]]]] + ['%when,[['%not,g2],['tableRemove!,cacheName,MKQ op]]]] thirdPredPair:= ['%otherwise,putCode] codeBody:= optSEQ ['SEQ,:callCountCode, @@ -301,8 +302,9 @@ compHashGlobal(op,argl,body,cacheName,eqEtc,countFl) == secondPredPair:= [g2,returnFoundValue] putForm:= ['%pair,MKQ op,g1] putCode:= - countFl => ['HPUT,cacheName,putForm,['%pair,1,computeValue]] - ['HPUT,cacheName,putForm,computeValue] + countFl => + ['%store,['tableValue,cacheName,putForm],['%pair,1,computeValue]] + ['%store,['tableValue,cacheName,putForm],computeValue] thirdPredPair := ['%otherwise,putCode] codeBody := ['%bind,[[g2,getCode]],['%when,secondPredPair,thirdPredPair]] lamex := ['LAM,arg,codeBody] @@ -345,7 +347,7 @@ clearConstructorCaches() == clearConstructorCache(cname) == (kind := getConstructorKindFromDB cname) => kind = "category" => clearCategoryCache cname - HREM($ConstructorCache,cname) + tableRemove!($ConstructorCache,cname) clearConstructorAndLisplibCaches() == clearClams() @@ -423,7 +425,7 @@ clearHashReferenceCounts() == remHashEntriesWith0Count $hashTable == MAPHASH(function fn,$hashTable) where fn(key,obj) == - first obj = 0 => HREM($hashTable,key) --free store + first obj = 0 => tableRemove!($hashTable,key) --free store nil initCache n == @@ -497,7 +499,7 @@ clamStats() == res postString:= cacheValue:= eval cacheVec.cacheName - kind = 'hash => [" (","%b",HASH_-TABLE_-COUNT cacheValue,"%d","entries)"] + kind = 'hash => [" (","%b",tableLength cacheValue,"%d","entries)"] empties:= numberOfEmptySlots eval cacheVec.cacheName empties = 0 => nil [" (","%b",kind-empties,"/",kind,"%d","slots used)"] diff --git a/src/interp/hash.lisp b/src/interp/hash.lisp index 98ac338a..9482efd3 100644 --- a/src/interp/hash.lisp +++ b/src/interp/hash.lisp @@ -74,8 +74,6 @@ (2 'EQUAL) (t "error unknown hash table class"))) -(define-function 'HCOUNT #'hash-table-count) - ;17.4 Searching and Updating (defun HPUT (table key value) (setf (gethash key table) value)) diff --git a/src/interp/slam.boot b/src/interp/slam.boot index e46f6bcd..4889507b 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -218,8 +218,10 @@ reportFunctionCacheAll(op,nam,argl,body) == if null argl then g1:=nil cacheName:= mkCacheName nam g2:= gensym() --value computed by calling function - secondPredPair:= [['%store,g2,["tableValue",['%dynval,MKQ cacheName],g1]],g2] - thirdPredPair:= ['%otherwise,["HPUT",['%dynval,MKQ cacheName],g1,computeValue]] + secondPredPair := [['%store,g2,['tableValue,['%dynval,MKQ cacheName],g1]],g2] + thirdPredPair := ['%otherwise, + ['%store,['tableValue,['%dynval,MKQ cacheName],g1], + computeValue]] codeBody:= ["PROG",[g2],["RETURN",['%when,secondPredPair,thirdPredPair]]] lamex:= ["LAM",arg,codeBody] mainFunction:= [nam,lamex] @@ -284,7 +286,8 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) == newTripleCode := ['%list,sharpArg,:gsList] newStateCode := null extraArguments => ["%store",["%dynval", MKQ stateNam],newTripleCode] - ["HPUT",["%dynval", MKQ stateNam],extraArgumentCode,newTripleCode] + ['store,['tableValue,["%dynval", MKQ stateNam],extraArgumentCode], + newTripleCode] computeFunction:= [auxfn,["LAM",cargl,cbody]] where cargl:= [:argl,lastArg] @@ -325,7 +328,7 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) == null extraArguments => nil [["%LET",stateVar,['%or, ["tableValue",stateVar,extraArgumentCode], - ["HPUT",stateVar,extraArgumentCode,tripleCode]]]] + ['%store,['tableValue,stateVar,extraArgumentCode],tripleCode]]]] mbody := preset := [initialSetCode,:initialResetCode,["%LET",max,["ELT",stateVar,0]]] diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in index 6e56a993..49396264 100644 --- a/src/lisp/core.lisp.in +++ b/src/lisp/core.lisp.in @@ -84,6 +84,8 @@ ;; Some common data structures "tableValue" ; value associated with a key in a table + "tableLength" ; number of entries in the table. + "tableRemove!" ; remove an entry from a table ;; IO "$InputStream" @@ -455,6 +457,12 @@ (defmacro |tableValue| (ht k) `(gethash ,k ,ht)) +(defmacro |tableRemove!| (ht k) + `(remhash ,k ,ht)) + +(defmacro |tableLength| (ht) + `(hash-table-count ,ht)) + ;; -*- File IO -*- (defparameter |$InputStream| (make-synonym-stream '*standard-input*)) -- cgit v1.2.3