Re: Prolog Execution Algorithm


"Struiver" <dieter.vanderelst@xxxxxxxxx> ha scritto nel messaggio
news:1129839379.263031.271080@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
> Hello,
>
> I'm looking for a good explanation of the algorithm (pseudocode ?) that
> prolog uses to solve a query.
>
> I know that the book by Ivan Bratko features a version of the
> algorithm, but I'm looking for a more elaborate version (with
> particular attention to the handling of variables).
>
> Thanks.
>

Some 20 years ago I wrote a simple Prolog interpreter, not using the WAM,
but the basic ABC algorithm.
This one implements the resolution, left to right, top down, keeping a stack
of calls and backtrack related info, like trail & variables.
You will see than query() procedure has more than three labels inside, to
handle some detail, like last call (tail recursion) optimization or builtin
interface.
Instantiation of variables is handled without copy, building chains of
shared values, directly in the unify() procedure.
So where values must be interfaced, some work is required to recover the
computed structure (of course, these values are binded to an interpreter'
instance).
The language runs without modification Clocksin-Mellish programs, with
object orientated extension (engine instance creation/query),
handled mainly from the DB interface, with some builtin to support syntax
changes.
C++ code should be fairly portable (except of course OLE related stuff...).
I choosed a MSVC oriented approach, so this Prolog is actually an MFC
extension DLL, exposing an interface on each engine to
load/define programs and query, passing structured terms or strings.

I used actually the interpreter for some time & real work.
Is you are interested, I could mail you the entire project source code, I
hope still working.

My best regards.

Ing. Capelli Carlo

