/**********************************************************************
 
	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	"memory_debug.h"
#include	"regular.h"
#include	"xlerror.h"
#include	"xl.h"

typedef struct reg_switch {
	struct reg_switch *	next;
	L_CHAR *		rex;
	AUTOMATON *		a;
	XL_SEXP *		cmd;
	L_CHAR *		mode;
} REG_SWITCH;

void gc_gb_sexp();
XL_SEXP * xl_RegSwitch();

void
free_reg_sw(REG_SWITCH * rs)
{
REG_SWITCH * rs1;
	for ( ; rs ;  ) {
		rs1 = rs->next;
		free_automaton(rs->a);
		d_f_ree(rs);
		rs = rs1;
	}
}

L_CHAR *
add_string(L_CHAR * a,L_CHAR * b,int size)
{
L_CHAR * ret;
int len;
	if ( a == 0 ) {
		ret = d_alloc(sizeof(L_CHAR)*(size+1),123);
		memcpy(ret,b,sizeof(L_CHAR)*size);
		ret[size] = 0;
		return ret;
	}
	len = l_strlen(a);
	ret = d_alloc(sizeof(L_CHAR)*(len+size+1),123);
	memcpy(ret,a,sizeof(L_CHAR)*len);
	memcpy(&ret[len],b,sizeof(L_CHAR)*size);
	ret[len+size] = 0;
	d_f_ree(a);
	return ret;
}

void
init_RegSwitch(XLISP_ENV * env)
{
XL_SEXP * p;
	set_env(env,l_string(std_cm,"RegSwitch"),
		p = get_func_prim(xl_RegSwitch,FO_NORMAL,0,2,-1));
}

XL_SEXP *
xl_RegSwitch(XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * a,XL_SYM_FIELD * sf)
{
XL_SEXP * target;
L_CHAR * _target;
XL_SEXP * case_pair, * case_sym, * ss, * ss_ret, * ret;
L_CHAR * rex;
REG_SWITCH * rs, ** rsp, * rs1, * match_rs;
int pret,min_ptr,max_ptr,match;
L_CHAR * match_str;
XLISP_ENV * ee;
L_CHAR * ret_string;
L_CHAR * mode;
XL_SEXP * _mode;
L_CHAR * __mode;

	s = cdr(s);
	target = eval(env,car(s));
	switch ( get_type(target) ) {
	case XLT_ERROR:
		return target;
	case XLT_STRING:
		_target = target->string.data;
		break;
	default:
		goto type_missmatch;
	}
	s = cdr(s);
	rs = 0;
	rsp = &rs;
	for ( ; get_type(s) == XLT_PAIR ; s = cdr(s) ) {
		case_pair = car(s);
		switch ( get_type(case_pair) ) {
		case XLT_ERROR:
			return case_pair;
		case XLT_PAIR:
			break;
		default:
			goto param_error;
		}
		case_sym = car(case_pair);
		switch ( get_type(case_sym) ) {
		case XLT_ERROR:
			return case_sym;
		case XLT_SYMBOL:
			break;
		default:
			goto param_error;
		}
		rex = get_sf_attribute(case_sym->symbol.field,
				l_string(std_cm,"rex"));
		if ( rex == 0 )
			goto param_error;
		mode = get_sf_attribute(case_sym->symbol.field,
				l_string(std_cm,"mode"));
		rs1 = d_alloc(sizeof(*rs1),123);
		rs1->next = 0;
		rs1->rex = rex;
		rs1->mode = mode;
		rs1->cmd = cdr(case_pair);
		rs1->a = get_fa(rex);
		if ( rs1->a == 0 ) {
			d_f_ree(rs1);
			free_reg_sw(rs);
			goto reg_exp_error;
		}
		*rsp = rs1;
		rsp = &rs1->next;
	}
	ret_string = 0;
	for ( ; *_target ; ) {
		_mode = get_env_symbol(env,l_string(std_cm,"RegMode"));
		if ( _mode == 0 )
			__mode = 0;
		else {
			switch ( get_type(_mode) ) {
			case XLT_STRING:
				__mode = _mode->string.data;
				break;
			case XLT_SYMBOL:
				__mode = _mode->symbol.data;
				break;
			default:
				goto type_missmatch_in_mode;
			}
		}
		match = -1;
		match_rs = 0;
		for ( rs1 = rs ; rs1 ; rs1 = rs1->next ) {
			if ( __mode && l_strcmp(__mode,rs1->mode) )
				continue;
			pret = parse_dfa_str(
				&min_ptr,
				&max_ptr,
				rs1->a,
				_target,
				0);
			if ( max_ptr == -1 )
				continue;
			if ( match < max_ptr ) {
				match = max_ptr;
				match_rs = rs1;
			}
		}
		if ( match == 0 || match_rs == 0 ) {
			ret_string = add_string(
				ret_string,_target,1);
			_target ++;
		}
		else {
			match_str = d_alloc(sizeof(L_CHAR)*
					(match+1),1234);
			memcpy(match_str,
				_target,
				sizeof(L_CHAR)*match);
			match_str[match] = 0;
			gc_push(0,0,"RegSwitch");
			ee = new_env(env);
			set_env(ee,l_string(std_cm,"pattern"),
				get_string(match_str));
			d_f_ree(match_str);
			for ( ss = match_rs->cmd ; 
				get_type(ss) == XLT_PAIR ;
				ss = cdr(ss) ) {

				ss_ret = eval(ee,car(ss));
				if ( get_type(ss_ret) == XLT_ERROR )
					break;
			}
			gc_pop(ss_ret,gc_gb_sexp);
			switch ( get_type(ss_ret) ) {
			case XLT_ERROR:
				if ( ss_ret->err.code ==
					XLE_SYSTEM_LOOP_BREAK ) {

					ss_ret = ss_ret->err.data;
					switch ( get_type(ss_ret) ) {
					case XLT_ERROR:
						break;
					case XLT_STRING:
						ret_string = add_string(
						ret_string,ss_ret->string.data,
						l_strlen(ss_ret->string.data));
					default:
						goto end;
					}
				}
				free_reg_sw(rs);
				return ss_ret;
			case XLT_STRING:
				ret_string = add_string(
					ret_string,ss_ret->string.data,
					l_strlen(ss_ret->string.data));
				break;
			default:
				break;
			}
			_target += match;
		}
	}
end:
	if ( ret_string == 0 )
		ret = n_get_string("");
	else	ret = get_string(ret_string);
	if ( ret_string )
		d_f_ree(ret_string);
	free_reg_sw(rs);
	return ret;
type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"RegSwitch"),
		n_get_string("type missmatch"));
type_missmatch_in_mode:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"RegSwitch"),
		n_get_string("type missmatch / symbol mode"));
param_error:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"RegSwitch"),
		n_get_string("parameter error"));
reg_exp_error:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"RegSwitch"),
		n_get_string("parameter error: regular expression"));
}

