--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/to.pl	Thu Aug 30 14:57:44 2007 +0900
@@ -0,0 +1,238 @@
+/*
+ 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$
+	compiler main routine 
+*/
+
+com(X) :- reset_macro,tokiocompile(X). 
+com(X,Y) :- reset_macro,tokiocompile(X, Y),
+	(Y = user,!;reconsult(Y)). 
+ 
+tokiocompile(S) :-
+    tokiocompile(S, '#temp.tokio'),
+%   reconsult('#temp.tokio'). 
+    compile0('#temp.tokio'). 
+
+tokiocompile(S, O) :- 
+    cputime(Time),
+    init_tokiocomp,
+    tell(O), 
+    tokiocomp(S, [], _L), told, 
+    cputime(Time1),Time0 is Time1-Time, 
+    c_error((write('END '), nl, write(Time0), write(' sec.'),nl)).
+ 
+init_tokiocomp :- recorded('$uskel', _X, R), erase(R), fail.
+init_tokiocomp :- recorded('$mnum', _X, R), erase(R), fail.
+init_tokiocomp.
+
+tokiocomp([], L, L) :- !. 
+tokiocomp([H|T], L0, L) :- !, tokiocomp(H, L0, L1), tokiocomp(T, L1, L). 
+tokiocomp(F, _L0, _L) :- 
+    seeing(O), nofileerrors, tokiofile(F,F1),see(F1), !, 
+    tokiocomp1('$$$$'), seen, see(O), !. 
+tokiocomp(F, _, _) :- 
+    fileerrors, 
+    c_error((write('Cannot open file: '), write(F), nl)), !, fail. 
+ 
+tokiofile(F,F).
+tokiofile(F,F1) :- name(F,FL),concatenate([FL,".tokio"],NewL),name(F1,NewL).
+tokiofile(F,F1) :- name(F,FL),concatenate([FL,".t"],NewL),name(F1,NewL).
+
+
+/* tokiocomp1
+	read loop (fail loop)
+*/
+
+tokiocomp1(X) :- tokiocomp2(X).
+tokiocomp1(_) :-
+    read(Next), !, tokiocomp1(Next). 
+tokiocomp1(_) :- c_error((nl,write('read error'),nl)).
+
+/* tokocomp2
+	compiler directive 
+	this predicate never success except file end.
+*/
+
+tokiocomp2(end_of_file) :- !. 
+tokiocomp2('$$$$') :- !,fail. 
+tokiocomp2('$define'(Macro)) :- 
+     read_macro(Macro),!,fail.
+tokiocomp2('$function'(Function)) :-
+     read_function(Function),!,fail.
+tokiocomp2((:- X)) :- 		
+    call(X), write_clause((:- X)),!,fail.
+tokiocomp2((?- X)) :- 		
+    call(X), write_clause((:- X)),!,fail.
+tokiocomp2(Head) :- compiling_message(Head),fail.
+tokiocomp2(X) :- preprocess(X,X1),!,tokiocomp3(X1).
+
+compiling_message((Head :- _Body)) :- !,compiling_message(Head).
+compiling_message(Head) :- 
+    (systemp(Head);Head = (_,_);Head = [_|_];functor(Head,'{}',_)),!,
+    functor(Head,H,A),
+    c_error((
+    write('Compiling System Predicate: '), 
+    write(H/A),nl)),!.
+compiling_message(Head) :- 
+    functor(Head,H,A),
+    c_error((
+    write('Compiling: '), 
+    write(H/A),nl)),!,!.
+
+/* tokiocomp3
+	if end_of_file then success otherwise fail
+*/
+
+tokiocomp3((X,_Y)) :- tokiocomp3(X),fail.	% fail and fall into next line
+tokiocomp3((_X,Y)) :- !,tokiocomp3(Y).
+tokiocomp3(X) :- 
+    c_clause(X, C), write_clause(C),!, fail. % to reduce stack
+tokiocomp3(X) :- 
+    c_error((nl,write('compiler error on '),write(X),nl)),fail.
+ 
+% preprocess(X,X).			% no development
+
+display_fa(F/A) :- display(F), display('/'), display(A), display(','). 
+ 
+writel([]) :- !. 
+writel([X|L]) :- writel(L), write(X), write(', '). 
+ 
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+%   varialble type
+%
+%	'$REF'       full referenced variable
+%	'$TMP'	   both now and next are referenced
+%	'$NOW','$NXT'  either now or next is referenced
+%	'$CNT'	   this variable is constnat in time transition
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+variable(X) :- var(X), !. 
+variable('$REF'(_)) :- !. 
+variable('$CNT'(_)) :- !. 
+variable('$NOW'(_,_)) :- !.
+variable('$NXT'(_,_)) :- !.
+variable('$TMP'(_,_,_)).
+ 
+
+% c_post(Vname, Vname, V0, V) :- 
+%  	var(Vname),!, V is V0+1,name(V0,Lv),name(Vname,[95|Lv]).  %%% _001
+c_post(Vname, Vname, V0, V) :- 
+ 	var(Vname),!, V is V0+1,Vname = '$VAR'(V0).		%%% _001
+c_post('$VAR'(X), '$VAR'(X), V, V) :- !. 
+c_post('$CNT'(X), XX, V0, V) :- !, c_post(X, XX, V0, V). 
+c_post('$REF'(X), XX, V0, V) :- !, c_post(X, XX, V0, V). 
+c_post('$TMP'(X,Now,Nxt), XX, V0, V) :- !, c_post_tvar(X,Now,Nxt, XX, V0, V).
+c_post('$NOW'(X,Now), XX, V0, V) :- !, c_post_tvar(X,Now,_Nxt, XX, V0, V).
+c_post('$NXT'(X,Nxt), XX, V0, V) :- !, c_post_tvar(X,_Now,Nxt, XX, V0, V).
+c_post(Atomic,Qatomic,V,V) :- atomic(Atomic),!,
+     c_post_atomic(Atomic,Qatomic).
+c_post([A|B],[AA|BB], V0, V) :- !, 
+	c_post(A,AA,V0,V1),c_post(B,BB,V1,V).
+c_post((A,B),(AA,BB), V0, V) :- !, 
+	c_post(A,AA,V0,V1),c_post(B,BB,V1,V).
+% Special Hack.... ( nonvar for C-Prolog)
+c_post('r_eq'(A,B,Q1,Q2), B1=A1, V0, V) :- nonvar(A),nonvar(B),
+	functor(A,'$CNT',_),functor(B,'$CNT',_),!,
+	c_post(A,A1,V0,V1),c_post(B,B1,V1,V2),
+	c_post(Q1,Q11,V2,V3),c_post(Q2,Q12,V3,V),Q11=Q12.
+c_post('r_eq'(A,B,Q1,Q2), 'r_eqn'(B1,A1,Q11,Q12), V0, V) :- nonvar(A),
+	functor(A,'$CNT',_),!,
+	c_post(A,A1,V0,V1),c_post(B,B1,V1,V2),
+	c_post(Q1,Q11,V2,V3),c_post(Q2,Q12,V3,V).
+c_post('r_eq'(A,B,Q1,Q2), 'r_eqn'(A1,B1,Q11,Q12), V0, V) :- nonvar(B),
+	functor(B,'$CNT',_),!,
+	c_post(A,A1,V0,V1),c_post(B,B1,V1,V2),
+	c_post(Q1,Q11,V2,V3),c_post(Q2,Q12,V3,V).
+c_post('r_eq'(A,B,Q1,Q2), 'r_eq'(A1,B1,Q11,Q12), V0, V) :- !,
+	c_post(A,A1,V0,V1),c_post(B,B1,V1,V2),
+	c_post(Q1,Q11,V2,V3),c_post(Q2,Q12,V3,V).
+c_post(X, XX, V0, V) :- 
+    functor(X, F, A), c_post_atomic(F,F1),!, functor(XX, F1, A), 
+    c_post_args(0, A, X, XX, V0, V). 
+
+c_post_atomic(X,X).
+% c_post_atomic([],[]) :- !.
+% c_post_atomic(Number,Number) :- number(Number),!.
+% c_post_atomic(Atomic,Qatomic):-
+%     name(Atomic,La),La=[H|_],[H]\="'",[H]\="_",!,
+%     concatenate(["'",La,"'"],Nla),name(Qatomic,Nla).
+% c_post_atomic(Atomic,Atomic).
+
+c_post_args(N, N, _, _, V, V) :- !. 
+c_post_args(K, N, X, XX, V0, V) :- 
+    K1 is K+1, arg(K1, X, XK), c_post(XK, XXK, V0, V1), arg(K1, XX, XXK), 
+    c_post_args(K1, N, X, XX, V1, V). 
+ 
+c_post_tvar(X, Now, Nxt, '$t'(Now1,Nxt1), V0, V) :- var(X),!,
+    X='$TMP'(_,Now,Nxt),
+    c_post(Now, Now1, V0, V1),
+    c_post(Nxt, Nxt1, V1, V).
+c_post_tvar('$REF'(X), _Now, _Nxt, XX, V0, V) :- !,
+    c_post(X, XX, V0, V).
+c_post_tvar('$CNT'(X), _Now, _Nxt, XX, V0, V) :- !,
+    c_post(X, XX, V0, V).
+c_post_tvar('$TMP'(X,Now,Nxt), Now, Nxt, XX, V0, V) :- !,
+    c_post_tvar(X, Now, Nxt, XX, V0, V).
+
+write_clause(X) :- recorded('r_assert',_,_),assert_clause0(X).
+write_clause(_) :- recorded('r_assert',_,_).
+write_clause(X) :- write_clause0(X).
+write_clause(_).
+
+write_clause0((X:-true)) :- 
+    c_post(X, XX, 0, _), 
+    write_term(XX,[numbervars(true),quoted(true)]),
+    % writeq(XX), 
+    put("."), nl,!,fail. %%% writeq --> write
+write_clause0(X) :- 
+    c_post(X, XX, 0, _), writeq1(XX), put("."), nl,!,fail. %%% writeq --> write
+
+% a little pretty print
+writeq1((A,B)) :- !,writeq1(A),put("."), nl,
+    writeq1(B).
+writeq1((H:-B)) :- !,
+    % writeq(H),
+    write_term(H,[numbervars(true),quoted(true)]),
+    write((:-)),
+    writeq2(B).
+writeq1(X) :- 
+    % writeq(X).
+    write_term(X,[numbervars(true),quoted(true)]).
+writeq2((A,B)) :- !,nl,tab(4),
+    % writeq(A),
+    write_term(A,[numbervars(true),quoted(true)]),
+    put(","),writeq2(B).
+writeq2(X) :- nl,tab(4),
+    write_term(X,[numbervars(true),quoted(true)]).
+    % writeq(X).
+
+
+assert_clause(X) :- assert_clause0(X).
+assert_clause(_).
+
+%assert_clause0((X:-true)) :- 
+%    c_post(X, XX, 0, _), c_melt(XX,XXX,_),
+%    recorda('r_run',XXX,Ref),assertz(XXX), !,fail. 
+assert_clause0(X) :- 
+    c_post(X, XX, 0, _), c_melt(XX,((XXX:-Y)),_),
+    recorda('r_run',((XXX:-_)),_Ref),assertz((XXX:-Y)), !,fail. 
+
+/* end  */