Mercurial > hg > Applications > Tokio

comparison tg.pl @ 0:cfb7c6b24319

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial revision
author kono
date Thu, 30 Aug 2007 14:57:44 +0900
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:cfb7c6b24319
1 /*
2 Copyright (C) 1988,2005, Shinji Kono
3 Everyone is permitted to copy and distribute verbatim copies
4 of this license, but changing it is not allowed. You can also
5 use this wording to make the terms for other programs.
6
7 send your comments to kono@ie.u-ryukyu.ac.jp
8 */
9
10 /*
11
12 Tokio to prolog compiler
13 One line compiler
14 Mon Jun 18 16:09:07 JST 1990
15 $Header$
16 */
17
18 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
19 % Main Loop
20 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
21 (tokio) :- repeat, init_static, nl,
22 display('tokio: '), ttyflush,
23 read(G), r_tokio_loop(G).
24 r_tokio_loop(end_of_file) :- !.
25 r_tokio_loop(G) :- r_goal(G),
26 !,fail.
27
28 % Now main loop becomes one line compiler in tg.pl
29 %
30 % tokio(Goals) :- init_static,
31 % copy(Goals, G), 'r_tokio0'(G),
32 % Goals = G.
33
34 tokio(Goals) :- init_static,
35 r_goal(Goals).
36
37 %
38 % call '$g$g$g'(Varlists)
39 %
40 r_goal(Goal) :-
41 r_goals_retract,
42 get_variable(Goal,Vlist,[],_,0,Vcount),
43 functor(GGG, '$g$g$g', Vcount),
44 get_variable(GGG,Vlist,[],_,0,_),!,
45 preprocess((GGG :- Goal),Processed),
46 r_goal1(GGG,Processed).
47
48 % success on compiler failuer
49 r_goal1(_GGG,Processed) :-
50 r_goals(Processed),!,r_goals_retract.
51 % Then execute goal
52 r_goal1(GGG,_Processed) :-
53 'r_tokio0'(GGG),r_goals_retract.
54 % Real Fail
55 r_goal1(_GGG,_Processed) :- r_goals_retract,fail.
56
57 r_goals((X,_Y)) :- r_goals(X). % fail and fall into next line
58 r_goals((_X,Y)) :- !,r_goals(Y).
59 r_goals(X) :-
60 recorda('r_assert',on,Ref),
61 c_clause(X, C), % clitical on asserting clause
62 erase(Ref),
63 assert_clause(C),!, fail. % to reduce stack
64 r_goals(X) :-
65 c_error((nl,write('compiler error on '),write(X),nl)).
66
67 r_goals_retract :- recorded('r_run',XXX,Ref),erase(Ref),retract(XXX),fail.
68 r_goals_retract.
69
70 c_melt('$VAR'(N), Var, Vs) :- !,
71 c_nlist(N,Var,Vs).
72 c_melt([X|TX], [XX|TXX], Vs) :-
73 c_melt(X,XX,Vs),c_melt(TX,TXX,Vs).
74 c_melt('$t'(X,TX), '$t'(XX,TXX), Vs) :-
75 c_melt(X,XX,Vs),c_melt(TX,TXX,Vs).
76 c_melt(X, XX, Vs) :-
77 functor(X, F, A),
78 functor(XX, F, A),
79 c_melt_args(0, A, X, XX, Vs),!.
80
81 c_melt_args(N, N, _X, _, _) :- !.
82 c_melt_args(K, N, X, XX, Vs) :-
83 K1 is K+1,
84 arg(K1, X, XK),
85 arg(K1, XX,XXK),
86 c_melt(XK, XXK, Vs),
87 c_melt_args(K1, N, X, XX, Vs).
88
89 c_nlist(0,V,[V|_]) :-!.
90 c_nlist(N,V,[_|T]) :-
91 N1 is N-1,
92 c_nlist(N1,V,T).
93
94 /* */