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

 % 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(1,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 to 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).

process(Word,FS,LP):-
     (extract_subcat(FS,Subcat,OutFS) ->
	(   necessary(Subcat)
	   ->
	    New_Entries = [lex_entry(Word,OutFS)]
	 ;
	   (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,OutFS),
		              New_Entries)))
	    ))
	
    ;   write(user_output,'No subcat list found for '),
	write(user_output,Word),nl,nl,
	New_Entries = [lex_entry(Word,FS)]),
    write_lex_entries(New_Entries).


 % extract_subcat(InFS,Subcat,OutFS)
 % runs through InFS to find the Subcat list thereby possibly
 % dereferencing chains and producing a different RL changing InFS to
 % OutFS. That the Subcat list is treated as a feature structure on its
 % own is connected with convert_to_prolog/2 which needs the RL as well
 % as the Subcat list.

extract_subcat(fs(FS,RL,DL),fs(Subcat,OutRL,DL),fs(FS,OutRL,DL)):-
	extract_synsem_aux(FS,RL,OutRL,Subcat).

 % extract_Feature_aux(Node,InRL,OutRL,Subcat)
 % finds the Feature, dereferences it if possible and continues with the
 % next feature

extract_synsem_aux(node(_,Feat),RL,OutRL,Subcat):-
	find_synsem(Feat,Synsem1),
	deref(Synsem1,RL,RL1,Val),
	( Val = rnum(_) ->
	    fail
	;   ( Val = re(_,Node) ->
	        extract_loc_aux(Node,RL1,OutRL,Subcat)
	    ;   extract_loc_aux(Val,RL1,OutRL,Subcat))).
extract_loc_aux(node(_,Feat),RL,OutRL,Subcat):-
	find_loc(Feat,Loc1),
	deref(Loc1,RL,RL1,Val),
	( Val = rnum(_) ->
	    fail
	;   ( Val = re(_,Node) ->
	        extract_category_aux(Node,RL1,OutRL,Subcat)
	    ;   extract_category_aux(Val,RL1,OutRL,Subcat))).
extract_category_aux(node(_,Feat),RL,OutRL,Subcat):-
	find_category(Feat,Category1),
	deref(Category1,RL,RL1,Val),
	( Val = rnum(_) ->
	    fail
	;   ( Val = re(_,Node) ->
	        extract_subcat_aux(Node,RL1,OutRL,Subcat)
	    ;   extract_subcat_aux(Val,RL1,OutRL,Subcat))).
extract_subcat_aux(node(_,Feat),RL,OutRL,Subcat):-
	find_subcat(Feat,Subcat1),
	deref(Subcat1,RL,OutRL,Val),
	( Val = rnum(_) ->
	    fail
	;   ( Val = re(_,Node) ->
	        Subcat = Node
	    ;   Subcat = Val)).
	

 % find_Feature(FeatList,Node)
 % looks for Feature in FeatList, returns the relevant node; fails if
 % the feature can't be found.

find_synsem([feat(synsem,Node)|_],Node).
find_synsem([feat(Feat,_)|Rest],Node):-
	(Feat @< synsem ->
	    find_synsem(Rest,Node)
	;   fail).
find_loc([feat(loc,Node)|_],Node).
find_loc([feat(Feat,_)|Rest],Node):-
	(Feat @< loc ->
	    find_loc(Rest,Node)
	;   fail).
find_category([feat(category,Node)|_],Node).
find_category([feat(Feat,_)|Rest],Node):-
	(Feat @< category ->
	    find_category(Rest,Node)
	;   fail).
find_subcat([feat(subcat,Node)|_],Node).
find_subcat([feat(Feat,_)|Rest],Node):-
	(Feat @< subcat ->
	    find_subcat(Rest,Node)
	;   fail).


 % 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_entry(Entry,H,NewEntry),
	make_entries(T,lex_entry(Word,Entry),Rest).


 % make_entry(+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.
 % partially evaluated version of make_entryN/3

make_entry(fs(node(Type,Feat),RL,DL),fs(Subcat,_,_),
	         fs(node(Type,OutFeat1),RL,DL)):-
	extract_member(Before1,feat(synsem,node(Type1,Feat1)),Feat,After1),
	extract_member(Before2,feat(loc,node(Type2,Feat2)),Feat1,After2),
	extract_member(Before3,feat(category,node(Type3,Feat3)),Feat2,After3),
	extract_member(Before4,feat(subcat,_Fs),Feat3,After4),
	extract_member(Before4,feat(subcat,Subcat),OutFeat4,After4),
	extract_member(Before3,feat(category,node(Type3,OutFeat4)),OutFeat3,
	               After3), 
	extract_member(Before2,feat(loc,node(Type2,OutFeat3)),OutFeat2,After2),
	extract_member(Before1,feat(synsem,node(Type1,OutFeat2)),OutFeat1,
	               After1).


 % 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(+HPSGList,-PrologList)

convert_to_prolog(fs(node(_Type,FeatList),RL,DL),Result):-
	convert_to_prolog_aux(FeatList,RL,DL,Result).


 % convert_to_prolog_aux(+ListOfHD/TLFeat,+RL,+DL,-PrologList)
 % takes the HD and makes it into an element of the prolog list,
 % recurses down through the rest. Works without naive_path_val/3. 

convert_to_prolog_aux([],_,_,[]).
convert_to_prolog_aux([feat(hd,FS1),feat(tl,node(_Type,FeatList))],
	              RL,DL,[fs(FS1,RL,DL)|Rest]):-
	convert_to_prolog_aux(FeatList,RL,DL,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.