aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog9
-rw-r--r--src/interp/br-con.boot2
-rw-r--r--src/interp/br-op1.boot2
-rw-r--r--src/interp/br-op2.boot2
-rw-r--r--src/interp/cattable.boot2
-rw-r--r--src/interp/daase.lisp16
-rw-r--r--src/interp/database.boot12
-rw-r--r--src/interp/i-funsel.boot2
-rw-r--r--src/interp/i-syscmd.boot2
-rw-r--r--src/interp/nrunfast.boot2
-rw-r--r--src/interp/showimp.boot22
11 files changed, 35 insertions, 38 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index d3b2c344..fa1118a2 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,12 @@
+2011-09-04 Gabriel Dos Reis <gdr@cse.tamu.edu>
+
+ * interp/daase.lisp (GETDATABASE): Do not handle PREDICATES and
+ ATTRIBUTES selectors anymore.
+ * interp/database.boot (getConstructorPredicates): Rename from
+ getConstructorPredicatesFromDB. Adjust callers.
+ (getConstructorAttributes): Rename from getConstructorAttributesFromDB.
+ Adjust callers.
+
2011-09-04 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/lisplib.boot (writeAbbreviation): New.
diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot
index 2b8f5cd9..50776276 100644
--- a/src/interp/br-con.boot
+++ b/src/interp/br-con.boot
@@ -328,7 +328,7 @@ dbSearchOrder(conform,domname,$domain) == --domain = nil or set to live domain
u := $infovec.3
$predvec:=
$domain => $domain . 3
- getConstructorPredicatesFromDB name
+ getConstructorPredicates name
catpredvec := first u
catinfo := second u
catvec := third u
diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot
index 72f65fa4..5144fba7 100644
--- a/src/interp/br-op1.boot
+++ b/src/interp/br-op1.boot
@@ -392,7 +392,7 @@ dbGatherDataImplementation(htPage,opAlist) ==
dom := eval domainForm
which := '"operation"
[nam,:$domainArgs] := domainForm
- $predicateList: local := getConstructorPredicatesFromDB nam
+ $predicateList: local := getConstructorPredicates nam
predVector := domainPredicates dom
u := getDomainOpTable(dom,true,ASSOCLEFT opAlist)
--u has form ((op,sig,:implementor)...)
diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot
index 1e5ff436..298c2fec 100644
--- a/src/interp/br-op2.boot
+++ b/src/interp/br-op2.boot
@@ -347,7 +347,7 @@ koAttrs(conform,domname) ==
$infovec: local := dbInfovec conname or return nil
$predvec: local :=
$domain => domainPredicares $domain
- getConstructorPredicatesFromDB conname
+ getConstructorPredicates conname
u := [[a,:pred] for [a,:i] in $infovec . 2 | a isnt 'nil and (pred := sublisFormal(args,kTestPred i))]
--------- CHECK for a = nil
listSort(function GLESSEQP,fn u) where fn u ==
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index 247caee3..fbb0b6c0 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -151,7 +151,7 @@ simpHasAttribute(pred,conform,attr) == --eval w/o loading
k = 0 => true
$domain => kTestPred k --from koOps
predvec := $predvec or sublisFormal(conform.args,
- getConstructorPredicatesFromDB conname)
+ getConstructorPredicates conname)
simpHasPred predvec.(k - 1)
simpCatHasAttribute(domform,attr) ==
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index b3cb6a64..5ee85320 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -793,9 +793,9 @@
(format t "~a: ~a~%" 'constructorargs
(|getConstructorArgsFromDB| constructor))
(format t "~a: ~a~%" 'attributes
- (|getConstructorAttributesFromDB| constructor))
+ (|getConstructorAttributes| constructor))
(format t "~a: ~%" 'predicates)
- (pprint (|getConstructorPredicatesFromDB| constructor))
+ (pprint (|getConstructorPredicates| constructor))
(format t "~a: ~a~%" 'documentation
(|getConstructorDocumentationFromDB| constructor))
(format t "~a: ~a~%" 'parents
@@ -899,14 +899,6 @@
(setq data (|dbConstructorForm| struct))))
(constructorargs
(setq data (cdr (|getConstructorFormFromDB| constructor))))
- (attributes
- (setq stream *browse-stream*)
- (when struct
- (setq data (|dbAttributes| struct))))
- (predicates
- (setq stream *browse-stream*)
- (when struct
- (setq data (|dbPredicates| struct))))
(documentation
(setq stream *browse-stream*)
(when struct
@@ -961,10 +953,6 @@
(setf (|dbAncestors| struct) data))
(constructorform
(setf (|dbConstructorForm| struct) data))
- (attributes
- (setf (|dbAttributes| struct) data))
- (predicates
- (setf (|dbPredicates| struct) data))
(documentation
(setf (database-documentation struct) data))
(parents
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 06030e16..53aba6ec 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -115,9 +115,9 @@ getDualSignatureFromDB: %Constructor -> %Form
getDualSignatureFromDB ctor ==
GETDATABASE(ctor,"COSIG")
-getConstructorPredicatesFromDB: %Constructor -> %List %Thing
-getConstructorPredicatesFromDB ctor ==
- GETDATABASE(ctor,"PREDICATES")
+getConstructorPredicates: %Constructor -> %List %Thing
+getConstructorPredicates ctor ==
+ dbPredicates loadDBIfnecessary constructorDB ctor
getConstructorParentsFromDB: %Constructor -> %List %Constructor
getConstructorParentsFromDB ctor ==
@@ -127,9 +127,9 @@ getSuperDomainFromDB: %Constructor -> %Form
getSuperDomainFromDB ctor ==
GETDATABASE(ctor,"SUPERDOMAIN")
-getConstructorAttributesFromDB: %Constructor -> %Form
-getConstructorAttributesFromDB ctor ==
- GETDATABASE(ctor,"ATTRIBUTES")
+getConstructorAttributes: %Constructor -> %Form
+getConstructorAttributes ctor ==
+ dbAttributes loadDBIfnecessary constructorDB ctor
niladicConstructor?: %Constructor -> %Boolean
niladicConstructor? ctor ==
diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot
index 2a086cf9..a09c86d4 100644
--- a/src/interp/i-funsel.boot
+++ b/src/interp/i-funsel.boot
@@ -1607,7 +1607,7 @@ hasAtt(dom,att,SL) ==
-- needs S0 similar to hasSig above ??
$domPvar: local := nil
fun := dom.op =>
- atts:= subCopy(getConstructorAttributesFromDB fun,constructSubst dom) =>
+ atts:= subCopy(getConstructorAttributes fun,constructSubst dom) =>
cons? (u := getInfovec dom.op) =>
--UGH! New world has attributes stored as pairs not as lists!!
for [x,:cond] in atts until S isnt 'failed repeat
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index 37724492..c3940cf4 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -2266,7 +2266,7 @@ reportOpsFromLisplib(op,u) ==
centerAndHighlight('"Attributes",$LINELENGTH,specialChar 'hbar)
sayBrightly '""
attList:= removeDuplicates MSORT [x for [x,:.] in
- getConstructorAttributesFromDB op]
+ getConstructorAttributes op]
null attList => sayBrightly
concat('"%b",form2String functorForm,'"%d","has no attributes.",'"%l")
say2PerLine [formatAttribute x for x in attList]
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index eba02971..de732ec2 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -665,7 +665,7 @@ newHasTest(domform,catOrAtt) ==
-- on second thoughts we won't!
categoryForm? domform =>
domform = catOrAtt => 'T
- for [aCat,:cond] in [:ancestorsOf(domform,nil),:applySubst(pairList($FormalMapVariableList,rest domform),getConstructorAttributesFromDB(opOf domform))] | aCat = catOrAtt repeat
+ for [aCat,:cond] in [:ancestorsOf(domform,nil),:applySubst(pairList($FormalMapVariableList,rest domform),getConstructorAttributes(opOf domform))] | aCat = catOrAtt repeat
return evalCond cond where
evalCond x ==
x isnt [.,:.] => x
diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot
index 4829d5e0..b776e748 100644
--- a/src/interp/showimp.boot
+++ b/src/interp/showimp.boot
@@ -51,7 +51,7 @@ showImp(dom,:options) ==
missingOnlyFlag := KAR options
domainForm := devaluate dom
[nam,:$domainArgs] := domainForm
- $predicateList: local := getConstructorPredicatesFromDB nam
+ $predicateList: local := getConstructorPredicates nam
predVector := domainPredicates dom
u := getDomainOpTable(dom,true)
--sort into 4 groups: domain exports, unexports, default exports, others
@@ -99,7 +99,7 @@ showFrom(D,:option) ==
alist := nil
domainForm := devaluate D
[nam,:.] := domainForm
- $predicateList: local := getConstructorPredicatesFromDB nam
+ $predicateList: local := getConstructorPredicates nam
for (opSig := [op,sig]) in getDomainSigs1(D,ops) repeat
u := from?(D,op,sig)
x := assoc(u,alist) => x.rest := [opSig,:rest x]
@@ -113,12 +113,12 @@ showFrom(D,:option) ==
--=======================================================================
getDomainOps D ==
conname := insantiationCtor D
- $predicateList: local := getConstructorPredicatesFromDB conname
+ $predicateList: local := getConstructorPredicates conname
removeDuplicates listSort(function GLESSEQP,ASSOCLEFT getDomainOpTable(D,nil))
getDomainSigs(D,:option) ==
conname := instantiationCtor D
- $predicateList: local := getConstructorPredicatesFromDB conname
+ $predicateList: local := getConstructorPredicates conname
getDomainSigs1(D,first option)
getDomainSigs1(D,ops) == listSort(function GLESSEQP,u) where
@@ -127,7 +127,7 @@ getDomainSigs1(D,ops) == listSort(function GLESSEQP,u) where
getDomainDocs(D,:option) ==
conname := instantiationCtor D
- $predicateList: local := getConstructorPredicatesFromDB conname
+ $predicateList: local := getConstructorPredicates conname
ops := KAR option
[[op,sig,:getInheritanceByDoc(D,op,sig)] for [op,sig] in getDomainSigs1(D,ops)]
@@ -208,7 +208,7 @@ showPredicates dom ==
sayBrightly '"--------------------Predicate summary-------------------"
conname := instantiationCtor dom
predvector := domainPredicates dom
- predicateList := getConstructorPredicatesFromDB conname
+ predicateList := getConstructorPredicates conname
for i in 1.. for p in predicateList repeat
prefix :=
testBitVector(predvector,i) => '"true : "
@@ -332,7 +332,7 @@ dcOpTable con ==
name := abbreviation? con or con
$infovec: local := getInfovec name
template := $infovec.0
- $predvec: local := getConstructorPredicatesFromDB con
+ $predvec: local := getConstructorPredicates con
opTable := $infovec.1
for i in 0..maxIndex opTable repeat
op := opTable.i
@@ -378,7 +378,7 @@ dcSig(numvec,index,numOfArgs) ==
dcPreds con ==
name := abbreviation? con or con
$infovec: local := getInfovec name
- $predvec:= getConstructorPredicatesFromDB con
+ $predvec:= getConstructorPredicates con
for i in 0..maxIndex $predvec repeat
sayBrightlyNT bright (i + 1)
sayBrightly pred2English $predvec.i
@@ -386,7 +386,7 @@ dcPreds con ==
dcAtts con ==
name := abbreviation? con or con
$infovec: local := getInfovec name
- $predvec:= getConstructorPredicatesFromDB con
+ $predvec:= getConstructorPredicates con
attList := $infovec.2
for [a,:predNumber] in attList for i in 0.. repeat
sayBrightlyNT bright i
@@ -400,7 +400,7 @@ dcCats con ==
$infovec: local := getInfovec name
u := $infovec.3
vector? CDDR u => dcCats1 con --old style slot4
- $predvec:= getConstructorPredicatesFromDB con
+ $predvec:= getConstructorPredicates con
catpredvec := first u
catinfo := second u
catvec := third u
@@ -418,7 +418,7 @@ dcCats con ==
sayBrightly concat(form2String formatSlotDomain form,suffix,extra)
dcCats1 con ==
- $predvec:= getConstructorPredicatesFromDB con
+ $predvec:= getConstructorPredicates con
u := $infovec.3
catvec := second u
catinfo := first u
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-28 03:41:50 +0000