/*
 Copyright (C) 1988,2005, Shinji Kono 
 Everyone is permitted to copy and distribute verbatim copies
 of this license, but changing it is not allowed.  You can also
 use this wording to make the terms for other programs.

 send your comments to kono@ie.u-ryukyu.ac.jp
*/

/*

	Tokio to prolog compiler
		Runtime routine
		with register list

 					Mon Aug  5 09:01:29 JST 1985
	fix put_queue			Fri Jan 24 11:47:11 JST 1986
	add tracer			Sun Jun 22 12:47:21 JST 1986
	fix empty/notempty		Wed Mar  9 09:24:47 JST 1988
        reducing compile time   	Fri Oct 14 03:27:08 JST 1988
	add mcom and fix chop		Sat Aug  5 22:25:15 JST 1989
        meta call supported             Sun Aug  6 00:55:42 JST 1989
	$Header$
*/

:-dynamic(r_fififi/1).
:-dynamic(r_skip/1).

r_header :-
 write('
 Tokio to prolog compiler $Revision$ $Date$
           try ?- tokio_help.
  ').

user_help :- tokio_help.
tokio_help :-
    nl, r_header,nl,
write('   com(File).       : compile & compile program.    '),nl,
write('   com(File,Output).: compile & counsult & save file.    '),nl,
write('   pcom(File,Predicate-heads).       : compile specified predicates.    '),nl,
write('   pcom(File,Predicate-heads,Output).: compile specified predicates.    '),nl,
write('   mcom(File).       : preprocess '),nl,
write('   mcom(File,Output).: preprocess & outputfile.'),nl,
write('   restart(File).   : run tokio save file.    '),nl,
write('   tokiodebug.      : All computation will be traced.    '),nl,
write('   tokionodebug.    : Debug mode is switched off.    '),nl,
write('   tokiodebugging.  : Display some informations about tracing.    '),nl,
write('   notimebacktrack. : no time backtrack.. '),nl,
write('   timebacktrack.   : time backtrack.. '),nl,
write('   tokio.           : start tokio top-level. '),nl,
write('   tokio predicate.   : run tokio program. '),nl,
write('   reset_macro.     : Reset Macro Definition. com predicates also reset Macros.'),nl.
% write('   tokiospy         : All predicate will be traced.   '),nl,
% write('   tokiospy(F/N)    : Predicate F which have N arity will be traced.'),nl,
% write('   tokionospy       : All spy point are removed.    '),nl,
% write('   tokionospy(F/N)  : Spy point F/N will be removed.    '),nl,
% write('   tokiodebugat(T)  : Tracing will be start at time=Time.    '),nl,
% write('   tokionodebugat   : Start point of tracing is removed.    '),nl,

r_tokio0(Goals) :-
    cputime(Time),
    r_do_solve(Goals, C),
    cputime(Time1),
    T is (Time1-Time),				% sec
    r_tokiostats(C, T).
r_tokio0(_Goals) :- nl, write('--fail--'), nl.

r_do_solve(Goals,C) :-
    r_put_queue(Goals, X, true, Q, Q1),
    r_notEmpty(Q),
  ( recorded(tokiodebug, on, _), !,
	r_solve_t(X,C,0,Q,Q1);
    recorded(timebacktrack, off, _), !,
	r_solve_d(X,C,0,Q,Q1);
    r_solve(X,C,0,Q,Q1)).

notimebacktrack :- recorded(timebacktrack,_,Ref),erase(Ref),fail.
notimebacktrack :- recorda(timebacktrack,off,_Ref).
timebacktrack :- recorded(timebacktrack,_,Ref),erase(Ref),fail.
timebacktrack :- recorda(timebacktrack,on,_Ref).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Quick and Easy Compile
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
r_put_queue(X, Y, Y, Q, Q) :- var(X),!,
	write('cannot call variable:'),write(X),nl.
r_put_queue(X, (unifyNow(X,Xn),Xn,Y), Y, Q, Q) :- systemp(X),!.
% Tokio's varible is local, so, meta call is also local to 
% its value. But I don't care about its arguments.
r_put_queue('$t'(Now,_Next),Z, Z1,Q, Q1) :- !,
	r_put_queue(Now, Z, Z1,Q, Q1).
r_put_queue((X,Y), Z, Z1, Q, Q1) :- !,
    r_put_queue(X,Z, Z2, Q,Q2),
    r_put_queue(Y,Z2,Z1,Q2,Q1).
r_put_queue(#P, (r_always(P,Q,Q1),Y), Y, Q, Q1) :- !.
r_put_queue(next(P), (r_next(P,Q,Q1),Y), Y, Q, Q1) :- !.
r_put_queue(length(N), (r_length(M,Q),Y), Y, Q, Q) :- !,	% restricted length
    M is N.
r_put_queue(P, (P1,Y), Y, Q, Q1) :-
    functor(P, H, N), N2 is N+2, N1 is N+1,
    functor(P1, H, N2), arg(N1, P1, Q), arg(N2, P1, Q1),
    r_put_queue_arg(N,P,P1).

r_put_queue_arg(0,_,_) :- !.
r_put_queue_arg(M,F,F1) :-
    arg(M,F,FA),arg(M,F1,FA),M1 is M-1,
    r_put_queue_arg(M1,F,F1).

r_tokiostats(L, T) :-  nl,
        write(L), write(' clock and '),
	write(T), write(' sec. '), nl.

r_always(X,['$t'((r_always(Xn,Q,Q2),N),F,E,C)|Q],Q1) :- 
	unifyNowNext(X,Xx,Xn),
	'tokio_call'(Xx,['$t'(N,F,E,C)|Q2],Q1).
r_next(X,['$t'(N,F,E,C)|Q],                  % same as next(tokio_call(X))
	['$t'(N1,F,E,C)|Q1]) :- unifyNext(X,Xn),
	r_put_queue(Xn,N,N1,Q,Q1).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Tokio Temporal Resolution
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
r_solve(r_end,_Fin,_Now,_X,_Y) :- !.
r_solve(X,Fin,Now,['$t'(Next,F,K,'$'(Fin,Now,Empty))|Futures],
		['$t'(true,true,true,'$'(Fin,Now,Empty))|True]) :-
	NextTime is Now+1,
	nl,write('t'),write(Now),write(':'),ttyflush,
	call(X),
	r_exec_fin_keep(Empty,Fin,Now,F,K,Next,Next1),
	r_solve(Next1, Fin, NextTime, Futures, True).
r_solve(_,_,Now,_,_) :- B is Now-1, B>0, nl,write(b),write(B),write(':'),
	ttyflush,!,fail.

r_solve_t(r_end,_Fin,_Now,_X,_Y) :- !.
r_solve_t(X,Fin,Now,['$t'(Next,F,K,'$'(Fin,Now,Empty))|Futures],
		['$t'(true,true,true,'$'(Fin,Now,Empty))|True]) :-
	r_tokioDebug(t(Empty,X,Fin,Now,F,K,Next,Futures,True),Now),
	NextTime is Now+1,
	nl,write('t'),write(Now),write(':'),ttyflush,
	call(X),
	r_exec_fin_keep(Empty,Fin,Now,F,K,Next,Next1),
	r_solve_t(Next1, Fin, NextTime, Futures, True).
r_solve_t(_,_,Now,_,_) :- B is Now-1, B>0, nl,write(b),write(B),write(':'),
	ttyflush,!,fail.

r_solve_d(r_end,_Fin,_Now,_X,_Y) :- !.
r_solve_d(X,Fin,Now,['$t'(Next,F,K,'$'(Fin,Now,Empty))|Futures],
		['$t'(true,true,true,'$'(Fin,Now,Empty))|True]) :-!,
	NextTime is Now+1, call(X),
	r_exec_fin_keep(Empty,Fin,Now,F,K,Next,Next1),
	r_solve_d(Next1, Fin, NextTime, Futures, True).

r_exec_fin_keep(empty,	Fin, Fin, F, _, _, r_end) :- !,	% end at this time
	call(F).
r_exec_fin_keep(notEmpty,	Now, Fin, _, K, Next, Next) :-
	Now \== Fin,
	call(K).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Chop Operator Runtime
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
r_subBegin(['$t'(_,_,_,'$'(_,Now,_))|Q],		% original interval
	['$t'((r_subBegin(Q,SQ,SQ1,Fin),N),F,K,'$'(Fin,Now,E))|SQ],
	['$t'(N,F,K,'$'(Fin,Now,E))|SQ1],Fin).	% subinterval's Fin

r_subFin( ['$t'(_, F   , _, '$'(Fin,Fin,empty))  | _  ],	% outer fin?
	['$t'(_, true, _, '$'(Fin,Fin,empty))  | _  ]) :-
	call(F).

r_subNotFin( LaterLoop, '$'(Q,Q1,QF,QF1),
	['$t'(N,  F,  K,  '$'(OuterFin,Now,notEmpty)) | Q   ],
	['$t'(N1, F1, K1, '$'(OuterFin,Now,notEmpty)) | Q1  ],
	['$t'(N,  F,  K,  '$'(Fin,Now,Empty)) | QF ],
	['$t'((LaterLoop,N1), F1, K1, '$'(Fin,Now,Empty)) | QF1  ]) :-
	r_sub_check(OuterFin,Now,Fin).

r_sub_check(OuterFin,Now,Fin) :- var(OuterFin),!,
	r_sub_check2(Fin,Now).
r_sub_check(OuterFin,Now,Fin) :- 
	OuterFin > Now,r_sub_check3(OuterFin,Now,Fin). %%%% Fin > Now, OuterFin > Now
r_sub_check2(Fin,_Now) :- var(Fin),!.                  %%%% freeze(Fin,Fin>Now).
r_sub_check2(Fin,Now) :- Fin>Now.
r_sub_check3(_OuterFin,_Now,Fin) :- var(Fin),!.       %%%% freeze(Fin,(N<F,F<O))
r_sub_check3(OuterFin,Now,Fin) :- Now<Fin,Fin<OuterFin.

%%%%%%%%%%%%%%%%%%%%%%%%%
% meta call ( same restriction as top level )
%%%%%%%%%%%%%%%%%%%%%%%%%
tokio_call(A,Q,Q) :- var(A),!,
	write('uninstantiated meta call'),nl.
tokio_call(A,Q,Q1) :-
	r_put_queue(A, X, true, Q, Q1),
	call(X).

%%%%%%%%%%%%%%%%%%%%%%%%%
% Tokio System Call
%%%%%%%%%%%%%%%%%%%%%%%%%
%  Thanks for Prof. Esterline and Dr. Kilis
r_empty(['$t'(_,_,_,'$'(F,F,empty))|_]).
r_notEmpty(['$t'(_,_,_,'$'(F,N,notEmpty))|_]):- F\==N.

r_length( 0, ['$t'(_,_,_,'$'(Fin,Fin,empty))|_] ) :-!.
r_length( L, ['$t'(_,_,_,'$'(Fin,Now,notEmpty))|_] ) :-
	Fin is Now+L.

r_cputime(X) :- statistics(runtime,[X1,_]),X is X1/1000.
r_cputime(X,Q,Q) :- r_cputime(X).


%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Static Variable Runtime
%%%%%%%%%%%%%%%%%%%%%%%%%%%
r_set_value(Name,Value) :- var(Value),!,
	write('Assign non fixed value = '),
	write(Name),nl.
r_set_value(Name,Value) :-
%%%%%%%	r_check(Name,Time),
	recorded(Name,(Name,V,_Time),_),!,V=Value.
r_set_value(Name,Value) :-
%%%%%%%	r_check(Name,Time),
	recorda(Name,(Name,Value,_Time),_).
r_set_value(Name,Value) :-
	recorded(Name,(Name,Value,_),Ref),
	erase(Ref),!,fail.

r_set_value(Name,Value,_Time) :- var(Value),!,
	write('Assign non fixed value = '),
	write(Name),nl.
r_set_value(Name,Value,Time) :-
	recorded(Name,(Name,V,Time),_),!,V=Value.
r_set_value(Name,Value,Time) :-
	recorda(Name,(Name,Value,Time),_).
r_set_value(Name,Value,Time) :-
	recorded(Name,(Name,Value,Time),Ref),
	erase(Ref),!,fail.

% Special Cases

% #(A=B)
%    variable vs varible
%    variable vs time constance
% *i <= ??

r_eq(A,B,['$t'((r_eq(C,D,E,F),G),H,I,J)|E],['$t'(G,H,I,J)|F]) :- 
	unifyNowNext(A,K,C),unifyNowNext(B,K,D).
r_eqn(A,B,['$t'((r_eqn(C,B,D,E),F),G,H,I)|D],['$t'(F,G,H,I)|E]) :- 
	unifyNowNext(A,B,C).
r_assign(Static,A,['$t'((r_assign(Static,A,B,C),D),(r_set_value(Static,A,Time),E),F,G)|B],
	['$t'(D,E,F,G)|C]):- G='$'(_Fin,Time,_Empty).



% r_check(Name,Time) :- 
% 	recorded(time,Time,_),
%	(	recorded(Name,(Name,Value1,Time),_),
%		report_conflict(Name,Name,Time)
%	;	true),
%	(	recorded(r_write,(Name,Bus),_),(
%		    recorded(Bus,(Name2,Time),_),
%		    report_conflict(Name,Name2,Time)
%	    	;   recorda(Bus,(Name,Time),_))
%	; true),!.

r_read_value(Name,Value) :- recorded(Name,(Name,Value1,_),_),!,
%	recorded(time,Time,_),
%	recorda(Name,(Name,Value1,Time),_),
%	(	recorded(r_read,(Name,Bus),_),(
%		    recorded(Bus,(Name2,Time),_),Name2 \= Name,
%		    report_conflict(Name,Name2,Time)
%		;   recorda(Bus,Name,_))
%	;	true),!,
	Value = Value1.
r_read_value(Name,_Value) :- nl,
	write('Reference Not assigned value -- '),
	write(Name),nl.

init_static :- recorded(r_static,Name,_),recorded(Name,_,Ref),
	erase(Ref),fail.
init_static :- abolish(r_skip,1),
	assert(r_skip(-1)).

reset_static :- recorded(r_static,Name,Iref),recorded(Name,_,Ref),
	erase(Ref),erase(Iref),fail.

static([]) :- !.
static([H|T]) :- !,static(H),static(T).


% static(Name=Bus) :- !,static(Name),static(Bus),
% 	r_read_bus(Name,Bus),r_write_bus(Name,Bus).
% static(Name=[RBus,WBus]) :- !,static(Name),static(Bus),
% 	r_read_bus(Name,RBus),r_write_bus(Name,WBus).
static(Name) :- functor(Name,_H,_),recorded(r_static,Name,_),!.
static(Name) :- functor(Name,_H,_),recordz(r_static,Name,_).

static_memory(L) :- static(L).
static_register(L) :- static(L).

r_read_bus(Name,Bus) :-
	(recorded(r_read,(Name,Bus),_);recordz(r_read,(Name,Bus),_)).
r_write_bus(Name,Bus) :-
	(recorded(r_write,(Name,Bus),_);recordz(r_write,(Name,Bus),_)).

/* :- static(time). */

% r_report_conflict(Name,Name2,Time) :- nl,
% 	write('Conflict *'),
% 	write(Name),write(' and *'),
% 	write(Name2),write(' at '),
% 	write(Time).

% A \= A :-!,fail.
% _ \= _.

append([],X,X).
append([H|X],Y,[H|Z]) :- append(X,Y,Z).

member(H,[H|_]) :-!.
member(H,[_|T]) :- member(H,T).

/* for ttyflush  */

/* :- (ttyflush ; assert(ttyflush) ). */

/* end of runtime */