/* A trail slot is marked iff it contains
an unbound constrained variable reference or a goal.
*/
static CVOID__PROTO(markChoicepoints) {
/* Mark choicepoints and corresponding chains of frames */
/* and mark remaining trail entries */
node_t *cp = Gc_Aux_Node;
tagged_t *tr = w->trail_top;
tagged_t *limit;
while (ChoiceYounger(cp,Gc_Choice_Start))
{
intmach_t n = cp->next_alt->node_offset;
intmach_t i = OffsetToArity(n);
markFrames(Arg, cp->frame, cp->next_insn);
while ((i--)>0)
{
if (IsHeapTerm(cp->term[i]))
markVariable(Arg, &cp->term[i]);
}
cp = ChoiceCharOffset(cp, -n);
/* mark goals and unbound constrained variables;
reset unmarked bound variables
between cp->trail_top and tr */
limit = TagToPointer(cp->trail_top);
while (TrailYounger(tr,limit))
{
tagged_t v = TrailPop(tr);
if (v==(tagged_t)NULL || gc_IsMarked(v))
;
else if (!IsVar(v))
markVariable(Arg, tr);
#ifdef EARLY_RESET
else if (TagIsCVA(v))
{
if (!gc_IsMarked(*TagToCVA(v)))
*TagToCVA(v)= v, markVariable(Arg, tr), *tr= 0;
}
else
{
if (!gc_IsMarked(*TagToPointer(v)))
*TagToPointer(v)= v, *tr= 0;
}
#else
else if (TagIsCVA(v))
markVariable(Arg, tr);
#endif
}
}
TokenTypes CMathParser::NextToken()//{ Gets the next Token from the Input stream }
{
CSPString NumString;// : String[80];
WORD TLen, NumLen; //, FormLen, Place;
// int Check ;//: Integer;
char Ch;//, FirstChar;
BOOL Decimal ;
TokenTypes ResultNextToken;
while ((Position < FInput.GetLength()) && (FInput.GetAt(Position) == ' '))
Position++;
TokenLen = Position;
if (Position >= FInput.GetLength())
{
ResultNextToken = EOL;
TokenLen = 0;
return ResultNextToken;
}
FInput.MakeUpper();
Ch = FInput.GetAt(Position);
if (Ch== '!')
{
ResultNextToken = ERR;
TokenLen = 0;
return ResultNextToken ;
}
if((Ch >= '0' && Ch <= '9') || Ch == '.')// if Ch in ['0'..'9', '.'] then
{
NumString = "";
TLen = Position;
Decimal = FALSE;
while ((TLen < FInput.GetLength()) &&
((FInput.GetAt(TLen) >= '0' && FInput.GetAt(TLen) <= '9' ) ||
((FInput.GetAt(TLen) == '.') && (!Decimal))))
{
NumString = NumString + FInput.GetAt(TLen);
if (Ch == '.')// then
Decimal = TRUE;
TLen++;//Inc(TLen);
}
if ((TLen == 2) && (Ch == '.'))// then
{
ResultNextToken = BAD;
TokenLen = 0;
return ResultNextToken ;
}
if ((TLen < FInput.GetLength()) && ((FInput.GetAt(TLen)) == 'E'))// then
{
NumString = NumString + 'E';
TLen++;
if( FInput.GetAt(TLen) == '+' || FInput.GetAt(TLen) == '-')// in ['+', '-'] then
{
NumString.SetAt(TLen, FInput.GetAt(TLen));//= NumString + FInput[TLen];
TLen++;
}
NumLen = 1;
while ((TLen < FInput.GetLength()) && (FInput.GetAt(TLen) >= '0' && FInput.GetAt(TLen) <= '9') &&
(NumLen <= MP_MaxExpLen))
{
NumString = NumString + FInput.GetAt(TLen);
NumLen++;//Inc(NumLen);
TLen++;//Inc(TLen);
}
}
if (NumString[0] == '.')// then
NumString = '0' + NumString;
CurrToken.Value = atof(NumString);
//Val(NumString, CurrToken.Value, Check);
/*//if (Check != 0 )
{// begin
ErrorCode = MP_ErrMath;
ErrorCode = ErrInvalidNum;
Position += Pred(Check);
//Inc(Position, Pred(Check));
}// end { if }
else*/
{// begin
ResultNextToken = NUM;
Position += NumString.GetLength();
//Inc(Position, System.Length(NumString));
TokenLen = Position - TokenLen;
}// end; { else }
return ResultNextToken;
}//end { if }
else if ((Ch>='a' && Ch <= 'z')
|| (Ch>='A' && Ch <= 'Z'))//in Letters then
{// begin
if (IsFunc("ABS") ||
IsFunc("ATAN") ||
IsFunc("COS") ||
IsFunc("EXP") ||
IsFunc("LN") ||
IsFunc("ROUND") ||
IsFunc("SIN") ||
IsFunc("SQRT") ||
IsFunc("SQR") ||
IsFunc("TRUNC")||
IsFunc("NOT")||// then//EXPAND
IsFunc("BOOL")||
IsFunc("SGN")
)
{
ResultNextToken = FUNC;
TokenLen = Position - TokenLen;
return ResultNextToken ;
}
if (IsFunc("MOD"))
{
ResultNextToken = MODU;
TokenLen = Position - TokenLen;
return ResultNextToken ;
}
if (IsVar(CurrToken.Value))
{
ResultNextToken = NUM;
TokenLen = Position - TokenLen;
return ResultNextToken;
}
else
{
ResultNextToken = BAD;
TokenLen = 0;
return ResultNextToken ;
}
}
else
{// begin
switch(Ch)
{
case '+' : ResultNextToken = PLUS; break;
case '-' : ResultNextToken = MINUS; break;
case '*' : ResultNextToken = TIMES; break;
case '/' : ResultNextToken = DIVIDE; break;
case '^' : ResultNextToken = EXPO; break;
case '(' : ResultNextToken = OPAREN; break;
case ')' : ResultNextToken = CPAREN; break;
default:
ResultNextToken = BAD;
TokenLen = 0;
return ResultNextToken ;
}//end; { case }
Position++;
TokenLen = Position - TokenLen;
return ResultNextToken ;
}//end; { else if }
}//end; { NextToken }
/*-------------------------------------------------------------------------*
* SIMPLIFY *
* *
* This function returns the result of the simplified boolean expression *
* given in e_word. NOT operators are only applied to variables. *
* *
* Input: *
* sign : current sign of the boolean term (-1 (inside a ~) or +1) *
* e_word: boolean term to simplify *
* *
* Output: *
* The returned result is a pointer to a node of the following form: *
* *
* for binary boolean not operator (~): *
* [1]: variable involved (tagged word) *
* [0]: operator NOT *
* *
* for unary boolean operators (<=> ~<=> ==> ~==> /\ ~/\ \/ ~\/): *
* [2]: right boolean exp (pointer to node) *
* [1]: left boolean exp (pointer to node) *
* [0]: operator (EQUIV, NEQUIV, IMPLY, NIMPLY, AND, NAND, OR, NOR) *
* *
* for boolean false value (0): *
* [0]: ZERO *
* *
* for boolean true value (1): *
* [0]: ONE *
* *
* for boolean variable: *
* [0]: tagged word *
* *
* for binary math operators (= \= < >= > <=) (partial / full AC): *
* [2]: right math exp (tagged word) *
* [1]: left math exp (tagged word) *
* [0]: operator (EQ, NEQ, LT, LTE, EQ_F, NEQ_F, LT_F, LTE_F) *
* (GT, GTE, GT_F, and GTE_F becomes LT, LTE, LT_F and LTE_F) *
* *
* These nodes are stored in a hybrid stack. NB: XOR same as NEQUIV *
*-------------------------------------------------------------------------*/
static WamWord *
Simplify(int sign, WamWord e_word)
{
WamWord word, tag_mask;
WamWord *adr;
WamWord f_n, le_word, re_word;
int op, n;
WamWord *exp, *sp1;
WamWord l, r;
#ifdef DEBUG
printf("ENTERING %5ld: %2d: ", sp - stack, sign);
Pl_Write(e_word);
printf("\n");
#endif
exp = sp;
if (sp - stack > BOOL_STACK_SIZE - 5)
Pl_Err_Resource(pl_resource_too_big_fd_constraint);
DEREF(e_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK || tag_mask == TAG_FDV_MASK)
{
adr = UnTag_Address(word);
if (vars_sp - vars_tbl == VARS_STACK_SIZE)
Pl_Err_Resource(pl_resource_too_big_fd_constraint);
*vars_sp++ = word;
*vars_sp++ = 0; /* bool var */
if (sign != 1)
*sp++ = NOT;
*sp++ = Tag_REF(adr);
return exp;
}
if (tag_mask == TAG_INT_MASK)
{
n = UnTag_INT(word);
if ((unsigned) n > 1)
goto type_error;
*sp++ = ZERO + ((sign == 1) ? n : 1 - n);
return exp;
}
if (tag_mask == TAG_ATM_MASK)
{
word = Pl_Put_Structure(ATOM_CHAR('/'), 2);
Pl_Unify_Value(e_word);
Pl_Unify_Integer(0);
type_error:
Pl_Err_Type(pl_type_fd_bool_evaluable, word);
}
if (tag_mask != TAG_STC_MASK)
goto type_error;
adr = UnTag_STC(word);
f_n = Functor_And_Arity(adr);
if (bool_xor == f_n)
op = NEQUIV;
else
{
for (op = 0; op < NB_OF_OP; op++)
if (bool_tbl[op] == f_n)
break;
if (op == NB_OF_OP)
{
word = Pl_Put_Structure(ATOM_CHAR('/'), 2);
Pl_Unify_Atom(Functor(adr));
Pl_Unify_Integer(Arity(adr));
goto type_error;
}
}
le_word = Arg(adr, 0);
re_word = Arg(adr, 1);
if (op == NOT)
return Simplify(-sign, le_word);
if (sign != 1)
op = (op % 2 == EQ % 2) ? op + 1 : op - 1;
if (op >= EQ && op <= LTE_F)
{
Add_Fd_Variables(le_word);
Add_Fd_Variables(re_word);
n = (op == GT || op == GT_F) ? op - 2 :
(op == GTE || op == GTE_F) ? op + 2 : op;
*sp++ = n;
*sp++ = (n == op) ? le_word : re_word;
*sp++ = (n == op) ? re_word : le_word;
return exp;
}
sp += 3;
exp[0] = op;
exp[1] = (WamWord) Simplify(1, le_word);
sp1 = sp;
exp[2] = (WamWord) Simplify(1, re_word);
l = *(WamWord *) (exp[1]);
r = *(WamWord *) (exp[2]);
/* NB: beware when calling below Simplify() (while has been just called above)
* this can ran into stack overflow (N^2 space complexity).
* Try to recover the stack before calling Simplify().
* Other stack recovery are less important (e.g. when only using exp[1]).
*
* In the following exp[] += sizeof(WamWord) is used to "skip" the NOT
* in a simplification (points to the next cell).
*/
switch (op)
{
case EQUIV:
if (l == ZERO) /* 0 <=> R is ~R */
{
sp = exp;
return Simplify(-1, re_word);
}
if (l == ONE) /* 1 <=> R is R */
{
return (WamWord *) exp[2];
}
if (r == ZERO) /* L <=> 0 is ~L */
{
sp = exp;
return Simplify(-1, le_word);
}
if (r == ONE) /* L <=> 1 is L */
{
sp = sp1;
return (WamWord *) exp[1];
}
if (l == NOT) /* ~X <=> R is X <=> ~R */
{
exp[1] += sizeof(WamWord);
sp = sp1;
exp[2] = (WamWord) Simplify(-1, re_word);
break;
}
if (r == NOT) /* L <=> ~X is ~L <=> X */
{ /* NB: cannot recover the stack */
exp[1] = (WamWord) Simplify(-1, le_word);
exp[2] += sizeof(WamWord);
break;
}
break;
case NEQUIV:
if (l == ZERO) /* 0 ~<=> R is R */
{
return (WamWord *) exp[2];
}
if (l == ONE) /* 1 ~<=> R is ~R */
{
sp = exp;
return Simplify(-1, re_word);
}
if (r == ZERO) /* L ~<=> 0 is L */
{
sp = sp1;
return (WamWord *) exp[1];
}
if (r == ONE) /* L ~<=> 1 is ~L */
{
sp = exp;
return Simplify(-1, le_word);
}
if (l == NOT) /* ~X ~<=> R is X <=> R */
{
exp[0] = EQUIV;
exp[1] += sizeof(WamWord);
break;
}
if (r == NOT) /* L ~<=> ~X is L <=> X */
{
exp[0] = EQUIV;
exp[2] += sizeof(WamWord);
break;
}
if (IsVar(l) && !IsVar(r)) /* X ~<=> R is X <=> ~R */
{
exp[0] = EQUIV;
sp = sp1;
exp[2] = (WamWord) Simplify(-1, re_word);
break;
}
if (IsVar(r) && !IsVar(l)) /* L ~<=> X is L <=> ~X */
{
exp[0] = EQUIV; /* NB: cannot recover the stack */
exp[1] = (WamWord) Simplify(-1, le_word);
break;
}
break;
case IMPLY:
if (l == ZERO || r == ONE) /* 0 ==> R is 1 , L ==> 1 is 1 */
{
sp = exp;
*sp++ = ONE;
break;
}
if (l == ONE) /* 1 ==> R is R */
{
return (WamWord *) exp[2];
}
if (r == ZERO) /* L ==> 0 is ~L */
return sp = exp, Simplify(-1, le_word);
if (l == NOT) /* ~X ==> R is X \/ R */
{
exp[0] = OR;
exp[1] += sizeof(WamWord);
break;
}
if (r == NOT) /* L ==> ~X is X ==> ~L */
{
exp[1] = exp[2] + sizeof(WamWord);
exp[2] = (WamWord) Simplify(-1, le_word);
break;
}
break;
case NIMPLY:
if (l == ZERO || r == ONE) /* 0 ~==> R is 0 , L ~==> 1 is 0 */
{
sp = exp;
*sp++ = ZERO;
break;
}
if (l == ONE) /* 1 ~==> R is ~R */
{
sp = exp;
return Simplify(-1, re_word);
}
if (r == ZERO) /* L ~==> 0 is L */
{
sp = sp1;
return (WamWord *) exp[1];
}
if (l == NOT) /* ~X ~==> R is X ~\/ R */
{
exp[0] = NOR;
exp[1] += sizeof(WamWord);
break;
}
if (r == NOT) /* L ~==> ~X is L /\ X */
{
exp[0] = AND;
exp[2] += sizeof(WamWord);
break;
}
break;
case AND:
if (l == ZERO || r == ZERO) /* 0 /\ R is 0 , L /\ 0 is 0 */
{
sp = exp;
*sp++ = ZERO;
break;
}
if (l == ONE) /* 1 /\ R is R */
{
return (WamWord *) exp[2];
}
if (r == ONE) /* L /\ 1 is L */
{
sp = sp1;
return (WamWord *) exp[1];
}
if (l == NOT) /* ~X /\ R is R ~==> X */
{
exp[0] = NIMPLY;
word = exp[1];
exp[1] = exp[2];
exp[2] = word + sizeof(WamWord);
break;
}
if (r == NOT) /* L /\ ~X is L ~==> X */
{
exp[0] = NIMPLY;
exp[2] += sizeof(WamWord);
break;
}
break;
case NAND:
if (l == ZERO || r == ZERO) /* 0 ~/\ R is 1 , L ~/\ 0 is 1 */
{
sp = exp;
*sp++ = ONE;
break;
}
if (l == ONE) /* 1 ~/\ R is ~R */
{
sp = exp;
return Simplify(-1, re_word);
}
if (r == ONE) /* L ~/\ 1 is ~L */
{
sp = exp;
return Simplify(-1, le_word);
}
if (l == NOT) /* ~X ~/\ R is R ==> X */
{
exp[0] = IMPLY;
word = exp[1];
exp[1] = exp[2];
exp[2] = word + sizeof(WamWord);
break;
}
if (r == NOT) /* L ~/\ ~X is L ==> X */
{
exp[0] = IMPLY;
exp[2] += sizeof(WamWord);
break;
}
break;
case OR:
if (l == ONE || r == ONE) /* 1 \/ R is 1 , L \/ 1 is 1 */
{
sp = exp;
*sp++ = ONE;
break;
}
if (l == ZERO) /* 0 \/ R is R */
{
return (WamWord *) exp[2];
}
if (r == ZERO) /* L \/ 0 is L */
{
sp = sp1;
return (WamWord *) exp[1];
}
if (l == NOT) /* ~X \/ R is X ==> R */
{
exp[0] = IMPLY;
exp[1] += sizeof(WamWord);
break;
}
if (r == NOT) /* L \/ ~X is X ==> L */
{
exp[0] = IMPLY;
word = exp[1];
exp[1] = exp[2] + sizeof(WamWord);
exp[2] = word;
break;
}
break;
case NOR:
if (l == ONE || r == ONE) /* 1 ~\/ R is 0 , L ~\/ 1 is 0 */
{
sp = exp;
*sp++ = ZERO;
break;
}
if (l == ZERO) /* 0 ~\/ R is ~R */
{
sp = exp;
return Simplify(-1, re_word);
}
if (r == ZERO) /* L ~\/ 0 is ~L */
{
sp = exp;
return Simplify(-1, le_word);
}
if (l == NOT) /* ~X ~\/ R is X ~==> R */
{
exp[0] = NIMPLY;
exp[1] += sizeof(WamWord);
break;
}
if (r == NOT) /* L ~\/ ~X is X ~==> L */
{
exp[0] = NIMPLY;
word = exp[1];
exp[1] = exp[2] + sizeof(WamWord);
exp[2] = word;
break;
}
break;
}
return exp;
}
static CVOID__PROTO(shuntVariables) {
tagged_t *pt = w->trail_top;
node_t *cp = Gc_Aux_Node;
node_t *prevcp = w->node;
try_node_t *alt = fail_alt;
intmach_t i;
tagged_t *limit;
frame_t *frame;
while (ChoiceYounger(cp,Gc_Choice_Start)) {
limit = TagToPointer(prevcp->trail_top);
while (TrailYounger(pt,limit)) {
tagged_t v = TrailPop(pt);
if (v!=0 && IsVar(v) && !gc_IsMarked(*TagToPointer(v)))
gc_MarkM(*TagToPointer(v));
else
gc_MarkM(pt[0]);
}
gc_ReverseChoice(cp,prevcp,alt);
}
while (ChoiceYounger(Gc_Aux_Node,cp)) {
gc_UndoChoice(cp,prevcp,alt);
limit = TagToPointer(cp->trail_top);
pt = TagToPointer(prevcp->trail_top);
while (TrailYounger(limit,pt)) {
tagged_t v = *pt++;
if (!gc_IsMarked(v))
gc_UnmarkM(*TagToPointer(v));
}
pt = TagToPointer(prevcp->trail_top);
while (TrailYounger(limit,pt)) {
tagged_t v = *pt++;
if (gc_IsMarked(v))
gc_UnmarkM(pt[-1]);
else
gc_shuntVariable(*TagToPointer(v));
}
pt = NodeGlobalTop(prevcp);
while (HeapYounger(NodeGlobalTop(cp),pt)) {
tagged_t v = *pt++;
if (v&QMask) pt += LargeArity(v);
else if (!gc_IsMarked(v)) {
if (v==Tag(CVA,pt-1))
gc_MarkM(Cvas_Found),
pt[-1] = Cvas_Found,
Cvas_Found = v,
pt += 2;
else {
gc_shuntVariable(pt[-1]);
}
}
}
i = FrameSize(cp->next_insn);
frame = cp->frame;
while (OffStacktop(frame,NodeLocalTop(prevcp))) {
pt = (tagged_t *)StackCharOffset(frame,i);
while (pt!=frame->term)
if (!gc_IsMarked(*(--pt)))
gc_shuntVariable(*pt);
i = FrameSize(frame->next_insn);
frame = frame->frame;
}
pt = cp->term+OffsetToArity(alt->node_offset);
while (pt!=cp->term) {
--pt;
gc_shuntVariable(*pt);
}
}
}
