static void chlabs(Term t)
{
if(is_list(t))
{
List l;
for(l=t;l;l=ListTail(l))
{
Term m=ListFirst(l);
if(is_label(m))
ChangeList(l,ListNth(labm,ListMember(labl,m)));
else
chlabs(m);
}
}
if(is_compound(t))
{
int i;
for(i=1;i<=CompoundArity(t);i++)
{
Term m=CompoundArgN(t,i);
if(is_label(m))
SetCompoundArg(t,i,ListNth(labm,ListMember(labl,m)));
else
chlabs(m);
}
}
}
static void lablist(Term t)
{
if(is_list(t))
{
List l;
for(l=t;l;l=ListTail(l))
{
Term m=ListFirst(l);
if(is_label(m) && !ListMember(labl,m))
labl=AppendFirst(labl,m);
else
lablist(m);
}
}
if(is_compound(t))
{
int i;
for(i=1;i<=CompoundArity(t);i++)
{
Term m=CompoundArgN(t,i);
if(is_label(m) && !ListMember(labl,m))
labl=AppendFirst(labl,m);
else
lablist(m);
}
}
}
/*
* FindRandomNodeNotInList finds a random node from the shared hash that is not
* a member of the current node list. The caller is responsible for making the
* necessary node count checks to ensure that such a node exists.
*
* Note that this function has a selection bias towards nodes whose positions in
* the shared hash are sequentially adjacent to the positions of nodes that are
* in the current node list. This bias follows from our decision to first pick a
* random node in the hash, and if that node is a member of the current list, to
* simply iterate to the next node in the hash. Overall, this approach trades in
* some selection bias for simplicity in design and for bounded execution time.
*/
static WorkerNode *
FindRandomNodeNotInList(HTAB *WorkerNodesHash, List *currentNodeList)
{
WorkerNode *workerNode = NULL;
HASH_SEQ_STATUS status;
uint32 workerNodeCount = 0;
uint32 currentNodeCount PG_USED_FOR_ASSERTS_ONLY = 0;
bool lookForWorkerNode = true;
uint32 workerPosition = 0;
uint32 workerIndex = 0;
workerNodeCount = hash_get_num_entries(WorkerNodesHash);
currentNodeCount = list_length(currentNodeList);
Assert(workerNodeCount > currentNodeCount);
/*
* We determine a random position within the worker hash between [1, N],
* assuming that the number of elements in the hash is N. We then get to
* this random position by iterating over the worker hash. Please note that
* the random seed has already been set by the postmaster when starting up.
*/
workerPosition = (random() % workerNodeCount) + 1;
hash_seq_init(&status, WorkerNodesHash);
for (workerIndex = 0; workerIndex < workerPosition; workerIndex++)
{
workerNode = (WorkerNode *) hash_seq_search(&status);
}
while (lookForWorkerNode)
{
bool listMember = ListMember(currentNodeList, workerNode);
if (workerNode->inWorkerFile && !listMember)
{
lookForWorkerNode = false;
}
else
{
/* iterate to the next worker node in the hash */
workerNode = (WorkerNode *) hash_seq_search(&status);
/* reached end of hash; start from the beginning */
if (workerNode == NULL)
{
hash_seq_init(&status, WorkerNodesHash);
workerNode = (WorkerNode *) hash_seq_search(&status);
}
}
}
/* we stopped scanning before completion; therefore clean up scan */
hash_seq_term(&status);
return workerNode;
}
static List alg1_w_ind(Term m1, List wf)
{
List l1,l2,wi,wn;
wi=wn=NewList();
l2=CompoundArgN(m1,3);
while(!is_empty_list(l2))
{
List l3;
l3=CompoundArg1(ListFirst(l2));
while(!is_empty_list(l3))
{
Atomic t1,t2;
t1=ListFirst(l3);
t2=CompoundArg2(t1);
if(CompoundName(t1)==OPR_WILD &&
!ListMember(wf,t2) && !ListMember(wi,t2))
{
wi=AppendLast(wi,t2);
wn=AppendLast(wn,CompoundArgN(t1,3));
}
l3=ListTail(l3);
}
l2=ListTail(l2);
}
l1=wi;
l2=wn;
while(!is_empty_list(l1))
{
ChangeList(l1,MakeCompound2(OPR_DIV,ListFirst(l1),ListFirst(l2)));
l1=ListTail(l1);
l2=ListTail(l2);
}
RemoveList(wn);
return wi;
}
static int set_ppl(void)
{
List l;
if(PROP_PPL==0) PROP_PPL=NewAtom("pprtlst",0);
if(prop_gened)
return 1;
if(vlist==0)
{
vlist=all_vert_list();
for(l=vlist; !is_empty_list(l); l=ListTail(l))
{
Term a2;
a2=ListFirst(l);
alg2_common_s(a2);
alg2_common_n(a2);
alg2_red_cos(a2);
alg2_red_orth(a2);
}
}
for(l=vlist; !is_empty_list(l); l=ListTail(l))
{
List pl,l1,l2,lr;
pl=CompoundArg1(ListFirst(l));
if(ListLength(pl)<3 || CompoundArg2(ListFirst(l))==NewInteger(0) ||
is_empty_list(CompoundArgN(ListFirst(l),5)))
continue;
#ifdef DBG_PPL
WriteVertex(pl); printf(": ");
#endif
l1=pl;
while(!is_empty_list(l1))
{
Atom pp,app;
Term prop;
pp=CompoundArg1(ListFirst(l1));
prop=GetAtomProperty(pp,PROP_TYPE);
app=remcc(pp);
if(!ListMember(plist,app))
plist=AppendFirst(plist,app);
#ifdef DBG_PPL
WriteTerm(app); printf(" -> ");
#endif
lr=NewList();
l2=pl;
while(!is_empty_list(l2))
{
Atom a;
if(l2==l1)
{
l2=ListTail(l2);
continue;
}
a=remcc(CompoundArg1(ListFirst(l2)));
lr=AppendLast(lr,a);
l2=ListTail(l2);
}
prop=GetAtomProperty(app,PROP_PPL);
if(prop==0)
SetAtomProperty(app,PROP_PPL,AppendFirst(NewList(),lr));
else
AppendLast(prop,lr);
#ifdef DBG_PPL
WriteTerm(lr); printf(" ");
#endif
while(!is_empty_list(l1) &&
remcc(CompoundArg1(ListFirst(l1)))==app)
l1=ListTail(l1);
}
#ifdef DBG_PPL
puts("");
#endif
}
if(ListLength(plist)>1)
plist=SortedList(plist,p__cmp);
prop_gened=1;
return 1;
}
void alg1_opt_let(Term a1)
{
List l,l1,l2,lm=ConsumeCompoundArg(a1,1);
List nl=0;
Label mylbl=NewLabel();
/*printf("%d -> ",ListLength(lm));*/
for(l=lm;l;l=ListTail(l))
{
Term m1=ListFirst(l);
int n,d,g;
List ln=ConsumeCompoundArg(m1,3);
List ld=ConsumeCompoundArg(m1,4);
Term f1=0, f2=0, w=0;
n=IntegerValue(CompoundArg1(m1));
d=IntegerValue(CompoundArg2(m1));
rpt1:
for(l1=ld;l1;l1=ListTail(l1))
{
int n=ListMember(ln,ListFirst(l1));
if(n)
{
ld=CutFromList(ld,l1);
l1=ListNthList(ln,n);
ln=CutFromList(ln,l1);
goto rpt1;
}
if(CompoundArg2(ListFirst(l1))==A_SQRT2)
{
Term t=ListFirst(l1);
ChangeList(l1,0);
ld=CutFromList(ld,l1);
ln=AppendFirst(ln,t);
d*=2;
goto rpt1;
}
}
rpt2:
for(l1=ln;l1;l1=ListTail(l1))
if(CompoundArg2(ListFirst(l1))==A_SQRT2)
{
List l2;
for(l2=ListTail(l1);l2;l2=ListTail(l2))
if(CompoundArg2(ListFirst(l2))==A_SQRT2)
{
ln=CutFromList(ln,l1);
ln=CutFromList(ln,l2);
n*=2;
goto rpt2;
}
}
g=gcf(n,d);
n/=g;
d/=g;
for(l1=ln;l1;l1=l1?ListTail(l1):0)
{
Term sp=ListFirst(l1);
if(CompoundName(sp)==OPR_PARAMETER)
continue;
if(CompoundName(sp)==OPR_FIELD)
{
if(f1==0)
f1=l1;
else if(f2==0)
f2=l1;
else
{
ErrorInfo(1280);
puts("bad let-sub: >2 prtc");
return;
}
continue;
}
if(CompoundName(sp)==OPR_WILD)
{
if(w)
{
ErrorInfo(1281);
puts("bad let-sub: unk spec");
return;
}
w=l1;
continue;
}
ErrorInfo(110);
WriteTerm(sp);puts(" : bad let: unk stuff");
return;
}
if(f2==0)
{
ErrorInfo(112);
puts("bad let-subs: not 2 prtc");
return;
}
l1=f1;f1=ListFirst(f1);ChangeList(l1,0);ln=CutFromList(ln,l1);
l1=f2;f2=ListFirst(f2);ChangeList(l1,0);ln=CutFromList(ln,l1);
if(w)
{l1=w;w=ListFirst(w);ChangeList(l1,0);ln=CutFromList(ln,l1);}
ln=SortedList(ln,prmcmp);
ld=SortedList(ld,prmcmp);
if((GetAtomProperty(CompoundArg2(f1),A_ANTI)==CompoundArg2(f1) ||
GetAtomProperty(CompoundArg2(f2),A_ANTI)==CompoundArg2(f2))
&& strcmp(AtomValue(CompoundArg2(f1)),AtomValue(CompoundArg2(f2)))>0)
{
Term tmp=f1;
f1=f2;
f2=tmp;
}
if(ListLength(CompoundArg1(f1))==1 && ListLength(CompoundArg1(f1))==1)
{
Term i1=ListFirst(CompoundArg1(f1));
Term i2=ListFirst(CompoundArg1(f2));
if(CompoundName(CompoundArg1(i1))!=A_COLOR ||
CompoundName(CompoundArg1(i2))!=A_COLOR ||
CompoundArg2(i1)!=CompoundArg2(i2))
{
ErrorInfo(233);
puts("bad color stru in let-sub.");
return;
}
SetCompoundArg(i1,2,mylbl);
SetCompoundArg(i2,2,mylbl);
}
ln=AppendLast(ln,f1);
ln=AppendLast(ln,f2);
if(w) ln=AppendLast(ln,w);
SetCompoundArg(m1,1,NewInteger(n));
SetCompoundArg(m1,2,NewInteger(d));
SetCompoundArg(m1,3,ln);
SetCompoundArg(m1,4,ld);
for(l1=nl;l1;l1=ListTail(l1))
{
if(EqualTerms(CompoundArgN(ListFirst(l1),3),ln) &&
EqualTerms(CompoundArgN(ListFirst(l1),4),ld) &&
IntegerValue(CompoundArg2(ListFirst(l1)))*d>0)
{
Term om1=ListFirst(l1);
int n1=IntegerValue(CompoundArg1(om1));
int d1=IntegerValue(CompoundArg2(om1));
int rn,rd,cc=0;
if(d1<0)
{
d=-d;d1=-d1;cc=1;
}
rn=n*d1+n1*d;
rd=d*d1;
if(rn==0)
{
nl=CutFromList(nl,l1);
break;
}
g=gcf(rn,rd);
rn/=g; rd/=g;
if(cc) rd=-rd;
SetCompoundArg(om1,1,NewInteger(rn));
SetCompoundArg(om1,2,NewInteger(rd));
FreeAtomic(m1);
break;
}
}
if(l1==0)
nl=AppendLast(nl,m1);
}
RemoveList(lm);
/*DumpList(nl);*/
/*printf("%d\n",ListLength(nl));*/
SetCompoundArg(a1,1,nl);
}
Term ProcLet(Term t, Term ind)
{
Term t1,nm,sub,kl=0;
List il,ol,l1;
int transf_fl=0;
Atom anti1=0, anti2=0;
ol=il=NewList();
t1=ConsumeCompoundArg(t,1);
FreeAtomic(t);
t1=ProcessAlias(t1);
if(is_compound(t1) && CompoundArity(t1)==2 && CompoundName(t1)==OPR_COMMA)
{
Term a1,a2;
a1=ConsumeCompoundArg(t1,1);
a2=ConsumeCompoundArg(t1,2);
FreeAtomic(t1);
ProcLet(MakeCompound1(OPR_LET,a1),0);
ProcLet(MakeCompound1(OPR_LET,a2),0);
return 0;
}
if(!is_compound(t1) || CompoundArity(t1)!=2 ||
(CompoundName(t1)!=OPR_EQSIGN && CompoundName(t1)!=OPR_RARROW))
{
ErrorInfo(325);
printf("bad argument in let statement\n");
return 0;
}
if(CompoundName(t1)==OPR_EQSIGN && is_atom(CompoundArg1(t1)) &&
is_atom(CompoundArg2(t1)) &&
(CompoundArg2(t1)==A_GAMMA5 || GetAtomProperty(CompoundArg2(t1),
A_GAMMA5)))
{
SetAtomProperty(CompoundArg1(t1),A_GAMMA5,NewInteger(1));
}
if(CompoundName(t1)==OPR_RARROW)
transf_fl=1;
if(CompoundName(t1)==OPR_EQSIGN && is_atom(CompoundArg1(t1)) &&
is_compound(CompoundArg2(t1)) &&
CompoundName(CompoundArg2(t1))==A_ANTI &&
is_atom(CompoundArg1(CompoundArg2(t1))))
{
anti1=CompoundArg1(t1);
anti2=CompoundArg1(CompoundArg2(t1));
}
nm=ConsumeCompoundArg(t1,1);
sub=ConsumeCompoundArg(t1,2);
FreeAtomic(t1);
if(transf_fl)
allow_transf_lets=0;
if(is_compound(nm) && (CompoundName(nm)==OPR_USCORE ||
CompoundName(nm)==OPR_CARET))
nm=SplitIndices(nm,&il);
if(!is_atom(nm))
{
ErrorInfo(325);
printf("bad left argument in let call\n");
FreeAtomic(sub);
FreeAtomic(t1);
return 0;
}
if(transf_fl)
{
if(!is_parameter(nm) && !is_particle(nm,NULL))
{
ErrorInfo(728);
printf("Unknown object '%s'.\n",AtomValue(nm));
return 0;
}
}
if(GetAtomProperty(nm,A_KEEP_LETS))
{
Term prp;
kl=ExprTo1kl(CopyTerm(sub));
if(kl==0)
return 0;
prp=GetAtomProperty(nm,A_KEEP_LETS);
SetCompoundArg(prp,1,kl);
}
sub=ExprTo1(sub);
alg1_set_cos0(sub);
if(sub==0)
return 0;
if(transf_fl)
allow_transf_lets=1;
t1=CopyTerm(CompoundArg2(sub));
if(is_empty_list(il))
{
l1=t1;
while(!is_empty_list(l1))
{
Term t;
t=CompoundArg2(ListFirst(l1));
if(!is_label(t))
{
ErrorInfo(326);
printf("unbalanced index '");
WriteTerm(t);
printf("' in let statement\n");
FreeAtomic(sub);
FreeAtomic(t1);
FreeAtomic(ol);
return 0;
}
ol=AppendLast(ol,t);
l1=ListTail(l1);
}
/* mk_let(nm,sub,ol,t1); */
}
else
{
List t2;
t2=0;
if(ListLength(il)!=ListLength(t1))
{
ErrorInfo(327);
printf("distinct indices number ");
printf("in let statement.\n");
FreeAtomic(sub);
FreeAtomic(t1);
return 0;
}
l1=t1;
while(!is_empty_list(l1))
{
Term t;
t=CompoundArg2(ListFirst(l1));
if(!is_atom(t) || !ListMember(il,t))
{
ErrorInfo(326);
printf("unbalanced index '");
WriteTerm(t);
printf("' in let statement\n");
FreeAtomic(sub);
FreeAtomic(t1);
FreeAtomic(ol);
return 0;
}
ol=AppendLast(ol,t);
l1=ListTail(l1);
}
l1=il;
while(!is_empty_list(l1))
{
List l2;
if(!ListMember(ol,ListFirst(l1)))
{
ErrorInfo(326);
printf("unbalanced index '");
WriteTerm(t);
printf("' in let statement\n");
FreeAtomic(sub);
FreeAtomic(t1);
FreeAtomic(ol);
return 0;
}
for(l2=t1;l2;l2=ListTail(l2))
if(ListFirst(l1)==CompoundArg2(ListFirst(l2)))
{
t2=AppendLast(t2,ListFirst(l2));
break;
}
l1=ListTail(l1);
}
RemoveList(t1);
t1=t2;
FreeAtomic(ol);
ol=il;
}
/* mk_let(nm,sub,ol,t1); */
l1=t1;
while(!is_empty_list(l1))
{
SetCompoundArg(ListFirst(l1),2,0);
l1=ListTail(l1);
}
/*WriteTerm(sub); puts(""); getchar();*/
t=MakeCompound(OPR_LET,5);
SetCompoundArg(t,1,sub);
SetCompoundArg(t,2,ol);
SetCompoundArg(t,3,alg1_inv_alg(sub));
if(transf_fl==0)
{
Term tt;
tt=alg1_guess_mpl(sub);
if(tt)
{
SetCompoundArg(t,4,NewInteger(1));
SetCompoundArg(t,5,tt);
}
else
{
int tp;
tt=alg1_guess_mtr(sub, &tp);
if(tt)
{
SetCompoundArg(t,4,NewInteger(tp));
SetCompoundArg(t,5,tt);
}
}
ReportRedefined(nm,"let-substitution");
SetAtomProperty(nm,PROP_INDEX,t1);
SetAtomProperty(nm,PROP_TYPE,t);
alg1_let_cw(nm);
if(anti1 && anti2)
{
SetAtomProperty(anti1,A_ANTI,anti2);
SetAtomProperty(anti2,A_ANTI,anti1);
}
else
if(only_prm(CompoundArg1(t)))
SetAtomProperty(nm,A_ANTI,nm);
return 0;
}
l1=GetAtomProperty(nm,PROP_INDEX);
if(!EqualTerms(l1,t1))
{
ErrorInfo(729);
puts("transformed object has other indices types");
return 0;
}
if(GetAtomProperty(nm,OPR_LET))
{
WarningInfo(0);
printf("Warning: transformation rule for '%s' is redefined.\n",
AtomValue(nm));
}
SetAtomProperty(nm,OPR_LET,t);
return 0;
}
static void repl_ind(Term a2, List oi, List ni)
{
List l1,l2,l3,oii=0,nii=0;
a2=CompoundArg1(a2);
for(l1=a2;l1;l1=ListTail(l1))
for(l2=CompoundArgN(ListFirst(l1),3);l2;l2=ListTail(l2))
for(l3=CompoundArg1(ListFirst(l2));l3;l3=ListTail(l3))
{
Label la;
la=CompoundArg2(ListFirst(l3));
if(!ListMember(oi,la) && !ListMember(oii,la))
oii=AppendLast(oii,la);
}
for(l1=oii;l1;l1=ListTail(l1))
nii=AppendLast(nii,NewLabel());
while(!is_empty_list(a2))
{
List t;
t=CompoundArgN(ListFirst(a2),3);
while(!is_empty_list(t))
{
List t1;
t1=CompoundArg1(ListFirst(t));
while(!is_empty_list(t1))
{
Term a;
List loi,lni;
a=CompoundArg2(ListFirst(t1));
loi=oi;
lni=ni;
while(!is_empty_list(loi))
{
if(a==ListFirst(loi))
{
SetCompoundArg(ListFirst(t1),2,CompoundArg2(ListFirst(lni)));
break;
}
loi=ListTail(loi);
lni=ListTail(lni);
}
if(!loi)
{
loi=oii;
lni=nii;
while(!is_empty_list(loi))
{
if(a==ListFirst(loi))
{
SetCompoundArg(ListFirst(t1),2,ListFirst(lni));
break;
}
loi=ListTail(loi);
lni=ListTail(lni);
}
}
t1=ListTail(t1);
}
t=ListTail(t);
}
a2=ListTail(a2);
}
RemoveList(oii);
RemoveList(nii);
return ;
}
void alg2_common_t(Term a2)
{
List ct, l1,l2,l3,l4, ml, gct, vil=0;
ct=NewList();
ml=CompoundArgN(a2,5);
if(is_empty_list(ml) || (ListLength(ml)==1 && FAOutput==0) )
return;
gct=CompoundArgN(ListFirst(ml),3);
if(is_empty_list(gct))
return;
if(FAOutput)
{
for(l1=CompoundArg1(a2);l1;l1=ListTail(l1))
if(CompoundName(CompoundArg2(ListFirst(l1)))==OPR_VECTOR ||
CompoundName(CompoundArg2(ListFirst(l1)))==OPR_SPINOR)
vil=AppendLast(vil,ListFirst(CompoundArg1(
CompoundArg2(ListFirst(l1)))));
}
l1=gct;
while(!is_empty_list(l1))
{
Term spt;
spt=ListFirst(l1);
if(FAOutput)
{
Term pr;
if(CompoundName(spt)==A_MOMENT)
goto cnt1;
if((is_atom(CompoundArg1(spt))&&
(pr=GetAtomProperty(CompoundArg1(spt),A_INFINITESIMAL))))
goto cnt1;
if(CompoundName(spt)==OPR_SPECIAL)
{
l2=CompoundArg1(spt);
if(l2==A_GAMMA||l2==A_GAMMA5||l2==A_GAMMAP||l2==A_GAMMAM)
goto cnt1;
}
if(vil && CompoundName(spt)==OPR_SPECIAL && CompoundArg1(spt)==A_DELTA)
{
l2=CompoundArg2(spt);
if(ListMember(vil,ListFirst(l2)))
goto cnt1;
if(ListMember(vil,ListFirst(ListTail(l2))))
goto cnt1;
}
}
l2=ListTail(ml);
while(!is_empty_list(l2))
{
l3=CompoundArgN(ListFirst(l2),3);
while(!is_empty_list(l3))
{
if(EqualTerms(spt,ListFirst(l3)))
break;
l3=ListTail(l3);
}
if(is_empty_list(l3))
goto cnt1;
l2=ListTail(l2);
}
ct=AppendLast(ct,CopyTerm(spt));
cnt1:
l1=ListTail(l1);
}
if(is_empty_list(ct))
return;
l1=ml;
while(!is_empty_list(l1))
{
Term m2;
m2=ListFirst(l1);
l2=ConsumeCompoundArg(m2,3);
l3=ct;
while(!is_empty_list(l3))
{
Term rt;
rt=ListFirst(l3);
l4=l2;
while(!is_empty_list(l4))
{
if(EqualTerms(ListFirst(l4),rt))
{
l2=CutFromList(l2,l4);
goto cnt2;
}
l4=ListTail(l4);
}
puts("Internal error (a2ctf).");
cnt2:
l3=ListTail(l3);
}
SetCompoundArg(m2,3,l2);
l1=ListTail(l1);
}
SetCompoundArg(a2,4,ct);
}
