diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/br-data.boot | 2 | ||||
| -rw-r--r-- | src/interp/cattable.boot | 9 | ||||
| -rw-r--r-- | src/interp/daase.lisp | 14 | ||||
| -rw-r--r-- | src/interp/database.boot | 8 | ||||
| -rw-r--r-- | src/interp/i-resolv.boot | 4 | ||||
| -rw-r--r-- | src/interp/lisplib.boot | 6 |
6 files changed, 21 insertions, 22 deletions
diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index bc0554a5..0b71c730 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -522,7 +522,7 @@ parentsOfForm [op,:argl] == getParentsForDomain domname == --called by parentsOf acc := nil - for x in folks getConstructorCategoryFromDB domname repeat + for x in folks getConstructorCategory domname repeat x := getConstructorKindFromDB domname = "category" => sublisFormal(IFCDR getConstructorForm domname,x,$TriangleVariableList) diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index fbb0b6c0..00505e8f 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -60,7 +60,7 @@ genCategoryTable() == SETQ(_*HASCATEGORY_-HASH_*,hashTable 'EQUAL) genTempCategoryTable() domainTable := - [addDomainToTable(con,getConstrCat getConstructorCategoryFromDB con) + [addDomainToTable(con,getConstrCat getConstructorCategory con) for con in allConstructors() | getConstructorKindFromDB con is "domain"] -- $nonLisplibDomains, $noCategoryDomains are set in BUILDOM BOOT specialDs := SETDIFFERENCE($nonLisplibDomains,$noCategoryDomains) @@ -366,7 +366,7 @@ makeCatPred(zz, cats, thePred) == cats getConstructorExports(conform,:options) == categoryParts(conform, - getConstructorCategoryFromDB opOf conform,IFCAR options) + getConstructorCategory opOf conform,IFCAR options) categoryParts(conform,category,:options) == main where main() == @@ -458,11 +458,10 @@ updateCategoryTable(cname,kind) == kind is 'package => nil kind is 'category => updateCategoryTableForCategory(cname) updateCategoryTableForDomain(cname,getConstrCat( - getConstructorCategoryFromDB cname)) ---+ + getConstructorCategory cname)) kind is 'domain => updateCategoryTableForDomain(cname,getConstrCat( - getConstructorCategoryFromDB cname)) + getConstructorCategory cname)) updateCategoryTableForCategory(cname) == clearTempCategoryTable([[cname,'category]]) diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index 5ee85320..96582c61 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -327,9 +327,7 @@ "if true print out cache misses on getdatabase calls") ; note that constructorcategory information need only be kept for - ; items of type category. this will be fixed in the next iteration - ; when the need for the various caches are reviewed - + ; items of type category. ; note that the *modemaps-hash* information does not need to be kept ; for system files. these are precomputed and kept in modemap.daase ; however, for user-defined files these are needed. @@ -610,9 +608,7 @@ ; constructormodemap ; modemaps -- this should not be needed. eliminate it. ; object -- the name of the object file to load for this con. -; constructorcategory -- note that this info is the cadar of the -; constructormodemap for domains and packages so it is stored -; as NIL for them. it is valid for categories. +; constructorcategory -- note that this info is valid only for categories. ; abbrev -- kept directly ; cosig -- kept directly ; constructorkind -- kept directly @@ -767,7 +763,7 @@ (format t "~a: ~%" 'constructormodemap) (pprint (|getConstructorModemap| constructor)) (format t "~&~a: ~%" 'constructorcategory) - (pprint (|getConstructorCategoryFromDB| constructor)) + (pprint (|getConstructorCategory| constructor)) (format t "~&~a: ~%" 'operationalist) (pprint (|getConstructorOperationsFromDB| constructor)) (format t "~&~a: ~%" 'modemaps) @@ -856,9 +852,7 @@ (constructorcategory (setq stream *interp-stream*) (when struct - (setq data (|dbCategory| struct)) - (when (null data) ;domain or package then subfield of constructormodemap - (setq data (cadar (|getConstructorModemap| constructor)))))) + (setq data (|dbCategory| struct)))) (operationalist (setq stream *interp-stream*) (when struct diff --git a/src/interp/database.boot b/src/interp/database.boot index 53aba6ec..c65f2c42 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -63,9 +63,11 @@ getConstructorAbbreviationFromDB: %Constructor -> %Symbol getConstructorAbbreviationFromDB ctor == GETDATABASE(ctor,"ABBREVIATION") -getConstructorCategoryFromDB: %Constructor -> %Form -getConstructorCategoryFromDB ctor == - GETDATABASE(ctor,"CONSTRUCTORCATEGORY") +getConstructorCategory: %Constructor -> %Form +getConstructorCategory ctor == + getConstructorKindFromDB ctor = 'category => + GETDATABASE(ctor,"CONSTRUCTORCATEGORY") + getConstructorModemap(ctor).mmTarget getConstructorKindFromDB: %Constructor -> %Maybe %ConstructorKind getConstructorKindFromDB ctor == diff --git a/src/interp/i-resolv.boot b/src/interp/i-resolv.boot index 4a0f08eb..bada82b8 100644 --- a/src/interp/i-resolv.boot +++ b/src/interp/i-resolv.boot @@ -412,7 +412,7 @@ getConditionsForCategoryOnType(t,cat) == getConditionalCategoryOfType(t,conditions,match) == if cons? t then t := first t t in '(Union Mapping Record) => nil - conCat := getConstructorCategoryFromDB t + conCat := getConstructorCategory t removeDuplicates rest getConditionalCategoryOfType1(conCat,conditions,match,[nil]) getConditionalCategoryOfType1(cat,conditions,match,seen) == @@ -429,7 +429,7 @@ getConditionalCategoryOfType1(cat,conditions,match,seen) == cat is [catName,:.] and (getConstructorKindFromDB catName = "category") => member(cat, rest seen) => conditions seen.rest := [cat,:rest seen] - subCat := getConstructorCategoryFromDB catName + subCat := getConstructorCategory catName -- substitute vars of cat into category for v in rest cat for vv in $TriangleVariableList repeat subCat := substitute(v,vv,subCat) diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 8c39a1b5..e8d85247 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -550,6 +550,9 @@ writeAbbreviation(db,file) == writeConstructorForm(ctor,form,file) == writeInfo(ctor,form,'constructorForm,'dbConstructorForm,file) +writeCategory(ctor,cat,file) == + writeInfo(ctor,cat,'constructorCategory,'dbCategory,file) + writeSuperDomain(ctor,domPred,file) == writeInfo(ctor,domPred,'superDomain,'dbSuperDomain,file) @@ -591,7 +594,8 @@ finalizeLisplib(ctor,libName) == $lisplibCategory := $lisplibCategory or mm.mmTarget -- set to target of mm for package/domain constructors; -- to the right-hand sides (the definition) for category constructors - lisplibWrite('"constructorCategory",$lisplibCategory,$libFile) + if dbConstructorKind db = 'category then + writeCategory(ctor,$lisplibCategory,$libFile) lisplibWrite('"sourceFile",namestring _/EDITFILE,$libFile) lisplibWrite('"modemaps",removeZeroOne $lisplibModemapAlist,$libFile) opsAndAtts := getConstructorOpsAndAtts(form,kind,mm) |