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