%      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.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%% DEBUGGING %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/*
 Debugging Tools

 # watch   --- set display mode for debugging data in Recognize-Act-Cycle
	  USAGE: watch(Rule_Base_Name,Number).

		* Rule_Base_Name  --- Rule Field Name.

		* Number --- 0, 1, 2 or 3. These integers set each mode.
			     If no argument or wrong argument, display
			     informations for set watch mode.

 # ppwm    --- display all working memories
	  USAGE: ppwm(Rule_Base_Name).

		* Rule_Base_Name  --- Rule Field Name.

 # cs      --- dispaly all instantiations of conflict set
	  USAGE: cs(Rule_Base_Name).

		* Rule_Base_Name --- Rule Field Name.

 # wm_clear   --- initialize working memory area
	  USAGE: wm_clear(Rule_Base_Name).

		* Rule_Base_Name --- Rule Field Name.

 # pm_clear --- Clear All Compiled Rules in Core
	  USAGE: pm_clear(Rule_Base_Name).

		* Rule_Base_Name --- Rule Field Name.

*/

%%%%% PPM

%%%%% PPPM

%%%%% WATCH/2
watch(Rule_Base,N) :-
	integer(N),
	N >=0,
	(N =<5
		;
	 N >=10,
	 N =<14),
	!,
	retract(watch_mode(Rule_Base,_)),
	display(N),
	ttynl,
	asserta(watch_mode(Rule_Base,N)),!.
watch(_,N) :-
	display(N),
	display(' is Not Applicable ...'),
	ttynl,
	ttynl,
	display('*** Watch Mode Level ***'),
	ttynl,
	display('Level---Mode'),
	ttynl,
	display('  0 --- no trace information'),
	ttynl,
	display('  1 --- dispaly the name of each production that fires'),
	ttynl,
	display('	    along with a list of the time tags of'),
	ttynl,
	display('	    instantiating the production.'),
	ttynl,
	display('  2 --- display the information of level 1,'),
	ttynl,
	display('           and display current WM.'),
	ttynl,
	display('  3 --- display the information of level 1.'),
	ttynl,
	display('	    and display new conflict set at every Recognaize-Act Cycle'),
	ttynl,
	display('  4 --- display the informanion of level 2,'),
	ttynl,
	display('	    and display the information of level 3.'),
	ttynl,
	display(' 11 --- display the name of each production that fires'),
	ttynl,
	display('	    along with a list of the time tags of'),
	ttynl,
	display('	    instantiating the production,'),
	ttynl,
	display('	    and display rule base name the production belonged to.'),
	ttynl,
	display(' 12 --- display the information of level 11,'),
	ttynl,
	display('	    and display current WM.'),
	ttynl,
	display(' 13 --- display the information of level 11.'),
	ttynl,
	display('	    and display new conflict set at every Recognaize-Act Cycle'),
	ttynl,
	display(' 14 --- display the informanion of level 12,'),
	ttynl,
	display('	    and display the information of level 13.'),
	ttynl,
	!.

%%%%% WATCH/1
watch(Rule_Base) :-
	watch_mode(Rule_Base,N),
	display('Current Watch Mode = '),
	display(N),
	ttynl,
	!.
watch(Number) :-
	integer(Number),
	rule_base_name(RB),
	watch(RB,Number).

%%%%% WATCH/0
watch :-
	watch_mode(RB,N),
	display('Current Watch Mode of '),
	write(RB),
	write(' = '),
	display(N),
	ttynl,
	fail.
watch :-
	!.

%%%%% watch_disp/2
watch_disp(2,RB) :-
	ppwm,
	!.
watch_disp(3,RB) :-
	write('New Conflict Set ---------------'),
	nl,
	cs(RB),
	write('--------------------------------'),
	nl,
	nl,
	!.
watch_disp(4,RB) :-
	ppwm,
	watch_disp(3,RB),
	!.
watch_disp(5,RB) :-
	ppwm,
	watch_disp(3,RB),
	!.
watch_disp(12,RB) :-
	ppwm,
	!.
watch_disp(13,RB) :-
	watch_disp(3,RB),
	!.
