From 4b6362cf4588e70357d39981088e0b86913dc637 Mon Sep 17 00:00:00 2001 From: Gabriel Dos Reis Date: Fri, 8 Jan 2016 11:04:32 -0800 Subject: Replace \*HASCATEGORY-HASH\* with $HasCategoryTable --- src/interp/br-data.boot | 5 +---- src/interp/br-op1.boot | 2 +- src/interp/cattable.boot | 26 +++++++++++++------------- src/interp/daase.lisp | 18 +++++++++--------- src/interp/sys-globals.boot | 2 +- 5 files changed, 25 insertions(+), 28 deletions(-) diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index 8d8e7635..1f182810 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -36,9 +36,6 @@ import bc_-util import nruncomp namespace BOOT -lefts u == - [x for [x,:.] in entries _*HASCATEGORY_-HASH_* | rest x = u] - --============================================================================ -- Build Library Database (libdb.text,...) --============================================================================ @@ -583,7 +580,7 @@ ancestorsAdd(pred,form) == --called by ancestorsRecur domainsOf(conform,domname,:options) == $hasArgList := IFCAR options conname := opOf conform - u := [key for [key,:.] in entries _*HASCATEGORY_-HASH_* + u := [key for [key,:.] in entries $HasCategoryTable | 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 dcbf5fdb..a9c3418d 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -530,7 +530,7 @@ dbShowOpAllDomains(htPage,opAlist,which) == pred := simpOrDumb(predicate,symbolTarget(conname,domOriginAlist) or true) domOriginAlist := insertAlist(conname,pred,domOriginAlist) --the following is similar to "domainsOf" but do not sort immediately - u := [copyTree key for [key,:.] in entries _*HASCATEGORY_-HASH_* + u := [copyTree key for [key,:.] in entries $HasCategoryTable | symbolTarget(rest key,catOriginAlist)] for pair in u repeat [dom,:cat] := pair diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index 7cb1dc0d..24b5f11d 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -43,13 +43,13 @@ hasCat(dom,cat) == or constructorHasCategoryFromDB [dom.op,:cat.op] showCategoryTable con == - [[b,:val] for [[a,:b],:val] in entries _*HASCATEGORY_-HASH_* + [[b,:val] for [[a,:b],:val] in entries $HasCategoryTable | symbolEq?(a,con) and val ~= nil] displayCategoryTable(:options) == conList := IFCAR options SETQ($ct,hashTable 'EQ) - for [[a,:b],:val] in entries _*HASCATEGORY_-HASH_* repeat + for [[a,:b],:val] in entries $HasCategoryTable 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:"] @@ -57,7 +57,7 @@ displayCategoryTable(:options) == genCategoryTable() == SETQ(_*ANCESTORS_-HASH_*, hashTable 'EQ) - SETQ(_*HASCATEGORY_-HASH_*,hashTable 'EQUAL) + $HasCategoryTable := makeTable function EQUAL genTempCategoryTable() domainTable := [addDomainToTable(con,getConstrCat getConstructorCategory con) @@ -69,11 +69,11 @@ genCategoryTable() == for id in specialDs | id ~= 'Cross], :domainTable] for [id,:entry] in domainTable repeat for [a,:b] in encodeCategoryAlist(id,entry) repeat - tableValue(_*HASCATEGORY_-HASH_*,[id,:a]) := b + tableValue($HasCategoryTable,[id,:a]) := b simpTempCategoryTable() -- compressHashTable _*ANCESTORS_-HASH_* simpCategoryTable() - -- compressHashTable _*HASCATEGORY_-HASH_* + -- compressHashTable $HasCategoryTable simpTempCategoryTable() == for [id,:.] in entries _*ANCESTORS_-HASH_* repeat @@ -82,12 +82,12 @@ simpTempCategoryTable() == simpCategoryTable() == main where main() == - for [key,:entry] in entries _*HASCATEGORY_-HASH_* repeat - null entry => tableRemove!(_*HASCATEGORY_-HASH_*,key) + for [key,:entry] in entries $HasCategoryTable repeat + null entry => tableRemove!($HasCategoryTable,key) change := opOf entry isnt [.,:.] => simpHasPred entry [[x,:npred] for [x,:pred] in entry | npred := simpHasPred pred] - tableValue(_*HASCATEGORY_-HASH_*,key) := change + tableValue($HasCategoryTable,key) := change simpHasPred(pred,:options) == main where main() == @@ -450,15 +450,15 @@ updateCategoryTableForDomain(cname,category) == clearCategoryTable(cname) [cname,:domainEntry]:= addDomainToTable(cname,category) for [a,:b] in encodeCategoryAlist(cname,domainEntry) repeat - tableValue(_*HASCATEGORY_-HASH_*,[cname,:a]) := b - $doNotCompressHashTableIfTrue => _*HASCATEGORY_-HASH_* - -- compressHashTable _*HASCATEGORY_-HASH_* + tableValue($HasCategoryTable,[cname,:a]) := b + $doNotCompressHashTableIfTrue => $HasCategoryTable + -- compressHashTable $HasCategoryTable clearCategoryTable($cname) == - MAPHASH('clearCategoryTable1,_*HASCATEGORY_-HASH_*) + MAPHASH('clearCategoryTable1,$HasCategoryTable) clearCategoryTable1(key,val) == - (first key=$cname)=> tableRemove!(_*HASCATEGORY_-HASH_*,key) + (first key=$cname)=> tableRemove!($HasCategoryTable,key) nil clearTempCategoryTable(catNames) == diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index 995ad0ec..f346f63d 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -407,7 +407,7 @@ (defun |fillDatabasesInCore| nil "set all -hash* to clean values. used to clean up core before saving system" - (setq *hascategory-hash* (make-hash-table :test #'equal)) + (setq |$HasCategoryTable| (make-hash-table :test #'equal)) (setq *operation-hash* (make-hash-table)) (setq *allconstructors* nil) (setq *interp-stream-stamp* '(0 . 0)) @@ -531,9 +531,9 @@ (setq pos (car stamp)) (file-position *category-stream* pos) (setq keys (read *category-stream*)) - (setq *hasCategory-hash* (make-hash-table :test #'equal)) + (setq |$HasCategoryTable| (make-hash-table :test #'equal)) (dolist (item keys) - (setf (gethash (first item) *hasCategory-hash*) (second item)))) + (setf (gethash (first item) |$HasCategoryTable|) (second item)))) (format t "~&"))) (defun operationOpen () @@ -668,7 +668,7 @@ (when struct (setq data (|dbModemaps| struct)))) (hascategory - (setq table *hasCategory-hash*) + (setq table |$HasCategoryTable|) (setq stream *category-stream*) (setq data (gethash constructor table))) (object @@ -726,7 +726,7 @@ (operation (setf (gethash constructor *operation-hash*) data)) (hascategory - (setf (gethash constructor *hascategory-hash*) data)) + (setf (gethash constructor |$HasCategoryTable|) data)) (constructorkind (setf (|dbConstructorKind| struct) data)) (cosig @@ -974,7 +974,7 @@ (do-symbols (symbol) (when (|constructorDB| symbol) (setf (|constructorDB| symbol) nil))) - (setq *hascategory-hash* (make-hash-table :test #'equal)) + (setq |$HasCategoryTable| (make-hash-table :test #'equal)) (setq *operation-hash* (make-hash-table)) (setq *allconstructors* nil) (withSpecialConstructors) @@ -1000,7 +1000,7 @@ (|buildGloss|) (write-browsedb) (write-operationdb) - ; note: genCategoryTable creates a new *hascategory-hash* table + ; note: genCategoryTable creates a new $HasCategoryTable table ; this smashes the existing table and regenerates it. ; write-categorydb does getdatabase calls to write the new information (write-categorydb) @@ -1137,7 +1137,7 @@ (close out))) (defun write-categorydb () - "make category.daase from scratch. contains the *hasCategory-hash* table" + "make category.daase from scratch. contains the $HasCategoryTable table" (let (out master pos *print-pretty*) (print "building category.daase") (|genCategoryTable|) @@ -1152,7 +1152,7 @@ (print value out) (finish-output out))) (push (list key pos) master)) - *hasCategory-hash*) + |$HasCategoryTable|) (setq pos (file-position out)) (print master out) (finish-output out) diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot index 65aa9a4f..0accfa64 100644 --- a/src/interp/sys-globals.boot +++ b/src/interp/sys-globals.boot @@ -303,7 +303,7 @@ LINE := nil $Echo := false ++ answers x has y category questions -_*HASCATEGORY_-HASH_* := nil +$HasCategoryTable := nil _*ANCESTORS_-HASH_* := nil -- cgit v1.2.3