support for X^[A,B] and X^length in arithmetic expressions.
This commit is contained in:
parent
1cc3280fea
commit
1ddd61314c
53
C/eval.c
53
C/eval.c
@ -34,7 +34,54 @@ static char SccsId[] = "%W% %G%";
|
||||
#include <unistd.h>
|
||||
#endif
|
||||
|
||||
static Term Eval(Term t1 USES_REGS);
|
||||
|
||||
static Term
|
||||
get_matrix_element(Term t1, Term t2 USES_REGS)
|
||||
{
|
||||
if (!IsPairTerm(t2)) {
|
||||
if (t2 == MkAtomTerm(AtomLength)) {
|
||||
Int sz = 1;
|
||||
while (IsApplTerm(t1)) {
|
||||
Functor f = FunctorOfTerm(t1);
|
||||
if (NameOfFunctor(f) != AtomNil) {
|
||||
return MkIntegerTerm(sz);
|
||||
}
|
||||
sz *= ArityOfFunctor(f);
|
||||
t1 = ArgOfTerm(1, t1);
|
||||
}
|
||||
return MkIntegerTerm(sz);
|
||||
}
|
||||
Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
|
||||
return FALSE;
|
||||
}
|
||||
while (IsPairTerm(t2)) {
|
||||
Int indx;
|
||||
Term indxt = Eval(HeadOfTerm(t2) PASS_REGS);
|
||||
if (!IsIntegerTerm(indxt)) {
|
||||
Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
|
||||
return FALSE;
|
||||
}
|
||||
indx = IntegerOfTerm(indxt);
|
||||
if (!IsApplTerm(t1)) {
|
||||
Yap_ArithError(TYPE_ERROR_EVALUABLE, t1, "X is Y^[A]");
|
||||
return FALSE;
|
||||
} else {
|
||||
Functor f = FunctorOfTerm(t1);
|
||||
if (ArityOfFunctor(f) < indx) {
|
||||
Yap_ArithError(TYPE_ERROR_EVALUABLE, t1, "X is Y^[A]");
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
t1 = ArgOfTerm(indx, t1);
|
||||
t2 = TailOfTerm(t2);
|
||||
}
|
||||
if (t2 != TermNil) {
|
||||
Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
|
||||
return FALSE;
|
||||
}
|
||||
return Eval(t1 PASS_REGS);
|
||||
}
|
||||
|
||||
static Term
|
||||
Eval(Term t USES_REGS)
|
||||
@ -77,6 +124,12 @@ Eval(Term t USES_REGS)
|
||||
"functor %s/%d for arithmetic expression",
|
||||
RepAtom(name)->StrOfAE,n);
|
||||
}
|
||||
if (p->FOfEE == op_power && p->ArityOfEE == 2) {
|
||||
t2 = ArgOfTerm(2, t);
|
||||
if (IsPairTerm(t2)) {
|
||||
return get_matrix_element(ArgOfTerm(1, t), t2 PASS_REGS);
|
||||
}
|
||||
}
|
||||
*RepAppl(t) = (CELL)AtomFoundVar;
|
||||
t1 = Eval(ArgOfTerm(1,t) PASS_REGS);
|
||||
if (t1 == 0L) {
|
||||
|
@ -150,6 +150,7 @@
|
||||
AtomLT = Yap_LookupAtom("<");
|
||||
AtomLastExecuteWithin = Yap_FullLookupAtom("$last_execute_within");
|
||||
AtomLeash = Yap_FullLookupAtom("$leash");
|
||||
AtomLength = Yap_FullLookupAtom("length");
|
||||
AtomList = Yap_LookupAtom("list");
|
||||
AtomLive = Yap_FullLookupAtom("$live");
|
||||
AtomLoadAnswers = Yap_LookupAtom("load_answers");
|
||||
|
@ -150,6 +150,7 @@
|
||||
AtomLT = AtomAdjust(AtomLT);
|
||||
AtomLastExecuteWithin = AtomAdjust(AtomLastExecuteWithin);
|
||||
AtomLeash = AtomAdjust(AtomLeash);
|
||||
AtomLength = AtomAdjust(AtomLength);
|
||||
AtomList = AtomAdjust(AtomList);
|
||||
AtomLive = AtomAdjust(AtomLive);
|
||||
AtomLoadAnswers = AtomAdjust(AtomLoadAnswers);
|
||||
|
@ -298,6 +298,8 @@
|
||||
#define AtomLastExecuteWithin Yap_heap_regs->AtomLastExecuteWithin_
|
||||
Atom AtomLeash_;
|
||||
#define AtomLeash Yap_heap_regs->AtomLeash_
|
||||
Atom AtomLength_;
|
||||
#define AtomLength Yap_heap_regs->AtomLength_
|
||||
Atom AtomList_;
|
||||
#define AtomList Yap_heap_regs->AtomList_
|
||||
Atom AtomLive_;
|
||||
|
@ -155,6 +155,7 @@ A LOOP N "_LOOP_"
|
||||
A LT N "<"
|
||||
A LastExecuteWithin F "$last_execute_within"
|
||||
A Leash F "$leash"
|
||||
A Length F "length"
|
||||
A List N "list"
|
||||
A Live F "$live"
|
||||
A LoadAnswers N "load_answers"
|
||||
|
Reference in New Issue
Block a user