%      Production system KORE/IE (version 12.48)
%
%          (C)1992 Institute for New Generation Computer Technology
%                          (Read COPYRIGHT for detailed information)
%
%      1992.7 Check and refine every programs 
%                             for IFS (ICOT Free Software) release.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%% Rule Compiler %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/*
# literalize      --- define attributes of condition element
		USAGE:literalize(Condition_Element_Name,
				  [Attribute_1,...,Attribute_n]).
		condition_element ::= 'Condition_Element_Name'(Attribute_1...)
# if ... then ... --- compile a production rule into ie structure
		USAGE: Rule_Name:
			if
			 LHS_1 & ... & LHS_n
			then
			 RHS_1 & ... & RHS_n.
*/

%%%%% literalize data of condition element 'start'
:- retract_all(structure(start,_,_,_,_,_)),
   retract_all(position(start,_,_,_,_)),
   !.
:- assertz(structure(start,kore_start,
			ie_lhs_start,2,
			[time_tag,order],
			[number,number])).
:- assertz(position(start,time_tag,number,0,1)).
:- assertz(position(start,order,non,nil,2)).

%%%%% LITERALIZE
literalize(CE_Name, List):-
	atomic(CE_Name),
	retract_all(position(CE_Name,_,_,_,_)),
	retract_all(structure(CE_Name,_,_,_,_,_)),
	compile_lit(CE_Name,[time_tag'#'number|List],
					ATTRIBUTE_LIST,TYPE_LIST,Number,0),
	(retract(structure(CE_Name,RN,_,RA,[_|ANLO],[_|ATLO])),
	 ANLO \== ATTRIBUTE_LIST,
	 ATLP \== TYPE_LIST,
	 abolish(RN,RA);
	 true),
	name(CE_Name,NCE_NAME),
	name(TERM_NAME,[107,111,114,101,95|NCE_NAME]),
	name(CE_Name,NCEN),
	name(CE_NAME,[105,101,95,108,104,115,95|NCEN]),
	asserta(structure(CE_Name,TERM_NAME,CE_NAME,
				Number,ATTRIBUTE_LIST,TYPE_LIST)),
	!.

%%%%% compile_lit
compile_lit(Rule,[B'#'T = D|C],[B|R],[T|RR],NUM,N) :-
	NN is N + 1,
	atomic(B),
	default_define(T,D),
	assertz(position(Rule,B,T,D,NN)),
	!,
	compile_lit(Rule,C,R,RR,NUM,NN).
compile_lit(Rule,[B'#'T|C],[B|R],[T|RR],NUM,N):-
	NN is N + 1,
	atomic(B),
	default_define(T,D),
	assertz(position(Rule,B,T,D,NN)),
	!,
	compile_lit(Rule,C,R,RR,NUM,NN).
compile_lit(Rule,[B = D|C],[B|R],[non|RR],NUM,N):-
	NN is N + 1,
	atomic(B),
	assertz(position(Rule,B,non,D,NN)),
	!,
	compile_lit(Rule,C,R,RR,NUM,NN).
compile_lit(Rule,[B|C],[B|R],[non|RR],NUM,N):-
	NN is N + 1,
	atomic(B),
	assertz(position(Rule,B,non,nil,NN)),
	!,
	compile_lit(Rule,C,R,RR,NUM,NN).
compile_lit(Rule,[],[],[],N,N):-
	!.

%%%%% default_define
default_define(number,Value) :-
	number(Value),
	!.
default_define(number,0) :-
	!.
default_define(atom,V) :-
	atomic(V),
	!.
defalut_define(atom,nil) :-
	!.
default_define(non,V) :-
	nonvar(V),
	!.
default_define(non,nil) :-
	!.
default_define(list,V) :-
	nonvar(V),
	type_check(list,V),
	!.
default_define(list,[]) :-
	!.
default_define(logical,V) :-
	nonvar(V),
	!.
default_define(logical,fail) :-
	!.

%%%%% type_check
type_check(number,Value) :-
	number(Value),
	!.
type_check(atom,Value) :-
	atomic(Value),
	!.
type_check(non,_) :-
	!.
type_check(list,[_|_]) :-
	!.
type_check(list,[]) :-
	!.
type_check(logical,true) :-
	!.
type_check(logical,fail) :-
	!.
type_check(_,Value) :-
	var(Value),
	!.

%%%%% .. : IF ... THEN ...
(Rule : if LHS then RHS):-
	rule_base_name(Rule_Base),
	!,
	atomic(Rule),
	display(Rule),
	ttyput(32),
	erase_rule(Rule,Rule_Base),
	reform_lhs(LHS,[],Var_List,Element_Restriction,
			Reformed_LHS,Time_Tags,Number_of_Undef_Slots,
				1,Designator_Names,Len,FN,[]),
	!,
	compile_lhs(Reformed_LHS,Reformed_LHS,
			Element_Restriction,Rule,Rule_Base,
				Time_Tags,Var_List,Number_of_Undef_Slots),
	functor(Desig,designators,Len),
	FNF =.. [f|FN],
	compile_rhs(Rule_Base,Rule,Var_List,RHS,Designator_Names,Desig,FNF),
	display('       end...'),
	ttynl,
	!.
(_ : if _ then _) :-
	write('Cannot Use This Style at Top Level ...'),
	nl.

