/*
 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 compiler to prolog
					Thu Aug 15 12:17:04 JST 1985
					Fri Jan 10 16:11:31 JST 1986
					Fri Sep  5 09:51:36 JST 1986 for 1.2a
					Thu Mar 26 16:19:10 JST 1987
					Wed Oct 14 13:35:54 JST 1987 full time F
					Fri Oct 16 11:28:26 JST 1987 Sicstus
					$Header$
	  body-compiler
*/

c_clause((Head :- Body), (H :- B)) :- !, 
    c_opt(Body, NBody, _), 				% delete true
    c_body(NBody, Control,
	['$t'(B1,_,_,_)|Q] , ['$t'(true,_,_,_)|T1], before_cut-_), 	
							% make queue structure
    c_head(Head, H0, B2, B1,Control,Q),  			% inline unification
    c_opt(B2, B, _),					% off tailing true
    c_make_pred(H0, H, Q, T1). 
c_clause(Head, H) :-					% fact
    c_head(Head, H0, B2, true,_,_),
    c_make_pred(H0, H1, Q, Q),
    c_opt(B2, B, _),					% off tailing true
    (B = true, H = H1,! ; H = (H1 :- B)).

c_error(A) :-
    telling(Old),tell(user),
    call(A),
    tell(Old).

/*

    c_head(Head, ModfiedHead, Qhead, Qtail)

*/

c_head(H,Mh,Qh0,Qt,Control,Q) :-
    c_control_reference(Control,Qh0,Qh,Q),
    functor(H,F,A),functor(Mh,F,A),
    c_args(0,A, H, Mh, Qh, Qt).

c_args(N, N, _, _, Q, Q) :- !. 
c_args(K, N, Head, H, Q, Q1) :- 
    K1 is K+1, arg(K1, Head, AK), arg(K1, H, HK), 
    c_unify(AK, HK, Q, Q2, 8),  
    c_args(K1, N, Head, H, Q2, Q1). 

% We needs NOW value however sometines is is hiden in Next time Queue
c_control_reference(Control,(Q=['$t'(_N,_F,_K,'$'(_,NowTime,_))|_],Qh),Qh,Q) :- 
	Control = '$'(_Fin,Now,_Empty),nonvar(Now),var(Q),
	Now = '$REF'(NowTime),!.
c_control_reference(_Control,Qh,Qh,_Q).	

/*

    Tokio compiler Queue structure

    [Qnow,Qnext1,Qnext2,......|_],[QnowTail,Qnext1Tail,Qnext2Tail,.....|_]
			D-list
    Qnow = '$t'(Next,Fin,Keep,'$'(Fin,Now,Empty))

	predicate(A):- p,q.
	    ---> predicate(A,Q,Q1) :- 
		    p(Q,Q2),q(Q2,Q1).
*/

c_body(E=E1, Control, 
	['$t'(N1,F,K,C)|Q], 
	['$t'(N,F,K,C)|Q], before_cut-before_cut) :- !, 
    c_eval(E, EE, N1, N2, Control), c_eval(E1, EE1, N2, N, Control),
    c_equate(EE,EE1).
c_body(E=E1, Control, 
	['$t'(N1,F,K,C)|Q], 
	['$t'(N,F,K,C)|Q], after_cut-after_cut) :- !, 
    c_eval(E, EE, N1, N2, Control), c_eval(E1, EE1, N2, (EE  =  EE1,N), Control).
c_body(E is E1, Control, 
	['$t'(N1,F,K,C)|Q], 
	['$t'(N,F,K,C)|Q], Cut-Cut) :- !, 
    c_eval(E, EE, N1, N2, Control), c_eval(E1, EE1, N2, (EE is EE1,N), Control).
c_body('$chop'(Former,Later), Control,			% later must be atomic
	['$t'(('r_subBegin'(Q,QF,QF1,_Sfin),FF),F,K,Control)|Q],
	['$t'(FF1,F,K,Control)|Q1],Cut) :- !,
    Control = '$'(_CFin,CNow,_CEmpty), NC = '$'(_,CNow,_), % subtle code
    c_body(Former,NC,['$t'(FF,_,_,NC)|QF1],['$t'((L1,FF1),_,_,NC)|QF2],Cut),
    c_chop_later(Later, L1, Q, Q1, QF, QF2).
c_body((A,B), Control, Q, Q1, Cut-Cut1) :- !,
    c_body(A, Control, Q, Q2, Cut-Cut2),
    c_body(B, Control, Q2, Q1, Cut2-Cut1).
%c_body(empty, '$'(Fin,Now,empty), 
%	[Now,'$t'(N,F,K,'$'(Fin,Now,empty))|Q1],
%	[Now,'$t'(N,F,K,'$'(Fin,Now,empty))|Q1], Cut) :- !, % strong next
c_body(empty, Control,
    ['$t'(('r_empty'(Q),N),F,K,Control)|Q],
    ['$t'(N,F,K,Control)|Q],Cut-Cut) :- !.
c_body(notEmpty, Control,
    ['$t'(('r_notEmpty'(Q),N),F,K,Control)|Q],
    ['$t'(N,F,K,Control)|Q],Cut-Cut) :- !.
c_body(length(L), Control,
    ['$t'(N2,F,K,Control)|Q],
    ['$t'(N,F,K,Control)|Q],Cut-Cut) :- !,
    c_eval(L, LL, N2, ('r_length'(LL,Q),N), Control).
