/***   unit.c   ***/

#include "algol.h"
#include "unit.h"
#include "coercion.h"
#include "declarer.h"
#include "primary.h"
#include "routine_call.h"	/* execute_operator */
	  /*** ERRORS: 661-3 ***/
	  /*** ERRORS: 531-2 ***/
	  /*** ERRORS: 521-2,551,621-3,631-4,682-5,691-6  ***/
/*----------------------------------------------------------------------*/
/*  secondary   */

static bool generator(int), selection(int*);
#define secondary(Q) (generator(*Q) || selection(Q) || primary(Q))

static bool generator(Q) int Q;
{int v;
	if(inp(LOC)||inp(HEAP)){
	    must(declarer(ACTUAL,&v,Q,TRUE),693);
	    if(Q==G){
		Z=actual_instance(v); relax(v); v=Z;
		Z=new_reference(v); relax(v);}
#if DEBUG
	fprintf(O,"generator, Q=%c, P=%d, Z=%d\n",Q==G?'G':Q==H?'H':'F',P,Z);
#endif
	    return(TRUE);
	}
	return(FALSE);
}

static bool selection(Q) int *Q;
{int Pold, el, i,n,u,Z1; bool name;
	Pold=P;
	if(inp_tag(&el) && inp(OF)){
	    must(secondary(Q),661);
	    if(weak_coercion(Q)){
		Z1=Z; name = A[Z]==REF; if(name)Z=B[Z];
		must(A[Z]==STRUCT,662); u=B[Z]; n=C[Z]; i=0;
		while(i<n && C[u+i]!=el)i++;
		must(i<n,663);
		Z=name?new_reference(B[u+i]):new_instance(B[u+i]);
		relax(Z1);
	    }
#if DEBUG
	fprintf(O,"selection, Q=%c, P=%d, Z=%d\n",
		*Q==G?'G':*Q==H?'H':'F',P,Z);
#endif
	    return(TRUE);
	}
	P=Pold; return(FALSE);
}

/*----------------------------------------------------------------------*/
/*  tertiary   */
  
static bool tertiary(int*);
static bool nil(int), formula(int,int*);
static bool operator(int,int*,int*,int), operand(int*);
static void monadic_operator(int,int*), dyadic_operator(int,int,int*);

static bool tertiary(Q) int *Q;
{	return(nil(*Q) || formula(1,Q));
}

static bool nil(Q) int Q;
{	if(inp(NIL)){
	  if(Q==G){Z=ask(); A[Z]=REF; B[Z]=C[Z]=0; MORF=FALSE;}
	  return(TRUE);
	}
	return(FALSE);
}

static bool formula(prio,Q) int prio, *Q;
{int Q1,op_prio,v,j;
	if(operand(Q)){
	  while(operator(prio,&j,&op_prio,*Q)){
		v=Z; Q1= *Q; must(formula(op_prio+1,Q),692);
		if(*Q == G){dyadic_operator(j,v,Q);}
		else if(Q1 != *Q)relax(v);
	  }
#if DEBUG
	fprintf(O,"formula, Q=%c, P=%d, Z=%d\n",
		*Q==G?'G':*Q==H?'H':'F',P,Z);
#endif
	  return(TRUE);
	}
	return(FALSE);
}

static bool operator(prio,op_j,op_prio,Q) int prio, *op_j, *op_prio, Q;
{int Pold,el;
	if(Q != G )return(inp_ind(&dummy));
	Pold=P; *op_j=J+1;
	if(inp_ind(&el) && further_search(el,prio<10,op_j,op_prio)){
	  if(prio<= *op_prio)return(TRUE);
	}
	P=Pold; return(FALSE);
}

static bool operand(Q) int *Q;
{int j;
	if(operator(10,&j,&dummy,*Q)){
	  must(operand(Q),691);
	  if(*Q == G) monadic_operator(j,Q);
	  return(TRUE);
	}
	return(secondary(Q));
}

static void dyadic_operator(j,v,Q)  int j, v, *Q;
{int el,MP1,MP2,v1,v2,how1,how2,w;
	el=LIND[j]; v1=v; v2=Z;
	do{ w=B[VIND[j]]; MP1=B[w+1]; MP2=A[w+1];}
		while(!(firmly_coerceable(v1,MP1,&how1) && 
			firmly_coerceable(v2,MP2,&how2)) && 
		      further_search(el,TRUE,&j,&dummy));
	must(j>0,532); Z=v1; firm_coercion(MP1,how1,Q); v1=Z;
	if(*Q != G){relax(v2); return;}
	Z=v2; firm_coercion(MP2,how2,Q); v2=Z;
	if(*Q != G){relax(v1); return;}
	execute_operator(2,w,v1,v2,Q);
	relax(v1); relax(v2); MORF=TRUE;
}

