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

coroutining is now a part of attvars.

Browse Source 
some more fixes.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1070 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-06-05 03:37:01 +00:00
parent cfd90835a0
commit 0101c09236
25 changed files with 341 additions and 956 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
C/absmi.c
View File

@ -10,8 +10,12 @@
* * * *
* File: absmi.c * * File: absmi.c *
* comments: Portable abstract machine interpreter * * comments: Portable abstract machine interpreter *
* Last rev: $Date: 2004-05-13 20:54:57 $,$Author: vsc $ * * Last rev: $Date: 2004-06-05 03:36:59 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.133 2004/05/13 20:54:57 vsc
* debugger fixes
* make sure we always go back to current module, even during initizlization.
*
* Revision 1.132 2004/04/29 03:45:49 vsc * Revision 1.132 2004/04/29 03:45:49 vsc
* fix garbage collection in execute_tail * fix garbage collection in execute_tail
* *
@ -1863,13 +1867,9 @@ Yap_absmi(int inp)
#ifdef YAPOR #ifdef YAPOR
CUT_prune_to((choiceptr) d0); CUT_prune_to((choiceptr) d0);
#else #else
B = (choiceptr) d0; while (B->cp_b != (choiceptr)d0) {
#endif /* YAPOR */ B = B->cp_b;
#ifdef TABLING }
abolish_incomplete_subgoals(B);
#endif /* TABLING */
SET_BB(PROTECT_FROZEN_B(B));
HBREG = PROTECT_FROZEN_H(B);
trim_trail: trim_trail:
{ {
tr_fr_ptr pt1, pt0; tr_fr_ptr pt1, pt0;
@ -1920,6 +1920,13 @@ Yap_absmi(int inp)
} }
TR = pt0; TR = pt0;
} }
B = B->cp_b;
#endif /* YAPOR */
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
SET_BB(PROTECT_FROZEN_B(B));
HBREG = PROTECT_FROZEN_H(B);
} }
ENDD(d0); ENDD(d0);
GONext(); GONext();
@ -1937,13 +1944,10 @@ Yap_absmi(int inp)
#ifdef YAPOR #ifdef YAPOR
CUT_prune_to((choiceptr) d0); CUT_prune_to((choiceptr) d0);
#else #else
B = (choiceptr) d0; while (B->cp_b != (choiceptr)d0) {
B = B->cp_b;
}
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
SET_BB(PROTECT_FROZEN_B(B));
HBREG = PROTECT_FROZEN_H(B);
goto trim_trail; goto trim_trail;
} }
ENDD(d0); ENDD(d0);
@ -1961,13 +1965,10 @@ Yap_absmi(int inp)
#ifdef YAPOR #ifdef YAPOR
CUT_prune_to((choiceptr) d0); CUT_prune_to((choiceptr) d0);
#else #else
B = (choiceptr) d0; while (B->cp_b != (choiceptr)d0) {
B = B->cp_b;
}
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
SET_BB(PROTECT_FROZEN_B(B));
HBREG = PROTECT_FROZEN_H(B);
goto trim_trail; goto trim_trail;
} }
ENDD(d0); ENDD(d0);
@ -2022,13 +2023,10 @@ Yap_absmi(int inp)
#ifdef YAPOR #ifdef YAPOR
CUT_prune_to(pt0); CUT_prune_to(pt0);
#else #else
B = pt0; while (B->cp_b != pt0) {
B = B->cp_b;
}
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
SET_BB(PROTECT_FROZEN_B(B));
HBREG = PROTECT_FROZEN_H(pt0);
goto trim_trail; goto trim_trail;
} }
} }
@ -2058,13 +2056,10 @@ Yap_absmi(int inp)
#ifdef YAPOR #ifdef YAPOR
CUT_prune_to(pt0); CUT_prune_to(pt0);
#else #else
B = pt0; while (B->cp_b != pt0) {
B = B->cp_b;
}
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
SET_BB(PROTECT_FROZEN_B(B));
HBREG = PROTECT_FROZEN_H(pt0);
goto trim_trail; goto trim_trail;
} }
} }
@ -2670,7 +2665,6 @@ Yap_absmi(int inp)
} else } else
#endif #endif
SREG = (CELL *) CreepCode; SREG = (CELL *) CreepCode;
CFREG = CalculateStackGap();
UNLOCK(SignalLock); UNLOCK(SignalLock);
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) if (Yap_do_low_level_trace)
@ -7725,13 +7719,10 @@ Yap_absmi(int inp)
#ifdef YAPOR #ifdef YAPOR
CUT_prune_to(pt0); CUT_prune_to(pt0);
#else #else
B = pt0; while (B->cp_b != pt0) {
B = B->cp_b;
}
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
HBREG = PROTECT_FROZEN_H(B);
PREG = NEXTOP(PREG, xF);
goto trim_trail; goto trim_trail;
} }
PREG = NEXTOP(PREG, xF); PREG = NEXTOP(PREG, xF);
@ -7773,13 +7764,10 @@ Yap_absmi(int inp)
#ifdef YAPOR #ifdef YAPOR
CUT_prune_to(pt1); CUT_prune_to(pt1);
#else #else
B = pt1; while (B->cp_b != pt1) {
B = B->cp_b;
}
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
HBREG = PROTECT_FROZEN_H(B);
PREG = NEXTOP(PREG, yF);
goto trim_trail; goto trim_trail;
} }
PREG = NEXTOP(PREG, yF); PREG = NEXTOP(PREG, yF);
@ -11847,7 +11835,6 @@ Yap_absmi(int inp)
if (ASP > (CELL *)B) if (ASP > (CELL *)B)
ASP = (CELL *)B; ASP = (CELL *)B;
LOCK(SignalLock); LOCK(SignalLock);
ActiveSignals &= ~YAP_CDOVF_SIGNAL;
UNLOCK(SignalLock); UNLOCK(SignalLock);
if (ActiveSignals & YAP_CDOVF_SIGNAL) { if (ActiveSignals & YAP_CDOVF_SIGNAL) {
saveregs_and_ycache(); saveregs_and_ycache();
@ -11858,8 +11845,44 @@ Yap_absmi(int inp)
} }
setregs_and_ycache(); setregs_and_ycache();
LOCK(SignalLock); LOCK(SignalLock);
ActiveSignals &= ~YAP_CDOVF_SIGNAL;
CFREG = CalculateStackGap(); CFREG = CalculateStackGap();
UNLOCK(SignalLock); UNLOCK(SignalLock);
if (!ActiveSignals) {
goto execute_after_comma;
}
}
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
saveregs_and_ycache();
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
setregs_and_ycache();
FAIL();
}
setregs_and_ycache();
LOCK(SignalLock);
ActiveSignals &= ~YAP_CDOVF_SIGNAL;
CFREG = CalculateStackGap();
UNLOCK(SignalLock);
if (!ActiveSignals) {
goto execute_after_comma;
}
}
if (ActiveSignals & YAP_TROVF_SIGNAL) {
saveregs_and_ycache();
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"YAP failed to reserve %ld bytes in growtrail",sizeof(CELL) * 16 * 1024L);
setregs_and_ycache();
FAIL();
}
setregs_and_ycache();
LOCK(SignalLock);
ActiveSignals &= ~YAP_TROVF_SIGNAL;
CFREG = CalculateStackGap();
UNLOCK(SignalLock);
if (!ActiveSignals) {
goto execute_after_comma;
}
} }
if (ActiveSignals) { if (ActiveSignals) {
goto creep; goto creep;

2
C/adtdefs.c
View File

@ -513,7 +513,7 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));
p->cs.p_code.ExpandCode = EXPAND_OP_CODE; p->cs.p_code.ExpandCode = EXPAND_OP_CODE;
if (cur_mod == TermProlog) if (cur_mod == TermProlog)
p->ModuleOfPred = 0; p->ModuleOfPred = 0L;
else else
p->ModuleOfPred = cur_mod; p->ModuleOfPred = cur_mod;
Yap_NewModulePred(cur_mod, p); Yap_NewModulePred(cur_mod, p);

83
C/attvar.c
View File

