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

XL_SEXP * xl_DivideString();


void
init_DivideString(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"DivideString"),
		get_func_prim(xl_DivideString,FO_APPLICATIVE,0,3,3));
}

XL_SEXP *
xl_div_str_str(XL_SEXP * d,L_CHAR * term)
{
XL_SEXP * r, * ret;
L_CHAR * buf, * ptr;
int len,i;
int term_len;
	term_len = l_strlen(term);
	r = 0;
	ptr = d->string.data;
	for ( ; ; ) {
		len = 0;
		for ( ; ; len ++ ) {
			if ( ptr[len] == 0 )
				break;
			for (i = 0 ; i < term_len ; i ++ ) {
				if ( ptr[len+i] != term[i] )
					break;
			}
			if ( i == term_len )
				break;
		}
		if ( ptr[len] == 0 ) {
			r = cons(get_string(ptr),r);
			break;
		}
		else {
			buf = d_alloc((len+1)*sizeof(L_CHAR),25);
			memcpy(buf,ptr,len*sizeof(L_CHAR));
			buf[len] = 0;
			r = cons(get_string(buf),r);
			d_f_ree(buf);
			ptr += len+term_len;
		}
	}
	ret = 0;
	for ( ; get_type(r) ; r = cdr(r) )
		ret = cons(car(r),ret);
	return ret;
}

XL_SEXP *
xl_div_str_pair(XL_SEXP * d,L_CHAR * term)
{
XL_SEXP * r, * ret;
XL_SEXP * xl_div_str();
	r = 0;
	for ( ; get_type(d) == XLT_PAIR ; d = cdr(d) ) {
		r = cons(xl_div_str(car(d),term),r);
	}
	ret = 0;
	for ( ; get_type(r) ; r = cdr(r) )
		ret = cons(car(r),ret);
	return ret;
}

XL_SEXP *
xl_div_str(XL_SEXP * d,L_CHAR * term)
{
	switch ( get_type(d) ) {
	case XLT_NULL:
		return 0;
	case XLT_PAIR:
		return xl_div_str_pair(d,term);
	case XLT_STRING:
		return xl_div_str_str(d,term);
	default:
		return get_error(
			d->h.file,
			d->h.line,
			XLE_SEMANTICS_TYPE_MISSMATCH,
			l_string(std_cm,"DivideString"),
			n_get_string("type missmatch in the 1st list"));
	}
}

XL_SEXP *
xl_DivideString(XLISP_ENV * env,XL_SEXP * s)
{
XL_SEXP * data;
XL_SEXP * term;
	data = get_el(s,1);
	term = get_el(s,2);
	if ( get_type(term) != XLT_STRING )
		goto type_missmatch;
	return xl_div_str(data,term->string.data);
type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"DivideString"),
		n_get_string("type missmatch in the terminate string"));
}


