/*-------------------------------------------------------------------------*
* PL_TERM_VARIABLES_3 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Term_Variables_3(WamWord start_word, WamWord list_word, WamWord tail_word)
{
PlLong *p;
/* only check if no Tail since if there is no vars in Term
* then List = Tail and Tail can be any term */
if (tail_word == NOT_A_WAM_WORD)
Pl_Check_For_Un_List(list_word);
var_ptr = pl_glob_dico_var; /* pl_glob_dico_var: stores variables */
Pl_Treat_Vars_Of_Term(start_word, TRUE, Collect_Variable);
for(p = pl_glob_dico_var; p < var_ptr; p++)
{
if (!Pl_Get_List(list_word) || !Pl_Unify_Value(*p))
return FALSE;
list_word = Pl_Unify_Variable();
}
if (tail_word == NOT_A_WAM_WORD)
return Pl_Get_Nil(list_word);
return Pl_Unify(list_word, tail_word);
}
/*-------------------------------------------------------------------------*
* PL_TREAT_VARS_OF_TERM *
* *
* Call fct for each variable found in a term. *
*-------------------------------------------------------------------------*/
void
Pl_Treat_Vars_Of_Term(WamWord start_word, Bool generic_var, void (*fct) ())
{
WamWord word, tag_mask;
WamWord *adr;
int i;
terminal_rec:
DEREF(start_word, word, tag_mask);
switch (Tag_Of(word))
{
case REF:
(*fct) (UnTag_REF(word), word);
break;
#ifndef NO_USE_FD_SOLVER
case FDV:
if (generic_var)
(*fct) (UnTag_FDV(word), word);
break;
#endif
case LST:
adr = UnTag_LST(word);
adr = &Car(adr);
Pl_Treat_Vars_Of_Term(*adr++, generic_var, fct);
start_word = *adr;
goto terminal_rec;
case STC:
adr = UnTag_STC(word);
i = Arity(adr);
adr = &Arg(adr, 0);
while (--i)
Pl_Treat_Vars_Of_Term(*adr++, generic_var, fct);
start_word = *adr;
goto terminal_rec;
}
}
/*-------------------------------------------------------------------------*
* PL_SUBSUMES_TERM_2 *
* *
* mostly implements: *
* *
* subsumes_term(Generic, Specific) :- *
* \+ \+ subsumes(Generic, Specific). *
* *
* subsumes(General, Specific) :- *
* term_variables(Specific, SVars), *
* unify_with_occurs_check(General, Specific), *
* term_variables(SVars, SVars2), *
* SVars == SVars2. *
* *
* TODO: what to do with FD vars ? (a var subsumes a FD var, what else ?) *
*-------------------------------------------------------------------------*/
Bool
Pl_Subsumes_Term_2(WamWord general_word, WamWord specific_word)
{
Bool ret = FALSE;;
Pl_Defeasible_Open();
base_var_ptr = var_ptr = pl_glob_dico_var; /* pl_glob_dico_var: stores variables */
Pl_Treat_Vars_Of_Term(specific_word, TRUE, Collect_Variable);
/* TODO: improve FD vars (possible ?) */
ret = Pl_Unify_Occurs_Check(general_word, specific_word) &&
Pl_Treat_Vars_Of_Term(specific_word, TRUE, Check_Variable) &&
base_var_ptr == var_ptr;
Pl_Defeasible_Close(FALSE); /* undo bindings */
return ret;
}
/*-------------------------------------------------------------------------*
* HANDLE_KEY_VARIABLES *
* *
*-------------------------------------------------------------------------*/
static void
Handle_Key_Variables(WamWord start_word)
{
WamWord word, tag_mask;
WamWord *adr;
save_key_var_ptr = key_var_ptr;
next_key_var_ptr = pl_glob_dico_var;
DEREF(start_word, word, tag_mask);
adr = UnTag_STC(word);
Pl_Treat_Vars_Of_Term(Arg(adr, 0), TRUE, Link_Key_Var);
}
/*-------------------------------------------------------------------------*
* PL_FREE_VARIABLES_4 *
* *
* Fail if no free variables. *
*-------------------------------------------------------------------------*/
Bool
Pl_Free_Variables_4(WamWord templ_word, WamWord gen_word, WamWord gen1_word,
WamWord key_word)
{
WamWord gl_key_word;
WamWord *save_H, *arg;
int nb_free_var = 0;
bound_var_ptr = pl_glob_dico_var; /* pl_glob_dico_var: stores bound vars */
Pl_Treat_Vars_Of_Term(templ_word, TRUE, Bound_Var);
new_gen_word = Existential_Variables(gen_word);
save_H = H++; /* one more word for f/n is possible */
arg = free_var_base = H; /* array is in the heap */
Pl_Treat_Vars_Of_Term(new_gen_word, TRUE, Free_Var);
nb_free_var = H - arg;
if (nb_free_var == 0)
return FALSE;
if (nb_free_var <= MAX_ARITY)
{
*save_H = Functor_Arity(ATOM_CHAR('.'), nb_free_var);
gl_key_word = Tag_STC(save_H);
}
else
{
H = free_var_base;
gl_key_word = Pl_Mk_Proper_List(nb_free_var, arg);
}
Pl_Unify(new_gen_word, gen1_word);
return Pl_Unify(gl_key_word, key_word);
}
/*-------------------------------------------------------------------------*
* EXISTENTIAL_VARIABLES *
* *
*-------------------------------------------------------------------------*/
static WamWord
Existential_Variables(WamWord start_word)
{
WamWord word, tag_mask;
WamWord *adr;
DEREF(start_word, word, tag_mask);
if (tag_mask == TAG_STC_MASK)
{
adr = UnTag_STC(word);
if (Functor_And_Arity(adr) == exist_2)
{
Pl_Treat_Vars_Of_Term(Arg(adr, 0), TRUE, Bound_Var);
word = Existential_Variables(Arg(adr, 1));
}
}
return word;
}