//--------------------------
// evaluation core of query
// use algorithm ABC
//
int IntlogExec::query(const Clause *q)
{
unsigned nc = 0;

ProofStack::Env *pcn, *pfn;
stkpos cn, fn;
#define PCN (pcn = ps->get(cn))
#define PFN (pfn = ps->get(fn))

UnifyStack us(vs, ts);

if (!q)
goto C;

fn = ps->push(STKNULL);
PFN->vspos = vs->reserve(q->get_nvars());
pfn->trail = ts->curr_dim();
pfn->dbpos = 0;
pfn->call = 0;

// current query is empty?
A: if (!q->get_body()) {

// search untried calls
A1: //fn = ps->curr_dim() - 1;
fn = cn;

ProofStack::Env *e = ps->get(fn);
while (e->father != STKNULL) {
if (tr && e->call && tr->exit(fn, e->call))
return -1;
if (e->call && !e->call->is_last())
break;
e = ps->get(fn = e->father);
}
if (e->father == STKNULL)
return 1;

// set call to next untried brother
cn = ps->push(PFN->father);
PCN->call = pfn->call->next();
pcn->vspos = pfn->vspos;
fn = pfn->father;

} else {
cn = ps->push(fn);
PCN->call = q->get_body();
}

A2: PFN;
pcn->dbpos = 0;
cc = pcn->call;

if (nc++ == ncycle)
{
nc = 0;
sighandler();
}

// trace the call
if (tr && tr->call(cn, cc))
return -1;

switch (cc->get_type()) {

case CallData::BUILTIN: {
BuiltIn *btp = cc->get_builtin();

pcn->trail = ts->curr_dim();
pcn->vspos = pfn->vspos;

// if evaluate OK
if (btp->eval(cc->args(), this, 0)) {
goto A1;
}

PCN;

if (tr && tr->fail(cn, pcn->call))
return -1;

unbind(pcn->trail);
}
goto C1;

case CallData::CUT: {
stkpos gf = PFN->father;
if ( gf != STKNULL &&
pfn->call->is_last() &&
pfn->call == pcn->call->next()) {
// tail recursion optimization
ProofStack::Env *pgf = ps->get(gf);
pgf->vspos = pfn->vspos;

ASSERT(!pcn->call->is_last());

slist_iter s(tmpt);
ElemTmp *t;
while ((t = (ElemTmp*)s.next()) != 0 && t->spos > fn)
t->spos = fn;

CallData *cproc = pcn->call;
cn = ps->pop(cn - fn) - 1;
PCN->call = cproc->next();
fn = pcn->father;

goto A2;
}

pcn->trail = ts->curr_dim();
pcn->vspos = pfn->vspos;
}
goto A1;

case CallData::DISJUNCT: // replace with catenated try
pcn->vspos = pfn->vspos;
pcn->trail = ts->curr_dim();
cn = ps->push(fn);
PCN->call = cc->next(); // left side
goto A2;

case CallData::DBPRED:

// initialize DB search
pcn->dbpos = db->StartProc(cc->get_dbe());

// DB matching & unification
B: if (pcn->dbpos && (q = pcn->dbpos->get()) != 0) {

unsigned nvars = q->get_nvars();
pcn->vspos = vs->reserve(nvars);
pcn->trail = ts->curr_dim();

/*
if (!unify( pfn->vspos, cc->args(),
pcn->vspos, q->h_args(), q->h_arity()))
*/
if (q->h_arity() > 0) {
TermArgs pa1 = cc->args(),
pa2 = q->h_args();

us.clear();
for (int i = q->h_arity() - 1; i > 0; i--) {
UnifyStack::termPair *tp = us.push();
tp->t1 = pa1.getarg(i);
tp->i1 = pfn->vspos;
tp->t2 = pa2.getarg(i);
tp->i2 = pcn->vspos;
}
us.check_overflow();

if (!us.work( pa1.getarg(0), pfn->vspos,
pa2.getarg(0), pcn->vspos))
{
// undo changes
unbind(pcn->trail);
vs->pop(nvars);

// try next match
pcn->dbpos = pcn->dbpos->succ(db);
goto B;
}
}

fn = cn;
goto A;
}
break;

default:
ASSERT(0);
}

if (tr && PCN->call && tr->fail(cn, cc))
return -1;

// backtracking
C1: query_fail(ps->curr_dim() - cn);

// resume top query
C: cn = ps->curr_dim() - 1;
unbind(PCN->trail);

C2: if ((fn = pcn->father) == STKNULL)
return 0;

if ((cc = pcn->call) == 0)
goto C1;

switch (cc->get_type()) {

case CallData::CUT: { // change satisfaction path up to father
stkpos fvp = PFN->vspos;
query_fail(cn - fn + 1);
if ((cn = ps->curr_dim() - 1) != STKNULL) {
unbind(PCN->trail);
vs->pop(vs->curr_dim() - fvp);
goto C2;
}
return 0;
}

case CallData::BUILTIN: { // check builtins retry
BuiltIn *btp = cc->get_builtin();

if (btp->args & BuiltIn::retry) {

if (tr && tr->redo(cn, cc))
return -1;

// could be resatisfied
pcn->trail = ts->curr_dim();
pcn->vspos = PFN->vspos;

// if evaluate OK
if (btp->eval(cc->args(), this, 1))
goto A1;
}

// failed
goto C1;
}

case CallData::DISJUNCT: // evaluate right side
if (tr && tr->redo(cn, cc))
return -1;

pcn->call = cc->get_orelse();
goto A2;

case CallData::DBPRED: // a DB query node to retry
if (tr) { // display REDOs (TBD)
if (pcn->dbpos && pcn->dbpos->succ(db) && tr->redo(cn, cc))
return -1;
}
vs->pop(vs->curr_dim() - pcn->vspos);
pcn->dbpos = pcn->dbpos->succ(db);
PFN;
goto B;

default:
ASSERT(0);
}

return -1;
}