@ -38,55 +38,35 @@ static CELL *
AddToQueue(attvar_record *attv) AddToQueue(attvar_record *attv)
{ {
Term t[2]; Term t[2];
sus_record *WGs; Term WGs, ng;
sus_record *new;
t[0] = (CELL)&(attv->Done); t[0] = (CELL)&(attv->Done);
t[1] = attv->Value; t[1] = attv->Value;
/* follow the chain */ /* follow the chain */
WGs = (sus_record *)Yap_ReadTimedVar(WokenGoals); WGs = Yap_ReadTimedVar(WokenGoals);
new = (sus_record *)H; ng = Yap_MkApplTerm(FunctorAttGoal, 2, t);
H = (CELL *)(new+1);
new->NR = (sus_record *)(&(new->NR));
new->SG = Yap_MkApplTerm(FunctorAttGoal, 2, t);
new->NS = new;
Yap_UpdateTimedVar(WokenGoals, MkPairTerm(ng, WGs));
if ((Term)WGs == TermNil) { if ((Term)WGs == TermNil) {
Yap_UpdateTimedVar(WokenGoals, (CELL)new);
/* from now on, we have to start waking up goals */ /* from now on, we have to start waking up goals */
Yap_signal(YAP_WAKEUP_SIGNAL); Yap_signal(YAP_WAKEUP_SIGNAL);
} else {
/* add to the end of the current list of suspended goals */
CELL *where_to = (CELL *)Deref((CELL)WGs);
Bind_Global(where_to, (CELL)new);
} }
return(RepAppl(new->SG)+2); return(RepAppl(ng)+2);
} }
static CELL * static void
AddFailToQueue(void) AddFailToQueue(void)
{ {
sus_record *WGs; Term WGs;
sus_record *new;
/* follow the chain */ /* follow the chain */
WGs = (sus_record *)Yap_ReadTimedVar(WokenGoals); WGs = Yap_ReadTimedVar(WokenGoals);
new = (sus_record *)H;
H = (CELL *)(new+1);
new->NR = (sus_record *)(&(new->NR));
new->SG = MkAtomTerm(AtomFail);
new->NS = new;
Yap_UpdateTimedVar(WokenGoals, MkPairTerm(MkAtomTerm(AtomFail),WGs));
if ((Term)WGs == TermNil) { if ((Term)WGs == TermNil) {
Yap_UpdateTimedVar(WokenGoals, (CELL)new);
/* from now on, we have to start waking up goals */ /* from now on, we have to start waking up goals */
Yap_signal(YAP_WAKEUP_SIGNAL); Yap_signal(YAP_WAKEUP_SIGNAL);
} else {
/* add to the end of the current list of suspended goals */
CELL *where_to = (CELL *)Deref((CELL)WGs);
Bind_Global(where_to, (CELL)new);
} }
return(RepAppl(new->SG)+2);
} }
static int static int
@ -213,6 +193,15 @@ WakeAttVar(CELL* pt1, CELL reg2)
Bind_Global(&(attv->Value), reg2); Bind_Global(&(attv->Value), reg2);
} }
void
Yap_WakeUp(CELL *pt0) {
CELL d0 = *pt0;
RESET_VARIABLE(pt0);
TR--;
WakeAttVar(pt0, d0);
}
static void static void
mark_attvar(CELL *orig) mark_attvar(CELL *orig)
{ {
@ -289,6 +278,18 @@ PutAtt(attvar_record *attv, Int i, Term tatt) {
return(TRUE); return(TRUE);
} }
static Int
UpdateAtt(attvar_record *attv, Int i, Term tatt) {
Int pos = i*2;
if (!IsUnboundVar(attv->Atts[pos+1])) {
tatt = MkPairTerm(tatt, attv->Atts[pos+1]);
} else {
tatt = MkPairTerm(tatt, TermNil);
}
return PutAtt(attv, i, tatt);
}
static Int static Int
RmAtt(attvar_record *attv, Int i) { RmAtt(attvar_record *attv, Int i) {
Int pos = i *2; Int pos = i *2;
@ -482,6 +483,29 @@ p_put_att(void) {
} }
} }
static Int
p_update_att(void) {
/* receive a variable in ARG1 */
Term inp = Deref(ARG1);
/* if this is unbound, ok */
if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) {
attvar_record *attv = (attvar_record *)VarOfTerm(inp);
exts id = (exts)attv->sus_id;
if (id != attvars_ext) {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
return(FALSE);
}
return(UpdateAtt(attv, IntegerOfTerm(Deref(ARG2)), Deref(ARG3)));
}
return(BuildNewAttVar(inp, IntegerOfTerm(Deref(ARG2)), MkPairTerm(Deref(ARG3),TermNil)));
} else {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
return(FALSE);
}
}
static Int static Int
p_rm_att(void) { p_rm_att(void) {
/* receive a variable in ARG1 */ /* receive a variable in ARG1 */
@ -655,6 +679,7 @@ void Yap_InitAttVarPreds(void)
Yap_InitCPred("get_all_atts", 2, p_get_all_atts, SafePredFlag); Yap_InitCPred("get_all_atts", 2, p_get_all_atts, SafePredFlag);
Yap_InitCPred("free_att", 2, p_free_att, SafePredFlag); Yap_InitCPred("free_att", 2, p_free_att, SafePredFlag);
Yap_InitCPred("put_att", 3, p_put_att, 0); Yap_InitCPred("put_att", 3, p_put_att, 0);
Yap_InitCPred("update_att", 3, p_update_att, 0);
Yap_InitCPred("rm_att", 2, p_rm_att, SafePredFlag); Yap_InitCPred("rm_att", 2, p_rm_att, SafePredFlag);
Yap_InitCPred("inc_n_of_atts", 1, p_inc_atts, SafePredFlag); Yap_InitCPred("inc_n_of_atts", 1, p_inc_atts, SafePredFlag);
Yap_InitCPred("n_of_atts", 1, p_n_atts, SafePredFlag); Yap_InitCPred("n_of_atts", 1, p_n_atts, SafePredFlag);

11
C/c_interface.c
View File

@ -10,8 +10,11 @@
* File: c_interface.c * * File: c_interface.c *
* comments: c_interface primitives definition * * comments: c_interface primitives definition *
* * * *
* Last rev: $Date: 2004-05-17 21:42:08 $,$Author: vsc $ * * Last rev: $Date: 2004-06-05 03:36:59 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.47 2004/05/17 21:42:08 vsc
* misc fixes
*
* Revision 1.46 2004/05/14 17:56:45 vsc * Revision 1.46 2004/05/14 17:56:45 vsc
* Yap_WriteBuffer * Yap_WriteBuffer
* *
@ -101,7 +104,7 @@ X_API Term STD_PROTO(YAP_ReadBuffer, (char *,Term *));
X_API Term STD_PROTO(YAP_BufferToString, (char *)); X_API Term STD_PROTO(YAP_BufferToString, (char *));
X_API Term STD_PROTO(YAP_BufferToAtomList, (char *)); X_API Term STD_PROTO(YAP_BufferToAtomList, (char *));
X_API void STD_PROTO(YAP_Error,(char *)); X_API void STD_PROTO(YAP_Error,(char *));
X_API int STD_PROTO(YAP_RunGoal,(Term)); X_API Term STD_PROTO(YAP_RunGoal,(Term));
X_API int STD_PROTO(YAP_RestartGoal,(void)); X_API int STD_PROTO(YAP_RestartGoal,(void));
X_API int STD_PROTO(YAP_GoalHasException,(Term *)); X_API int STD_PROTO(YAP_GoalHasException,(Term *));
X_API int STD_PROTO(YAP_ContinueGoal,(void)); X_API int STD_PROTO(YAP_ContinueGoal,(void));
@ -752,10 +755,10 @@ static void myputc (int ch)
putc(ch,stderr); putc(ch,stderr);
} }
X_API int X_API Term
YAP_RunGoal(Term t) YAP_RunGoal(Term t)
{ {
int out; Term out;
yamop *old_CP = CP; yamop *old_CP = CP;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();

9
C/cdmgr.c
View File

@ -11,8 +11,11 @@
* File: cdmgr.c * * File: cdmgr.c *
* comments: Code manager * * comments: Code manager *
* * * *
* Last rev: $Date: 2004-05-17 21:42:09 $,$Author: vsc $ * * Last rev: $Date: 2004-06-05 03:36:59 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.123 2004/05/17 21:42:09 vsc
* misc fixes
*
* Revision 1.122 2004/05/13 21:36:45 vsc * Revision 1.122 2004/05/13 21:36:45 vsc
* get rid of pesky debugging prints * get rid of pesky debugging prints
* *
@ -2388,12 +2391,12 @@ search_for_static_predicate_in_use(PredEntry *p, int check_everything)
} }
do { do {
/* check first environments that are younger than our latest choicepoint */ /* check first environments that are younger than our latest choicepoint */
if (check_everything) { if (check_everything && env_ptr) {
/* /*
I do not need to check environments for asserts, I do not need to check environments for asserts,
only for retracts only for retracts
*/ */
while (b_ptr > (choiceptr)env_ptr) { while (env_ptr && b_ptr > (choiceptr)env_ptr) {
PredEntry *pe = EnvPreg(env_ptr[E_CP]); PredEntry *pe = EnvPreg(env_ptr[E_CP]);
if (p == pe) return(TRUE); if (p == pe) return(TRUE);
if (env_ptr != NULL) if (env_ptr != NULL)

736
C/corout.c
View File

@ -26,601 +26,12 @@ static char SccsId[]="%W% %G%";
#define NULL (void *)0 #define NULL (void *)0
#endif #endif
/*
These are simple routines to support co-routining in YAP. The idea is
to make the interface as simple as possible.
The interface for co-routines is:
$freeze(+X,+G) -> execute G only when V is *bound* (not
necessarily ground.
The data-structures are:
|-------------------|
Ref ---------------->| V | SG\ |
|-------------\-----|
\
\ |------------/
>| | | G | NS|
| | | | |
|-|----------|
|
V
|------------/
->| | G | NS|
| | | | | |
| |-|----------|
| |
|----
Where V is an indicator for the term, SG is a pointer for the list of
suspended goals, G is the suspended goal, and NS is a pointer to a
list of suspended goals.
When suspend_on is called, it executes the following operations:
if (X is a reference):
add a record containing G to the tail
of the current SG list for V
if (X is unbound)
create a record R containing G and a self-reference.
create a suspension register containing a free
variable V and a pointer to R (sus goal list)
Bind V to a Ref to the new structure.
if (X is nonvar)
Oooppssss!!!! The Prolog interface should have
prevented this.
When trying to unify a nonvar to a suspension variable, the following
actions are taken:
o Bind V to to the nonvar. This is done within absmi.c and
depends a lot on the surrounding code.
o Make the list SG the head of the list WokenGoals.
o Activate the Interrupt Flag, so that the system will process
the suspended goals at the next "call" absmiop.
At the next "call":
+ Save the current goal on the heap (C).
+ Take the first member of the WokenGoals list.
+ set up '$resume_and_continue'(?G,?C), which should execute
G and then C.
+ If WokenGoals is empty, down Interrupt Flag
+ jump to the code for '$resume_and_continue'(?G,?C)
+ Note, the system will fetch the next goal at the next
"call" op.
When trying to unify two suspended variables X and Y, we just bind X
to Y, and include Y's goals in X's list.
The standard definition for resume_and_continue:
'$wake_up_goal'(C,G) :- call(G), call(C).
Advantages:
o Implementation is simple (the main work is changing absmi).
o Does not need updatable variables.
o No special support in backtracking.
o Data structures spend little space.
Disadvantages
o We create a goal frame for every suspended goal. This is
avoided by storing both P and the arguments in the suspension
record, and then jumping.
o We do a lot of meta-calls. This can be avoided by
manipulating P and CP directly.
*/
STATIC_PROTO(Int p_read_svar_list, (void));
STATIC_PROTO(Int p_set_svar_list, (void));
STATIC_PROTO(Int p_frozen_goals, (void));
STATIC_PROTO(Int p_all_frozen_goals, (void));
STATIC_PROTO(Int p_freeze_on_first, (void));
STATIC_PROTO(Int p_freeze, (void));
STATIC_PROTO(Int p_can_unify, (void));
STATIC_PROTO(Int p_non_ground, (void));
#ifdef COROUTINING
STATIC_PROTO(void Wake, (CELL *, CELL));
STATIC_PROTO(sus_record *UpdateSVarList, (sus_record *));
STATIC_PROTO(sus_record *GetSVarList, (void));
STATIC_PROTO(void mark_sus_record, (sus_record *));
STATIC_PROTO(void mark_suspended_goal, (CELL *));
STATIC_PROTO(void AddSuspendedGoals, (sus_record *, sus_record *));
STATIC_PROTO(void ReleaseGoals, (sus_record *));
STATIC_PROTO(void wake_if_binding_vars_in_frozen_goal, (Term, sus_record *));
STATIC_PROTO(void AddSuspendedGoals, (sus_record *, sus_record *));
STATIC_PROTO(sus_record *has_been_suspended, (Term, sus_record *));
STATIC_PROTO(void AddSuspendedGoal, (Term, sus_record *));
STATIC_PROTO(Term AddSusToList, (Term, Term));
STATIC_PROTO(Term AddSusSubGoals, (Term, CELL *, int));
STATIC_PROTO(Int freeze_goal, (Term, Term));
STATIC_PROTO(Term AddVarIfNotThere, (Term, Term));
STATIC_PROTO(int can_unify_complex, (CELL *, CELL *, CELL *, Term *));
STATIC_PROTO(int can_unify, (Term, Term, Term *));
STATIC_PROTO(int non_ground_complex, (CELL *, CELL *, Term *));
STATIC_PROTO(int non_ground, (Term, Term *));
#ifdef FOLLOW_ENVIRONMENTS_FOR_SUSPENDED_GOALS
STATIC_PROTO(Term FindFrozenGoals, (Term, CELL *, int));
#endif
#ifdef MULTI_ASSIGNMENT_VARIABLES
inline static sus_record *
UpdateSVarList(sus_record *sl)
{
/* make sl the new head of the suspension list, and update the list
to use the old one. Note that the list is only bound once,
MutableList is the one variable being updated all the time */
return((sus_record *)Yap_UpdateTimedVar(MutableList, (CELL)sl));
}
inline static sus_record *
GetSVarList(void)
{
Term t = Yap_ReadTimedVar(MutableList);
/* just return the start of the list */
if (t == TermNil)
return(NULL);
else
return((sus_record *)t);
}
#endif
/* dif (and eventually others) may have the same goal suspended on the
several variables. If this is the case, whenever we bind two
variables we may need to wake the goals. That's implemented by
going to the other guy's list, and checking if the same goal
appears there.
*/
static Term
ListOfWokenGoals(void) {
sus_record *pt = (sus_record *)Yap_ReadTimedVar(WokenGoals);
Term t;
t = TermNil;
while (pt->NR != (sus_record *)(&(pt->NR))) {
t = MkPairTerm(pt->SG, t);
pt = pt->NR;
}
t = MkPairTerm(pt->SG, t);
return(t);
}
Term
Yap_ListOfWokenGoals(void) {
return ListOfWokenGoals();
}
static void ReleaseGoals(sus_record *from)
{
/* follow the chain */
sus_record *WGs = (sus_record *)Yap_ReadTimedVar(WokenGoals);
if ((Term)WGs == TermNil) {
Yap_UpdateTimedVar(WokenGoals, (CELL)from);
} else {
/* add to the end of the current list of suspended goals */
CELL *where_to = (CELL *)Deref((CELL)WGs);
Bind_Global(where_to, (CELL)from);
}
Yap_signal(YAP_WAKEUP_SIGNAL);
}
static void
wake_if_binding_vars_in_frozen_goal(Term goal, sus_record *from)
{
do {
if (from->SG == goal) {
sus_record *gf;
/* A dif like goal has suspended on both variables. We cannot
wake it up directly, because it may have other goals
suspended on the same variable. So we'll just wake up a copy,
and wake up the copy.
*/
gf = (sus_record *)H;
H += sizeof(sus_record)/sizeof(CELL);
gf->NR = (sus_record *)&(gf->NR);
gf->SG = goal;
#ifdef MULTI_ASSIGNMENT_VARIABLES
gf->NS = UpdateSVarList(gf);
#endif
ReleaseGoals(gf);
/* done */
return;
}
if (from->NR == (sus_record *)&(from->NR))
return;
else from = from->NR;
} while (TRUE);
}
inline static void AddSuspendedGoals(sus_record *to, sus_record *from)
{
/* deref the chain */
do {
if (IsApplTerm(to->SG))
wake_if_binding_vars_in_frozen_goal(to->SG, from);
if (to->NR == (sus_record *)&(to->NR))
break;
else to = to->NR;
} while (TRUE);
/* and bind it */
Bind_Global((CELL *)(to->NR), (CELL)from);
}
static sus_record *
has_been_suspended(Term goal, sus_record *from)
{
do {
if (from->SG == goal) {
/* we found it */
return (NULL);
}
if (from->NR == (sus_record *)&(from->NR))
return (from);
else from = from->NR;
} while (TRUE);
/* make lcc happy */
return(NULL);
}
/* This is a simplified version for the case we add a goal to a
suspended goal queue. It avoids having the same copy of the goal
all over the place!
*/
inline static void AddSuspendedGoal(Term goal, sus_record *from)
{
sus_record *gf;
/* do nothing if we suspended before on the same goal! */
if (IsApplTerm(goal) && ((from = has_been_suspended(goal, from)) == NULL))
return;
/* else add goal to the queue */
gf = (sus_record *)H;
H += sizeof(sus_record)/sizeof(CELL);
gf->NR = (sus_record *)&(gf->NR);
gf->SG = goal;
#ifdef MULTI_ASSIGNMENT_VARIABLES
gf->NS = UpdateSVarList(gf);
#endif
Bind_Global((CELL *)&(from->NR), (CELL)gf);
}
static sus_record *
copy_suspended_goals(sus_record *pt, CELL ***to_visit_ptr)
{
CELL **to_visit = *to_visit_ptr;
sus_record *gf;
gf = (sus_record *)H;
H += sizeof(sus_record)/sizeof(CELL);
to_visit[0] = &(pt->SG)-1;
to_visit[1] = &(pt->SG);
to_visit[2] = &(gf->SG);
to_visit[3] = (CELL *)(*to_visit[0]);
*to_visit_ptr = to_visit+4;
#ifdef MULTI_ASSIGNMENT_VARIABLES
gf->NS = UpdateSVarList(gf);
#endif
if (pt->NR == (sus_record *)(&(pt->NR))) {
gf->NR = (sus_record *)&(gf->NR);
} else {
gf->NR = copy_suspended_goals(pt->NR, to_visit_ptr);
}
return(gf);
}
static int
CopySuspendedVar(CELL *orig, CELL ***to_visit_ptr, CELL *res)
{
register sus_tag *sreg = (sus_tag *)orig, *vs;
/* add a new suspension */
vs = (sus_tag *)Yap_ReadTimedVar(DelayedVars);
if (H0 - (CELL *)vs < 1024)
return(FALSE);
RESET_VARIABLE(&(vs->ActiveSus));
vs->sus_id = susp_ext;
vs->SG = copy_suspended_goals(sreg->SG, to_visit_ptr);
*res = (CELL)&(vs->ActiveSus);
Yap_UpdateTimedVar(DelayedVars, (CELL)(vs+1));
return(TRUE);
}
static Term
mk_sus_var_list(sus_record *sr, sus_record *osr)
{
if (sr == osr)
return(TermNil);
return(MkPairTerm(sr->SG, mk_sus_var_list(sr->NR, sr)));
}
static Term
SuspendedVarToTerm(CELL *orig)
{
register sus_tag *sreg = (sus_tag *)orig;
return(MkPairTerm(sreg->SG->SG, mk_sus_var_list(sreg->SG->NR, sreg->SG)));
}
static sus_record *
terms_to_suspended_goals(Term gl)
{
sus_record *gf;
gf = (sus_record *)H;
H += sizeof(sus_record)/sizeof(CELL);
#ifdef MULTI_ASSIGNMENT_VARIABLES
gf->NS = UpdateSVarList(gf);
#endif
gf->SG = HeadOfTerm(gl);
gl = TailOfTerm(gl);
if (gl == TermNil) {
gf->NR = (sus_record *)&(gf->NR);
} else {
gf->NR = terms_to_suspended_goals(gl);
}
return(gf);
}
static int
TermToSuspendedVar(Term gs, Term var)
{
register sus_tag *vs;
/* add a new suspension */
vs = (sus_tag *)Yap_ReadTimedVar(DelayedVars);
if (H0 - (CELL *)vs < 1024)
return(FALSE);
Yap_UpdateTimedVar(DelayedVars, (CELL)(vs+1));
RESET_VARIABLE(&(vs->ActiveSus));
vs->sus_id = susp_ext;
vs->SG = terms_to_suspended_goals(gs);
Yap_unify(var,(CELL)&(vs->ActiveSus));
return(TRUE);
}
static void
mark_sus_record(sus_record *sg)
{
if (MARKED(((CELL)(sg->NR))))
return;
MARK(((CELL *)&(sg->NR)));
Yap_inc_mark_variable();
Yap_mark_variable((CELL *)&(sg->SG));
#ifdef MULTI_ASSIGNMENT_VARIABLES
Yap_inc_mark_variable();
if (!IsAtomTerm((CELL)(sg->NS)))
mark_sus_record(sg->NS);
MARK(((CELL *)&(sg->NS)));
#endif
}
static void mark_suspended_goal(CELL *orig)
{
register sus_tag *sreg = (sus_tag *)orig;
mark_sus_record(sreg->SG);
Yap_mark_external_reference(((CELL *)&(sreg->SG)));
}
void
Yap_mark_all_suspended_goals(void)
{
sus_record *sg = GetSVarList();
if (sg == NULL)
return;
/* okay, we are on top of the list of variables. Let's burn rubber!
*/
while (sg != (sus_record *)TermNil) {
CELL tmp;
mark_sus_record(sg);
tmp = (CELL)(sg->NS);
if (MARKED(tmp))
sg = (sus_record *)UNMARK_CELL(tmp);
else
sg = (sus_record *)tmp;
}
}
/*
This routine does most of the work. It is called after
someone tries to instantiate a suspension reference.
Three operations are possible:
SBIND: trying to bind it to a constructed non-var term, most
often a primitive term;
SISPAIR: the term is *going* to be bound to a list. We need to
return where.
SISAPPL: the term is *going* to be bound to a compound term. We
need to return where, if we allow the binding.
*/
static void
Wake(CELL *pt1, CELL reg2)
{
/* if bound to someone else, follow until we find the last one */
register sus_tag *susp = (sus_tag *)pt1;
CELL *myH = H;
if (IsVarTerm(reg2)) {
if (IsAttachedTerm(reg2)) {
sus_tag *susp2 = (sus_tag *)VarOfTerm(reg2);
/* binding two suspended variables, be careful */
if (susp2->sus_id != susp_ext) {
/* joining two suspensions */
Yap_Error(SYSTEM_ERROR, TermNil, "joining two suspensions not implemented");
return;
}
/* join the two suspended lists */
if (susp2 > susp) {
AddSuspendedGoals(susp->SG, susp2->SG);
Bind_Global(VarOfTerm(reg2), (CELL)pt1);
return;
} else {
AddSuspendedGoals(susp2->SG, susp->SG);
Bind_Global(pt1, reg2);
return;
}
} else {
Bind(VarOfTerm(reg2), (CELL)pt1);
}
} else {
/* release the variable into the WokenGoals list */
ReleaseGoals(susp->SG);
if (IsPairTerm(reg2) && RepPair(reg2) == myH)
reg2 = AbsPair(H);
else if (IsApplTerm(reg2) && RepAppl(reg2) == myH)
reg2 = AbsAppl(H);
/* bind it to t1's value */
Bind_Global(pt1, reg2);
}
return;
}
/* find all goals frozen in the current chain of environments */
/* This will also mark them as bound, in order that goal lists
won't be displayed twice */
static Term
AddSusToList(Term t, Term t1)
{
if (IsVarTerm(t1)) {
/* we found an active suspension variable */
sus_tag * susp = (sus_tag *)VarOfTerm(t);
sus_record *s = susp->SG;
while (s->NR != (sus_record *)&(s->NR)) {
t = MkPairTerm(s->SG,t);
s = s->NR;
} while (s->NR != (sus_record *)&(s->NR));
t = MkPairTerm(s->SG,t);
Bind_Global((CELL *)(susp->ActiveSus), TermNil);
} else if (IsApplTerm(t1)) {
int args = ArityOfFunctor(FunctorOfTerm(t1));
t = AddSusSubGoals(t, RepAppl(t1)+1, args);
} else if (IsPairTerm(t1)) {
t = AddSusSubGoals(t, RepPair(t1), 2);
}
return(t);
}
/* used to search from subarguments from within a compound term */
static Term
AddSusSubGoals(Term t, CELL *saved_var, int max)
{
int i;
for (i = 0; i < max; i++)
{
Term t1 = Derefa(saved_var);
if (!IsVarTerm(t1)) {
if (IsApplTerm(t1)) {
Functor f = FunctorOfTerm(t1);
if (!IsExtensionFunctor(f)) {
int args = ArityOfFunctor(f);
t = AddSusSubGoals(t, RepAppl(t1)+1, args);
}
} else if (IsPairTerm(t1)) {
t = AddSusSubGoals(t, RepPair(t1), 2);
}
} else {
if (IsAttachedTerm(t1)) {
t = AddSusToList(t, t1);
}
}
}
return(t);
}
static Int
freeze_goal(Term t, Term g)
{
if (IsVarTerm(t)) {
sus_record *gf;
sus_tag *vs;
if (IsAttachedTerm(t)) {
sus_tag *susp = (sus_tag *)VarOfTerm(t);
exts id;
id = (exts)(susp->sus_id);
if (id != susp_ext) {
/* obtain the term */
Yap_Error(SYSTEM_ERROR,TermNil,"multiple suspensions not supported");
return(FALSE);
}
AddSuspendedGoal(g, susp->SG);
return(TRUE);
}
vs = (sus_tag *)Yap_ReadTimedVar(DelayedVars);
if (H0 - (CELL *)vs < 1024) {
ARG1 = t;
ARG2 = g;
if (!Yap_growglobal(NULL)) {
Yap_Error(SYSTEM_ERROR, t, Yap_ErrorMessage);
return FALSE;
}
t = ARG1;
g = ARG2;
}
/* create a new suspension record */
gf = (sus_record *)H;
/* I assume here sus_record has size multiple of CELL !!!! */
H += sizeof(sus_record)/sizeof(CELL);
gf->NR = (sus_record *)&(gf->NR);
gf->SG = g;
#ifdef MULTI_ASSIGNMENT_VARIABLES
gf->NS = UpdateSVarList(gf);
#endif
vs->sus_id = susp_ext;
vs->SG = gf;
RESET_VARIABLE(&(vs->ActiveSus));
Yap_UpdateTimedVar(DelayedVars, (CELL)(vs+1));
Bind_Global((CELL *)t,(CELL)&(vs->ActiveSus));
return(TRUE);
}
else {
/* Oops, first argument was bound :-( */
Yap_Error(TYPE_ERROR_VARIABLE, t, "freeze/2");
return(FALSE);
}
}
#endif /* COROUTINING */
static Int static Int
p_read_svar_list(void) p_read_svar_list(void)
{ {
#ifdef COROUTINING #ifdef COROUTINING
#ifdef MULTI_ASSIGNMENT_VARIABLES #ifdef MULTI_ASSIGNMENT_VARIABLES
return(Yap_unify(ARG1, MutableList) && Yap_unify(ARG2, AttsMutableList)); return(Yap_unify(ARG1, AttsMutableList));
#else #else
return(TRUE); return(TRUE);
#endif #endif
@ -634,122 +45,12 @@ p_set_svar_list(void)
{ {
#ifdef COROUTINING #ifdef COROUTINING
#ifdef MULTI_ASSIGNMENT_VARIABLES #ifdef MULTI_ASSIGNMENT_VARIABLES
MutableList = Deref(ARG1); AttsMutableList = Deref(ARG1);
AttsMutableList = Deref(ARG2);
#endif #endif
#endif #endif
return(TRUE); return(TRUE);
} }
static Int
p_freeze(void)
{
#ifdef COROUTINING
Term t = Deref(ARG1);
return(freeze_goal(t, Deref(ARG2)));
#else
return(FALSE);
#endif /* COROUTINING */
}
/* The idea here is that we are trying to freeze on a list of
variables. If we can freeze on the first one, we create a
suspension record and are off to see the wizard of Oz. Otherwise,
the goal fails, indicating we did not have to freeze (look at code
for wait and for block to understand why.
*/
static Int p_freeze_on_first(void)
{
#ifdef COROUTINING
Term r = Deref(ARG1);
int i;
CELL *pt;
if (!IsApplTerm(r)) return(FALSE);
i = ArityOfFunctor(FunctorOfTerm(r));
pt = RepAppl(r)+1;
do {
if (IsNonVarTerm(Derefa(pt)))
return(FALSE);
i --;
pt++;
} while(i);
/* we can freeze on the first variable */
return(freeze_goal(Derefa(RepAppl(r)+1), Deref(ARG2)));
#else
return(FALSE);
#endif
}
/* return a queue with goals currently frozen on the first argument */
static Int p_frozen_goals(void)
{
/* initially, we do not know of any frozen goals */
Term t = TermNil;
#ifdef COROUTINING
Term t1 = Deref(ARG1);
CELL *pt1;
tr_fr_ptr pt0;
/* make B and HB point to H to guarantee all bindings will
be trailed
*/
pt1 = (CELL *)B;
pt0 = TR;
HB = H;
B = (choiceptr)H;
/* look at the first argument */
if (!IsVarTerm(t1)) {
if (IsApplTerm(t1)) {
Functor f = FunctorOfTerm(t1);
int args;
if (!IsExtensionFunctor(f)) {
args = ArityOfFunctor(f);
t = AddSusSubGoals(t, RepAppl(t1)+1, args);
}
} else if (IsPairTerm(t1)) {
t = AddSusSubGoals(t, RepPair(t1), 2);
}
} else {
if (IsAttachedTerm(t1)) {
t = AddSusToList(t, t1);
}
}
B = (choiceptr)pt1;
/* untrail all bindings made by IUnify */
while (TR != pt0) {
pt1 = (CELL *)(TrailTerm(--TR));
RESET_VARIABLE(pt1);
}
HB = B->cp_h;
#endif
return(Yap_unify(ARG2,t));
}
/* return a queue with all goals frozen in the system */
static Int p_all_frozen_goals(void)
{
#ifdef COROUTINING
/* initially, we do not know of any goals frozen */
Term t = Yap_CurrentAttVars();
#ifdef MULTI_ASSIGNMENT_VARIABLES
sus_record *x = GetSVarList();
if (x == NULL)
return(Yap_unify(ARG1,t));
/* okay, we are on top of the list of variables. Let's burn rubber!
*/
while ((CELL)x != TermNil) {
t = MkPairTerm(x->SG,t);
x = x->NS;
}
#endif
return(Yap_unify(ARG1,t));
#else
return(Yap_unify(ARG1,TermNil));
#endif
}
#ifdef COROUTINING #ifdef COROUTINING
/* check if variable was there */ /* check if variable was there */
@ -1195,6 +496,16 @@ static Int p_coroutining(void)
#endif #endif
} }
static Term
ListOfWokenGoals(void) {
return Yap_ReadTimedVar(WokenGoals);
}
Term
Yap_ListOfWokenGoals(void) {
return ListOfWokenGoals();
}
/* return a list of awoken goals */ /* return a list of awoken goals */
static Int p_awoken_goals(void) static Int p_awoken_goals(void)
{ {
@ -1211,16 +522,6 @@ static Int p_awoken_goals(void)
#endif #endif
} }
#ifdef COROUTINING
void
Yap_WakeUp(CELL *pt0) {
CELL d0 = *pt0;
RESET_VARIABLE(pt0);
TR--;
attas[ExtFromCell(pt0)].bind_op(pt0, d0);
}
#endif
static Int static Int
p_yap_has_rational_trees(void) p_yap_has_rational_trees(void)
{ {
@ -1248,11 +549,6 @@ Yap_InitCoroutPreds(void)
Atom at; Atom at;
PredEntry *pred; PredEntry *pred;
attas[susp_ext].bind_op = Wake;
attas[susp_ext].copy_term_op = CopySuspendedVar;
attas[susp_ext].to_term_op = SuspendedVarToTerm;
attas[susp_ext].term_to_op = TermToSuspendedVar;
attas[susp_ext].mark_op = mark_suspended_goal;
at = Yap_LookupAtom("$wake_up_goal"); at = Yap_LookupAtom("$wake_up_goal");
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 2),0)); pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 2),0));
WakeUpCode = pred; WakeUpCode = pred;
@ -1260,12 +556,8 @@ Yap_InitCoroutPreds(void)
#endif /* COROUTINING */ #endif /* COROUTINING */
Yap_InitCPred("$yap_has_rational_trees", 0, p_yap_has_rational_trees, SafePredFlag); Yap_InitCPred("$yap_has_rational_trees", 0, p_yap_has_rational_trees, SafePredFlag);
Yap_InitCPred("$yap_has_coroutining", 0, p_yap_has_coroutining, SafePredFlag); Yap_InitCPred("$yap_has_coroutining", 0, p_yap_has_coroutining, SafePredFlag);
Yap_InitCPred("$read_svar_list", 2, p_read_svar_list, SafePredFlag); Yap_InitCPred("$read_svar_list", 1, p_read_svar_list, SafePredFlag);
Yap_InitCPred("$set_svar_list", 2, p_set_svar_list, SafePredFlag); Yap_InitCPred("$set_svar_list", 1, p_set_svar_list, SafePredFlag);
Yap_InitCPred("$freeze", 2, p_freeze, 0);
Yap_InitCPred("freeze_on_first", 2, p_freeze_on_first, TestPredFlag);
Yap_InitCPred("$frozen_goals", 2, p_frozen_goals, SafePredFlag);
Yap_InitCPred("$all_frozen_goals", 1, p_all_frozen_goals, SafePredFlag);
Yap_InitCPred("$can_unify", 3, p_can_unify, SafePredFlag); Yap_InitCPred("$can_unify", 3, p_can_unify, SafePredFlag);
Yap_InitCPred("$non_ground", 2, p_non_ground, SafePredFlag); Yap_InitCPred("$non_ground", 2, p_non_ground, SafePredFlag);
Yap_InitCPred("$coroutining", 0, p_coroutining, SafePredFlag); Yap_InitCPred("$coroutining", 0, p_coroutining, SafePredFlag);

14
C/dbase.c
View File

@ -4740,7 +4740,7 @@ p_init_queue(void)
dbq->Flags = DBClMask; dbq->Flags = DBClMask;
dbq->FirstInQueue = dbq->LastInQueue = NULL; dbq->FirstInQueue = dbq->LastInQueue = NULL;
INIT_RWLOCK(dbq->QRWLock); INIT_RWLOCK(dbq->QRWLock);
t = MkDBRefTerm((DBRef)dbq); t = MkIntegerTerm((Int)dbq);
return(Yap_unify(ARG1, t)); return(Yap_unify(ARG1, t));
} }
@ -4755,11 +4755,11 @@ p_enqueue(void)
if (IsVarTerm(Father)) { if (IsVarTerm(Father)) {
Yap_Error(INSTANTIATION_ERROR, Father, "enqueue"); Yap_Error(INSTANTIATION_ERROR, Father, "enqueue");
return(FALSE); return(FALSE);
} else if (!IsDBRefTerm(Father)) { } else if (!IsIntegerTerm(Father)) {
Yap_Error(TYPE_ERROR_DBREF, Father, "enqueue"); Yap_Error(TYPE_ERROR_INTEGER, Father, "enqueue");
return(FALSE); return(FALSE);
} else } else
father_key = (db_queue *)DBRefOfTerm(Father); father_key = (db_queue *)IntegerOfTerm(Father);
while ((x = (QueueEntry *)AllocDBSpace(sizeof(QueueEntry))) == NULL) { while ((x = (QueueEntry *)AllocDBSpace(sizeof(QueueEntry))) == NULL) {
if (!Yap_growheap(FALSE, sizeof(QueueEntry), NULL)) { if (!Yap_growheap(FALSE, sizeof(QueueEntry), NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "in findall"); Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "in findall");
@ -4823,11 +4823,11 @@ p_dequeue(void)
if (IsVarTerm(Father)) { if (IsVarTerm(Father)) {
Yap_Error(INSTANTIATION_ERROR, Father, "dequeue"); Yap_Error(INSTANTIATION_ERROR, Father, "dequeue");
return(FALSE); return(FALSE);
} else if (!IsDBRefTerm(Father)) { } else if (!IsIntegerTerm(Father)) {
Yap_Error(TYPE_ERROR_DBREF, Father, "dequeue"); Yap_Error(TYPE_ERROR_INTEGER, Father, "dequeue");
return(FALSE); return(FALSE);
} else } else
father_key = (db_queue *)DBRefOfTerm(Father); father_key = (db_queue *)IntegerOfTerm(Father);
WRITE_LOCK(father_key->QRWLock); WRITE_LOCK(father_key->QRWLock);
if ((cur_instance = father_key->FirstInQueue) == NULL) { if ((cur_instance = father_key->FirstInQueue) == NULL) {
/* an empty queue automatically goes away */ /* an empty queue automatically goes away */

23
C/exec.c
View File

@ -1031,15 +1031,17 @@ exec_absmi(int top)
return(Yap_absmi(0)); return(Yap_absmi(0));
} }
static int static Term
do_goal(yamop *CodeAdr, int arity, CELL *pt, int top) do_goal(Term t, yamop *CodeAdr, int arity, CELL *pt, int top)
{ {
choiceptr saved_b = B; choiceptr saved_b = B;
Term out = 0L;
/* create an initial pseudo environment so that when garbage /* create an initial pseudo environment so that when garbage
collection is going up in the environment chain it doesn't get collection is going up in the environment chain it doesn't get
confused */ confused */
EX = 0L; EX = 0L;
// sl = Yap_InitSlot(t);
YENV = ASP; YENV = ASP;
YENV[E_CP] = (CELL)P; YENV[E_CP] = (CELL)P;
YENV[E_CB] = (CELL)B; YENV[E_CB] = (CELL)B;
@ -1084,7 +1086,12 @@ do_goal(yamop *CodeAdr, int arity, CELL *pt, int top)
CP = YESCODE; CP = YESCODE;
S = CellPtr (RepPredProp (PredPropByFunc (Yap_MkFunctor(AtomCall, 1),0))); /* A1 mishaps */ S = CellPtr (RepPredProp (PredPropByFunc (Yap_MkFunctor(AtomCall, 1),0))); /* A1 mishaps */
return(exec_absmi(top)); out = exec_absmi(top);
// if (out) {
// out = Yap_GetFromSlot(sl);
// }
// Yap_RecoverSlots(1);
return out;
} }
int int
@ -1139,12 +1146,12 @@ Yap_execute_goal(Term t, int nargs, Term mod)
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
CodeAdr = RepPredProp (pe)->CodeOfPred; CodeAdr = RepPredProp (pe)->CodeOfPred;
READ_UNLOCK(ppe->PRWLock); READ_UNLOCK(ppe->PRWLock);
out = do_goal(CodeAdr, 0, pt, FALSE); out = do_goal(t, CodeAdr, 0, pt, FALSE);
} else { } else {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
CodeAdr = RepPredProp (pe)->CodeOfPred; CodeAdr = RepPredProp (pe)->CodeOfPred;
READ_UNLOCK(ppe->PRWLock); READ_UNLOCK(ppe->PRWLock);
out = do_goal(CodeAdr, ArityOfFunctor(f), pt, FALSE); out = do_goal(t, CodeAdr, ArityOfFunctor(f), pt, FALSE);
} }
if (out == 1) { if (out == 1) {
@ -1218,7 +1225,7 @@ Yap_trust_last(void)
} }
} }
int Term
Yap_RunTopGoal(Term t) Yap_RunTopGoal(Term t)
{ {
yamop *CodeAdr; yamop *CodeAdr;
@ -1227,7 +1234,7 @@ Yap_RunTopGoal(Term t)
CELL *pt; CELL *pt;
UInt arity; UInt arity;
Term mod = CurrentModule; Term mod = CurrentModule;
int goal_out = 0; Term goal_out = 0;
restart_runtopgoal: restart_runtopgoal:
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
@ -1273,7 +1280,7 @@ Yap_RunTopGoal(Term t)
Yap_Error(SYSTEM_ERROR,TermNil, Yap_Error(SYSTEM_ERROR,TermNil,
"unable to boot because of too little heap space"); "unable to boot because of too little heap space");
} }
goal_out = do_goal(CodeAdr, arity, pt, TRUE); goal_out = do_goal(t, CodeAdr, arity, pt, TRUE);
return(goal_out); return(goal_out);
} }