%%%%% .. : .. : IF ... THEN ...
(Rule_Base : RN : if LHS then RHS):-
	(retract(cs(Rule_Base,_));
	 true),
	asserta(cs(Rule_Base,[])),
	(strategy_rec(Rule_Base,_,_);
	 asserta(strategy_rec(Rule_Base,lex,lex))),
	(watch_mode(Rule_Base,_);
	 asserta(watch_mode(Rule_Base,1))),
	(rule_base_name(RB);
	 asserta(rule_base_name(RB))),
	!,
	atomic(RN),
	write(RN),
	write(' of '),
	write(RB),
	ttyput(32),
	erase_rule(RN,Rule_Base),
	reform_lhs(LHS,[],VL,ER,RLHS,TTs,NUS,1,Designator_Names,L,FN,[]),
	!,
	compile_lhs(RLHS,RLHS,ER,RN,Rule_Base,TTs,VL,NUS),
	functor(Desig,designators,L),
	FNF =.. [f|FN],
	compile_rhs(Rule_Base,RN,VL,RHS,DN,Desig,FNF),
	display('       end...'),
	ttynl,
	!.

%%%%% reform_lhs
reform_lhs((+ H & T),
	   Variable_List_Carry,
	   Variable_List,
	   [ER|Element_Restriction],
	   [REFORMED|LHS],
	   [Time_Tag|Time_Tags],
	   Nunber_of_Undefine_Slots,
	   Position,
	   Designators_Names_List,
	   LENGTH,
	   [Functor_Name|FNS],
	   Non_Args_Elements) :-
	H =.. [Functor_Name|Atrs],
	!,
	(structure(Functor_Name,FUNCTOR_NAME,Arity,NUM,[_|SLOT],[_|TYPE]),
	 !;
	 error_on_wm_class_declaration(Functor_Name)),
	!,
	check_slots_attribute(Atrs, SLOT),
	reforming(Atrs,Variable_List_Carry,
			VARIABLE_LIST_CARRY,[],ERL,
			SLOT,TYPE,Reformed,NUSN,Arity,
			Functor_Name,Non_Args_Elements,New_Non_Args_Elements),
	list_to_maru_kakko(ERL,ER),
	REFORMED =.. [FUNCTOR_NAME,Time_Tag|Reformed],
	!,
	reform_lhs(T,VARIABLE_LIST_CARRY,Variable_List,
		    Element_Restriction,LHS,Time_Tags,NUSC,POSITION,
		       Designators_Names_List,Length,FNS,New_Non_Args_Elements),
	Number_of_Undefine_Slots is NUSN + NUSC,
	LENGTH is Length + 1,
	!.
reform_lhs((Designator + H & T),VLC,VL,[ER|ELRE],[REF|LHS],
		[TT|TTS],NUS,Posi,[(Designator,Posi)|DN],LEN,[F|FNS],NAE):-
	H =.. [F|Atrs],
	!,
	POSI is Posi + 1,
	(structure(F,FN,_,NUM,[_|SLOT],[_|TYPE]),
	 !;
	 error_on_wm_class_declaration(F)),
	!,
	check_slots_attribute(Atrs, SLOT),
	reforming(Atrs,VLC,VLCN,[],ERL,SLOT,TYPE,Ref,NUSN,NUM,F,NAE,NNAE),
	REF =.. [FN,TT|Ref],
	list_to_maru_kakko(ERL,ER),
	!,
	reform_lhs(T,VLCN,VL,ELRE,LHS,TTS,NUSC,POSI,DN,Len,FNS,NNAE),
	NUS is NUSN + NUSC,
	LEN is Len + 1,
	!.
reform_lhs((- H & T),VLC,VL,[[]|ELRE],[ERN|LHS],TTS,NUS,Posi,DN,LEN,FNS,NAE):-
	H =.. [F|Atrs],
	!,
	POSI is Posi + 1,
	(structure(F,FN,_,NUM,[_|SLOT],[_|TYPE]),
	 !;
	 error_on_wm_class_declaration(F)),
	check_slots_attribute(Atrs, SLOT),
	reforming(Atrs,VLC,VLCN,[],ERL,SLOT,TYPE,Ref,NUSN,NUM,F,NAE,NNAE),
	!,
	list_to_maru_kakko(ERL,ER),
	REF =.. [FN,_|Ref],
	negative_element_restriction(ER,REF,ERN),
	!,
	reform_lhs(T,VLCN,VL,ELRE,LHS,TTS,NUS,POSI,DN,LEN,FNS,NNAE),
	!.
reform_lhs((H & T),VLC,VL,[ER|ELRE],[REF|LHS],[TT|TTS],
					NUS,Posi,DN,LEN,[F|FNS],NAE) :-
	H =.. [F|Atrs],
	!,
	POSI is Posi + 1,
	(structure(F,FN,_,NUM,[_|SLOT],[_|TYPE]),
	 !;
	 error_on_wm_class_declaration(F)),
	!,
	check_slots_attribute(Atrs, SLOT),
	reforming(Atrs,VLC,VLCN,[],ERL,SLOT,TYPE,Ref,NUSN,NUM,F,NAE,NNAE),
	list_to_maru_kakko(ERL,ER),
	REF =.. [FN,TT|Ref],
	!,
	reform_lhs(T,VLCN,VL,ELRE,LHS,TTS,NUSC,POSI,DN,Len,FNS,NNAE),
	NUS is NUSN + NUSC,
	LEN is Len + 1,
	!.
reform_lhs(Designator+H,VLC,VL,[ER],[REF],[TT],NUS,Posi,[(D,Posi)],1,[F],NAE) :-
	H =.. [F|Atrs],
	!,
	(structure(F,FN,_,NUM,[_|SLOT],[_|TYPE]),
	 !;
	 error_on_wm_class_declaration(F)),
	!,
	check_slots_attribute(Atrs, SLOT),
	reforming(Atrs,VLC,VL,[],ERL,SLOT,TYPE,Ref,NUS,NUM,F,NAE,_),
	list_to_maru_kakko(ERL,ER),
	REF =.. [FN,TT|Ref],
	!.
