//////////////////////////////////
// list all entries with property
//
void DbIntlog::EntriesWithProperty(DbEntry::scopemode vProp, slist &l) const
{
if (vProp == DbEntry::local)
{
slist_iter i(m_types);
DbIntlog *db;
while ((db = (DbIntlog*)i.next()) != 0)
{
EntryWithProp *ewp = new EntryWithProp;
ewp->id = db->GetId();
ewp->arity = -1;
l.append(ewp);
}
}
else
{
hashtable_iter it(this);
DbEntry *dbe;
while ((dbe = (DbEntry*)it.next()) != 0)
if (dbe->vProp == vProp)
{
EntryWithProp *ewp = new EntryWithProp;
ewp->id = dbe->funct;
ewp->arity = dbe->arity;
l.append(ewp);
}
}
}
///////////////////////////////////////
// on qualified name, select direct DB
//
DbIntlog *DbIntlog::FixPathName(Term *t) const
{
DbIntlog *db = (DbIntlog*)this;
Term r = *t;
while (db && r.is_expr(Operator::PATHNAME) && r.getarg(0).type(f_ATOM))
{
kstring dbid = r.getarg(0).kstr();
if (!strcmp(dbid, ".."))
db = db->m_father;
else
{
DbInherIter itdb(db);
while ((db = itdb.next()) != 0)
if (db->GetId() == dbid)
break;
}
if (db)
r = r.getarg(1);
}
*t = r;
return db;
}
ostream& DbIntlog::Display(ostream& s, int mode) const
{
indent(mode, s) << '{' << m_name << ' ' << this;
if (mode & Header)
s << " #entries " << get_nentries() << " #size " << get_vsize();
s << endl;
inc();
if (mode & PropInt)
{
indent(mode, s) << "Inherits:";
DbInherIter it(this);
DbIntlog *pDb;
while ((pDb = it.next()) != 0)
s << ' ' << pDb->m_name;
s << endl;
}
if (mode & Entries)
{
indent(mode, s) << "Entries:" << endl;
hashtable_iter it(this);
DbEntry *e;
while ((e = (DbEntry*)it.next()) != 0)
e->Display(s, mode);
}
if (m_types.numel() > 0)
{
indent(mode, s) << "Local Types DB" << endl;
slist_iter dbit(m_types);
const DbIntlog *dbt;
while ((dbt = (const DbIntlog *)dbit.next()) != 0)
dbt->Display(s, mode) << endl;
}
if (mode & Recurs)
{
DbInherIter it(this);
DbIntlog *pDb;
while ((pDb = it.next()) != 0)
pDb->Display(s, mode);
s << endl;
}
return dec(mode, s) << '}' << endl;
}
/////////////////////////////
// search in inheritance list
//
DbEntry* DbIntlog::find_inherited_entry(DbEntry *e, DbInherIter &l) const
{
DbEntry *dbe;
DbIntlog *db;
while ((db = l.next()) != 0)
if ((dbe = db->isin(e)) != 0)
return dbe;
return 0;
}
////////////////////////////
// look in local types list
//
DbIntlog *DbIntlog::IsLocalInterface(kstring id) const
{
#ifdef _DEBUG
CCP tstring = id;
#endif
slist_iter i(m_types);
DbIntlog *db;
while ((db = (DbIntlog*)i.next()) != 0)
if (db->GetId() == id)
break;
return db;
}
/////////////////////////////////////////
// i_begin(i_name) (+)
// insert i_name as local to current DB
// push empty DB(i_name)
//
BtFImpl(i_begin, a, p)
{
Term t;
if (!(t = p->eval_term(a.getarg(0))).type(f_ATOM)) {
p->BtErr(BTERR_INVALID_ARG_TYPE);
return 0;
}
DbIntlog *db = p->get_db();
kstring idi = t.kstr();
if ((db = db->BeginInterface(idi)) == 0) {
p->BtErr(BTERR_CANT_BEGINTERF, CCP(idi));
return 0;
}
p->set_db(db);
return 1;
}
///////////////////////////////////////////////////
// i_end(i_name) (+)
// pop current DB (interface became instantiable)
//
BtFImpl(i_end, a, p)
{
Term t;
if (!(t = p->eval_term(a.getarg(0))).type(f_ATOM)) {
p->BtErr(BTERR_INVALID_ARG_TYPE);
return 0;
}
DbIntlog *db = p->get_db();
kstring dbid = db->GetId(), idi = t.kstr();
if (dbid != idi || (db = db->EndInterface()) == 0) {
CCP sdb = MemStoreRef(dbid) != MSR_NULL ? dbid : "";
p->BtErr(BTERR_CANT_ENDINTERF, CCP(idi), sdb);
return 0;
}
p->set_db(db);
return 1;
}
//////////////////////////////////////////
// i_create(i_name, HandleEngine)
// create a new running interface (+, -)
//
BtFImpl(i_create, t, p)
{
ASSERT(all_engines);
ArgIdArityList i(t.getarg(0), p, "i_create");
if (!p->eval_term(t.getarg(1)).type(f_NOTERM)) {
p->BtErr(BTERR_INVALID_ARG_TYPE);
return 0;
}
EngHandle h = GetEngines()->create(p->get_db());
if (h == EH_NULL) {
p->BtErr(BTERR_CANT_CREATE_ENG);
return 0;
}
IntlogExec *pExec = GetEngines()->HtoD(h);
DbIntlog *engdb = pExec->get_db(), *dbi;
// scan all interfaces names
int errc = 0;
while (i.next()) {
// search for declared interface (from current to root)
if ((dbi = findint(p->get_db(), i.funct)) == 0)
errc = BTERR_CANT_FIND_DB;
else if (!engdb->InheritInterface(dbi))
errc = BTERR_CANT_INHERIT;
if (errc) {
// on error signal and reset
p->BtErr(errc, CCP(i.funct));
all_engines->destroy(h);
return 0;
}
}
return p->unify(p->save(Term(new EngineObj(h))), t.getarg(1));
}
//////////////////////////////////////////////
// remove all clauses entries indexed by file
//
DbIntlog *DbIntlog::RemoveFileClauses(kstring fileId, slistvptr &updated)
{
// if already updated, skip
if (updated.seek(this) != SLIST_INVPOS)
return 0;
hashtable_iter hit(this);
DbEntry *he;
DbIntlog *found = 0;
while ((he = (DbEntry *)hit.next()) != 0)
{
slist_iter lit(he->entries);
e_DbList *e;
while ((e = (e_DbList*)lit.next()) != 0)
if (e->type == e_DbList::tClause && e->clause && e->clause->get_source() == fileId)
{
e_DbList *eNew = new e_DbList(e->clause);
eNew->type = e->type;
m_deleted.insert(eNew, 0);
e->clause = 0;
found = this;
}
}
if (!found)
{
slist_iter dbit(m_types);
DbIntlog *dbt;
while ((dbt = (DbIntlog *)dbit.next()) != 0)
if ((found = dbt->RemoveFileClauses(fileId, updated)) != 0)
break;
}
else
updated.append(this);
return found;
}
void EngineObj::show(ostream &s) const
{
IntlogExec *eng = all_engines->HtoD(handler);
if (eng) {
s << '$' << handler << ':';
DbIntlog *db = eng->get_db();
kstring dbid = db->GetId();
if (unsigned(dbid) != MSR_NULL)
s << CCP(dbid);
s << ':';
DbInherIter ii(db);
while ((db = ii.next()) != 0) {
dbid = db->GetId();
if (unsigned(dbid) != MSR_NULL)
s << CCP(dbid);
s << ':';
}
} else
s << '~' << handler;
}
////////////////////////////////////
// resync clauses list
// this invalidate all DbEntryIter
//
void DbIntlog::ClearStatus(DbIntlog *owner)
{
slist_scan ld(m_deleted);
e_DbList *edbd;
while ((edbd = (e_DbList*)ld.next()) != 0)
{
Term tk = edbd->clause->get_head();
#ifdef _DEBUG
CCP tstring = tk.get_funct();
#endif
DbEntry x(tk.get_funct(), tk.get_arity());
DbEntry *dbe = isin(x);
ASSERT(dbe);
slist_scan tla(dbe->entries);
e_DbList *edbl;
while ((edbl = (e_DbList*)tla.next()) != 0)
if (edbl->clause == 0)
{
tla.delitem();
break;
}
if (!owner || edbd->type != e_DbList::tLocData ||
edbd->clause->get_db() == owner)
ld.delitem();
}
// clear all inherited DBs
DbInherIter it(this);
DbIntlog *db;
while ((db = (DbIntlog *)it.next()) != 0)
db->ClearStatus(this);
}
///////////////////////////////////
// storage entry point to database
//
void DbIntlog::Add(Clause *c, int first, DbIntlog *owner)
{
Term h = c->get_head();
ASSERT(!h.type(f_NOTERM));
#ifdef _DEBUG
CCP tstring = h.get_funct();
#endif
e_DbList *edbl = new e_DbList(c);
// retrieve or create the entry
kstring funct = h.get_funct();
int arity = h.get_arity();
DbEntry e(funct, arity), *dbe = isin(e);
// verify location on create
if (dbe == 0 && owner && owner != this)
dbe = owner->isin(e);
if (!dbe)
{
dbe = new DbEntry(funct, arity);
insert(dbe);
}
if (dbe->arity == -1)
dbe->arity = arity;
DbIntlog *dbwork = this;
if (dbe->vProp == DbEntry::dynamic)
{
if (!owner)
owner = this;
dbe = owner->isin(dbe);
ASSERT(dbe);
c->set_db(dbwork = owner);
}
else if (owner && owner != this)
{
edbl->type = e_DbList::tLocData;
c->set_db(owner);
}
if (first)
dbe->entries.insert(edbl, 0);
else
{
DbListSeek eref(e_DbList::tExtRef);
DbListSeek vtbl(e_DbList::tVTable);
unsigned iref = dbe->entries.seek(&eref);
unsigned itbl = dbe->entries.seek(&vtbl);
if (iref != SLIST_INVPOS)
dbe->entries.insert(edbl, iref);
else
if (itbl != SLIST_INVPOS)
dbe->entries.insert(edbl, itbl);
else
dbe->entries.append(edbl);
}
// close inheritance chainings
dbwork->check_inherited_entries(dbe);
}
/////////////////////////////////////////////
// i_proplist(NameInt,Property,List) (+,+,?)
// retrieve property name/arity list
// for required interface e property
//
BtFImpl(i_proplist, t, p)
{
Term NameInt = p->eval_term(t.getarg(0)),
Prop = p->eval_term(t.getarg(1)),
ListProp(ListNULL);
DbIntlog *db;
if ( !NameInt.type(f_ATOM) ||
!Prop.type(f_ATOM) ||
(db = findint(p->get_db(), NameInt.kstr())) == 0)
{ err:
p->BtErr(BTERR_INVALID_ARG_TYPE);
return 0;
}
// search for property
DbEntry::scopemode prop;
BuiltIn* bt = p->get_db()->is_builtin(Prop, 1);
if (!bt)
goto err;
if (bt->eval == i_export) prop = DbEntry::exported;
else
if (bt->eval == i_import) prop = DbEntry::import;
else
if (bt->eval == i_dynamic) prop = DbEntry::dynamic;
else
if (bt->eval == i_begin) prop = DbEntry::local;
else goto err;
slist lprop;
db->EntriesWithProperty(prop, lprop);
// transform the slist in Prolog List
if (lprop.numel() > 0) {
Term tail(f_NOTERM);
slist_iter it(lprop);
DbIntlog::EntryWithProp *pEntry;
while ((pEntry = (DbIntlog::EntryWithProp *)it.next()) != 0) {
// build the name/arity structure
Term sProp = Term(kstring(Operator::DIV), 2);
sProp.setarg(0, Term(kstring(pEntry->id)));
sProp.setarg(1, Term(Int(pEntry->arity)));
Term elem = Term(sProp, Term(ListNULL));
if (tail.type(f_NOTERM))
tail = ListProp = elem;
else {
tail.setarg(1, elem);
tail = elem;
}
}
ListProp = p->save(ListProp);
}
return p->unify(t.getarg(2), ListProp);
}
