/***   clauses.c   ***/

#include "Algol.h"
#include "clauses.h"
#include "coercion.h"
#include "declarer.h"
#include "declaration.h"
#include "routine_call.h"
#include "unit.h"
   /***  ERRORS: 221-3,231-4,241-7,251-5,261-9,271-2,558  ***/


static bool series(int*,bool*,bool*);
static bool label(int);
static void branch(int,int,int*,int*);
static void collateral_clause(int*);
static void choice_clause(int*);
static void choice_boolean(int*,int*);
static void choice_integer(int*,int*);
static void choice_union(int*,int*);
static int  count_units(void);

static bool series(Q,no_label,single_unit) int *Q; bool *no_label,*single_unit;
{int P1,P2,Q1,had_label; bool bl; int u;
	P1=P;
	if(*Q != G){
#if DEBUG
	  fprintf(O,"series, Q=%c, P=%d\n",*Q==H?'H':'F',P);
#endif
	  had_label=1; *single_unit = TRUE;
	  for(;;){
	    while(label(*Q)){had_label=0;}
	    if(had_label==1 && declaration(*Q)){*single_unit=FALSE;}
	     else if(had_label>-1 && unit(Q)){;}
	     else{return(FALSE);}
	    if(inp(GOON)){*single_unit = FALSE;}
	     else if(inp(EXIT)){*single_unit=FALSE; had_label= -1;}
	     else if(inp(COMMA)){;}
	     else{*no_label = (had_label==1); return(TRUE);}
	  }}
	else if(series(&H,no_label,single_unit)){
#if DEBUG
	  fprintf(O,"series, Q=G, P=%d, end=%d\n",P1,P);
#endif
	  P2=P; P=P1; had_label=1;
	  while(P1<=P && P<P2){
	    while(label(*Q)){had_label=0;}
	    Q1= *Q;
	    if(had_label && declaration(Q1)){must(spy(GOON),222);}
	    else{must(unit(&Q1),221);}
	    if(inp(GOON)){
		void_coercion(&Q1);
		if(Q1==F){branch(P1,P2,Q,&Q1);}else{emp();}
		}
	    else if(inp(EXIT)){
		if(Q1==F){branch(P1,P2,Q,&Q1);}else{P=P2;}
		}
	    else if(Q1==F){branch(P1,P2,Q,&Q1);}
	    else if(P<P2)break;
	    if(P==P2 && MORF){  /* check for proc with current range */
		bl= *Q == G;
		while(bl){
		  u=Z;while(A[Z]==REF && C[Z]>0)Z=B[Z];
		  if(A[Z]==PROC && C[Z]==0 && A[B[Z]]>=JGLOB){
		    call_proc(Q); relax(u); bl= *Q==G;
		  }else{Z=u; bl=FALSE;}
		}
		if(*Q==F){branch(P1,P2,Q,&Q1);}
		else{MORF=TRUE;}
	    }
	  }
	  return(TRUE);}
	else{return(FALSE);}
}

static bool label(Q) int Q;
{int Pold,el;
	Pold=P;
	if(inp_tag(&el) && inp(COLON)){
	  if(Q == H){possess(el,-P);}
	  return(TRUE);}
	P=Pold; return(FALSE);
}

static void branch(P1,P2,Q,Q1) int P1,P2,*Q,*Q1;
{	if(P1<PLAB && PLAB<P2){P=PLAB; *Q1 = *Q = G; emp();}
	else{*Q = F; P=P2;}
	return;
}


bool enclosed_clause(Q) int *Q;
{bool result, no_label, single_unit; int Pold, Jold;
	Pold=P;
	if(!inp(OPEN))return(FALSE);
	if(*Q != G){P=match(); return(TRUE);}
#if DEBUG
	fprintf(O,"enclosed_clause, Q=%c, P=%d\n",*Q==G?'G':*Q==H?'H':'F',P);
#endif
	adm_open(&Jold); result=series(Q,&no_label,&single_unit);
	if(result){
	  if(no_label && inp(VERT)){choice_clause(Q); must(inp(CLOSE),241);}
	   else if(single_unit && spy(COMMA)){collateral_clause(Q);}
	   else{must(inp(CLOSE),223);}}
	else{P=Pold;}
	adm_close(Jold);
	return(result);
}

static void collateral_clause(Q) int *Q;
{int n,v,w,i,Q1;
	if(*Q !=G){
	  while(inp(COMMA) && unit(&F)); must(inp(CLOSE),231); return;
	}
	v=ask(); A[v]=COLL; C[v]=n=count_units(); B[v]=w=askn(n); B[w]=Z;
	for(i=1;i<n;i++){
#if DEBUG
	fprintf(O,"display, Q=%c, P=%d\n",*Q==G?'G':*Q==H?'H':'F',P);
#endif
	  must(inp(COMMA),233);Q1= *Q;must(unit(Q),232);B[w+i]= Q1==G?Z:0;
	}
	Z=v; must(inp(CLOSE),234);
	if(*Q != G){emp(); void_result();}
}

