aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-08-28 10:48:31 +0000
committerdos-reis <gdr@axiomatics.org>2011-08-28 10:48:31 +0000
commitf4c22b31e5b7232f5d41d8d729cbb7e0e633adee (patch)
tree35d1cec5fcf06fbe6bb030ecbd3eadb5c245f47b
parent6634594622ba229e94c7fba18430a5edbb8c22bc (diff)
downloadopen-axiom-f4c22b31e5b7232f5d41d8d729cbb7e0e633adee.tar.gz
* interp/define.boot (compDefineCategory2): Mark begining and end
of definition processing. (compDefineFunctor1): Likewise. * interp/daase.lisp (dbPrincipals): New accessor. * interp/br-data.boot (getDefaultPackageClients): Fix thinko. * interp/lisplib.boot (writeAncestors): New. (finalizeLisplib): Use it
-rw-r--r--src/ChangeLog10
-rw-r--r--src/interp/br-data.boot2
-rw-r--r--src/interp/daase.lisp9
-rw-r--r--src/interp/define.boot7
-rw-r--r--src/interp/lisplib.boot5
5 files changed, 27 insertions, 6 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 5cb13b36..f426bf10 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,13 @@
+2011-08-28 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/define.boot (compDefineCategory2): Mark begining and end
+ of definition processing.
+ (compDefineFunctor1): Likewise.
+ * interp/daase.lisp (dbPrincipals): New accessor.
+ * interp/br-data.boot (getDefaultPackageClients): Fix thinko.
+ * interp/lisplib.boot (writeAncestors): New.
+ (finalizeLisplib): Use it
+
2011-08-27 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/lisplib.boot (writeInstanceCache): Remove.
diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot
index b11b2adf..e8b1ba7b 100644
--- a/src/interp/br-data.boot
+++ b/src/interp/br-data.boot
@@ -427,7 +427,7 @@ mkUsersHashTable() == --called by buildDatabase (database.boot)
getDefaultPackageClients con == --called by mkUsersHashTable
catname := makeSymbol subString(s := symbolName con,0,maxIndex s)
for [catAncestor,:.] in childrenOf([catname]) repeat
- pakname := makeDefaultPackageName symbolName catAncestor
+ pakname := makeDefaultPackageName symbolName catAncestor.op
if getCDTEntry(pakname,true) then acc := [pakname,:acc]
acc := union([CAAR x for x in domainsOf([catAncestor],nil)],acc)
listSort(function GLESSEQP,acc)
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 16a63f22..678c390f 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -260,6 +260,9 @@
(defmacro |dbCategory| (db)
`(database-constructorcategory ,db))
+(defmacro |dbPrincipals| (db)
+ `(database-parents ,db))
+
(defmacro |dbAncestors| (db)
`(database-ancestors ,db))
@@ -702,7 +705,7 @@
(setf (database-documentation dbstruct) (fourth item))
(setf (|dbAttributes| dbstruct) (fifth item))
(setf (|dbPredicates| dbstruct) (sixth item))
- (setf (database-parents dbstruct) (seventh item))))
+ (setf (|dbPrincipals| dbstruct) (seventh item))))
(format t "~&")))
(defun categoryOpen ()
@@ -912,7 +915,7 @@
(parents
(setq stream *browse-stream*)
(when struct
- (setq data (database-parents struct))))
+ (setq data (|dbPrincipals| struct))))
(users
(setq stream *browse-stream*)
(when struct
@@ -967,7 +970,7 @@
(documentation
(setf (database-documentation struct) data))
(parents
- (setf (database-parents struct) data))
+ (setf (|dbPrincipals| struct) data))
(superdomain
(setf (|dbSuperDomain| struct) data))
(users
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 70800868..5331907c 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -998,7 +998,9 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
--Set in DomainSubstitutionFunction, used further down
-- 1.1 augment e to add declaration $: <form>
[$op,:argl] := $definition
- dbInstanceCache(constructorDB $op) := true
+ db := constructorDB $op
+ dbBeingDefined?(db) := true
+ dbInstanceCache(db) := true
e:= addBinding("$",[['mode,:$definition]],e)
-- 2. obtain signature
@@ -1059,6 +1061,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
$lisplibAncestors := computeAncestorsOf($form,nil)
form':=[op',:sargl]
augLisplibModemapsFromCategory(form',formalBody,signature')
+ dbBeingDefined?(db) := false
[fun,$Category,e]
mkConstructor: %Form -> %Form
@@ -1338,6 +1341,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
originale:= $e
[$op,:argl]:= form
db := constructorDB $op
+ dbBeingDefined?(db) := true
dbConstructorForm(db) := form
$formalArgList:= [:argl,:$formalArgList]
$pairlis: local := pairList(argl,$FormalMapVariableList)
@@ -1446,6 +1450,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
if $bootStrapMode then
evalAndRwriteLispForm('%incomplete,
['MAKEPROP, ['QUOTE,op'], ['QUOTE,'%incomplete], true])
+ dbBeingDefined?(db) := false
[fun,['Mapping,:signature'],originale]
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index f0477250..dc2e587b 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -557,6 +557,9 @@ writeOperations(ctor,ops,file) ==
writeConstructorModemap(ctor,mm,file) ==
writeInfo(ctor,mm,'constructorModemap,'dbConstructorModemap,file)
+writeAncestors(ctor,x,file) ==
+ writeInfo(ctor,x,'ancestors,'dbAncestors,file)
+
++ If compilation produces an error, issue inform user and
++ return to toplevel reader.
leaveIfErrors(libName,kind) ==
@@ -594,7 +597,7 @@ finalizeLisplib(ctor,libName) ==
lisplibWrite('"predicates",removeZeroOne $lisplibPredicates,$libFile)
lisplibWrite('"abbreviation",dbAbbreviation constructorDB ctor,$libFile)
lisplibWrite('"parents",removeZeroOne $lisplibParents,$libFile)
- lisplibWrite('"ancestors",removeZeroOne $lisplibAncestors,$libFile)
+ writeAncestors(ctor,removeZeroOne $lisplibAncestors,$libFile)
lisplibWrite('"documentation",finalizeDocumentation ctor,$libFile)
lisplibWrite('"slot1Info",removeZeroOne $lisplibSlot1,$libFile)
if $profileCompiler then profileWrite()