watch_disp(14,RB) :-
	ppwm,
	watch_disp(3,RB),
	!.
watch_disp(_,_) :-
	!.

%%%%% watch_disp/4
watch_disp(0,_,_,_) :-
	!.
watch_disp(N,_,R,I) :-
	N > 0,
	N < 6,
	write(R),
	write(' : '),
	write(I),
	nl,
	!.
watch_disp(10,RB,R,_) :-
	write(RB),
	write('>>> '),
	write(R),
	nl,
	!.
watch_disp(N,RB,R,I) :-
	N > 10,
	N < 15,
	write(RB),
	write('>>> '),
	write(R),
	write(' : '),
	write(I),
	nl,
	!.

%%%%% PPWM
ppwm :-
	pp_wm,
	ppwm_collect(ppwm,WM),
	keysort(WM,PPWM),
	pretty_print_wm(PPWM,1),
	!.

%%%%% PPWM_ALL
ppwm_all :-
	pp_wm_all,
	ppwm_collect(ppwm,WM),
	keysort(WM,PPWM),
	pretty_print_wm(PPWM,1),
	!.

%%%%% pp_wm
pp_wm :-
	structure(F,FN,_,A,[_|ANL],_),
	functor(Call,FN,A),
	Call =.. [FN,Time_Tag|WM],
	Call,
	p_p_wm(ANL,WM,PPWM),
	Disp =.. [F|PPWM],
	REMOVE =.. [FN|WM],
	asserta(ie_ppwm_tmp(Time_Tag-(on,KS,B,Disp)-REMOVE)),
	fail.
pp_wm :-
	!.

%%%%% pp_wm_all
pp_wm_all :-
	structure(F,FN,_,A,[_|ANL],_),
	functor(Call,FN,A),
	Call =.. [FN,Time_Tag|WM],
	Call,
	p_p_wm(ANL,WM,PPWM),
	Disp =.. [F|PPWM],
	REMOVE =.. [FN|WM],
	asserta(ie_ppwm_tmp(Time_Tag-(EF,KS,B,Disp)-REMOVE)),
	fail.
pp_wm_all :-
	!.

%%%%% p_p_wm
p_p_wm([A|D],[H|T],[A = H|R]) :-
	!,
	p_p_wm(D,T,R).
p_p_wm([],[],[]) :-
	!.

%%%%% ppwm_collect
ppwm_collect(ppwm,[Time_Tag-DISP|T]) :-
	retract(ie_ppwm_tmp(Time_Tag-DISP-_)),
	!,
	ppwm_collect(ppwm,T).
ppwm_collect(remove,[Time_Tag-WM|T]) :-
	retract(ie_ppwm_tmp(Time_Tag-_-WM)),
	!,
	ppwm_collect(remove,T).
ppwm_collect(_,[]) :-
	!.

%%%%% pretty_print_wm
pretty_print_wm([TT-(on,fact,true,H)|T],N) :-
	!,
	NN is N + 1,
	pretty_print_wm(T,NN),
	write(N),
	write(' :: '),
	write(TT),
	write(' : '),
	write(H),
	nl,
	!.
