/******************************************************************************

			UNSW Prolog (version 4)

			Written by Claude Sammut
		     Department of Computer Science
		     University of New South Wales
		   (and St. Joseph's U., Philadelphia)

		   Copyright (c)  1983 - Claude Sammut

******************************************************************************/





/*		'bag' and data base predicates		*/


#include "pred.h"

#define MAXBAG 50

extern atom *nil;
extern pval new(), make();

static int cur_bag = -1;

static struct {pval start, tail;} bag[MAXBAG];


static
open_bag PREDICATE
{
	if (++cur_bag == MAXBAG)
		fatal("Too many open bags");
	bag[cur_bag].start = (pval) nil;
	bag[cur_bag].tail = (pval) nil;
	return(TRUE);
}

static
write_bag PREDICATE
{
	extern var **varcell;
	var ** old_vc;
	pval result;

	if (isvariable(arg[0]) || cur_bag == -1)
		fail("Argument to `write_bag' must not be an variable")
	result = new(LIST);
	old_vc = varcell;
	varcell = 0;
	result -> c.term[0] = make(arg[0], frame[0]);
	varcell = old_vc;
	result -> c.term[1] = (pval) nil;
	if (bag[cur_bag].start == (pval) nil)
		bag[cur_bag].start = result;
	else bag[cur_bag].tail -> c.term[1] = result;
	bag[cur_bag].tail = result;
	return(FALSE);
}

static
close_bag PREDICATE
{
	return unify(arg[0], frame[0], bag[cur_bag].start, 0);
}

static
free_bag PREDICATE
{
	free_term(bag[cur_bag--].start);
	return(TRUE);
}

static
conc PREDICATE
{
	extern var **varcell;
	var **old_vc;
	register pval p, result;

	if (isvariable(arg[1]))
		fail("2nd argument to `conc' must not be a variable")

	p = arg[0];

	repeat {
		if (TYPE(p) != LIST)
			fail("1st argument to `conc' must be a list")
		if (isvariable(p -> c.term[0]))
			fail("Variables not allowed in `conc' list")
		if (p -> c.term[1] == (pval) nil) break;
		p = p -> c.term[1];
	}
	result = new(LIST);
	p -> c.term[1] = result;
	old_vc = varcell;
	varcell = 0;
	result -> c.term[0] = make(arg[1], frame[1]);
	varcell = old_vc;
	result -> c.term[1] = (pval) nil;
	return(TRUE);
}


atom_table p_bag =
{
	SET_PRED(NONOP, 0, 0, "open_bag", open_bag),
	SET_PRED(NONOP, 0, 1, "write_bag", write_bag),
	SET_PRED(NONOP, 0, 1, "close_bag", close_bag),
	SET_PRED(NONOP, 0, 0, "free_bag", free_bag),
	SET_PRED(NONOP, 0, 2, "conc", conc),
	END_MARK
};