support for X^[A,B] and X^length in arithmetic expressions.

This commit is contained in:
Vítor Santos Costa 2011-10-27 12:36:48 +02:00
parent 1cc3280fea
commit 1ddd61314c
5 changed files with 58 additions and 0 deletions

View File

@ -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) {

View File

@ -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");

View File

@ -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);

View File

@ -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_;

View File

@ -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"