more cleanup

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
parent: fb3bb6231462cddfb70301ea1672ebc04c8e829a (diff)
download: open-axiom-104def0e400bbf3a0daed9e490e41485a9213c9d.tar.gz
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*))
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
parent	fb3bb6231462cddfb70301ea1672ebc04c8e829a (diff)
download	open-axiom-104def0e400bbf3a0daed9e490e41485a9213c9d.tar.gz