/*Copyright (C) 1992, 1995 by Thomas Glen Smith.  All Rights Reserved.*/
/* execqfxd APL2 V1.0.0 ************************************************
* Called from execqfxl to scan the function header, determining type,  *
* e.g. niladic, monadic, etc.  Returns a function name token pointer.  *
***********************************************************************/
#define INCLUDES APLCB+APLCHDEF+APLFUNCI+APLTOKEN
#include "includes.h"
Apltoken execqfxd(fp)
struct aplfunc *fp; /* function definition structure */
{
	Execqfxe; Execqfxg; Execqfxh; Fifo;
	extern int aplerr;
	Apltoken curtok,curvar=NULL,lastok,nametok=NULL,tokhdr;
	int tokcnt;

	tokcnt = *(fp->functokc); /* count of tokens in header */
	tokhdr = *(fp->functokp); /* head of token list */
	curtok = execqfxe(tokhdr + --tokcnt,OPERAND_TOKEN,93);
	if (aplerr) return(NULL); /* didn't get token type expected */
	if (tokcnt > 1 && (curtok - 1)->token_code == LEFT_ARROW) {
		tokcnt--; /* less 1 for LEFT_ARROW */
		fp->functype = RETVAL; /* function has a result */
		curvar = fifo(&(fp->funcvars),curvar,curtok); /* result var */
		curtok = execqfxe(tokhdr + --tokcnt,OPERAND_TOKEN,93);
	}
	if (aplerr) return(NULL); /* didn't get token type expected */
	if (tokcnt < 2) /* no localized names to process */
		return(execqfxg(fp,curtok,tokcnt,curvar));
	nametok = curtok; /* save either left opnd or function name */
	if ((curtok - 1)->token_code == SEMICOLON)
		fp->functype += NILAD; /* form = ... F ; ... */
	else { /* it cannot be niladic in form */
		curtok = execqfxe(tokhdr + --tokcnt,OPERAND_TOKEN,93);
		if (NULL == curtok) return(NULL); /* bad syntax */
		if ((curtok - 1)->token_code == SEMICOLON)
			fp->functype += MONAD; /* form = ... F b ; ?... */
		else { /* must be dyadic */
			fp->functype += DYAD; /* form = ... a F b ?... */
			curvar = fifo(&(fp->funcvars),curvar,nametok); /* left */
			nametok = curtok; /* save function name */
			curtok = execqfxe(tokhdr + --tokcnt,OPERAND_TOKEN,93);
			if (NULL == curtok) return(NULL); /* bad syntax */
		}
		curvar = fifo(&(fp->funcvars),curvar,curtok); /* right */
	}
	execqfxh(fp,tokhdr,curtok,tokcnt,curvar); /* do locals */
	if (aplerr) return(NULL);
	return(nametok);
}