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

Merge branch 'master' of gitosis@yap.dcc.fc.up.pt:yap-6

Browse Source
This commit is contained in:
Ricardo Rocha 2009-06-24 20:06:00 +01:00
commit c47da032a8
16 changed files with 249 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
C/absmi.c
View File

@ -977,18 +977,6 @@ Yap_absmi(int inp)
GONext();
ENDOp();
/* profiled_enter */
Op(enter_a_profiling, e);
{
PredEntry *pen = RepPredProp((Prop)IntegerOfTerm(ENV[-EnvSizeInCells-2]));
PREG = NEXTOP(PREG, e);
LOCK(pen->StatisticsForPred.lock);
pen->StatisticsForPred.NOfEntries++;
UNLOCK(pen->StatisticsForPred.lock);
}
GONext();
ENDOp();
/* profiled_retry Label,NArgs */
Op(retry_profiled, p);
LOCK(PREG->u.p.p->StatisticsForPred.lock);
@ -1214,32 +1202,6 @@ Yap_absmi(int inp)
GONext();
ENDOp();
/* count_enter_me Label,NArgs */
Op(count_a_call, e);
{
PredEntry *pen = RepPredProp((Prop)IntegerOfTerm(ENV[-EnvSizeInCells-2]));
PREG = NEXTOP(PREG, e);
LOCK(pen->StatisticsForPred.lock);
pen->StatisticsForPred.NOfEntries++;
UNLOCK(pen->StatisticsForPred.lock);
ReductionsCounter--;
if (ReductionsCounter == 0 && ReductionsCounterOn) {
saveregs();
Yap_Error(CALL_COUNTER_UNDERFLOW,TermNil,"");
setregs();
JMPNext();
}
PredEntriesCounter--;
if (PredEntriesCounter == 0 && PredEntriesCounterOn) {
saveregs();
Yap_Error(PRED_ENTRY_COUNTER_UNDERFLOW,TermNil,"");
setregs();
JMPNext();
}
}
GONext();
ENDOp();
/* count_retry Label,NArgs */
Op(count_retry, p);
LOCK(PREG->u.p.p->StatisticsForPred.lock);
@ -8057,6 +8019,41 @@ Yap_absmi(int inp)
/* IPred can generate errors, it thus must get rid of the lock itself */
setregs();
}
/* first check if we need to increase the counter */
if ((pe->PredFlags & CountPredFlag)) {
LOCK(pe->StatisticsForPred.lock);
pe->StatisticsForPred.NOfEntries++;
UNLOCK(pe->StatisticsForPred.lock);
ReductionsCounter--;
if (ReductionsCounter == 0 && ReductionsCounterOn) {
saveregs();
Yap_Error(CALL_COUNTER_UNDERFLOW,TermNil,"");
setregs();
JMPNext();
}
PredEntriesCounter--;
if (PredEntriesCounter == 0 && PredEntriesCounterOn) {
saveregs();
Yap_Error(PRED_ENTRY_COUNTER_UNDERFLOW,TermNil,"");
setregs();
JMPNext();
}
if ((pe->PredFlags & (CountPredFlag|ProfiledPredFlag|SpiedPredFlag)) ==
CountPredFlag) {
PREG = pe->cs.p_code.TrueCodeOfPred;
JMPNext();
}
}
/* standard profiler */
if ((pe->PredFlags & ProfiledPredFlag)) {
LOCK(pe->StatisticsForPred.lock);
pe->StatisticsForPred.NOfEntries++;
UNLOCK(pe->StatisticsForPred.lock);
if (!(pe->PredFlags & SpiedPredFlag)) {
PREG = pe->cs.p_code.TrueCodeOfPred;
JMPNext();
}
}
if (!DebugOn) {
PREG = pe->cs.p_code.TrueCodeOfPred;
UNLOCK(pe->PELock);

22
C/amasm.c
View File

@ -3665,13 +3665,25 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
code_p = a_f2(TRUE, &cmp_info, code_p, pass_no, cip);
break;
case enter_profiling_op:
code_p = a_pl(_enter_profiling, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no);
{
PredEntry *pe = (PredEntry *)(cip->cpc->rnd1);
if ((pe->PredFlags & (CPredFlag|UserCPredFlag|AsmPredFlag)) ||
!pe->ModuleOfPred) {
code_p = a_pl(_enter_profiling, pe, code_p, pass_no);
}
}
break;
case retry_profiled_op:
code_p = a_pl(_retry_profiled, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no);
break;
case count_call_op:
{
PredEntry *pe = (PredEntry *)(cip->cpc->rnd1);
if ((pe->PredFlags & (CPredFlag|UserCPredFlag|AsmPredFlag)) ||
!pe->ModuleOfPred) {
code_p = a_pl(_count_call, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no);
}
}
break;
case count_retry_op:
code_p = a_pl(_count_retry, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no);
@ -3925,14 +3937,6 @@ Yap_InitComma(void)
code_p->u.p.p = PredMetaCall;
GONEXT(p);
} else {
if (PROFILING) {
code_p->opc = opcode(_enter_a_profiling);
GONEXT(e);
}
if (CALL_COUNTING) {
code_p->opc = opcode(_count_a_call);
GONEXT(e);
}
code_p->opc = opcode(_p_execute_tail);
code_p->u.Osbpp.s = emit_count(-Signed(RealEnvSize)-3*sizeof(CELL));
code_p->u.Osbpp.bmap = NULL;

48
C/cdmgr.c
View File

@ -965,7 +965,7 @@ IPred(PredEntry *ap, UInt NSlots)
ap->cs.p_code.TrueCodeOfPred = BaseAddr;
ap->PredFlags |= IndexedPredFlag;
}
if (ap->PredFlags & SpiedPredFlag) {
if (ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
#if defined(YAPOR) || defined(THREADS)
@ -996,7 +996,7 @@ static void
RemoveMainIndex(PredEntry *ap)
{
yamop *First = ap->cs.p_code.FirstClause;
int spied = ap->PredFlags & SpiedPredFlag;
int spied = ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag);
ap->PredFlags &= ~IndexedPredFlag;
if (First == NULL) {
@ -1006,7 +1006,7 @@ RemoveMainIndex(PredEntry *ap)
}
if (First != NULL && spied) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->cs.p_code.TrueCodeOfPred = ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
} else if (ap->cs.p_code.NOfClauses > 1
#ifdef TABLING
||ap->PredFlags & TabledPredFlag
@ -1587,6 +1587,10 @@ retract_all(PredEntry *p, int in_use)
p->PredFlags |= ProfiledPredFlag;
} else
p->PredFlags &= ~ProfiledPredFlag;
if (CALL_COUNTING) {
p->PredFlags |= CountPredFlag;
} else
p->PredFlags &= ~CountPredFlag;
#ifdef YAPOR
if (SEQUENTIAL_IS_DEFAULT) {
p->PredFlags |= SequentialPredFlag;
@ -1636,8 +1640,16 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag)
p->StatisticsForPred.NOfRetries = 0;
if (PROFILING) {
p->PredFlags |= ProfiledPredFlag;
} else
spy_flag = TRUE;
} else {
p->PredFlags &= ~ProfiledPredFlag;
}
if (CALL_COUNTING) {
p->PredFlags |= CountPredFlag;
spy_flag = TRUE;
} else {
p->PredFlags &= ~CountPredFlag;
}
if (spy_flag) {
p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
@ -1666,8 +1678,16 @@ add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag)
p->StatisticsForPred.NOfRetries = 0;
if (PROFILING) {
p->PredFlags |= ProfiledPredFlag;
} else
spy_flag = TRUE;
} else {
p->PredFlags &= ~ProfiledPredFlag;
}
if (CALL_COUNTING) {
p->PredFlags |= CountPredFlag;
spy_flag = TRUE;
} else {
p->PredFlags &= ~CountPredFlag;
}
#ifdef YAPOR
p->PredFlags |= SequentialPredFlag;
#endif /* YAPOR */
@ -1753,12 +1773,12 @@ asserta_stat_clause(PredEntry *p, yamop *q, int spy_flag)
clq->ClNext = clp;
clp->ClPrev = clq;
p->cs.p_code.FirstClause = q;
if (p->PredFlags & SpiedPredFlag) {
if (p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} else if (!(p->PredFlags & IndexedPredFlag)) {
p->OpcodeOfPred = INDEX_OPCODE;
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
}
#if defined(YAPOR) || defined(THREADS)
if (p->ModuleOfPred != IDB_MODULE) {
@ -1771,7 +1791,7 @@ asserta_stat_clause(PredEntry *p, yamop *q, int spy_flag)
cl->ClNext = ClauseCodeToStaticClause(p->cs.p_code.FirstClause);
p->cs.p_code.FirstClause = q;
p->cs.p_code.TrueCodeOfPred = q;
if (p->PredFlags & SpiedPredFlag) {
if (p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} else if (!(p->PredFlags & IndexedPredFlag)) {
@ -1840,7 +1860,7 @@ assertz_stat_clause(PredEntry *p, yamop *cp, int spy_flag)
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
}
#endif
if (p->PredFlags & SpiedPredFlag) {
if (p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
}
@ -1851,7 +1871,7 @@ assertz_stat_clause(PredEntry *p, yamop *cp, int spy_flag)
cl->ClNext = ClauseCodeToStaticClause(cp);
}
if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) {
if (!(p->PredFlags & SpiedPredFlag)) {
if (!(p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag))) {
p->OpcodeOfPred = INDEX_OPCODE;
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
}
@ -2075,7 +2095,7 @@ addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
if (pflags & IndexedPredFlag) {
Yap_AddClauseToIndex(p, cp, mode == asserta);
}
if (pflags & SpiedPredFlag)
if (pflags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag))
spy_flag = TRUE;
if (p == PredGoalExpansion) {
Term tg = ArgOfTerm(1, tf);
@ -2315,7 +2335,7 @@ Yap_EraseStaticClause(StaticClause *cl, Term mod) {
} else if (ap->cs.p_code.NOfClauses > 1) {
ap->OpcodeOfPred = INDEX_OPCODE;
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
} else if (ap->PredFlags & SpiedPredFlag) {
} else if (ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
} else {
@ -2770,6 +2790,7 @@ p_rmspy(void)
return TRUE;
}
#endif
if (!(pred->PredFlags & (CountPredFlag|ProfiledPredFlag))) {
if (!(pred->PredFlags & DynamicPredFlag)) {
#if defined(YAPOR) || defined(THREADS)
if (pred->PredFlags & LogUpdatePredFlag &&
@ -2789,6 +2810,7 @@ p_rmspy(void)
UNLOCK(pred->PELock);
return FALSE;
}
}
pred->PredFlags ^= SpiedPredFlag;
UNLOCK(pred->PELock);
return (TRUE);

8
C/compiler.c
View File

@ -1090,10 +1090,6 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler_struct
save_machine_regs();
longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH);
}
if (profiling)
Yap_emit(enter_profiling_op, (CELL)RepPredProp(p0), Zero, &cglobs->cint);
else if (call_counting)
Yap_emit(count_call_op, (CELL)RepPredProp(p0), Zero, &cglobs->cint);
c_args(Goal, 0, cglobs);
Yap_emit(safe_call_op, (CELL)p0 , Zero, &cglobs->cint);
Yap_emit(empty_call_op, Zero, Zero, &cglobs->cint);
@ -1814,6 +1810,10 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
return;
}
else if (op >= _plus && op <= _functor) {
if (profiling)
Yap_emit(enter_profiling_op, (CELL)RepPredProp(p), Zero, &cglobs->cint);
else if (call_counting)
Yap_emit(count_call_op, (CELL)RepPredProp(p), Zero, &cglobs->cint);
if (op == _functor) {
c_functor(Goal, mod, cglobs);
}

4
C/dbase.c
View File

@ -4253,7 +4253,7 @@ PrepareToEraseLogUpdClause(LogUpdClause *clau, DBRef dbr)
code_p = p->cs.p_code.FirstClause;
code_p->u.Otapl.d = p->cs.p_code.FirstClause;
p->cs.p_code.TrueCodeOfPred = NEXTOP(code_p, Otapl);
if (p->PredFlags & SpiedPredFlag) {
if (p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
#if defined(YAPOR) || defined(THREADS)
@ -4275,7 +4275,7 @@ PrepareToEraseLogUpdClause(LogUpdClause *clau, DBRef dbr)
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
}
} else {
if (p->PredFlags & SpiedPredFlag) {
if (p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
#if defined(YAPOR) || defined(THREADS)

6
C/exec.c
View File

@ -77,12 +77,6 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt, yamop *code) {
YENV[E_CB] = (CELL) cut_pt;
}
P = code;
/* vsc: increment reduction counter at meta-call entry */
if (pen->PredFlags & ProfiledPredFlag) {
LOCK(pen->StatisticsForPred.lock);
pen->StatisticsForPred.NOfEntries++;
UNLOCK(pen->StatisticsForPred.lock);
}
return TRUE;
}

12
C/globals.c
View File

@ -44,7 +44,7 @@ static char SccsId[] = "%W% %G%";
#define HEAP_DELAY_ARENA 3
#define HEAP_START 4
#define MIN_ARENA_SIZE 2048
#define MIN_ARENA_SIZE 1048
#define MAX_ARENA_SIZE (2048*16)
#define Global_MkIntegerTerm(I) MkIntegerTerm(I)
@ -1497,7 +1497,7 @@ p_nb_queue(void)
{
UInt arena_sz = (ASP-H)/16;
if (DepthArenas > 1)
arena_sz /= log(MIN_ARENA_SIZE);
arena_sz /= DepthArenas;
if (arena_sz < MIN_ARENA_SIZE)
arena_sz = MIN_ARENA_SIZE;
if (arena_sz > MAX_ARENA_SIZE)
@ -1579,9 +1579,10 @@ RecoverArena(Term arena)
CELL *pt = ArenaPt(arena),
*max = ArenaLimit(arena);
if (max == H)
if (max == H) {
H = pt;
}
}
static Int
p_nb_queue_close(void)
@ -1612,7 +1613,10 @@ p_nb_queue_close(void)
Yap_unify(ARG3, qp[QUEUE_TAIL]) &&
Yap_unify(ARG2, qp[QUEUE_HEAD]);
qp[-1] = (CELL)Yap_MkFunctor(AtomHeap,1);
qp[0] = MkIntegerTerm(0);
qp[QUEUE_ARENA] =
qp[QUEUE_DELAY_ARENA] =
qp[QUEUE_HEAD] =
qp[QUEUE_TAIL] = MkIntegerTerm(0);
return out;
}
Yap_Error(INSTANTIATION_ERROR,t,"queue/3");

2
C/index.c
View File

@ -5997,7 +5997,7 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
return;
}
ap->cs.p_code.TrueCodeOfPred = ap->cs.p_code.FirstClause;
if (ap->PredFlags & SpiedPredFlag) {
if (ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
#if defined(YAPOR) || defined(THREADS)

65
C/stdpreds.c
View File

@ -2503,6 +2503,70 @@ p_sub_atom_extract(void)
goto start;
}
/* $sub_atom_extract(A,Bef,Size,After,SubAt).*/
static Int
p_sub_atom_fetch(void)
{
Atom at = AtomOfTerm(Deref(ARG1));
Atom subatom = AtomOfTerm(Deref(ARG5));
Int offset = IntegerOfTerm(Deref(ARG6));
if (IsWideAtom(at)) {
wchar_t *s = RepAtom(at)->WStrOfAE;
wchar_t *ins, *where;
Int start, sz, after;
if (!IsWideAtom(subatom)) {
/* first convert to wchar_t */
char *inschars = RepAtom(subatom)->StrOfAE;
Int i;
sz = strlen(inschars);
ins = (wchar_t *)Yap_PreAllocCodeSpace();
while ((ins = (wchar_t *)Yap_PreAllocCodeSpace()) + (sz+1) > (wchar_t *)AuxSp) {
if (!Yap_ExpandPreAllocCodeSpace(sizeof(wchar_t)*(sz+1), NULL, TRUE)) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG5, "allocating temp space in sub_atom/2");
return FALSE;
}
}
for (i=0;i<=sz;i++)
ins[i] = inschars[i];
} else {
ins = RepAtom(subatom)->WStrOfAE;
sz = wcslen(ins);
}
if (!Yap_unify(MkIntegerTerm(sz), ARG3))
return FALSE;
if (!(where = wcsstr(s+offset, ins))) {
return FALSE;
}
if (!Yap_unify(MkIntegerTerm((start = (where-s))), ARG2))
return FALSE;
after = wcslen(s)-(start+sz);
return Yap_unify(MkIntegerTerm(after), ARG4);
} else {
char *s = RepAtom(at)->StrOfAE;
char *ins, *where;
Int start, sz, after;
if (IsWideAtom(subatom)) {
return FALSE;
}
ins = subatom->StrOfAE;
sz = strlen(ins);
if (!Yap_unify(MkIntegerTerm(sz), ARG3))
return FALSE;
if (!(where = strstr(s+offset, ins))) {
return FALSE;
}
if (!Yap_unify(MkIntegerTerm((start = (where-s))), ARG2))
return FALSE;
after = strlen(s)-(start+sz);
return Yap_unify(MkIntegerTerm(after), ARG4);
}
}
static Int
p_abort(void)
@ -3929,6 +3993,7 @@ Yap_InitCPreds(void)
Yap_InitCPred("atom_length", 2, p_atom_length, SafePredFlag);
Yap_InitCPred("$atom_split", 4, p_atom_split, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$sub_atom_extract", 5, p_sub_atom_extract, HiddenPredFlag);
Yap_InitCPred("$sub_atom_fetch", 6, p_sub_atom_fetch, HiddenPredFlag);
Yap_InitCPred("number_chars", 2, p_number_chars, 0);
Yap_InitCPred("number_atom", 2, p_number_atom, 0);
Yap_InitCPred("number_codes", 2, p_number_codes, 0);

4
C/utilpreds.c
View File

@ -467,7 +467,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs) {
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
goto restart_list;
} else if (res && share && FunctorOfTerm(t) != FunctorMutable) {
} else if (res && share) {
H = Hi;
return t;
}
@ -499,7 +499,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs) {
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
goto restart_appl;
} else if (res && share) {
} else if (res && share && FunctorOfTerm(t) != FunctorMutable) {
H = HB0;
return t;
}