pretty_print_wm([TT-(on,fact,fail,H)|T],N) :-
	!,
	NN is N + 1,
	pretty_print_wm(T,NN),
	write(N),
	write(' :: '),
	write(TT),
	write(' : \'),
	write(H),
	nl,
	!.
pretty_print_wm([TT-(on,assumption,true,H)|T],N) :-
	!,
	NN is N + 1,
	pretty_print_wm(T,NN),
	write(N),
	write(' :: '),
	write(TT),
	write(' : '),
	write(H),
	write('*'),
	nl,
	!.
pretty_print_wm([TT-(on,assumption,fail,H)|T],N) :-
	!,
	NN is N + 1,
	pretty_print_wm(T,NN),
	write(N),
	write(' :: '),
	write(TT),
	write(' : \'),
	write(H),
	write('*'),
	nl,
	!.
pretty_print_wm([TT-(off,fact,true,H)|T],N) :-
	!,
	NN is N + 1,
	pretty_print_wm(T,NN),
	write(N),
	write(' :: '),
	write(TT),
	write(' : # '),
	write(H),
	nl,
	!.
pretty_print_wm([TT-(off,fact,fail,H)|T],N) :-
	!,
	NN is N + 1,
	pretty_print_wm(T,NN),
	write(N),
	write(' :: '),
	write(TT),
	write(' : # \'),
	write(H),
	nl,
	!.
pretty_print_wm([TT-(off,assumption,true,H)|T],N) :-
	!,
	NN is N + 1,
	pretty_print_wm(T,NN),
	write(N),
	write(' :: '),
	write(TT),
	write(' : # '),
	write(H),
	write('*'),
	nl,
	!.
pretty_print_wm([TT-(off,assumption,fail,H)|T],N) :-
	!,
	NN is N + 1,
	pretty_print_wm(T,NN),
	write(N),
	write(' :: '),
	write(TT),
	write(' : # \'),
	write(H),
	write('*'),
	nl,
	!.
pretty_print_wm([],_) :-
	!.

%%%%% CS/0
cs :-
	cs(Rule_Base,CS),
	write(Rule_Base),
	write('--------------------'),
	nl,
	cs_disp(CS),
	write('--------------------'),
	nl,
	fail.
cs :-
	!.

%%%%% CS/1
cs(Rule_Base) :-
	cs(Rule_Base,CS),
	!,
	cs_disp(CS).

%%%%% cs_disp
cs_disp([[R,I,_,_,_]|T]) :-
	display(R),
	display('  '),
	write(I),
	ttynl,
	!,
	cs_disp(T).
cs_disp(_) :-
	!.

%%%%% WM_CLEAR
wm_clear :-
	write('All Working Memories'),
	nl,
	write('CLEAR ...'),
	ttynl,
	(structure(CE_Name,CE_NAME,_,Num,_,_),
	 functor(RET,CE_NAME,Num),
	 retract(RET),
	 fail;
	 true),
	!.

%%%%% PM_CLEAR/0
pm_clear :-
	strategy_rec(Rule_Base,_,_),
	pm_clear(Rule_Base),
	fail.
pm_clear.

%%%%% PM_CLEAR/1
pm_clear(Rule_Base) :-
	write('All Rules in '),
	write(Rule_Base),
	write(' Clear ...'),
	ttynl,
	erase_rule(_,RB),
	retract_all(ie_to_eden(_,Rule_Base,_)),
	retract_all(strategy_rec(Rule_Base,_,_)),
	retract_all(rule_base_name(Rule_Base)),
	retract_all(watch_mode(Rule_Base,_)),
	retract_all(cs(Rule_Base,_)),
	write('                 ... END'),
	ttynl,
	!.

%%%%% CS_CLEAR/0
cs_clear :-
	cs(Rule_Base,_),
	cs_clear(Rule_Base),
	fail.
cs_clear.

%%%%% CS_CLEAR/1
cs_clear(Rule_Base) :-
	write('Conflict  Set of '),
	write(Rule_Base),
	write(' clear '),
	ttynl,
	retract_all(cs(Rule_Base,_)),
	asserta(cs(Rule_Base,[])),
	write('                 ... END'),
	ttynl,
	!.

%%%%%% IE_CLEAR
ie_clear :-
	wm_clear,cs_clear,
	retract_all(kgc_data(_,_,_,_)),
	retract_all(back_data(_,_,_)),
	(clear;true),
	retract_all(solving_contradiction(_,_,_,_)),
	!.

%%%%% CRD/0
crd :-
	cs(RB,[[RN0,TT0,STT0,NUS0,VL0]|CS]),
	crd(RB,RN0,TT0,STT0,NUS0,VL0,CS),
	fail.
crd :-
	!.

%%%%% crd/7
crd(RB,RN0,TT0,STT0,NUS0,VL0,CS) :-
	write('Dominated Rule of '),
	write(RB),
	write('----------'),
	nl,
	strategy_rec(RB,_,S),
	conflict_resolution(S,CS,[RN0,TT0,STT0,NUS0,VL0],[RNS,TTS,_,_,_],_),
	write(RNS),
	write(' '),
	write(TTS),
	!.

