diff options
| -rw-r--r-- | src/ChangeLog | 10 | ||||
| -rw-r--r-- | src/interp/br-data.boot | 2 | ||||
| -rw-r--r-- | src/interp/daase.lisp | 9 | ||||
| -rw-r--r-- | src/interp/define.boot | 7 | ||||
| -rw-r--r-- | src/interp/lisplib.boot | 5 |
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() |