Mercurial > hg > Applications > Tokio

comparison tf.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 filter for partial compile
13 Sun Oct 13 18:35:19 JST 1985
14 Sun Nov 17 00:03:22 JST 1985 :-static
15 Wed Mar 25 23:00:23 JST 1987 rewrite
16 $Header$
17 */
18
19 pcom(File,Name) :- reset_macro,tokiopcompile(File,Name).
20 pcom(File,Name,Out) :- reset_macro,tokiopcompile(File,Out,Name),
21 (Out = user,!;reconsult(Out)).
22
23 tokiopcompile(S,Names) :-
24 tokiopcompile(S, '#temp.tokio', Names),
25 reconsult('#temp.tokio'). % I suppose we are in debugging.
26
27 tokiopcompile(S, O,Names) :-
28 cputime(Time),
29 init_tokiocomp,
30 tell(O),
31 tokiopcomp(S, [], _L, Names), told,
32 cputime(Time1),Time0 is Time1-Time,
33 c_error((write('END '), nl,
34 write(Time0), write(' sec.'),nl)).
35
36 tokiopcomp([], L, L, _Names) :- !.
37 tokiopcomp([H|T], L0, L, Names) :- !,
38 tokiopcomp(H, L0, L1, Names), tokiopcomp(T, L1, L, Names).
39 tokiopcomp(F, L, L, Names) :-
40 seeing(O), nofileerrors,
41 tokiofile(F,F1),see(F1), !,
42 tokiopcomp1('$$$$',Names), seen, see(O), !.
43 tokiopcomp(F, _, _, _) :-
44 fileerrors,
45 c_error((
46 display('Cannot open file: '), display(F), ttynl)),fail.
47
48 tokiopcomp1(X,_Names) :- tokiocomp2(X),!.
49 tokiopcomp1(_,Names) :-
50 read_filter(Next,Names),
51 tokiopcomp1(Next,Names).
52 tokiopcomp1(_,_Names) :-
53 c_error((nl,write('read error'),nl)).
54
55 read_filter(X,Name) :- repeat,read(X),
56 filter(X,Name).
57
58 filter(end_of_file,_):-!.
59 filter((:-_X),_):-!.
60 filter((?-_X),_):-!.
61 filter(('$function'(_X)),_):-!.
62 filter(('$define'(_X)),_):-!.
63 filter((H:-_),Name) :- !,functor(H,HH,_),
64 (HH=Name ; member(HH,Name)),!.
65 filter(X,Name) :- functor(X,HH,_),
66 (HH=Name ; member(HH,Name)),!.
67
68 cputime(T) :- 'r_cputime'(T).
69
70 /* Macro Level Only Output */
71 mcom(File) :- reset_macro,tokiomcompile(File).
72 mcom(File,Out) :- reset_macro,tokiomcompile(File,Out).
73
74 tokiomcompile(S) :-
75 tokiomcompile(S, '#temp.tokio').
76
77 tokiomcompile(S, O) :-
78 cputime(Time),
79 init_tokiocomp,
80 tell(O),
81 tokiomcomp(S, [], _L), told,
82 cputime(Time1),Time0 is Time1-Time,
83 c_error((write('END '), nl,
84 write(Time0), write(' sec.'),nl)).
85
86 tokiomcomp([], L, L) :- !.
87 tokiomcomp([H|T], L0, L) :- !,
88 tokiomcomp(H, L0, L1), tokiomcomp(T, L1, L).
89 tokiomcomp(F, L, L) :-
90 seeing(O), nofileerrors,
91 tokiofile(F,F1),see(F1), !,
92 tokiomcomp1('$$$$'), seen, see(O), !.
93 tokiomcomp(F, _, _) :-
94 fileerrors,
95 c_error((
96 display('Cannot open file: '), display(F), ttynl)),fail.
97
98 tokiomcomp1(X) :- tokiomcomp2(X),!.
99 tokiomcomp1(_) :-
100 read(Next),!,tokiomcomp1(Next).
101 tokiomcomp1(_) :-
102 c_error((nl,write('read error'),nl)).
103
104 tokiomcomp2(end_of_file) :- !.
105 tokiomcomp2('$$$$') :- !,fail.
106 tokiomcomp2('$define'(Macro)) :-
107 read_macro(Macro),!,fail.
108 tokiomcomp2('$function'(Function)) :-
109 read_function(Function),!,fail.
110 tokiomcomp2((:- X)) :-
111 call(X), write_clause((:- X)),!,fail.
112 tokiomcomp2((?- X)) :-
113 call(X), write_clause((:- X)),!,fail.
114 % tokiomcomp2(Head) :- compiling_message(Head),fail.
115 tokiomcomp2(X) :- preprocess(X,X1),!,
116 numbervars(X1,0,_),
117 write_clause(X1),!,fail.
118
119 /* end */