2
H/YapOpcodes.h
View File

@ -8,14 +8,12 @@
OPCODE(retry_me ,Otapl),
OPCODE(trust_me ,Otapl),
OPCODE(enter_profiling ,p),
OPCODE(enter_a_profiling ,e),
OPCODE(retry_profiled ,p),
OPCODE(profiled_retry_me ,Otapl),
OPCODE(profiled_trust_me ,Otapl),
OPCODE(profiled_retry_logical ,OtaLl),
OPCODE(profiled_trust_logical ,OtILl),
OPCODE(count_call ,p),
OPCODE(count_a_call ,e),
OPCODE(count_retry ,p),
OPCODE(count_retry_me ,Otapl),
OPCODE(count_trust_me ,Otapl),

6
H/findclause.h
View File

@ -141,12 +141,6 @@
return;
cl = NEXTOP(cl,e);
break;
case _count_a_call:
cl = NEXTOP(cl,e);
break;
case _enter_a_profiling:
cl = NEXTOP(cl,e);
break;
case _pop:
cl = NEXTOP(cl,e);
break;

2
H/rclause.h
View File

@ -194,11 +194,9 @@ restore_opcodes(yamop *pc)
case _Nstop:
case _allocate:
case _copy_idb_term:
case _count_a_call:
case _cut:
case _cut_e:
case _cut_t:
case _enter_a_profiling:
case _expand_index:
case _index_blob:
case _index_dbref:

2
H/walkclause.h
View File

@ -154,11 +154,9 @@
case _unify_idb_term:
return found_idb_clause(pc, startp, endp);
case _allocate:
case _count_a_call:
case _cut:
case _cut_e:
case _cut_t:
case _enter_a_profiling:
case _index_blob:
case _index_dbref:
case _index_long:

57
packages/cplint/lpad.pl
View File

@ -34,7 +34,7 @@
p/1,
slg/3,setting/2,set/2
]).
:-source.
:- dynamic wfs_trace/0.
:-use_module(library(ugraphs)).
:-use_module(library(lists)).
@ -434,7 +434,14 @@ map_oldt([Clause|Frames],Ggoal,Tab0,Tab,S0,S,Dfn0,Dfn,Dep0,Dep,TP0,TP,
C0,C,D0,D) :-
edge_oldt(Clause,Ggoal,Tab0,Tab1,S0,S1,Dfn0,Dfn1,Dep0,Dep1,TP0,TP1,
C0,C1,D0,D1),
map_oldt(Frames,Ggoal,Tab1,Tab,S1,S,Dfn1,Dfn,Dep1,Dep,TP1,TP,C1,C,D1,D).
find(Tab0,Ggoal,Ent),
ent_to_comp(Ent,Comp),
(Comp \== true->
map_oldt(Frames,Ggoal,Tab1,Tab,S1,S,Dfn1,Dfn,
Dep1,Dep,TP1,TP,C1,C,D1,D)
;
Tab=Tab1,S=S1,Dfn=Dfn1,Dep=Dep1,TP=TP1,C=C1,D=D1
).
/* edge_oldt(Clause,Ggoal,Tab0,Tab,S0,S,Dfn0,Dfn,Dep0,Dep,TP0,TP)
Clause may be one of the following forms:
@ -470,9 +477,25 @@ edge_oldt(Clause,Ggoal,Tab0,Tab,S0,S,Dfn0,Dfn,Dep0,Dep,TP0,TP,C0,C,D0,D) :-
or to the D set if it is definite. The rule is added only if it is consistent
with the current C set
*/
add_ans_to_C(rule(_,_,def(N),_,S,_),C,C,D,[(N,S)|D],true):-!.
add_ans_to_C(rule(_,_,def(N),_,S,_),Tab,C,C,D,[(N,S)|D],true):-!.
add_ans_to_C(rule(_Ans,_B,R,N,S,LH),C0,C,D,D,HeadSelected):-
add_ans_to_C(rule(Goal,_B,R,N,S,LH),Tab,C0,C,D,D,HeadSelected):-
Goal=d(G,_D),
(find(Tab,G,Ent)->
ent_to_anss(Ent,Anss),
(member_anss(d(G,[]),Anss)->
C=C0,
HeadSelected=false
;
add_to_C(R,N,S,LH,C0,C,HeadSelected)
)
;
add_to_C(R,N,S,LH,C0,C,HeadSelected)
).
add_to_C(R,N,S,LH,C0,C,HeadSelected):-
member(N1,LH),
(N1=N->
HeadSelected=true
@ -518,7 +541,7 @@ add_PC_to_C([rule(H,B,R,N,S)|T],C0,C):-
add_PC_to_C(T,C1,C).
ans_edge(rule(Ans,B,Rule,Number,Sub,LH),Ggoal,Tab0,Tab,S0,S,Dfn0,Dfn,Dep0,Dep,TP0,TP,C0,C,D0,D) :-
add_ans_to_C(rule(Ans,B,Rule,Number,Sub,LH),C0,C1,D0,D1,HeadSelected),
add_ans_to_C(rule(Ans,B,Rule,Number,Sub,LH),Tab0,C0,C1,D0,D1,HeadSelected),
(HeadSelected=false->
Tab = Tab0, S = S0, Dfn = Dfn0, Dep = Dep0, TP = TP0, C=C1, D=D1
;
@ -1347,6 +1370,14 @@ succeeded(l(_,Lanss)) :-
else
fail.
*/
add_ans(Tab0,Ggoal,Ans,Nodes,Mode,Tab) :-
Ans = d(H,[]),
ground(H),
H=Ggoal,!,
updatevs(Tab0,Ggoal,Ent0,Ent,Tab),
new_ans_ent1(Ent0,Ent,Ans,Nodes,Mode).
add_ans(Tab0,Ggoal,Ans,Nodes,Mode,Tab) :-
updatevs(Tab0,Ggoal,Ent0,Ent,Tab),
Ans = d(H,Ds),
@ -1356,6 +1387,20 @@ add_ans(Tab0,Ggoal,Ans,Nodes,Mode,Tab) :-
new_ans_ent(Ent0,Ent,d(H,NewDs),Nodes,Mode)
).
new_ans_ent1(Ent0,Ent,Ans,Nodes,Mode) :-
Ent0 = e(Nodes,ANegs,Anss0,Delay0,Comp,Dfn,Slist),
Ent = e(Nodes,ANegs,Anss,Delay,true,Dfn,Slist),
Ans = d(H,[]),
( updatevs(Anss0,H,Lanss0,Lanss,Anss) ->
Lanss = [Ans],
Mode = no_new_head
; addkey(Anss0,H,[Ans],Anss),
Mode = new_head
),
Delay = Delay0
.
new_ans_ent(Ent0,Ent,Ans,Nodes,Mode) :-
Ent0 = e(Nodes,ANegs,Anss0,Delay0,Comp,Dfn,Slist),
Ent = e(Nodes,ANegs,Anss,Delay,Comp,Dfn,Slist),
@ -1763,7 +1808,7 @@ cmb5(t(NT2a,Mb,NT2b),T1,M2,M3,T3,t(n2(T1,M2,NT2a),Mb,n2(NT2b,M3,T3))).
set(Parameter,Value) */
setting(epsilon_parsing,0.00001).
setting(save_dot,false).
setting(ground_body,false).
setting(ground_body,true).
/* find_rule(G,(R,S,N),Body,C) takes a goal G and the current C set and
returns the index R of a disjunctive rule resolving with G together with

15
pl/utils.yap
View File

@ -520,6 +520,10 @@ sub_atom(At, Bef, Size, After, SubAt) :-
% extract something from an atom
atom(At), integer(Bef), integer(Size), !,
'$sub_atom_extract'(At, Bef, Size, After, SubAt).
sub_atom(At, Bef, Size, After, SubAt) :-
% extract subatom from an atom
atom(At), atom(SubAt), !,
'$do_sub_atom_fetch'(At, Bef, Size, After, SubAt, 0).
sub_atom(At, Bef, Size, After, SubAt) :-
atom(At), !,
atom_codes(At, Atl),
@ -532,6 +536,17 @@ sub_atom(At, Bef, Size, After, SubAt) :-
'$do_error'(type_error(atom,At),sub_atom(At, Bef, Size,After, SubAt)).
'$do_sub_atom_fetch'(At, Bef, Size, After, SubAt, I0) :-
'$sub_atom_fetch'(At, Bef1, Size, After1, SubAt, I0),
(
Bef = Bef1, After = After1
;
Next is Bef1+1,
'$do_sub_atom_fetch'(At, Bef, Size, After, SubAt, Next)
).
'$sub_atom2'(Bef, Atl, Size, After, SubAt, ErrorTerm) :-
var(Bef), !,
'$sub_atombv'(Bef, Size, After, SubAt, Atl, ErrorTerm).