reform_lhs(-H,VLC,VL,[[]],[ERN],[],NUS,_,[],0,[],NAE) :-
	H =.. [F|Atrs],
	!,
	(structure(F,FN,_,NUM,[_|SLOT],[_|TYPE]),
	 !;
	 error_on_wm_class_declaration(F)),
	check_slots_attribute(Atrs, SLOT),
	reforming(Atrs,VLC,VL,[],ERL,SLOT,TYPE,Ref,NUS,NUM,F,NAE,_),
	!,
	list_to_maru_kakko(ERL,ER),
	REF =.. [FN,_|Ref],
	negative_element_restriction(ER,REF,ERN),
	!.
reform_lhs(+H,VLC,VL,[ER],[REF],[TT],NUS,_,[],1,[F],NAE) :-
	H =.. [F|Atrs],
	!,
	(structure(F,FN,_,NUM,[_|SLOT],[_|TYPE]),
	 !;
	 error_on_wm_class_declaration(F)),
	!,
	check_slots_attribute(Atrs, SLOT),
	reforming(Atrs,VLC,VL,[],ERL,SLOT,TYPE,Ref,NUS,NUM,F,NAE,_),
	list_to_maru_kakko(ERL,ER),
	REF =.. [FN,TT,_,on,_,true|Ref],
	!.
reform_lhs(H,VLC,VL,[ER],[REF],[TT],NUS,_,[],1,[F],NAE) :-
	H =.. [F|Atrs],
	!,
	(structure(F,FN,_,NUM,[_|SLOT],[_|TYPE]),
	 !;
	 error_on_wm_class_declaration(F)),
	!,
	check_slots_attribute(Atrs, SLOT),
	reforming(Atrs,VLC,VL,[],ERL,SLOT,TYPE,Ref,NUS,NUM,F,NAE,_),
	list_to_maru_kakko(ERL,ER),
	REF =.. [FN,TT|Ref],
	!.

%%%%% reforming
reforming([],VL,VL,ER,ER,SLOTS,_,Reformed,Num,NUM,F,NAE,NNAE) :-
	Num is NUM - 5,
	functor(L,f,Num),
	L =.. [f|Reformed],
	reforming_non_argument_element(F,NAE,Reformed,NNAE),
	!.
reforming(Atrs,VLC,VL,ER,ERL,[Atr|SLOTS],[Type|TYPE],[One|Reform],NUS,_,_,N,N):-
	reforming_member(Atr,OP,Value,Atrs),
	reforming_now(OP,Value,VLC,VLCC,ER,ERN,One),
	!,
	reforming(Atrs,VLCC,VL,ERN,ERL,SLOTS,TYPE,Reform,NUS,_,_,N,N).
reforming(A,VC,V,E,EL,[_|S],[_|T],[_|R],NUS,_,_,N,N):-
	reforming(A,VC,V,E,EL,S,T,R,NUSC,_,_,N,N),
	NUS is NUSC + 1.
reforming(_,V,V,E,E,[],[],[],0,_,_,N,N) :-
	!.

%%%%% reforming_non_argument_element
reforming_non_argument_element(\ F,NAE,Ref,NNAE) :-
	r_n_a_e(F,NAE,Ref,\ F,NNAE),
	!.
reforming_non_argument_element(F,NAE,Ref,NNAE) :-
	r_n_a_e(\ F,NAE,Ref,F,NNAE),
	!.

%%%%% r_n_a_e
r_n_a_e(F,[[F,Ref]|T],Ref,FF,[[FF,Ref]|T]) :-
	!.
r_n_a_e(F,[H|T],Ref,FF,[H|R]) :-
	!,
	r_n_a_e(F,T,Ref,FF,R).
r_n_a_e(F,[],Ref,FF,[[FF,Ref]]) :-
	!.
	
%%%%% reforming_member
reforming_member(One,Op,V,[H|_]):-
	H =.. [Op,One,V],
	!.
reforming_member(One,Op,V,[_|T]):-
	!,
	reforming_member(One,Op,V,T).
	
%%%%% reforming_now
reforming_now(=,V,VL,[V|VL],ER,ER,V) :-
	var(V),
	!.
reforming_now(=,[H|T],VL,VLC,ER,ER,[H|T]) :-
	rcad([H|T],VL,VLC,_),
	!.
reforming_now(=,(H;T),VL,VLC,ER,ERL,N) :-
	!,
	ref_conj_and_disj(=,(H;T),VL,VLC,ER,ERL,N),
	!.
reforming_now(=,(H,T),VL,VLC,ER,ERL,N) :-
	!,
	ref_conj_and_disj(=,(H,T),VL,VLC,ER,ERL,N),
	!.
reforming_now(=,V,VL,VL,ER,ER,V) :-
	atomic(V),
	!.
reforming_now(=,V,VL,VLC,ER,ERL,N) :-
	ref_conj_and_disj(=,V,VL,VLC,ER,ERL,N),
	!.
reforming_now(OP,V,VL,VL,ER,[NOPV|ER],N) :-
	atomic(V),
	NOPV =.. [OP,N,V],
	!.
reforming_now(OP,V,VL,VLC,ER,ERL,VV) :-
	var(V),
	VVOPV =.. [OP,VV,V],
	ref_now_matching_checker(VVOPV,[V],VL,VLC,ER,ERL),
	!.
reforming_now(OP,F,VL,VLC,ER,ERL,N) :-
	F =.. List,
	NOPF =.. [OP,N,F],
	ref_now_matching_checker(NOPF,List,VL,VLC,ER,ERL),
	!.

