/* xlsubr - xlisp builtin function support routines */

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

#include "xlisp.h"

/* external variables */
extern struct node *xlstack;

/* xlsubr - define a builtin function */
xlsubr(sname,type,subr)
  char *sname; int type; struct node *(*subr)();
{
    struct node *sym;

    /* enter the symbol */
    sym = xlsenter(sname);

    /* initialize the value */
    sym->n_symvalue = newnode(type);
    sym->n_symvalue->n_subr = subr;
}

/* xlarg - get the next argument */
struct node *xlarg(pargs)
  struct node **pargs;
{
    struct node *arg;

    /* make sure the argument exists */
    if (*pargs == NULL)
	xlfail("too few arguments");

    /* get the argument value */
    arg = (*pargs)->n_listvalue;

    /* move the argument pointer ahead */
    *pargs = (*pargs)->n_listnext;

    /* return the argument */
    return (arg);
}

/* xlmatch - get an argument and match its type */
struct node *xlmatch(type,pargs)
  int type; struct node **pargs;
{
    struct node *arg;

    /* get the argument */
    arg = xlarg(pargs);

    /* check its type */
    if (type == LIST) {
	if (arg != NULL && arg->n_type != LIST)
	    xlfail("bad argument type");
    }
    else {
	if (arg == NULL || arg->n_type != type)
	    xlfail("bad argument type");
    }

    /* return the argument */
    return (arg);
}

/* xlevarg - get the next argument and evaluate it */
struct node *xlevarg(pargs)
  struct node **pargs;
{
    struct node *oldstk,val;

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

    /* get the argument */
    val.n_ptr = xlarg(pargs);

    /* evaluate the argument */
    val.n_ptr = xleval(val.n_ptr);

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

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

/* xlevmatch - get an evaluated argument and match its type */
struct node *xlevmatch(type,pargs)
  int type; struct node **pargs;
{
    struct node *arg;

    /* get the argument */
    arg = xlevarg(pargs);

    /* check its type */
    if (type == LIST) {
	if (arg != NULL && arg->n_type != LIST)
	    xlfail("bad argument type");
    }
    else {
	if (arg == NULL || arg->n_type != type)
	    xlfail("bad argument type");
    }

    /* return the argument */
    return (arg);
}

/* xllastarg - make sure the remainder of the argument list is empty */
xllastarg(args)
  struct node *args;
{
    if (args != NULL)
	xlfail("too many arguments");
}

/* assign - assign a value to a symbol */
assign(sym,val)
  struct node *sym,*val;
{
    struct node *lptr;

    /* check for a current object */
    if ((lptr = xlobsym(sym)) != NULL)
	lptr->n_listvalue = val;
    else
	sym->n_symvalue = val;
}