/**********************************************************************
 
	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"


XL_SEXP *
gb_let(XLISP_ENV * env,XL_SEXP * s)
{
XLISP_ENV * e;
XL_SEXP * sub, * s1, * sym, * data, * ret;
char * pos;
	e = new_env(env);
	sub = get_el(s,1);
	if ( get_type(sub) != XLT_PAIR ) {
		pos = "substitution";
		goto syntax;
	}
	for ( ; get_type(sub) ; sub = cdr(sub) ) {
		s1 = car(sub);
		if ( get_type(s1) != XLT_PAIR ) {
			pos = "substitution element";
			goto syntax;
		}
		sym = get_el(s1,0);
		if ( get_type(sym) != XLT_SYMBOL ) {
			pos = "substitution symbol";
			goto syntax;
		}
		data = eval(env,get_el(s1,1));
		if ( get_type(data) == XLT_ERROR )
			return data;
		set_env(e,sym->symbol.data,data);
	}
	for ( s1 = cdr(cdr(s)) ; get_type(s1) ; s1 = cdr(s1) ) {
		ret = eval(e,car(s1));
		if ( get_type(ret) == XLT_ERROR )
			return ret;
	}
	return ret;
syntax:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_INV_FORMAT,
		l_string(std_cm,"let"),
		list(	n_get_string("format error"),
			n_get_string(pos),
			s,
			0));
}
