diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

support for tabling

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@951 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-12-18 16:38:40 +00:00
parent 0c2a3b4aff
commit 221665bab8
18 changed files with 285 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
C/absmi.c
View File

@ -1139,7 +1139,7 @@ Yap_absmi(int inp)
UNLOCK(cl->ClLock);
}
#else
if (B->cp_tr[-1] == CLREF_TO_TRENTRY(cl) &&
if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) &&
B->cp_tr > B->cp_b->cp_tr) {
cl->ClFlags &= ~InUseMask;
TR = --B->cp_tr;
@ -1419,7 +1419,14 @@ Yap_absmi(int inp)
/* trust_fail */
BOp(trust_fail, e);
#ifdef YAPOR
CUT_prune_to((choiceptr) d0);
#else
B = B->cp_b;
#endif /* YAPOR */
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
goto fail;
ENDBOp();
@ -1601,7 +1608,6 @@ Yap_absmi(int inp)
if ((ADDR) pt1 >= Yap_TrailBase)
#endif /* SBA */
{
pt1 = (tr_fr_ptr) pt1;
goto failloop;
}
#endif /* FROZEN_STACKS */

62
C/amasm.c
View File

@ -1245,6 +1245,9 @@ a_try(op_numbers opcode, CELL lab, CELL opr)
code_p->u.ld.d = emit_a(lab);
code_p->u.ld.s = emit_count(opr);
code_p->u.ld.p = CurrentPred;
#ifdef TABLING
code_p->u.ld.te = CurrentPred->TableOfPred;
#endif
#ifdef YAPOR
INIT_YAMOP_LTT(code_p, nofalts);
if (hascut)
@ -2016,9 +2019,11 @@ a_f2(int var)
#define TRYOP(G,P) (IPredArity<5 ? (op_numbers)((int)(P)+(IPredArity*3)) : (G))
#ifdef YAPOR
#define TRYCODE(G,P) a_try(TRYOP(G,P), Unsigned(code_addr) + label_offset[cpc->rnd1], IPredArity, cpc->rnd2 >> 1, cpc->rnd2 & 1);
#define TRYCODE(G,P) a_try(TRYOP(G,P), Unsigned(code_addr) + label_offset[cpc->rnd1], IPredArity, cpc->rnd2 >> 1, cpc->rnd2 & 1)
#define TABLE_TRYCODE(G) a_try(G, (CELL)emit_ilabel(cpc->rnd1), IPredArity, cpc->rnd2 >> 1, cpc->rnd2 & 1)
#else
#define TRYCODE(G,P) a_try(TRYOP(G,P), Unsigned(code_addr) + label_offset[cpc->rnd1], IPredArity);
#define TRYCODE(G,P) a_try(TRYOP(G,P), Unsigned(code_addr) + label_offset[cpc->rnd1], IPredArity)
#define TABLE_TRYCODE(G) a_try(G, (CELL)emit_ilabel(cpc->rnd1), IPredArity)
#endif /* YAPOR */
static yamop *
@ -2032,6 +2037,9 @@ do_pass(void)
#endif /* YAPOR */
int log_update;
int dynamic;
#ifdef TABLING
int tabled;
#endif
int ystop_found = FALSE;
union clause_obj *cl_u;
@ -2043,6 +2051,9 @@ do_pass(void)
/* Space while for the clause flags */
log_update = CurrentPred->PredFlags & LogUpdatePredFlag;
dynamic = CurrentPred->PredFlags & DynamicPredFlag;
#ifdef TABLING
tabled = CurrentPred->PredFlags & TabledPredFlag;
#endif
if (assembling != ASSEMBLING_INDEX) {
if (log_update) {
if (pass_no) {
@ -2128,6 +2139,9 @@ do_pass(void)
case table_new_answer_op:
a_n(_table_new_answer, (int) cpc->rnd2);
break;
case table_try_single_op:
a_gl(_table_try_single);
break;
#endif /* TABLING */
#ifdef TABLING_INNER_CUTS
case clause_with_cut_op:
@ -2359,35 +2373,65 @@ do_pass(void)
a_deallocate();
break;
case tryme_op:
TRYCODE(_try_me, _try_me0);
#ifdef TABLING
if (tabled)
TABLE_TRYCODE(_table_try_me);
else
#endif
TRYCODE(_try_me, _try_me0);
break;
case retryme_op:
TRYCODE(_retry_me, _retry_me0);
#ifdef TABLING
if (tabled)
TABLE_TRYCODE(_table_retry_me);
else
#endif
TRYCODE(_retry_me, _retry_me0);
break;
case trustme_op:
if (log_update && assembling == ASSEMBLING_INDEX) {
a_cl(_trust_logical_pred);
a_gl(_trust_logical_pred);
}
TRYCODE(_trust_me, _trust_me0);
#ifdef TABLING
if (tabled)
TABLE_TRYCODE(_table_trust_me);
else
#endif
TRYCODE(_trust_me, _trust_me0);
break;
case enter_lu_op:
a_lucl(_enter_lu_pred);
break;
case try_op:
a_gl(_try_clause);
#ifdef TABLING
if (tabled)
a_gl(_table_try);
else
#endif
a_gl(_try_clause);
break;
case retry_op:
if (log_update) {
add_clref(cpc->rnd1);
}
a_gl(_retry);
#ifdef TABLING
if (tabled)
a_gl(_table_retry);
else
#endif
a_gl(_retry);
break;
case trust_op:
if (log_update) {
add_clref(cpc->rnd1);
a_cl(_trust_logical_pred);
}
a_gl(_trust);
#ifdef TABLING
if (tabled)
a_gl(_table_trust);
else
#endif
a_gl(_trust);
break;
case try_in_op:
a_il(_try_in);

23
C/cdmgr.c
View File

@ -151,13 +151,6 @@ IPred(PredEntry *ap)
{
yamop *BaseAddr;
#ifdef TABLING
if (is_tabled(ap)) {
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
ap->OpcodeOfPred = ap->CodeOfPred->opc;
return;
}
#endif /* TABLING */
#ifdef DEBUG
if (Yap_Option['i' - 'a' + 1]) {
Term tmod = ModuleName[ap->ModuleOfPred];
@ -235,7 +228,11 @@ RemoveMainIndex(PredEntry *ap)
if (First != NULL && spied) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->cs.p_code.TrueCodeOfPred = ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
} else if (ap->cs.p_code.NOfClauses > 1) {
} else if (ap->cs.p_code.NOfClauses > 1
#ifdef TABLING
||ap->PredFlags & TabledPredFlag
#endif
) {
ap->OpcodeOfPred = INDEX_OPCODE;
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
} else {
@ -657,10 +654,9 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag)
#endif /* YAPOR */
#ifdef TABLING
if (is_tabled(p)) {
pt->u.ld.te = p->TableOfPred; XXXXX
pt->opc = Yap_opcode(_table_try_me_single);
p->OpcodeOfPred = INDEX_OPCODE;
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
}
else
#endif /* TABLING */
}
p->cs.p_code.TrueCodeOfPred = pt;
@ -800,11 +796,6 @@ asserta_stat_clause(PredEntry *p, yamop *q, int spy_flag)
#ifdef YAPOR
PUT_YAMOP_LTT(q, YAMOP_LTT((yamop *)(p->cs.p_code.FirstClause)) + 1);
#endif /* YAPOR */
#ifdef TABLING
if (is_tabled(p)) XXX
q->opc = Yap_opcode(_table_try_me);
else
#endif /* TABLING */
p->cs.p_code.FirstClause = q;
p->cs.p_code.TrueCodeOfPred = q;
if (p->PredFlags & SpiedPredFlag) {

1
C/computils.c
View File

@ -624,6 +624,7 @@ static char *opformat[] =
#endif /* YAPOR */
#ifdef TABLING
"table_new_answer",
"table_try_single\t%g\t%x",
#endif /* TABLING */
#ifdef TABLING_INNER_CUTS
"clause_with_cut",

13
C/dbase.c
View File

@ -1789,10 +1789,8 @@ record_lu(PredEntry *pe, Term t, int position)
LogUpdClause *cl;
int needs_vars = FALSE;
WRITE_LOCK(pe->PRWLock);
ipc = NEXTOP(((LogUpdClause *)NULL)->ClCode,e);
if ((x = (DBTerm *)CreateDBStruct(t, NULL, 0, &needs_vars, (UInt)ipc)) == NULL) {
WRITE_UNLOCK(pe->PRWLock);
return NULL; /* crash */
}
cl = (LogUpdClause *)((ADDR)x-(UInt)ipc);
@ -1812,6 +1810,7 @@ record_lu(PredEntry *pe, Term t, int position)
ipc->opc = Yap_opcode(_copy_idb_term);
else
ipc->opc = Yap_opcode(_unify_idb_term);
WRITE_LOCK(pe->PRWLock);
Yap_add_logupd_clause(pe, cl, (position == MkFirst ? 2 : 0));
WRITE_UNLOCK(pe->PRWLock);
return cl;
@ -1829,7 +1828,6 @@ p_rcda(void)
if (!IsVarTerm(Deref(ARG3)))
return (FALSE);
pe = find_lu_entry(t1);
WRITE_LOCK(pe->PRWLock);
restart_record:
Yap_Error_Size = 0;
if (pe) {
@ -4366,7 +4364,12 @@ p_instance_module(void)
Term t1 = Deref(ARG1);
DBRef dbr;
if (IsVarTerm(t1) || !IsDBRefTerm(t1)) {
if (IsVarTerm(t1)) {
return FALSE;
}
if (IsDBRefTerm(t1)) {
dbr = DBRefOfTerm(t1);
} else {
if (IsIntegerTerm(t1))
dbr = (DBRef)IntegerOfTerm(t1);
else
@ -4375,8 +4378,6 @@ p_instance_module(void)
if (dbr > (DBRef)Yap_HeapBase && dbr < (DBRef)HeapTop && dbr->id != FunctorDBRef) {
return FALSE;
}
} else {
dbr = DBRefOfTerm(t1);
}
if (dbr->Flags & LogUpdMask) {
LogUpdClause *cl = (LogUpdClause *)dbr;

10
C/heapgc.c
View File

@ -1490,9 +1490,9 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
op_numbers caller_op = Yap_op_from_opcode(ENV_ToOp(gc_B->cp_cp));
/* first condition checks if this was a meta-call */
if ((caller_op != _call && caller_op != _fcall) || pe == NULL) {
fprintf(Yap_stderr,"[GC] marked %d (%s)\n", total_marked, op_names[opnum]);
fprintf(Yap_stderr,"[GC] marked %ld (%s)\n", total_marked, op_names[opnum]);
} else
fprintf(Yap_stderr,"[GC] %s/%d marked %d (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked, op_names[opnum]);
fprintf(Yap_stderr,"[GC] %s/%d marked %ld (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked, op_names[opnum]);
}
break;
case _trie_retry_var:
@ -1505,7 +1505,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
case _trie_trust_list:
case _trie_retry_struct:
case _trie_trust_struct:
fprintf(Yap_stderr,"[GC] marked %d (%s)\n", total_marked, op_names[opnum]);
fprintf(Yap_stderr,"[GC] marked %ld (%s)\n", total_marked, op_names[opnum]);
break;
#endif
default:
@ -1640,6 +1640,8 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
break;
case _table_retry_me:
case _table_trust_me:
case _table_retry:
case _table_trust:
{
register gen_cp_ptr gcp = GEN_CP(gc_B);
int nargs = rtp->u.ld.s;
@ -2312,6 +2314,8 @@ sweep_choicepoints(choiceptr gc_B)
break;
case _table_retry_me:
case _table_trust_me:
case _table_retry:
case _table_trust:
{
register gen_cp_ptr gcp = GEN_CP(gc_B);
int nargs;

47
C/index.c
View File

@ -1550,10 +1550,13 @@ add_info(ClauseDef *clause, UInt regno)
case _sync:
#endif
#ifdef TABLING
case _table_try_me_single:
case _table_try_single:
case _table_try_me:
case _table_retry_me:
case _table_trust_me:
case _table_try:
case _table_retry:
case _table_trust:
case _table_answer_resolution:
case _table_completion:
#endif
@ -1597,6 +1600,7 @@ add_info(ClauseDef *clause, UInt regno)
case _getwork_first_time:
#endif
#ifdef TABLING
case _table_new_answer:
case _trie_do_var:
case _trie_trust_var:
case _trie_try_var:
@ -2335,7 +2339,7 @@ emit_retry(ClauseDef *cl, PredEntry *ap, int clauses)
}
static compiler_vm_op
emit_optry(int var_group, int first, int clauses, int clleft)
emit_optry(int var_group, int first, int clauses, int clleft, PredEntry *ap)
{
/* var group */
if (var_group || clauses == 0) {
@ -2347,8 +2351,13 @@ emit_optry(int var_group, int first, int clauses, int clleft)
return trust_op;
}
} else if (clleft == 0) {
/* last group */
return try_op;
if (ap->PredFlags & TabledPredFlag && !first) {
/* we never actually get to remove the last choice-point in this case */
return retry_op;
} else {
/* last group */
return try_op;
}
} else {
/* nonvar group */
return try_in_op;
@ -2359,7 +2368,7 @@ emit_optry(int var_group, int first, int clauses, int clleft)
static void
emit_try(ClauseDef *cl, PredEntry *ap, int var_group, int first, int clauses, int clleft, UInt nxtlbl)
{
compiler_vm_op comp_op = emit_optry(var_group, first, clauses, clleft);
compiler_vm_op comp_op = emit_optry(var_group, first, clauses, clleft, ap);
Yap_emit(comp_op, (CELL)(cl->CurrentCode), ((clauses+clleft) << 1) | has_cut(cl->CurrentCode) );
}
@ -2635,6 +2644,25 @@ count_funcs(GroupDef *grp)
static UInt
emit_single_switch_case(ClauseDef *min, PredEntry *ap, int first, int clleft, UInt nxtlbl)
{
#ifdef TABLING
if (ap->PredFlags & TabledPredFlag) {
/* we have two differences with tabling:
1. we cannot allow straight jumps to clauses, otherwise thetabled
would never get to be created.
2. we don't clean trust at the very end of computation.
*/
if (clleft == 0) {
UInt lbl = new_label();
Yap_emit(label_op, lbl, Zero);
if (first) {
Yap_emit(table_try_single_op, (UInt)(min->CurrentCode), has_cut(cl->CurrentCode));
} else {
Yap_emit(trust_op, (UInt)(min->CurrentCode), has_cut(cl->CurrentCode));
}
return lbl;
}
}
#endif
return (UInt)(min->CurrentCode);
}
@ -2834,6 +2862,13 @@ emit_protection_choicepoint(int first, int clleft, UInt nxtlbl, PredEntry *ap)
/* !first */
if (clleft) {
Yap_emit(retryme_op, nxtlbl, (clleft << 1));
} else if ((ap->PredFlags & TabledPredFlag)) {
/*
we cannot get rid of the choice-point for tabled predicates, all
kinds of hell would follow, so we just keep it around: not nice,
but should work.
*/
Yap_emit(retryme_op, (CELL)TRUSTFAILCODE, 0);
} else {
Yap_emit(trustme_op, 0, 0);
}
@ -6178,7 +6213,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yam
UNLOCK(cl->ClLock);
}
#else
if (B->cp_tr[-1] == CLREF_TO_TRENTRY(cl) &&
if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) &&
B->cp_tr > B->cp_b->cp_tr) {
cl->ClFlags &= ~InUseMask;
/* clear the entry from the trail */

5
C/init.c
View File

@ -1140,9 +1140,12 @@ Yap_InitStacks(int Heap,
aux_delayed_release_load);
#else /* Yap */
Yap_InitMemory (Trail, Heap, Stack);
#endif /* YAPOR || TABLING */
AtomHashTableSize = MaxHash;
HashChain = (AtomHashEntry *)Yap_AllocAtomSpace(sizeof(AtomHashEntry) * MaxHash);
#endif /* YAPOR || TABLING */
if (HashChain == NULL) {
Yap_Error(FATAL_ERROR,MkIntTerm(0),"allocating initial atom table");
}
for (i = 0; i < MaxHash; ++i) {
INIT_RWLOCK(HashChain[i].AERWLock);
HashChain[i].Entry = NIL;

4
C/tracer.c
View File

@ -115,10 +115,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
/* extern int gc_calls; */
vsc_count++;
if (vsc_count == 716559119LL)
vsc_xstop=1;
if (vsc_count < 716558000LL)
return;
#ifdef COMMENTED
if (port != enter_pred ||
!pred ||

5
H/YapOpcodes.h
View File

@ -29,10 +29,13 @@
OPCODE(sync ,ld),
#endif /* YAPOR */
#ifdef TABLING
OPCODE(table_try_me_single ,ld),
OPCODE(table_try_me ,ld),
OPCODE(table_retry_me ,ld),
OPCODE(table_trust_me ,ld),
OPCODE(table_try_single ,ld),
OPCODE(table_try ,ld),
OPCODE(table_retry ,ld),
OPCODE(table_trust ,ld),
OPCODE(table_new_answer ,s),
OPCODE(table_answer_resolution ,ld),
OPCODE(table_completion ,ld),

1
H/compile.h
View File

@ -138,6 +138,7 @@ typedef enum compiler_op {
#endif /* YAPOR */
#ifdef TABLING
table_new_answer_op,
table_try_single_op,
#endif /* TABLING */
#ifdef TABLING_INNER_CUTS
clause_with_cut_op,

5
H/rheap.h
View File

@ -648,10 +648,13 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode)
case _sync:
#endif
#ifdef TABLING
case _table_try_me_single:
case _table_try_single:
case _table_try_me:
case _table_retry_me:
case _table_trust_me:
case _table_try:
case _table_retry:
case _table_trust:
case _table_answer_resolution:
case _table_completion:
#endif /* TABLING */

122
OPTYap/tab.insts.i
View File

@ -189,7 +189,7 @@
PBOp(table_try_me_single, ld)
PBOp(table_try_single, ld)
tab_ent_ptr tab_ent;
sg_node_ptr sg_node;
sg_fr_ptr sg_fr;
@ -221,7 +221,7 @@
#endif /* TABLE_LOCK_LEVEL */
LOCAL_top_sg_fr = sg_fr;
store_generator_node(YENV, PREG->u.ld.s, COMPLETION, sg_fr);
PREG = NEXTOP(PREG, ld);
PREG = PREG->u.ld.d;
PREFETCH_OP(PREG);
allocate_environment(YENV);
GONext();
@ -386,6 +386,115 @@
ENDPBOp();
PBOp(table_try, ld)
tab_ent_ptr tab_ent;
sg_node_ptr sg_node;
sg_fr_ptr sg_fr;
CELL *Yaddr;
Yaddr = YENV;
check_trail();
tab_ent = PREG->u.ld.te;
#ifdef TABLE_LOCK_AT_ENTRY_LEVEL
LOCK(TabEnt_lock(tab_ent));
#endif /* TABLE_LOCK_LEVEL */
sg_node = subgoal_search(tab_ent, PREG->u.ld.s, &Yaddr);
YENV = Yaddr;
#if defined(TABLE_LOCK_AT_NODE_LEVEL)
LOCK(TrNode_lock(sg_node));
#elif defined(TABLE_LOCK_AT_WRITE_LEVEL)
LOCK_TABLE(sg_node);
#endif /* TABLE_LOCK_LEVEL */
if (TrNode_sg_fr(sg_node) == NULL) {
/* new tabled subgoal */
new_subgoal_frame(sg_fr, sg_node, PREG->u.ld.s, LOCAL_top_sg_fr);
TrNode_sg_fr(sg_node) = (sg_node_ptr) sg_fr;
#if defined(TABLE_LOCK_AT_ENTRY_LEVEL)
UNLOCK(TabEnt_lock(tab_ent));
#elif defined(TABLE_LOCK_AT_NODE_LEVEL)
UNLOCK(TrNode_lock(sg_node));
#elif defined(TABLE_LOCK_AT_WRITE_LEVEL)
UNLOCK_TABLE(sg_node);
#endif /* TABLE_LOCK_LEVEL */
LOCAL_top_sg_fr = sg_fr;
store_generator_node(YENV, PREG->u.ld.s, NEXTOP(PREG,ld), sg_fr);
PREG = PREG->u.ld.d;
PREFETCH_OP(PREG);
allocate_environment(YENV);
GONext();
} else {
/* tabled subgoal not new */
#if defined(TABLE_LOCK_AT_ENTRY_LEVEL)
UNLOCK(TabEnt_lock(tab_ent));
#elif defined(TABLE_LOCK_AT_NODE_LEVEL)
UNLOCK(TrNode_lock(sg_node));
#elif defined(TABLE_LOCK_AT_WRITE_LEVEL)
UNLOCK_TABLE(sg_node);
#endif /* TABLE_LOCK_LEVEL */
sg_fr = (sg_fr_ptr) TrNode_sg_fr(sg_node);
LOCK(SgFr_lock(sg_fr));
if (SgFr_state(sg_fr)) {
/* subgoal completed */
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
if (SgFr_first_answer(sg_fr) == NULL) {
/* no answers --> fail */
goto fail;
} else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
/* yes answer --> procceed */
PREG = (yamop *) CPREG;
PREFETCH_OP(PREG);
YENV = ENV;
GONext();
} else {
/* answers -> load first answer */
PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr));
PREFETCH_OP(PREG);
*--YENV = 0; /* vars_arity */
*--YENV = 0; /* heap_arity */
GONext();
}
} else {
/* subgoal not completed */
choiceptr leader_cp;
int leader_dep_on_stack;
find_dependency_node(sg_fr, leader_cp, leader_dep_on_stack);
UNLOCK(SgFr_lock(sg_fr));
find_leader_node(leader_cp, leader_dep_on_stack);
store_consumer_node(YENV, sg_fr, leader_cp, leader_dep_on_stack);
#ifdef OPTYAP_ERRORS
if (PARALLEL_EXECUTION_MODE) {
choiceptr aux_cp;
aux_cp = B;
while (YOUNGER_CP(aux_cp, LOCAL_top_cp_on_stack))
aux_cp = aux_cp->cp_b;
if (aux_cp->cp_or_fr != DepFr_top_or_fr(LOCAL_top_dep_fr))
OPTYAP_ERROR_MESSAGE("Error on DepFr_top_or_fr (table_try_me)");
aux_cp = B;
while (YOUNGER_CP(aux_cp, DepFr_leader_cp(LOCAL_top_dep_fr)))
aux_cp = aux_cp->cp_b;
if (aux_cp != DepFr_leader_cp(LOCAL_top_dep_fr))
OPTYAP_ERROR_MESSAGE("Error on DepFr_leader_cp (table_try_me)");
}
#endif /* OPTYAP_ERRORS */
goto answer_resolution;
}
}
ENDPBOp();
Op(table_retry, ld)
restore_generator_node(B, PREG->u.ld.s, NEXTOP(PREG,ld));
YENV = (CELL *) PROTECT_FROZEN_B(B);
set_cut(YENV, B->cp_b);
SET_BB(NORM_CP(YENV));
allocate_environment(YENV);
PREG = PREG->u.ld.d;
GONext();
ENDOp();
Op(table_retry_me, ld)
restore_generator_node(B, PREG->u.ld.s, PREG->u.ld.d);
@ -409,6 +518,15 @@
GONext();
ENDOp();
Op(table_trust, ld)
restore_generator_node(B, PREG->u.ld.s, COMPLETION);
YENV = (CELL *) PROTECT_FROZEN_B(B);
set_cut(YENV, B->cp_b);
SET_BB(NORM_CP(YENV));
allocate_environment(YENV);
PREG = PREG->u.ld.d;
GONext();
ENDOp();
PBOp(table_new_answer, s)

3
docs/yap.tex
View File

@ -4863,6 +4863,9 @@ true if the predicate is exported in the current module.
@item public
true if the predicate is public; note that all dynamic predicates are
public.
@item tabled
true if the predicate is tabled; note that only static predicates can
be tabled in YAP.
@item source
true if source for the predicate is available.
@item number_of_clauses(@var{ClauseCount})

4
pl/init.yap
View File

@ -131,6 +131,8 @@ system_mode(verbose,off) :- set_value('$verbose',off).
:- module(user).
:- current_module(X), write(X).
:- multifile goal_expansion/3.
:- dynamic_predicate(goal_expansion/3, logical).
@ -157,5 +159,3 @@ library_directory(D) :-
:- get_value(system_library_directory,D), assert(library_directory(D)).

5
pl/modules.yap
View File

@ -180,10 +180,7 @@ module(N) :-
'$current_module'(_,N),
get_value('$consulting_file',F),
( recordzifnot('$module','$module'(N),_) -> true; true),
( recorded('$module','$module'(F,N,[]),_) ->
true ;
recorda('$module','$module'(F,N,[]),_)
).
( recordaifnot('$module','$module'(F,N,[]),_) -> true, true).
module(N) :-
'$do_error'(type_error(atom,N),module(N)).

5
pl/preds.yap
View File

@ -809,7 +809,10 @@ predicate_property(Pred,Prop) :-
'$system_predicate'(P,M), !.
'$predicate_property'(P,M,_,source) :-
'$flags'(G,M,F,F),
( F /\ 0x00400000 =\= 0 -> true ; false).
F /\ 0x00400000 =\= 0.
'$predicate_property'(P,M,_,tabled) :-
'$flags'(G,M,F,F),
F /\ 0x00000040 =\= 0.
'$predicate_property'(P,M,_,dynamic) :-
'$is_dynamic'(P,M).
'$predicate_property'(P,M,_,static) :-

29
pl/tabling.yap
View File

@ -20,7 +20,7 @@
table(M:X) :- !,
'$table'(X, M).
table(X) :-
current_module(M),
'$current_module'(M),
'$table'(X, M).
'$table'(X, _) :- var(X), !,
@ -30,17 +30,24 @@ table(X) :-
'$table'(M:A, _) :- !, '$table'(A, M).
'$table'((A,B), M) :- !, '$table'(A, M), '$table'(B, M).
'$table'(A/N, M) :- integer(N), atom(A), !,
functor(T,A,N), '$flags'(T,M,F,F),
(
X is F /\ 0x1991F880, X =:= 0, !, '$do_table'(T, M)
;
'$do_error'(permission_error(modify,static_procedure,A/N),tabled(Mod:A/N))
).
functor(P, A, N),
'$declare_tabled'(P, M).
'$table'(X, _) :- write(user_error, '[ Error: '),
write(user_error, X),
write(user_error, ' is an invalid argument to table/1 ]'),
nl(user_error),
fail.
write(user_error, X),
write(user_error, ' is an invalid argument to table/1 ]'),
nl(user_error),
fail.
'$declare_tabled'(P, M) :-
'$undefined'(P, M), !,
'$do_table'(P, M).
'$declare_tabled'(P, M) :-
'$flags'(P,M,F,F),
X is F /\ 0x1991F880, X =:= 0, !,
'$do_table'(P, M).
'$declare_tabled'(P, M) :-
functor(P, A, N),
'$do_error'(permission_error(modify,static_procedure,A/N),tabled(Mod:A/N)).
abolish_trie(M:X) :- !,
'$abolish_trie'(X, M).