--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tg.pl	Thu Aug 30 14:57:44 2007 +0900
@@ -0,0 +1,94 @@
+/*
+ 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).
+
+/* */