/*
 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
%%
%%    variable classification and head compile
%%
%%
%% Sat Jan 11 11:31:10 JST 1986
%% $Header$

c_equate(EE,EE) :-!.
c_equate('$CNT'(EE),EE) :-!.
c_equate(EE,'$CNT'(EE)) :-!.

%% variable separation for temporality

c_seperate(Var,Now,Next) :- Var = '$TMP'(_,Now,Next),!.
c_seperate(Var,Var,'$CNT'(Var1)) :- Var = '$CNT'(Var1),!.
c_seperate(Var,Now,Next) :- Var = '$NOW'(Var1,Now),!,
    c_seperate(Var1,Now,Next).
c_seperate(Var,Now,Next) :- Var = '$NXT'(Var1,Next),!,
    c_seperate(Var1,Now,Next).
c_seperate(Atomic,Atomic,Atomic) :- atomic(Atomic),!.
c_seperate(Op, Op1, Op2) :- 
    functor(Op, H, N),functor(Op1, H, N),functor(Op2, H, N),
    c_seperate_arg(0, N, Op, Op1, Op2).

c_seperate_arg(N, N, _, _, _) :- !.
c_seperate_arg(M, N, Op, Op1, Op2) :-
    M1 is M+1,arg(M1, Op, A), arg(M1, Op1, A1),arg(M1, Op2, A2),
    c_seperate(A,A1,A2),
    c_seperate_arg(M1, N, Op, Op1, Op2).


c_seperate_now(Var,Now) :- Var = '$NOW'(_,Now),!.
c_seperate_now(Var,Var) :- Var = '$CNT'(_Var1),!.
c_seperate_now(Var,Now) :- Var = '$TMP'(_,Now,_Next),!.
c_seperate_now(Var,Now) :- Var = '$NXT'(Var1,Next),!,
    c_seperate(Var1,Now,Next).
c_seperate_now(Atomic,Atomic) :- atomic(Atomic),!.
c_seperate_now(Op, Op1) :- 
    functor(Op, H, N),functor(Op1, H, N),
    c_seperate_now_arg(0, N, Op, Op1).

c_seperate_now_arg(N, N, _, _) :- !.
c_seperate_now_arg(M, N, Op, Op1) :-
    M1 is M+1,arg(M1, Op, A), arg(M1, Op1, A1),
    c_seperate_now(A,A1),
    c_seperate_now_arg(M1, N, Op, Op1).

c_seperate_next(Var,Next) :- Var = '$NXT'(_,Next),!.
c_seperate_next(Var,'$CNT'(Var1)) :- Var = '$CNT'(Var1),!.
c_seperate_next(Var,Next) :- Var = '$TMP'(_,_Now,Next),!.
c_seperate_next(Var,Next) :- Var = '$NOW'(Var1,Now),!,
    c_seperate(Var1,Now,Next).
c_seperate_next(Atomic,Atomic) :- atomic(Atomic),!.
c_seperate_next(Op, Op1) :- 
    functor(Op, H, N),functor(Op1, H, N),
    c_seperate_next_arg(0, N, Op, Op1).

c_seperate_next_arg(N, N, _, _) :- !.
c_seperate_next_arg(M, N, Op, Op1) :-
    M1 is M+1,arg(M1, Op, A), arg(M1, Op1, A1),
    c_seperate_next(A,A1),
    c_seperate_next_arg(M1, N, Op, Op1).

% c_unify(Original_argument, Generated_argument, Unification_code, ItsBase, 
%         Level). 
%	Tokio has same problem as ghc. f(X,X) must be comipled into
%	f(X, Y) :- unify(X, Y).
c_unify(X, Y, Q, Q, _) :-  
     var(X), !, X= '$REF'(Y).   % mark X as "used!" 
c_unify('$REF'(X), Y, (unifyAll(X, Y),Q), Q, _) :- !. 
% c_unify('$CNT'(X), X, Q, Q, _) :- !. 
c_unify('$CNT'(X), Y, (uconst(Y,X),Q), Q, _) :- !. 
c_unify('$TMP'(Org,Now,Next), Org1, Q1, Q, L) :- !,
    c_nownext(Org, Org1, Now, Next, Q1, Q, L).
c_unify('$NOW'(Org,Now), Org1, Q1, Q, L) :- !,
    c_now(Org, Org1, Now, Q1, Q, L).
c_unify('$NXT'(Org,Next), Org1, Q1, Q, L) :- !,
    c_next(Org, Org1, Next, Q1, Q, L).
c_unify([], X, (unil(X),Q), Q, _) :- !. 
c_unify(A, X, (uatom(X, A),Q), Q, _) :- atomic(A), !. 
c_unify(X, Y, (unifyAll(X, Y),Q), Q, 0) :- !. % Stop expansion at given level 
c_unify([H|T], X, (ulist(X, H0, T0), Q1), Q, L) :- !, 
    L1 is L-1, c_unify(H, H0, Q1, Q2, L1),  
    c_unify(T, T0, Q2, Q, L1). 
c_unify(S, X, Q1, Q, L) :-  		% compile unification
    functor(S, F, A), A < 4, !, functor(S0, F, A), 
    make_skel_name(F, Us, A),
    c_skel(Us, S0, X, F, A, Q1, Q2, L), 
    L1 is L-1,
    c_unify_args(0, A, S, S0, Q2, Q, L1). 
c_unify(S, X, (uskel(X, S0), Q1), Q, L) :- !, 
    L1 is L-1, functor(S, F, A), functor(S0, F, A), 
    c_unify_args(0, A, S, S0, Q1, Q, L1). 
 
c_unify_args(N, N, _, _, Q, Q, _) :- !. 
c_unify_args(K, N, S, X, Q1, Q, L) :- 
    K1 is K+1, arg(K1, S, SK), arg(K1, X, XK),  
    c_unify(SK, XK, Q1, Q2, L), 
    c_unify_args(K1, N, S, X, Q2, Q, L). 

% compile skelton unifications
%
%	f(_,_,_) ---> 'r_f3'

make_skel_name(F, U, A) :-
    name(A, AL), name(F, FL), 
%    concatenate(["'r_",FL,AL,"'"], UL),
    concatenate(["r_",FL,AL], UL),		%%%%%%%%%%%%%%%%%
    name(U, UL).

concatenate([],[]).
concatenate([H|T],X) :- concatenate(T,X1),append(H,X1,X).

c_skel(U, S, X, _F, A, (Uc,Q), Q, _L) :- recorded('$uskel',U,_),!,
    A1 is A+1, functor(Uc, U, A1), 
    arg(1, Uc, X),
    c_skel_copy_arg(0, 1, A1, S, Uc).
c_skel(U, S, X, F, A, (Uc,Q), Q, _L) :- recordz('$uskel',U,_),!,
    A1 is A+1, functor(Uc, U, A1),
    arg(1, Uc, X),
    c_skel_copy_arg(0, 1, A1, S, Uc),
    functor(U1, U, A1), functor(Us, F, A),
    c_skel_copy_arg(0, 1, A1, Us, U1),
    arg(1, U1, Us),
    write_clause((U1 :- !)),
    functor(U2, U, A1), functor(Us2, F, A), functor(Un, U, A1),
    c_skel_copy_arg_tmp(0, 1, A1, Us2, U2, Un),
    arg(1, U2, '$t'(Us2, N)),
    arg(1, Un, N),
    write_clause((U2 :- Un)).


c_skel_copy_arg(_L, N, N, _A, _B) :- !.
c_skel_copy_arg(L, N, M, A, B) :-
    L1 is L+1, N1 is N+1,
    arg(L1, A, Arg), arg(N1, B, Arg),
    c_skel_copy_arg(L1, N1, M, A, B).

c_skel_copy_arg_tmp(_L, N, N, _A, _B, _C) :- !.
c_skel_copy_arg_tmp(L, N, M, A, B, C) :-
    L1 is L+1, N1 is N+1,
    arg(L1, A, Now), arg(N1, B, '$t'(Now,Next)), arg(N1, C, Next),
    c_skel_copy_arg_tmp(L1, N1, M, A, B, C).
% optimiser check variables
%	now only referenced	unifyNow
%	next only referenced	unifyNext
%	both referenced		unifyNowNext
%
%	if already referenced then product unifyAll code
%
%    c_now/next(Org, Modyfied, Now/Next, Q1, Q),

c_nownext(Org, Org1, Now, Next, (unifyNowNext(Org1,Now,Next1),Q1), Q, L) :- 
    var(Org),!,Org = '$REF'(Org1),
    c_unify(Next,Next1, Q1, Q, L).
c_nownext('$REF'(O2), O, _Now, _Next, (unifyAll(O2,O),Q), Q, _L).

c_now(Var, Var1, Now, (unifyNow(Var1,Now), Q), Q, _L) :- var(Var),!,
    Var = '$REF'(Var1).
c_now('$REF'(O2), O, _Now, (unifyAll(O2,O),Q), Q, _L) :- !.
c_now('$TMP'(O,Now,Next), O1, Now, Q, Q1, L) :- 
    c_nownext(O, O1, Now, Next, Q, Q1, L).

c_next(Var, Var, Next, (unifyNext(Var1,Next1), Q), Q1, L) :- var(Var),!,
    Var = '$REF'(Var1),
    c_unify(Next,Next1, Q, Q1, L).
c_next('$REF'(O2), O, _Next, (unifyAll(O2,O),Q), Q, _L) :- !.
c_next('$TMP'(O,Now,Next), O1, Next, Q, Q1, L) :-
    c_nownext(O, O1, Now, Next, Q, Q1, L).


% c_opt(Before, After, Optimized_or_not) 
c_opt(X,X,0) :- var(X),!.
c_opt((true, X), Y, 1) :- !, c_opt(X, Y, _). 
c_opt((X0, true), X, 1) :- !, c_opt(X0, X, _). 
c_opt((X0, Y0), R, C) :- !, 
    c_opt(X0, X1, CX), c_opt(Y0, Y1, CY), C0 is CX\/CY, 
  ( C0 =:= 0, !, C is C0, R = (X1, Y1);  
    c_opt((X1, Y1), R, C) ).            % X1/Y1 may be optimized to 'true' 
c_opt(X, X, 0). 
 
/* end of compiler */