%%%%% ref_conj_and_disj
%ref_conj_and_disj(=,(H;T),VL,[H|VLC],ER,[(H == One;BODY)|ER],One) :-
%	var(H),
%	r_c_a_d(T,VL,VLC,TV,H,BODY),
%	TV = H,
%	!.
ref_conj_and_disj(=,(H,T),VL,[H|VLC],ER,[BODY|ER],H) :-
	var(H),
	r_c_a_d(T,VL,VLC,TV,H,BODY),
	TV = H,
	!.
ref_conj_and_disj(=,Body,VL,VLC,ER,[BODY|ER],One) :-
	r_c_a_d(Body,VL,VLC,TV,One,BODY),
	TV = One,
	!.

%%%%% r_c_a_d
r_c_a_d(A,VLC,VL,TV,One,(One == A)) :-
	var(A),
	!,
	rcad([A],VLC,VL,TV),
	!.
r_c_a_d((H;T),VLC,VL,TV,One,(One == H;BODY)) :-
	var(H),
	!,
	rcad([H],VLC,VLCC,TV),
	r_c_a_d(T,VLCC,VL,TV,One,BODY).
r_c_a_d((expr(EXPR);T),VLC,VL,TV,One,(EXPR;BODY)) :-
	!,
	r_c_a_d_expr(EXPR,VLC,VLCC),
	!,
	r_c_a_d(T,VLCC,VL,TV,One,BODY).
r_c_a_d((H;T),VLC,VL,TV,One,(Body;BODY)) :-
	!,
	r_c_a_d(H,VLC,VLCC,TV,One,Body),
	r_c_a_d(T,VLCC,VL,TV,One,BODY).
r_c_a_d((H,T),VLC,VL,TV,One,(Body,BODY)) :-
	var(H),
	rcad([H],VLC,VLCC,TV),
	!,
	r_c_a_d(T,VLCC,VL,_,One,BODY).
r_c_a_d((expr(EXPR),T),VLC,VL,TV,One,(EXPR,BODY)) :-
	!,
	r_c_a_d_expr(EXPR,VLC,VLCC),
	!,
	r_c_a_d(T,VLCC,VL,_,One,BODY).
r_c_a_d((H,T),VLC,VL,TV,One,(Body,BODY)) :-
	!,
	r_c_a_d(H,VLC,VLCC,TV,One,Body),
	r_c_a_d(T,VLCC,VL,_,One,BODY).
r_c_a_d(A > B,VLC,VL,TV,_,A > B) :-
	rcad([A,B],VLC,VL,TV),
	!.
r_c_a_d(A < B,VLC,VL,TV,_,A < B) :-
	rcad([A,B],VLC,VL,TV),
	!.
r_c_a_d(A >= B,VLC,VL,TV,_,A >= B) :-
	rcad([A,B],VLC,VL,TV),
	!.
r_c_a_d(A =< B,VLC,VL,TV,_,A =< B) :-
	rcad([A,B],VLC,VL,TV),
	!.
r_c_a_d(A \== B,VLC,VL,TV,_,A \== B) :-
	rcad([A,B],VLC,VL,TV),
	!.
r_c_a_d(A = B,VLC,VL,TV,_,A = B) :-
	rcad([A,B],VLC,VL,TV),
	!.
r_c_a_d(A == B,VLC,VL,TV,_,A == B) :-
	rcad([A,B],VLC,VL,TV),
	!.
r_c_a_d(> B,VLC,VL,_,One,One > B) :-
	rcad([B],VLC,VL,_),
	!.
r_c_a_d(< B,VLC,VL,_,One,One < B) :-
	rcad([B],VLC,VL,_),
	!.
r_c_a_d(=< B,VLC,VL,_,One,One =< B) :-
	rcad([B],VLC,VL,_),
	!.
r_c_a_d(>= B,VLC,VL,_,One,One >= B) :-
	rcad([B],VLC,VL,_),
	!.
r_c_a_d(\== B,VLC,VL,_,One,One \== B) :-
	rcad([B],VLC,VL,_),
	!.
r_c_a_d(= B,VLC,VL,_,One,One = B) :-
	rcad([B],VLC,VL,_),
	!.
r_c_a_d(== B,VLC,VL,_,One,One == B) :-
	rcad([B],VLC,VL,_),
	!.
r_c_a_d(B,VLC,VL,_,One,One = B) :-
	B =.. [_|[H|T]],
	rcad([H|T],VLC,VL,_),
	!.
r_c_a_d(B,VLC,VL,_,One,One = B) :-
	rcad([B],VLC,VL,_),
	!.

%%%%% rcad
rcad([H|T],VL,NVL,One) :-
	var(H),
	just_member(HVL),
	(var(T),
	 (just_member(T,VL),
	  NVL = [];
	  NVL = [T]);
	 !,
	 rcad(T,VL,NVL,_)).
rcad([H|T],VL,[O|R],O) :-
	var(O),
	(var(T),
	 (just_member(T,VL),
	  R=[];
	  R = [T]);
	 !,
	 rcad(T,VL,R,_)).
rcad([[A|B]|T],VL,NVL,VV) :-
	!,
	rcad([A|B],VL,VLC,_),
	!,
	rcad(T,VLC,NVL,VV).
rcad([_|T],VL,R,VV) :-
	!,
	rcad(T,VL,R,VV).
rcad(_,VL,VL,_) :-
	!.

%%%%% r_c_a_d_expr
r_c_a_d_expr((X is Y),VLC,VLCC) :-
	arith_expr_check(Y,VLC,VLCC),
	!.
r_c_a_d_expr(PRED,VLC,VLCC) :-
	PRED =.. [_|[H|T]],
	rcad([H|T],VLC,VLCC,_),
	!.