3
C/heapgc.c
View File

@ -2910,9 +2910,6 @@ marking_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
cont_top = (cont *)db_vec; cont_top = (cont *)db_vec;
/* These two must be marked first so that our trail optimisation won't lose /* These two must be marked first so that our trail optimisation won't lose
values */ values */
#ifdef COROUTINING
Yap_mark_all_suspended_goals();
#endif
mark_regs(old_TR); /* active registers & trail */ mark_regs(old_TR); /* active registers & trail */
#ifdef COROUTINING #ifdef COROUTINING
mark_delays(max); mark_delays(max);

3
C/init.c
View File

@ -842,9 +842,8 @@ InitCodes(void)
heap_regs->atprompt = 0; heap_regs->atprompt = 0;
#ifdef COROUTINING #ifdef COROUTINING
heap_regs->num_of_atts = 0; /* initially no attributes have been defined */ heap_regs->num_of_atts = 1; /* initially only coroutining is supported */
#endif #endif
/* system boots in compile mode */ /* system boots in compile mode */
heap_regs->static_predicates_marked = TRUE; heap_regs->static_predicates_marked = TRUE;
/* use Quintus compatible atom_chars and number_chars, not ISO compatible */ /* use Quintus compatible atom_chars and number_chars, not ISO compatible */

