/*Copyright (C) 1992, 1996 by Thomas Glen Smith.	All Rights Reserved.*/
/* popnest APL2 V1.0.0 *************************************************
* Called by execnexu. Pops elements from the operand stack, and builds *
* nested array if  more than one element is on the stack.              *
***********************************************************************/
#define INCLUDES APLCHDEF+APLTOKEN+APLCB+TREE
#include "includes.h"
Apltoken popnest(hdr)
Apltoken *hdr;
{	
	Endoper; Execgetp; Exectok; Getcb; Pop; Popnesc; Popnesu; Popnesv;
	Popnesw; Popnesx; Typeget;
	extern int aplerr;
	extern Treelist treehdr;
	Apltoken tok, toklast, toknext;
	int datacnt, datatyp, newtype, offset, resolved;
	Aplcb out=NULL;

	if (NULL == (tok = *hdr)) return(NULL); /* nothing on stack */
	if (NULL == tok->token_queue.token_next_ptr)
		return(pop(hdr)); /* one element in stack */
	offset = tok->token_offset; /* save for later */
	datacnt = datatyp = 0;
	toklast = (Apltoken ) hdr;
	while (tok) {
		datacnt++; /* count of items on operand stack */
		toknext = tok->token_queue.token_next_ptr;
		switch(tok->token_code) {
			case VECTOR_TOKEN:
			case QUOTE: resolved = 1;
				break;
			default: resolved = 0;
		}
		if (!resolved) {
			out = execgetp(tok); /* resolve operand, free tok */
			if (out == NULL) { /* Clean up stack and quit. */
				toklast->token_queue.token_next_ptr = toknext;
				return(NULL);
			}
			tok = exectok(out,offset); /* get new token */
			toklast->token_queue.token_next_ptr = tok;
			tok->token_queue.token_next_ptr = toknext;
		}
		out = tok->token_ptr.token_vector;
		if (out->aplrank)
			datatyp = APLAPL; /* nested array */
		else datatyp = typeget(datatyp,
			out->aplflags & (APLMASK + APLAPL));
		toklast = tok; /* save prior on stack */
		tok = toknext; /* point to next on stack */
	}
	out = getcb(NULL, datacnt, datatyp + APLTEMP, 1, NULL);
	if (aplerr) return(NULL); /* probably out of storage */
	switch (datatyp) {
		case APLAPL:  popnesu(hdr,out); break;
		case APLCHAR: popnesv(hdr,out); break;
		case APLINT:  popnesw(hdr,out); break;
		case APLNUMB: popnesx(hdr,out); break;
		case APLCPLX: popnesc(hdr,out); break;
		default: aplerr = 999; /* internal error */
	}
	if (aplerr) { endoper(out); return(NULL); }
	if (treehdr->lastfun == LEFT_ARROW)
		treehdr->lastfun = 0; /* last thing done wasn't assignment. */
	return(exectok(out,offset));
}