%%%%% arith_expr_check
arith_expr_check(VAR,VLC,VLCC) :-
	var(VAR),
	(just_member(VAR,VLC),
	 VLCC = VLC;
	 VLCC = [VAR|VLC]),
	!.
arith_expr_check(VALUE,VLC,VLC) :-
	!.
arith_expr_check(A * B,VLC,VLCC) :-
	!,
	arith_expr_check(A,VLCA,VLCB),
	!,
	arith_expr_check(B,VLCB,VLCC).
arith_expr_check(A / B,VLC,VLCC) :-
	!,
	arith_expr_check(A,VLCA,VLCB),
	!,
	arith_expr_check(B,VLCB,VLCC).
arith_expr_check(A - B,VLC,VLCC) :-
	!,
	arith_expr_check(A,VLCA,VLCB),
	!,
	arith_expr_check(B,VLCB,VLCC).
arith_expr_check(A + B,VLC,VLCC) :-
	!,
	arith_expr_check(A,VLCA,VLCB),
	!,
	arith_expr_check(B,VLCB,VLCC).

%%%%% negative_element_restriction
negative_element_restriction([],R,nega_wm(R)) :-
	!.
negative_element_restriction(ER,REF,nega_wm(REF,ER)) :-
	!.

%%%%% list_to_maru_kakko
list_to_maru_kakko([H],H) :-
	!.
list_to_maru_kakko([H|T],(H,R)) :-
	!,
	list_to_maru_kakko(T,R).
list_to_maru_kakko([],[]) :-
	!.

%%%%% ref_now_matching_checker
ref_now_matching_checker(Body,HT,VL,NVL,BM,[Body|BM]) :-
	one_of_just_member(HT,VL),
	append(HT,VL,NVL),
	!.
ref_now_matching_checker(B,HT,VL,VLC,BC,[B|BC]) :-
	r_n_m_c(HT,VL,VLC),
	!.

%%%%% one_of_just_member
one_of_just_member([H|T],L) :-
	just_member(H,L),
	!.
one_of_just_member([_|T],L) :-
	!,
	one_of_just_member(T,L).

%%%%% r_n_m_c
r_n_m_c([H|T],VL,[H|VLC]) :-
	var(H),
	!,
	r_n_m_c(T,VL,VLC).
r_n_m_c([_|T],VL,VLC) :-
	!,
	r_n_m_c(T,VL,VLC).
r_n_m_c([],VL,VL) :-
	!.

%%%%% compile_lhs
compile_lhs([nega_wm(H,ER)|T],LHS_List,ER_List,RN,RB,TT,VL,NUS) :-
	compiling_lhs_now(nega_wm(H),LHS_List,ER_List,CALL,MR),
	compiling_lhs_right_now(CALL,CALLING),
	H   =.. [F,HTT|Atrs],
	structure(FN,F,FF,_,_,_),
	ASS =.. [FF,-,MR,RN,RB,VL,TT,NUS,HTT|Atrs],
	compiling_lhs_assert(CALLING,ASS),
	!,
	compile_lhs(T,LHS_List,ER_List,RN,RB,TT,VL,NUS).
compile_lhs([nega_wm(H)|T],LL,EL,RN,RB,TT,VL,NUS) :-
	compiling_lhs_now(nega_wm(H),LL,EL,CALL,MR),
	compiling_lhs_right_now(CALL,CALLING),
	H   =.. [F,HTT|Atrs],
	structure(FN,F,FF,_,_,_),
	ASS =.. [FF,-,MR,RN,RB,VL,TT,NUS,HTT|Atrs],
	compiling_lhs_assert(CALLING,ASS),
	!,
	compile_lhs(T,LL,EL,RN,RB,TT,VL,NUS).
compile_lhs([H|T],LL,EL,RN,RB,TT,VL,NUS) :-
	compiling_lhs_now(H,LL,EL,CALL,MR),
	compiling_lhs_right_now(CALL,CALLING),
	H =.. [F,HTT|Atrs],
	structure(FN,F,FF,_,_,_),
	ASS =.. [FF,+,MR,RN,RB,VL,TT,NUS,HTT|Atrs],
	compiling_lhs_assert(CALLING,ASS),
	!,
	compile_lhs(T,LL,EL,RN,RB,TT,VL,NUS).
compile_lhs([],_,_,_,_,_,_,_) :-
	!.

%%%%% compiling_lhs_now
compiling_lhs_now(nega_wm(H),[nega_wm(WM,ER)|Body],
			[[]|R],[nega_wm(MR,ER,(NEGA_WM,NEGA_ER))|CALL],MR) :-
	H == WM,
	nega_wm_convert(WM,ER,NEGA_WM,NEGA_ER),
	!,
	compiling_lhs_now(nega_wm(H),Body,R,CALL,MR).
compiling_lhs_now(nega_wm(H),[nega_wm(WM)|Body],
				[[]|R],[nega_wm(MR,NEGA_WM)|CALL],MR) :-
	H == WM,
	nega_wm_convert(WM,NEGA_WM),
	!,
	compiling_lhs_now(nega_wm(H),Body,R,CALL,MR).
compiling_lhs_now(A,[nega_wm(WM,ER)|Body],[[]|R],[\+((WM,ER))|CALL],MR) :-
	!,
	compiling_lhs_now(A,Body,R,CALL,MR).
compiling_lhs_now(A,[nega_wm(WM)|Body],[[]|R],[\+(WM)|CALL],MR) :-
	!,
	compiling_lhs_now(A,Body,R,CALL,MR).
compiling_lhs_now(nega_wm(N),[H|T],[[]|R],[H|CALL],MR) :-
	!,
	compiling_lhs_now(nega_wm(N),T,R,CALL,MR).