3
C/iopreds.c
View File

@ -4660,9 +4660,11 @@ Yap_StringToTerm(char *s,Term *tp)
int sno = open_buf_read_stream(s, strlen(s)+1); int sno = open_buf_read_stream(s, strlen(s)+1);
Term t; Term t;
TokEntry *tokstart; TokEntry *tokstart;
tr_fr_ptr TR_before_parse;
if (sno < 0) if (sno < 0)
return FALSE; return FALSE;
TR_before_parse = TR;
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno); tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno);
/* cannot actually use CloseStream, because we didn't allocate the buffer */ /* cannot actually use CloseStream, because we didn't allocate the buffer */
Stream[sno].status = Free_Stream_f; Stream[sno].status = Free_Stream_f;
@ -4680,6 +4682,7 @@ Yap_StringToTerm(char *s,Term *tp)
return FALSE; return FALSE;
} }
t = Yap_Parse(); t = Yap_Parse();
TR = TR_before_parse;
if (Yap_ErrorMessage) { if (Yap_ErrorMessage) {
if (tp) { if (tp) {
*tp = syntax_error(tokstart); *tp = syntax_error(tokstart);

9
C/sysbits.c
View File

@ -878,14 +878,15 @@ static void
HandleSIGSEGV(int sig, siginfo_t *sip, ucontext_t *uap) HandleSIGSEGV(int sig, siginfo_t *sip, ucontext_t *uap)
{ {
#if !USE_SYSTEM_MALLOC
if (sip->si_code != SI_NOINFO && if (sip->si_code != SI_NOINFO &&
sip->si_code == SEGV_MAPERR && sip->si_code == SEGV_MAPERR &&
(void *)(sip->si_addr) > (void *)(Yap_HeapBase) && (void *)(sip->si_addr) > (void *)(Yap_HeapBase) &&
(void *)(sip->si_addr) < (void *)(Yap_TrailTop+64 * 1024L) && (void *)(sip->si_addr) < (void *)(Yap_TrailTop+64 * 1024L)) {
! USE_SYSTEM_MALLOC) {
Yap_growtrail(64 * 1024L); Yap_growtrail(64 * 1024L);
} } else
else { #endif
{
Yap_Error(FATAL_ERROR, TermNil, Yap_Error(FATAL_ERROR, TermNil,
"likely bug in YAP, segmentation violation at %p", sip->si_addr); "likely bug in YAP, segmentation violation at %p", sip->si_addr);
} }

7
C/write.c
View File

@ -311,12 +311,7 @@ write_var(CELL *t, struct write_globs *wglb)
exts ext = ExtFromCell(t); exts ext = ExtFromCell(t);
Yap_Portray_delays = FALSE; Yap_Portray_delays = FALSE;
if (ext == susp_ext) { if (ext == attvars_ext) {
wrputs("$DL(",wglb->writech);
write_var(t, wglb);
wrputc(')', wglb->writech);
lastw = separator;
} else if (ext == attvars_ext) {
attvar_record *attv = (attvar_record *)t; attvar_record *attv = (attvar_record *)t;
int i; int i;
long sl = 0; long sl = 0;

8
H/Regs.h
View File

@ -10,7 +10,7 @@
* File: Regs.h * * File: Regs.h *
* mods: * * mods: *
* comments: YAP abstract machine registers * * comments: YAP abstract machine registers *
* version: $Id: Regs.h,v 1.28 2004-05-13 20:54:58 vsc Exp $ * * version: $Id: Regs.h,v 1.29 2004-06-05 03:37:00 vsc Exp $ *
*************************************************************************/ *************************************************************************/
@ -92,12 +92,6 @@ typedef struct
CELL EX_; /* 18 */ CELL EX_; /* 18 */
#ifdef COROUTINING #ifdef COROUTINING
Term DelayedVars_; /* maximum number of attributed variables */ Term DelayedVars_; /* maximum number of attributed variables */
#endif
#ifndef USE_OFFSETS
#ifndef EXT_BASE
Term TermDot_; /* 19 */
Term TermNil_; /* 20 */
#endif
#endif #endif
Term CurrentModule_; Term CurrentModule_;
#if defined(SBA) || defined(TABLING) #if defined(SBA) || defined(TABLING)

5
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto * * File: Yap.proto *
* mods: * * mods: *
* comments: Function declarations for YAP * * comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.51 2004-03-05 15:26:33 vsc Exp $ * * version: $Id: Yapproto.h,v 1.52 2004-06-05 03:37:00 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* prototype file for Yap */ /* prototype file for Yap */
@ -130,7 +130,6 @@ void STD_PROTO(Yap_InitCoroutPreds,(void));
#ifdef COROUTINING #ifdef COROUTINING
Term STD_PROTO(Yap_ListOfWokenGoals,(void)); Term STD_PROTO(Yap_ListOfWokenGoals,(void));
void STD_PROTO(Yap_WakeUp,(CELL *)); void STD_PROTO(Yap_WakeUp,(CELL *));
void STD_PROTO(Yap_mark_all_suspended_goals,(void));
#endif #endif
/* dbase.c */ /* dbase.c */
@ -150,7 +149,7 @@ void STD_PROTO(Yap_InitEval,(void));
Term STD_PROTO(Yap_ExecuteCallMetaCall,(Term)); Term STD_PROTO(Yap_ExecuteCallMetaCall,(Term));
void STD_PROTO(Yap_InitExecFs,(void)); void STD_PROTO(Yap_InitExecFs,(void));
Int STD_PROTO(Yap_JumpToEnv,(Term)); Int STD_PROTO(Yap_JumpToEnv,(Term));
int STD_PROTO(Yap_RunTopGoal,(Term)); Term STD_PROTO(Yap_RunTopGoal,(Term));
Int STD_PROTO(Yap_execute_goal,(Term, int, Term)); Int STD_PROTO(Yap_execute_goal,(Term, int, Term));
int STD_PROTO(Yap_exec_absmi,(int)); int STD_PROTO(Yap_exec_absmi,(int));
void STD_PROTO(Yap_trust_last,(void)); void STD_PROTO(Yap_trust_last,(void));

14
H/corout.h
View File

@ -19,24 +19,22 @@ static char SccsId[]="%W% %G%";
#endif #endif
typedef struct sus_record_struct { typedef struct sus_record_struct {
struct sus_record_struct *NR; /* next record */ Functor f;
Term SG; /* suspended goal */ Term NR; /* next record for same variable */
#ifdef MULTI_ASSIGNMENT_VARIABLES Term SG; /* actual suspended goal */
struct sus_record_struct *NS; /* other suspended goals */ Term NS; /* other suspended goals */
#endif
} sus_record; } sus_record;
typedef struct sus_tag_struct { typedef struct sus_tag_struct {
Term ActiveSus; /* if unbound suspension active, if bound terminated */ Term ActiveSus; /* if unbound suspension active, if bound terminated */
CELL sus_id; CELL sus_id;
sus_record *SG; /* list of suspended goals */ Term TimeStamp; /* actual suspended goal */
Term SG; /* list of suspended goals */
} sus_tag; } sus_tag;
#ifdef COROUTINING #ifdef COROUTINING
/*********** tags for suspension variables */ /*********** tags for suspension variables */
#define AbsSuspendedVar(sustag_ptr) AbsAppl(((CELL *)(sustag_ptr))) #define AbsSuspendedVar(sustag_ptr) AbsAppl(((CELL *)(sustag_ptr)))
#define RepSuspendedVar(val) ((sus_tag *)RepAppl(val)) #define RepSuspendedVar(val) ((sus_tag *)RepAppl(val))
#endif #endif

7
H/rheap.h
View File

@ -11,8 +11,11 @@
* File: rheap.h * * File: rheap.h *
* comments: walk through heap code * * comments: walk through heap code *
* * * *
* Last rev: $Date: 2004-04-29 03:45:50 $,$Author: vsc $ * * Last rev: $Date: 2004-06-05 03:37:00 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.41 2004/04/29 03:45:50 vsc
* fix garbage collection in execute_tail
*
* Revision 1.40 2004/03/31 01:03:10 vsc * Revision 1.40 2004/03/31 01:03:10 vsc
* support expand group of clauses * support expand group of clauses
* *
@ -595,7 +598,7 @@ restore_opcodes(yamop *pc)
pc->u.Ill.I = (LogUpdIndex *)PtoOpAdjust((yamop *)(pc->u.Ill.I)); pc->u.Ill.I = (LogUpdIndex *)PtoOpAdjust((yamop *)(pc->u.Ill.I));
pc->u.Ill.l1 = PtoOpAdjust(pc->u.Ill.l1); pc->u.Ill.l1 = PtoOpAdjust(pc->u.Ill.l1);
pc->u.Ill.l2 = PtoOpAdjust(pc->u.Ill.l2); pc->u.Ill.l2 = PtoOpAdjust(pc->u.Ill.l2);
pc = NEXTOP(pc,Ill); pc = pc->u.Ill.l1;
break; break;
/* instructions type l */ /* instructions type l */
case _enter_profiling: case _enter_profiling:

12
docs/yap.tex
View File

@ -14083,10 +14083,18 @@ simple way for controlling and communicating with the Prolog run-time.
@findex YAP_Read/1 @findex YAP_Read/1
Parse a Term using the function @var{GetC} to input characters. Parse a Term using the function @var{GetC} to input characters.
@item @code{int} YAP_RunGoal(@code{Term} @var{Goal}) @item @code{Term} YAP_RunGoal(@code{Term} @var{Goal})
@findex YAP_RunGoal/1 @findex YAP_RunGoal/1
Execute query @var{Goal} and return 1 if the query succeeds, and Execute query @var{Goal} and return 1 if the query succeeds, and
0 otherwise. 0 otherwise. The predicate returns 0 if failure, otherwise it will
return @var{Term}. Note that @var{Term} may change due to garbage
collection, so you should use something like:
@example
t = YAP_RunGoal(t);
if (t == 0) return FALSE;
@end example
If the execution fails, garbage collection might still have changed
the term, so you should not use the input argument again.
@item @code{int} YAP_RestartGoal(@code{void}) @item @code{int} YAP_RestartGoal(@code{void})
@findex YAP_RestartGoal/0 @findex YAP_RestartGoal/0

2
include/YapInterface.h
View File

@ -203,7 +203,7 @@ extern X_API void *PROTO(YAP_AllocSpaceFromYap,(unsigned int));
extern X_API void PROTO(YAP_FreeSpaceFromYap,(void *)); extern X_API void PROTO(YAP_FreeSpaceFromYap,(void *));
/* int YAP_RunGoal(YAP_Term) */ /* int YAP_RunGoal(YAP_Term) */
extern X_API YAP_Bool PROTO(YAP_RunGoal,(YAP_Term)); extern X_API YAP_Term PROTO(YAP_RunGoal,(YAP_Term));
/* int YAP_RestartGoal(void) */ /* int YAP_RestartGoal(void) */
extern X_API YAP_Bool PROTO(YAP_RestartGoal,(void)); extern X_API YAP_Bool PROTO(YAP_RestartGoal,(void));

6
library/atts.yap
View File

@ -15,8 +15,6 @@
* * * *
*************************************************************************/ *************************************************************************/
:- sequential.
:- module(attributes, []). :- module(attributes, []).
:- op(1150, fx, attribute). :- op(1150, fx, attribute).
@ -29,10 +27,10 @@
:- dynamic_predicate(existing_attribute/3,logical). :- dynamic_predicate(existing_attribute/3,logical).
:- dynamic_predicate(modules_with_attributes/1,logical). :- dynamic_predicate(modules_with_attributes/1,logical).
:- user_defined_directive(attribute(G), attributes:new_attribute(G)).
modules_with_attributes([]). modules_with_attributes([]).
:- user_defined_directive(attribute(G), attributes:new_attribute(G)).
user:goal_expansion(get_atts(Var,AccessSpec), Mod, Gs) :- !, user:goal_expansion(get_atts(Var,AccessSpec), Mod, Gs) :- !,
expand_get_attributes(AccessSpec,Mod,Var,[],GL), expand_get_attributes(AccessSpec,Mod,Var,[],GL),
convert_to_goals(GL,Gs). convert_to_goals(GL,Gs).

5
m4/TermExt.h.m4
View File

@ -10,7 +10,7 @@
* File: TermExt.h * * File: TermExt.h *
* mods: * * mods: *
* comments: Extensions to standard terms for YAP * * comments: Extensions to standard terms for YAP *
* version: $Id: TermExt.h.m4,v 1.13 2004-04-22 20:07:06 vsc Exp $ * * version: $Id: TermExt.h.m4,v 1.14 2004-06-05 03:37:00 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#ifdef USE_SYSTEM_MALLOC #ifdef USE_SYSTEM_MALLOC
@ -85,8 +85,7 @@ typedef struct {
/* known delays */ /* known delays */
typedef enum { typedef enum {
empty_ext = 0*sizeof(ext_op), /* default op, this should never be called */ empty_ext = 0*sizeof(ext_op), /* default op, this should never be called */
susp_ext = 1*sizeof(ext_op), /* support for delayable goals */ attvars_ext = 1*sizeof(ext_op) /* support for attributed variables */
attvars_ext = 2*sizeof(ext_op) /* support for attributed variables */
/* add your own extensions here */ /* add your own extensions here */
/* keep this one */ /* keep this one */
} exts; } exts;

2
m4/Yatom.h.m4
View File

@ -238,10 +238,10 @@ typedef struct pred_entry {
tab_ent_ptr TableOfPred; tab_ent_ptr TableOfPred;
#endif /* TABLING */ #endif /* TABLING */
Term ModuleOfPred; /* module for this definition */ Term ModuleOfPred; /* module for this definition */
struct pred_entry *NextPredOfModule; /* next pred for same module */
/* This must be at an odd number of cells, otherwise it /* This must be at an odd number of cells, otherwise it
will not be aligned on RISC machines */ will not be aligned on RISC machines */
profile_data StatisticsForPred; /* enable profiling for predicate */ profile_data StatisticsForPred; /* enable profiling for predicate */
struct pred_entry *NextPredOfModule; /* next pred for same module */
} PredEntry; } PredEntry;
#define PEProp ((PropFlags)(0x0000)) #define PEProp ((PropFlags)(0x0000))

4
pl/boot.yap
View File

@ -452,9 +452,9 @@ repeat :- '$repeat'.
'$write_query_answer_true'(_). '$write_query_answer_true'(_).
'$show_frozen'(G,V,LGs) :- '$show_frozen'(G,V,LGs) :-
'$all_frozen_goals'(LGs0), LGs0 = [_|_], !,
attributes:all_attvars(LAV), attributes:all_attvars(LAV),
'$convert_to_list_of_frozen_goals'(LGs0,V,LAV,G,LGs). LAV = [_|_], !,
'$convert_to_list_of_frozen_goals'(V,LAV,G,LGs).
'$show_frozen'(_,_,[]). '$show_frozen'(_,_,[]).
% %

206
pl/corout.yap
View File

@ -36,11 +36,8 @@
:- assert((extensions_to_present_answer(Level) :- :- assert((extensions_to_present_answer(Level) :-
'$show_frozen_goals'(Level))). '$show_frozen_goals'(Level))).
'$convert_to_list_of_frozen_goals'(LGs0,LIV,LAV,G,NLG) :- '$convert_to_list_of_frozen_goals'(LIV,LAV,G,NLG) :-
'$sort'(LGs0, LGs), '$project'(LAV,LIV,NLG).
'$purge_done_goals'(LGs, LG),
'$clean_list_of_frozen_goals'(LG, ILG),
'$project'(G,LIV,LAV,NLG,ILG).
'$get_rid_of_vls'((_-G),G). '$get_rid_of_vls'((_-G),G).
@ -88,26 +85,44 @@
'$execute_woken_system_goals'([]). '$execute_woken_system_goals'([]).
'$execute_woken_system_goals'([G|LG]) :- '$execute_woken_system_goals'([G|LG]) :-
'$execute_woken_system_goal'(G, G), '$execute_woken_system_goal'(G),
'$execute_woken_system_goals'(LG). '$execute_woken_system_goals'(LG).
%
% X surely was bound, otherwise we would not be awaken.
%
'$execute_woken_system_goal'('$att_do'(V,New)) :-
( '$frozen_goals'(V, Goals) ->
'$call_atts'(V,New),
'$execute_frozen_goals'(Goals)
;
'$call_atts'(V,New)
).
'$call_atts'(V,_) :-
'$undefined'(woken_att_do(_,_), attributes), !,
attributes:bind_attvar(V).
'$call_atts'(V,_) :-
'$att_bound'(V), !.
'$call_atts'(V,New) :-
attributes:woken_att_do(V,New).
'$execute_frozen_goals'([]).
'$execute_frozen_goals'([G0|Gs]) :-
'$execute_frozen_goal'(G0,G0),
'$execute_frozen_goals'(Gs).
% %
% X and Y may not be bound (multiple suspensions on the same goal). % X and Y may not be bound (multiple suspensions on the same goal).
% %
'$execute_woken_system_goal'('$redo_dif'(Done, X, Y), G) :- '$execute_frozen_goal'('$redo_dif'(Done, X, Y), G) :-
'$redo_dif'(Done, X, Y, G). '$redo_dif'(Done, X, Y, G).
% '$execute_frozen_goal'('$redo_freeze'(Done, _, Goal), _) :-
% X surely was bound, otherwise we would not be awaken.
%
'$execute_woken_system_goal'('$redo_freeze'(Done, _, Goal), _) :-
'$redo_freeze'(Done, Goal). '$redo_freeze'(Done, Goal).
'$execute_woken_system_goal'('$redo_eq'(Done, X, Y, Goal), G) :- '$execute_frozen_goal'('$redo_eq'(Done, X, Y, Goal), G) :-
'$redo_eq'(Done, X, Y, Goal, G). '$redo_eq'(Done, X, Y, Goal, G).
'$execute_woken_system_goal'('$redo_ground'(Done, X, Goal), _) :- '$execute_frozen_goal'('$redo_ground'(Done, X, Goal), _) :-
'$redo_ground'(Done, X, Goal). '$redo_ground'(Done, X, Goal).
'$execute_woken_system_goal'('$att_do'(V,New), _) :-
% make sure we are not trying to wake up again a bound variable.
( '$att_bound'(V) -> true ; attributes:woken_att_do(V,New) ).
freeze(V, G) :- freeze(V, G) :-
var(V), !, var(V), !,
@ -468,9 +483,7 @@ when(_,Goal) :-
frozen(V, G) :- nonvar(V), !, G = true. frozen(V, G) :- nonvar(V), !, G = true.
frozen(V, LG) :- frozen(V, LG) :-
'$frozen_goals'(V, LGs), '$project'([V],[V],G),
'$find_att_vars'(LGs, AttVars),
'$convert_to_list_of_frozen_goals'(LGs,[V],AttVars,V,G),
'$simplify_list_of_frozen_goals'(G,LG). '$simplify_list_of_frozen_goals'(G,LG).
%write(vsc:G0), nl, %write(vsc:G0), nl,
% '$purge_done_goals'(G0, GI), % '$purge_done_goals'(G0, GI),
@ -503,36 +516,6 @@ frozen(V, LG) :-
'$purge_done_goals'(G0, GF). '$purge_done_goals'(G0, GF).
'$clean_list_of_frozen_goals'([], []).
'$clean_list_of_frozen_goals'([A|B], G) :-
'$convert_list_of_frozen_goals_into_list'([A|B], G).
'$convert_list_of_frozen_goals_into_list'([A], [LV-G]) :- !,
'$convert_frozen_goal'(A, [], _, LV0, G0),
'$clean_bound_args'(LV0, LV1),
'$sort'(LV1, LV),
'$process_when'(G0, G).
'$convert_list_of_frozen_goals_into_list'([A|L], OUT) :- !,
'$convert_frozen_goal'(A, LV, Done, NA, G0),
'$process_when'(G0, Gf),
'$fetch_same_done_goals'(L, Done, LV, NL),
'$clean_bound_args'(NA, NA1),
'$sort'(NA1, LVf),
( NL = [] -> OUT = [LVf-Gf];
OUT = [(LVf-Gf)|Gs],
'$convert_list_of_frozen_goals_into_list'(NL, Gs)).
'$clean_bound_args'([], []).
'$clean_bound_args'([NV|L], NL) :- nonvar(NV), !,
'$clean_bound_args'(L,NL).
'$clean_bound_args'([V|L], [V|NL]) :-
'$clean_bound_args'(L,NL).
'$process_when'('$when'(_,G,_), NG) :- !,
'$process_when'(G, NG).
'$process_when'(G, G).
'$convert_frozen_goal'(V, _, _, V, _) :- '$is_att_variable'(V), !. '$convert_frozen_goal'(V, _, _, V, _) :- '$is_att_variable'(V), !.
'$convert_frozen_goal'('$redo_dif'(Done, X, Y), LV, Done, [X,Y|LV], dif(X,Y)). '$convert_frozen_goal'('$redo_dif'(Done, X, Y), LV, Done, [X,Y|LV], dif(X,Y)).
'$convert_frozen_goal'('$redo_freeze'(Done, FV, G), LV, Done, [FV|LV], G). '$convert_frozen_goal'('$redo_freeze'(Done, FV, G), LV, Done, [FV|LV], G).
@ -559,20 +542,19 @@ frozen(V, LG) :-
call_residue(Goal,Residue) :- call_residue(Goal,Residue) :-
'$read_svar_list'(OldList,OldAttsList), '$read_svar_list'(OldAttsList),
'$copy_term_but_not_constraints'(Goal, NGoal), '$copy_term_but_not_constraints'(Goal, NGoal),
( create_mutable([], CurrentList), ( create_mutable([], CurrentAttsList),
create_mutable([], CurrentAttsList), '$set_svar_list'(CurrentAttsList),
'$set_svar_list'(CurrentList, CurrentAttsList),
'$execute'(NGoal), '$execute'(NGoal),
'$call_residue_continuation'(NGoal,NResidue), '$call_residue_continuation'(NGoal,NResidue),
( '$set_svar_list'(OldList,OldAttsList), ( '$set_svar_list'(OldAttsList),
'$copy_term_but_not_constraints'(NGoal+NResidue, Goal+Residue) '$copy_term_but_not_constraints'(NGoal+NResidue, Goal+Residue)
; ;
'$set_svar_list'(CurrentList,CurrentAttsList), fail '$set_svar_list'(CurrentAttsList), fail
) )
; ;
'$set_svar_list'(OldList,OldAttsList), fail '$set_svar_list'(OldAttsList), fail
). ).
% %
@ -588,8 +570,7 @@ call_residue(Goal,Residue) :-
attributes:convert_att_var(AttV, GS), attributes:convert_att_var(AttV, GS),
'$purge_and_set_done_goals'(G0, GF, Atts). '$purge_and_set_done_goals'(G0, GF, Atts).
'$purge_and_set_done_goals'(['$redo_dif'(Done, X , Y)|G0], [LVars-dif(X,Y)|GF], Atts) :- '$purge_and_set_done_goals'(['$redo_dif'(Done, X , Y)|G0], [LVars-dif(X,Y)|GF], Atts) :-
var(Done), var(Done), !,
!,
Done = '$done', Done = '$done',
'$can_unify'(X, Y, LVars), '$can_unify'(X, Y, LVars),
'$purge_and_set_done_goals'(G0, GF, Atts). '$purge_and_set_done_goals'(G0, GF, Atts).
@ -609,20 +590,19 @@ call_residue(Goal,Residue) :-
'$purge_and_set_done_goals'(G0, GF, Atts). '$purge_and_set_done_goals'(G0, GF, Atts).
'$project'(true,_,_,Gs,Gs) :- !. '$project'([],_,[]).
'$project'(_,_,_,Gs,Gs) :- '$project'([V|LAV],_,LGs) :-
'$undefined'(modules_with_attributes(_), attributes), !. % we don't have constraints yet, so we must be talking about delays.
'$project'(_,LIV,LAV,Gs,Gs0) :- '$undefined'(modules_with_attributes(LAV),attributes), !,
attributes:all_attvars(NLAV),
'$fetch_delays'(NLAV,LGs, []).
'$project'([V|LAV],LIV,LDs) :-
attributes:modules_with_attributes(LMods), attributes:modules_with_attributes(LMods),
(LAV = [] ->
Gs = Gs0
;
'$pick_vars_for_project'(LIV,NLIV), '$pick_vars_for_project'(LIV,NLIV),
'$project_module'(LMods,NLIV,LAV), '$project_module'(LMods,NLIV,[V|LAV]),
attributes:all_attvars(NLAV0), attributes:all_attvars(NLAV),
'$sort'(NLAV0, NLAV), '$convert_att_vars'(NLAV, LIV, LGs),
'$convert_att_vars'(NLAV, LIV, Gs, Gs0) '$fetch_delays'(NLAV, LDs, LGs).
).
'$pick_vars_for_project'([],[]). '$pick_vars_for_project'([],[]).
'$pick_vars_for_project'([V|L],[V|NL]) :- var(V), !, '$pick_vars_for_project'([V|L],[V|NL]) :- var(V), !,
@ -639,25 +619,27 @@ call_residue(Goal,Residue) :-
'$project_module'([_|LMods], LIV, LAV) :- '$project_module'([_|LMods], LIV, LAV) :-
'$project_module'(LMods,LIV,LAV). '$project_module'(LMods,LIV,LAV).
'$convert_att_vars'([], _, L, L).
'$convert_att_vars'([V|LAV], LIV, NGs, NGs0) :- '$convert_att_vars'(Vs, LIV, []) :-
% do nothing
'$undefined'(convert_att_var(Vs,LIV),attributes), !.
'$convert_att_vars'(Vs0, LIV, LGs) :-
'$sort'(Vs0, Vs),
'$do_convert_att_vars'(Vs0, LIV, LGs).
'$do_convert_att_vars'([], _, []).
'$do_convert_att_vars'([V|LAV], LIV, NGs) :-
var(V), var(V),
attributes:convert_att_var(V, G), attributes:convert_att_var(V,G),
G \= true, G \= true,
% '$variables_in_term'(G,[],GV0),
% I'm allowing goals without variables to go through
% '$sort'(GV0,GV),
% ( GV0 = [] -> true ;
% '$sort'(LIV,NLIV), % notice that ordering changes as we introduce constraints
% '$vars_interset_for_constr'(GV,NLIV) ), !,
!, !,
'$split_goals_for_catv'(G,V,NGs,IGs), '$split_goals_for_catv'(G,V,NGs,IGs),
'$convert_att_vars'(LAV, LIV, IGs, NGs0). '$do_convert_att_vars'(LAV, LIV, IGs).
'$convert_att_vars'([_|LAV], LIV, Gs, NGs0) :- '$do_convert_att_vars'([_|LAV], LIV, Gs) :-
'$convert_att_vars'(LAV, LIV, Gs, NGs0). '$do_convert_att_vars'(LAV, LIV, Gs).
'$split_goals_for_catv'((G,NG),V,Gs,Gs0) :- !, '$split_goals_for_catv'((G,NG),V,[V-G|Gs],Gs0) :- !,
'$split_goals_for_catv'(NG,V,Gs,[V-G|Gs0]). '$split_goals_for_catv'(NG,V,Gs,Gs0).
'$split_goals_for_catv'(NG,V,[V-NG|Gs],Gs). '$split_goals_for_catv'(NG,V,[V-NG|Gs],Gs).
'$vars_interset_for_constr'([V1|_],[V2|_]) :- '$vars_interset_for_constr'([V1|_],[V2|_]) :-
@ -668,6 +650,62 @@ call_residue(Goal,Residue) :-
'$vars_interset_for_constr'([V1|GV],[_|LIV]) :- '$vars_interset_for_constr'([V1|GV],[_|LIV]) :-
'$vars_interset_for_constr'([V1|GV],LIV). '$vars_interset_for_constr'([V1|GV],LIV).
%'$fetch_delays'(_, L, L) :-
% '$no_delayed_goals', !.
'$fetch_delays'(Vs, LDs, LAs) :-
'$do_fetch_delays'(Vs, LGs0),
'$sort'(LGs0, LGs),
'$purge_done_goals'(LGs, LG),
'$clean_list_of_frozen_goals'(LG, LDs, LAs).
'$do_fetch_delays'([], []).
'$do_fetch_delays'([V|NLAV], GF) :-
'$frozen_goals'(V,G), !,
'$hole_in_frozen_goals'(G,GF,G1),
'$do_fetch_delays'(NLAV, G1).
'$do_fetch_delays'([V|NLAV], GF) :-
'$do_fetch_delays'(NLAV, GF).
'$hole_in_frozen_goals'([],V,V).
'$hole_in_frozen_goals'([G|Gs],[G|GF],G1) :-
'$hole_in_frozen_goals'(Gs,GF,G1).
'$clean_list_of_frozen_goals'([], L, L).
'$clean_list_of_frozen_goals'([A|B], Gs, Gs0) :-
'$convert_list_of_frozen_goals_into_list'([A|B], Gs, Gs0).
'$convert_list_of_frozen_goals_into_list'([A], [LV-G|L], L) :- !,
'$convert_frozen_goal'(A, [], _, LV0, G0),
'$clean_bound_args'(LV0, LV1),
'$sort'(LV1, LV),
'$process_when'(G0, G).
'$convert_list_of_frozen_goals_into_list'([A|L], OUT, Gs0) :- !,
'$convert_frozen_goal'(A, LV, Done, NA, G0),
'$process_when'(G0, Gf),
'$fetch_same_done_goals'(L, Done, LV, NL),
'$clean_bound_args'(NA, NA1),
'$sort'(NA1, LVf),
( NL = [] -> OUT = [LVf-Gf|Gs0];
OUT = [(LVf-Gf)|Gs],
'$convert_list_of_frozen_goals_into_list'(NL, Gs, Gs0)).
'$clean_bound_args'([], []).
'$clean_bound_args'([NV|L], NL) :- nonvar(NV), !,
'$clean_bound_args'(L,NL).
'$clean_bound_args'([V|L], [V|NL]) :-
'$clean_bound_args'(L,NL).
'$process_when'('$when'(_,G,_), NG) :- !,
'$process_when'(G, NG).
'$process_when'(G, G).
'$freeze'(V,G) :-
attributes:update_att(V, 0, G).
'$frozen_goals'(V,Gs) :-
attributes:get_att(V, 0, Gs), nonvar(Gs).