/***   primary.c   ***/

#include "Algol.h"
#include "primary.h"
#include "clauses.h"
#include "coercion.h"
#include "declarer.h"
#include "routine_call.h"	/* call_tail */
#include "unit.h"
   /*** ERRORS: 481,555,611-3,641-4 ***/

static bool denotation(int);
static bool identifier(int);
static bool vacuum(int);
static bool cast(int*);
static void slice_tail(int*);

bool primary(Q) int *Q;
{bool pr;
	pr=denotation(*Q) || identifier(*Q) || cast(Q) ||
		vacuum(*Q) || enclosed_clause(Q) || loop(Q);
	if(!pr)return(FALSE);
	while(inp(OPEN)){
	    if(weak_coercion(Q)){
		if(A[Z]==PROC){call_tail(Q);}else{slice_tail(Q);}
	    }else{P=match();}
	}
#if DEBUG
	fprintf(O,"primary, Q=%c, P=%d, Z=%d\n",*Q==G?'G':*Q==H?'H':'F',P,Z);
#endif
	return(TRUE);
}

static bool denotation(Q) int Q;
{int d;
	if(inp_denoter(&d)){if(Q==G)put_denoter(d);}
	else if(inp(DTRUE)){if(Q==G)put_bool(TRUE);}
	else if(inp(DFALSE)){if(Q==G)put_bool(FALSE);}
	else if(inp(EMPTY)){if(Q==G)void_result();}
	else return(FALSE);
	MORF=FALSE; return(TRUE);
}

static bool identifier(Q) int Q;
{int el,j;
	if(!inp_tag(&el))return(FALSE);
	if(Q==G){
	    must(search(el,&j),611); Z=VIND[j]; must(Z>0,613);
	    more_instance(Z); MORF=TRUE;
	} return(TRUE);
}

static bool vacuum(Q) int Q;
{int Pold;
	Pold=P;
	if(inp(OPEN) && inp(CLOSE)){
	    if(Q==G){void_result(); MORF=FALSE;}
	    return(TRUE);
	}
	P=Pold; return(FALSE);
}

static bool cast(Q) int *Q;
{int t,Q0;
	if(declarer(FORMAL,&t,*Q,FALSE)){
	    Q0 = *Q; must(enclosed_clause(Q),481);
	    must(strong_coercion(t,Q),555);
	    if(Q0==G)relax(t);
	    if(*Q==G)MORF=FALSE;
	    return(TRUE);
	} return(FALSE);
}

static void slice_tail(Q) int *Q;
{int n,v,w,w1,i,dim,new_dim,offset,bz,lb,ub,rlb; bool name,subscript;
	v=Z; name=A[Z]==REF; if(name)Z=B[Z];
	must(A[Z]==ROW,612); bz=B[Z]; dim=A[bz];
	w1=w=askn(dim+1); copyn(bz,w,dim+1);
	A[w]=n=1; offset=B[bz]; new_dim=0;
	for(i=bz+1;i<=bz+dim;i++){
	    lb=ub=(subscript=unit(Q))!=0?short_meek_integer(Q):A[i];
	    if(spy(COLON)||spy(AT)||!subscript){
		ub=B[i]; rlb=A[i];
		if(inp(COLON)){
		    rlb=1;if(unit(Q))ub=short_meek_integer(Q);
		}
		if(inp(AT)){must(unit(Q),641); rlb=short_meek_integer(Q);}
		n *= ub<lb?0:ub-lb+1; new_dim++;
		A[++w1]=rlb; B[w1]=ub-lb+rlb; C[w1]=C[i];
	    }
	    if(*Q == G){
		must(lb>=A[i],642); must(ub<=B[i],643);
		offset += (lb-A[i])*C[i];
	    }
	    must(inp(i<bz+dim?COMMA:CLOSE),644);
	}
	if(*Q != G){
	    freen(w,dim+1); void_result(); relax(v); return;
	}
	MORF=TRUE;
	if(new_dim){
	    freen(w1+1,dim-new_dim); A[w]=new_dim; B[w]=n?offset:B[bz];C[w]=n;
	    Z=w1=ask(); A[w1]=ROW; B[w1]=w; C[w1]=1;
	    if(name){
		Z=new_reference(w1); relax(w1);
		if(n){
		    spelling_row(w,more_instance_call);
		}else{
		    more_instance(B[w]);
		}
	    }else{
		move_row(w);
	    }
	}else{
	    freen(w,dim+1);Z=name?new_reference(offset):new_instance(offset);
	}
	relax(v);
}