compiling_lhs_now(nega_wm(N),[H|T],[Call|R],[H,Call|CALL],MR) :-
	!,
	compiling_lhs_now(nega_wm(N),T,R,CALL,MR).
compiling_lhs_now(A,[H|T],[[]|R],CALL,MR) :-
	A == H,
	!,
	compiling_lhs_now(A,T,R,CALL,MR).
compiling_lhs_now(A,[H|Body],[Call|R],[Call|CALL],MR) :-
	A == H,
	!,
	compiling_lhs_now(H,Body,R,CALL,MR).
compiling_lhs_now(A,[H|T],[[]|R],[H|CALL],MR) :-
	!,
	compiling_lhs_now(A,T,R,CALL,MR).
compiling_lhs_now(A,[H|Body],[Call|R],[H,Call|CALL],MR) :-
	!,
	compiling_lhs_now(A,Body,R,CALL,MR).
compiling_lhs_now(_,[],[],[],_) :-
	!.

%%%%% nega_wm/3
nega_wm(*,X,_) :-
	!,
	X.
nega_wm(_,X,Y) :-
	!,
	\+((X,Y)).

%%%%% nega_wm/2
nega_wm(*,_) :-
	!.
nega_wm(_,X) :-
	\+ X.

%%%%% nega_wm_convert/4
nega_wm_convert(WM,ER,NEGA_WM,(NTT \== TT,NEGA_ER)) :-
	WM      =.. [F,TT|Atrs],
	n_w_c(Atrs,Nega_Atrs,Vars,Nega_Vars),
	nwc(ER,Vars,NEGA_ER,Nega_Vars),
	NEGA_WM =.. [F,NTT|Nega_Atrs],
	!.

%%%%% nega_wm_convert/2
nega_wm_convert(WM,(NEGA_WM,NTT \== TT)) :-
	WM      =.. [F,TT|Atrs],
	n_w_c(Atrs,Nega_Atrs,_,_),
	NEGA_WM =.. [F,NTT|Nega_Atrs],
	!.

%%%%% n_w_c
n_w_c([H|Atrs],[NH|Nega_Atrs],[H|Vars],[NH|Nega_Vars]) :-
	var(H),
	!,
	n_w_c(Atrs,Nega_Atrs,Vars,Nega_Vars).
n_w_c([H|A],[NH|NA],V,NV) :-
	nonvar(H),
	list_element_var_check(H,V,VC,NH,NV,NVC),
	!,
	n_w_c(A,NA,NV,NVC).
n_w_c([H|A],[H|NA],V,NV) :-
	!,
	n_w_c(A,NA,V,NV).
n_w_c([],[],[],[]) :-
	!.

%%%%% list_element_var_check
list_element_var_check([H|T],V,[H|R],[NH|NT],NV,[NH|NR]) :-
	var(H),
	!,
	list_element_var_check(T,V,R,NT,NV,NR).
list_element_var_check([H|T],V,[H|R],[NH|NT],NV,[NH|NR]) :-
	list_element_var_check(H,V,VC,NH,NV,NVC),
	!,
	list_element_var_check(T,VC,R,NT,NVC,NR).
list_element_var_check([H|T],V,R,[H|NT],NV,NR) :-
	!,
	list_element_var_check(T,V,R,NT,NV,NR).
list_element_var_check([],V,V,[],NV,NV) :-
	!.
	
%%%%% nwc
nwc((H,ER),Vars,(NH,NEGA_ER),Nega_Vars) :-
	H  =.. [F|Atrs],
	nwc_copy(Atrs,Vars,Nega_Atrs,Nega_Vars),
	NH =.. [F|Nega_Atrs],
	!,
	nwc(ER,Vars,NEGA_ER,Nega_Vars).
nwc(ER,V,NEGA_ER,NV) :-
	ER      =.. [F|A],
	nwc_copy(A,V,NA,NV),
	NEGA_ER =.. [F|NA],
	!.

%%%%% nwc_copy
nwc_copy([H|T],Vars,[NH|NT],Nega_Vars) :-
	var(H),
	nwc_cp(H,Vars,Nega_Vars,NH),
	!,
	nwc_copy(T,Vars,NT,Nega_Vars).
nwc_copy([H|T],Vars,[NH|NT],Nega_Vars) :-
	nonvar(H),
	nwc_copy(H,Vars,NH,Nega_Vars),
	!,
	nwc_copy(T,Vars,NT,Nega_Vars).
nwc_copy([H|T],Vars,[H|NT],Nega_Vars) :-
	!,
	nwc_copy(T,Vars,NT,Nega_Vars).
nwc_copy([],_,[],_) :-
	!.

%%%%% nwc_cp
nwc_cp(H,[VH|Vars],[NH|Nega_Vars],NH) :-
	H == VH,
	!.
nwc_cp(H,[_|V],[_|NV],NH) :-
	!,
	nwc_cp(H,V,NV,NH).
nwc_cp(_,[],[],_) :-
	!.

%%%%% compiling_lhs_right_now
compiling_lhs_right_now([H],H) :-
	!.
compiling_lhs_right_now([H|T],(H,D)) :-
	!,
	compiling_lhs_right_now(T,D).
compiling_lhs_right_now([],true) :-
	!.

%%%%% compiling_lhs_assert
compiling_lhs_assert(true,ASS) :-
	asserta(ASS),
	!.
compiling_lhs_assert(CALLING,ASS) :-
	asserta((ASS :- CALLING)),
	!.

%%%%% negative
negative(*,CALL) :-
	!,
	not(CALL).
negative(=,CALL) :-
	!,
	CALL.