%% c_body(@true, C, Q, Q, Cut-Cut) :-!.			% special optimize
c_body(next(true), _C, Q, Q, Cut-Cut) :-!.
c_body(@A, '$'(Fin,NowTime,notEmpty), 
	[Now|Q],
	[Now,'$t'(N,F,K,'$'(Fin,NowTime,notEmpty))|Q1], Cut) :- !, % strong next
     c_seperate_next(A, NextA),
     c_body(NextA, _Control, 
	Q,
	['$t'(N,F,K,'$'(Fin,NowTime,notEmpty))|Q1], Cut).
c_body(next(A), _Control,
	 [Now|Q], [Now|Q1], Cut) :- !,   % weak next
     c_seperate_next(A, NextA),
     c_body(NextA, _Control1, Q, Q1, Cut). 
c_body(ifEmpty(A), Control, 			% fin don't care queue
	[Now,'$t'(N,F,K,Control)|Q],[Now,'$t'(N,F1,K,Control)|Q], 
		Cut-Cut) :- !,
     c_body(A, Control,
	['$t'(F,F2,_,Control)|_],
	['$t'(F2,F1,_,Control)|_] , after_cut-_).
c_body(ifNotEmpty(A), Control, 
	[Now,'$t'(N,F,K,Control)|Q],[Now,'$t'(N1,F,K1,Control1)|Q1], 
		Cut-Cut) :- !,
     c_body(A, Control,
	['$t'(K ,_,_,Control),'$t'(N, _,K2,Control) |Q],
	['$t'(K2,_,_,Control),'$t'(N1,_,K1,Control1)|Q1] , after_cut-_).
c_body(A, Control, ['$t'(System,F,K,Control)|Q], 
	['$t'(System1,F,K,Control)|Q], Cut) :- 
    c_system(A, System, System1, Control, Cut), !.
c_body(A, Control, 
	['$t'((A1,Now),F,K,Control)|Q],
	['$t'(Now,F,K,Control)|Q1], Cut-Cut) :- !,
    c_make_pred(A,A1,Q,Q1).

c_make_pred(X, XX, Q, T) :- 
    functor(X, F, A),  
    A1 is A+1, A2 is A+2, 
    functor(XX, F, A2), 
    c_copy_args(A, X, XX), 
    arg(A1, XX, Q), arg(A2, XX, T).

c_copy_args(0, _, _) :- !. 
c_copy_args(K, X, XX) :- 
    arg(K, X, XK), arg(K, XX, XK), K1 is K-1, c_copy_args(K1, X, XX). 
 
c_system(true,Q, Q, _, Cut-Cut) :- !. 
c_system('r_read_value'(A,B),('r_read_value'(A1,B),Q), Q, _, Cut-Cut) :- !,
	c_seperate_now(A,A1). 
c_system(!, (!,Q), Q, _, _Cut-after_cut) :- !. 
c_system(prolog(A), (call(A1),Q), Q, _, Cut-Cut) :- !, c_seperate_now(A,A1). 
%% c_system(A<--B, Q, Q1, Control, Cut-Cut) :- !,
%%     c_eval(B, V, Q, Q2, Control),
%%     (A = '$CNT'(V),!,Q1=Q2 ; Q2 = (unifyAll(A,V),Q1)). 
c_system(*A:=B, Q, Q1, Control, Cut-Cut) :- !,
    '$'(_Fin,'$REF'(NowTime),_Empty)=Control,
    c_eval(A, Name, Q, Q2, Control),
    c_eval(B, Value, Q2, ('r_set_value'(Name,Value,NowTime),Q1), Control).
c_system(Op, Q, Q1, Control, Cut-Cut) :- n_predicate(Op,A,B,Op2,AA,BB),!,
    c_eval(A, AA, Q, Q2, Control), c_eval(B, BB, Q2, (Op2,Q1), Control).
c_system(System,(System1,Q), Q, _, Cut-Cut) :- systemp(System),
    c_seperate_now(System,System1).

% compile chop operator
%
%    c_chop_later(Later, GenerateLater, Q, Q1, QF, QF1).

c_chop_later(Later, GenerateLater, Q, Q1, QF, QF1) :-

	%	0r(X, '$'(Q,Q1,QF,QF1))

    functor(Later, LH1, A),
    A1 is A+1,
    functor(GenerateLater, LH1, A1),
    arg(A1, GenerateLater, '$'(Q,Q1,QF,QF1)),  
    c_skel_copy_arg(0, 0, A, Later, GenerateLater),

	% 0r(X, '$'(Q, Q1, QF, QF1)) :- 'r_subFin'(QF, QF1),r(X, Q, Q1).

    functor(Later0, LH1, A),
    c_make_pred(Later0, Later1, QQ, QQ1),
    functor(L2, LH1, A1),
    arg(A1, L2, '$'(QQ,QQ1,QQF,QQF1)), 
    c_skel_copy_arg(0, 0, A, Later0, L2),
    write_clause( (L2 :- 'r_subFin'(QQF,QQF1), Later1)),

	% 0r(X, '$'(Q, Q1, QF, QF1)) :- 
	%	'r_subNotFin'(
	%		0r(Xn,'$'(NQ,NQ1,NQF,NQF1)), '$'(NQ,NQ1,NQF,NQF1),
	%		'$'(Q, Q1, QF, QF1)).

    functor(Later00, LH1, A),
    functor(L3, LH1, A1),
    arg(A1, L3, '$'(QQ,QQ1,QQF,QQF1)), 
    functor(L4, LH1, A1),
    arg(A1, L4, '$'(NQQ,NQQ1,NQQF,NQQF1)), 
    c_seperate_next(Later00,Later00Next),
    c_skel_copy_arg(0, 0, A, Later00Next, L4),
    c_args(0,A,Later00, L3, Body,
	'r_subNotFin'( L4, '$'(NQQ,NQQ1,NQQF,NQQF1),
                QQ, QQ1, QQF, QQF1)),
    write_clause(( L3 :- Body )).

%%