/*-------------------------------------------------------------------------*
* WRITE_SUPP_INITIALIZER *
* *
*-------------------------------------------------------------------------*/
static void
Write_Supp_Initializer(void)
{
atom_dots = Pl_Create_Atom("...");
curly_brackets_1 = Functor_Arity(pl_atom_curly_brackets, 1);
dollar_var_1 = Functor_Arity(Pl_Create_Atom("$VAR"), 1);
dollar_varname_1 = Functor_Arity(Pl_Create_Atom("$VARNAME"), 1);
}
/*-------------------------------------------------------------------------*
* PREPARE_CALL *
* *
*-------------------------------------------------------------------------*/
static CodePtr
Prepare_Call(int func, int arity, WamWord *arg_adr)
{
PredInf *pred;
WamWord *w;
int i;
int bip_func, bip_arity;
pred = Pl_Lookup_Pred(func, arity);
if (pred == NULL || !(pred->prop & MASK_PRED_NATIVE_CODE) ||
(pred->prop & MASK_PRED_CONTROL_CONSTRUCT))
{
if (arity == 0)
A(0) = Tag_ATM(func);
else
{
w = goal_H;
A(0) = Tag_STC(w);
*w++ = Functor_Arity(func, arity);
for (i = 0; i < arity; i++)
*w++ = *arg_adr++;
}
bip_func = Pl_Get_Current_Bip(&bip_arity);
A(1) = Tag_INT(Call_Info(bip_func, bip_arity, 0));
return (CodePtr) Prolog_Predicate(CALL_INTERNAL, 2);
}
for (i = 0; i < arity; i++)
A(i) = *arg_adr++;
return (CodePtr) (pred->codep);
}
/*-------------------------------------------------------------------------*
* 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);
}
/*-------------------------------------------------------------------------*
* ALL_SOLUT_INITIALIZER *
* *
*-------------------------------------------------------------------------*/
static void
All_Solut_Initializer(void)
{
exist_2 = Functor_Arity(ATOM_CHAR('^'), 2);
}
/*-------------------------------------------------------------------------*
* PL_BLT_UNIV *
* *
*-------------------------------------------------------------------------*/
Bool FC
Pl_Blt_Univ(WamWord term_word, WamWord list_word)
{
WamWord word, tag_mask;
WamWord *adr;
WamWord car_word;
int lst_length;
WamWord *arg1_adr;
WamWord *term_adr, *lst_adr, *stc_adr;
WamWord functor_word, functor_tag;
int functor;
int arity;
Pl_Set_C_Bip_Name("=..", 2);
DEREF(term_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK)
goto list_to_term;
/* from term to list functor+args */
if (tag_mask == TAG_LST_MASK)
{
adr = UnTag_LST(word);
car_word = Tag_ATM(ATOM_CHAR('.'));
lst_length = 1 + 2;
arg1_adr = &Car(adr);
}
else if (tag_mask == TAG_STC_MASK)
{
adr = UnTag_STC(word);
car_word = Tag_ATM(Functor(adr));
lst_length = 1 + Arity(adr);
arg1_adr = &Arg(adr, 0);
}
#ifndef NO_USE_FD_SOLVER
else if (tag_mask == TAG_FDV_MASK)
{
adr = UnTag_FDV(word);
car_word = Tag_REF(adr); /* since Dont_Separate_Tag */
lst_length = 1 + 0;
}
#endif
else /* TAG_ATM/INT/FLT_MASK */
{
car_word = word;
lst_length = 1 + 0;
}
Pl_Check_For_Un_List(list_word);
Pl_Unset_C_Bip_Name();
for (;;)
{
if (!Pl_Get_List(list_word) || !Pl_Unify_Value(car_word))
return FALSE;
list_word = Pl_Unify_Variable();
if (--lst_length == 0)
break;
car_word = *arg1_adr++;
}
return Pl_Get_Nil(list_word);
/* from list functor+args to term */
list_to_term:
term_adr = UnTag_REF(word);
DEREF(list_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK)
Pl_Err_Instantiation();
if (word == NIL_WORD)
Pl_Err_Domain(pl_domain_non_empty_list, list_word);
if (tag_mask != TAG_LST_MASK)
Pl_Err_Type(pl_type_list, list_word);
lst_adr = UnTag_LST(word);
DEREF(Car(lst_adr), functor_word, functor_tag);
if (functor_tag == TAG_REF_MASK)
Pl_Err_Instantiation();
DEREF(Cdr(lst_adr), word, tag_mask);
if (word == NIL_WORD)
{
if (functor_tag != TAG_ATM_MASK && functor_tag != TAG_INT_MASK &&
functor_tag != TAG_FLT_MASK)
Pl_Err_Type(pl_type_atomic, functor_word);
term_word = functor_word;
goto finish;
}
if (functor_tag != TAG_ATM_MASK)
Pl_Err_Type(pl_type_atom, functor_word);
if (tag_mask == TAG_REF_MASK)
Pl_Err_Instantiation();
if (tag_mask != TAG_LST_MASK)
Pl_Err_Type(pl_type_list, list_word);
functor = UnTag_ATM(functor_word);
stc_adr = H;
H++; /* space for f/n maybe lost if a list */
arity = 0;
for (;;)
{
arity++;
lst_adr = UnTag_LST(word);
DEREF(Car(lst_adr), word, tag_mask);
Do_Copy_Of_Word(tag_mask, word); /* since Dont_Separate_Tag */
Global_Push(word);
DEREF(Cdr(lst_adr), word, tag_mask);
if (word == NIL_WORD)
break;
if (tag_mask == TAG_REF_MASK)
Pl_Err_Instantiation();
if (tag_mask != TAG_LST_MASK)
Pl_Err_Type(pl_type_list, list_word);
}
if (arity > MAX_ARITY)
Pl_Err_Representation(pl_representation_max_arity);
if (functor == ATOM_CHAR('.') && arity == 2) /* a list */
term_word = Tag_LST(stc_adr + 1);
else
{
*stc_adr = Functor_Arity(functor, arity);
term_word = Tag_STC(stc_adr);
}
finish:
Bind_UV(term_adr, term_word);
Pl_Unset_C_Bip_Name();
return TRUE;
}
/*-------------------------------------------------------------------------*
* FD_BOOL_INITIALIZER *
* *
*-------------------------------------------------------------------------*/
static void
Fd_Bool_Initializer(void)
{
bool_tbl[NOT] = Functor_Arity(Pl_Create_Atom("#\\"), 1);
bool_tbl[EQUIV] = Functor_Arity(Pl_Create_Atom("#<=>"), 2);
bool_tbl[NEQUIV] = Functor_Arity(Pl_Create_Atom("#\\<=>"), 2);
bool_tbl[IMPLY] = Functor_Arity(Pl_Create_Atom("#==>"), 2);
bool_tbl[NIMPLY] = Functor_Arity(Pl_Create_Atom("#\\==>"), 2);
bool_tbl[AND] = Functor_Arity(Pl_Create_Atom("#/\\"), 2);
bool_tbl[NAND] = Functor_Arity(Pl_Create_Atom("#\\/\\"), 2);
bool_tbl[OR] = Functor_Arity(Pl_Create_Atom("#\\/"), 2);
bool_tbl[NOR] = Functor_Arity(Pl_Create_Atom("#\\\\/"), 2);
bool_tbl[EQ] = Functor_Arity(Pl_Create_Atom("#="), 2);
bool_tbl[NEQ] = Functor_Arity(Pl_Create_Atom("#\\="), 2);
bool_tbl[LT] = Functor_Arity(Pl_Create_Atom("#<"), 2);
bool_tbl[GTE] = Functor_Arity(Pl_Create_Atom("#>="), 2);
bool_tbl[GT] = Functor_Arity(Pl_Create_Atom("#>"), 2);
bool_tbl[LTE] = Functor_Arity(Pl_Create_Atom("#=<"), 2);
bool_tbl[EQ_F] = Functor_Arity(Pl_Create_Atom("#=#"), 2);
bool_tbl[NEQ_F] = Functor_Arity(Pl_Create_Atom("#\\=#"), 2);
bool_tbl[LT_F] = Functor_Arity(Pl_Create_Atom("#<#"), 2);
bool_tbl[GTE_F] = Functor_Arity(Pl_Create_Atom("#>=#"), 2);
bool_tbl[GT_F] = Functor_Arity(Pl_Create_Atom("#>#"), 2);
bool_tbl[LTE_F] = Functor_Arity(Pl_Create_Atom("#=<#"), 2);
bool_xor = Functor_Arity(Pl_Create_Atom("##"), 2);
func_tbl[NOT] = Set_Not;
func_tbl[EQUIV] = Set_Equiv;
func_tbl[NEQUIV] = Set_Nequiv;
func_tbl[IMPLY] = Set_Imply;
func_tbl[NIMPLY] = Set_Nimply;
func_tbl[AND] = Set_And;
func_tbl[NAND] = Set_Nand;
func_tbl[OR] = Set_Or;
func_tbl[NOR] = Set_Nor;
func_tbl[EQ] = Set_Eq;
func_tbl[NEQ] = Set_Neq;
func_tbl[LT] = Set_Lt;
func_tbl[GTE] = NULL;
func_tbl[GT] = NULL;
func_tbl[LTE] = Set_Lte;
func_tbl[EQ_F] = NULL;
func_tbl[NEQ_F] = NULL;
func_tbl[LT_F] = NULL;
func_tbl[GTE_F] = NULL;
func_tbl[GT_F] = NULL;
func_tbl[LTE_F] = NULL;
func_tbl[ZERO] = Set_Zero;
func_tbl[ONE] = Set_One;
}
/*-------------------------------------------------------------------------*
* MATH_SUPP_INITIALIZER *
* *
*-------------------------------------------------------------------------*/
static void
Math_Supp_Initializer(void)
{
arith_tbl[PLUS_1] = Functor_Arity(ATOM_CHAR('+'), 1);
arith_tbl[PLUS_2] = Functor_Arity(ATOM_CHAR('+'), 2);
arith_tbl[MINUS_1] = Functor_Arity(ATOM_CHAR('-'), 1);
arith_tbl[MINUS_2] = Functor_Arity(ATOM_CHAR('-'), 2);
arith_tbl[TIMES_2] = Functor_Arity(ATOM_CHAR('*'), 2);
arith_tbl[POWER_2] = Functor_Arity(Pl_Create_Atom("**"), 2);
arith_tbl[DIV_2] = Functor_Arity(ATOM_CHAR('/'), 2);
arith_tbl[MIN_2] = Functor_Arity(Pl_Create_Atom("min"), 2);
arith_tbl[MAX_2] = Functor_Arity(Pl_Create_Atom("max"), 2);
arith_tbl[DIST_2] = Functor_Arity(Pl_Create_Atom("dist"), 2);
arith_tbl[QUOT_2] = Functor_Arity(Pl_Create_Atom("//"), 2);
arith_tbl[REM_2] = Functor_Arity(Pl_Create_Atom("rem"), 2);
arith_tbl[QUOT_REM_3] = Functor_Arity(Pl_Create_Atom("quot_rem"), 3);
}
