File contents

/* xllist - xlisp list builtin functions */

#include "xlisp.h"

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

/* external procedures */
extern struct node *xlarg();
extern struct node *xlevarg();
extern struct node *xlmatch();
extern struct node *xlevmatch();

/* xlist - builtin function list */
static struct node *xlist(args)
  struct node *args;
{
    struct node *oldstk,arg,list,val,*last,*lptr;

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

    /* initialize */
    arg.n_ptr = args;

    /* evaluate and append each argument */
    for (last = NULL; arg.n_ptr != NULL; last = lptr) {

	/* evaluate the next argument */
	val.n_ptr = xlevarg(&arg.n_ptr);

	/* append this argument to the end of the list */
	lptr = newnode(LIST);
	if (last == NULL)
	    list.n_ptr = lptr;
	else
	    last->n_listnext = lptr;
	lptr->n_listvalue = val.n_ptr;
    }

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

    /* return the list */
    return (list.n_ptr);
}

/* head - return the head of a list */
static struct node *head(args)
  struct node *args;
{
    struct node *list;

    /* get the list */
    if ((list = xlevmatch(LIST,&args)) == NULL)
	xlfail("null list");

    /* make sure this is the only argument */
    if (args != NULL)
	xlfail("too many arguments");

    /* return the head of the list */
    return (list->n_listvalue);
}

/* tail - return the tail of a list */
static struct node *tail(args)
  struct node *args;
{
    struct node *list;

    /* get the list */
    if ((list = xlevmatch(LIST,&args)) == NULL)
	xlfail("null list");

    /* make sure this is the only argument */
    if (args != NULL)
	xlfail("too many arguments");

    /* return the tail of the list */
    return (list->n_listnext);
}

/* nth - return the nth element of a list */
static struct node *nth(args)
  struct node *args;
{
    struct node *oldstk,arg,list;
    int n;

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

    /* initialize */
    arg.n_ptr = args;

    /* get n */
    n = xlevmatch(INT,&arg.n_ptr)->n_int;

    /* get the list */
    list.n_ptr = xlevmatch(LIST,&arg.n_ptr);

    /* make sure this is the only argument */
    if (arg.n_ptr != NULL)
	xlfail("too many arguments");

    /* find the nth element */
    for (; n-- > 0 && list.n_ptr != NULL; list.n_ptr = list.n_ptr->n_listnext)
	;

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

    /* make sure we got something */
    if (list.n_ptr == NULL)
	return (NULL);
    else
	return (list.n_ptr->n_listvalue);
}

/* append - builtin function append */
static struct node *append(args)
  struct node *args;
{
    struct node *oldstk,arg,list,last,val,*lptr;

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

    /* initialize */
    arg.n_ptr = args;

    /* get the list to append to */
    list.n_ptr = xlevmatch(LIST,&arg.n_ptr);

    /* find the last node in the list */
    last.n_ptr = list.n_ptr;
    while (last.n_ptr != NULL && last.n_ptr->n_listnext != NULL)
	last.n_ptr = last.n_ptr->n_listnext;

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

	/* evaluate the next argument */
	val.n_ptr = xlevarg(&arg.n_ptr);

	/* append this argument to the end of the list */
	lptr = newnode(LIST);
	if (last.n_ptr == NULL)
	    list.n_ptr = lptr;
	else
	    last.n_ptr->n_listnext = lptr;
	lptr->n_listvalue = val.n_ptr;

	/* save the new last element */
	last.n_ptr = lptr;
    }

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

    /* return the list */
    return (list.n_ptr);
}

/* prepend - builtin function prepend */
static struct node *prepend(args)
  struct node *args;
{
    struct node *oldstk,arg,list,val,*lptr;

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

    /* initialize */
    arg.n_ptr = args;

    /* get the list to prepend to */
    list.n_ptr = xlevmatch(LIST,&arg.n_ptr);

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

	/* evaluate the next argument */
	val.n_ptr = xlevarg(&arg.n_ptr);

	/* prepend this argument to the end of the list */
	lptr = newnode(LIST);
	lptr->n_listnext = list.n_ptr;
	list.n_ptr = lptr;
	lptr->n_listvalue = val.n_ptr;
    }

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

    /* return the list */
    return (list.n_ptr);
}

/* xllinit - xlisp list initialization routine */
xllinit()
{
    xlsubr("list",xlist);
    xlsubr("head",head); xlsubr("CAR",head);
    xlsubr("tail",tail); xlsubr("CDR",tail);
    xlsubr("nth",nth);
    xlsubr("append",append);
    xlsubr("prepend",prepend);
}