static int count_units()
{int Pold,i=1;
	Pold=P;
	while(inp(COMMA) && unit(&F))i++;
	P=Pold;return(i);
}


static void choice_clause(Q) int *Q;
{int Qout; bool no_label;
start:
#if DEBUG
	fprintf(O,"choice clause, Q=%c, P=%d\n",*Q==G?'G':*Q==H?'H':'F',P);
#endif
	meek_coercion(Q);
	if(*Q != G){P=match()-1; return;}
	switch(A[Z]){
	  case BOOL:	choice_boolean(Q,&Qout); break;
	  case INT:	choice_integer(Q,&Qout); break;
	  case UNION:	choice_union(Q,&Qout); break;
	default:	ERROR(558);
	}
	if(Qout == F){P=match()-1; return;}
	if(inp(VERT)){must(series(Q,&bummy,&bummy),242);}
	else if(inp(AGAIN)){
		must(series(Q,&no_label,&bummy),243); must(no_label,246);
		must(inp(VERT),247); goto start;}
        else {void_result();}
}

static void choice_boolean(Q,Qout) int *Q, *Qout;
{bool bl; int Q0,Q1;
	bl=B[Z]==1; emp(); Q0=Q1= bl?G:F;
	must(series(&Q1,&bummy,&bummy),244);
	if(Q1!=Q0){*Q=F;}
	*Qout= bl?F:G;
}

static void choice_integer(Q,Qout) int *Q, *Qout;
{inta n,i; int Q0,Q1;
	n=get_int(Z); emp(); i=0;
	do{ i++; Q0=Q1= i==n?G:F; must(unit(&Q1),245);
	    if(Q0!=Q1){*Q=F;}
	}while(inp(COMMA));
	*Qout= 0<n && n<=i ?F:G;
}

static void choice_union(Q,Qout) int *Q, *Qout;
{int u,v,w,Q0,Q1,Q2,Jold,el;
	u=new_instance(C[Z]); emp(); Q2=G;
	do{ Q0=F; must(inp(OPEN),252); adm_open(&Jold);
	    must(declarer(FORMAL,&w,Q2,TRUE),253);
	    if(Q2==G){
		if(equivalent_or_union_member(u,w)){
		  Q0=G; Q2=F;
		  if(A[w]==UNION){v=new_instance(w);C[v]=u;u=v;}
		}
		relax(w);
	    }
	    el=dummy_tag; inp_tag(&el); if(Q0==G) possess(el,u);
	    must(inp(CLOSE),254); must(inp(COLON),255); Q1=Q0;
	    must(unit(&Q1),251); if(Q0!=Q1){*Q=F;}
	    adm_close(Jold);
	}while(inp(COMMA));
	if(Q2==G)relax(u);
	*Qout=Q2;
}

bool loop(Q0) int *Q0;
{int jold,Pold,el,Q; bool unbnd,cont,no_label; inta f,b,t;
	if(!(spy(FOR)||spy(FROM)||spy(BY)||spy(TO)||spy(WHILE)||spy(DO)))
		return(FALSE);
	Q = *Q0; f=b=1; unbnd=TRUE; el=dummy_tag;
	if(inp(FOR)){must(inp_tag(&el),261);}
	if(inp(FROM)){must(unit(&Q),262); f=meek_integer(&Q);}
	if(inp(BY)){must(unit(&Q),263); b=meek_integer(&Q);}
	if(inp(TO)){must(unit(&Q),264); t=meek_integer(&Q); unbnd=FALSE;}
	if(*Q0 != Q)emp();
	Pold=P;
	if(Q!=G || !(unbnd || b==0 || b<0 && f>=t || b>0 && f<=t)){
	    if(inp(WHILE)){must(series(&F,&bummy,&bummy),265);}
	    must(inp(DO) && inp(OPEN),266); P=match();
	}else{
	    do{ adm_open(&jold); cont=TRUE; P=Pold;
		put_int(f); possess(el,Z);
#if DEBUG
	fprintf(O,"loop, Q=%c, P=%d, i=%ld\n",Q==G?'G':Q==H?'H':'F',P,f);
#endif
		if(inp(WHILE)){
		    must(series(&Q,&no_label,&bummy),267); must(no_label,268);
		    meek_coercion(&Q); must(Q!=G || A[Z]==BOOL,559);
		    cont=Q==G && B[Z]==1; emp();
		}
		must(inp(DO),269);
		if(cont){
		    must(enclosed_clause(&Q),271); void_coercion(&Q); emp();
		}else{
		    must(enclosed_clause(&F),272);
		}
		adm_close(jold); f += b;
	    }while(Q==G && cont && (unbnd || b==0 || b<0 && f>=t || b>0&&f<=t));
	}
	if(*Q0 == G){void_result(); MORF=FALSE;}
	if(*Q0 !=Q)*Q0=F; return(TRUE);
}