:- ensure_loaded(process_lex).
:- ensure_loaded(process_lp).
:- ensure_loaded(path_val).
:- ensure_loaded(compile_version_1).
:- ensure_loaded(warshall).

 % precompile(+LP_File,+Lex_File)
 % takes a file with LP rules and a lexicon (all predicates are
 % hardwired for the current troll hpsg type hierarchy) in indentation
 % format, transforms both to prolog format (predicates lp(FS1,FS2) and
 % lex_entry(Word,FS)), computes the transitive closure for the lp
 % rules, writes them into a file in prolog format, then constructs a
 % new lexicon by using the lp rules on the subcat lists of the lexical
 % entries. That means that in the end we have lexical entries whose
 % subcat lists reflects the order of their complements. The new lexicon
 % is written into a file too.      

precompile(LP_File,Lex_File):-
	read_lp(LP_File,_LP),
	read_lex(Lex_File),
	closure(NewLP,LP_File),
        cpu_time_fail(20,precompile_aux(Lex_File,NewLP),Duration),
	write(user_output,'Compilation time: '),
	write(user_output,Duration),
	write(user_output,'
                 '),fail.
precompile(_,Lex_File):-
	told,
	rename_file(Lex_File,New_lex_file),
	abolish(lex_entry/2),
	reconsult(New_lex_file),
	write_lex.

precompile_aux(Lex_File,NewLP):-
	rename_file(Lex_File,New_lex_file),
	tell(New_lex_file),
	loop(NewLP).


 % loop(+LP)
 % takes a list of lp rules, finds all lexical entries via a fail loop
 % and processes them to yield new lexical entries.

loop(LP):-
	!,
	lex_entry(Word,FS),
	do(process(Word,FS,LP)),
	fail.
 

 % do(+Goal)
 % ensures that in a fail loop no backtracking in the argument goal is
 % possible.

do(X):-
	X,!.


 % process(+Word,+FS,+LPrules)
 % does the actual work. First gets the subcat list from the input FS.
 % we have to catch three cases in which the new entry is identical to
 % the old one: an empty subcat list or one with just one element. Since
 % a list with only one element can have either type ne_list_synsem or
 % list_synsem we have two alternatives for the second case.
 % If we have a subcat list bigger than one with just one element we
 % convert it into prolog list format, compute the possible valid
 % permutations, convert it back to hpsg format and create the new
 % entries. 
 % Finally the new entries are written (to a file).
 % The use of naive_path_val/3 may be a problem but I assume that every
 % lex_entry has got a subcat list. we could substitute this with a
 % specific procedure that finds the subcat list.

process(Word,FS,LP):-
	naive_path_val([synsem,loc,category,subcat],FS,Subcat),
	(   necessary(Subcat)
	   ->
	    New_Entries = [lex_entry(Word,FS)]
	 ;
	   (write(user_output,'Compilation time for  '),
	    write(user_output,Word),
	    write(user_output,'  :'), 
	    convert_to_prolog(Subcat,Prolog_Subcat),
	    cpu_time(1,compile_lp(Prolog_Subcat,LP,Prolog_Subcats),Dur),
	    write(user_output,Dur),nl(user_output),nl(user_output),
	    (Prolog_Subcats = [] ->
		(write(user_output,'The lexical entry for >>'),
		 write(user_output,Word),
		 write(user_output,'<<  is not compatible with the given
	                                lp rules'),nl,nl,
		 fail)
	     ;
	    	 (turn_to_hpsg_list(Prolog_Subcats,New_Subcats),
%	         write_subcats(New_Subcats),
	         make_entries(New_Subcats,lex_entry(Word,FS),
		              New_Entries)))
	    )),
	write_lex_entries(New_Entries).


 % necessary(+Subcat)
 % takes a feature structure in form of a hpsg (subcat) list and fails
 % if the list has more than one element.

necessary(fs(node(Type,List),_,_)):-
	necessary_aux(Type,List).
necessary_aux(e_list,[]).
necessary_aux(list_synsem,_).
necessary_aux(ne_list_synsem,[_,feat(tl,node(e_list,[]))]).



 % make_entries(+ListOfValidSubcats,+OldEntry,-ListOfNewEntries)
 
make_entries([],_,[]).
make_entries([H|T],lex_entry(Word,Entry),[lex_entry(Word,NewEntry)|Rest]):-
	make_entry0(Entry,H,NewEntry),
	make_entries(T,lex_entry(Word,Entry),Rest).


 % make_entryN(+OldFS,+Subcat,-NewFS)
 % takes the old feature structure, walks through it via the features to
 % the subcat list and replaces it by the new value and outputs a new
 % feature structure.

make_entry0(fs(node(Type,Feat),RL,DL),fs(Subcat,_,_),
	         fs(node(Type,OutFeat),RL,DL)):-
	extract_member(Before,feat(synsem,Fs),Feat,After),
	make_entry1(Fs,Subcat,NewFeat),
	extract_member(Before,feat(synsem,NewFeat),OutFeat,After).
make_entry1(node(Type,Feat),NewSubcat,node(Type,OutFeat)):-
	extract_member(Before,feat(loc,Fs),Feat,After),
	make_entry2(Fs,NewSubcat,NewFeat),
	extract_member(Before,feat(loc,NewFeat),OutFeat,After).
make_entry2(node(Type,Feat),NewSubcat,node(Type,OutFeat)):-
	extract_member(Before,feat(category,Fs),Feat,After),
	make_entry3(Fs,NewSubcat,NewFeat),
	extract_member(Before,feat(category,NewFeat),OutFeat,After).
make_entry3(node(Type,Feat),Subcat,node(Type,OutFeat)):-
	extract_member(Before,feat(subcat,_Fs),Feat,After),
	extract_member(Before,feat(subcat,Subcat),OutFeat,After).

 % extract_member(?Before,+Feat,?FS,?After)
 % just like member only that it also returns everything before and
 % after the item.

extract_member([],X,[X|R],R):-!.
extract_member([Y|R1],X,[Y|R],After) :-
	extract_member(R1,X,R,After).


 % turn_to_prolog_list(+ListOfHpsgLists,-ListOfPrologLists)

turn_to_prolog_list([],[]).
turn_to_prolog_list([H|T],[Subcat|Rest]):-
	convert_to_prolog(H,Subcat),
	turn_to_prolog_list(T,Rest).


% convert_to_prolog(+FS,-PrologList)
 % takes the HD and makes it into an element of the prolog list,
 % recurses down through the TL.
 % The use of naive_path_val/3 may be a problem but I assume that every
 % lex_entry has got a hd and a tl. we could substitute this with a
 % specific procedure.

convert_to_prolog(fs(node(e_list,_),_,_),[]).
convert_to_prolog(FS,[FS1|Rest]):-
	naive_path_val([hd],FS,FS1),
	naive_path_val([tl],FS,FS2),
	convert_to_prolog(FS2,Rest).

 % turn_to_hpsg_list(+ListOfPrologLists,-ListOfHpsgLists)

turn_to_hpsg_list([],[]).
turn_to_hpsg_list([H|T],[fs(FS,RL,DL)|Rest]):-
	convert_to_hpsg(H,FS,RL,DL),
	turn_to_hpsg_list(T,Rest).
 

 % convert_to_hpsg(+PrologList,-HPSGList)

convert_to_hpsg([],node(e_list,[]),_,_).
convert_to_hpsg([fs(FS,RL,DL)|FSs],
	        node(ne_list_synsem,[feat(hd,FS),feat(tl,FS1)]),
		RL,DL):-
	convert_to_hpsg(FSs,FS1,_,_).
	


 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 % some predicates used for writing

 % write_subcats(+ListOfHpsgSubcats)

write_subcats([]).
write_subcats([H|T]):-
	pretty_print(H),
	write_subcats(T).


 % write_lex_entries(+ListOfEntries)

write_lex_entries([]).
write_lex_entries([H|T]):-
	write(H),write('.'),nl,nl,
	write_lex_entries(T).


 % write_lex(+ListOfLexEntries)

write_lex([]).
 % write_lex([new_lex_entry(Word,FS)|T]):-
 % 	write('word: '),
 % 	write(Word),nl,
 %   	pretty_print(FS),nl,nl,
 % 	write_lex(T).
write_lex([lex_entry(Word,FS)|T]):-
	write('word: '),
	write(Word),nl,
	pretty_print(FS),nl,nl,
	write_lex(T).


 % write_lex
 % writes all lex entries via a fail loop

write_lex:-
	lex_entry(Word,FS),
	do((write('word: '),
	write(Word),nl,
	pretty_print(FS),nl,nl)),
	fail.
write_lex.