|
0
|
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 /* */
|