%%%%% compile_rhs
compile_rhs(Rule_Base,Rule,Val_List,Body,Designator_Names,Desig,FNF):-
	rhs_body_check(Body,BODY,Designator_Names,Desig,FNF),
	retract_all((rhs(Rule,Rule_Base,_,_,_) :- _)),
	Desig =.. [_|Desig_Vars],
	assertz(
		(rhs(Rule,Rule_Base,Val_List,Desig_Vars,Instantiation) :- BODY,!)
			),
	!.

%%%%% rhs_body_check
rhs_body_check((Body,Bodies),(BODY,BODIES),DN,Desig,FNF):-
	Body =.. [F|Atrs],
	!,
	rhs_body_checking(F,Atrs,BODY,DN,Desig,FNF),
	rhs_body_check(Bodies,BODIES,DN,Desig,FNF).
rhs_body_check((Body&Bodies),(BODY,BODIES),DN,Desig,FNF):-
	Body =.. [F|Atrs],
	!,
	rhs_body_checking(F,Atrs,BODY,DN,Desig,FNF),
	rhs_body_check(Bodies,BODIES,DN,Desig,FNF).
rhs_body_check(Body,BODY,DN,DG,FNF):-
	Body =.. [F|Atrs],
	rhs_body_checking(F,Atrs,BODY,DN,DG,FNF),
	!.

%%%%% rhs_body_checking
rhs_body_checking(make,[F,R1|R2],BODY,_,_,FNF):-
	!,
	(structure(F,FN,FF,_,[_|ANL],[_|ATL]),
	 !;
	 error_on_wm_class_declaration(F)),
	reforming_make(F,[R1|R2],ANL,ATL,RR,Restriction),
	Body =.. [make,FN,FF,RR],
	cut_true_from_restrictions(Restriction,Body,BODY),
	!.
rhs_body_checking(make,[\One],BODY,_,_,FNF) :-
	One =.. [F|R],
	!,
	(structure(F,FN,FF,_,[_|ANL],[_|ATL]),
	 !;
	 error_on_wm_class_declaration(F)),
	reforming_make(F,R,ANL,ATL,RR,Restriction),
	Body =.. [make,FN,FF,RR],
	cut_true_from_restrictions(Restriction,Body,BODY),
	!.
rhs_body_checking(make,[One],BODY,_,_,FNF) :-
	One =.. [F|R],
	!,
	(structure(F,FN,FF,_,[_|ANL],[_|ATL]),
	 !;
	 error_on_wm_class_declaration(F)),
	reforming_make(F,R,ANL,ATL,RR,Restriction),
	Body =.. [make,FN,FF,RR],
	cut_true_from_restrictions(Restriction,Body,BODY),
	!.
rhs_body_checking(modify,[N,[R1|R2]],BODY,_,Desig,FNF):-
	number(N),
	arg(N,Desig,V),
	arg(N,FNF,F),
	!,
	(structure(F,FN,FF,Arity,[_|ANL],[_|ATL]),
	 !;
	 error_on_wm_class_declaration(F)),
	r_b_c_modify(ANL,ATL,[R1|R2],RR,Restriction),
	Body =.. [modify,FN,FF,Arity,V,RR],
	cut_true_from_restrictions(Restriction,Body,BODY),
	!.
rhs_body_checking(modify,[D,[R1|R2]],BODY,DN,Desig,FNF) :-
	mem((D,N),DN),
	arg(N,Desig,V),
	arg(N,FNF,F),
	!,
	(structure(F,FN,FF,Arity,[_|ANL],[_|ATL]),
	 !;
	 error_on_wm_class_declaration(F)),
	r_b_c_modify(ANL,ATL,[R1|R2],RR,Restriction),
	Body =.. [modify,FN,FF,Arity,V,RR],
	cut_true_from_restrictions(Restriction,Body,BODY),
	!.
rhs_body_checking(modify,[N|R],BODY,_,Desig,FNF):-
	number(N),
	arg(N,Desig,V),
	arg(N,FNF,F),
	!,
	(structure(F,FN,FF,Arity,[_|ANL],[_|ATL]),
	 !;
	 error_on_wm_class_declaration(F)),
	r_b_c_modify(ANL,ATL,R,RR,Restriction),
	Body =.. [modify,FN,FF,Arity,V,RR],
	cut_true_from_restrictions(Restriction,Body,BODY),
	!.
rhs_body_checking(modify,[D|R],BODY,DN,Desig,FNF) :-
	mem((D,N),DN),
	arg(N,Desig,V),
	arg(N,FNF,F),
	!,
	(structure(F,FN,FF,Arity,[_|ANL],[_|ATL]),
	 !;
	 error_on_wm_class_declaration(F)),
	r_b_c_modify(ANL,ATL,R,RR,Restriction),
	Body =.. [modify,FN,FF,Arity,V,RR],
	cut_true_from_restrictions(Restriction,Body,BODY),
	!.
rhs_body_checking(remove,[N],Body,_,Desig,FNF):-
	number(N),
	arg(N,Desig,V),
	arg(N,FNF,F),
	!,
	(structure(F,FN,FF,Arity,[_|ANL],[_|ATL]),
	 !;
	 error_on_wm_class_declaration(F)),
	Body =.. [remove,FN,FF,Arity,V],
	!.
rhs_body_checking(remove,[D],Body,DN,Desig,FNF) :-
	mem((D,N),DN),
	arg(N,Desig,V),
	arg(N,FNF,F),
	!,
	(structure(F,FN,FF,_,_,_),
	 !;
	 error_on_wm_class_declaration(F)),
	Body =.. [remove,FN,FF,V],
	!.
rhs_body_checking((;),[A,D],(BODY_A;BODY_D),DN,Desig,FNF) :-
	!,
	rhs_body_check(A,BODY_A,DN,Desig,FNF),
	!,
	rhs_body_check(D,BODY_D,DN,Desig,FNF),
	!.