//-----------------------------------------------------
// generate MGU of terms t1, t2
// return 0 if failure (t1, t2 don't unify)
//
// the simple stacked, abstract algorithm is keep from
// 'The Art Of Intlog' by Sterling & Shapiro
//
int UnifyStack::work(Term t1, stkpos envp1, Term t2, stkpos envp2)
{
termPair *tp;

for ( ; ; )
{
if (t1.type(f_VAR)) // here be dragons!
{
if (Var(t1) == ANONYM_IX)
goto next;
stkpos ix1 = Var(t1) + envp1;
if ((t1 = vs->getvar(ix1, &envp1, &ix1)).type(f_NOTERM))
{
if (t2.type(f_VAR))
{
if (Var(t2) == ANONYM_IX)
goto next;
ts->bind(ix1);
stkpos ix2 = Var(t2) + envp2;
if ((t2 = vs->getvar(ix2, &envp2, &ix2)).type(f_NOTERM))
{
if (ix1 != ix2)
vs->setshare(ix1, ix2);
}
else
vs->setvar(ix1, t2, envp2);
}
else
{
ts->bind(ix1);
vs->setvar(ix1, t2, envp2);
}
goto next;
}
}

if (t2.type(f_VAR))
{
if (Var(t2) == ANONYM_IX)
goto next;
stkpos ix2 = Var(t2) + envp2;
if ((t2 = vs->getvar(ix2, &envp2, &ix2)).type(f_NOTERM)) {
ts->bind(ix2);
vs->setvar(ix2, t1, envp1);
goto next;
}
}

if (!t2.type(t1.type()))
return 0;

switch (t1.type())
{

case f_ATOM:
case f_INT:
if (TermData(t1) != TermData(t2))
return 0;
break;

case f_DOUBLE:
if (Double(t1) != Double(t2))
return 0;
break;

case f_STRUCT:
{
Term *pa1, *pa2;
int na1, na2;
if (t1.structData(&pa1, &na1) != t2.structData(&pa2, &na2) ||
na1 != na2)
return 0;

for (int i = na1 - 1; i >= 0; i--)
{
tp = push();
tp->t1 = pa1[i];
tp->i1 = envp1;
tp->t2 = pa2[i];
tp->i2 = envp2;
}
check_overflow();
}
break;

case f_LIST:
if (t1.LNULL() && t2.LNULL())
goto next;
if (!t1.LNULL() && !t2.LNULL())
{
const List& l1 = t1, &l2 = t2;

tp = push();
tp->t1 = l1.tail();
tp->i1 = envp1;
tp->t2 = l2.tail();
tp->i2 = envp2;

tp = push();
tp->t1 = l1.head();
tp->i1 = envp1;
tp->t2 = l2.head();
tp->i2 = envp2;

check_overflow();
}
else
return 0;
break;

case f_SYSDATA:
if (!SysDataPtr(t1)->unify(t2))
return 0;
break;

default:
ASSERT(0);
}

next:
if (free == 0)
return 1;

tp = v + --free;

t1 = tp->t1;
envp1 = tp->i1;
t2 = tp->t2;
envp2 = tp->i2;
}
}



.

Relevant Pages

  • Re: Which query is running
    ... GetAddress is the name of a function which combines and formats the address ... Each query could contain more than 1 output field that need parameters to be ... This is part of a Club database. ... On Error GoTo GetParameters_Err ...
    (comp.databases.ms-access)
  • Re: Remove Carriage return in BATCH file
    ... call:getSource "%key%\%%A")) ... 'reg.exe query "%~1\SourceList" /V LastUsedSource' ... GOTO:EOF ...
    (microsoft.public.win2000.cmdprompt.admin)
  • Re: Remove Carriage return in BATCH file
    ... call:getSource "%key%\%%A")) ... 'reg.exe query "%~1\SourceList" /V LastUsedSource' ... GOTO:EOF ...
    (microsoft.public.win2000.cmdprompt.admin)
  • Re: Which query is running
    ... the query be a parameter query taking the QueryName as an argument, ... On Error GoTo GetParameters_Err ... Set MyDb = CurrentDb ... Set ParamSet = MyDb.OpenRecordset ...
    (comp.databases.ms-access)
  • Re: YAPL - Yet Another Programming Language
    ... array for an out of order pair, swapping them then checking the array ... Can the algorithm be re-written to avoid the goto and remain as clear. ... construct that makes one sequential pass through a sequence. ...
    (comp.programming)