/**********************************************************************
 
	Copyright (C) 2003 Hirohisa MORI <joshua@nichibun.ac.jp>
 
	This program is free software; you can redistribute it 
	and/or modify it under the terms of the GLOBALBASE 
	Library General Public License (G-LGPL) as published by 

	http://www.globalbase.org/
 
	This program 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.

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


#include	"xlerror.h"
#include	"xl.h"
#include	"memory_debug.h"

#define LEN_UNIT	10

XL_SEXP * xl_FormatEval();
XL_SEXP * FormatEval_loop(XLISP_ENV * e,XL_SEXP * d);


void
init_FormatEval(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"FormatEval"),
		get_func_prim(xl_FormatEval,FO_APPLICATIVE,0,3,-1));
}


XL_SEXP *
FormatEval_loop(XLISP_ENV * e,XL_SEXP * d)
{
XL_SEXP * ret;
XL_SEXP * el,* sym;
	ret = 0;
	for ( ; get_type(d) == XLT_PAIR ; d = cdr(d) ) {
		el = car(d);
		switch ( get_type(el) ) {
		case XLT_ERROR:
			return el;
		case XLT_PAIR:
			sym = car(el);
			switch ( get_type(sym) ) {
			case XLT_SYMBOL:
			case XLT_FUNC:
				ret = cons(eval(e,el),ret);
				break;
			case XLT_ERROR:
				return sym;
			default:
				ret = cons(FormatEval_loop(e,el),ret);
				break;
			}
			break;
		case XLT_STRING:
		case XLT_INTEGER:
		case XLT_FLOAT:
			ret = cons(eval(e,
					List(n_get_symbol("__text"),
						el,
						-1)),ret);
		default:
			ret = cons(eval(e,el),ret);
		}
	}
	return reverse(ret);
}

XL_SEXP *
xl_FormatEval(XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * a,
	XL_SYM_FIELD * sf)
{
XL_SEXP * d;
XL_SEXP * e;
	e = get_el(s,1);
	if ( get_type(e) != XLT_ENV )
		goto type_missmatch;
	d = cdr(cdr(s));
	return FormatEval_loop(e->env.data,d);
type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"FormatEval"),
		0);
}


