diff options
| -rw-r--r-- | src/ChangeLog | 8 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 2 | ||||
| -rw-r--r-- | src/interp/daase.lisp | 9 | ||||
| -rw-r--r-- | src/interp/database.boot | 59 | ||||
| -rw-r--r-- | src/interp/types.boot | 3 |
5 files changed, 50 insertions, 31 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index a68e3b99..3ede6c74 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,13 @@ 2012-05-23 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/database.boot (%Constructor): New. + (makeConstructor): Likewise. + (makeInitialDB): Tidy. + * interp/daase.lisp (makeDB): Take two more parameters. Build a + %Constructor structure object too. + +2012-05-23 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/sys-driver.boot (initializeDatabases): Load initidb if specified. * interp/database.boot (populateDFFromFile): Remove. diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index b8ec4c5f..21140ca3 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -50,7 +50,7 @@ module c_-util where registerConstructor: (%Symbol,%Env) -> %Env currentConstructor: %Env -> %Maybe %Symbol -- functor data manipulation - dbInfovec: %Constructor -> %Maybe %FunctorData + dbInfovec: %Symbol -> %Maybe %FunctorData --% Accessors of domain and category objects diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index 6d989a2c..d8175d90 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -310,9 +310,12 @@ (defmacro |dbLookupFunction| (db) `(database-lookup-function ,db)) -(defun |makeDB| (c) +(defun |makeDB| (c &optional (k nil) (a nil)) (let ((db (make-database))) + (|makeConstructor| c k a) (setf (|dbConstructor| db) c) + (setf (|dbConstructorKind| db) k) + (setf (|dbAbbreviation| db) a) (setf (|constructorDB| c) db))) ; there are only a small number of domains that have default domains. @@ -464,16 +467,14 @@ (dolist (item constructors) (setq item (unsqueeze item)) (setq *allconstructors* (adjoin (first item) *allconstructors*)) - (setq dbstruct (|makeDB| (first item))) + (setq dbstruct (|makeDB| (first item) (ninth item) (seventh item))) (setf (|dbOperations| dbstruct) (second item)) (setf (|dbConstructorModemap| dbstruct) (third item)) (setf (|dbModemaps| dbstruct) (fourth item)) (setf (|dbModule| dbstruct) (fifth item)) (setf (|dbCategory| dbstruct) (sixth item)) - (setf (|dbAbbreviation| dbstruct) (seventh item)) (setf (get (seventh item) 'abbreviationfor) (first item)) ;invert (setf (|dbDualSignature| dbstruct) (eighth item)) - (setf (|dbConstructorKind| dbstruct) (ninth item)) (setf (|dbAncestors| dbstruct) (nth 10 item)) (setf (|dbSuperDomain| dbstruct) (nth 11 item)) )) diff --git a/src/interp/database.boot b/src/interp/database.boot index a8527d29..61040869 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -59,32 +59,45 @@ pathToDatabase name == --% -getConstructorAbbreviationFromDB: %Constructor -> %Symbol +structure %Constructor == + Record(name: %Symbol,kind: %ConstructorKind,abbrev: %Symbol, + xparms: %List %Symbol) with + constructorName == (.name) + constructtorKind == (.kind) + constructrorAbbreviation == (.abbrev) + constructorExplicitParameters == (.xparms) + +makeConstructor(s,k == nil,a == nil) == + symbolValue(s) := mk%Constructor(s,k,a,nil) + +--% + +getConstructorAbbreviationFromDB: %Symbol -> %Symbol getConstructorAbbreviationFromDB ctor == GETDATABASE(ctor,"ABBREVIATION") -getConstructorCategory: %Constructor -> %Form +getConstructorCategory: %Symbol -> %Form getConstructorCategory ctor == getConstructorKindFromDB ctor = 'category => GETDATABASE(ctor,"CONSTRUCTORCATEGORY") getConstructorModemap(ctor).mmTarget -getConstructorKindFromDB: %Constructor -> %Maybe %ConstructorKind +getConstructorKindFromDB: %Symbol -> %Maybe %ConstructorKind getConstructorKindFromDB ctor == GETDATABASE(ctor,"CONSTRUCTORKIND") -getConstructorAncestorsFromDB: %Constructor -> %List %Constructor +getConstructorAncestorsFromDB: %Symbol -> %List %Constructor getConstructorAncestorsFromDB ctor == GETDATABASE(ctor,"ANCESTORS") ++ return the modemap of the constructor or the instantiation ++ of the constructor `form'. -getConstructorModemap: %Constructor -> %Mode +getConstructorModemap: %Symbol -> %Mode getConstructorModemap ctor == GETDATABASE(ctor, 'CONSTRUCTORMODEMAP) or dbConstructorModemap loadDBIfNecessary constructorDB ctor -getConstructorFormFromDB: %Constructor -> %Form +getConstructorFormFromDB: %Symbol -> %Form getConstructorFormFromDB ctor == GETDATABASE(ctor,"CONSTRUCTORFORM") @@ -96,56 +109,56 @@ genericInstanceForm form == builtinConstructor? op => builtinInstanceForm form getConstructorFormFromDB op -getConstructorSourceFileFromDB: %Constructor -> %Maybe %String +getConstructorSourceFileFromDB: %Symbol -> %Maybe %String getConstructorSourceFileFromDB ctor == GETDATABASE(ctor,"SOURCEFILE") -getConstructorModuleFromDB: %Constructor -> %Maybe %String +getConstructorModuleFromDB: %Symbol -> %Maybe %String getConstructorModuleFromDB ctor == GETDATABASE(ctor,"OBJECT") -getConstructorDocumentationFromDB: %Constructor -> %List %Form +getConstructorDocumentationFromDB: %Symbol -> %List %Form getConstructorDocumentationFromDB ctor == GETDATABASE(ctor,"DOCUMENTATION") -getConstructorOperationsFromDB: %Constructor -> %List %List %Form +getConstructorOperationsFromDB: %Symbol -> %List %List %Form getConstructorOperationsFromDB ctor == GETDATABASE(ctor,"OPERATIONALIST") -getConstructorFullNameFromDB: %Symbol -> %Constructor +getConstructorFullNameFromDB: %Symbol -> %Symbol getConstructorFullNameFromDB ctor == GETDATABASE(ctor,"CONSTRUCTOR") -getConstructorArgsFromDB: %Constructor -> %List %Symbol +getConstructorArgsFromDB: %Symbol -> %List %Symbol getConstructorArgsFromDB ctor == GETDATABASE(ctor,"CONSTRUCTORARGS") ++ returns a list of Boolean values indicating whether the ++ parameter type at the corresponding position is a category. -getDualSignature: %Constructor -> %Form +getDualSignature: %Symbol -> %Form getDualSignature ctor == db := constructorDB ctor or return nil dbDualSignature db or GETDATABASE(ctor,'COSIG) -getConstructorPredicates: %Constructor -> %List %Thing +getConstructorPredicates: %Symbol -> %List %Thing getConstructorPredicates ctor == db := constructorDB ctor dbBeingDefined? db => dbPredicates db dbPredicates loadDBIfNecessary db -getConstructorParentsFromDB: %Constructor -> %List %Constructor +getConstructorParentsFromDB: %Symbol -> %List %Symbol getConstructorParentsFromDB ctor == GETDATABASE(ctor,"PARENTS") -getSuperDomainFromDB: %Constructor -> %Form +getSuperDomainFromDB: %Symbol -> %Form getSuperDomainFromDB ctor == GETDATABASE(ctor,"SUPERDOMAIN") -getConstructorAttributes: %Constructor -> %Form +getConstructorAttributes: %Symbol -> %Form getConstructorAttributes ctor == dbAttributes loadDBIfNecessary constructorDB ctor -niladicConstructor?: %Constructor -> %Boolean +niladicConstructor?: %Symbol -> %Boolean niladicConstructor? ctor == form := getConstructorFormFromDB ctor => form.args = nil false @@ -154,7 +167,7 @@ constructorHasCategoryFromDB: %Pair(%Thing,%Thing) -> %List %Code constructorHasCategoryFromDB p == GETDATABASE(p,"HASCATEGORY") -getConstructorDefaultFromDB: %Constructor -> %Maybe %Symbol +getConstructorDefaultFromDB: %Symbol -> %Maybe %Symbol getConstructorDefaultFromDB ctor == GETDATABASE(ctor,"DEFAULTDOMAIN") @@ -167,12 +180,12 @@ getOperationModemapsFromDB op == GETDATABASE(op,"MODEMAPS") -getConstructorArity: %Constructor -> %Short +getConstructorArity: %Symbol -> %Short getConstructorArity ctor == sig := getConstructorSignature ctor => #rest sig -1 -getConstructorKind: %Constructor -> %Maybe %ConstructorKind +getConstructorKind: %Symbol -> %Maybe %ConstructorKind getConstructorKind ctor == kind := getConstructorKindFromDB ctor => kind is "domain" and isDefaultPackageName ctor => "package" @@ -779,10 +792,8 @@ squeezeAll x == [SQUEEZE t for t in x] makeInitialDB [form,kind,abbrev,srcfile] == - db := makeDB form.op + db := makeDB(form.op,kind,abbrev) dbConstructorForm(db) := form - dbConstructorKind(db) := kind - dbAbbreviation(db) := abbrev property(abbrev,'ABBREVIATIONFOR) := form.op dbSourceFile(db) := srcfile setAutoLoadProperty form.op diff --git a/src/interp/types.boot b/src/interp/types.boot index 592c70e5..f230b67c 100644 --- a/src/interp/types.boot +++ b/src/interp/types.boot @@ -38,8 +38,7 @@ namespace BOOT %Alist(s,t) <=> %List %Pair(s,t) -- association list -%Constructor <=> %Symbol -- constructor -%Instantiation <=> [%Constructor,:%Form] -- constructor instance +%Instantiation <=> [%Symbol,:%Form] -- constructor instance %Modemap <=> %List(%Form) -- modemap |