rhs_body_checking(F,A,BODY,_,_,_):-
	BODY =.. [F|A],
	!.

%%%%% negative_modify
negative_modify([[H|T]],[H|T],N,_,Desig,FNF,F,V) :-
	number(N),
	arg(N,Desig,V),
	arg(N,FNF,F),
	!.
negative_modify([[H|T]],[H|T],N,DN,Desig,FNF,F,V) :-
	mem((D,N),DN),
	arg(N,Desig,V),
	arg(N,FNF,F),
	!.
negative_modify([H|T],[H|T],N,_,Desig,FNF,F,V) :-
	number(N),
	arg(N,Desig,V),
	arg(N,FNF,F),
	!.
negative_modify([H|T],[H|T],N,DN,Desig,FNF,F,V) :-
	mem((D,N),DN),
	arg(N,Desig,V),
	arg(N,FNF,F),
	!.
	
%%%%% r_b_c_modify
r_b_c_modify([_|AT],[_|TT],[],['$$nil'|RT],Restriction) :-
	!,
	r_b_c_modify(AT,TT,[],RT,Restriction).
r_b_c_modify([AH|AT],[TH|TT],R,[RH|RT],[One|Restriction]) :-
	rbc_modify(AH,R,NR,X),
	type_check_and_call(TH,X,RH,One),
	!,
	r_b_c_modify(AT,TT,NR,RT,Restriction).
r_b_c_modify([_|AT],[_|TT],R,['$$nil'|RT],Restriction) :-
	!,
	r_b_c_modify(AT,TT,R,RT,Restriction).
r_b_c_modify([],[],_,[],[]) :-
	!.

%%%%% rbc_modify
rbc_modify(AH,[AH = X|T],T,X) :-
	!.
rbc_modify(AH,[H|T],[H|NT],X) :-
	!,
	rbc_modify(AH,T,NT,X).

%%%%% type_check_and_call
type_check_and_call(number, X, X, true     ) :-
	number(X),
	!.
type_check_and_call(atom,   X, X, true     ) :-
	atomic(X),
	!.
type_check_and_call(atomic, X, X, true     ) :-
	atomic(X),
	!.
type_check_and_call(number, X, X, number(X)) :-
	var(X),
	!.
type_check_and_call(atom,   X, X, atom(X)  ) :-
	var(X),
	!.
type_check_and_call(atomic, X, X, atomic(X)) :-
	var(X),
	!.
type_check_and_call(list,   X, X, list(X)  ) :-
	var(X),
	!.
type_check_and_call(non,    X, X, true     ) :- !.
type_check_and_call(number,X,XX,(CALL,number(XX))) :-
	X =.. [F|R],
	CALL =.. [F,XX|R],
	current_predicate(F,CALL),
	!.
type_check_and_call(atom,X,XX,(CALL,atom(XX))) :-
	X =.. [F|R],
	CALL =.. [F,XX|R],
	current_predicate(F,CALL),
	!.
type_check_and_call(atomic,X,XX,(CALL,atomic(XX))) :-
	X =.. [F|R],
	CALL =.. [F,XX|R],
	current_predicate(F,CALL),
	!.
type_check_and_call(list,X,XX,(CALL,list(XX))) :-
	X =.. [F|R],
	CALL =.. [F,XX|R],
	current_predicate(F,CALL),
	!.
type_check_and_call(_,X,XX,CALL) :-
	X =.. [F|R],
	CALL =.. [F,XX|R],
	current_predicate(F,CALL),
	!.
	
%%%%% cut_true_from_restrictions/2
cut_true_from_restrictions([CALL],CALL) :-
	!.
cut_true_from_restrictions([true|R],BODY) :-
	!,
	cut_true_from_restrictions(R,BODY).
cut_true_from_restrictions([H|R],(H,BODY)) :-
	!,
	cut_true_from_restrictions(R,BODY).

%%%%% cut_true_from_restrictions/3
cut_true_from_restrictions([true|R],Body,BODY) :-
	!,
	cut_true_from_restrictions(R,Body,BODY).
cut_true_from_restrictions([H|R],Body,(H,BODY)) :-
	!,
	cut_true_from_restrictions(R,Body,BODY).
cut_true_from_restrictions([],Body,Body) :-
	!.

%%%%% erase_rule
erase_rule(RN,RB) :-
	structure(_,_,RH,N,_,_),
	e_r(RH,RN,RB,N),
	fail.
erase_rule(_,_) :-
	!.

%%%% e_r
e_r(RH,RN,RB,N) :-
	functor(L,d,N),
	L =.. [d|Atrs],
	ASS =.. [RH,_,_,RN,RB,_,_,_|Atrs],
	retract_all(ASS),
	retract_all((ASS :- _)),
	retract_all((rhs(RN,RB,_,_,_,_,_) :- _)),
	!.

%%%%% error_on_wm_class_declaration
error_on_wm_class_declaration(CLASS) :-
	nl,
	write('WM class '),
	write(CLASS),
	write(' is not declared...'),
	nl,
	!,
	fail.

%%%%% check_slots_attribute
check_slots_attribute([],   _) :-
	!.
check_slots_attribute([H|T], Attribute_List) :-
	H =.. [_, Attribute, _],
	mem(Attribute, Attribute_List),
	!,
	check_slots_attribute(T, Attribute_List).
check_slots_attribute([H|T], AL) :-
	nl,
	write('Warning from Rule Compiler ...'),
	nl,
	write('   Wrong Attribute :'),
	write(H),
	nl,
	!,
	check_slots_attribute(T, AL).
