/*
 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
		One line compiler 
					Mon Jun 18 16:09:07 JST 1990
	$Header$
*/

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Main Loop
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(tokio) :- repeat, init_static, nl,
    display('tokio: '), ttyflush,
    read(G), r_tokio_loop(G).
r_tokio_loop(end_of_file) :- !.
r_tokio_loop(G) :- r_goal(G),
    !,fail.

% Now main loop becomes one line compiler in tg.pl
%
% tokio(Goals) :- init_static,
%     copy(Goals, G), 'r_tokio0'(G),
%     Goals = G.

tokio(Goals) :- init_static,
        r_goal(Goals).

%
%  call '$g$g$g'(Varlists)
%
r_goal(Goal) :-
        r_goals_retract,
	get_variable(Goal,Vlist,[],_,0,Vcount),
	functor(GGG, '$g$g$g', Vcount),
	get_variable(GGG,Vlist,[],_,0,_),!,
	preprocess((GGG :- Goal),Processed),
	r_goal1(GGG,Processed).

% success on compiler failuer
r_goal1(_GGG,Processed) :-
	r_goals(Processed),!,r_goals_retract.
% Then execute goal
r_goal1(GGG,_Processed) :-
	'r_tokio0'(GGG),r_goals_retract.
% Real Fail
r_goal1(_GGG,_Processed) :- r_goals_retract,fail.

r_goals((X,_Y)) :- r_goals(X).	% fail and fall into next line
r_goals((_X,Y)) :- !,r_goals(Y).
r_goals(X) :- 
        recorda('r_assert',on,Ref),
            c_clause(X, C),       % clitical on asserting clause
        erase(Ref),
        assert_clause(C),!, fail. % to reduce stack
r_goals(X) :- 
	c_error((nl,write('compiler error on '),write(X),nl)).

r_goals_retract :- recorded('r_run',XXX,Ref),erase(Ref),retract(XXX),fail.
r_goals_retract.

c_melt('$VAR'(N), Var, Vs) :- !,
	c_nlist(N,Var,Vs).	
c_melt([X|TX], [XX|TXX], Vs) :-
	c_melt(X,XX,Vs),c_melt(TX,TXX,Vs).
c_melt('$t'(X,TX), '$t'(XX,TXX), Vs) :-
	c_melt(X,XX,Vs),c_melt(TX,TXX,Vs).
c_melt(X, XX, Vs) :-
	functor(X, F, A), 
	functor(XX, F, A), 
	c_melt_args(0, A, X, XX, Vs),!.

c_melt_args(N, N, _X, _, _) :- !.
c_melt_args(K, N, X, XX, Vs) :-
	K1 is K+1, 
	arg(K1, X, XK),   
	arg(K1, XX,XXK),   
	c_melt(XK, XXK, Vs), 
	c_melt_args(K1, N, X, XX, Vs).

c_nlist(0,V,[V|_]) :-!.
c_nlist(N,V,[_|T]) :-
	N1 is N-1,
	c_nlist(N1,V,T).

/* */