int valueExpression(List *lp, double *wp) {
double w;
if ( !valueTerm(lp,wp) ) {
return 0;
}
w = *wp;
while ( *lp != NULL ) {
if ( acceptCharacter(lp,'+') ) {
if ( valueTerm(lp,wp) ) {
w = w+(*wp);
} else {
return 0;
}
} else if ( acceptCharacter(lp,'-') ) {
if ( valueTerm(lp,wp) ) {
w = w-(*wp);
} else {
return 0;
}
} else {
*wp = w;
return 1;
}
}
*wp = w;
return 1;
}
static void
cp_unmark(Word p, int flags ARG_LD)
{ term_agenda agenda;
initTermAgenda(&agenda, 1, p);
while((p=nextTermAgenda(&agenda)))
{ again:
switch(tag(*p))
{ case TAG_ATTVAR:
{ if ( flags & COPY_ATTRS )
{ p = valPAttVar(*p);
goto again;
}
}
case TAG_VAR:
{ *p &= ~BOTH_MASK;
continue;
}
case TAG_COMPOUND:
{ Functor f = valueTerm(*p);
if ( visited(f->definition) )
{ f->definition &= ~BOTH_MASK;
pushWorkAgenda(&agenda, arityFunctor(f->definition), f->arguments);
continue;
}
}
}
}
clearTermAgenda(&agenda);
}
Word
dict_lookup_ptr(word dict, word name ARG_LD)
{ Functor data = valueTerm(dict);
int arity = arityFunctor(data->definition);
int l = 1, h = arity/2;
if ( arity == 1 )
return NULL; /* empty */
assert(arity%2 == 1);
for(;;)
{ int m = (l+h)/2;
Word p;
deRef2(&data->arguments[m*2], p);
if ( *p == name )
return p-1;
if ( l == h )
return NULL;
if ( *p < name )
l=m+1;
else if ( m == l )
h=m;
else
h=m-1;
}
}
static void
update_ground(Word p ARG_LD)
{ Functor t = valueTerm(*p);
int arity = arityFunctor(t->definition);
Word a = &t->arguments[arity];
int ground = TRUE;
while(--a >= t->arguments)
{ if ( !can_share(a PASS_LD) )
{ ground = FALSE;
break;
}
}
if ( ground )
set_ground(t->definition);
}
static int
mark_for_duplicate(Word p, int flags ARG_LD)
{ term_agenda agenda;
initTermAgenda(&agenda, 1, p);
while((p=nextTermAgenda(&agenda)))
{
again:
switch(tag(*p))
{ case TAG_ATTVAR:
{ if ( flags & COPY_ATTRS )
{ p = valPAttVar(*p);
goto again;
}
/*FALLTHROUGH*/
}
case TAG_VAR:
{ if ( virgin(*p) )
set_visited(*p);
else if ( visited_once(*p) )
set_shared(*p);
break;
}
case TAG_COMPOUND:
{ Functor t = valueTerm(*p);
int arity = arityFunctor(t->definition);
if ( virgin(t->definition) )
{ set_visited(t->definition);
} else
{ if ( visited_once(t->definition) )
set_shared(t->definition);
break;
}
if ( !pushWorkAgenda(&agenda, arity, t->arguments) )
return MEMORY_OVERFLOW;
continue;
}
}
}
clearTermAgenda(&agenda);
return TRUE;
}
static void
unshare_attvar(Word p ARG_LD)
{ for(;;)
{ deRef(p);
if ( isTerm(*p) )
{ Functor t = valueTerm(*p);
word fd = (t->definition & ~BOTH_MASK);
if ( fd == FUNCTOR_att3 )
{ t->definition = fd | MARK_MASK;
p = &t->arguments[2];
}
} else
{ break;
}
}
}
static int
can_share(Word p ARG_LD)
{
again:
switch(tag(*p))
{ case TAG_VAR:
case TAG_ATTVAR:
return FALSE;
case TAG_REFERENCE:
p = unRef(*p);
goto again;
case TAG_COMPOUND:
{ Functor t = valueTerm(*p);
return ground(t->definition);
}
default:
return TRUE;
}
}
static int
get_dict_ex(term_t t, Word dp, int ex ARG_LD)
{ Word p = valTermRef(t);
deRef(p);
if ( isTerm(*p) )
{ Functor f = valueTerm(*p);
FunctorDef fd = valueFunctor(f->definition);
if ( fd->name == ATOM_dict &&
fd->arity%2 == 1 ) /* does *not* validate ordering */
{ *dp = *p;
return TRUE;
}
}
if ( !ex )
return FALSE;
PL_type_error("dict", t);
return FALSE;
}
static int
get_create_dict_ex(term_t t, term_t dt ARG_LD)
{ Word p = valTermRef(t);
deRef(p);
if ( isTerm(*p) )
{ Functor f = valueTerm(*p);
FunctorDef fd = valueFunctor(f->definition);
if ( fd->name == ATOM_dict &&
fd->arity%2 == 1 ) /* does *not* validate ordering */
{ *valTermRef(dt) = *p;
return TRUE;
}
}
if ( PL_get_dict_ex(t, 0, dt, DICT_GET_ALL) )
{ assert(isTerm(*valTermRef(dt)));
return TRUE;
}
return PL_type_error("dict", t);
}
static int
copy_term(Word from, Word to, int flags ARG_LD)
{ term_agendaLR agenda;
int rc = TRUE;
initTermAgendaLR(&agenda, 1, from, to);
while( nextTermAgendaLR(&agenda, &from, &to) )
{
again:
switch(tag(*from))
{ case TAG_REFERENCE:
{ Word p2 = unRef(*from);
if ( *p2 == VAR_MARK ) /* reference to a copied variable */
{ *to = makeRef(p2);
} else
{ from = p2; /* normal reference */
goto again;
}
continue;
}
case TAG_VAR:
{ if ( shared(*from) )
{ *to = VAR_MARK;
*from = makeRef(to);
TrailCyclic(from PASS_LD);
} else
{ setVar(*to);
}
continue;
}
case TAG_ATTVAR:
if ( flags©_ATTRS )
{ Word p = valPAttVar(*from);
if ( isAttVar(*p) ) /* already copied */
{ *to = makeRefG(p);
} else
{ Word attr;
if ( !(attr = alloc_attvar(PASS_LD1)) )
{ rc = GLOBAL_OVERFLOW;
goto out;
}
TrailCyclic(p PASS_LD);
TrailCyclic(from PASS_LD);
*from = consPtr(attr, STG_GLOBAL|TAG_ATTVAR);
*to = makeRefG(attr);
from = p;
to = &attr[1];
goto again;
}
} else
{ if ( shared(*from) )
{ Word p = valPAttVar(*from & ~BOTH_MASK);
if ( *p == VAR_MARK )
{ *to = makeRef(p);
} else
{ *to = VAR_MARK;
*from = consPtr(to, STG_GLOBAL|TAG_ATTVAR)|BOTH_MASK;
TrailCyclic(p PASS_LD);
TrailCyclic(from PASS_LD);
}
} else
{ setVar(*to);
}
}
continue;
case TAG_COMPOUND:
{ Functor ff = valueTerm(*from);
if ( isRef(ff->definition) )
{ *to = consPtr(unRef(ff->definition), TAG_COMPOUND|STG_GLOBAL);
continue;
}
if ( ground(ff->definition) )
{ *to = *from;
continue;
}
if ( shared(ff->definition) )
{ int arity = arityFunctor(ff->definition);
Functor ft;
if ( !(ft = (Functor)allocGlobalNoShift(arity+1)) )
{ rc = GLOBAL_OVERFLOW;
goto out;
}
ft->definition = ff->definition & ~BOTH_MASK;
ff->definition = makeRefG((Word)ft);
TrailCyclic(&ff->definition PASS_LD);
*to = consPtr(ft, TAG_COMPOUND|STG_GLOBAL);
if ( pushWorkAgendaLR(&agenda, arity, ff->arguments, ft->arguments) )
continue;
rc = MEMORY_OVERFLOW;
goto out;
} else /* unshared term */
{ int arity = arityFunctor(ff->definition);
Functor ft;
if ( !(ft = (Functor)allocGlobalNoShift(arity+1)) )
{ rc = GLOBAL_OVERFLOW;
goto out;
}
ft->definition = ff->definition & ~BOTH_MASK;
*to = consPtr(ft, TAG_COMPOUND|STG_GLOBAL);
if ( pushWorkAgendaLR(&agenda, arity, ff->arguments, ft->arguments) )
continue;
rc = MEMORY_OVERFLOW;
goto out;
}
}
default:
*to = *from;
continue;
}
}
out:
clearTermAgendaLR(&agenda);
return rc;
}
static int
mark_for_copy(Word p, int flags ARG_LD)
{ Word start = p;
int walk_ref = FALSE;
Word buf[1024];
segstack stack;
initSegStack(&stack, sizeof(Word), sizeof(buf), buf);
for(;;)
{ switch(tag(*p))
{ case TAG_ATTVAR:
{ if ( flags & COPY_ATTRS )
{ if ( !pushForMark(&stack, p, walk_ref) )
{ clearSegStack(&stack);
return MEMORY_OVERFLOW;
}
walk_ref = TRUE;
p = valPAttVar(*p);
continue;
}
/*FALLTHROUGH*/
}
case TAG_VAR:
{ if ( virgin(*p) )
set_visited(*p);
else if ( visited_once(*p) )
set_shared(*p);
break;
}
case TAG_REFERENCE:
{ if ( !pushForMark(&stack, p, walk_ref) )
{ clearSegStack(&stack);
return MEMORY_OVERFLOW;
}
walk_ref = TRUE;
deRef(p);
continue;
}
case TAG_COMPOUND:
{ Functor t = valueTerm(*p);
int arity = arityFunctor(t->definition);
if ( virgin(t->definition) )
{ set_visited(t->definition);
} else
{ if ( visited_once(t->definition) )
set_shared(t->definition);
break;
}
if ( arity >= 1 )
{ if ( !pushForMark(&stack, p, walk_ref) )
{ clearSegStack(&stack);
return MEMORY_OVERFLOW;
}
walk_ref = FALSE;
p = &t->arguments[arity-1]; /* last argument */
continue;
}
}
}
if ( p == start )
{ clearSegStack(&stack);
return TRUE;
}
while ( walk_ref )
{ popForMark(&stack, &p, &walk_ref);
if ( isAttVar(*p) )
{ Word ap = valPAttVar(*p);
unshare_attvar(ap PASS_LD);
}
if ( p == start )
{ clearSegStack(&stack);
return TRUE;
}
}
p--;
if ( tagex(*p) == (TAG_ATOM|STG_GLOBAL) )
{ popForMark(&stack, &p, &walk_ref);
update_ground(p PASS_LD);
}
}
}
{ if ( unlikely(tTop+1 >= tMax) )
return TRAIL_OVERFLOW;
setVar(*dp);
Trail(val, makeRef(dp));
} else
{ *dp = makeRef(val);
}
}
return TRUE;
}
int
put_dict(word dict, int size, Word nv, word *new_dict ARG_LD)
{ Functor data = valueTerm(dict);
int arity = arityFunctor(data->definition);
Word new, out, in, in_end, nv_end;
int modified = FALSE;
assert(arity%2 == 1);
if ( size == 0 )
{ *new_dict = dict;
return TRUE;
}
if ( gTop+1+arity+2*size > gMax )
return GLOBAL_OVERFLOW;
new = gTop;
