/* xlcont - xlisp control builtin functions */

#ifdef AZTEC
#include "stdio.h"
#else
#include <stdio.h>
#endif

#include "xlisp.h"

/* external variables */
extern struct node *xlstack,*xlenv;
extern struct node *true;

/* xcond - builtin function cond */
struct node *xcond(args)
  struct node *args;
{
    struct node *oldstk,arg,list,*val;

    /* create a new stack frame */
    oldstk = xlsave(&arg,&list,NULL);

    /* initialize */
    arg.n_ptr = args;

    /* initialize the return value */
    val = NULL;

    /* find a predicate that is true */
    while (arg.n_ptr != NULL) {

	/* get the next conditional */
	list.n_ptr = xlmatch(LIST,&arg.n_ptr);

	/* evaluate the predicate part */
	if (xlevarg(&list.n_ptr) != NULL) {

	    /* evaluate each expression */
	    while (list.n_ptr != NULL)
		val = xlevarg(&list.n_ptr);

	    /* exit the loop */
	    break;
	}
    }

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the value */
    return (val);
}

/* xand - builtin function 'and; */
struct node *xand(args)
  struct node *args;
{
    struct node *oldstk,arg,*val;

    /* create a new stack frame */
    oldstk = xlsave(&arg,NULL);

    /* initialize */
    arg.n_ptr = args;
    val = true;

    /* evaluate each argument */
    while (arg.n_ptr != NULL)

	/* get the next argument */
	if ((val = xlevarg(&arg.n_ptr)) == NULL)
	    break;

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the result value */
    return (val);
}

/* xor - builtin function 'or' */
struct node *xor(args)
  struct node *args;
{
    struct node *oldstk,arg,*val;

    /* create a new stack frame */
    oldstk = xlsave(&arg,NULL);

    /* initialize */
    arg.n_ptr = args;
    val = NULL;

    /* evaluate each argument */
    while (arg.n_ptr != NULL)
	if ((val = xlevarg(&arg.n_ptr)) != NULL)
	    break;

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the result value */
    return (val);
}

/* xlet - establish some local bindings and execute some code */
struct node *xlet(args)
  struct node *args;
{
    struct node *oldstk,*oldenv,arg,bnd,sym,val,*p;

    /* create a new stack frame */
    oldstk = xlsave(&arg,&bnd,&sym,&val,NULL);

    /* initialize */
    arg.n_ptr = args;

    /* get the list of bindings */
    bnd.n_ptr = xlmatch(LIST,&arg.n_ptr);

    /* initialize the local environment */
    oldenv = xlenv;

    /* bind each symbol in the list of bindings */
    while (bnd.n_ptr && bnd.n_ptr->n_type == LIST) {

	/* get the next binding */
	p = bnd.n_ptr->n_listvalue;

	/* check its type */
	switch (p->n_type) {
	case SYM:
		sym.n_ptr = p;
		val.n_ptr = NULL;
		break;
	case LIST:
		sym.n_ptr = p->n_listvalue;
		val.n_ptr = p->n_listnext->n_listvalue;
		val.n_ptr = xleval(val.n_ptr);
		break;
	default:
		xlfail("bad binding");
	}

	/* bind the value to the symbol */
	xlbind(sym.n_ptr,val.n_ptr);

	/* get next binding */
	bnd.n_ptr = bnd.n_ptr->n_listnext;
    }

    /* fix the bindings */
    xlfixbindings(oldenv);

    /* execute the code */
    for (val.n_ptr = NULL; arg.n_ptr; )
	val.n_ptr = xlevarg(&arg.n_ptr);

    /* unbind the arguments */
    xlunbind(oldenv);

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the result */
    return (val.n_ptr);
}

/* xwhile - builtin function while */
struct node *xwhile(args)
  struct node *args;
{
    struct node *oldstk,farg,arg,*val;

    /* create a new stack frame */
    oldstk = xlsave(&farg,&arg,NULL);

    /* initialize */
    farg.n_ptr = arg.n_ptr = args;

    /* loop until test fails */
    val = NULL;
    for (; TRUE; arg.n_ptr = farg.n_ptr) {

	/* evaluate the test expression */
	if (xlevarg(&arg.n_ptr) == NULL)
	    break;

	/* evaluate each remaining argument */
	while (arg.n_ptr != NULL)
	    val = xlevarg(&arg.n_ptr);
    }

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the last test expression value */
    return (val);
}

/* xrepeat - builtin function repeat */
struct node *xrepeat(args)
  struct node *args;
{
    struct node *oldstk,farg,arg,*val;
    int cnt;

    /* create a new stack frame */
    oldstk = xlsave(&farg,&arg,NULL);

    /* initialize */
    arg.n_ptr = args;

    /* evaluate the repeat count */
    cnt = xlevmatch(INT,&arg.n_ptr)->n_int;

    /* save the first expression to repeat */
    farg.n_ptr = arg.n_ptr;

    /* loop until test fails */
    val = NULL;
    for (; cnt > 0; cnt--) {

	/* evaluate each remaining argument */
	while (arg.n_ptr != NULL)
	    val = xlevarg(&arg.n_ptr);

	/* restore pointer to first expression */
	arg.n_ptr = farg.n_ptr;
    }

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the last test expression value */
    return (val);
}

/* xif - builtin function 'if' */
struct node *xif(args)
  struct node *args;
{
    struct node *oldstk,testexpr,thenexpr,elseexpr,*val;

    /* create a new stack frame */
    oldstk = xlsave(&testexpr,&thenexpr,&elseexpr,NULL);

    /* get the test expression, then clause and else clause */
    testexpr.n_ptr = xlarg(&args);
    thenexpr.n_ptr = xlarg(&args);
    elseexpr.n_ptr = (args ? xlarg(&args) : NULL);
    xllastarg(args);

    /* evaluate the appropriate clause */
    val = xleval(xleval(testexpr.n_ptr) ? thenexpr.n_ptr : elseexpr.n_ptr);

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the last value */
    return (val);
}

/* xprogn - builtin function 'progn' */
struct node *xprogn(args)
  struct node *args;
{
    struct node *oldstk,arg,*val;
    int cnt;

    /* create a new stack frame */
    oldstk = xlsave(&arg,NULL);

    /* initialize */
    arg.n_ptr = args;

    /* evaluate each remaining argument */
    for (val = NULL; arg.n_ptr != NULL; )
	val = xlevarg(&arg.n_ptr);

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the last test expression value */
    return (val);
}