static void monadic_operator(j,Q) int j, *Q;
{int el,w,MP,how,u;
	el=LIND[j];
	do{w=B[VIND[j]]; MP=B[w+1];}
	  while(!firmly_coerceable(Z,MP,&how)
		&& further_search(el,FALSE,&j,&dummy));
	must(j>0,531); firm_coercion(MP,how,Q); u=Z;
	if(*Q != G) return;
	execute_operator(1,w,u,dummy,Q);
	relax(u); MORF=TRUE;
}



/*----------------------------------------------------------------------*/
/*  unit   */

static bool skip(int), jump(int*);
static void assignation_tail(int*), identity_relation(int*,int);

bool unit(Q) int *Q;
{
#if DEBUG
	fprintf(O,"unit, Q=%c, P=%d\n",*Q==G?'G':*Q==H?'H':'F',P);
#endif
	if(skip(*Q) || jump(Q))return(TRUE);
	if(spy_declarer() && routine_text(*Q))return(TRUE);
	if(tertiary(Q)){
	  if(inp(BECOMES)){assignation_tail(Q);}
	  else if(inp(IS)){identity_relation(Q,IS);}
	  else if(inp(ISNT)){identity_relation(Q,ISNT);}
	  return(TRUE);
	}
	return(FALSE);
}

bool routine_text(Q) int Q;
{int Pold,v;
	Pold=P;
	if(plan(ACTUAL,&dummy,F) && inp(COLON)){
	  if(Q!=G){must(unit(&F),682); return(TRUE);}
	  P=Pold;
	  must(plan(ACTUAL,&v,Q),684); must(inp(COLON),685);
	  C[B[v]]=P; A[B[v]]=scope(); must(unit(&F),683);
	  Z=v; MORF=TRUE; return(TRUE);
	}
	P=Pold; return(FALSE);
}

static void assignation_tail(Q) int *Q;
{int vd,vc;
	soft_coercion(Q);
	if(*Q == G){
	  must(A[Z]==REF,623); must(C[Z],521); vd=Z; vc=B[vd];
	  must(unit(Q),622); must(strong_coercion(vc,Q),551);
	  if(*Q == G){
		supersede(Z,vc); Z=vd; MORF=FALSE;
	  }else{relax(vd);}
	  return;
	}
	must(unit(&F),621);
}

static void identity_relation(Q,relator) int *Q, relator;
{int u1,u2,Q1,n1,n2,v,w,i;
	if(*Q != G){must(tertiary(&F),631); return;}
	soft_coercion(Q);
	v=u1=Z; Q1 = *Q; must(tertiary(Q),632);
	soft_coercion(Q); w=u2=Z;
	if(*Q != G){ if(Q1==G)relax(u1); return;}
	must(A[u1]==REF,633); must(A[u2]==REF,634);
	if(B[u1]>0 && B[u2]>0){
	    n1=1; while(A[v]==REF){n1++; v=B[v];}
	    n2=1; while(A[w]==REF){n2++; w=B[w];}
	    if((n1=n1-n2)<0){n1= -n1; w=u1; v=u2;}else{v=u1; w=u2;}
	    for(i=0;i<n1;i++){must(C[v],522);v=B[v];}
	}
	Z=ask(); A[Z]=BOOL;
	B[Z]= (C[v]==0?C[w]==0:C[w]==0?FALSE:B[v]==B[w])==(relator == IS);
	relax(u1); relax(u2); MORF=FALSE;
}

static bool skip(Q) int Q;
{	if(inp(SKIP)){
	  if(Q==G){void_result(); MORF=FALSE;}
	  return(TRUE);
	}
	return(FALSE);
}

static bool jump(Q) int *Q;
{int el,j,Pold;
	Pold=P;
	if(inp(GOTO)){
	  must(inp_tag(&el),694);
	  if(*Q != G)return(TRUE);
	  must(search(el,&j),695); must(VIND[j]<0,696);}
	else if(*Q != G ){return(FALSE);}
	else if(!(inp_tag(&el) && search(el,&j) && VIND[j]<0)){
	  P=Pold; return(FALSE);
	}
	*Q = F; PLAB = -VIND[j]; void_result(); MORF=FALSE; return(TRUE);
}