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

XL_SEXP * radar_query_regulation(XL_SEXP *);

XL_SEXP *
rqr_list(XL_SEXP * q)
{
XL_SEXP * ret1, * ret2;
	ret1 = cons(car(q),0);
	q = cdr(q);
	for ( ; get_type(q) == XLT_PAIR ; q = cdr(q) )
		ret1 = cons(radar_query_regulation(car(q)),ret1);
	ret2 = 0;
	for ( ; ret1 ; ret1 = cdr(ret1) )
		ret2 = cons(car(ret1),ret2);
	return ret2;
}

XL_SEXP *
rqr_URL(XL_SEXP * q)
{
L_CHAR * f;
XL_SEXP * u;
XL_SEXP * ret;
	u = get_el(q,1);
	if ( get_type(u) != XLT_STRING )
		return q;
	ret = List(
		car(q),
		get_string(f = url_regulation(u->string.data)),
		-1);
	d_f_ree(f);
	return ret;
}

XL_SEXP *
rqr_pair(XL_SEXP * q)
{
XL_SEXP * cmd;
	cmd = car(q);
	if ( get_type(cmd) != XLT_SYMBOL )
		return q;
	if ( l_strcmp(cmd->symbol.data,l_string(std_cm,"URL")) == 0 )
		return rqr_URL(q);
	if ( l_strcmp(cmd->symbol.data,l_string(std_cm,"AND")) == 0 )
		return rqr_list(q);
	if ( l_strcmp(cmd->symbol.data,l_string(std_cm,"OR")) == 0 )
		return rqr_list(q);
	if ( l_strcmp(cmd->symbol.data,l_string(std_cm,"NOT")) == 0 )
		return rqr_list(q);
	return q;
}

XL_SEXP *
radar_query_regulation(XL_SEXP * q)
{
	switch ( get_type(q) ) {
	case XLT_PAIR:
		return rqr_pair(q);
	default:
		return q;
	}
}