put tabling back to work
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@460 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
83c4fab84c
commit
4fc1a2ff42
@ -353,7 +353,7 @@ BuildNewAttVar(Term t, Int i, Term tatt)
|
||||
H[0] = t;
|
||||
H[1] = tatt;
|
||||
H += 2;
|
||||
growglobal();
|
||||
growglobal(NULL);
|
||||
H -= 2;
|
||||
t = H[0];
|
||||
tatt = H[1];
|
||||
|
||||
@ -564,7 +564,7 @@ freeze_goal(Term t, Term g)
|
||||
if (H0 - (CELL *)vs < 1024) {
|
||||
ARG1 = t;
|
||||
ARG2 = g;
|
||||
growglobal();
|
||||
growglobal(NULL);
|
||||
t = ARG1;
|
||||
g = ARG2;
|
||||
}
|
||||
|
||||
27
C/exec.c
27
C/exec.c
@ -385,6 +385,9 @@ p_execute_within(void)
|
||||
/* Wow, we're gonna cut!!! */
|
||||
B = cut_pt;
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
HB = PROTECT_FROZEN_H(B);
|
||||
}
|
||||
return(TRUE);
|
||||
@ -481,6 +484,9 @@ p_execute_within2(void)
|
||||
/* Wow, we're gonna cut!!! */
|
||||
B = pt0;
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
HB = PROTECT_FROZEN_H(B);
|
||||
}
|
||||
return(TRUE);
|
||||
@ -1004,6 +1010,9 @@ execute_goal(Term t, int nargs, SMALLUNSGN mod)
|
||||
#else
|
||||
B = (choiceptr)(ENV[E_CB]);
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
/* find out where we have the old arguments */
|
||||
old_B = ((choiceptr)(ENV-(EnvSizeInCells+nargs+1)))-1;
|
||||
{
|
||||
@ -1033,12 +1042,18 @@ execute_goal(Term t, int nargs, SMALLUNSGN mod)
|
||||
if (YOUNGER_CP(OldTopB,DelayedB)) {
|
||||
/* and this delayed cut is to before the c-code that actually called us */
|
||||
B = OldTopB;
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
/* did we have a cut which was cutting more than our current cut? */
|
||||
if (OldDelayedB != NULL && YOUNGER_CP(DelayedB,OldDelayedB))
|
||||
DelayedB = OldDelayedB;
|
||||
} else {
|
||||
/* just cut back to where we should cut */
|
||||
B = DelayedB;
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
DelayedB = OldDelayedB;
|
||||
}
|
||||
}
|
||||
@ -1080,12 +1095,18 @@ execute_goal(Term t, int nargs, SMALLUNSGN mod)
|
||||
if (YOUNGER_CP(OldTopB,DelayedB)) {
|
||||
/* and this delayed cut is to before the c-code that actually called us */
|
||||
B = OldTopB;
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
/* did we have a cut which was cutting more than our current cut? */
|
||||
if (OldDelayedB != NULL && YOUNGER_CP(DelayedB,OldDelayedB))
|
||||
DelayedB = OldDelayedB;
|
||||
} else {
|
||||
/* just cut back to where we should cut */
|
||||
B = DelayedB;
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
DelayedB = OldDelayedB;
|
||||
}
|
||||
}
|
||||
@ -1230,6 +1251,9 @@ p_restore_regs2(void)
|
||||
#else
|
||||
B = pt0;
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
HB = B->cp_h;
|
||||
/* trim_trail();*/
|
||||
}
|
||||
@ -1304,6 +1328,9 @@ JumpToEnv(Term t) {
|
||||
if (first_func != NULL) {
|
||||
B = first_func;
|
||||
}
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
return(FALSE);
|
||||
}
|
||||
|
||||
|
||||
7
C/grow.c
7
C/grow.c
@ -523,7 +523,7 @@ local_growheap(long size, int fix_code)
|
||||
|
||||
/* Used by do_goal() when we're short of heap space */
|
||||
static int
|
||||
local_growglobal(long size)
|
||||
local_growglobal(long size, CELL **ptr)
|
||||
{
|
||||
Int start_growth_time, growth_time;
|
||||
int gc_verbose;
|
||||
@ -549,6 +549,7 @@ local_growglobal(long size)
|
||||
MoveGlobalOnly();
|
||||
AdjustStacksAndTrail();
|
||||
AdjustRegs(MaxTemps);
|
||||
*ptr = PtoLocAdjust(*ptr);
|
||||
YAPLeaveCriticalSection();
|
||||
ASP += 256;
|
||||
growth_time = cputime()-start_growth_time;
|
||||
@ -664,14 +665,14 @@ growheap(int fix_code)
|
||||
}
|
||||
|
||||
int
|
||||
growglobal(void)
|
||||
growglobal(CELL **ptr)
|
||||
{
|
||||
unsigned long sz = sizeof(CELL) * 16 * 1024L;
|
||||
|
||||
#ifdef FIXED_STACKS
|
||||
abort_optyap("noheapleft in function absmi");
|
||||
#endif
|
||||
if (!local_growglobal(sz))
|
||||
if (!local_growglobal(sz, ptr))
|
||||
return(FALSE);
|
||||
#ifdef TABLING
|
||||
fix_tabling_info();
|
||||
|
||||
231
C/heapgc.c
231
C/heapgc.c
@ -1177,6 +1177,10 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
||||
} else {
|
||||
if (trail_cell == (CELL)trail_ptr)
|
||||
discard_trail_entries++;
|
||||
#ifdef FROZEN_STACKS
|
||||
else
|
||||
mark_external_reference(&TrailVal(trail_ptr));
|
||||
#endif
|
||||
#ifdef EASY_SHUNTING
|
||||
if (hp < gc_H && hp >= H0) {
|
||||
tr_fr_ptr nsTR = (tr_fr_ptr)cont_top0;
|
||||
@ -1198,9 +1202,6 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
||||
RESET_VARIABLE(cptr);
|
||||
MARK(cptr);
|
||||
}
|
||||
#endif
|
||||
#ifdef FROZEN_STACKS
|
||||
mark_external_reference(&TrailVal(trail_ptr));
|
||||
#endif
|
||||
}
|
||||
} else if (IsPairTerm(trail_cell)) {
|
||||
@ -1309,6 +1310,9 @@ static void
|
||||
mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
||||
{
|
||||
|
||||
#ifdef TABLING
|
||||
dep_fr_ptr depfr = LOCAL_top_dep_fr;
|
||||
#endif
|
||||
#ifdef EASY_SHUNTING
|
||||
HB = H;
|
||||
#endif
|
||||
@ -1326,14 +1330,20 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
||||
num_bs++;
|
||||
#endif
|
||||
#ifdef TABLING
|
||||
/* ignore empty choicepoints */
|
||||
if (rtp == NULL) {
|
||||
gc_B = gc_B->cp_b;
|
||||
/* include consumers */
|
||||
if (depfr != NULL && gc_B >= DepFr_cons_cp(depfr)) {
|
||||
gc_B = DepFr_cons_cp(depfr);
|
||||
depfr = DepFr_next(depfr);
|
||||
continue;
|
||||
}
|
||||
if (rtp == NULL) {
|
||||
opnum = _table_completion;
|
||||
} else
|
||||
#endif
|
||||
op = rtp->opc;
|
||||
opnum = op_from_opcode(op);
|
||||
{
|
||||
op = rtp->opc;
|
||||
opnum = op_from_opcode(op);
|
||||
}
|
||||
if (very_verbose) {
|
||||
switch (opnum) {
|
||||
case _or_else:
|
||||
@ -1372,6 +1382,18 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
||||
}
|
||||
break;
|
||||
#endif
|
||||
case _trie_retry_var:
|
||||
case _trie_trust_var:
|
||||
case _trie_retry_val:
|
||||
case _trie_trust_val:
|
||||
case _trie_retry_atom:
|
||||
case _trie_trust_atom:
|
||||
case _trie_retry_list:
|
||||
case _trie_trust_list:
|
||||
case _trie_retry_struct:
|
||||
case _trie_trust_struct:
|
||||
YP_fprintf(YP_stderr,"[GC] marked %d (%s)\n", total_marked, op_names[opnum]);
|
||||
break;
|
||||
default:
|
||||
{
|
||||
PredEntry *pe = (PredEntry *)gc_B->cp_ap->u.ld.p;
|
||||
@ -1491,6 +1513,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
||||
case _table_completion:
|
||||
{
|
||||
register gen_cp_ptr gcp = GEN_CP(gc_B);
|
||||
int nargs;
|
||||
|
||||
#ifdef TABLING_BATCHED_SCHEDULING
|
||||
nargs = gcp->gcp_sg_fr->subgoal_arity;
|
||||
@ -1504,13 +1527,13 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
||||
saved_reg++;
|
||||
}
|
||||
}
|
||||
nargs = 0;
|
||||
break;
|
||||
case _table_retry_me:
|
||||
case _table_trust_me:
|
||||
{
|
||||
register gen_cp_ptr gcp = GEN_CP(gc_B);
|
||||
|
||||
nargs = rtp->u.ld.s;
|
||||
int nargs = rtp->u.ld.s;
|
||||
/* for each saved register */
|
||||
for (saved_reg = (CELL *)(gcp+1);
|
||||
/* assumes we can count registers in CP this
|
||||
@ -1525,6 +1548,50 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
||||
saved_reg++;
|
||||
}
|
||||
}
|
||||
nargs = 0;
|
||||
break;
|
||||
case _trie_retry_var:
|
||||
case _trie_trust_var:
|
||||
case _trie_retry_val:
|
||||
case _trie_trust_val:
|
||||
case _trie_retry_atom:
|
||||
case _trie_trust_atom:
|
||||
case _trie_retry_list:
|
||||
case _trie_trust_list:
|
||||
case _trie_retry_struct:
|
||||
case _trie_trust_struct:
|
||||
{
|
||||
CELL *aux_ptr;
|
||||
int heap_arity;
|
||||
int vars_arity;
|
||||
int subs_arity;
|
||||
|
||||
/* fetch the solution */
|
||||
aux_ptr = (CELL *)(gc_B+1);
|
||||
heap_arity = *aux_ptr;
|
||||
vars_arity = *(aux_ptr + heap_arity + 1);
|
||||
subs_arity = *(aux_ptr + heap_arity + 2);
|
||||
if (heap_arity) {
|
||||
int i;
|
||||
aux_ptr += heap_arity + subs_arity + vars_arity + 1;
|
||||
for (i = 0; i < heap_arity + subs_arity + vars_arity + 1; i++) {
|
||||
mark_external_reference(aux_ptr);
|
||||
aux_ptr--;
|
||||
}
|
||||
} else {
|
||||
int i;
|
||||
aux_ptr += 2 + subs_arity + vars_arity;
|
||||
for (i = 0; i < vars_arity; i++) {
|
||||
mark_external_reference(aux_ptr);
|
||||
aux_ptr--;
|
||||
}
|
||||
for (i = 1; i < subs_arity; i++) {
|
||||
aux_ptr--;
|
||||
mark_external_reference(aux_ptr);
|
||||
}
|
||||
}
|
||||
}
|
||||
nargs = 0;
|
||||
break;
|
||||
#endif
|
||||
#ifdef DEBUG
|
||||
@ -1673,10 +1740,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
|
||||
|
||||
trail_cell = TrailTerm(trail_ptr);
|
||||
|
||||
#ifdef FROZEN_STACKS
|
||||
/* it is complex to recover cells with frozen segments */
|
||||
TrailVal(dest) = TrailVal(trail_ptr);
|
||||
#else
|
||||
#ifndef FROZEN_STACKS
|
||||
/* recover a trail cell */
|
||||
if (trail_cell == (CELL)trail_ptr) {
|
||||
TrailTerm(dest) = trail_cell;
|
||||
@ -1692,6 +1756,16 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
|
||||
if (HEAP_PTR(trail_cell)) {
|
||||
into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell));
|
||||
}
|
||||
#ifdef FROZEN_STACKS
|
||||
/* it is complex to recover cells with frozen segments */
|
||||
TrailVal(dest) = TrailVal(trail_ptr);
|
||||
if (MARKED(TrailVal(dest))) {
|
||||
UNMARK(&TrailVal(dest));
|
||||
if (HEAP_PTR(TrailVal(dest))) {
|
||||
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailVal(dest)));
|
||||
}
|
||||
}
|
||||
#endif
|
||||
} else if ((CELL *)trail_cell < (CELL *)HeapTop) {
|
||||
/* we may have pointers from the heap back into the cell */
|
||||
CELL *next = GET_NEXT(*CellPtr(trail_cell));
|
||||
@ -1699,15 +1773,17 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
|
||||
if (HEAP_PTR(*CellPtr(trail_cell))) {
|
||||
into_relocation_chain(CellPtr(trail_cell),next);
|
||||
}
|
||||
}
|
||||
#ifdef FROZEN_STACKS
|
||||
if (MARKED(TrailVal(dest))) {
|
||||
UNMARK(&TrailVal(dest));
|
||||
if (HEAP_PTR(TrailVal(dest))) {
|
||||
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailVal(dest)));
|
||||
/* it is complex to recover cells with frozen segments */
|
||||
TrailVal(dest) = TrailVal(trail_ptr);
|
||||
if (MARKED(TrailVal(dest))) {
|
||||
UNMARK(&TrailVal(dest));
|
||||
if (HEAP_PTR(TrailVal(dest))) {
|
||||
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailVal(dest)));
|
||||
}
|
||||
}
|
||||
}
|
||||
#endif
|
||||
}
|
||||
} else if (IsPairTerm(trail_cell)) {
|
||||
CELL *pt0 = RepPair(trail_cell);
|
||||
CELL flags;
|
||||
@ -1859,6 +1935,7 @@ sweep_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
|
||||
|
||||
if (size > EnvSizeInCells) {
|
||||
int tsize = size - EnvSizeInCells;
|
||||
|
||||
|
||||
currv = sizeof(CELL)*8-tsize%(sizeof(CELL)*8);
|
||||
pvbmap += tsize/(sizeof(CELL)*8);
|
||||
@ -1906,6 +1983,9 @@ sweep_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
|
||||
static void
|
||||
sweep_choicepoints(choiceptr gc_B)
|
||||
{
|
||||
#ifdef TABLING
|
||||
dep_fr_ptr depfr = LOCAL_top_dep_fr;
|
||||
#endif
|
||||
|
||||
while(gc_B != NULL) {
|
||||
yamop *rtp = gc_B->cp_ap;
|
||||
@ -1913,14 +1993,20 @@ sweep_choicepoints(choiceptr gc_B)
|
||||
op_numbers opnum;
|
||||
|
||||
#ifdef TABLING
|
||||
/* ignore empty choicepoints */
|
||||
if (rtp == NULL) {
|
||||
gc_B = gc_B->cp_b;
|
||||
/* include consumers */
|
||||
if (depfr != NULL && gc_B >= DepFr_cons_cp(depfr)) {
|
||||
gc_B = DepFr_cons_cp(depfr);
|
||||
depfr = DepFr_next(depfr);
|
||||
continue;
|
||||
}
|
||||
if (rtp == NULL) {
|
||||
opnum = _table_completion;
|
||||
} else
|
||||
#endif
|
||||
op = rtp->opc;
|
||||
opnum = op_from_opcode(op);
|
||||
{
|
||||
op = rtp->opc;
|
||||
opnum = op_from_opcode(op);
|
||||
}
|
||||
|
||||
restart_cp:
|
||||
/*
|
||||
@ -1997,6 +2083,7 @@ sweep_choicepoints(choiceptr gc_B)
|
||||
into_relocation_chain(answ_fr, GET_NEXT(cp_cell));
|
||||
}
|
||||
}
|
||||
answ_fr++;
|
||||
}
|
||||
}
|
||||
break;
|
||||
@ -2065,6 +2152,69 @@ sweep_choicepoints(choiceptr gc_B)
|
||||
}
|
||||
}
|
||||
break;
|
||||
case _trie_retry_var:
|
||||
case _trie_trust_var:
|
||||
case _trie_retry_val:
|
||||
case _trie_trust_val:
|
||||
case _trie_retry_atom:
|
||||
case _trie_trust_atom:
|
||||
case _trie_retry_list:
|
||||
case _trie_trust_list:
|
||||
case _trie_retry_struct:
|
||||
case _trie_trust_struct:
|
||||
{
|
||||
CELL *aux_ptr;
|
||||
int heap_arity;
|
||||
int vars_arity;
|
||||
int subs_arity;
|
||||
|
||||
sweep_environments(gc_B->cp_env,
|
||||
EnvSize((CELL_PTR) (gc_B->cp_cp)),
|
||||
EnvBMap((CELL_PTR) (gc_B->cp_cp)));
|
||||
|
||||
/* fetch the solution */
|
||||
aux_ptr = (CELL *)(gc_B+1);
|
||||
heap_arity = *aux_ptr;
|
||||
vars_arity = *(aux_ptr + heap_arity + 1);
|
||||
subs_arity = *(aux_ptr + heap_arity + 2);
|
||||
if (heap_arity) {
|
||||
int i;
|
||||
aux_ptr += heap_arity + subs_arity + vars_arity + 1;
|
||||
for (i = 0; i < heap_arity + subs_arity + vars_arity + 1; i++) {
|
||||
CELL cp_cell = *aux_ptr;
|
||||
if (MARKED(cp_cell)) {
|
||||
UNMARK(aux_ptr);
|
||||
if (HEAP_PTR(cp_cell)) {
|
||||
into_relocation_chain(aux_ptr, GET_NEXT(cp_cell));
|
||||
}
|
||||
}
|
||||
aux_ptr--;
|
||||
}
|
||||
} else {
|
||||
int i;
|
||||
aux_ptr += 2 + subs_arity + vars_arity;
|
||||
for (i = 0; i < vars_arity; i++) {
|
||||
CELL cp_cell = *aux_ptr;
|
||||
if (MARKED(cp_cell)) {
|
||||
UNMARK(aux_ptr);
|
||||
if (HEAP_PTR(cp_cell)) {
|
||||
into_relocation_chain(aux_ptr, GET_NEXT(cp_cell));
|
||||
}
|
||||
}
|
||||
aux_ptr--;
|
||||
}
|
||||
for (i = 1; i < subs_arity; i++) {
|
||||
CELL cp_cell = *--aux_ptr;
|
||||
if (MARKED(cp_cell)) {
|
||||
UNMARK(aux_ptr);
|
||||
if (HEAP_PTR(cp_cell)) {
|
||||
into_relocation_chain(aux_ptr, GET_NEXT(cp_cell));
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
break;
|
||||
#endif
|
||||
case _retry_c:
|
||||
case _retry_userc:
|
||||
@ -2171,8 +2321,12 @@ update_relocation_chain(CELL_PTR current, CELL_PTR dest)
|
||||
#endif /* TAGS_FAST_OPS */
|
||||
}
|
||||
|
||||
#ifdef TABLING
|
||||
static dep_fr_ptr gl_depfr;
|
||||
#endif
|
||||
|
||||
static inline choiceptr
|
||||
update_B_H( choiceptr gc_B, CELL *current, CELL *dest, CELL *odest) {
|
||||
update_B_H( choiceptr gc_B, CELL *current, CELL *dest, CELL *odest) {
|
||||
/* also make the value of H in a choicepoint
|
||||
coherent with the new global
|
||||
*/
|
||||
@ -2183,8 +2337,14 @@ static inline choiceptr
|
||||
gc_B->cp_h = odest;
|
||||
}
|
||||
gc_B = gc_B->cp_b;
|
||||
#ifdef TABLING
|
||||
if (gl_depfr != NULL && gc_B >= DepFr_cons_cp(gl_depfr)) {
|
||||
gc_B = DepFr_cons_cp(gl_depfr);
|
||||
gl_depfr = DepFr_next(gl_depfr);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
return(gc_B);
|
||||
return(gc_B);
|
||||
}
|
||||
|
||||
/*
|
||||
@ -2200,6 +2360,7 @@ compact_heap(void)
|
||||
#endif /* DEBUG */
|
||||
choiceptr gc_B = B;
|
||||
int in_garbage = 0;
|
||||
|
||||
|
||||
|
||||
/*
|
||||
@ -2208,6 +2369,9 @@ compact_heap(void)
|
||||
* objects pointed to
|
||||
*/
|
||||
|
||||
#ifdef TABLING
|
||||
gl_depfr = LOCAL_top_dep_fr;
|
||||
#endif
|
||||
dest = (CELL_PTR) H0 + total_marked - 1;
|
||||
for (current = H - 1; current >= H0; current--) {
|
||||
if (MARKED(*current)) {
|
||||
@ -2353,6 +2517,9 @@ compact_heap(void)
|
||||
static void
|
||||
adjust_cp_hbs(void)
|
||||
{
|
||||
#ifdef TABLING
|
||||
dep_fr_ptr depfr = LOCAL_top_dep_fr;
|
||||
#endif
|
||||
choiceptr gc_B = B;
|
||||
CELL_PTR *top = iptop-1, *base = (CELL_PTR *)H;
|
||||
|
||||
@ -2391,7 +2558,13 @@ adjust_cp_hbs(void)
|
||||
}
|
||||
}
|
||||
}
|
||||
gc_B = gc_B->cp_b;
|
||||
#ifdef TABLING
|
||||
if (depfr != NULL && gc_B >= DepFr_cons_cp(depfr)) {
|
||||
gc_B = DepFr_cons_cp(depfr);
|
||||
depfr = DepFr_next(depfr);
|
||||
} else
|
||||
#endif
|
||||
gc_B = gc_B->cp_b;
|
||||
}
|
||||
}
|
||||
|
||||
@ -2653,7 +2826,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
|
||||
|
||||
#if COROUTINING
|
||||
if (H0 - (CELL *)ReadTimedVar(DelayedVars) < 1024+(2*NUM_OF_ATTS)) {
|
||||
growglobal();
|
||||
growglobal(¤t_env);
|
||||
}
|
||||
#endif
|
||||
#ifdef INSTRUMENT_GC
|
||||
|
||||
@ -112,14 +112,15 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
||||
/* extern int gc_calls; */
|
||||
|
||||
vsc_count++;
|
||||
/* if (vsc_count < 3829100) return;*/
|
||||
if (vsc_count == 656) {
|
||||
if (vsc_count < 618000) return;
|
||||
/* if (vsc_count == 656) {
|
||||
printf("Here I go\n");
|
||||
}
|
||||
*/
|
||||
/* if (vsc_count > 500000) exit(0); */
|
||||
/* if (gc_calls < 1) return;*/
|
||||
#if defined(__GNUC__)
|
||||
YP_fprintf(YP_stderr,"%llu ", vsc_count);
|
||||
YP_fprintf(YP_stderr,"%llu, %p ", vsc_count, H);
|
||||
#endif
|
||||
/* check_trail_consistency(); */
|
||||
if (pred == NULL) {
|
||||
|
||||
@ -10,7 +10,7 @@
|
||||
* File: Yap.proto *
|
||||
* mods: *
|
||||
* comments: Function declarations for YAP *
|
||||
* version: $Id: Yapproto.h,v 1.14 2002-03-07 05:13:21 vsc Exp $ *
|
||||
* version: $Id: Yapproto.h,v 1.15 2002-05-03 15:30:36 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* prototype file for Yap */
|
||||
@ -162,7 +162,7 @@ void STD_PROTO(InitGrowPreds, (void));
|
||||
int STD_PROTO(growheap, (int));
|
||||
int STD_PROTO(growstack, (long));
|
||||
int STD_PROTO(growtrail, (long));
|
||||
int STD_PROTO(growglobal, (void));
|
||||
int STD_PROTO(growglobal, (CELL **));
|
||||
|
||||
/* heapgc.c */
|
||||
Int STD_PROTO(total_gc_time,(void));
|
||||
|
||||
@ -1113,8 +1113,10 @@ trim_trail(choiceptr b, tr_fr_ptr tr, CELL *hbreg)
|
||||
}
|
||||
pt0++;
|
||||
} else {
|
||||
DO_TRAIL(d1, TrailVal(pt0));
|
||||
pt0++;
|
||||
if (!IsPairTerm(d1)) {
|
||||
DO_TRAIL(d1, TrailVal(pt0));
|
||||
}
|
||||
pt0++;
|
||||
}
|
||||
ENDD(d1);
|
||||
}
|
||||
|
||||
@ -72,9 +72,9 @@ void itos(int i, char *s) {
|
||||
void information_message(const char *mesg,...) {
|
||||
va_list args;
|
||||
va_start(args, mesg);
|
||||
fprintf(stdout, "[ ");
|
||||
vfprintf(stdout, mesg, args);
|
||||
fprintf(stdout, " ]\n");
|
||||
fprintf(stderr, "[ ");
|
||||
vfprintf(stderr, mesg, args);
|
||||
fprintf(stderr, " ]\n");
|
||||
return;
|
||||
}
|
||||
/* ------------------------- **
|
||||
|
||||
@ -53,6 +53,7 @@ static void answer_to_stdout(char *answer);
|
||||
static int p_table(void);
|
||||
static int p_abolish_trie(void);
|
||||
static int p_show_trie(void);
|
||||
static int p_resume_trie(void);
|
||||
#endif /* TABLING */
|
||||
#ifdef STATISTICS
|
||||
static int p_show_frames(void);
|
||||
@ -82,6 +83,7 @@ void init_optyap_preds(void) {
|
||||
InitCPred("$do_table", 2, p_table, SafePredFlag);
|
||||
InitCPred("$do_abolish_trie", 2, p_abolish_trie, SafePredFlag);
|
||||
InitCPred("$show_trie", 3, p_show_trie, SafePredFlag);
|
||||
InitCPred("$resume_trie", 2, p_resume_trie, SafePredFlag);
|
||||
#endif /* TABLING */
|
||||
#ifdef STATISTICS
|
||||
InitCPred("show_frames", 0, p_show_frames, SafePredFlag);
|
||||
@ -557,19 +559,50 @@ int p_show_trie(void) {
|
||||
if (IsVarTerm(t2)) {
|
||||
Term ta = MkAtomTerm(LookupAtom("stdout"));
|
||||
Bind((CELL *)t2, ta);
|
||||
show_trie(stdout, TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at);
|
||||
traverse_trie(stderr, TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at, TRUE);
|
||||
} else if (IsAtomTerm(t2)) {
|
||||
FILE *file;
|
||||
char *path = RepAtom(AtomOfTerm(t2))->StrOfAE;
|
||||
if ((file = fopen(path, "w")) == NULL)
|
||||
abort_optyap("fopen error in function p_show_trie");
|
||||
show_trie(file, TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at);
|
||||
traverse_trie(file, TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at, TRUE);
|
||||
fclose(file);
|
||||
} else
|
||||
return(FALSE);
|
||||
|
||||
return (TRUE);
|
||||
}
|
||||
|
||||
static
|
||||
int p_resume_trie(void) {
|
||||
Term t1;
|
||||
Atom at;
|
||||
int arity;
|
||||
PredEntry *pe;
|
||||
Term tmod = Deref(ARG2);
|
||||
SMALLUNSGN mod;
|
||||
|
||||
if (IsVarTerm(tmod) || !IsAtomTerm(tmod)) {
|
||||
return (FALSE);
|
||||
} else {
|
||||
mod = LookupModule(tmod);
|
||||
}
|
||||
t1 = Deref(ARG1);
|
||||
if (IsAtomTerm(t1)) {
|
||||
at = AtomOfTerm(t1);
|
||||
arity = 0;
|
||||
pe = RepPredProp(PredPropByAtom(at, mod));
|
||||
} else if (IsApplTerm(t1)) {
|
||||
Functor func = FunctorOfTerm(t1);
|
||||
at = NameOfFunctor(func);
|
||||
arity = ArityOfFunctor(func);
|
||||
pe = RepPredProp(PredPropByFunc(func, mod));
|
||||
} else
|
||||
return(FALSE);
|
||||
|
||||
traverse_trie(stdout, TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at, FALSE);
|
||||
return (TRUE);
|
||||
}
|
||||
#endif /* TABLING */
|
||||
|
||||
|
||||
|
||||
@ -77,6 +77,7 @@ void update_answer_trie(sg_fr_ptr sg_fr);
|
||||
void show_trie(FILE *stream, sg_node_ptr sg_node, int pred_arity, Atom pred_atom);
|
||||
int show_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_index, int *arity);
|
||||
int show_answer_trie(FILE *stream, ans_node_ptr ans_node, char *str, int str_index, int *arity, int var_index);
|
||||
void traverse_trie(FILE *stream, sg_node_ptr sg_node, int pred_arity, Atom pred_atom, int show);
|
||||
#endif /* TABLING */
|
||||
|
||||
|
||||
|
||||
@ -927,7 +927,7 @@
|
||||
|
||||
|
||||
|
||||
BOp(table_completion, ld)
|
||||
BOp(table_completion, ld);
|
||||
#ifdef YAPOR
|
||||
if (SCH_top_shared_cp(B)) {
|
||||
SCH_new_alternative(PREG, GEN_CP_NULL_ALT);
|
||||
@ -1053,7 +1053,6 @@
|
||||
if (B->cp_tr > DepFr_cons_cp(dep_fr)->cp_tr)
|
||||
TABLING_ERROR_MESSAGE("B->cp_tr > DepFr_cons_cp(dep_fr)->cp_tr (completion)");
|
||||
#endif /* TABLING_ERRORS */
|
||||
printf("vsc1: looking from dep_fr %p to B %p\n", dep_fr, B);
|
||||
rebind_variables(DepFr_cons_cp(dep_fr)->cp_tr, B->cp_tr);
|
||||
#ifdef TABLING_ERRORS
|
||||
if (TR != B->cp_tr) {
|
||||
@ -1226,6 +1225,10 @@
|
||||
goto fail;
|
||||
#else /* TABLING_LOCAL_SCHEDULING */
|
||||
/* subgoal completed */
|
||||
LOCK_SG_FRAME(sg_fr);
|
||||
if (SgFr_state(sg_fr) == complete)
|
||||
update_answer_trie(sg_fr);
|
||||
UNLOCK_SG_FRAME(sg_fr);
|
||||
if (SgFr_first_answer(sg_fr) == NULL) {
|
||||
/* no answers --> fail */
|
||||
B = B->cp_b;
|
||||
|
||||
@ -18,6 +18,8 @@
|
||||
** Local functions declaration **
|
||||
** ------------------------------------- */
|
||||
|
||||
static int traverse_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_index, int *arity, int depth);
|
||||
static int traverse_answer_trie(FILE *stream, ans_node_ptr ans_node, char *str, int str_index, int *arity, int var_index, int depth);
|
||||
static void free_answer_trie_branch(ans_node_ptr node);
|
||||
#ifdef YAPOR
|
||||
#ifdef TABLING_INNER_CUTS
|
||||
@ -39,11 +41,13 @@ STD_PROTO(static inline sg_node_ptr subgoal_trie_node_check_insert, (tab_ent_ptr
|
||||
STD_PROTO(static inline ans_node_ptr answer_trie_node_check_insert, (sg_fr_ptr, ans_node_ptr, Term, int));
|
||||
|
||||
|
||||
|
||||
#ifdef TABLE_LOCK_AT_WRITE_LEVEL
|
||||
|
||||
static inline
|
||||
sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) {
|
||||
sg_node_ptr chain_node, new_node;
|
||||
sg_hash_ptr hash;
|
||||
|
||||
|
||||
chain_node = TrNode_child(parent_node);
|
||||
@ -61,6 +65,7 @@ sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr pare
|
||||
FREE_SUBGOAL_TRIE_NODE(new_node);
|
||||
#endif /* ALLOC_BEFORE_CHECK */
|
||||
UNLOCK_TABLE(parent_node);
|
||||
hash = (sg_hash_ptr) chain_node;
|
||||
goto subgoal_hash;
|
||||
}
|
||||
do {
|
||||
@ -111,6 +116,7 @@ sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr pare
|
||||
FREE_SUBGOAL_TRIE_NODE(new_node);
|
||||
#endif /* ALLOC_BEFORE_CHECK */
|
||||
UNLOCK_TABLE(parent_node);
|
||||
hash = (sg_hash_ptr) chain_node;
|
||||
goto subgoal_hash;
|
||||
}
|
||||
do {
|
||||
@ -134,7 +140,6 @@ sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr pare
|
||||
}
|
||||
if (count_nodes > MAX_NODES_PER_TRIE_LEVEL) {
|
||||
/* alloc a new hash */
|
||||
sg_hash_ptr hash;
|
||||
sg_node_ptr next_node, *bucket;
|
||||
new_subgoal_hash(hash, count_nodes, tab_ent);
|
||||
chain_node = new_node;
|
||||
@ -154,13 +159,12 @@ sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr pare
|
||||
}
|
||||
|
||||
|
||||
hash = (sg_hash_ptr) chain_node;
|
||||
subgoal_hash:
|
||||
{ /* trie nodes with hashing */
|
||||
sg_hash_ptr hash;
|
||||
sg_node_ptr *bucket, first_node;
|
||||
int seed, count_nodes;
|
||||
|
||||
hash = (sg_hash_ptr) chain_node;
|
||||
seed = Hash_seed(hash);
|
||||
bucket = Hash_bucket(hash, HASH_TERM(t, seed));
|
||||
first_node = chain_node = *bucket;
|
||||
@ -171,7 +175,7 @@ subgoal_hash:
|
||||
}
|
||||
count_nodes++;
|
||||
chain_node = TrNode_next(chain_node);
|
||||
} while (chain_node);
|
||||
}
|
||||
#ifdef ALLOC_BEFORE_CHECK
|
||||
new_subgoal_trie_node(new_node, t, NULL, parent_node, first_node);
|
||||
#endif /* ALLOC_BEFORE_CHECK */
|
||||
@ -209,14 +213,14 @@ subgoal_hash:
|
||||
Hash_num_nodes(hash)++;
|
||||
if (count_nodes > MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) {
|
||||
/* expand current hash */
|
||||
sg_node_ptr next_node, *old_bucket, *last_old_bucket;
|
||||
old_bucket = Hash_buckets(hash);
|
||||
last_old_bucket = old_bucket + Hash_num_buckets(hash);
|
||||
Hash_num_buckets(hash) *= 2;
|
||||
ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash));
|
||||
seed = Hash_num_buckets(hash) - 1;
|
||||
sg_node_ptr next_node, *first_old_bucket, *old_bucket;
|
||||
first_old_bucket = Hash_buckets(hash);
|
||||
old_bucket = first_old_bucket + Hash_num_buckets(hash);
|
||||
seed = Hash_num_buckets(hash) * 2;
|
||||
ALLOC_HASH_BUCKETS(Hash_buckets(hash), seed);
|
||||
seed--;
|
||||
do {
|
||||
if (*old_bucket) {
|
||||
if (*--old_bucket) {
|
||||
chain_node = *old_bucket;
|
||||
do {
|
||||
bucket = Hash_bucket(hash, HASH_TERM(TrNode_entry(chain_node), seed));
|
||||
@ -226,8 +230,9 @@ subgoal_hash:
|
||||
chain_node = next_node;
|
||||
} while (chain_node);
|
||||
}
|
||||
} while (++old_bucket != last_old_bucket);
|
||||
FREE_HASH_BUCKETS(old_bucket - Hash_num_buckets(hash) / 2);
|
||||
} while (old_bucket != first_old_bucket);
|
||||
Hash_num_buckets(hash) = seed + 1;
|
||||
FREE_HASH_BUCKETS(first_old_bucket);
|
||||
}
|
||||
UNLOCK_TABLE(parent_node);
|
||||
return new_node;
|
||||
@ -238,7 +243,7 @@ subgoal_hash:
|
||||
static inline
|
||||
ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) {
|
||||
ans_node_ptr chain_node, new_node;
|
||||
|
||||
ans_hash_ptr hash;
|
||||
|
||||
#ifdef TABLING_ERRORS
|
||||
if (IS_ANSWER_LEAF_NODE(parent_node))
|
||||
@ -261,6 +266,7 @@ ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_
|
||||
FREE_ANSWER_TRIE_NODE(new_node);
|
||||
#endif /* ALLOC_BEFORE_CHECK */
|
||||
UNLOCK_TABLE(parent_node);
|
||||
hash = (ans_hash_ptr) chain_node;
|
||||
goto answer_hash;
|
||||
}
|
||||
do {
|
||||
@ -311,6 +317,7 @@ ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_
|
||||
FREE_ANSWER_TRIE_NODE(new_node);
|
||||
#endif /* ALLOC_BEFORE_CHECK */
|
||||
UNLOCK_TABLE(parent_node);
|
||||
hash = (ans_hash_ptr) chain_node;
|
||||
goto answer_hash;
|
||||
}
|
||||
do {
|
||||
@ -334,7 +341,6 @@ ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_
|
||||
}
|
||||
if (count_nodes > MAX_NODES_PER_TRIE_LEVEL) {
|
||||
/* alloc a new hash */
|
||||
ans_hash_ptr hash;
|
||||
ans_node_ptr next_node, *bucket;
|
||||
new_answer_hash(hash, count_nodes, sg_fr);
|
||||
chain_node = new_node;
|
||||
@ -354,13 +360,12 @@ ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_
|
||||
}
|
||||
|
||||
|
||||
hash = (ans_hash_ptr) chain_node;
|
||||
answer_hash:
|
||||
{ /* trie nodes with hashing */
|
||||
ans_hash_ptr hash;
|
||||
ans_node_ptr *bucket, first_node;
|
||||
int seed, count_nodes;
|
||||
|
||||
hash = (ans_hash_ptr) chain_node;
|
||||
seed = Hash_seed(hash);
|
||||
bucket = Hash_bucket(hash, HASH_TERM(t, seed));
|
||||
first_node = chain_node = *bucket;
|
||||
@ -371,7 +376,7 @@ answer_hash:
|
||||
}
|
||||
count_nodes++;
|
||||
chain_node = TrNode_next(chain_node);
|
||||
} while (chain_node);
|
||||
}
|
||||
#ifdef ALLOC_BEFORE_CHECK
|
||||
new_answer_trie_node(new_node, instr, t, NULL, parent_node, first_node);
|
||||
#endif /* ALLOC_BEFORE_CHECK */
|
||||
@ -409,14 +414,14 @@ answer_hash:
|
||||
Hash_num_nodes(hash)++;
|
||||
if (count_nodes > MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) {
|
||||
/* expand current hash */
|
||||
ans_node_ptr next_node, *old_bucket, *last_old_bucket;
|
||||
old_bucket = Hash_buckets(hash);
|
||||
last_old_bucket = old_bucket + Hash_num_buckets(hash);
|
||||
Hash_num_buckets(hash) *= 2;
|
||||
ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash));
|
||||
seed = Hash_num_buckets(hash) - 1;
|
||||
ans_node_ptr next_node, *first_old_bucket, *old_bucket;
|
||||
first_old_bucket = Hash_buckets(hash);
|
||||
old_bucket = first_old_bucket + Hash_num_buckets(hash);
|
||||
seed = Hash_num_buckets(hash) * 2;
|
||||
ALLOC_HASH_BUCKETS(Hash_buckets(hash), seed);
|
||||
seed--;
|
||||
do {
|
||||
if (*old_bucket) {
|
||||
if (*--old_bucket) {
|
||||
chain_node = *old_bucket;
|
||||
do {
|
||||
bucket = Hash_bucket(hash, HASH_TERM(TrNode_entry(chain_node), seed));
|
||||
@ -426,8 +431,9 @@ answer_hash:
|
||||
chain_node = next_node;
|
||||
} while (chain_node);
|
||||
}
|
||||
} while (++old_bucket != last_old_bucket);
|
||||
FREE_HASH_BUCKETS(old_bucket - Hash_num_buckets(hash) / 2);
|
||||
} while (old_bucket != first_old_bucket);
|
||||
Hash_num_buckets(hash) = seed + 1;
|
||||
FREE_HASH_BUCKETS(first_old_bucket);
|
||||
}
|
||||
UNLOCK_TABLE(parent_node);
|
||||
return new_node;
|
||||
@ -437,8 +443,8 @@ answer_hash:
|
||||
|
||||
|
||||
#ifdef TABLE_LOCK_AT_NODE_LEVEL
|
||||
#define LOCK_NODE(NODE) LOCK(TrNode_lock(NODE))
|
||||
#define UNLOCK_NODE(NODE) UNLOCK(TrNode_lock(NODE))
|
||||
#define LOCK_NODE(NODE) TRIE_LOCK(TrNode_lock(NODE))
|
||||
#define UNLOCK_NODE(NODE) UNLOCK(TrNode_lock(NODE))
|
||||
#else
|
||||
#define LOCK_NODE(NODE)
|
||||
#define UNLOCK_NODE(NODE)
|
||||
@ -513,15 +519,15 @@ sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr pare
|
||||
*bucket = child_node;
|
||||
if (count_nodes > MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) {
|
||||
/* expand current hash */
|
||||
sg_node_ptr chain_node, next_node, *old_bucket, *last_old_bucket;
|
||||
sg_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket;
|
||||
int seed;
|
||||
old_bucket = Hash_buckets(hash);
|
||||
last_old_bucket = old_bucket + Hash_num_buckets(hash);
|
||||
first_old_bucket = Hash_buckets(hash);
|
||||
old_bucket = first_old_bucket + Hash_num_buckets(hash);
|
||||
Hash_num_buckets(hash) *= 2;
|
||||
ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash));
|
||||
seed = Hash_num_buckets(hash) - 1;
|
||||
do {
|
||||
if (*old_bucket) {
|
||||
if (*--old_bucket) {
|
||||
chain_node = *old_bucket;
|
||||
do {
|
||||
bucket = Hash_bucket(hash, HASH_TERM(TrNode_entry(chain_node), seed));
|
||||
@ -531,8 +537,8 @@ sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr pare
|
||||
chain_node = next_node;
|
||||
} while (chain_node);
|
||||
}
|
||||
} while (++old_bucket != last_old_bucket);
|
||||
FREE_HASH_BUCKETS(old_bucket - Hash_num_buckets(hash) / 2);
|
||||
} while (old_bucket != first_old_bucket);
|
||||
FREE_HASH_BUCKETS(first_old_bucket);
|
||||
}
|
||||
UNLOCK_NODE(parent_node);
|
||||
return child_node;
|
||||
@ -548,6 +554,7 @@ ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_
|
||||
if (IS_ANSWER_LEAF_NODE(parent_node))
|
||||
TABLING_ERROR_MESSAGE("IS_ANSWER_LEAF_NODE(parent_node) (answer_trie_node_check_insert)");
|
||||
#endif /* TABLING_ERRORS */
|
||||
|
||||
LOCK_NODE(parent_node);
|
||||
child_node = TrNode_child(parent_node);
|
||||
|
||||
@ -612,15 +619,15 @@ ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_
|
||||
*bucket = child_node;
|
||||
if (count_nodes > MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) {
|
||||
/* expand current hash */
|
||||
ans_node_ptr chain_node, next_node, *old_bucket, *last_old_bucket;
|
||||
ans_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket;
|
||||
int seed;
|
||||
old_bucket = Hash_buckets(hash);
|
||||
last_old_bucket = old_bucket + Hash_num_buckets(hash);
|
||||
first_old_bucket = Hash_buckets(hash);
|
||||
old_bucket = first_old_bucket + Hash_num_buckets(hash);
|
||||
Hash_num_buckets(hash) *= 2;
|
||||
ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash));
|
||||
seed = Hash_num_buckets(hash) - 1;
|
||||
do {
|
||||
if (*old_bucket) {
|
||||
if (*--old_bucket) {
|
||||
chain_node = *old_bucket;
|
||||
do {
|
||||
bucket = Hash_bucket(hash, HASH_TERM(TrNode_entry(chain_node), seed));
|
||||
@ -630,8 +637,8 @@ ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_
|
||||
chain_node = next_node;
|
||||
} while (chain_node);
|
||||
}
|
||||
} while (++old_bucket != last_old_bucket);
|
||||
FREE_HASH_BUCKETS(old_bucket - Hash_num_buckets(hash) / 2);
|
||||
} while (old_bucket != first_old_bucket);
|
||||
FREE_HASH_BUCKETS(first_old_bucket);
|
||||
}
|
||||
UNLOCK_NODE(parent_node);
|
||||
return child_node;
|
||||
@ -673,7 +680,7 @@ sg_node_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr) {
|
||||
current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, t);
|
||||
} else {
|
||||
if (count_vars == MAX_TABLE_VARS)
|
||||
abort_optyap("MAX_TABLE_VARS exceeded in function subgoal_search");
|
||||
Error(SYSTEM_ERROR,TermNil,"MAX_TABLE_VARS exceeded in function subgoal_search (%d)", count_vars);
|
||||
FREE_STACK_PUSH(t, stack_vars);
|
||||
*((CELL *)t) = GLOBAL_table_var_enumerator(count_vars);
|
||||
t = MakeTableVarTerm(count_vars);
|
||||
@ -705,8 +712,10 @@ sg_node_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr) {
|
||||
FREE_STACK_PUSH(count_vars, stack_vars);
|
||||
*Yaddr = stack_vars++;
|
||||
/* reset variables */
|
||||
while (count_vars--)
|
||||
*((CELL *)*stack_vars) = STACK_POP(stack_vars);
|
||||
while (count_vars--) {
|
||||
Term t = STACK_POP(stack_vars);
|
||||
RESET_VARIABLE(t);
|
||||
}
|
||||
|
||||
return current_sg_node;
|
||||
}
|
||||
@ -745,7 +754,7 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
|
||||
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, t, _trie_retry_val);
|
||||
} else {
|
||||
if (count_vars == MAX_TABLE_VARS)
|
||||
abort_optyap("MAX_TABLE_VARS exceeded in function answer_search");
|
||||
Error(SYSTEM_ERROR,TermNil,"MAX_TABLE_VARS exceeded in function answer_search (%d)", count_vars);
|
||||
FREE_STACK_PUSH(t, stack_vars);
|
||||
*((CELL *)t) = GLOBAL_table_var_enumerator(count_vars);
|
||||
t = MakeTableVarTerm(count_vars);
|
||||
@ -775,12 +784,15 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
|
||||
}
|
||||
|
||||
/* reset variables */
|
||||
while (count_vars--)
|
||||
*((CELL *)*stack_vars) = STACK_POP(stack_vars);
|
||||
while (count_vars--) {
|
||||
Term t = STACK_POP(stack_vars);
|
||||
RESET_VARIABLE(t);
|
||||
}
|
||||
|
||||
return current_ans_node;
|
||||
}
|
||||
|
||||
|
||||
void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) {
|
||||
int subs_arity;
|
||||
subs_arity = *subs_ptr;
|
||||
@ -1007,42 +1019,94 @@ void update_answer_trie(sg_fr_ptr sg_fr) {
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
static struct trie_statistics{
|
||||
int show;
|
||||
long subgoals;
|
||||
long subgoals_abolished;
|
||||
long subgoal_trie_nodes;
|
||||
long subgoal_linear_nodes;
|
||||
int subgoal_trie_max_depth;
|
||||
int subgoal_trie_min_depth;
|
||||
long answers;
|
||||
long answers_pruned;
|
||||
long answer_trie_nodes;
|
||||
long answer_linear_nodes;
|
||||
int answer_trie_max_depth;
|
||||
int answer_trie_min_depth;
|
||||
} trie_stats;
|
||||
#define TrStat_show trie_stats.show
|
||||
#define TrStat_subgoals trie_stats.subgoals
|
||||
#define TrStat_subgoals_abolished trie_stats.subgoals_abolished
|
||||
#define TrStat_sg_nodes trie_stats.subgoal_trie_nodes
|
||||
#define TrStat_sg_linear_nodes trie_stats.subgoal_linear_nodes
|
||||
#define TrStat_sg_max_depth trie_stats.subgoal_trie_max_depth
|
||||
#define TrStat_sg_min_depth trie_stats.subgoal_trie_min_depth
|
||||
#define TrStat_answers trie_stats.answers
|
||||
#define TrStat_answers_pruned trie_stats.answers_pruned
|
||||
#define TrStat_ans_nodes trie_stats.answer_trie_nodes
|
||||
#define TrStat_ans_linear_nodes trie_stats.answer_linear_nodes
|
||||
#define TrStat_ans_max_depth trie_stats.answer_trie_max_depth
|
||||
#define TrStat_ans_min_depth trie_stats.answer_trie_min_depth
|
||||
#define SHOW_INFO(MESG, ARGS...) fprintf(stream, MESG, ##ARGS)
|
||||
/*#define SHOW_TRIE(MESG, ARGS...) fprintf(stream, MESG, ##ARGS)*/
|
||||
#define SHOW_TRIE(MESG, ARGS...)
|
||||
int trie_subgoals;
|
||||
int trie_subgoals_abolished;
|
||||
int trie_answers;
|
||||
int trie_answers_pruned;
|
||||
#define SHOW_TRIE(MESG, ARGS...) if (TrStat_show) fprintf(stream, MESG, ##ARGS)
|
||||
|
||||
void show_trie(FILE *stream, sg_node_ptr sg_node, int pred_arity, Atom pred_atom) {
|
||||
void traverse_trie(FILE *stream, sg_node_ptr sg_node, int pred_arity, Atom pred_atom, int show) {
|
||||
char str[1000];
|
||||
int arity[100];
|
||||
int str_index;
|
||||
|
||||
trie_subgoals = 0;
|
||||
trie_subgoals_abolished = 0;
|
||||
trie_answers = 0;
|
||||
trie_answers_pruned = 0;
|
||||
TrStat_show = show;
|
||||
TrStat_subgoals = 0;
|
||||
TrStat_subgoals_abolished = 0;
|
||||
TrStat_sg_nodes = 0;
|
||||
TrStat_sg_linear_nodes = 0;
|
||||
TrStat_sg_max_depth = -1;
|
||||
TrStat_sg_min_depth = -1;
|
||||
TrStat_answers = 0;
|
||||
TrStat_answers_pruned = 0;
|
||||
TrStat_ans_nodes = 0;
|
||||
TrStat_ans_linear_nodes = 0;
|
||||
TrStat_ans_max_depth = -1;
|
||||
TrStat_ans_min_depth = -1;
|
||||
str_index = sprintf(str, " ?- %s(", AtomName(pred_atom));
|
||||
arity[0] = 1;
|
||||
arity[1] = pred_arity;
|
||||
SHOW_INFO("\n[ Trie structure for predicate '%s/%d' ]\n[\n", AtomName(pred_atom), pred_arity);
|
||||
if (show_subgoal_trie(stream, sg_node, str, str_index, arity)) {
|
||||
SHOW_INFO("\n Number of subgoals: %d", trie_subgoals);
|
||||
if (trie_subgoals_abolished)
|
||||
SHOW_INFO(" (%d abolished)", trie_subgoals_abolished);
|
||||
SHOW_INFO("\n Number of answers: %d", trie_answers);
|
||||
if (trie_answers_pruned)
|
||||
SHOW_INFO(" (+ %d pruned)", trie_answers_pruned);
|
||||
TrStat_sg_nodes++;
|
||||
if (traverse_subgoal_trie(stream, sg_node, str, str_index, arity, 0)) {
|
||||
SHOW_INFO("\n Subgoal Trie structure\n %ld subgoals", TrStat_subgoals);
|
||||
if (TrStat_subgoals_abolished)
|
||||
SHOW_INFO(" (including %ld abolished)", TrStat_subgoals_abolished);
|
||||
SHOW_INFO("\n %ld nodes (%ld%c reuse)\n %.2f average depth (%d min - %d max)",
|
||||
TrStat_sg_nodes,
|
||||
TrStat_sg_linear_nodes == 0 ? 0 : (TrStat_sg_linear_nodes - TrStat_sg_nodes + 1) * 100 / TrStat_sg_linear_nodes,
|
||||
'%',
|
||||
TrStat_subgoals == 0 ? 0 : (float)TrStat_sg_linear_nodes / (float)TrStat_subgoals,
|
||||
TrStat_sg_min_depth < 0 ? 0 : TrStat_sg_min_depth,
|
||||
TrStat_sg_max_depth < 0 ? 0 : TrStat_sg_max_depth);
|
||||
SHOW_INFO("\n Answer Trie Structure\n %ld answers", TrStat_answers);
|
||||
if (TrStat_answers_pruned)
|
||||
SHOW_INFO(" (including %ld pruned)", TrStat_answers_pruned);
|
||||
SHOW_INFO("\n %ld nodes (%ld%c reuse)\n %.2f average depth (%d min - %d max)",
|
||||
TrStat_ans_nodes,
|
||||
TrStat_ans_linear_nodes == 0 ? 0 : (TrStat_ans_linear_nodes - TrStat_ans_nodes + TrStat_subgoals) * 100 / TrStat_ans_linear_nodes,
|
||||
'%',
|
||||
TrStat_answers == 0 ? 0 : (float)TrStat_ans_linear_nodes / (float)TrStat_answers,
|
||||
TrStat_ans_min_depth < 0 ? 0 : TrStat_ans_min_depth,
|
||||
TrStat_ans_max_depth < 0 ? 0 : TrStat_ans_max_depth);
|
||||
}
|
||||
SHOW_INFO("\n]\n\n");
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
int show_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_index, int *arity) {
|
||||
|
||||
/* ------------------------- **
|
||||
** Local functions **
|
||||
** ------------------------- */
|
||||
|
||||
static
|
||||
int traverse_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_index, int *arity, int depth) {
|
||||
int tag;
|
||||
Term t;
|
||||
int new_arity[100];
|
||||
@ -1050,9 +1114,17 @@ int show_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_inde
|
||||
if (arity[0] == 0) {
|
||||
ans_node_ptr ans_node;
|
||||
str[str_index] = 0;
|
||||
trie_subgoals++;
|
||||
TrStat_subgoals++;
|
||||
TrStat_sg_linear_nodes+= depth;
|
||||
if (TrStat_sg_max_depth < 0) {
|
||||
TrStat_sg_min_depth = TrStat_sg_max_depth = depth;
|
||||
} else if (depth < TrStat_sg_min_depth) {
|
||||
TrStat_sg_min_depth = depth;
|
||||
} else if (depth > TrStat_sg_max_depth) {
|
||||
TrStat_sg_max_depth = depth;
|
||||
}
|
||||
if (sg_node == NULL) {
|
||||
trie_subgoals_abolished++;
|
||||
TrStat_subgoals_abolished++;
|
||||
SHOW_TRIE("%s.\n ABOLISHED\n", str);
|
||||
return TRUE;
|
||||
}
|
||||
@ -1062,15 +1134,23 @@ int show_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_inde
|
||||
}
|
||||
SHOW_TRIE("%s.\n", str);
|
||||
ans_node = SgFr_answer_trie((sg_fr_ptr)sg_node);
|
||||
TrStat_ans_nodes++;
|
||||
if (IS_ANSWER_LEAF_NODE(ans_node)) {
|
||||
SHOW_TRIE(" YES\n");
|
||||
if (TrStat_ans_max_depth < 0)
|
||||
TrStat_ans_max_depth = 0;
|
||||
TrStat_ans_min_depth = 0;
|
||||
TrStat_answers++;
|
||||
} else if (TrNode_child(ans_node) == NULL) {
|
||||
SHOW_TRIE(" NO\n");
|
||||
if (TrStat_ans_max_depth < 0)
|
||||
TrStat_ans_max_depth = 0;
|
||||
TrStat_ans_min_depth = 0;
|
||||
} else {
|
||||
char answer_str[1000];
|
||||
int answer_arity[1000];
|
||||
answer_arity[0] = 0;
|
||||
if (! show_answer_trie(stream, TrNode_child(ans_node), answer_str, 0, answer_arity, 0))
|
||||
if (! traverse_answer_trie(stream, TrNode_child(ans_node), answer_str, 0, answer_arity, 0, 1))
|
||||
return FALSE;
|
||||
}
|
||||
return TRUE;
|
||||
@ -1089,14 +1169,15 @@ int show_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_inde
|
||||
if (*bucket) {
|
||||
sg_node = *bucket;
|
||||
memcpy(new_arity, arity, 100);
|
||||
if (! show_subgoal_trie(stream, sg_node, str, str_index, new_arity))
|
||||
if (! traverse_subgoal_trie(stream, sg_node, str, str_index, new_arity, depth))
|
||||
return FALSE;
|
||||
}
|
||||
} while (++bucket != last_bucket);
|
||||
return TRUE;
|
||||
}
|
||||
TrStat_sg_nodes++;
|
||||
memcpy(new_arity, arity, 100);
|
||||
if (! show_subgoal_trie(stream, TrNode_next(sg_node), str, str_index, new_arity))
|
||||
if (! traverse_subgoal_trie(stream, TrNode_next(sg_node), str, str_index, new_arity, depth))
|
||||
return FALSE;
|
||||
|
||||
t = TrNode_entry(sg_node);
|
||||
@ -1200,24 +1281,26 @@ int show_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_inde
|
||||
arity[arity[0]] = ArityOfFunctor((Functor)NonTagPart(t));
|
||||
break;
|
||||
default:
|
||||
abort_optyap("unknown type tag in function show_subgoal_trie");
|
||||
abort_optyap("unknown type tag in function traverse_subgoal_trie");
|
||||
}
|
||||
|
||||
if (! show_subgoal_trie(stream, TrNode_child(sg_node), str, str_index, arity))
|
||||
if (! traverse_subgoal_trie(stream, TrNode_child(sg_node), str, str_index, arity, depth + 1))
|
||||
return FALSE;
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
|
||||
int show_answer_trie(FILE *stream, ans_node_ptr ans_node, char *str, int str_index, int *arity, int var_index) {
|
||||
static
|
||||
int traverse_answer_trie(FILE *stream, ans_node_ptr ans_node, char *str, int str_index, int *arity, int var_index, int depth) {
|
||||
int tag;
|
||||
Term t;
|
||||
int new_arity[100];
|
||||
|
||||
if (ans_node == NULL)
|
||||
return TRUE;
|
||||
TrStat_ans_nodes++;
|
||||
memcpy(new_arity, arity, 100);
|
||||
if (! show_answer_trie(stream, TrNode_next(ans_node), str, str_index, new_arity, var_index))
|
||||
if (! traverse_answer_trie(stream, TrNode_next(ans_node), str, str_index, new_arity, var_index, depth))
|
||||
return FALSE;
|
||||
|
||||
if (arity[0] == 0) {
|
||||
@ -1326,32 +1409,35 @@ int show_answer_trie(FILE *stream, ans_node_ptr ans_node, char *str, int str_ind
|
||||
arity[arity[0]] = ArityOfFunctor((Functor)NonTagPart(t));
|
||||
break;
|
||||
default:
|
||||
abort_optyap("unknown type tag in function show_answer_trie");
|
||||
abort_optyap("unknown type tag in function traverse_answer_trie");
|
||||
}
|
||||
|
||||
if (! IS_ANSWER_LEAF_NODE(ans_node)) {
|
||||
#ifdef TABLING_INNER_CUTS
|
||||
if (! TrNode_child(ans_node)) {
|
||||
trie_answers_pruned++;
|
||||
TrStat_answers_pruned++;
|
||||
return TRUE;
|
||||
}
|
||||
#endif /* TABLING_INNER_CUTS */
|
||||
if (! show_answer_trie(stream, TrNode_child(ans_node), str, str_index, arity, var_index))
|
||||
if (! traverse_answer_trie(stream, TrNode_child(ans_node), str, str_index, arity, var_index, depth + 1))
|
||||
return FALSE;
|
||||
} else {
|
||||
str[str_index] = 0;
|
||||
SHOW_TRIE("%s\n", str);
|
||||
trie_answers++;
|
||||
TrStat_answers++;
|
||||
TrStat_ans_linear_nodes+= depth;
|
||||
if (TrStat_ans_max_depth < 0) {
|
||||
TrStat_ans_min_depth = TrStat_ans_max_depth = depth;
|
||||
} else if (depth < TrStat_ans_min_depth) {
|
||||
TrStat_ans_min_depth = depth;
|
||||
} else if (depth > TrStat_ans_max_depth) {
|
||||
TrStat_ans_max_depth = depth;
|
||||
}
|
||||
}
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/* ------------------------- **
|
||||
** Local functions **
|
||||
** ------------------------- */
|
||||
|
||||
static
|
||||
void free_answer_trie_branch(ans_node_ptr node) {
|
||||
#ifdef TABLING_INNER_CUTS
|
||||
|
||||
@ -102,12 +102,16 @@
|
||||
*aux_ptr = heap_arity - 1; \
|
||||
var_ptr = *++aux_ptr; \
|
||||
*((CELL *) var_ptr) = var_ptr; \
|
||||
for (i = 0; i < heap_arity - 1; i++) \
|
||||
*aux_ptr++ = *(aux_ptr + 1); \
|
||||
for (i = 0; i < heap_arity - 1; i++) { \
|
||||
*aux_ptr = *(aux_ptr + 1); \
|
||||
aux_ptr++; \
|
||||
} \
|
||||
*aux_ptr++ = vars_arity + 1; \
|
||||
*aux_ptr++ = subs_arity; \
|
||||
for (i = 0; i < subs_arity; i++) \
|
||||
*aux_ptr++ = *(aux_ptr + 1); \
|
||||
for (i = 0; i < subs_arity; i++) { \
|
||||
*aux_ptr = *(aux_ptr + 1); \
|
||||
aux_ptr++; \
|
||||
} \
|
||||
*aux_ptr = var_ptr; \
|
||||
next_instruction(--heap_arity || subs_arity, node); \
|
||||
} else { \
|
||||
@ -192,8 +196,10 @@
|
||||
Bind_Local((CELL *) aux, subs); \
|
||||
} \
|
||||
} \
|
||||
for (i = 0; i < vars_arity; i++) \
|
||||
*aux_ptr++ = *(aux_ptr + 1); \
|
||||
for (i = 0; i < vars_arity; i++) { \
|
||||
*aux_ptr = *(aux_ptr + 1); \
|
||||
aux_ptr++; \
|
||||
} \
|
||||
next_instruction(--subs_arity, node); \
|
||||
}
|
||||
|
||||
@ -265,8 +271,10 @@
|
||||
*aux_ptr = subs_arity - 1; \
|
||||
aux_ptr += subs_arity; \
|
||||
Bind((CELL *) *aux_ptr, TrNode_entry(node)); \
|
||||
for (i = 0; i < vars_arity; i++) \
|
||||
*aux_ptr++ = *(aux_ptr + 1); \
|
||||
for (i = 0; i < vars_arity; i++) { \
|
||||
*aux_ptr = *(aux_ptr + 1); \
|
||||
aux_ptr++; \
|
||||
} \
|
||||
next_instruction(--subs_arity, node); \
|
||||
}
|
||||
|
||||
@ -316,8 +324,10 @@
|
||||
*aux_ptr = subs_arity - 1; \
|
||||
aux_ptr += subs_arity; \
|
||||
Bind((CELL *) *aux_ptr, AbsPair(H - 2)); \
|
||||
for (i = 0; i < vars_arity; i++) \
|
||||
*aux_ptr++ = *(aux_ptr + 1); \
|
||||
for (i = 0; i < vars_arity; i++) { \
|
||||
*aux_ptr = *(aux_ptr + 1); \
|
||||
aux_ptr++; \
|
||||
} \
|
||||
} \
|
||||
next_trie_instruction(node)
|
||||
|
||||
@ -374,8 +384,10 @@
|
||||
*aux_ptr = subs_arity - 1; \
|
||||
aux_ptr += subs_arity; \
|
||||
Bind((CELL *) *aux_ptr, AbsAppl(H - func_arity - 1)); \
|
||||
for (i = 0; i < vars_arity; i++) \
|
||||
*aux_ptr++ = *(aux_ptr + 1); \
|
||||
for (i = 0; i < vars_arity; i++) { \
|
||||
*aux_ptr = *(aux_ptr + 1); \
|
||||
aux_ptr++; \
|
||||
} \
|
||||
} \
|
||||
next_trie_instruction(node)
|
||||
|
||||
|
||||
@ -15,6 +15,10 @@
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
:- meta_predicate table(:), abolish_trie(:), show_trie(:), resume_trie(:).
|
||||
|
||||
table(M:X) :- !,
|
||||
'$table'(X, M).
|
||||
table(X) :-
|
||||
current_module(M),
|
||||
'$table'(X, M).
|
||||
@ -28,12 +32,6 @@ table(X) :-
|
||||
'$table'(A/N, M) :- integer(N), atom(A), !,
|
||||
functor(T,A,N), '$flags'(T,M,F,F),
|
||||
(
|
||||
X is F /\ 8'000100, X =\= 0, !,
|
||||
write(user_error, '[ Warning: '),
|
||||
write(user_error, M:A/N),
|
||||
write(user_error, ' is already declared as table ]'),
|
||||
nl(user_error)
|
||||
;
|
||||
X is F /\ 8'170000, X =:= 0, !, '$do_table'(T, M)
|
||||
;
|
||||
write(user_error, '[ Error: '),
|
||||
@ -48,31 +46,8 @@ table(X) :-
|
||||
nl(user_error),
|
||||
fail.
|
||||
|
||||
show_trie(X) :-
|
||||
'$current_module'(M),
|
||||
'$show_trie'(X, M).
|
||||
|
||||
'$show_trie'(X, M) :- var(X), !,
|
||||
throw(error(instantiation_error,show_trie(M:X))).
|
||||
'$show_trie'((A,B), _) :- !, '$show_trie'(A, M), '$show_trie'(B, M).
|
||||
'$show_trie'(M:A, _) :- !, '$show_trie'(A, M).
|
||||
'$show_trie'(A/N, M) :- integer(N), atom(A), !,
|
||||
functor(T,A,N), '$flags'(T,M,F,F),
|
||||
(
|
||||
X is F /\ 8'000100, X =\= 0, !, '$show_trie'(T,M,_)
|
||||
;
|
||||
write(user_error, '[ Error: '),
|
||||
write(user_error, M:A/N),
|
||||
write(user_error, ' is not declared as table ]'),
|
||||
nl(user_error),
|
||||
fail
|
||||
).
|
||||
'$show_trie'(X, M) :- write(user_error, '[ Error: '),
|
||||
write(user_error, M:X),
|
||||
write(user_error, ' is an invalid argument to trie/1 ]'),
|
||||
nl(user_error),
|
||||
fail.
|
||||
|
||||
abolish_trie(M:X) :- !,
|
||||
'$abolish_trie'(X, M).
|
||||
abolish_trie(X) :-
|
||||
'$current_module'(M),
|
||||
'$abolish_trie'(X, M).
|
||||
@ -99,3 +74,58 @@ abolish_trie(X) :-
|
||||
write(user_error, ' is an invalid argument to abolish_trie/1 ]'),
|
||||
nl(user_error),
|
||||
fail.
|
||||
|
||||
show_trie(M:X) :- !,
|
||||
'$show_trie'(X, M).
|
||||
show_trie(X) :-
|
||||
'$current_module'(M),
|
||||
'$show_trie'(X, M).
|
||||
|
||||
'$show_trie'(X, M) :- var(X), !,
|
||||
throw(error(instantiation_error,show_trie(M:X))).
|
||||
'$show_trie'((A,B), _) :- !, '$show_trie'(A, M), '$show_trie'(B, M).
|
||||
'$show_trie'(M:A, _) :- !, '$show_trie'(A, M).
|
||||
'$show_trie'(A/N, M) :- integer(N), atom(A), !,
|
||||
functor(T,A,N), '$flags'(T,M,F,F),
|
||||
(
|
||||
X is F /\ 8'000100, X =\= 0, !, '$show_trie'(T,M,_)
|
||||
;
|
||||
write(user_error, '[ Error: '),
|
||||
write(user_error, M:A/N),
|
||||
write(user_error, ' is not declared as table ]'),
|
||||
nl(user_error),
|
||||
fail
|
||||
).
|
||||
'$show_trie'(X, M) :- write(user_error, '[ Error: '),
|
||||
write(user_error, M:X),
|
||||
write(user_error, ' is an invalid argument to trie/1 ]'),
|
||||
nl(user_error),
|
||||
fail.
|
||||
|
||||
resume_trie(M:X) :- !,
|
||||
'$resume_trie'(X, M).
|
||||
resume_trie(X) :-
|
||||
'$current_module'(M),
|
||||
'$resume_trie'(X, M).
|
||||
|
||||
|
||||
'$resume_trie'(X,_) :- var(X), !,
|
||||
write(user_error, '[ Error: argument to trie/1 should be a predicate ]'),
|
||||
nl(user_error),
|
||||
fail.
|
||||
'$resume_trie'(A/N,M) :- atom(A), integer(N), !,
|
||||
functor(T,A,N), '$flags'(T,M,F,F),
|
||||
(
|
||||
X is F /\ 8'000100, X =\= 0, !, '$resume_trie'(T,M)
|
||||
;
|
||||
write(user_error, '[ Error: '),
|
||||
write(user_error, A/N),
|
||||
write(user_error, ' is not declared as table ]'),
|
||||
nl(user_error),
|
||||
fail
|
||||
).
|
||||
'$resume_trie'(X,M) :- write(user_error, '[ Error: '),
|
||||
write(user_error, M:X),
|
||||
write(user_error, ' is an invalid argument to trie/1 ]'),
|
||||
nl(user_error),
|
||||
fail.
|
||||
|
||||
Reference in New Issue
Block a user