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

/*

	filter for partial compile
				Sun Oct 13 18:35:19 JST 1985
				Sun Nov 17 00:03:22 JST 1985 :-static
				Wed Mar 25 23:00:23 JST 1987 rewrite
				$Header$
	*/

pcom(File,Name) :- reset_macro,tokiopcompile(File,Name).
pcom(File,Name,Out) :- reset_macro,tokiopcompile(File,Out,Name),
    (Out = user,!;reconsult(Out)).
 
tokiopcompile(S,Names) :-
    tokiopcompile(S, '#temp.tokio', Names),
    reconsult('#temp.tokio').   % I suppose we are in debugging.
 
tokiopcompile(S, O,Names) :- 
    cputime(Time),
    init_tokiocomp,
    tell(O), 
    tokiopcomp(S, [], _L, Names), told,
    cputime(Time1),Time0 is Time1-Time,
    c_error((write('END '), nl, 
    write(Time0), write(' sec.'),nl)).
 
tokiopcomp([], L, L, _Names) :- !. 
tokiopcomp([H|T], L0, L, Names) :- !,
	tokiopcomp(H, L0, L1, Names), tokiopcomp(T, L1, L, Names). 
tokiopcomp(F, L, L, Names) :- 
    seeing(O), nofileerrors, 
    tokiofile(F,F1),see(F1), !, 
    tokiopcomp1('$$$$',Names), seen, see(O), !. 
tokiopcomp(F, _, _, _) :- 
    fileerrors, 
    c_error((
    display('Cannot open file: '), display(F), ttynl)),fail.

tokiopcomp1(X,_Names) :- tokiocomp2(X),!.
tokiopcomp1(_,Names) :-
    read_filter(Next,Names), 
    tokiopcomp1(Next,Names). 
tokiopcomp1(_,_Names) :- 
    c_error((nl,write('read error'),nl)).

read_filter(X,Name) :- repeat,read(X),
	filter(X,Name).

filter(end_of_file,_):-!.
filter((:-_X),_):-!.
filter((?-_X),_):-!.
filter(('$function'(_X)),_):-!.
filter(('$define'(_X)),_):-!.
filter((H:-_),Name) :- !,functor(H,HH,_),
    (HH=Name ; member(HH,Name)),!.
filter(X,Name) :- functor(X,HH,_),
    (HH=Name ; member(HH,Name)),!.

cputime(T) :- 'r_cputime'(T).

/* Macro Level Only Output */
mcom(File) :- reset_macro,tokiomcompile(File).
mcom(File,Out) :- reset_macro,tokiomcompile(File,Out).
 
tokiomcompile(S) :-
    tokiomcompile(S, '#temp.tokio').

tokiomcompile(S, O) :- 
    cputime(Time),
    init_tokiocomp,
    tell(O), 
    tokiomcomp(S, [], _L), told,
    cputime(Time1),Time0 is Time1-Time,
    c_error((write('END '), nl, 
    write(Time0), write(' sec.'),nl)).
 
tokiomcomp([], L, L) :- !. 
tokiomcomp([H|T], L0, L) :- !,
	tokiomcomp(H, L0, L1), tokiomcomp(T, L1, L). 
tokiomcomp(F, L, L) :- 
    seeing(O), nofileerrors, 
    tokiofile(F,F1),see(F1), !, 
    tokiomcomp1('$$$$'), seen, see(O), !. 
tokiomcomp(F, _, _) :- 
    fileerrors, 
    c_error((
    display('Cannot open file: '), display(F), ttynl)),fail.

tokiomcomp1(X) :- tokiomcomp2(X),!.
tokiomcomp1(_) :-
    read(Next),!,tokiomcomp1(Next). 
tokiomcomp1(_) :- 
    c_error((nl,write('read error'),nl)).

tokiomcomp2(end_of_file) :- !. 
tokiomcomp2('$$$$') :- !,fail. 
tokiomcomp2('$define'(Macro)) :- 
     read_macro(Macro),!,fail.
tokiomcomp2('$function'(Function)) :-
     read_function(Function),!,fail.
tokiomcomp2((:- X)) :- 		
    call(X), write_clause((:- X)),!,fail.
tokiomcomp2((?- X)) :- 		
    call(X), write_clause((:- X)),!,fail.
% tokiomcomp2(Head) :- compiling_message(Head),fail.
tokiomcomp2(X) :- preprocess(X,X1),!,
    numbervars(X1,0,_),
    write_clause(X1),!,fail.

/* end */