302 lines
7.4 KiB
C
302 lines
7.4 KiB
C
|
/*************************************************************************
|
||
|
|
* *
|
||
|
|
* YAP Prolog *
|
||
|
|
* *
|
||
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||
|
|
* *
|
||
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||
|
|
* *
|
||
|
|
**************************************************************************
|
||
|
|
* *
|
||
|
|
* File: evaltwo.c *
|
||
|
|
* Last rev: *
|
||
|
|
* mods: *
|
||
|
|
* comments: is/4 predicate *
|
||
|
|
* *
|
||
|
|
*************************************************************************/
|
||
|
|
#ifdef SCCS
|
||
|
|
static char SccsId[] = "%W% %G%";
|
||
|
|
#endif
|
||
|
|
|
||
|
|
/*
|
||
|
|
* This predicates had to be developed here because of a bug in the MPW
|
||
|
|
* compiler, which was not able to compile the original eval.c
|
||
|
|
*/
|
||
|
|
|
||
|
|
#include "Yap.h"
|
||
|
|
#include "Yatom.h"
|
||
|
|
#include "Heap.h"
|
||
|
|
#include "eval.h"
|
||
|
|
|
||
|
|
#define IntRes(X) return(unify_constant(ARG1,MkIntegerTerm(X)))
|
||
|
|
#define FloatRes(X) return(unify_constant(ARG1,MkEvalFl(X)))
|
||
|
|
|
||
|
|
int
|
||
|
|
BinEvalInt(BITS16 op, Int i1, Int i2)
|
||
|
|
{
|
||
|
|
switch(op) {
|
||
|
|
case e_plus:
|
||
|
|
REvalInt(i1 + i2);
|
||
|
|
case e_dif:
|
||
|
|
REvalInt(i1 - i2);
|
||
|
|
case e_times:
|
||
|
|
REvalInt(i1 * i2);
|
||
|
|
case e_div:
|
||
|
|
#ifdef TRY_TO_CONVERT_FLOATS_TO_INTS
|
||
|
|
if (i1 % i2 == 0)
|
||
|
|
REvalInt(i1 / i2);
|
||
|
|
#endif
|
||
|
|
REvalFl(FL(i1) / FL(i2));
|
||
|
|
case e_and:
|
||
|
|
REvalInt(i1 & i2);
|
||
|
|
case e_xor:
|
||
|
|
REvalInt(i1 ^ i2);
|
||
|
|
case e_or:
|
||
|
|
REvalInt(i1 | i2);
|
||
|
|
case e_lshift:
|
||
|
|
REvalInt(i1 << i2);
|
||
|
|
case e_rshift:
|
||
|
|
REvalInt(i1 >> i2);
|
||
|
|
case e_mod:
|
||
|
|
REvalInt(i1 % i2);
|
||
|
|
case e_idiv:
|
||
|
|
REvalInt(i1 / i2);
|
||
|
|
case e_gcd:
|
||
|
|
REvalInt(gcd(abs(i1),abs(i2)));
|
||
|
|
case e_gcdmult:
|
||
|
|
{
|
||
|
|
Int i;
|
||
|
|
REvalInt(gcdmult(abs(i1),abs(i2), &i));
|
||
|
|
}
|
||
|
|
case e_min:
|
||
|
|
REvalInt((i1 < i2 ? i1 : i2));
|
||
|
|
case e_max:
|
||
|
|
REvalInt((i1 > i2 ? i1 : i2));
|
||
|
|
case e_power:
|
||
|
|
REvalFl(pow(FL(i1), FL(i2)));
|
||
|
|
case e_atan2:
|
||
|
|
REvalFl(atan2(FL(i1), FL(i2)));
|
||
|
|
default:
|
||
|
|
{
|
||
|
|
Term t, ti[2];
|
||
|
|
|
||
|
|
ti[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(current_eval_term)));
|
||
|
|
ti[1] = MkIntegerTerm(2);
|
||
|
|
t = MkApplTerm(MkFunctor(LookupAtom("/"),2), 2, ti);
|
||
|
|
Error(TYPE_ERROR_EVALUABLE, t,
|
||
|
|
"in arithmetic expression %s(%d,%d)",
|
||
|
|
RepAtom(NameOfFunctor(FunctorOfTerm(current_eval_term)))->StrOfAE,
|
||
|
|
i1,
|
||
|
|
i2
|
||
|
|
);
|
||
|
|
P = (yamop *)FAILCODE;
|
||
|
|
REvalError();
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
int
|
||
|
|
BinEvalFl(BITS16 op, Float f1, Float f2, int flts)
|
||
|
|
{
|
||
|
|
switch(op) {
|
||
|
|
case e_plus:
|
||
|
|
REvalFl(f1 + f2);
|
||
|
|
case e_dif:
|
||
|
|
REvalFl(f1 - f2);
|
||
|
|
case e_times:
|
||
|
|
REvalFl(f1 * f2);
|
||
|
|
case e_div:
|
||
|
|
REvalFl(f1 / f2);
|
||
|
|
case e_power:
|
||
|
|
REvalFl(pow(f1, f2));
|
||
|
|
case e_atan2:
|
||
|
|
REvalFl(atan2(f1, f2));
|
||
|
|
case e_min:
|
||
|
|
REvalFl((f1 < f2 ? f1 : f2));
|
||
|
|
case e_max:
|
||
|
|
REvalFl((f1 > f2 ? f1 : f2));
|
||
|
|
case e_lshift:
|
||
|
|
if (flts & 1)
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), "<</2");
|
||
|
|
else
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), "<</2");
|
||
|
|
P = (yamop *)FAILCODE;
|
||
|
|
REvalError();
|
||
|
|
case e_rshift:
|
||
|
|
if (flts & 1)
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), ">>/2");
|
||
|
|
else
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), ">>/2");
|
||
|
|
P = (yamop *)FAILCODE;
|
||
|
|
REvalError();
|
||
|
|
case e_and:
|
||
|
|
if (flts & 1)
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), "/\\/2");
|
||
|
|
else
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), "/\\/2");
|
||
|
|
P = (yamop *)FAILCODE;
|
||
|
|
REvalError();
|
||
|
|
case e_xor:
|
||
|
|
if (flts & 1)
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), "#/2");
|
||
|
|
else
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), "#/2");
|
||
|
|
P = (yamop *)FAILCODE;
|
||
|
|
REvalError();
|
||
|
|
case e_or:
|
||
|
|
if (flts & 1)
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), "\\/ /2");
|
||
|
|
else
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), "\\/ /2");
|
||
|
|
P = (yamop *)FAILCODE;
|
||
|
|
REvalError();
|
||
|
|
case e_mod:
|
||
|
|
if (flts & 1)
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), "mod/2");
|
||
|
|
else
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), "mod/2");
|
||
|
|
P = (yamop *)FAILCODE;
|
||
|
|
REvalError();
|
||
|
|
case e_idiv:
|
||
|
|
if (flts & 1)
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), "/ /2");
|
||
|
|
else
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), "/ /2");
|
||
|
|
P = (yamop *)FAILCODE;
|
||
|
|
REvalError();
|
||
|
|
case e_gcd:
|
||
|
|
if (flts & 1)
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), "gcd/2");
|
||
|
|
else
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), "gcd/2");
|
||
|
|
P = (yamop *)FAILCODE;
|
||
|
|
REvalError();
|
||
|
|
case e_gcdmult:
|
||
|
|
if (flts & 1)
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f1), "gcdmult/2");
|
||
|
|
else
|
||
|
|
Error(TYPE_ERROR_INTEGER, MkFloatTerm(f2), "gcdmult/2");
|
||
|
|
P = (yamop *)FAILCODE;
|
||
|
|
REvalError();
|
||
|
|
default:
|
||
|
|
{
|
||
|
|
Term t, ti[2];
|
||
|
|
|
||
|
|
ti[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(current_eval_term)));
|
||
|
|
ti[1] = MkIntegerTerm(2);
|
||
|
|
t = MkApplTerm(MkFunctor(LookupAtom("/"),2), 2, ti);
|
||
|
|
Error(TYPE_ERROR_EVALUABLE, t,
|
||
|
|
"in arithmetic expression %s(%d,%d)",
|
||
|
|
RepAtom(NameOfFunctor(FunctorOfTerm(current_eval_term)))->StrOfAE,
|
||
|
|
f1,
|
||
|
|
f2
|
||
|
|
);
|
||
|
|
P = (yamop *)FAILCODE;
|
||
|
|
}
|
||
|
|
REvalError();
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
Int
|
||
|
|
p_binary_is(void)
|
||
|
|
{
|
||
|
|
register BITS16 OpNum;
|
||
|
|
Term t2,t3,t4;
|
||
|
|
Int i1;
|
||
|
|
Float f1;
|
||
|
|
int flag;
|
||
|
|
|
||
|
|
current_eval_term = MkIntTerm(2);
|
||
|
|
t2 = Deref(ARG2);
|
||
|
|
if (IsVarTerm(t2)) {
|
||
|
|
Error(INSTANTIATION_ERROR, t2, "operation for is/4");
|
||
|
|
P = (yamop *)FAILCODE;
|
||
|
|
return(FALSE);
|
||
|
|
}
|
||
|
|
if (IsIntTerm(t2))
|
||
|
|
OpNum = IntOfTerm(t2);
|
||
|
|
else if (IsAtomTerm(t2)) {
|
||
|
|
Atom name = AtomOfTerm(t2);
|
||
|
|
Prop p;
|
||
|
|
if ((p = GetExpProp(name, 2)) == NIL) {
|
||
|
|
Term t, ti[2];
|
||
|
|
|
||
|
|
ti[0] = MkIntegerTerm(2);
|
||
|
|
ti[0] = MkAtomTerm(name);
|
||
|
|
t = MkApplTerm(MkFunctor(LookupAtom("/"),2), 2, ti);
|
||
|
|
Error(TYPE_ERROR_EVALUABLE, t,
|
||
|
|
"arithmetic expression %s/%d",
|
||
|
|
RepAtom(name)->StrOfAE,
|
||
|
|
2
|
||
|
|
);
|
||
|
|
P = (yamop *)FAILCODE;
|
||
|
|
return(FALSE);
|
||
|
|
}
|
||
|
|
OpNum = RepExpProp(p)->ENoOfEE;
|
||
|
|
} else
|
||
|
|
return (FALSE);
|
||
|
|
t3 = Deref(ARG3);
|
||
|
|
t4 = Deref(ARG4);
|
||
|
|
if (IsVarTerm(t3) || IsVarTerm(t4)) {
|
||
|
|
int op = 0;
|
||
|
|
|
||
|
|
while (InitTab[op].eno != OpNum) op++;
|
||
|
|
Error(INSTANTIATION_ERROR, (IsVarTerm(t3) ? t3 : t4),
|
||
|
|
"arithmetic expression %s/2", InitTab[op].OpName);
|
||
|
|
return(FALSE);
|
||
|
|
}
|
||
|
|
if (IsIntegerTerm(t3)) {
|
||
|
|
i1 = IntegerOfTerm(t3);
|
||
|
|
t3_int:
|
||
|
|
if (IsIntegerTerm(t4)) {
|
||
|
|
flag = BinEvalInt(OpNum, i1, IntegerOfTerm(t4));
|
||
|
|
} else if (IsFloatTerm(t4)) {
|
||
|
|
flag = BinEvalFl(OpNum, FL(i1), FloatOfTerm(t4), 2);
|
||
|
|
} else {
|
||
|
|
int aflag = Eval(t4);
|
||
|
|
if (aflag == FError) {
|
||
|
|
return(FALSE);
|
||
|
|
} else if (aflag == FInt) {
|
||
|
|
flag = BinEvalInt(OpNum, i1, eval_int);
|
||
|
|
} else {
|
||
|
|
flag = BinEvalFl(OpNum, FL(i1), eval_flt, 2);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else if (IsFloatTerm(t3)) {
|
||
|
|
f1 = FloatOfTerm(t3);
|
||
|
|
t3_flt:
|
||
|
|
if (IsIntegerTerm(t4)) {
|
||
|
|
flag = BinEvalFl(OpNum, f1, FL(IntegerOfTerm(t4)), 1);
|
||
|
|
} else if (IsFloatTerm(t4)) {
|
||
|
|
flag = BinEvalFl(OpNum, f1, FloatOfTerm(t4), 3);
|
||
|
|
} else {
|
||
|
|
int aflag = Eval(t4);
|
||
|
|
if (aflag == FError) {
|
||
|
|
return(FALSE);
|
||
|
|
} else if (aflag == FInt) {
|
||
|
|
flag = BinEvalFl(OpNum, f1, eval_int, 1);
|
||
|
|
} else {
|
||
|
|
flag = BinEvalFl(OpNum, f1, eval_flt, 3);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
int aflag = Eval(t3);
|
||
|
|
if (aflag == FError) {
|
||
|
|
return(FALSE);
|
||
|
|
} else if (aflag == FInt) {
|
||
|
|
i1 = eval_int;
|
||
|
|
goto t3_int;
|
||
|
|
} else {
|
||
|
|
f1 = eval_flt;
|
||
|
|
goto t3_flt;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if (flag == FError) {
|
||
|
|
return(FALSE);
|
||
|
|
} else if (flag == FInt) {
|
||
|
|
return(unify_constant(ARG1,MkIntegerTerm(eval_int)));
|
||
|
|
} else {
|
||
|
|
return(unify_constant(ARG1,MkFloatTerm(eval_flt)));
|
||
|
|
}
|
||
|
|
}
|