/*
 Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa

This file is part of GNU Common Lisp, herein referred to as GCL

GCL is free software; you can redistribute it and/or modify it under
the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

GCL is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
License for more details.

You should have received a copy of the GNU Library General Public License 
along with GCL; see the file COPYING.  If not, write to the Free Software
Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

*/

/*

	mapfun.c

	Mapping
*/

#include "include.h"

/*

Use of VS in mapfunctions:

		|	|
		|-------|
	base ->	|  fun	|
		| list1	|
		|   :	|
		|   :	|
		| listn	|
	top ->	| value	| -----	the list which should be returned
		| arg1	| --|
		|   :	|   |--	arguments to FUN.
		|   :	|   |	On call to FUN, vs_base = top+1
		| argn	| --|			vs_top  = top+n+1
		|-------|
		|	|
		   VS
*/

Lmapcar()
{
	object endp_temp;

	object *top = vs_top;
	object *base = vs_base;
	object x, handy;
	int n = vs_top-vs_base-1;
	int i;

	if (n <= 0)
		too_few_arguments();
	vs_push(Cnil);
	for (i = 1;  i <= n;  i++) {
		x = base[i];
		if (endp(x)) {
			base[0] = Cnil;
			vs_top = base+1;
			vs_base = base;
			return;
		}
		vs_push(MMcar(x));
		base[i] = MMcdr(x);
	}
	handy = top[0] = MMcons(Cnil,Cnil);
LOOP:
	vs_base = top+1;
	super_funcall(base[0]);
	MMcar(handy) = vs_base[0];
	for (i = 1;  i <= n;  i++) {
		x = base[i];
		if (endp(x)) {
			vs_base = top;
			vs_top = top+1;
			return;
		}
		top[i] = MMcar(x);
		base[i] = MMcdr(x);
	}
	vs_top = top+n+1;
	handy = MMcdr(handy) = MMcons(Cnil,Cnil);
	goto LOOP;
}

Lmaplist()
{
	object endp_temp;

	object *top = vs_top;
	object *base = vs_base;
	object x, handy;
	int n = vs_top-vs_base-1;
	int i;

	if (n <= 0)
		too_few_arguments();
	vs_push(Cnil);
	for (i = 1;  i <= n;  i++) {
		x = base[i];
		if (endp(x)) {
			base[0] = Cnil;
			vs_top = base+1;
			vs_base = base;
			return;
		}
		vs_push(x);
		base[i] = MMcdr(x);
	}
	handy = top[0] = MMcons(Cnil,Cnil);
LOOP:
	vs_base = top+1;
	super_funcall(base[0]);
	MMcar(handy) = vs_base[0];
	for (i = 1;  i <= n;  i++) {
		x = base[i];
		if (endp(x)) {
			vs_base = top;
			vs_top = top+1;
			return;
		}
		top[i] = x;
		base[i] = MMcdr(x);
	}
	vs_top = top+n+1;
	handy = MMcdr(handy) = MMcons(Cnil,Cnil);
	goto LOOP;
}

Lmapc()
{
	object endp_temp;

	object *top = vs_top;
	object *base = vs_base;
	object x;
	int n = vs_top-vs_base-1;
	int i;

	if (n <= 0)
		too_few_arguments();
	vs_push(base[1]);
	for (i = 1;  i <= n;  i++) {
		x = base[i];
		if (endp(x)) {
			vs_top = top+1;
			vs_base = top;
			return;
		}
		vs_push(MMcar(x));
		base[i] = MMcdr(x);
	}
LOOP:
	vs_base = top+1;
	super_funcall(base[0]);
	for (i = 1;  i <= n;  i++) {
		x = base[i];
		if (endp(x)) {
			vs_base = top;
			vs_top = top+1;
			return;
		}
		top[i] = MMcar(x);
		base[i] = MMcdr(x);
	}
	vs_top = top+n+1;
	goto LOOP;
}

Lmapl()
{
	object endp_temp;

	object *top = vs_top;
	object *base = vs_base;
	object x;
	int n = vs_top-vs_base-1;
	int i;

	if (n <= 0)
		too_few_arguments();
	vs_push(base[1]);
	for (i = 1;  i <= n;  i++) {
		x = base[i];
		if (endp(x)) {
			vs_top = top+1;
			vs_base = top;
			return;
		}
		vs_push(x);
		base[i] = MMcdr(x);
	}
LOOP:
	vs_base = top+1;
	super_funcall(base[0]);
	for (i = 1;  i <= n;  i++) {
		x = base[i];
		if (endp(x)) {
			vs_base = top;
			vs_top = top+1;
			return;
		}
		top[i] = x;
		base[i] = MMcdr(x);
	}
	vs_top = top+n+1;
	goto LOOP;
}

Lmapcan()
{
	object endp_temp;

	object *top = vs_top;
	object *base = vs_base;
	object x, handy;
	int n = vs_top-vs_base-1;
	int i;

	if (n <= 0)
		too_few_arguments();
	vs_push(Cnil);
	for (i = 1;  i <= n;  i++) {
		x = base[i];
		if (endp(x)) {
			base[0] = Cnil;
			vs_top = base+1;
			vs_base = base;
			return;
		}
		vs_push(MMcar(x));
		base[i] = MMcdr(x);
	}
	handy = Cnil;
LOOP:
	vs_base = top+1;
	super_funcall(base[0]);
	if (endp(handy)) handy = top[0] = vs_base[0];
	else {
		x = MMcdr(handy);
		while(!endp(x)) {
			handy = x;
			x = MMcdr(x);
		}
		MMcdr(handy) = vs_base[0];
		}
	for (i = 1;  i <= n;  i++) {
		x = base[i];
		if (endp(x)) {
			vs_base = top;
			vs_top = top+1;
			return;
		}
		top[i] = MMcar(x);
		base[i] = MMcdr(x);
	}
	vs_top = top+n+1;
	goto LOOP;
}

Lmapcon()
{
	object endp_temp;

	object *top = vs_top;
	object *base = vs_base;
	object x, handy;
	int n = vs_top-vs_base-1;
	int i;

	if (n <= 0)
		too_few_arguments();
	vs_push(Cnil);
	for (i = 1;  i <= n;  i++) {
		x = base[i];
		if (endp(x)) {
			base[0] = Cnil;
			vs_top = base+1;
			vs_base = base;
			return;
		}
		vs_push(x);
		base[i] = MMcdr(x);
	}
	handy = Cnil;
LOOP:
	vs_base = top+1;
	super_funcall(base[0]);
	if (endp(handy))
		handy = top[0] = vs_base[0];
	else {
		x = MMcdr(handy);
		while(!endp(x)) {
			handy = x;
			x = MMcdr(x);
		}
		MMcdr(handy) = vs_base[0];
	}
	for (i = 1;  i <= n;  i++) {
		x = base[i];
		if (endp(x)) {
			vs_base = top;
			vs_top = top+1;
			return;
		}
		top[i] = x;
		base[i] = MMcdr(x);
	}
	vs_top = top+n+1;
	goto LOOP;
}

init_mapfun()
{
	make_function("MAPCAR", Lmapcar);
	make_function("MAPLIST", Lmaplist);
	make_function("MAPC", Lmapc);
	make_function("MAPL", Lmapl);
	make_function("MAPCAN", Lmapcan);
	make_function("MAPCON", Lmapcon);
}
