
:-dynamic 
invoked/1,

/* a_rule_some_exist/0, */ 
a_rule_inner_rule_last_nbr/1,
edges_combination_inner_info/3,
edge_inner_info/3 ,
edge_inner_min_structure/2,
/* end_inner_node/1, */
/* edge_inner_structure/2, */
/* handle_counter_inner/1, */
read_edge_inner_information/2,
reduction_inner_information/4,
rule_1A_inner_structure/7,
rule_1B_inner_structure/7,
rule_2_inner_structure/5,
named_rule_inner_info/2,
named_rule_retract_info/1,
stack_inner_structure/4,
/* start_inner_node/1, */
stack_operation/2,
current_stack_operation/2,
success_edge/1,

node__/2,
edge_free_number__/1,
edge_chart__/2,
edge_start_node__/2,
edge_end_node__/2,
edge_category__/2,

error_sort_value_edges_list_inner__/1,
nonchart_error_edge_inner_info__/6,
kp_dm_new_reduction_error_information__/3,
kp_dm_new_edges_combination_error_info__/2,
kp_dm_edge_head_info_inner__/1,
kp_dm_in_ds_head_is_knowen_inner__/3,
kp_dm_hide_edge_db_inner__/8.


/*  predikaty cistici feature structuru od == (structure sharing)

  clean_feature_structure( Feature, CleanedFeature )
	- z featury vyhodi structure sharing

  clean_feature_structure_tell( Feature, CleanedFeature )
	- z featury vyhodi structure sharing, pripadnou chybu oznami na vystup

*/

clean_feature_structure_tell( Feature, CleanedFeature ) :-
	if1( clean_feature_structure( Feature, CleanedFeature ),
		true,
		( write( 'ERROR in the feature structure: ' ),
		  write( Feature ), nl, nl ) ), !.


clean_feature_structure( Feature, CleanedFeature ) :-
	( var( Feature ) ; atomic( Feature ) ), !,
	CleanedFeature = Feature.

clean_feature_structure( Feature, CleanedFeature ) :-
	Feature = [ Head | Tail ], !,
	clean_feature_structure( Head, CleanedHead ),
	clean_feature_structure( Tail, CleanedTail ), !,
	CleanedFeature = [ CleanedHead | CleanedTail ].

clean_feature_structure( Feature, CleanedFeature ) :-
	Feature = ( Head = Tail ), !,
	clean_feature_structure( Head, CleanedHead ),
	clean_feature_structure( Tail, CleanedTail ), !,
	CleanedFeature = ( CleanedHead = CleanedTail ).

clean_feature_structure( Feature, CleanedFeature ) :-
	Feature = list( Tail ), !,
	clean_feature_structure( Tail, CleanedTail ), !,
	CleanedFeature = list( CleanedTail ).

clean_feature_structure( Feature, CleanedFeature ) :-
	Feature = ( Head == Tail ), !,
	clean_feature_structure( Head, CleanedHead ),
	clean_feature_structure( Tail, CleanedTail ), !,
	if1( ( var( CleanedHead ) ; var( CleanedTail ) ),
		CleanedHead = CleanedTail,
		true ), !,
	CleanedFeature = CleanedTail.

clean_feature_structure( Feature, CleanedFeature ) :-
	Feature =.. Tail, !,
	clean_feature_structure( Tail, CleanedTail ), !,
	CleanedFeature =.. CleanedTail.

/* predikaty na vypsani chyb z feature structure

  write_feature_structure_errors( FeatureStructure )
	- predikat vypisujici pro kazdy vyskyt chyby phonem cele struktury,
	 phonem hlavy a i clenu v nemz k chybe doslo nasledovany chybovou
	 hlaskou

  ret_feature_structure_error( FeatureStructure, StructurePhon, HeadPhon,
		MemberPhon, ErrMessage )
	- postupne (backrackingem) pro feature structuru vraci veskere jeji
	 chyby, tj. pro kazdou phonem te fraze, kde k chybe doslo, phonem
	 hlavy a i prislusneho clenu one fraze, jako i dannou chybovou hlasku

  there_is_an_error_in_feature_structure( FeatureStructure )
	- zjisti zda feature structure reprezentuje chybovou frazi

  ret_feature_structure_phone( FeatureStructure, FeaturePhon )
	- z feature structure vrati hodnotu vlastnosti phon

  ret_feature_structure_first( FeatureStructure, FeatureFirst )
	- z feature structure vrati strukturu pod first

  ret_feature_structure_rest( FeatureStructure, FeatureRest )
	- z feature structure vrati strukturu pod rest

  is_error_message_in_feature_here( FeatureStructure, ErrMess )
	- uspeje prave tehdy, je -li chybova hlaska na teto urovni feature
	 structure

  is_a_head_structure( FeatureStructure )
	- zda feature structure struktura pod first reprezentuje prave hlavu
	 fraze
*/

write_feature_structure_errors( FeatureStructure ) :-
	backtracking_loop( (
		ret_feature_structure_error( FeatureStructure, StructurePhon,
			HeadPhon, MemberPhon, ErrMessage ),
		write( 'Error: ' ), write( ErrMessage ), nl,
		write( 'in the phrase: ' ), write( StructurePhon ), nl,
		write( 'head of the phrase is: ' ), write( HeadPhon ), nl,
		write( 'the error phrase member is: ' ), write( MemberPhon ),
		nl ) ).


ret_feature_structure_error( FeatureStructure, StructurePhon, HeadPhon,
		MemberPhon, ErrMessage ) :-
	there_is_an_error_in_feature_structure( FeatureStructure ),
	ret_feature_structure_phone( FeatureStructure, FeaturePhon ),
	kp_wri_err_call_members_find_head_phon( FeatureStructure,
		StructurePhon, HeadPhon, MemberPhon, ErrMessage, ErrPresented,
		HeadStructPhon, InsideErrorFilled ),
	if1( var( InsideErrorFilled ),
		( nonvar( ErrPresented ),
		  HeadPhon = HeadStructPhon,
		  StructurePhon = FeaturePhon,
		  kp_wri_find_error( FeatureStructure, MemberPhon,
			ErrMessage ) ),
		true ).


kp_wri_err_call_members_find_head_phon( FeatureStructure,
		StructurePhon, HeadPhon, MemberPhon, ErrMessage, ErrPresented,
		HeadStructPhon, InsideErrorFilled ) :-
	nonvar( FeatureStructure ),
	ret_feature_structure_first( FeatureStructure, FeatureFirst ),
	ret_feature_structure_rest( FeatureStructure, FeatureRest ),
	if1( is_error_message_in_feature_here( FeatureStructure, _ ),
		ErrPresented = true,
		true ), !,
	if1( is_a_head_structure( FeatureStructure ),
		( ret_feature_structure_phone( FeatureFirst, FeaturePhon ),
		  HeadStructPhon = FeaturePhon ),
		true ), !,
	(
	  nonvar( FeatureFirst ),
	  InsideErrorFilled = true, 
	  ret_feature_structure_error( FeatureFirst, StructurePhon,
		HeadPhon, MemberPhon, ErrMessage )
	;
	  if1( there_is_an_error_in_feature_structure( FeatureRest ),
	  	kp_wri_err_call_members_find_head_phon( FeatureRest,
			StructurePhon, HeadPhon, MemberPhon, ErrMessage,
 			ErrPresented, HeadStructPhon, InsideErrorFilled ),
		nonvar( ErrPresented ) )
	).


kp_wri_find_error( FeatureStructure, MemberPhon, ErrMessage ) :-
	nonvar( FeatureStructure ),
	is_error_message_in_feature_here( FeatureStructure, ErrMess ),
	ErrMessage = ErrMess,
	ret_feature_structure_first( FeatureStructure, FeatureFirst ),
	ret_feature_structure_phone( FeatureFirst, FeaturePhon ),
	MemberPhon = FeaturePhon.

kp_wri_find_error( FeatureStructure, MemberPhon, ErrMessage ) :-
	nonvar( FeatureStructure ),
	ret_feature_structure_rest( FeatureStructure, FeatureRest ),
	kp_wri_find_error( FeatureRest, MemberPhon, ErrMessage ).


there_is_an_error_in_feature_structure( FeatureStructure ) :-
	nonvar( FeatureStructure ),
	get_feature_structure_error( FeatureStructure, Error ),
	get_no_error( NoError ), !,
	b_not( NoError = Error ), !.


ret_feature_structure_phone( FeatureStructure, FeaturePhon ) :-
	feature_structure_find_feature( FeatureStructure, phon, Phon ), !,
	FeaturePhon = Phon.


ret_feature_structure_first( FeatureStructure, FeatureFirst ) :-
	big_feature_ret_bottom_structure( FeatureStructure, FeatureFirst ).


ret_feature_structure_rest( FeatureStructure, FeatureRest ) :-
	big_feature_ret_right_structure( FeatureStructure, FeatureRest ).


is_error_message_in_feature_here( FeatureStructure, ErrMess ) :-
	big_feature_ret_error_mess( FeatureStructure, ErrMess ), !,
	nonvar( ErrMess ).


is_a_head_structure( FeatureStructure ) :-
	kp_wri_err_is_head_inside( FeatureStructure ), !,
	ret_feature_structure_rest( FeatureStructure, FeatureRest ),
	b_not( kp_wri_err_is_head_inside( FeatureRest ) ), !.


kp_wri_err_is_head_inside( FeatureStructure ) :-
	feature_structure_find_feature( FeatureStructure, synsem, Synsem ), !,
	feature_structure_find_feature( Synsem, nucleus, Nucleus ), !,
	Nucleus = plus.

/* veskera podpora deterministickeho modulu (DS)

  init_ds_module
	- predikat starajici se o veskere inicializace

  get_edge(Edge, From, To)
	- predikat pro DS programovany panem doktorem Jano Hricem, vraci
	 postupne vsechny hrany, plus jejich pocatecni a koncove uzly

  rules_context_ret_1A_list( Context, Rules1AList )
	- z kontextu (vytvoreny volanim 'make_context_1') vynda seznam prvku
	 cislo pravidla = min. struktura pravidla, pro pravidla typu 1A
  rules_context_ret_handle( Context, ContextHandle )
	- z kontextu vrati jeho jednoznacnou identifikaci
  rules_context_ret_reduction_rules( Context, Rules1BList, Rules2List )
	- z kontextu vrati seznam povolenych pravidel typu 1B a 2 (head a
	 phrase termination rules)

  compose_edges( E1, E2, List, Cxt )
	- ze dvou hran a kontextu (povolena pravidla) vytvori vsechny
	 mozne kombinace (dle povolenych pravidel)

  make_context_1( Seznam_pravidel, Context )
	- ze seznamu povolenych pravidel vytvori kontext

  get_input_nodes( List )
	- vrati seznam vsech uzlu

  hide_edge( E )
	- dannou hranu schova

  allow_all_edges
	- po neuspesnem behu parseru nad DS vstupem opet vrati puvodni vstup

  exist_final_edge
	- zda existuje uspesny vypocet

  change_constituent_types
	- u vsech sestrojenych hran vramci DS zmeni lexikalnost na true
*/

:-dynamic
 kp_dm_ds_pred_edge_head_reduct__/1,
 kp_dm_ds_pred_compose_edge_mark__/1,
 kp_dm_ds_pred_hide_edge_mark_info__/1.


init_ds_module :-
	retract_all_with_head( kp_dm_ds_pred_edge_head_reduct__( _ ) ),
	retract_all_with_head( kp_dm_ds_pred_compose_edge_mark__( _ ) ),
	retract_all_with_head( kp_dm_ds_pred_hide_edge_mark_info__( _ ) ).


get_edge( Edge, From, To ) :-
	get_chart_edge( Edge, From, To ),
	b_not( kp_dsp_is_edge_a_ds_reduct( Edge ) ).

rules_context_ret_1A_list( Context, Rules1AList ) :-
	Context = rule_compilated_structure( _ContextHandle, Rules1AList,
		_HeadRuleList, _TermRuleList ), !.


rules_context_ret_handle( Context, ContextHandle ) :-
	Context = rule_compilated_structure( ContextHandle, _Rules1AList,
		_HeadRuleList, _TermRuleList ), !.


rules_context_ret_reduction_rules( Context, HeadRuleList, TermRuleList ) :-
	Context = rule_compilated_structure( _ContextHandle, _Rules1AList,
		HeadRuleList, TermRuleList ), !.


compose_edges( E1, E2, List, Cxt ) :-
	if1( kp_dsp_is_edge_a_ds_reduct( E2 ),
		List = [],
		kp_dsp_compose_edges( E1, E2, List, Cxt ) ).

kp_dsp_compose_edges( E1, E2, List, Cxt ) :-
	all_succ_result( ListOfEdgesHandles,
		( is_edge_left_growable( E2 ),
		  left_combine_stack_edges( E1, E2, fail, Cxt,
			EdgeHandle, Useable ),
		  kp_dsp_make_compose_edge_mark( EdgeHandle ),
		  if1( Useable,
			Complete = complete,
			Complete = incomplete ) ),
		EdgeHandle = Complete ),
	if1( ListOfEdgesHandles = [],
		kp_dsp_compose_head( E1, E2, List, Cxt ),
		List = ListOfEdgesHandles ), !.


kp_dsp_compose_head( E1, E2, List, Cxt ) :-
	is_edge_valid( E2 ), !,
	kp_dsp_make_all_heads( E2, Cxt, ListOfHeads ), !,
	all_succ_result( ListListOfHandles,
		( list_member( H2, ListOfHeads ),
		  kp_dsp_compose_edges( E1, H2, ListHandles, Cxt ) ),
		ListHandles ), !,
	kp_erm_make_list_from_list_of_lists( ListListOfHandles, [],
		List ), !.


kp_dsp_make_all_heads( E2, Cxt, ListOfHeads ) :-
	rules_context_ret_handle( Cxt, ContextHandle ), !,
	if1( head_is_knowen( E2, ContextHandle, ListOfHeads ),
		true,
		( kp_dsp_really_make_heads( E2, Cxt, ListOfHeads ),
		  learn_ds_heads( E2, ContextHandle, ListOfHeads ) ) ), !.


kp_dsp_really_make_heads( E2, Cxt, ListOfHeads ) :-
	rules_context_ret_reduction_rules( Cxt, Rules1BList, Rules2List ), !,
	all_succ_result( ListOfHeads,
		kp_dsp_make_one_head( E2, Rules1BList, Rules2List, NewHead ),
		NewHead ), !.


kp_dsp_make_one_head( E2, Rules1BList, Rules2List, NewHead ) :-
	there_is_any_head_rule_for_an_edge( E2, Rules1BList, Rules2List,
		RuleNbr ),
	one_general_reduction( RuleNbr, E2, fail, [], NewHead ),
	kp_dsp_make_ds_reduction_edge_mark( NewHead ).


make_context_1( RuleList, Context ) :-
	new_handle( ContextHandle ),
	kp_dsp_make_rules_lists( RuleList, [], [], [],
		Rule1AList, Rule1BList, Rule2List ), !,
	Context = rule_compilated_structure( ContextHandle, Rule1AList,
		Rule1BList, Rule2List ), !.


kp_dsp_make_rules_lists( [], Rule1AList, Rule1BList, Rule2List,
		Rule1AList, Rule1BList, Rule2List ) :- !.

kp_dsp_make_rules_lists( [ RuleName | RuleList ],
		PrevRule1AList, PrevRule1BList, PrevRule2List,
		NewRule1AList, NewRule1BList, NewRule2List ) :-
	if1( kp_dsp_is_rule1A_name( RuleName, Element ),
		kp_dsp_make_rules_lists( RuleList,
			[ Element | PrevRule1AList ], PrevRule1BList,
			PrevRule2List, NewRule1AList, NewRule1BList,
			NewRule2List ),
		if1( kp_dsp_is_rule1B_name( RuleName, Element ),
			kp_dsp_make_rules_lists( RuleList, PrevRule1AList,
				[ Element | PrevRule1BList ], PrevRule2List,
				NewRule1AList, NewRule1BList, NewRule2List ),
			if1( kp_dsp_is_rule2_name( RuleName, Element ),
				kp_dsp_make_rules_lists( RuleList,
					PrevRule1AList, PrevRule1BList,
					[ Element | PrevRule2List ],
					NewRule1AList, NewRule1BList,
					NewRule2List ),
				( write(
		'make_context_1 error: I do not know any rule named like: ' ),
				  write( RuleName ), nl, !, fail
				) ) ) ), !.


kp_dsp_is_rule1A_name( RuleName, Element ) :-
	rule_structure_ret_rule_number( RuleStructure, RuleName ),
	find_1A_rule( MinStructure, _RuleNbrList, RuleStructure, _ ), !,
	kp_dsp_make_context_list_element( RuleName, MinStructure, Element ).


kp_dsp_make_context_list_element( RuleName, MinStructure, Element ) :-
	Element = ( RuleName = MinStructure ).


kp_dsp_is_rule1B_name( RuleName, Element ) :-
	find_1B_rule_number( MinStructure, RuleName, _ ), !,
	kp_dsp_make_context_list_element( RuleName, MinStructure, Element ).


kp_dsp_is_rule2_name( RuleName, Element ) :-
	find_2_rule_number( MinStructure, RuleName, _ ), !,
	kp_dsp_make_context_list_element( RuleName, MinStructure, Element ).


get_input_nodes( List ) :-
	start_node( StartNodeHandle ),
	last_node( EndNodeHandle ),
	ret_node_position( StartNodeHandle, StartNodePosition ),
	ret_node_position( EndNodeHandle, EndNodePosition), !,
	kp_dsp_generate_node_list( StartNodePosition, EndNodePosition,
		List ), !.


kp_dsp_generate_node_list( StartNodePosition, EndNodePosition, [] ) :-
	StartNodePosition > EndNodePosition, !.

kp_dsp_generate_node_list( StartNodePosition, EndNodePosition,
		[ StartNodePosition | List ] ) :-
	( StartNodePosition < EndNodePosition
	; StartNodePosition = EndNodePosition ), !,
	NewStart is StartNodePosition + 1,
	kp_dsp_generate_node_list( NewStart, EndNodePosition, List ), !.


hide_edge( E ) :-
	if1( var( E ),
		( write( 'hide_edge called with a free variable' ), nl,
		  !, fail ),
		true ), !,
	if1( kp_dsp_is_composed_edge( E ),
		( delete_edge_from_chart( E ),
		  kp_dsp_delete_composed_info( E ) ),
		( hide_edge_from_chart( E ),
		  kp_dsp_make_hide_edge_info( E ) ) ), !.


allow_all_edges :-
	retract_all_with_head(reduction_inner_information(_,_,_,_)),
	retract_all_with_head(read_edge_inner_information(_,_)),
	retract_all_with_head(kp_dm_edge_head_info_inner(_)),
	retract_all_with_head(edges_combination_inner_info(_,_,_)),
	backtracking_loop(
		( kp_dsp_delete_hide_info( E ),
		  chart_hiden_edge( E ) ) ),
	backtracking_loop(
		( kp_dsp_delete_composed_info( E ),
		  delete_edge_from_chart( E ) ) ).


exist_final_edge :-
	ex_success_edge.


change_constituent_types :-
	kp_dsp_delete_ds_reductions,
	kp_dsp_get_all_composed_edges( CompList ),
	kp_dsp_change_each_composed_structure( CompList ), !.


kp_dsp_delete_ds_reductions :-
	backtracking_loop(
		( kp_dsp_delete_ds_reduction_info( E ),
		  delete_edge_from_chart( E ) ) ).


kp_dsp_get_all_composed_edges( CompList ) :-
	all_succ_result( CompList,
		kp_dsp_is_composed_edge( Edge ),
		Edge ), !.


kp_dsp_change_each_composed_structure( CompList ) :-
	backtracking_loop(
		( list_member( Edge, CompList ),
		  kp_dsp_change_constituent( Edge ) ) ), !.


kp_dsp_change_constituent( Edge ) :-
	edge_ret_your_structure( Edge, EdgeStructure ),
	unify_feature_structures( EdgeStructure,
		[ synsem = SynsemStructure | RestEdgeStruct ] ),
	unify_feature_structures( SynsemStructure,
		[ phrasal = PhrasalStructure | RestSynsemStruct ] ),
	unify_feature_structures( PhrasalStructure,
		[ lexical = _Minus | RestPhrasalStructure ] ),
	NewEdgeStructure = [
		synsem = [
			phrasal = [
				lexical = plus | RestPhrasalStructure
				  ] | RestSynsemStruct
			 ] | RestEdgeStruct
			   ], !,
	edge_set_structure( Edge, NewEdgeStructure ), !.


kp_dsp_is_edge_a_ds_reduct( Edge ) :-
	ask_db( kp_dm_ds_pred_edge_head_reduct__( Edge ) ).

kp_dsp_make_ds_reduction_edge_mark( Edge ) :-
	assert_to_db( kp_dm_ds_pred_edge_head_reduct__( Edge ) ), !.

kp_dsp_delete_ds_reduction_info( Edge ) :-
	retract_from_db( kp_dm_ds_pred_edge_head_reduct__( Edge ) ).


kp_dsp_make_compose_edge_mark( Edge ) :-
	assert_to_db( kp_dm_ds_pred_compose_edge_mark__( Edge ) ), !.

kp_dsp_is_composed_edge( Edge ) :-
	ask_db( kp_dm_ds_pred_compose_edge_mark__( Edge ) ).

kp_dsp_delete_composed_info( Edge ) :-
	retract_from_db( kp_dm_ds_pred_compose_edge_mark__( Edge ) ).


kp_dsp_make_hide_edge_info( Edge ) :-
	assert_to_db( kp_dm_ds_pred_hide_edge_mark_info__( Edge ) ), !.

kp_dsp_delete_hide_info( Edge ) :-
	retract_from_db( kp_dm_ds_pred_hide_edge_mark_info__( Edge ) ).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/* veskere zpracovani a dosazovani chyb

  get_no_error( NoError )
   vrati 'nechybu' (cislo)

  get_feature_structure_error( Structure, Error )
   od feature structury vrati jeji chybovost (mysleno cislo)

  get_edge_error( EdgeHandle, EdgeError )
   od hrany zjisti chybovost jeji struktury (cislo)

  set_feature_structure_error( Structure, ErrorNbr, ErrorMessage )
   nastavi ve feature structure jeji chybovost

  combine_errors( LeftError, RightError, RuleError, WholeError )
   pro pravidlo typu 1, z chybovosti struktury dole, vpravo a chybovosti
    splneni pravidla, spocita celkovou chybu vysledne struktury (cisla vse)

  combine_body_errors( StillError, Error, RuleError )
   z dosavadni chyby splnovani a chyby posledne splneneho predikatu spocita
   prozatimni chybu splnovani

  compute_sort_value_for_error_edge( ErrorEdge, Value )
   pro chybovou hranu spocita jeji chybove ohodnoceni, podle nehoz se chybove
    hrany tridi
*/

get_no_error( 0 ).


get_feature_structure_error( Structure, Error ) :-
	big_feature_ret_error_nbr( Structure, ErrorNbr ), !,
	if1( var( ErrorNbr ),
		get_no_error( ErrorNbr ),
		true ), !,
	Error = ErrorNbr.


get_edge_error( EdgeHandle, EdgeError ) :-
	edge_ret_your_structure( EdgeHandle, EdgeStructure ), !,
	get_feature_structure_error( EdgeStructure, EdgeError ).


set_feature_structure_error( Structure, ErrorNumber, ErrorMessage ) :-
	big_feature_ret_error_nbr( Structure, ErrorNbr ),
	big_feature_ret_error_mess( Structure, ErrorMess ), !,
	if1( ( ErrorNbr = ErrorNumber , ErrorMess = ErrorMessage ),
		true,
		( write(
		    'the INNER PARSER ERROR - a new feature has an error' ),
		  nl
		) ).


combine_errors( LeftError, RightError, RuleError, WholeError ) :-
	WholeError is LeftError + RightError + RuleError.


combine_body_errors( StillError, Error, RuleError ) :-
	RuleError is StillError + Error.


compute_sort_value_for_error_edge( ErrorEdge, Value ) :-
	get_error_edge_info( ErrorEdge, EdgeStructure, _Useable,
		_MinStructure, StartNodeHandle, EndNodeHandle ),
	ret_nodes_distance( StartNodeHandle, EndNodeHandle, Distance ), !,
	get_feature_structure_error( EdgeStructure, Error ), !,
	Value is (100 * Error) / Distance.


/* Veskere operace na uzlich grafu */

/*
  ret_node_position(NodeHandle, NodePosition)
  ret_node_position_name(NodePosition, NodeHandle)
  ret_nodes_pos_distance(OneNodePosition, SecNodePosition, Distance)
  ret_nodes_distance(OneNodeHandle, SecNodeHandle, Distance)
  ret_farest_node(ListNodeHandles, FarestNodeHandle)

  set_start_node(NodeHandle)
  set_end_node(NodeHandle)
  is_last_node_defined
  start_node(NodeHandle)
  last_node(NodeHandle)
*/

ret_node_position(NodeHandle, NodePosition) :-
        if1(integer(NodeHandle),
                NodeHandle = NodePosition,
		ask_db(node__(NodeHandle, NodePosition))).

ret_node_position_name(NodePosition, NodeHandle) :-
	ask_db(node__(NodeHandle, NodePosition)).

ret_nodes_pos_distance(OneNodePosition, SecNodePosition, Distance) :-
        if1(OneNodePosition > SecNodePosition,
                Distance is OneNodePosition - SecNodePosition,
                Distance is SecNodePosition - OneNodePosition).

ret_nodes_distance(OneNodeHandle, SecNodeHandle, Distance) :-
        ret_node_position(OneNodeHandle, OneNodePosition),
        ret_node_position(SecNodeHandle, SecNodePosition),
        ret_nodes_pos_distance(OneNodePosition, SecNodePosition, Distance).

ret_farest_node([NodeHandle], NodeHandle).
ret_farest_node([NodeHandle | RestNodeHandlesList], FarestNodeHandle) :-
        RestNodeHandlesList \== [],
        ret_farest_node(RestNodeHandlesList, FarerNodeHandle),
        ret_node_position(NodeHandle, NodePosition),
        ret_node_position(FarerNodeHandle, FarerNodePosition),
        if1(FarerNodePosition > NodePosition,
                FarestNodeHandle = FarerNodePosition,
                FarestNodeHandle = NodePosition).

set_start_node(NodeHandle) :-
        asserta_to_db(node__(initial, NodeHandle)).

set_end_node(NodeHandle) :-
        asserta_to_db(node__(final, NodeHandle)).

is_last_node_defined :-
	ask_db(node__(final, NodeHandle)).

start_node(NodeHandle) :-
        necked_action((NodeHandle = initial;
		       ask_db(node__(initial, NodeHandle)))).

last_node(NodeHandle) :-
        necked_action((NodeHandle = final;
		       ask_db(node__(final, NodeHandle)))).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%




/* Konstrukty pouzite v ostatnich zdrojacich */

/*
  error(String)
  repeat1
  if1(Cond, Then, Else)
  b_not(Goal)
  necked_action(Action)
  necked_action_and_heap(Action)
  while_backtracking_loop(BackAction, Cond, LoopAction)
  while_repeat_backtracking_small_loop(Cond)
  backtracking_loop(BackAction)
  all_succ_result(ListOfSuccTerms, Goal, Term)

  read_list_of_files(FileList, EachTermAction, CurrTerm)
        - precte vsechny soubory obsazene v seznamu, tak ze na kazdy z nich
         nacteni term zavola akci, kde term v te chvili bude naunifikovany
	 do CurrTerm (cimz jasne, ze vse se deje pomoci backtrackingu)

 database data:
  assert_to_db(X)
  asserta_to_db(X)
  ask_db(X)
  retract_from_db(X)
  retract_all_with_head(Head)

 lists:
  list_append(L1,L2,Res)
  list_member( Elem, List )
*/

error(String) :-
	write(String),
	break.

repeat1.
repeat1 :- repeat1.

if1(Cond, Then, Else) :-
        Cond, !, Then.
if1(Cond, Then, Else) :-
       ( /* var(Cond), write('If called with empty condition'), ! ,Else ; */
	 Else ).

b_not(Goal) :-
        if1(Goal, fail, true).

necked_action(Action) :-
        Action, !.

necked_action_and_heap(Action) :-
        b_not(b_not(Action)).

while_backtracking_loop(BackAction, Cond, LoopAction) :-
        necked_action((
                (BackAction,
		 if1(Cond,
                    true,
                    (LoopAction,
                     fail)));
                true)).

while_repeat_backtracking_small_loop(Cond) :-
	while_backtracking_loop(repeat1, Cond, true).

backtracking_loop(BackAction) :-
        necked_action((
                (BackAction, fail);
                true)).

all_succ_result(ListOfSuccTerms, Goal, Term) :-
	findall(Term, Goal, ListOfSuccTerms).

assert_to_db(X) :-
	assert(X).

asserta_to_db(X) :-
        asserta(X).

ask_db(X) :-
	X.

retract_from_db(X) :-
	retract(X).

retract_all_with_head(Head) :-
	while_repeat_backtracking_small_loop(b_not(retract_from_db(Head))),
	while_repeat_backtracking_small_loop(
		b_not(retract_from_db(:-(Head, Body)))).

read_list_of_files([], EachTermAction, CurrTerm) :-
        !.
read_list_of_files([File | RestFiles], EachTermAction, CurrTerm) :-
        konstr_read_whole_file(File, EachTermAction, CurrTerm), !,
        read_list_of_files(RestFiles, EachTermAction, CurrTerm).

konstr_read_whole_file(File, EachTermAction, CurrTerm) :-
        seeing(CurrFile),
	see(File),
        konstr_read_to_end_of_file(EachTermAction, CurrTerm),
        seen,
	see(CurrFile).

konstr_read_to_end_of_file(EachTermAction, CurrTerm) :-
	repeat1,
        if1((read(Term), Term \== end_of_file),
                (Term = CurrTerm,
		 necked_action(EachTermAction),
                 fail),
		true),
	!.

list_append( [], List, List ).
list_append( [ Member | Rest ], List, [ Member | New ] ) :-
	list_append( Rest, List, New ).

list_member( Elem, [ Elem | _List ] ).
list_member( Elem, [ _ | List ] ) :-
	list_member( Elem, List ).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%



/* definice hran a prace s nimi na nizke urovni - zavisle na CHARTDAT.ARI */

/*
  init_lo_edges
        - vyhodi vsechny stare hrany
  make_new_input_edge(EdgeStructure, MinStructure,
                StartNodeHandle, EndNodeHandle)
        - vytvori hranu pro slovo ze vstupu
  make_new_reduction_edge(EdgeStructure, Useable, MinStructure,
                StartNodeHandle, EndNodeHandle,
                EdgeHandle)
        - vytvori novou hranu dale do leva rozsiritelnou, vzniklou redukci:
         parametry po rade obsahuji ji pridelenou strukturu, zda je primo
         pouzitelna (nemusi-li jeste cekat na levou redukci), nutnou
         podminku s niz vznikla (dulezite pro pozdejsi rozsirovani do leva),
         pocatecni a koncovy uzel, a v zaveru volnou promennou - vystupni
         parametr, do nehoz se po zkonceni navaze handle, nove vznikle hrany
  make_new_edge(NewStructure, MinStructure, StartNodeHandle, EndNodeHandle,
                EdgeHandle)
	- vytvori novou do leva rozsiritelnou, pouzitelnou hranu, pro jejiz
         parametry pri tomto volani se da rict totez jako i o
	 make_new_reduction_edge
  is_edge_valid(EdgeHandle)
        - zda hrana muze byt pouzita (neceka jeste na redukci doleva)
  is_edge_left_growable(EdgeHandle)
        - zda hrana muze rust doleva (dale redukovat)
  edge_ret_your_structure(EdgeHandle, EdgeStructure)
        - vrati feature structure zadane hrany
  edge_ret_your_minimal_structure(EdgeHandle, MinStructure)
        - vrati minimalni podminku pouzitou pri tvorbe teto hrany (napr VP),
         EdgeHandle preedpokladano jiz inicializovane (neni to volna promenna)
  edge_ret_start_node(EdgeHandle, StartNodeHandle)
        - od hrany vrati pocatecni uzel
  edge_ret_end_node(EdgeHandle, EndNodeHandle)
        - od hrany vrati koncovy uzel
  useable_edge_handle_starting_at(NodeHandle, EdgeHandle)
        - postupne vrati vsechny handly hran zacinajici v zadanem uzlu
  left_growable_edge_handle_starting_at(EndNodeHandle, EdgeHandle)
	- take postupne navraci vsechny doleva zvetsitelne i zatim nehrany
  make_new_error_reduction_edge( EdgeStructure, Useable, MinStructure,
		StartNodeHandle, EndNodeHandle, EdgeHandle )
	- podobne jako make_new_reduction_edge, vytvoi novou, ale trochu
	 specialni (pro predikaty vyse nepristupnou) hranu
  get_error_edge_info( ErrEdge, EdgeStructure, Useable,
		MinStructure, StartNodeHandle, EndNodeHandle )
	- jedinny predikat schopny s onou chybovou hranou pracovat, vraci od
	 ni veskere informace naraz (pozn. - tato hrana je mimo chart a pouze
	 vybrane nejlepsi se do chartu presunou)
  get_chart_edge(Edge, From, To)
	- predikat pro DS programovany panem doktorem Jano Hricem, vraci
	 postupne vsechny hrany, plus jejich pocatecni a koncove uzly
  hide_edge_from_chart( Edge )
	- hranu zapise do vzlastni, jinak nepristupne struktury, do db
  delete_edge_from_chart( Edge )
	- zcela zrusi hranu
  chart_hiden_edge( Edge )
	- schovanou hranu opet rekonstruhuje
  edge_set_structure( Edge, Structure )
	- prepise strukturu ve hrane na prave tuto novou
*/

make_new_error_reduction_edge( EdgeStructure, Useable, MinStructure,
		StartNodeHandle, EndNodeHandle, EdgeHandle ) :-
	new_handle(EdgeHandle),
	assert_to_db( nonchart_error_edge_inner_info__( EdgeHandle,
		EdgeStructure, Useable, MinStructure, StartNodeHandle,
		EndNodeHandle ) ), !.

get_error_edge_info( ErrEdge, EdgeStructure, Useable,
		MinStructure, StartNodeHandle, EndNodeHandle ) :-
	ask_db( nonchart_error_edge_inner_info__( ErrEdge, EdgeStructure,
		Useable, MinStructure, StartNodeHandle, EndNodeHandle ) ).


l_edge_remake_new_edge(EdgeStructure, Useable, LeftGrowable, MinStructure,
		StartNodeHandle, EndNodeHandle, ChartEdge,
		EdgeHandle) :-
	if1(ChartEdge, assert_to_db(edge_chart__(EdgeHandle, chart)), true),
	assert_to_db(edge_start_node__(EdgeHandle, StartNodeHandle)),
	assert_to_db(edge_end_node__(EdgeHandle, EndNodeHandle)),
	assert_to_db(edge_category__(EdgeHandle, EdgeStructure)),

	assert_to_db(edge_inner_info(EdgeHandle, Useable, LeftGrowable)),
	assert_to_db(edge_inner_min_structure(EdgeHandle, MinStructure)),
	!.

l_edge_make_new_edge(EdgeStructure, Useable, LeftGrowable, MinStructure,
		StartNodeHandle, EndNodeHandle, ChartEdge,
		EdgeHandle) :-
	new_handle(EdgeHandle),
	l_edge_remake_new_edge(EdgeStructure, Useable, LeftGrowable,
		MinStructure, StartNodeHandle, EndNodeHandle, ChartEdge,
		EdgeHandle), !.

make_new_input_edge(EdgeStructure, MinStructure,
		StartNodeHandle, EndNodeHandle) :-
	l_edge_make_new_edge(EdgeStructure, true, fail, MinStructure,
		StartNodeHandle, EndNodeHandle, fail, _).
/* sem opet dat volani pro ds (DS_INSERT) */

make_new_reduction_edge(EdgeStructure, Useable, MinStructure,
		StartNodeHandle, EndNodeHandle,
                EdgeHandle) :-
	l_edge_make_new_edge(EdgeStructure, Useable, true, MinStructure,
                StartNodeHandle, EndNodeHandle, true, EdgeHandle)
/* * /
, write(make_reduction_edge(StartNodeHandle, EndNodeHandle, EdgeHandle)), nl
/ * */
	 .

make_new_edge(NewStructure, MinStructure, StartNodeHandle, EndNodeHandle,
		EdgeHandle) :-
        l_edge_make_new_edge(NewStructure, true, true, MinStructure,
                StartNodeHandle, EndNodeHandle, true, EdgeHandle)
/* * /
, write(make_left_edge(StartNodeHandle, EndNodeHandle, EdgeHandle)), nl
/ * */
	.

is_edge_valid(EdgeHandle) :-
	ask_db(edge_inner_info(EdgeHandle, true, _)).

is_edge_left_growable(EdgeHandle) :-
	ask_db(edge_inner_info(EdgeHandle, _, true)).

edge_ret_your_structure(EdgeHandle, EdgeStructure) :-
        ask_db(edge_category__(EdgeHandle, EdgeStructure)).

edge_ret_your_minimal_structure(EdgeHandle, MinStructure) :-
        if1(ask_db(edge_inner_min_structure(EdgeHandle, MinStructure)),
		true,
		(edge_ret_your_structure(EdgeHandle, EdgeStructure),
		 big_feature_ret_minimal_condition(EdgeStructure,
						   MinStructure),
		 assert_to_db(edge_inner_min_structure(EdgeHandle,
						       MinStructure)))).

edge_ret_start_node(EdgeHandle, StartNodeHandle) :-
	 ask_db(edge_start_node__(EdgeHandle, StartNodeHandle))
        ;
         nonvar(StartNodeHandle),
	 if1(integer(StartNodeHandle),
                ret_node_position_name(StartNodeHandle, NodeHandle),
                ret_node_position(StartNodeHandle, NodeHandle)),
         ask_db(edge_start_node__(EdgeHandle, NodeHandle)).

edge_ret_end_node(EdgeHandle, EndNodeHandle) :-
         ask_db(edge_end_node__(EdgeHandle, EndNodeHandle))
        ;
         nonvar(EndNodeHandle),
	 if1(integer(EndNodeHandle),
		ret_node_position_name(EndNodeHandle, NodeHandle),
                ret_node_position(EndNodeHandle, NodeHandle)),
         ask_db(edge_end_node__(EdgeHandle, NodeHandle)).


useable_edge_handle_starting_at(NodeHandle, EdgeHandle) :-
	edge_ret_start_node(EdgeHandle, NodeHandle),
	is_edge_valid(EdgeHandle).

left_growable_edge_handle_starting_at(NodeHandle, EdgeHandle) :-
	edge_ret_start_node(EdgeHandle, NodeHandle),
	is_edge_left_growable(EdgeHandle).

init_lo_edges :-
	init_ds_module,
	retract_all_with_head(edge_inner_info(_,_,_)),
	retract_all_with_head(edge_category__(_,_)),
	retract_all_with_head(edge_chart__(_,_)),
	retract_all_with_head(edge_start_node__(_,_)),
	retract_all_with_head(edge_end_node__(_,_)),
	retract_all_with_head(edge_inner_min_structure(_,_)),
	retract_all_with_head(
		kp_dm_hide_edge_db_inner__( _,_,_,_,_,_,_,_ ) ).


get_chart_edge( Edge, From, To ) :-
	if1( var( To ),
		( edge_ret_start_node( Edge, From ),
		  edge_ret_end_node( Edge, To ) ),
		( edge_ret_end_node( Edge, To ),
		  edge_ret_start_node( Edge, From ) ) ).

l_edge_retract_edge_ret_all_info( EdgeHandle, ChartEdge, StartNodeHandle,
		EndNodeHandle, EdgeStructure, Useable, LeftGrowable,
		MinStructure ) :-
	if1( retract_from_db( edge_chart__( EdgeHandle, chart ) ),
		ChartEdge = true,
		ChartEdge = fail ),
	retract_from_db( edge_start_node__( EdgeHandle, StartNodeHandle ) ),
	retract_from_db( edge_end_node__( EdgeHandle, EndNodeHandle ) ),
	retract_from_db( edge_category__( EdgeHandle, EdgeStructure ) ),
	retract_from_db( edge_inner_info( EdgeHandle, Useable,
			LeftGrowable ) ),
	retract_from_db( edge_inner_min_structure( EdgeHandle,
			MinStructure ) ).

hide_edge_from_chart( Edge ) :-
	l_edge_retract_edge_ret_all_info( Edge, ChartEdge, StartNodeHandle,
		EndNodeHandle, EdgeStructure, Useable, LeftGrowable,
		MinStructure ),
	assert_to_db( kp_dm_hide_edge_db_inner__( Edge, ChartEdge,
		StartNodeHandle, EndNodeHandle, EdgeStructure, Useable,
		LeftGrowable, MinStructure ) ), !.

delete_edge_from_chart( Edge ) :-
	l_edge_retract_edge_ret_all_info( Edge, _ChartEdge, _StartNodeHandle,
		_EndNodeHandle, _EdgeStructure, _Useable, _LeftGrowable,
		_MinStructure ).

chart_hiden_edge( Edge ) :-
	retract_from_db( kp_dm_hide_edge_db_inner__( Edge, ChartEdge,
		StartNodeHandle, EndNodeHandle, EdgeStructure, Useable,
		LeftGrowable, MinStructure ) ),
	l_edge_remake_new_edge( EdgeStructure, Useable, LeftGrowable,
		MinStructure, StartNodeHandle, EndNodeHandle, ChartEdge,
		Edge ).

edge_set_structure( Edge, Structure ) :-
	retract_from_db( edge_category__( Edge, _EdgeStructure ) ),
	assert_to_db( edge_category__( Edge, Structure ) ), !.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/* hlavni program celeho parseru */

/*
  load_rules(FileList)
        - nacte pravidla ze souboru uvedenych v seznamu
	 pozn - kod je nadefinovan v souboru a_rule.ari
  start_parsing(FileList)
        - nacte hrany ze souboru uvedenych v seznamu a pokusi se je
         sparsovat
  parse(MultipleResult)
        - predpoklada existenci zadani jiz v databazi,
	 veskere vystupy tiskne pomoci write
          neni-li MultipleResult atom 'single', pokusi se najit vsechna reseni
  start_DEEM_parsing
	- zahaji po veskerych inicializacich vlastni parsing
*/

parse(MultipleResult) :-
	init_lo_level, !,
	if1( MultipleResult == single,
		single_parse_loop,
		start_DEEM_parsing /* prave sem dat volani DS - misto tohoto
					cile (DS_INSERT) */
	   ).

start_DEEM_parsing :-
	make_first_empty_stack, !,
	all_parse_loop.

single_parse_loop :-
	make_first_empty_stack, !,
	while_backtracking_loop(
		repeat1,
		(choose_stack, curr_stack_finishing),
		make_curr_stack_operation).

all_parse_loop :-
	while_backtracking_loop(
		repeat1,
                b_not(choose_stack),
                make_curr_stack_operation).

start_parsing(FileList) :-
        init_handle_counter,
        set_start_node(0),
        init_lo_edges,
        read_input_edges(FileList),
        parse(multiple),
	error_parsing.

%%%%%%%%%%%%%%%%%%%%%%%%%%%

/* error processing

  error_parsing
   zahaji cele chybove zpracovani

  kp_erm_make_list_from_list_of_lists( ListOfListEdges, TempList,
	NewErrEdges )
   ze seznamu seznamu vytvori seznam

  one_general_reduction( HeadRuleNumber, HeadEdgeHandle, ErrorParsing,
		ListOfInnerEdgeHandles, EdgeHandle )
	- z cisla head pravidla, hrany, jez ma slouzit za hranu, seznamu
	 povolenych pravidel vytvori (backtackingem vsechny mozne) hrany,
	 a to podle toho, zda se jedna o normalni ci o error processing,
	 normalni ci specialni pro zpracovani chyb
*/

error_parsing :-
	kp_erm_init_error_informations, !,
	kp_erm_main_loop.


kp_erm_main_loop :-
	repeat1,
	if1( ex_success_edge,
		true,
		( kp_erm_make_best_edges_list( BestList ), !,
		  if1( BestList = [],
			true,
			( kp_erm_continue_parsing_on_edges( BestList ), !,
			  fail ) ) ) ), !.


kp_erm_make_best_edges_list( BestList ) :-
	kp_erm_error_reductions( NewErrEdges ), !,
	kp_erm_value_err_edges( NewErrEdges, ValueErrEdges ), !,
	kp_erm_get_old_err_edges( OldErrEdges ), !,
	kp_erm_sort_merge( ValueErrEdges, OldErrEdges, AllErrEdges ), !,
	kp_erm_take_bests( AllErrEdges, BestList, RestList ), !,
	kp_erm_put_rest_to_db( RestList ), !.


kp_erm_error_reductions( NewErrEdges ) :-
	all_succ_result( ListOfListEdges,
		(
		 kp_erm_one_error_reduction( ListOfErrEdges )
		;
		 kp_erm_error_left_reduction( ListOfErrEdges )
		),
		ListOfErrEdges ), !,
	kp_erm_make_list_from_list_of_lists( ListOfListEdges, [],
		NewErrEdges ).


kp_erm_one_error_reduction( ListOfErrEdges ) :-
	del_new_err_reduction_info( HeadRuleNumber, HeadEdgeHandle,
		ListOfInnerEdgeHandles ),
	all_succ_result( ListOfErrEdges,
		kp_erm_make_one_err_reduction( HeadRuleNumber, HeadEdgeHandle,
			ListOfInnerEdgeHandles, EdgeHandle ),
		EdgeHandle ).


kp_erm_make_one_err_reduction( HeadRuleNumber, HeadEdgeHandle,
		ListOfInnerEdgeHandles, EdgeHandle ) :-
	one_general_reduction( HeadRuleNumber, HeadEdgeHandle, true,
		ListOfInnerEdgeHandles, EdgeHandle ).


one_general_reduction( HeadRuleNumber, HeadEdgeHandle, ErrorParsing,
		ListOfInnerEdgeHandles, EdgeHandle ) :-
	edge_ret_start_node( HeadEdgeHandle, StartNodeHandle ),
	if1( ListOfInnerEdgeHandles = [ LastEdgeHandle | _ ],
		Useable = true,
		( Useable = fail, LastEdgeHandle = HeadEdgeHandle ) ),
	edge_ret_end_node( LastEdgeHandle, EndNodeHandle ),
	use_head_rule( HeadEdgeHandle, HeadRuleNumber,
		HeadNode, MinStructure, EndStructure ),
	reduction_combine_structures( EndStructure, MinStructure, _,
		ErrorParsing, ListOfInnerEdgeHandles, fail, NewStructure,
		_StillUseable, ErrorPresented ),
	get_edge_error( HeadEdgeHandle, HeadError ),
	reduction_combine_node_with_structure( HeadNode, HeadError,
		NewStructure, ErrorParsing, EdgeStructure, ErrorPresented ),
	if1( ErrorParsing,
		( nonvar( ErrorPresented ),
		  make_new_error_reduction_edge( EdgeStructure, Useable,
			MinStructure, StartNodeHandle, EndNodeHandle,
			EdgeHandle ) ),
		make_new_reduction_edge( EdgeStructure, Useable,
			MinStructure, StartNodeHandle, EndNodeHandle,
			EdgeHandle ) ).


kp_erm_error_left_reduction( ListOfErrEdges ) :-
	del_new_err_left_reduction_info( PrevEdgeHandle, LastEdgeHandle ),
	all_succ_result( ListOfErrEdges,
		left_combine_stack_edges( PrevEdgeHandle,
			LastEdgeHandle, true, _, EdgeHandle, _ ),
		EdgeHandle ).


kp_erm_make_list_from_list_of_lists( [], ResultList, ResultList ) :-
	!.

kp_erm_make_list_from_list_of_lists( [ ErrList | ListOfListEdges ], TempList,
		NewErrEdges ) :-
	list_append( ErrList, TempList, NextList ), !,
	kp_erm_make_list_from_list_of_lists( ListOfListEdges, NextList,
		NewErrEdges ).


kp_erm_value_err_edges( [], [] ) :- !.

kp_erm_value_err_edges( [ ErrorEdge | NewErrEdges ],
		[ ErrorEdge = Value | ValueErrEdges ] ) :-
	compute_sort_value_for_error_edge( ErrorEdge, Value ), !,
	kp_erm_value_err_edges( NewErrEdges, ValueErrEdges ).


kp_erm_sort_merge( [], ErrEdges, ErrEdges ) :- !.

kp_erm_sort_merge( [ ErrorEdgeInfo | NewEdges ], SortedErrEdges,
		AllErrEdges ) :-
	kp_erm_insert_edge( ErrorEdgeInfo, SortedErrEdges, NextErrEdges ), !,
	kp_erm_sort_merge( NewEdges, NextErrEdges, AllErrEdges ).


kp_erm_insert_edge( ErrorEdgeInfo, [], [ ErrorEdgeInfo ] ) :- !.

kp_erm_insert_edge( ErrorEdgeInfo, StillSortedList,
		NextErrEdges ) :-
	ErrorEdgeInfo = ( _ErrEdge = Value ),
	StillSortedList = [ SortInfo | SortedErrEdges ],
	SortInfo = ( _SortEdge = SortValue ), !,
	if1( Value > SortValue,
		( NextErrEdges = [ SortInfo | RestNext ],
		  kp_erm_insert_edge( ErrorEdgeInfo, SortedErrEdges,
			RestNext ) ),
		NextErrEdges = [ ErrorEdgeInfo | StillSortedList ] ), !.


kp_erm_take_bests( AllErrEdges, BestList, RestList ) :-
	kp_erm_take_first_count( AllErrEdges, 7, BestList, RestList ).


kp_erm_take_first_count( [], _, [], [] ) :- !.

kp_erm_take_first_count( ErrEdges, 0, [], ErrEdges ) :- !.

kp_erm_take_first_count( [ Edge = _Value | AllErrEdges ], Number,
		[ Edge | BestList ], RestList ) :-
	Number > 0,
	NewNumber is Number - 1, !,
	kp_erm_take_first_count( AllErrEdges, NewNumber, BestList, RestList ).


kp_erm_continue_parsing_on_edges( BestList ) :-
	kp_erm_make_edges_and_operations( BestList ), !,
	all_parse_loop, !.


kp_erm_make_edges_and_operations( [] ) :- !.

kp_erm_make_edges_and_operations( [ ErrEdge | BestList ] ) :-
	kp_erm_make_edges_and_operations( BestList ), !,
	necked_action_and_heap( (
		get_error_edge_info( ErrEdge, EdgeStructure, Useable,
			MinStructure, StartNodeHandle, EndNodeHandle ),
		make_new_reduction_edge( EdgeStructure, Useable, MinStructure,
			StartNodeHandle, EndNodeHandle, _EdgeHandle ),
		kp_erm_wake_up_all_stacks( StartNodeHandle ), !
				) ), !.


kp_erm_wake_up_all_stacks( StartNodeHandle ) :-
	backtracking_loop( (
		get_stack_starting_at( StartNodeHandle, StackHandle ),
		make_stack_copy( StackHandle, so_readanyedge )
			   ) ), !.


kp_erm_init_error_informations :-
	kp_erm_put_rest_to_db( [] ), !.


kp_erm_get_old_err_edges( OldErrEdges ) :-
	ask_db( error_sort_value_edges_list_inner__( OldErrEdges ) ).

kp_erm_put_rest_to_db( RestList ) :-
	retract_all_with_head( error_sort_value_edges_list_inner__( _ ) ), !,
	asserta_to_db( error_sort_value_edges_list_inner__( RestList ) ).

%%%%%%%%%%%%%%%%%%%%%%%%%%%


/* hlavni soubor pro vsechny lo_level */

/*
  init_lo_level
        - inicialicuje veskere potrebne lo-level struktury
  init_handle_counter
        - inicializuje handle counter - treba volat PRED init_lo_level
  new_handle(Handle)
        - vytvori nove handle
*/

init_lo_level :-
        init_information.

init_handle_counter :-
	retract_all_with_head(edge_free_number__(X)),
        asserta_to_db(edge_free_number__(0)).

new_handle(Handle) :-
	retract_from_db(edge_free_number__(Handle)),
        NewCounter is Handle + 1,
        asserta_to_db(edge_free_number__(NewCounter)).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


/* operace se stackem jeste na rozumne vysoke urovni */

/*
  make_first_empty_stack
        - vytvori novy, prazdny stack, na pocatku celeho vypoctu

  choose_stack
        - vybere stack vhodny akorat tak pro provedeni nejake akce

  curr_stack_finishing
	- zjisti, zda stack jiz nahodou nepredstavuje odvozeni cele vety

  make_curr_stack_operation
        - na stacku provede vsechny mozne operace
*/

make_first_empty_stack :-
        make_first_lolevel_empty_stack,
        init_information.

choose_stack :-
        there_is_a_stack,
        necked_action_and_heap((
                del_first_stack(Stack),
                set_current_stack(Stack))).

is_curr_stack_on_end :-
        curr_stack_end_node(NodeHandle),
        last_node(NodeHandle).

is_curr_stack_list_of_reduction_empty :-
        curr_stack_list_of_free_ends([]).

last_finishing_test_operations :-
        curr_stack_list_of_last_members([Member]),
        get_stack_member_edge_handle(Member, Sentence),
        structure_is_a_valid_sentence(Sentence),
        !,
        copy_curr_stack_to_success_info.

curr_stack_finishing :-
        is_curr_stack_on_end,
        is_curr_stack_list_of_reduction_empty,
        last_finishing_test_operations,
        !.

make_curr_stack_operation :-
	get_curr_stack_operation_code(OperationCode),
/* * /
CurrentStack = current_stack_operation( StackHandle, OperationCode ),
ask_db( CurrentStack ), write( CurrentStack ),nl, !,
/ * */
	(
         var(OperationCode), !, Action = error(
          'i_stack.ari: make_curr_stack_operation - operation code error');
         OperationCode = so_decide, !,
                        Action = decide_on_curr_stack;
         OperationCode = so_reduct, !,
                        Action = start_reduct_curr_stack;
         OperationCode = so_leftreduct, !,
                        Action = left_reduct_curr_stack;
         OperationCode = so_possleftreduct, !,
                        Action = poss_left_reduct_curr_stack;
         OperationCode = so_readanyedge, !,
                        Action = read_any_edge_to_curr_stack;
         OperationCode = so_readhead, !,
                        Action = read_head_to_curr_stack;
         OperationCode = so_readonlyedge, !,
                        Action = read_only_edge_to_curr_stack;
	 OperationCode = so_nooperation, !,
                        Action = true;
	 Action = error(
           'i_stack.ari: make_curr_stack_operation - operation code error')
        ), !,
        if1(Action, true, make_curr_failure_stack_info).


decide_on_curr_stack :-
        if1(is_curr_stack_list_of_reduction_empty,
                (EndAction = last_finishing_test_operations,
                 ReadAction = make_curr_stack_copy(so_readanyedge)),
                if1((in_curr_stack_top_reduction_has_no_inner_edge,
                     in_curr_stack_top_reduction_starts_at_begining),
                        (EndAction = true,
                         ReadAction = make_curr_stack_copy(so_readanyedge)),
                        (EndAction = make_curr_stack_copy(so_reduct),
                         ReadAction = really_decide_on_curr_stack))),
        if1(is_curr_stack_on_end, EndAction, ReadAction).

really_decide_on_curr_stack :-
        sort_read_reduct([so_reduct, so_readanyedge], SortedList),
        if1(SortedList = [_, Second],
                make_curr_stack_copy(Second), true),
        if1(SortedList = [First | _],
                make_curr_stack_copy(First), true),
        !.

start_reduct_curr_stack :-
 	if1(( in_curr_stack_top_reduction_has_no_inner_edge,
			in_curr_stack_top_reduction_has_no_left_edge ),
		MakeNewStack = fail,
		MakeNewStack = true ),
        make_reduction_info_change_curr_to_dady(ReductionInfo,
                FatherStackHandle),
        reduce_ret_edges_handles(ReductionInfo, ListOfEdgesHandles),
 	if1( MakeNewStack,
        	father_dady_read_edges(ListOfEdgesHandles, so_possleftreduct,
                	FatherStackHandle ),
		true ).


reduce_ret_edges_handles(ReductionInfo, ListOfEdgesHandles) :-
        reduction_info_ret_unique_handle(ReductionInfo,
                HeadRuleNumber, HeadEdgeHandle, ListOfInnerEdgeHandles),
        if1(has_reduction_been_here(HeadRuleNumber, HeadEdgeHandle,
                        ListOfInnerEdgeHandles, ListOfEdgesHandles),
                true,
                (reduce_action(ReductionInfo, ListOfEdgesHandles),
                 add_reduction_info(HeadRuleNumber, HeadEdgeHandle,
                        ListOfInnerEdgeHandles, ListOfEdgesHandles))).

reduce_action(ReductionInfo, ListOfEdgesHandles) :-
        all_succ_result(ListOfEdgesHandles,
                reduce_to_edge(ReductionInfo, EdgeHandle),
                EdgeHandle).

reduce_to_edge(ReductionInfo, EdgeHandle) :-
        get_reduction_info_end_structure(ReductionInfo, EndStructure),
        get_reduction_info_back_edges_list(ReductionInfo, BackEdgesList),
        get_reduction_info_minimal_struct_mask(ReductionInfo, MinStructure),
	reduction_combine_structures( EndStructure, MinStructure, _,
		fail, BackEdgesList, fail, NewStructure, _StillUseable,
		_ErrorPresented ),
	get_reduction_info_head_node(ReductionInfo, HeadNode),
	get_reduction_info_head_error( ReductionInfo, HeadError ),
	reduction_combine_node_with_structure( HeadNode, HeadError,
		NewStructure, fail, EdgeStructure, _ErrorPresented ),
        if1(BackEdgesList = [], Useable = fail, Useable = true),
        get_reduction_start_head_node(ReductionInfo, StartNodeHandle),
        get_reduction_end_node(ReductionInfo, EndNodeHandle),
/*
nl,
*/
	make_new_reduction_edge(EdgeStructure, Useable, MinStructure,
                StartNodeHandle, EndNodeHandle,
		EdgeHandle).

reduction_combine_structures( EndStructure, _MinStructure, _RulesContext,
		_ErrorParsing, [], Competetion, EndStructure, Competetion,
		_ErrorPresented ).
reduction_combine_structures( EndStructure, MinStructure, RulesContext,
		ErrorParsing, [LastEdgeHandle | RestEdgesHandles],
		_Competetion, NewStructure, EdgeCompetetion,
		ErrorPresented ) :-
	make_new_parse_node( LastEdgeHandle, MinStructure, RulesContext,
		EdgeNode, StillCompletition, LastEdgeError ),
	reduction_combine_node_with_structure( EdgeNode, LastEdgeError,
		EndStructure, ErrorParsing, TempStructure, ErrorPresented ),
	reduction_combine_structures( TempStructure, MinStructure,
		RulesContext, ErrorParsing, RestEdgesHandles,
		StillCompletition, NewStructure, EdgeCompetetion,
		ErrorPresented ).

reduction_combine_node_with_structure( EdgeNode, EdgeError, NextStructure,
		ErrorParsing, ResultStructure, ErrorPresented ) :-
	get_edge_node_end_structure(EdgeNode, EndStructure),
	unify_feature_structures(EndStructure, NextStructure),
	call_f_function_ret_all_structure( EdgeNode, ErrorParsing,
		ResultStructure, ErrorPresented, RuleError, RuleErrMessage ),
	get_feature_structure_error( NextStructure, NextError ),
	combine_errors( EdgeError, NextError, RuleError, NewError ),
	set_feature_structure_error( ResultStructure, NewError,
		RuleErrMessage ).

father_dady_read_edges(ListOfEdgesHandles, OperationCode,
		FatherStackHandle) :-
        back_sort_edges_for_stack(FatherStackHandle, ListOfEdgesHandles,
                BackListOfEdgesHandles),
        read_list_of_edges_by_stack(FatherStackHandle,
                BackListOfEdgesHandles, OperationCode).

curr_dady_read_edges(ListOfEdgesHandles, OperationCode) :-
        back_sort_edges_for_curr_stack(ListOfEdgesHandles,
                BackListOfEdgesHandles),
        read_list_of_edges_by_curr_stack(BackListOfEdgesHandles,
                OperationCode).

read_list_of_edges_by_stack(FatherStackHandle, [], OperationCode).
read_list_of_edges_by_stack(FatherStackHandle,
                [EdgeHandle | RestOfEdgeHandlesList], OperationCode) :-
        read_edge_by_a_stack(FatherStackHandle, EdgeHandle, OperationCode),
        read_list_of_edges_by_stack(FatherStackHandle, RestOfEdgeHandlesList,
                OperationCode).

read_list_of_edges_by_curr_stack([], OperationCode).
read_list_of_edges_by_curr_stack([EdgeHandle | RestOfEdgeHandlesList],
                OperationCode) :-
        read_edge_by_curr_stack(EdgeHandle, OperationCode),
        read_list_of_edges_by_curr_stack(RestOfEdgeHandlesList,
                OperationCode).

read_edge_by_a_stack(FatherStackHandle, EdgeHandle, OperationCode) :-
        if1(introduce_edge_to_a_stack_fail_means_new(FatherStackHandle,
                        EdgeHandle),
                true,
                make_stack_son(FatherStackHandle, EdgeHandle,
                        OperationCode)).

read_edge_by_curr_stack(EdgeHandle, OperationCode) :-
        if1(introduce_edge_to_stack_fail_means_new(EdgeHandle),
                true,
                make_curr_stack_son(EdgeHandle, OperationCode)).

left_reduct_curr_stack :-
        curr_stack_ret_two_last_members_change_to_father(LastMember,
                PrevMember, FatherStackHandle),
        get_stack_member_edge_handle(LastMember, LastEdgeHandle),
        if1(is_edge_left_growable(LastEdgeHandle),
                (get_stack_member_edge_handle(PrevMember, PrevEdgeHandle),
                 combine_edges_add_to_a_stack(PrevEdgeHandle,
                        LastEdgeHandle, FatherStackHandle)),
                error('i_stack.ari: left_reduct_curr_stack')).

combine_edges_add_to_a_stack(PrevEdgeHandle, LastEdgeHandle,
                FatherStackHandle) :-
        if1(knowen_edges(PrevEdgeHandle, LastEdgeHandle, ListOfEdgesHandles),
                true,
		(
		all_succ_result(ListOfEdgesHandles,
			left_combine_stack_edges( PrevEdgeHandle,
				LastEdgeHandle, fail, _, EdgeHandle, _ ),
			EdgeHandle),
		 learn_edges_combination(PrevEdgeHandle, LastEdgeHandle,
			ListOfEdgesHandles))),
	father_dady_read_edges(ListOfEdgesHandles, so_possleftreduct,
		FatherStackHandle).

left_combine_stack_edges( PrevEdgeHandle, LastEdgeHandle, ErrorProcessing,
		Context, EdgeHandle, Useable ) :-
	edge_ret_your_structure(LastEdgeHandle, EndStructure),
	edge_ret_your_minimal_structure(LastEdgeHandle, MinStructure),
	reduction_combine_structures( EndStructure, MinStructure, Context,
		ErrorProcessing, [PrevEdgeHandle], fail, NewStructure,
		Useable, ErrorPresented ),
	edge_ret_start_node(PrevEdgeHandle, StartNodeHandle),
	edge_ret_end_node(LastEdgeHandle, EndNodeHandle),
	if1( ErrorProcessing,
		( nonvar( ErrorPresented ),
		  make_new_error_reduction_edge( NewStructure, Useable,
				MinStructure,
				StartNodeHandle, EndNodeHandle, EdgeHandle )
		),
		make_new_reduction_edge( NewStructure, Useable, MinStructure,
			StartNodeHandle, EndNodeHandle, EdgeHandle ) ).

poss_left_reduct_curr_stack :-
        if1(is_curr_stack_left_reduceable,
                really_decide_on_leftred_or_read,
                if1(is_top_curr_stack_edge_valid,
                        (make_curr_stack_copy(so_decide),
                         i_stack_make_head_from_top_of_curr_stack),
                        make_curr_failure_stack_info)).

really_decide_on_leftred_or_read :-
        if1(is_top_curr_stack_edge_valid,
                (sort_decide_leftreduct([so_leftreduct, so_decide],
                        SortedList),
                 if1(SortedList = [_, Second],
                        make_curr_stack_copy(Second), true),
                 if1(SortedList = [First | _],
                        make_curr_stack_copy(First), true),
                 i_stack_make_head_from_top_of_curr_stack,
                 !),
                make_curr_stack_copy(so_leftreduct)).

i_stack_make_head_from_top_of_curr_stack :-
        curr_stack_ret_top_change_to_father(TopEdgeHandle),
        i_stack_read_all_really_heads_of_edge_to_curr_stack(TopEdgeHandle).

read_any_edge_to_curr_stack :-
	sort_read_member_head([so_readhead, so_readonlyedge], SortedList),
        if1(SortedList = [_, Second],
                make_curr_stack_copy(Second), true),
        if1(SortedList = [First | _],
                make_curr_stack_copy(First), true),
        !.

read_head_to_curr_stack :-
        curr_stack_end_node(EndNodeHandle),
        read_all_really_heads_to_curr_stack(EndNodeHandle),
        read_all_left_edges_to_curr_stack(EndNodeHandle).

read_all_really_heads_to_curr_stack(EndNodeHandle) :-
        i_stack_read_all_really_heads_to_curr_stack(
                useable_edge_handle_starting_at(EndNodeHandle, EdgeHandle),
                EdgeHandle).

i_stack_read_all_really_heads_of_edge_to_curr_stack(EdgeHandle) :-
        i_stack_read_all_really_heads_to_curr_stack(true, EdgeHandle).

i_stack_read_all_really_heads_to_curr_stack(EdgeSelectingGoal, EdgeHandle) :-
        all_succ_result(ListOfDoubleHandles,
		(EdgeSelectingGoal,
		 i_stack_test_head_info( EdgeHandle ),
		 there_is_any_head_rule_for_an_edge( EdgeHandle, _, _,
			RuleNbr )),
		(EdgeHandle, RuleNbr)),
        back_sort_double_handles(ListOfDoubleHandles, BackDoubleList),
        insert_heads_to_curr_stack(BackDoubleList).

i_stack_test_head_info( EdgeHandle ) :-
	if1( ex_edge_head_info( EdgeHandle ),
		fail,
		add_edge_head_info( EdgeHandle ) ), !.

insert_heads_to_curr_stack([]).
insert_heads_to_curr_stack([(EdgeHandle, RuleNbr) | RestOfBackList]) :-
        if1(use_head_rule(EdgeHandle, RuleNbr,
                HeadNode, MinStructure, EndStructure),
                make_curr_stack_headed_son(EdgeHandle, RuleNbr, HeadNode,
                        MinStructure, EndStructure, so_decide),
                true),
        insert_heads_to_curr_stack(RestOfBackList).

read_all_left_edges_to_curr_stack(EndNodeHandle) :-
        all_succ_result(ListOfLeftEdgeHandles,
                left_growable_edge_handle_starting_at(EndNodeHandle,
                        EdgeHandle),
                EdgeHandle),
        curr_dady_read_edges(ListOfLeftEdgeHandles, so_possleftreduct).

read_only_edge_to_curr_stack:-
        curr_stack_end_node(EndNodeHandle),
        all_succ_result(ListOfEdgeHandles,
                useable_edge_handle_starting_at(EndNodeHandle, EdgeHandle),
                EdgeHandle),
/* * /
write(read_only_edge(ListOfEdgeHandles)), nl,
/ * */
        curr_dady_read_edges(ListOfEdgeHandles, so_decide).



%%%%%%%%%%%%%%%%%%%%%%%%


/* lolevel operace se stackem */

/*
  make_first_lolevel_empty_stack
	- vytvori prvni novy prazdny stack
  there_is_a_stack
	- dotaz, zda existuje nejaky stack v databazi
  del_first_stack(Stack)
	- prvni stack znici z databaze a vrati v promenne
  set_current_stack(Stack)
	- stack z promenne nastavi na aktualni
  curr_stack_number(CurrStackHandle)
	- vrati handle aktualniho stacku
  ordinary_stack_end_node(StackHandle, NodeHandle)
  curr_stack_end_node(NodeHandle)
	- ze stacku vrati zatim posledni docteny uzel
  ordinary_stack_list_of_free_ends(StackHandle, ListOfFreeEnds)
  curr_stack_list_of_free_ends(ListOfFreeEnds)
	- vrati seznam volnych koncu se zakomponovanymi i predchozimi
	 urovnemi vypoctu na tomto stacku (kazdy volny konec saha jen nekam,
	 a to kam saha (co muze zredukovat) ten nejhornejsi je pouze v
	 seznamu clenu, zbyvajici jsou postupne nabirani sem
  ordinary_stack_list_of_last_members(StackHandle, ListOfLastMembers)
  curr_stack_list_of_last_members(ListOfLastMembers)
	- vrati seznam vsech clenu na posledni urovni
  get_curr_stack_operation_code(OperationCode)
	- vrati operaci asociovanou s timto stackem
	 mozne operace jsou :
	  so_decide .. rozhodni zda priste redukovat nebo cokoli cist
          so_reduct .. zacit redukovat od volneho az k hlave
          so_leftreduct .. pribalit nekolik zleva k jiz zredukovanemu
	  so_possleftreduct .. rozhodnout zda leftreduction nebo nektery read
          so_readanyedge .. rozhodni ktere z nasledujicich cteni
          so_readhead .. precti hlavu, nebo hranu schopnou redukce doleva
	  so_readonlyedge .. precti pouze schopnou hranu, uzavri ji
          so_nooperation .. byl pouze pomocny - nedelej jiz nic
  make_stack_copy( StackHandle, OperationCode )
	- ke stacku vytvori identickou kopii s jinou aktualni operaci
  make_curr_stack_copy(OperationCode)
	- zkopiruje aktualni stav do noveho, jemuz necha staejne cislo,
         ale da jinou operaci (tu z promenne OperationCode)
  make_curr_stack_son(EdgeHandle, OperationCode)
        - aktualnimu stavu (ten samy jim zustane i po zkonceni teto operace)
         'udela' syna - prida novou hranu, jemuz pak da za ukol OperationCode
  make_stack_son(FatherStackHandle, EdgeHandle, OperationCode)
        - predchozi akce, ale na obecnem stacku
  make_curr_stack_headed_son(EdgeHandle, RuleNbr,
                HeadNode, MinStructure, EndStructure,
		OperationCode)
        - od stavajiciho aktualniho uzlu (ten zustava nezmenen i aktualnim i
         po provedeni operace) vytvori synovsky pridanim nove hlavy
  get_stack_member_edge_handle(Member, Sentence)
        - ze clena seznamu prvku ve stacku za posledni hlavou (ten typ prvku),
         ziska handle jemu prislusne hrany
  is_top_ordinary_stack_edge_valid(StackHandle)
  is_top_curr_stack_edge_valid
        - vraci true <==> posledni nactena hrana na stacku je platna (nema
         potrebu se redukovat doleva) - pozn. - a musi existovat na posledni
	 urovni
  copy_curr_stack_to_success_info
        - aktualni stack obsahuje odvozeni vety, tento predikat ho schova
         do seznamu uspechu
  make_curr_failure_stack_info
        - o aktualnim stacku je znamo, ze je vadny, tento predikat ho schova
         pred upnym znicenim, pro pripadny zajem laditele
  is_ordinary_stack_left_reduceable(StackHandle)
  is_curr_stack_left_reduceable
        - vrati true, jestlize na stacku jsou dole alespon dve hrany, z cehoz
	 ta zadni smi byt rozsirovana do leva
  curr_stack_ret_top_change_to_father(TopEdgeHandle)
        - z aktualniho stacku odebere vrchni hranu (existuje -li) a stack
	 pak zmeni na jeho (i cislem) predchudce
  curr_stack_ret_two_last_members_change_to_father(LastMember, PrevMember,
                FatherStackHandle)
        - z aktualniho stacku (existuji-li), odebere dva nejvrchnejsi cleny
         a ten tak zmeni (i cislem) na sveho predchudce
  make_reduction_info_change_curr_to_dady(ReductionInfo, FatherStackHandle)
	- aktualni stack premeni na jeho stav (vcetne cisla), nez byla nactena
         posledni hlava, pricemz vsechny informace o ostatnich nactenich i
	 o hlave da do promenne ReductionInfo
  reduction_info_ret_unique_handle(ReductionInfo,
                HeadRuleNumber, HeadEdgeHandle, ListOfInnerEdgeHandles)
        - vrati od infa redukce, cislo pravidla v kterem byla popsana hlava,
         cislo hrany one hlavy a seznam cisel hran vsech zbyvajicich hran
         nyni zabiranych v redukci
  get_reduction_info_end_structure(ReductionInfo, EndStructure)
        - vrati of infa strukturu drzenou ve volnem konci
  get_reduction_info_back_edges_list(ReductionInfo, BackEdgesList)
	- od infa da seznam handlu hran (posledni v seznamu na prvnim miste),
         ktere svazat dohromady
  get_reduction_info_minimal_struct_mask(ReductionInfo, MinStructure)
	- kazda redukce ma jakousi minimalni strukturu, kterou musi hrany
         dodrzovat (tedy omezeni pri vybirani pravidel - jakesy VP ..)
  get_reduction_info_head_node(ReductionInfo, HeadNode)
        - od infa zas vrati jeho hlavickovy uzel
  get_reduction_start_head_node(ReductionInfo, StartNodeHandle)
	- hrana hlavickoveho uzlu nekde zacinala
  get_reduction_end_node(ReductionInfo, EndNodeHandle)
	- posledni clen redukce nekde konci
  get_reduction_info_head_error( ReductionInfo, HeadError )
	- vrati chybovost struktury reprezentovane hlavou
  in_curr_stack_top_reduction_has_no_inner_edge
        - nejvyssi redukce na aktualnim stacku nema vnitrni hrany (mezi hlavou
	 a koncem)
  in_curr_stack_top_reduction_has_no_left_edge
	- nejvyssi redukce na aktualnim stacku nema hran, ktere by mohla pak
	 doleva pribalit
  in_curr_stack_top_reduction_starts_at_begining
	- nejvyssi redukce na aktualnim stacku zacina v pocatecnim uzlu
  get_stack_starting_at( StartNodeHandle, StackHandle )
	- backtrackingem vraci vsechny stacky koncici v pozadovanem uzlu
  ex_success_edge
	- uspeje prave tehdy, byla -li jiz vytvorena alepon jedna uspesna
	 vysledna hrana
*/


kp_l_stack_make_stack_operation( StackHandle, OperationCode ) :-
	asserta_to_db( stack_operation( StackHandle, OperationCode ) ), !.

l_stack_make_stack(StackHandle, EndNodeHandle, MemberList, Reduction) :-
	asserta_to_db(stack_inner_structure(StackHandle, EndNodeHandle,
		MemberList, Reduction)), !.

l_stack_make_new_stack(EndNodeHandle, MemberList, ReductionList,
		OperationCode) :-
	new_handle(StackHandle),
	l_stack_make_stack(StackHandle, EndNodeHandle, MemberList,
		ReductionList),
	kp_l_stack_make_stack_operation( StackHandle, OperationCode ), !.

make_first_lolevel_empty_stack :-
	retract_all_with_head( stack_operation( _,_ ) ),
	start_node(StartNodeHandle),
	l_stack_make_new_stack(StartNodeHandle, [], [], so_decide).

there_is_a_stack :-
	ask_db( stack_operation( _,_ ) ).

del_first_stack(Stack) :-
	Stack = stack_operation( _,_ ),
	retract_from_db(Stack).

set_current_stack(Stack) :-
	retract_all_with_head(current_stack_operation(_,_)),
	Stack = stack_operation( StackHandle, OperationCode ),
	asserta_to_db(current_stack_operation(StackHandle,OperationCode)), !.

curr_stack_number(StackHandle) :-
	ask_db(current_stack_operation( StackHandle, _OperationCode )).

ordinary_stack_end_node(StackHandle, NodeHandle) :-
	ask_db(stack_inner_structure(StackHandle, NodeHandle, _MemberList,
		_Reduction)).

curr_stack_end_node(NodeHandle) :-
	curr_stack_number(StackHandle), !,
	ordinary_stack_end_node(StackHandle, NodeHandle).

ordinary_stack_list_of_free_ends(StackHandle, Reduction) :-
	ask_db(stack_inner_structure(StackHandle, _NodeHandle, _MemberList,
		Reduction)).

curr_stack_list_of_free_ends(Reduction) :-
	curr_stack_number(StackHandle), !,
	ordinary_stack_list_of_free_ends(StackHandle, Reduction).

ordinary_stack_list_of_last_members(StackHandle, MemberList) :-
	ask_db(stack_inner_structure(StackHandle, _NodeHandle, MemberList,
		_Reduction)).

curr_stack_list_of_last_members(MemberList) :-
	curr_stack_number(StackHandle), !,
	ordinary_stack_list_of_last_members(StackHandle, MemberList).

kp_ls_get_curr_stack_reduction( ReductionInfo ) :-
	curr_stack_number( StackHandle ), !,
	ask_db(stack_inner_structure( StackHandle, _NodeHandle, _MemberList,
		ReductionInfo )).

get_curr_stack_operation_code(OperationCode) :-
	ask_db(current_stack_operation( _StackHandle, OperationCode )).

make_stack_copy( StackHandle, OperationCode ) :-
	kp_l_stack_make_stack_operation( StackHandle, OperationCode ), !.

make_curr_stack_copy(OperationCode) :-
	curr_stack_number(StackHandle), !,
	make_stack_copy( StackHandle, OperationCode ), !.

make_stack_son(FatherStackHandle, EdgeHandle, OperationCode) :-
	ask_db(stack_inner_structure(FatherStackHandle, _NodeHandle,
		MemberList, Reduction)),
	edge_ret_end_node(EdgeHandle, EndNodeHandle),
	l_stack_make_new_stack(EndNodeHandle,
		[member_info(FatherStackHandle, EdgeHandle) |
		MemberList], Reduction, OperationCode), !.

make_curr_stack_son(EdgeHandle, OperationCode) :-
	curr_stack_number(StackHandle), !,
	make_stack_son(StackHandle, EdgeHandle, OperationCode), !.

make_curr_stack_headed_son(EdgeHandle, RuleNbr,
		HeadNode, MinStructure, EndStructure,
		OperationCode) :-
	curr_stack_number(StackHandle), !,
	ask_db(stack_inner_structure(StackHandle, NodeHandle,
		MemberList, _Reduction)),
	edge_ret_end_node(EdgeHandle, EndNodeHandle),
	get_edge_error( EdgeHandle, EdgeError ),
	l_stack_make_new_stack(EndNodeHandle, [],
		reduction_info(EdgeHandle, EdgeError, RuleNbr, HeadNode,
			MinStructure, EndStructure, old_info(StackHandle),
			_, _),
		OperationCode), !.

get_stack_member_edge_handle(Member, Sentence) :-
	Member = member_info(_, Sentence).

l_stack_get_ordinary_stack_top(StackHandle, Member) :-
	ask_db(stack_inner_structure(StackHandle, _NodeHandle,
		[Member | _RestMemberList], _Reduction)).

l_stack_get_curr_stack_top(Member) :-
	curr_stack_number(StackHandle), !,
	l_stack_get_ordinary_stack_top(StackHandle, Member).

is_top_ordinary_stack_edge_valid(StackHandle) :-
	l_stack_get_ordinary_stack_top(StackHandle, Member),
	get_stack_member_edge_handle(Member, Sentence),
	is_edge_valid(Sentence).

is_top_curr_stack_edge_valid :-
	curr_stack_number(StackHandle), !,
	is_top_ordinary_stack_edge_valid(StackHandle).

copy_curr_stack_to_success_info :-
	l_stack_get_curr_stack_top(Member), !,
	get_stack_member_edge_handle(Member, Sentence),
	assert_to_db(success_edge( Sentence )), !.

make_curr_failure_stack_info :-
	true, !.

is_ordinary_stack_left_reduceable(StackHandle) :-
	ask_db(stack_inner_structure(StackHandle, NodeHandle,
		[Member, _ | RestMemberList], _Reduction)),
	get_stack_member_edge_handle(Member, Sentence),
	is_edge_left_growable(Sentence).

is_curr_stack_left_reduceable :-
	curr_stack_number(StackHandle), !,
	is_ordinary_stack_left_reduceable(StackHandle).

curr_stack_ret_top_change_to_father(TopEdgeHandle) :-
	retract_from_db(current_stack_operation( StackHandle,
		_OperationCode )),
	l_stack_get_ordinary_stack_top( StackHandle, Member ), !,
	Member = member_info(FatherStackHandle, TopEdgeHandle),
	asserta_to_db(current_stack_operation( FatherStackHandle,
		so_nooperation )).

curr_stack_ret_two_last_members_change_to_father(LastMember, PrevMember,
		FatherStackHandle) :-
	curr_stack_number(StackHandle), !,
	ask_db(stack_inner_structure(StackHandle, _NodeHandle,
		[LastMember, PrevMember | _RestMemberList], _Reduction)),
	PrevMember = member_info(FatherStackHandle, _), !.

l_stack_clean_member_info([], []).
l_stack_clean_member_info([Member | MemberRest], [Handle | RestHandles]) :-
        get_stack_member_edge_handle(Member, Handle),
	l_stack_clean_member_info(MemberRest, RestHandles).

make_reduction_info_change_curr_to_dady(ReductionInfo, FatherStackHandle) :-
	curr_stack_number(StackHandle), !,
	ask_db(stack_inner_structure(StackHandle, NodeHandle, MemberList,
		ReductionInfo)),
	l_stack_clean_member_info(MemberList, MemberHandels),
	ReductionInfo = reduction_info(_EdgeHandle, _EdgeError, _RuleNbr,
		_HeadNode, _MinStructure, _EndStructure,
		old_info(FatherStackHandle), NodeHandle, MemberHandels), !.


reduction_info_ret_unique_handle(ReductionInfo,
		RuleNbr, HeadEdgeHandle, ListOfInnerEdgeHandles) :-
	ReductionInfo = reduction_info(HeadEdgeHandle, _EdgeError, RuleNbr,
		HeadNode, MinStructure, EndStructure,
		_,
		NodeHandle, ListOfInnerEdgeHandles).

get_reduction_info_end_structure(ReductionInfo, EndStructure) :-
	ReductionInfo = reduction_info(HeadEdgeHandle, _EdgeError, RuleNbr,
		HeadNode, MinStructure, EndStructure,
                _,
		NodeHandle, ListOfInnerEdgeHandles).

get_reduction_info_back_edges_list(ReductionInfo, ListOfInnerEdgeHandles) :-
	ReductionInfo = reduction_info(HeadEdgeHandle, _EdgeError, RuleNbr,
		HeadNode, MinStructure, EndStructure,
                _,
                NodeHandle, ListOfInnerEdgeHandles).

get_reduction_info_minimal_struct_mask(ReductionInfo, MinStructure) :-
	ReductionInfo = reduction_info(HeadEdgeHandle, _EdgeError, RuleNbr,
		HeadNode, MinStructure, EndStructure,
		_,
                NodeHandle, ListOfInnerEdgeHandles).

get_reduction_info_head_node(ReductionInfo, HeadNode) :-
	ReductionInfo = reduction_info(HeadEdgeHandle, _EdgeError, RuleNbr,
		HeadNode, MinStructure, EndStructure,
                _,
                NodeHandle, ListOfInnerEdgeHandles).

get_reduction_start_head_node(ReductionInfo, StartNodeHandle) :-
	ReductionInfo = reduction_info(HeadEdgeHandle, _EdgeError, RuleNbr,
		HeadNode, MinStructure, EndStructure,
                _,
                NodeHandle, ListOfInnerEdgeHandles),
        edge_ret_start_node(HeadEdgeHandle, StartNodeHandle).

get_reduction_end_node(ReductionInfo, EndNodeHandle) :-
	ReductionInfo = reduction_info(HeadEdgeHandle, _EdgeError, RuleNbr,
		HeadNode, MinStructure, EndStructure,
		_,
		EndNodeHandle, ListOfInnerEdgeHandles).

get_reduction_info_head_error( ReductionInfo, HeadError ) :-
	ReductionInfo = reduction_info( _HeadEdgeHandle, HeadError, _RuleNbr,
		_HeadNode, _MinStructure, _EndStructure,
		_,
		_EndNodeHandle, _ListOfInnerEdgeHandles).

in_curr_stack_top_reduction_has_no_inner_edge :-
        curr_stack_list_of_last_members([]), !.
        
in_curr_stack_top_reduction_has_no_left_edge :-
	curr_stack_list_of_free_ends(
		reduction_info(_EdgeHandle, _EdgeError, _RuleNbr, _HeadNode,
			_MinStructure, _EndStructure, old_info(StackHandle),
			_, _) ), !,
	ordinary_stack_list_of_last_members(StackHandle, MemberList), !,
	MemberList = [].

in_curr_stack_top_reduction_starts_at_begining :-
	kp_ls_get_curr_stack_reduction( ReductionInfo ),
	get_reduction_start_head_node( ReductionInfo, StartNodeHandle ), !,
	start_node( StartNodeHandle ).

get_stack_starting_at( StartNodeHandle, StackHandle ) :-
	ordinary_stack_end_node( StackHandle, StartNodeHandle ).

ex_success_edge :-
	ask_db( success_edge( _ ) ), !.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%



/* shranuje veskere pomocne informace k vypoctu */

/*
  init_information
        - veskere zdejsi inicializace
  has_reduction_been_here(HeadRuleNumber, HeadEdgeHandle,
                ListOfInnerEdgeHandles, ListOfEdgesHandles)
        - dotaz, zda zde se jiz konala podobna redukce (pouze dotaz !!),
         podobna redukce - stejne cislo pravidla, vytvorivsiho hlavu,
         stejne cislo hrany hlavy i seznam vsech clenu redukce
          posledni argument je vystupni - v pripade, kdy se jiz podobna
         redukce konala, zde se vrati seznam hran, jez byly jejimz vysledkem
  add_reduction_info(HeadRuleNumber, HeadEdgeHandle,
                ListOfInnerEdgeHandles, ListOfEdgesHandles)
        - naopak tento predikat, se stejnym obsahem argumentu (az na cvrty,
         ktery je zde vstupni) jako predchozi, tj has_reduction_been_here,
         informaci o redukci prida
  introduce_edge_to_stack_fail_means_new(EdgeHandle)
        - jestlize aktualni stack se s hranou tohoto handlu jiz paroval,
         vrati true, jinak si zapamatuje informaci o parovani a vrati fail
  introduce_edge_to_a_stack_fail_means_new(FatherStackHandle,
                EdgeHandle)
        - to same co predesly, pouze na normalnim stacku
  knowen_edges(FirstEdgeHandle, SecEdgeHandle, ListOfEdgesHandles)
        - jestlize hrany byly jiz spolu skombinovany (prvni 'podpojena pod'
         druhou, pak vrati true a ve tretim argumentu zanecha seznam handlu
         z toho (predesleho) spojeni vzeslych hran
  learn_edges_combination(PrevEdgeHandle, LastEdgeHandle, ListOfEdgesHandles)
        - po spojeni se hrany takto prihlasi ke svemu pocinu
  del_new_err_reduction_info( HeadRuleNumber, HeadEdgeHandle,
		ListOfInnerEdgeHandles )
	- z databaze precte a zaroven vyskrtne jeden zaznam o redukci (
	 specialni urceny pouze pro zpracovani chyb)
  del_new_err_left_reduction_info( PrevEdgeHandle, LastEdgeHandle )
	- z databaze vykrtne jeden error zaznam o prpovedene leve redukci
  ex_edge_head_info( EdgeHandle )
	- zda jiz existuje informace, ze tato hrana byla ctena jako head
  add_edge_head_info( EdgeHandle )
	- prida informaci a hrane, byvse ctena jako hlava
  head_is_knowen( Edge, ContextHandle, ListOfHeads )
	- zda v danem deterministickem behu hlava jiz v danem kontextu byla
	 zpracovavana (a s jakym vysledkem)
  learn_ds_heads( Edge, ContextHandle, ListOfHeads )
	- predikat, jimz si databaze zapamatuje zpracovani hlavu pro
	 predchozi predikat
*/

init_information :-
	retract_all_with_head(reduction_inner_information(_,_,_,_)),
	retract_all_with_head(read_edge_inner_information(_,_)),
	retract_all_with_head(edges_combination_inner_info(_,_,_)),
	retract_all_with_head( error_sort_value_edges_list_inner__(_) ),
	retract_all_with_head(
		nonchart_error_edge_inner_info__(_,_,_,_,_,_) ),
	retract_all_with_head(
		kp_dm_new_reduction_error_information__(_,_,_) ),
	retract_all_with_head(
		kp_dm_new_edges_combination_error_info__( _,_ ) ),
	retract_all_with_head( kp_dm_edge_head_info_inner__( _ ) ),
	retract_all_with_head( kp_dm_in_ds_head_is_knowen_inner__( _,_,_ ) ).


has_reduction_been_here(HeadRuleNumber, HeadEdgeHandle,
                ListOfInnerEdgeHandles, ListOfEdgesHandles) :-
        ask_db(reduction_inner_information(HeadRuleNumber, HeadEdgeHandle,
                ListOfInnerEdgeHandles, ListOfEdgesHandles)).

add_reduction_info(HeadRuleNumber, HeadEdgeHandle,
		ListOfInnerEdgeHandles, ListOfEdgesHandles) :-
	assert_to_db(reduction_inner_information(HeadRuleNumber,
		HeadEdgeHandle, ListOfInnerEdgeHandles,
		ListOfEdgesHandles)),
	assert_to_db( kp_dm_new_reduction_error_information__( HeadRuleNumber,
		HeadEdgeHandle, ListOfInnerEdgeHandles ) ).

introduce_edge_to_a_stack_fail_means_new(FatherStackHandle,
			EdgeHandle) :-
	if1(ask_db(read_edge_inner_information(FatherStackHandle,
			EdgeHandle)),
		true,
		(assert_to_db(read_edge_inner_information(
				FatherStackHandle, EdgeHandle)), !,
		 fail)).

introduce_edge_to_stack_fail_means_new(EdgeHandle) :-
        curr_stack_number(CurrStackHandle), !,
        introduce_edge_to_a_stack_fail_means_new(CurrStackHandle,
                EdgeHandle).

knowen_edges(FirstEdgeHandle, SecEdgeHandle, ListOfEdgesHandles) :-
	ask_db(edges_combination_inner_info(FirstEdgeHandle, SecEdgeHandle,
		ListOfEdgesHandles)).

learn_edges_combination(PrevEdgeHandle, LastEdgeHandle,
		ListOfEdgesHandles) :-
	assert_to_db(edges_combination_inner_info(PrevEdgeHandle,
		LastEdgeHandle, ListOfEdgesHandles)),
	assert_to_db( kp_dm_new_edges_combination_error_info__(
		PrevEdgeHandle, LastEdgeHandle ) ).

del_new_err_reduction_info( HeadRuleNumber, HeadEdgeHandle,
		ListOfInnerEdgeHandles ) :-
	retract_from_db( kp_dm_new_reduction_error_information__(
		HeadRuleNumber, HeadEdgeHandle, ListOfInnerEdgeHandles ) ).

del_new_err_left_reduction_info( PrevEdgeHandle, LastEdgeHandle ) :-
	retract_from_db( kp_dm_new_edges_combination_error_info__(
		PrevEdgeHandle, LastEdgeHandle ) ).

ex_edge_head_info( EdgeHandle ) :-
	ask_db( kp_dm_edge_head_info_inner__( EdgeHandle ) ).

add_edge_head_info( EdgeHandle ) :-
	assert_to_db( kp_dm_edge_head_info_inner__( EdgeHandle ) ).


head_is_knowen( Edge, ContextHandle, ListOfHeads ) :-
	ask_db( kp_dm_in_ds_head_is_knowen_inner__( Edge, ContextHandle,
			ListOfHeads ) ).

learn_ds_heads( Edge, ContextHandle, ListOfHeads ) :-
	assert_to_db( kp_dm_in_ds_head_is_knowen_inner__( Edge,
			ContextHandle, ListOfHeads ) ).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%



/* interface mezi nami */

/*
  structure_is_a_valid_sentence(EdgeHandle)
        - zjisti, zda hrana, jejiz handle je vstupu by mohla byt opravdu
         strukturou cele vety (zda zde neco neschazi)
  sort_read_reduct(OperationList, SortedOperationList)
        - ziska OperationList sestavajici se ze dvou operaci (so_startreduct,
         so_readanyedge) a vrati Sorted.. - v poradi, jakem se maji provest,
         jestli vubec
  sort_read_member_head(OperationList, SortedOperationList)
        - stejne jako prechozi heuristika, jen rozhoduje zda cist hranu, ci
	 jen hlavu - so_readhead, so_readonlyedge
  sort_decide_leftreduct(OperationList, SortedOperationList)
        - stejne s predchozim sortem (sort_read_reduct), jen v pocatecnim
         seznamu volby jsou nyni redukce doleva a velke rozhodovani
  make_new_parse_node(EdgeHandle, MinStructure, RuleContext, EdgeNode,
		Completition, EdgeError)
	- z handlu na hranu, pozadavku co musi vzdy splnovat vrchni 'cara'
	 pravidla (tedy hodne maleho prototypu feature structure, mozna
	 jen VP) a popripade i seznamu vsech prave povolenych pravidel (ziskan
	 volanim predikatu make_context_1/2), vrat cely uzel (celou trojici
	 nejak zakomponovanou, jiz po zavolani fce g, pred zavolanim f, ktera
	 je zde take uvedana) a informaci, zda hrana muze byt povazovana za
	 kompletni, plus i jeji chybovost
  get_edge_node_end_structure(EdgeNode, EndStructure)
        - z one trojice (vyse zminene) - tedy instance pravidla typu 1,
         vrat do druheho argumentu strukturu prinadlezejici pravemu
         vrchnimu konci
  call_f_function_ret_all_structure( EdgeNode, ErrorParsing, ResultStructure,
    ErrorPresented, RuleError, RuleErrMessage )
	- na trojici pravidla 1A (EdgeNode) zavolej f funkci, tam lezici a
	 vyslednou strukturu (predpokladam, ze by mela byt v levem hodnim
	 rohu) vrat skrze treti argument (ResultStructure), v ErrorParsing je
	 zda pripadne se pokouset splnovat fci f pomoci chybovych klazuli,
	 v ErrorPresented se vraci (volna promenna se navaze na true) zda toho
	 bylo potreba, v RuleError se vraci celkova chyba splnovani f fce a
	 v RuleErrMessage chybove hlasky z toho plynouci
  back_sort_edges_for_curr_stack(ListOfEdgesHandles, BackListOfEdgesHandles)
	- argumentmi jsou seznamy handlu hran, prvy vstupni, druhy vystupni,
         tento predikat vstupni coby heuristika setridi (mene dulezite
         dopredu), pripadne nektere vyhaze
  back_sort_edges_for_stack(FatherStackHandle, ListOfEdgesHandles,
                BackListOfEdgesHandles).
        - totez, ale jiz pro normalni stack

  there_is_any_head_rule_for_an_edge( EdgeHandle, Rule1BList, Rule2List,
		RuleNbr )
	- pro zadany handl hrany postupne backtrackingem vraci vsechna
	 jednoznacna cisla pravidel typu 1B (a 2), ktera s ni mohou byt
	 spojena, pricemz mozna pravidla mohou byt omezena
  there_is_any_head_rule_context_and_structure( MinStructure, Rule1BList,
		Rule2List, RuleNbr )
	- totez co predchozi, jen misto hrany jiz je uvedena pouze jeji
	 minimalni struktura
  back_sort_double_handles(ListOfDoubleHandles, BackDoubleList)
        - prvnim argumentem je seznam dvojic (handle na hranu, cislo pravidla
         z volani predchoziho predikatu), ucelem teto heuristiky je je opet
         setricit vzestupne podle dulezitosti do seznamu vystupniho
         (2. argument)
  use_head_rule(EdgeHandle, RuleNbr,
                HeadNode, MinStructure, EndStructure)
        - pouzije pravidle typu 1B cisla RuleNbr na hrany handlu EdgeHandle,
         pricemz vytvori onu trojici (obracene L o 90 strupnu), tu strci do
         HeadNode a zavola na ni sam i funkci g, a dale i volny konec
         (predpokladano - z cisla pravidla jiz nyni plyne prave jeden volny
         konec stejne tak jako prave jedno pravidlo 1B), na nejz zavola
         funkci h (svaze tak s hlavou)
          do MinStructure by se mela dat minimalni podminka na zapojovani
         clenu do teto struktury (napr VP)
*/

structure_is_a_valid_sentence(EdgeHandle).
/*
 :-
        edge_ret_your_structure(EdgeHandle, EdgeStructure),
	nl, write('Success:'), nl,
	write(EdgeStructure), nl.

*/

sort_read_reduct(OperationList, OperationList).

sort_read_member_head(OperationList, OperationList).

sort_decide_leftreduct(OperationList, OperationList).

back_sort_edges_for_curr_stack(ListOfEdgesHandles, ListOfEdgesHandles).

back_sort_edges_for_stack(FatherStackHandle, ListOfEdgesHandles,
                ListOfEdgesHandles).

back_sort_double_handles(ListOfDoubleHandles, ListOfDoubleHandles).

make_new_parse_node( EdgeHandle, MinStructure, RuleContext,
		EdgeNode, Completition, EdgeError ) :-
	edge_ret_your_structure(EdgeHandle, EdgeStructure), !,
	get_feature_structure_error( EdgeStructure, EdgeError ),
	find_1A_rule(MinStructure, RuleContext, RuleStructure, Completition),
	rule_structure_ret_bottom_struct(RuleStructure, BottomStruct),
	unify_feature_structures(BottomStruct, EdgeStructure),
/*	rule_structure_ret_rule_number(RuleStructure, RuleNbr), */
	rule_structure_ret_node_structure(RuleStructure, EdgeNode).

get_edge_node_end_structure(EdgeNode, EndStructure) :-
        node_structure_ret_right_end_structure(EdgeNode, EndStructure).

call_f_function_ret_all_structure( EdgeNode, ErrorParsing, ResultStructure,
		ErrorPresented, RuleError, RuleErrMessage ) :-
	node_structure_ret_action( EdgeNode, Action ),
	node_structure_ret_left_upper_structure( EdgeNode, ResultStructure ),
	get_no_error( NoError ),
	if1( ErrorParsing,
		( kp_raf_try_f_error_function( Action, NoError,
			RuleErrMessage, ErrorPresented, RuleError,
			ErrMessageListEndVar ),
		  if1( ErrMessageListEndVar == RuleErrMessage,
			true,
			ErrMessageListEndVar = [] ) ),
		( RuleError = NoError,
		  Action ) ).


:- op( 80, xfx,  wt  ).
:- op( 60, xfx,  msg  ).

kp_raf_try_f_error_function( Action, StillError, ErrMessageFreeEnd,
		ErrorPresented, RuleError, ErrMessageListEndVar ) :-
	var( Action ), !,
	write( 'a rule error - call a free variable' ), nl, !, fail.

kp_raf_try_f_error_function( Action, StillError, ErrMessageFreeEnd,
		ErrorPresented, RuleError, ErrMessageListEndVar ) :-
	Action = ( SomeAction , Body ) , !,
	kp_raf_try_f_error_function( SomeAction, StillError,
		ErrMessageFreeEnd, ErrorPresented, ActionError,
		ActionErrMessageListEndVar ),
	kp_raf_try_f_error_function( Body, ActionError,
		ActionErrMessageListEndVar, ErrorPresented, RuleError,
		ErrMessageListEndVar ).

kp_raf_try_f_error_function( Action, StillError, ErrMessageFreeEnd,
		ErrorPresented, RuleError, ErrMessageListEndVar ) :-
	Action = ( Goal ; DisjGoals ), !,
	(
	  kp_raf_try_f_error_function( Goal, StillError, ErrMessageFreeEnd,
		ErrorPresented, RuleError, ErrMessageListEndVar )
	;
	  kp_raf_try_f_error_function( DisjGoals, StillError,
		ErrMessageFreeEnd, ErrorPresented, RuleError,
		ErrMessageListEndVar )
	).

kp_raf_try_f_error_function( Action, StillError, ErrMessageFreeEnd,
		ErrorPresented, RuleError, ErrMessageListEndVar ) :-
	if1( b_not( Action ),
		kp_raf_error_predicate_call( Action, StillError,
			ErrMessageFreeEnd, ErrorPresented, RuleError,
			ErrMessageListEndVar ),
		kp_raf_noerror_predicate_call( Action, StillError,
			ErrMessageFreeEnd, ErrorPresented, RuleError,
			ErrMessageListEndVar ) ).


kp_raf_error_predicate_call( Action, StillError, ErrMessageFreeEnd,
		ErrorPresented, RuleError, ErrMessageListEndVar ) :-
	ErrMessageFreeEnd = [ Mess | ErrMessageListEndVar ],
	ErrorPresented = true,
	Action wt Error msg Mess,
	combine_body_errors( StillError, Error, RuleError ).


kp_raf_noerror_predicate_call( Action, StillError, ErrMessageFreeEnd,
		_ErrorPresented, StillError, ErrMessageFreeEnd ) :-
	Action.


there_is_any_head_rule_for_an_edge( EdgeHandle, Rule1BList,
		Rule2List, RuleNbr ) :-
	edge_ret_your_minimal_structure(EdgeHandle, MinStructure),
	there_is_any_head_rule_context_and_structure( MinStructure,
		Rule1BList, Rule2List, RuleNbr ).

there_is_any_head_rule_context_and_structure( MinStructure, Rule1BList,
		Rule2List, RuleNbr ) :-
	find_1B_rule_number( MinStructure, Rule1BNbr, Rule1BList ),
	find_2_rule_number( MinStructure, Rule2Nbr, Rule2List ),
        RuleNbr = (Rule1BNbr, Rule2Nbr).

use_head_rule(EdgeHandle, (Rule1BNbr, Rule2Nbr),
                HeadNode, MinStructure, EndStructure) :-
        numbered_1B_rule_ret_structure(Rule1BNbr, Rule1BStructure),
        numbered_2_rule_ret_structure(Rule2Nbr, Rule2Structure),
        rule_1B_structure_ret_h_structure(Rule1BStructure, H1BStruct),
        rule_2_structure_ret_h_structure(Rule2Structure, H2Struct),
        unify_feature_structures(H1BStruct, H2Struct),
        rule_1B_structure_ret_bottom_struct(Rule1BStructure, BottomStruct),
        edge_ret_your_structure(EdgeHandle, EdgeStructure),
        unify_feature_structures(BottomStruct, EdgeStructure),
        rule_2_structure_ret_validation_action(Rule2Structure, Rule2Action),
        Rule2Action,
        rule_1B_structure_ret_node_structure(Rule1BStructure, HeadNode),
        rule_1B_structure_ret_minimal_structure(Rule1BStructure,
                MinStructure),
        rule_2_structure_ret_feature_structure(Rule2Structure, EndStructure).


%%%%%%%%%%%%%%%%%%%%%%%%%%%


/* unifikace features struktures a veskere cinnosti s nimi */

/*
  unify_feature_structures(OneStructure, SecStructure)
        - sunifykuje dve struktury
  feature_structure_find_feature(FeatureStructure, FeatureName, FeatureValue)
        - najde v patricne strukture vlastnost a vrati jeji hodnotu,
         pokud vlastnost neexituje, vytvori ji
  big_feature_ret_minimal_condition(FeatureStructure, MinimalStructure)
        - z celkove feature struktury ziska minimalni podminku
  big_feature_ret_bottom_structure(FeatureStructure, BottomStruct)
        - ten zas strukturu vazici se 'dolu'
  big_feature_ret_h_structure(FeatureStructure, HStruct)
        - pro provedeni funkce h, vybere ze struktury patricnou cast
         na unifikaci
  big_feature_ret_right_structure(FeatureStructure, RightStruct)
	- a ten ze struktury vynda 'pravou' - tedy rest
  big_feature_ret_error_nbr( Structure, ErrorNbr )
	- ze struktury vrati vlastnost error_nbr, oznacujici chybovost (cislo)
  big_feature_ret_error_mess( Structure, ErrorMess )
	- ze struktury vrati vlastnost error_mess, oznacujici chybove hlasky
*/


unify_feature_structures(OneStructure, SecStructure) :-
        f_unify_find_term(OneStructure, OneTerm),
        f_unify_find_term(SecStructure, SecTerm),
        f_unify_unification(OneTerm, SecTerm), !.

f_unify_find_term(Structure, Term) :-
        nonvar(Structure),
        Structure = (Variable == AnyTerm), !,
        if1((Variable == AnyTerm;
            f_unify_features_have_same_end(Variable, AnyTerm)),
                true,
                unify_feature_structures(Variable, AnyTerm)),
        f_unify_find_term(AnyTerm, Term), !.
f_unify_find_term(Term, Term) :-
        !.

f_unify_features_have_same_end(OneTerm, SecTerm) :-
        f_unify_is_feature(OneTerm),
        f_unify_is_feature(SecTerm),
        f_unify_free_list_end(OneTerm, OneVariableEnd),
        f_unify_free_list_end(SecTerm, SecVariableEnd),
        OneVariableEnd == SecVariableEnd, !.

f_unify_is_feature(Term) :-
        (var(Term); Term = [_ | _]), !.

f_unify_free_list_end(List, VariableEnd) :-
        var(List), !,
        List = VariableEnd, !.
f_unify_free_list_end([_ | Rest], VariableEnd) :-
        f_unify_free_list_end(Rest, VariableEnd), !.

f_unify_unification(OneTerm, SecTerm) :-
        (var(OneTerm); var(SecTerm)), !,
        if1(var(OneTerm),
                f_unify_walk_throught(SecTerm),
                f_unify_walk_throught(OneTerm)),
        OneTerm = SecTerm, !.
f_unify_unification(list(OneList), list(SecList)) :-
        f_unify_lists(OneList, SecList), !.
f_unify_unification(OneTerm, SecTerm) :-
        f_unify_is_feature(OneTerm),
        f_unify_is_feature(SecTerm), !,
        f_unify_features(OneTerm, SecTerm, NewVariable, NewVariable), !.
f_unify_unification(OneTerm, SecTerm) :-
        OneTerm = SecTerm, !.

f_unify_walk_throught(_Term) :-
	!. /* optimalizace */
f_unify_walk_throught(Term) :-
        var(Term), !.
f_unify_walk_throught(Structure) :-
        Structure = (Variable == Term),
        !, f_unify_find_term(Structure, _), !.
f_unify_walk_throught(list(Term)) :-
        !, f_unify_walk_throught_any_list(Term), !.
f_unify_walk_throught(Term) :-
        f_unify_is_feature(Term), !,
        f_unify_walk_throught_feature_structure(Term), !.
f_unify_walk_throught(Term) :-
        !.

f_unify_walk_throught_any_list(_Term) :-
	!. /* optimalizace */
f_unify_walk_throught_any_list(Term) :-
        (var(Term); Term = []), !.
f_unify_walk_throught_any_list(Term) :-
        Term = (Variable == List), !,
        f_unify_find_term(Term, NewTerm), !,
        f_unify_walk_throught_any_list(NewTerm).
f_unify_walk_throught_any_list([ Term | Rest ]) :-
        f_unify_walk_throught(Term), !,
        f_unify_walk_throught_any_list(Rest), !.

f_unify_walk_throught_feature_structure(Term) :-
        var(Term), !.
f_unify_walk_throught_feature_structure([ Name = Value | Rest ]) :-
        f_unify_walk_throught(Value), !,
        f_unify_walk_throught_feature_structure(Rest), !.

f_unify_lists(OneList, SecList) :-
        (var(OneList); var(SecList)), !,
        if1(var(OneList),
                f_unify_walk_throught_any_list(SecList),
                f_unify_walk_throught_any_list(OneList)),
        OneList = SecList, !.
f_unify_lists([], []) :-
        !.
f_unify_lists([OneHead | OneRest], [SecHead | SecRest]) :-
        unify_feature_structures(OneHead, SecHead),
        f_unify_lists(OneRest, SecRest), !.

f_unify_features(OneFeature, SecFeature, OneSetMinusSec, NewVariable) :-
        var(OneFeature), !,
        f_unify_make_free_end_list_copy(SecFeature, OneSetMinusSec,
                OneFeature, NewVariable), !.
f_unify_features(OneFeature, SecFeature, OneSetMinusSec, NewVariable) :-
        var(SecFeature), !,
        f_unify_make_free_end_list_copy(OneFeature, NewVariable,
                SecFeature, OneSetMinusSec), !.
f_unify_features([FeatureMember | OneFeatureRest],
                SecFeature, OneSetMinusSec, NewVariable) :-
        FeatureMember = (FeatureName = OneFeatureValue),
        if1(f_unify_ex_feature_in_struct(FeatureName, SecFeature,
                SecFeatureValue, SecFeatureRest),
                (unify_feature_structures(OneFeatureValue, SecFeatureValue),
                 f_unify_features(OneFeatureRest, SecFeatureRest,
                        OneSetMinusSec, NewVariable)),
                (f_unify_walk_throught(OneFeatureValue),
                 f_unify_features(OneFeatureRest, SecFeature,
                        [FeatureMember | OneSetMinusSec], NewVariable))), !.

f_unify_make_free_end_list_copy(FreeEndList, ItsEndVariable,
                NewList, NewVariable) :-
        var(FreeEndList), !,
        FreeEndList = ItsEndVariable,
        NewList = NewVariable, !.
f_unify_make_free_end_list_copy([Head | RestOfFreeList], ItsEndVariable,
                [Head | NewRest], NewVariable) :-
        Head = (Name = Value),
        f_unify_walk_throught(Value),
        f_unify_make_free_end_list_copy(RestOfFreeList, ItsEndVariable,
                NewRest, NewVariable), !.

f_unify_ex_feature_in_struct(FeatureName, FeatureStruct,
                FeatureValue, FeatureRest) :-
        f_unify_find_feature_in_struct(FeatureName, FeatureStruct,
                FeatureValue, FeatureRest, fail, _), !.

f_unify_find_feature_in_struct(FeatureName, FeatureStruct,
                FeatureValue, FeatureRest, EndAction, ActionFeaturePar) :-
        var(FeatureStruct), !,
        ActionFeaturePar = FeatureStruct,
        EndAction, !.
f_unify_find_feature_in_struct(FeatureName,
                [FeatureName = ThisFeatureValue | FeatureRest],
                FeatureValue, FeatureRest, EndAction, ActionFeaturePar) :-
        !,
        ThisFeatureValue = FeatureValue, !.
f_unify_find_feature_in_struct(FeatureName,
                [FeatureMember | FeatureTail],
                FeatureValue, [FeatureMember | FeatureRest],
                EndAction, ActionFeaturePar) :-
        f_unify_find_feature_in_struct(FeatureName, FeatureTail,
                FeatureValue, FeatureRest, EndAction, ActionFeaturePar), !.

feature_structure_find_feature(FeatureStructure, FeatureName, FeatureValue) :-
        f_unify_find_feature_in_struct(FeatureName, FeatureStructure,
                FeatureTerm, _,
                (ActionFeaturePar = [FeatureName = FeatureTerm | _]),
                ActionFeaturePar), !,
        unify_feature_structures(FeatureTerm, FeatureValue), !.

big_feature_ret_minimal_condition(FeatureStructure, MinimalStructure) :-
        feature_structure_find_feature(FeatureStructure,
                synsem, SynsemStructure),
        feature_structure_find_feature(SynsemStructure, head, HeadStructure),
        feature_structure_find_feature(HeadStructure, cat, CatStructure),
        !,
        CatStructure = MinimalStructure, !.

big_feature_ret_bottom_structure(FeatureStructure, BottomStruct) :-
        feature_structure_find_feature(FeatureStructure,
                first, FirstStructure), !,
        FirstStructure = BottomStruct, !.

big_feature_ret_h_structure(FeatureStructure, HStruct) :-
        feature_structure_find_feature(FeatureStructure,
                synsem, SynsemStructure),
        feature_structure_find_feature(SynsemStructure, head, HeadStructure),
        !,
        HeadStructure = HStruct, !.

big_feature_ret_right_structure(FeatureStructure, RightStruct) :-
        feature_structure_find_feature(FeatureStructure,
		rest, RestStructure), !,
	RestStructure = RightStruct, !.


big_feature_ret_error_nbr( Structure, ErrorNbr ) :-
	feature_structure_find_feature( Structure,
		error_nbr, ErrorNumber ), !,
	ErrorNbr = ErrorNumber.

big_feature_ret_error_mess( Structure, ErrorMess ) :-
	feature_structure_find_feature( Structure,
		error_mess, ErrorMessage ), !,
	ErrorMess = ErrorMessage.

%%%%%%%%%%%%%%%%%%%%%%%%%%


/* prace s hranami na vyssi urovni */

/*
  insert_input_edge(EdgeInputStructure)
        - necha hranu ze vstupu zapsat do databaze
  read_input_edges(FileList)
        - precte vsechny souboru ze seznamu, ocekavaje tam pouze vstupni
         hrany a prave jeden predikat last_node_is
*/

:- op(1200, xfx, is_an_edge_from_node).
:- op(10, xfx, to_node).
:- op(10, fx, last_node_is).

insert_input_edge((Feature is_an_edge_from_node
                StartNodeHandle to_node EndNodeHandle)) :-
	clean_feature_structure_tell( Feature, EdgeStructure ),
        big_feature_ret_minimal_condition(EdgeStructure, MinimalStructure),
        make_new_input_edge(EdgeStructure, MinimalStructure,
                StartNodeHandle, EndNodeHandle),
        !.
insert_input_edge(_) :-
        seen,
        error('Syntax error: bad edge format').

l_edge_readed_term(last_node_is NodeHandle) :-
        nonvar(NodeHandle),
        !,
        l_edge_define_last_node(NodeHandle).
l_edge_readed_term(Term) :-
        insert_input_edge(Term).

l_edge_define_last_node(NodeHandle) :-
        set_end_node(NodeHandle).

read_input_edges(FileList) :-
        read_list_of_files(FileList,
                l_edge_readed_term(CurrTerm), CurrTerm).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%



/* veskere operace primo s pravidly */

/*
  load_rules(FileList)
        - nahraje pravidla ze souboru uvedenych v seznamu
  rule_push_in(Name)
        - pripravi k moznemu pouziti pravidlo jmenem Name
  rule_init_before_lexicon 
        - vycisti databazi od pravidel startovanych na zadost (pojmenovanych)
  find_1A_rule(MinStructure, RuleNbrList, RuleStructure, Completition)
	- pro nutnou podminku a povoleny seznam pravidel (onen jiz
	'prekompilovany' predikatem make_context_1/2) najde 1A pravidlo ji
	nahore splnujici a jeho 'kompletnost' - tedy umoznenost prohlasit
	vzniklou hranu za kvalitni
  rule_structure_ret_bottom_struct(RuleStructure, BottomStruct)
        - pro pravidlo vracene pomoci predchoziho volani vrati strukturu
         lezici 'vespodu'
  rule_structure_ret_rule_number(RuleStructure, RuleNbr)
        - pro pravidlo vrati jeho identifikator
  rule_structure_ret_node_structure(RuleStructure, NodeStructure)
        - pravidlo zkonveruje do node_struktury
  node_structure_ret_right_end_structure(NodeStructure, EndStructure)
        - pro node structuru (jak pravidla 1A, tak i 1B) vrati koncovou
         strukturu (pro pravy horni konec)
  node_structure_ret_action(NodeStructure, Action)
        - pro node strukturu vrati koncovou validacni akci
  node_structure_ret_left_upper_structure(NodeStructure, ResultStructure)
        - k node strukture da vyslednou strukturu reprezentujici vse - tu
         vlevo nahore
  find_1B_rule_number( MinStructure, Rule1BNbr, Rule1BList )
	- pro minimalni podminku postupne vrati vsechny identifikatory
	 pravidel typu 1B ji splnujici, pricemz, bude -li urcen i seznam pouze
	 povolenych pravidel, bude se ridit i jim
  numbered_1B_rule_ret_structure(Rule1BNbr, Rule1BStructure)
        - od zadaneho identifikatoru vrat patricne 1B pravidlo
  rule_1B_structure_ret_h_structure(Rule1BStructure, H1BStruct)
        - ze struktury 1B pravidla odvod cast predavanou h funkci
  rule_1B_structure_ret_bottom_struct(Rule1BStructure, BottomStruct)
        - ze zadane 1B struktury pravidla vrat feature structuru odpovidajici
         spodku
  rule_1B_structure_ret_minimal_structure(Rule1BStructure, MinStructure)
        - ze struktury 1B pravidla vrat minimalni podminku pro vrsek
  rule_1B_structure_ret_node_structure(Rule1BStructure, HeadNode)
        - prekonvertuj 1B strukturu pravidla na node strukturu
  find_2_rule_number( MinStructure, Rule2Nbr, Rules2List )
        - rozdil od podobneho predikatu typu 1B spociva v navratu 
         identifikatoru pravidel typu 2
  numbered_2_rule_ret_structure(Rule2Nbr, Rule2Structure)
        - opet rozdil minimalni
  rule_2_structure_ret_h_structure(Rule2Structure, H2Struct)
        - stejne jako i zde
  rule_2_structure_ret_feature_structure(Rule2Structure, EndStructure)
        - tento predikat vrati celkovou strukturu pravidla cislo 2
  rule_2_structure_ret_validation_action(Rule2Structure, Action)
        - vrati validacni akci pro prazdny konec

A_rule_structure =
  rule_1A_inner_structure(minStructure, nbr, structure, bottom, right,
	action, completition)
B_rule_structure =
  rule_1B_inner_structure(minStructure, nbr, structure, bottom, h, right,
        action)
2_rule_structure =
  rule_2_inner_structure(minStructure, nbr, structure, h, action)

node_structure =
  node_inner_structure(structure, right, action)
*/

find_1A_rule(MinStructure, RuleNbrList, RuleStructure, Completition) :-
	RuleStructure = rule_1A_inner_structure(MinStructure, RuleNbr,
		FeatureStructure, BottomStructure, RightStructure, Action,
		Completition),
	( var(RuleNbrList), !
	; kp_jro_rule_list_take_1A_struct_compatible(MinStructure,
		RuleNbrList, RuleNbr)
	),
	ask_db(RuleStructure).

kp_jro_rule_list_take_1A_struct_compatible( MinStructure, Context,
		Rule1ANbr ) :-
	rules_context_ret_1A_list( Context, CompRuleList ), !,
	kp_jro_take_compatible_rules( MinStructure, CompRuleList,
		Rule1ANbr ).

kp_jro_take_compatible_rules( MinStructure, [ RuleNbr = MinStructure |
		_RestCompRuleList ], RuleNbr ).
kp_jro_take_compatible_rules( MinStructure, [ _ | RestCompRuleList ],
		RuleNbr ) :-
	kp_jro_take_compatible_rules( MinStructure, RestCompRuleList,
		RuleNbr ).

rule_structure_ret_bottom_struct(RuleStructure, BottomStruct) :-
	RuleStructure = rule_1A_inner_structure(MinStructure, RuleNbr,
		FeatureStructure, BottomStruct, RightStructure, Action,
		Completition).

rule_structure_ret_rule_number(RuleStructure, RuleNbr) :-
	RuleStructure = rule_1A_inner_structure(MinStructure, RuleNbr,
		FeatureStructure, BottomStruct, RightStructure, Action,
		Completition).

rule_structure_ret_node_structure(RuleStructure, NodeStructure) :-
	RuleStructure = rule_1A_inner_structure(MinStructure, RuleNbr,
		FeatureStructure, BottomStruct, RightStructure, Action,
		Completition),
        NodeStructure = node_inner_structure(FeatureStructure,
		RightStructure, Action).

node_structure_ret_right_end_structure(NodeStructure, EndStructure) :-
        NodeStructure = node_inner_structure(FeatureStructure,
                EndStructure, Action).

node_structure_ret_action(NodeStructure, Action) :-
        NodeStructure = node_inner_structure(FeatureStructure,
                EndStructure, Action).

node_structure_ret_left_upper_structure(NodeStructure, ResultStructure) :-
        NodeStructure = node_inner_structure(ResultStructure,
                EndStructure, Action).

find_1B_rule_number( MinStructure, Rule1BNbr, Rule1BList ) :-
	RuleStructure = rule_1B_inner_structure( MinStructure, Rule1BNbr,
		FeatureStructure, BottomStructure, HStructure,
		RightStructure, Action ),
	( var( Rule1BList ), !
	; kp_jro_take_compatible_rules( MinStructure, Rule1BList, Rule1BNbr )
	),
	ask_db( RuleStructure ).

numbered_1B_rule_ret_structure(Rule1BNbr, Rule1BStructure) :-
        Rule1BStructure = rule_1B_inner_structure(MinStructure, Rule1BNbr,
                FeatureStructure, BottomStructure, HStructure,
                RightStructure, Action),
        ask_db(Rule1BStructure).

rule_1B_structure_ret_h_structure(Rule1BStructure, H1BStruct) :-
        Rule1BStructure = rule_1B_inner_structure(MinStructure, Rule1BNbr,
                FeatureStructure, BottomStructure, H1BStruct,
                RightStructure, Action).

rule_1B_structure_ret_bottom_struct(Rule1BStructure, BottomStruct) :-
        Rule1BStructure = rule_1B_inner_structure(MinStructure, Rule1BNbr,
                FeatureStructure, BottomStruct, H1BStruct,
                RightStructure, Action).

rule_1B_structure_ret_minimal_structure(Rule1BStructure, MinStructure) :-
        Rule1BStructure = rule_1B_inner_structure(MinStructure, Rule1BNbr,
                FeatureStructure, BottomStruct, H1BStruct,
                RightStructure, Action).

rule_1B_structure_ret_node_structure(Rule1BStructure, HeadNode) :-
        Rule1BStructure = rule_1B_inner_structure(MinStructure, Rule1BNbr,
                FeatureStructure, BottomStruct, H1BStruct,
                RightStructure, Action),
        HeadNode = node_inner_structure(FeatureStructure,
                RightStructure, Action).

find_2_rule_number( MinStructure, Rule2Nbr, Rule2List ) :-
	RuleStructure = rule_2_inner_structure( MinStructure, Rule2Nbr,
		FeatureStructure, HStructure, Action ),
	( var( Rule2List ), !
	; kp_jro_take_compatible_rules( MinStructure, Rule2List, Rule2Nbr )
	),
	ask_db( RuleStructure ).

numbered_2_rule_ret_structure(Rule2Nbr, Rule2Structure) :-
        Rule2Structure = rule_2_inner_structure(MinStructure, Rule2Nbr,
                FeatureStructure, HStructure, Action),
        ask_db(Rule2Structure).

rule_2_structure_ret_h_structure(Rule2Structure, H2Struct) :-
        Rule2Structure = rule_2_inner_structure(MinStructure, Rule2Nbr,
                FeatureStructure, H2Struct, Action).

rule_2_structure_ret_feature_structure(Rule2Structure, EndStructure) :-
        Rule2Structure = rule_2_inner_structure(MinStructure, Rule2Nbr,
                EndStructure, H2Struct, Action).

rule_2_structure_ret_validation_action(Rule2Structure, Action) :-
        Rule2Structure = rule_2_inner_structure(MinStructure, Rule2Nbr,
                EndStructure, H2Struct, Action).

:- op(1200, xfx, is_a_nucleus_expansion_rule_if).
:- op(1200, xf, is_a_nucleus_expansion_rule).
:- op(1200, xfx, is_a_complement_expansion_rule_if).
:- op(1200, xf, is_a_complement_expansion_rule).
:- op(1200, xfx, is_an_adjunct_expansion_rule_if).
:- op(1200, xf, is_an_adjunct_expansion_rule).
:- op(1200, xfx, is_a_marker_expansion_rule_if).
:- op(1200, xf, is_a_marker_expansion_rule).
:- op(1200, xfx, is_an_uncoplete_complement_expansion_rule_if).
:- op(1200, xf, is_an_uncoplete_complement_expansion_rule).
:- op(1200, xfx, is_a_phrase_termination_rule_if).
:- op(1200, xf, is_a_phrase_termination_rule).
:- op(1200, xfy, : ).

%%%%%%%%%%%%%%%

load_rules(File_Name)
 :-
        atom(File_Name),

        load_rules([File_Name]).

load_rules(FileList) :-
        if1(a_rule_some_exist,
		(nl,write('Warning: Some rules have already been loaded into db - these will be retracted'),nl,purge_DB),
                true),
        a_rule_rules_just_loaded,
        read_list_of_files(FileList,a_rule_read_a_rule(CurrTerm),CurrTerm) .

purge_DB :-
        
	retractall( kp_dm_ds_pred_edge_head_reduct__( _ ) ),
	retractall( kp_dm_ds_pred_compose_edge_mark__( _ ) ),
	retractall( kp_dm_ds_pred_hide_edge_mark_info__( _ ) ),
	retractall( kp_dm_hide_edge_db_inner__( _,_,_,_,_,_,_,_ ) ),
	retractall(a_rule_inner_rule_last_nbr(_)),
	retractall(rule_2_inner_structure(_,_,_,_,_)),
	retractall(rule_1A_inner_structure(_,_,_,_,_,_,_)),
	retractall(rule_1B_inner_structure(_,_,_,_,_,_,_)),
	retractall(named_rule_inner_info(_,_)),
	retractall(named_rule_retract_info(_)),
	retractall(stack_operation(_,_)),
	retractall(current_stack_operation(_,_)),
	retractall(success_edge(_)),
	retractall(edges_combination_inner_info(_,_,_)),
	retractall(edge_inner_info(_,_,_)) ,
	retractall(edge_inner_min_structure(_,_)),
	retractall(edge_chart__(_,_)),
	retractall(edge_start_node__(_,_)),
	retractall(edge_end_node__(_,_)),
	retractall(node__(_,_)),
	retractall(edge_category__(_,_)),
	retractall(edge_free_number__(_)),
	retractall(read_edge_inner_information(_,_)),
	retractall(reduction_inner_information(_,_,_,_)),
	retractall( error_sort_value_edges_list_inner__(_) ),
	retractall( nonchart_error_edge_inner_info__(_,_,_,_,_,_) ),
	retractall( kp_dm_new_reduction_error_information__(_,_,_) ),
	retractall( kp_dm_new_edges_combination_error_info__( _,_ ) ),
	retractall( kp_dm_edge_head_info_inner__( _ ) ),
	retractall( kp_dm_in_ds_head_is_knowen_inner__( _,_,_ ) ).

%%%%%%%%%%%%%%%%




/*
load_rules(FileList) :-
        if1(a_rule_some_exist,
                error('Rules have been loaded into db'),
                (a_rule_rules_just_loaded,
                 read_list_of_files(FileList,
                        a_rule_readed_term(CurrTerm), CurrTerm))).
*/
a_rule_some_exist :-
        ask_db(a_rule_inner_rule_last_nbr(_)).

a_rule_rules_just_loaded :-
        asserta_to_db(a_rule_inner_rule_last_nbr(0)).

a_rule_new_rule_nbr(RuleNbr) :-
	retract_from_db(a_rule_inner_rule_last_nbr(RuleNbr)),
        NewNbr is RuleNbr + 1,
        asserta_to_db(a_rule_inner_rule_last_nbr(NewNbr)).

a_rule_read_a_rule(Rule) :-
        nonvar(Rule), Rule = ( Name : RuleInner), !,
        a_rule_readed_term(RuleInner, Name, RuleStructure),
	a_rule_named_rule_push( Name, RuleStructure ), !.
a_rule_read_a_rule(Rule) :-
        a_rule_new_rule_nbr(RuleNbr),
        a_rule_readed_term(Rule, RuleNbr, RuleStructure),
        assert_to_db(RuleStructure), !.

rule_push_in(Name) :-
	if1(named_rule_retract_info(Name),
                true,
                if1(named_rule_inner_info(Name, RuleStructure),
			(assert_to_db(named_rule_retract_info(Name)),
                         assert_to_db(RuleStructure)),
			(nl, write('ERROR: no rule has name '), write(Name),
                         error(' ')))). 

rule_init_before_lexicon :-
	(retract_from_db(named_rule_retract_info(Name)),
		(retract_from_db(rule_2_inner_structure(_,Name,_,_,_))
		;retract_from_db(rule_1A_inner_structure(_,Name,_,_,_,_,_))
		;retract_from_db(rule_1B_inner_structure(_,Name,_,_,_,_,_))),
         fail)
        ;
         true.

a_rule_readed_term((FeatureStructure is_a_nucleus_expansion_rule_if
                Action), RuleNbr, RuleStructure) :-
        a_rule_make_1B_rule(FeatureStructure, Action, RuleNbr, RuleStructure).
a_rule_readed_term((FeatureStructure is_a_nucleus_expansion_rule),
                RuleNbr, RuleStructure) :-
        a_rule_make_1B_rule(FeatureStructure, true, RuleNbr, RuleStructure).
a_rule_readed_term((FeatureStructure is_a_complement_expansion_rule_if
                Action), RuleNbr, RuleStructure) :-
	a_rule_make_1A_rule(FeatureStructure, Action, RuleNbr, true,
		RuleStructure).
a_rule_readed_term((FeatureStructure is_a_complement_expansion_rule),
		RuleNbr, RuleStructure) :-
	a_rule_make_1A_rule(FeatureStructure, true, RuleNbr, true,
		RuleStructure).
a_rule_readed_term((FeatureStructure is_an_adjunct_expansion_rule_if
                Action), RuleNbr, RuleStructure) :-
	a_rule_make_1A_rule(FeatureStructure, Action, RuleNbr, true,
		RuleStructure).
a_rule_readed_term((FeatureStructure is_an_adjunct_expansion_rule), 
                RuleNbr, RuleStructure) :-
	a_rule_make_1A_rule(FeatureStructure, true, RuleNbr, true,
		RuleStructure).
a_rule_readed_term((FeatureStructure is_a_marker_expansion_rule_if
                Action), RuleNbr, RuleStructure) :-
	a_rule_make_1A_rule(FeatureStructure, Action, RuleNbr, true,
		RuleStructure).
a_rule_readed_term((FeatureStructure is_a_marker_expansion_rule), 
                RuleNbr, RuleStructure) :-
	a_rule_make_1A_rule(FeatureStructure, true, RuleNbr, true,
		RuleStructure).
a_rule_readed_term((FeatureStructure
		is_an_uncoplete_complement_expansion_rule_if Action),
		RuleNbr, RuleStructure) :-
	a_rule_make_1A_rule(FeatureStructure, Action, RuleNbr, fail,
		RuleStructure).
a_rule_readed_term((FeatureStructure
		is_an_uncoplete_complement_expansion_rule),
		RuleNbr, RuleStructure) :-
	a_rule_make_1A_rule(FeatureStructure, true, RuleNbr, fail,
		RuleStructure).
a_rule_readed_term((FeatureStructure is_a_phrase_termination_rule_if
                Action), RuleNbr, RuleStructure) :-
        a_rule_make_2_rule(FeatureStructure, Action, RuleNbr, RuleStructure).
a_rule_readed_term((FeatureStructure is_a_phrase_termination_rule), 
                RuleNbr, RuleStructure) :-
        a_rule_make_2_rule(FeatureStructure, true, RuleNbr, RuleStructure).
a_rule_readed_term(_, RuleNbr, _) :-
        seen,
        if1(integer(RuleNbr),
                ErrRuleNbr is RuleNbr + 1,
                ErrRuleNbr = RuleNbr),
	nl,write('Syntax error near rule nr. '),write(ErrRuleNbr),nl,error(' ').
 

a_rule_make_1B_rule(Feature, Action, RuleNbr, RuleStructure) :-
        nonvar(Feature), nonvar(Action), !,
	clean_feature_structure_tell( Feature, FeatureStructure ),
        big_feature_ret_minimal_condition(FeatureStructure, MinStructure),
        big_feature_ret_bottom_structure(FeatureStructure, BottomStruct),
        big_feature_ret_h_structure(FeatureStructure, HStruct),
        big_feature_ret_right_structure(FeatureStructure, RightStruct),
        RuleStructure = rule_1B_inner_structure(MinStructure, RuleNbr,
                FeatureStructure, BottomStruct, HStruct, RightStruct,
                Action).

a_rule_make_1A_rule(Feature, Action, RuleNbr, Completition,
		RuleStructure) :-
        nonvar(Feature), nonvar(Action), !,
	clean_feature_structure_tell( Feature, FeatureStructure ),
        big_feature_ret_minimal_condition(FeatureStructure, MinStructure),
        big_feature_ret_bottom_structure(FeatureStructure, BottomStruct),
        big_feature_ret_right_structure(FeatureStructure, RightStruct),
	RuleStructure = rule_1A_inner_structure(MinStructure, RuleNbr,
		FeatureStructure, BottomStruct, RightStruct, Action,
		Completition).

a_rule_make_2_rule(Feature, Action, RuleNbr, RuleStructure) :-
        nonvar(Feature), nonvar(Action), !,
	clean_feature_structure_tell( Feature, FeatureStructure ),
        big_feature_ret_minimal_condition(FeatureStructure, MinStructure),
        big_feature_ret_h_structure(FeatureStructure, HStruct),
        RuleStructure = rule_2_inner_structure(MinStructure, RuleNbr,
                FeatureStructure, HStruct, Action).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%



%Added by karel

% ANTI_PERESTROIKA

anti_perestroika(
    Variable,
    [])
 :- 
     var(Variable),
        
        ! .



anti_perestroika(
    [Attribute=Atom|Rest_Gorbachev_Category],
    [Attribute=Atom|Rest_Honecker_Category])
 :-
    atomic(Atom),
    
    !,
    
    anti_perestroika(
        Rest_Gorbachev_Category,
        Rest_Honecker_Category),
    
    ! .

       

anti_perestroika(
    [tense=Variable|Rest_Gorbachev_Category],
    [tense=present|Rest_Honecker_Category])
 :-
    var(Variable),
    
    !,
    
    anti_perestroika(
        Rest_Gorbachev_Category,
        Rest_Honecker_Category),
    
    ! .
     

       
anti_perestroika(
    [Attribute=Variable|Rest_Gorbachev_Category],
    Honecker_Category)
 :-
    var(Variable),
    
    !,
    
    anti_perestroika(
        Rest_Gorbachev_Category,
        Honecker_Category),
    
    ! .
     

      
anti_perestroika(
    [Attribute=list(List)|Rest_Gorbachev_Category],
    [Attribute=list(List)|Rest_Honecker_Category])
 :-        
    !,
    
    anti_perestroika(
        Rest_Gorbachev_Category,
        Rest_Honecker_Category),
    
    ! .


anti_perestroika(
    [Attribute=frame(List,Conditions)|Rest_Gorbachev_Category],
    [Attribute=frame(List,Conditions)|Rest_Honecker_Category])
 :-        
    !,
    
    anti_perestroika(
        Rest_Gorbachev_Category,
        Rest_Honecker_Category),
    
    ! .        
     
        


anti_perestroika(
    [Attribute= (First_Gorbachev_Attribute==Second_Gorbachev_Attribute)|Rest_Gorbachev_Category],
    [Attribute=Honecker_Attribute|Rest_Honecker_Category])
 :-

    unify_feature_structures(
         First_Gorbachev_Attribute,
         Second_Gorbachev_Attribute),

    !,

    anti_perestroika(
         First_Gorbachev_Attribute, 
         Honecker_Attribute),
     
    !,
    
    anti_perestroika(
        Rest_Gorbachev_Category,
        Rest_Honecker_Category),
    
    ! .

     
anti_perestroika(
    [Attribute=Gorbachev_Attribute|Rest_Gorbachev_Category],
    [Attribute=Honecker_Attribute|Rest_Honecker_Category])
 :-
    anti_perestroika(
         Gorbachev_Attribute, 
         Honecker_Attribute),
     
    !,
    
    anti_perestroika(
        Rest_Gorbachev_Category,
        Rest_Honecker_Category),
    
    ! .


%%% LR

lr(X) :- load_rules([X]), ! .


%%% PRETTY_PRINT(Number_of_Blanks, Structure__Printed)


pretty_print(_,[])
 :-
    !.

pretty_print(N,[Attribute=Variable|Rest_F_S])

 :-
        var(Variable),

        !,

        pretty_print(N,Rest_F_S),

        ! .


pretty_print(N,[Attribute=Atom|Rest_F_S])

 :-
        atomic(Atom),

        !,

        print_n_blanks(N),

	write(Attribute), write('='),write(Atom),nl,

        pretty_print(N,Rest_F_S),

        ! .

pretty_print(N,[subcat=list([])|Rest_F_S])

 :-
        !,

        print_n_blanks(N),

	write('subcat=list([])'),nl .


pretty_print(N,[subcat=list(List)|Rest_F_S])

 :-
        !,

        print_n_blanks(N),

	write('subcat=list(['),nl,

        Nplus13 is N + 13,

        pretty_print_list(List,Nplus13),

        Nplus12 is N + 12,

        print_n_blanks(Nplus12),

	write('])'),nl,

        pretty_print(N,Rest_F_S),

        ! .

pretty_print(N,[comps=list([])|Rest_F_S])

 :-
        !,

        print_n_blanks(N),

	write('comps=list([])'),nl .


pretty_print(N,[comps=list(List)|Rest_F_S])

 :-
        !,

        print_n_blanks(N),

	write('comps=list(['),nl,

        Nplus12 is N + 12,

        pretty_print_list(List,Nplus12),

        Nplus11 is N + 11,

        print_n_blanks(Nplus11),

	write('])'),nl,

        pretty_print(N,Rest_F_S),

        ! .


pretty_print(N,[Attribute=list(List)|Rest_F_S])

 :-
        !,

        print_n_blanks(N),

	write(Attribute), write('=list('),write(List),write(')'),nl,

        pretty_print(N,Rest_F_S),

        ! .

pretty_print(N, [Attribute= (Cat_1 == Cat_2)|Rest_FS])
 :-
        var(Cat_1),
        !,
        pretty_print(N,[Attribute= Cat_2|Rest_FS]).


pretty_print(N, [Attribute= (Cat_1 == Cat_2)|Rest_FS])
 :-
        var(Cat_2),
        !,
        pretty_print(N, [Attribute= Cat_1|Rest_FS]).

pretty_print(N, [Attribute= (Atom == Atom)|Rest_FS])
 :-
        atomic(Atom),
        !,
        pretty_print(N, [Attribute= Atom|Rest_FS]).


pretty_print(N, [Attribute= (list(List) == list(List))|Rest_FS])
 :-
        !,
        pretty_print(N, [Attribute= list(List)|Rest_FS]).




pretty_print(N, [Attribute= (Cat_1 == Cat_2)|Rest_FS])
 :-                      
        !,
        
        pretty_print(N, [Attribute=Cat_1|Rest_FS]).



pretty_print(N,[Attribute=Complex_Value|Rest_F_S])

 :-
        !,

        print_n_blanks(N),
	write(Attribute), write('=['), nl,
        name(Attribute,Char_List),
        list_length(Char_List,Length),
        NplusLengthplus2 is N + Length + 2 ,
        pretty_print(NplusLengthplus2 , Complex_Value),
        NplusLengthplus1 is N + Length + 1 ,
	print_n_blanks(NplusLengthplus1), write(']'),nl,

        pretty_print(N,Rest_F_S),

        ! .


/*
pretty_print(N, [frame=frame(Frame)|Rest])
 :-                      
   !,

   pretty_print(Rest),

   pretty_print_frame(Frame) .

*/


pretty_print(N,[A|Rest])
 :-
   print_n_blanks(N),

   write(A),write(','),nl,

   pretty_print(N,Rest).

/*
pretty_print_frame([])
 :-
    !.

pretty_print_frame([Slot|Rest])
 :-
    write(Slot),write(','),nl,

    pretty_print_frame(Rest),

    !.
*/


%%% PRINT_N_BLANKS(Number_of_Blanks)

print_n_blanks(Negative_Number) :- 

        ( var(Negative_Number)
        ; number(Negative_Number) , Negative_Number < 0 ),

	write('print_n_blanks invoked with incorrect argument'),nl,

        !, fail .

print_n_blanks(0) :- ! .


print_n_blanks(N) :- 
	write(' '),
        Nminus1 is N - 1, 
        print_n_blanks(Nminus1),
        ! .

list_length([],0) :- ! .
list_length([H|T],Result)
 :-
    list_length(T,Length_T),
    Result is Length_T + 1 .


pretty_print_list([],_):- ! .

pretty_print_list([H|T],N):-
        
        print_n_blanks(N),

	write(H), nl,

        pretty_print_list(T,N),

        ! .



%%% SP

sp(X) :- start_parsing([X]) .


%%%%%%%%%%%%%%%%%

%       PROCESS_WORD

/* VERSE PRO HIERARCHICKY SLOVNIK - vykomentovana
process_word(
   Word,
   [phon=Phon|Rest])
 :-
    transform_word_form(
       Word,
       T_Word            ),

    
       entry(
          T_Word,
          Structure,
          Classs,
          Constraints   ),

    call(
       Constraints),

   glue_goals(
    [  perestroika(
           Structure,
           Real_Structure),

        process_classes(
           Classs,
           Real_Structure,
           Sign           ),

        nonvar_efface_if_member(
           phon=Phon,
           Sign,
           Rest_Sign           ),

        efface_all(
          _ = no_default,
          Rest_Sign,
          Rest     )      ] ).

*/


%verse pro mdloduchy slovnik soucasny

process_word(
   Word,
   Real_Structure)
 :-
    transform_word_form(
       Word,
       T_Word            ),

    lexical_entry(
          T_Word,
          Structure),
   
    perestroika(
           Structure,
           Real_Structure).



%       EFFACE_ALL

efface_all(_,Var,Var) :- var(Var), ! .

efface_all(_=Val,[_=Val|Rest],Result)
  :- !, efface_all(_=Val,Rest,Result) .
                                       
efface_all(Member,[N|Rest],[N|Result])
 :-
    efface_all(Member,Rest,Result) .

                                                                                                       
    
%%% GLUE_GOALS

glue_goals([])
  :-
     ! .

glue_goals([Goal|Rest_Goals])
 :-
    Goal,

    glue_goals(Rest_Goals),

    ! .

%%%%%  NOT

not(Goal)
 :-
    Goal, !, fail .

not(_) :- ! .





%       IN_STRING

/* poznamka - je DULEZITE aby uzly sli za sebou po jedne - PETR (jinak zmenit
 predikat 'get_input_nodes( List )') */
in_string(
   N,
   [Word_Form|Rest_String],
   _  ,
   Temporary_Lexicon        )
 :-
    Nplus1  is  N + 1,

    (
       process_word(
          Word_Form,
          Real_Word_Form_Category),

       write(Temporary_Lexicon,(Real_Word_Form_Category is_an_edge_from_node N to_node Nplus1)),

       tab(Temporary_Lexicon, 2), put(Temporary_Lexicon,46), tab(Temporary_Lexicon, 2),

       fail

    ;
   
       not(
           process_word(
              Word_Form,
              _          )),

       nl,

       write(' Word >>'),

       write(Word_Form),
 
       write('<< not found in the lexicon. Parse terminated.'),

       nl,nl,

       close(Temporary_Lexicon),

       !,

       fail

    ) .


in_string(
   N,
   [Word_Form|Rest_String],
   Last_Pos,
   Temporary_Lexicon       )
 :-
    Nplus1  is  N + 1,

    !,

    in_string(
       Nplus1,
       Rest_String,
       Last_Pos,
       Temporary_Lexicon ) .


in_string(
   N,
   [],
   N,
   Temporary_Lexicon    ) 
 :-
    write(Temporary_Lexicon,(last_node_is N)) ,

    tab(Temporary_Lexicon, 2), put(Temporary_Lexicon,46), tab(Temporary_Lexicon, 2),

    ! .




%       LOAD_LEXICON(FILENAME)

load_lexicon(Filename)
 :- 
    retractall(lexical_entry(_,_)),

    retractall(number_of_lex_entries(_)),

    open(Filename, read, Lexicon),

    write(' Reading in lexicon ...'),

    nl,

    assert(number_of_lex_entries(0)),

    repeat,

    in_entry(Lexicon,Read),

    glue_goals(
        [number_of_lex_entries(NoLE),
	 retract(number_of_lex_entries(NoLE)),
         NoLEplus1 is NoLE + 1,
         assert(number_of_lex_entries(NoLEplus1)) ]),

    end == Read,

    number_of_lex_entries(No_Of_Entries),

    N is No_Of_Entries - 1,

    nl,

    write('     ... lexicon read in, containing '),

    write(N),

    write(' entries.'),

    nl,

    nl,

    close(Lexicon),

    ! .

load_lexicon(_)
 :- 
    write(' File containing cannot be opened (probably missing). '),

    nl,nl .





%       IN_ENTRY

in_entry(Lexicon,End)
 :-
    read(Lexicon,Term),

    (   Term = is_an_instance_of(
            [phon=list([Phon])|Rest_Entry],
            if1(
               type(Type),
               Constraints)                             ),
                                                                          
        assertz(
           entry(Phon,
                 [phon=list([Phon])|Rest_Entry],
                 Type,
                 Constraints                                )),

        !

    ; 
           Term = is_an_instance_of(
            [phon=list([Phon])|Rest_Entry],
            type(Type)                                       ),
                                                                          
        assertz(
           entry(Phon,
                 [phon=list([Phon])|Rest_Entry],
                 Type,
                 true                                       )),

        !

    ; Term = is_an_instance_of(
            [phon=list([Phon])|Rest_Entry],
            if1(
               Type,
               Constraints)                             ),
                                                                          
        assertz(
           entry(Phon,
                 [phon=list([Phon])|Rest_Entry],
                 Type,
                 Constraints                                )),

        !

    ; 
           Term = is_an_instance_of(
            [phon=list([Phon])|Rest_Entry],
            Type                                       ),
                                                                          
        assertz(
           entry(Phon,
                 [phon=list([Phon])|Rest_Entry],
                 Type,
                 true                                       )),

        !

   ;

        Term = [phon=list([Phon])|Rest_Entry],

        assertz(
           lexical_entry(
                 Phon,
                 [phon=list([Phon])|Rest_Entry])),

        !

   ;
        Term = end_of_file,

        End = end,


        ! 

    ;

        End = end,

        nl,

        number_of_lex_entries(NoLE),

        Error is NoLE + 1,
  
	write(' ERROR in lexicon ... near its '),

	write(Error),

	write('st/rd/th entry.'),

        nl                                                        ) .


%   READ_INPUT_STRING

read_input_string([Char_Code|Rest])
 :-
   ttyget0(Char_Code),

   if1( (Char_Code = 46 ; Char_Code = 33 ; Char_Code = 63),
        Rest = [],
         read_input_string(Rest) ),
         ! .


%       NEW_READ_SENTENCE


/* reading something what noone has written :-) but what appears as a character */
new_read_sentence(
   [10|Rest_Input],
   Words           )
 :-
    new_read_sentence(
       Rest_Input,
       Words          ),

    ! .

/* reading a blank */
new_read_sentence(
   [32|Rest_Input],
   Words           )
 :-
    new_read_sentence(
       Rest_Input,
       Words          ),

    ! .

/* reading a carriage return */
new_read_sentence(
   [13|Rest_Input],
   Words           )
 :-
    new_read_sentence(
       Rest_Input,
       Words          ),

    ! .

/* reading a  full-stop */
new_read_sentence(
   [46|_],
   []             )
 :-
    ! .

/* reading an exclamation-mark  */
new_read_sentence(
   [33|_],
   []             )
 :-
    ! .

/* reading a question-mark */
new_read_sentence(
   [63|_],
   []             )
 :-
    ! .

/* reading a real word */
new_read_sentence(
   Input,
   [Real_Word|Words]   )
 :-

    new_read_word(
       Input,
       Rest_Input,
       Word       ),

    name(
      Real_Word,
      Word      ),

       
    new_read_sentence(
       Rest_Input,
       Words          ) .


%       NEW_READ_WORD

new_read_word(
  [32|Rest_Input],
  Rest_Input,
  []              )
 :-
    ! .

new_read_word(
  [13|Rest_Input],
  Rest_Input,
  []              )
 :-
    ! .

new_read_word(
  [46|Rest_Input],
  [46|Rest_Input],
  []              )
 :-
    ! .


new_read_word(
  [33|Rest_Input],
  [33|Rest_Input],
  []              )
 :-
    ! .

new_read_word(
  [63|Rest_Input],
  [63|Rest_Input],
  []              )
 :-
    ! .


new_read_word(
  [Char|Rest_Input],
  Rest_of_Rest_Input,
  [Char|Chars]              )
 :-
    new_read_word(
       Rest_Input,
       Rest_of_Rest_Input,
       Chars              ) .

 


%       PERESTROIKA

perestroika(
    [],
    Free_Variable)
 :- 
     var(Free_Variable),

     ! .
   

perestroika(
    [Attribute=Atom|Rest_Brezhnev_Category],
    [Attribute=Atom|Rest_Gorbachev_Category])
 :-
    atomic(Atom),
    
    !,
    
    perestroika(
        Rest_Brezhnev_Category,
        Rest_Gorbachev_Category),
    
    ! .
     

perestroika(
    [Attribute=Variable|Rest_Brezhnev_Category],
    [Attribute=Variable|Rest_Gorbachev_Category])
 :-
    var(Variable),
    
    !,
    
    perestroika(
        Rest_Brezhnev_Category,
        Rest_Gorbachev_Category),
    
    ! .
    



perestroika(
    [Attribute= (Variable==Atom)|Rest_Brezhnev_Category],
    [Attribute= (Variable==Atom)|Rest_Gorbachev_Category])
 :-
    var(Variable),
    
    atomic(Atom),
     
    !,
    
    perestroika(
        Rest_Brezhnev_Category,
        Rest_Gorbachev_Category),
    
    ! .

perestroika(
    [Attribute= (Variable==list(List))|Rest_Brezhnev_Category],
    [Attribute= (Variable==list(List))|Rest_Gorbachev_Category])
 :-
    var(Variable),
    
    !,
    
    perestroika(
        Rest_Brezhnev_Category,
        Rest_Gorbachev_Category),
    
    ! .


perestroika(
    [Attribute= (Variable==frame(List,Conditions))|Rest_Brezhnev_Category],
    [Attribute= (Variable==frame(List,Conditions))|Rest_Gorbachev_Category])
 :-
    var(Variable),
    
    !,
    
    perestroika(
        Rest_Brezhnev_Category,
        Rest_Gorbachev_Category),
    
    ! .
     
 

perestroika(
    [Attribute= (Variable==Brezhnev_Attribute)|Rest_Brezhnev_Category],
    [Attribute= (Variable==Gorbachev_Attribute)|Rest_Gorbachev_Category])
 :-
    var(Variable),
    
    Brezhnev_Attribute = [_|_],
    
    !,

    perestroika(
        Brezhnev_Attribute, 
        Gorbachev_Attribute),
     
    !,
    
    perestroika(
        Rest_Brezhnev_Category,
        Rest_Gorbachev_Category),
    
    ! .
     


perestroika(
    [Attribute= (Variable==Value)|Rest_Brezhnev_Category],
    [Attribute= (Variable==Value)|Rest_Gorbachev_Category])
 :-
    var(Variable),
    
    !,
    
    perestroika(
        Rest_Brezhnev_Category,
        Rest_Gorbachev_Category),
    
    ! .
           


perestroika(
    [Attribute=list(List)|Rest_Brezhnev_Category],
    [Attribute=list(List)|Rest_Gorbachev_Category])
 :-        
    !,
    
    perestroika(
        Rest_Brezhnev_Category,
        Rest_Gorbachev_Category),
    
    ! .        


perestroika(
    [Attribute=frame(List,Conditions)|Rest_Brezhnev_Category],
    [Attribute=frame(List,Conditions)|Rest_Gorbachev_Category])
 :-        
    !,
    
    perestroika(
        Rest_Brezhnev_Category,
        Rest_Gorbachev_Category),
    
    ! .        
     

perestroika(
    [Attribute=Brezhnev_Attribute|Rest_Brezhnev_Category],
    [Attribute=Gorbachev_Attribute|Rest_Gorbachev_Category])
 :-
    Brezhnev_Attribute = [_|_],
    
    !,
 
    perestroika(
         Brezhnev_Attribute, 
         Gorbachev_Attribute),
     
    !,
    
    perestroika(
        Rest_Brezhnev_Category,
        Rest_Gorbachev_Category),
    
    ! .

     
perestroika(
    [Attribute=Value|Rest_Brezhnev_Category],
    [Attribute=Value|Rest_Gorbachev_Category])
 :-
    !,
    
    perestroika(
        Rest_Brezhnev_Category,
        Rest_Gorbachev_Category),
    
    ! .
    
    
%       TRANSFORM_WORD_FORM

transform_word_form(
   Word_Form,
   Word_Form        ) .

transform_word_form(
   Upper_Case_Word_Form,
   Lower_Case_Word_Form ) 
 :-
    name(
      Upper_Case_Word_Form,
      [Upper_Case_Char|Rest_List_Of_Chars]
                           ),

    128  < Upper_Case_Char,
           Upper_Case_Char < 159,

    Lower_Case_Char is Upper_Case_Char + 32,

    name(
      Lower_Case_Word_Form,
      [Lower_Case_Char|Rest_List_Of_Chars] ),

    ! .

%================
parser
 :- 

   main_loop(121) .


main_loop(121)
 :-
    glue_goals(
	[write(' Enter string to be parsed, followed by ".","?" or "!" and "ENTER". '),
	 nl,
	 retractall(stack_operation(_,_)),
	 retractall( kp_dm_ds_pred_edge_head_reduct__( _ ) ),
	 retractall( kp_dm_ds_pred_compose_edge_mark__( _ ) ),
	 retractall( kp_dm_ds_pred_hide_edge_mark_info__( _ ) ),
	 retractall( kp_dm_hide_edge_db_inner__( _,_,_,_,_,_,_,_ ) ),
	 retractall(current_stack_operation(_,_)),
	 retractall(success_edge(_)),
	 retractall(edges_combination_inner_info(_,_,_)),
	 retractall(edge_inner_info(_,_,_) ),
	 retractall(edge_inner_min_structure(_,_)),
/*         retractall(end_inner_node(_)),     PETR */
	 retractall(node__(_,_)),                /* PETR */
	 retractall(edge_category__(_,_)),  /* PETR - edge_inner_structure  */
	 retractall(edge_free_number__(_)),  /* PETR handle_counter_inner */
	 retractall(read_edge_inner_information(_,_)),
	 retractall(reduction_inner_information(_,_,_,_)),
	 retractall( error_sort_value_edges_list_inner__(_) ),
	 retractall( nonchart_error_edge_inner_info__(_,_,_,_,_,_) ),
	 retractall( kp_dm_new_reduction_error_information__(_,_,_) ),
	 retractall( kp_dm_new_edges_combination_error_info__( _,_ ) ),
	 retractall( kp_dm_edge_head_info_inner__( _ ) ),
	 retractall( kp_dm_in_ds_head_is_knowen_inner__( _,_,_ ) ),
	 retractall(stack_inner_structure(_,_,_,_)),
/*         retractall(start_inner_node(_)),        PETR */

/* PETR */
	 retractall(edge_chart__(_,_)),
	 retractall(edge_start_node__(_,_)),
	 retractall(edge_end_node__(_,_)),
/* PETR */

	 read_input_string(Input_String),
	 new_read_sentence(Input_String,Sentence),
	 open(temporary_lexicon,write,Temporary_Lexicon),
	 write(Temporary_Lexicon, '   '),
	 in_string(0,Sentence,Last_Pos,Temporary_Lexicon),
	 close(Temporary_Lexicon),
	 gc   ]),

    glue_goals([
    if1(setof(Rule,invoked(Rule),Invoked_Rules), true, Invoked_Rules = []),  
				% Karel

    fit_grammar(Invoked_Rules),  %Karel

   start_parsing([temporary_lexicon]) ]),

   start_node(Start_Node),

   last_node(End_Node),

   print_results(Start_Node,End_Node),

   fail .


main_loop(121)
 :- 
    nl,nl,nl,
                     
    write(' No (more) parses. '),nl,nl,
    
    write(' Another string to be parsed (y/n) ?  '),

    ttyget(Response),

    main_loop(Response),

    ! . 

%%%%%%  PRINT_RESULTS
/*
print_results(Start,End)
 :-
/  *  edge_inner_info(Handle,_,_,Start,End), PETR *  /
   edge_ret_start_node(Handle, Start),
   edge_ret_end_node(Handle, End),  /  * PETR *  /

   edge_category__(Handle,Structure),  / * PETR edge_inner_structure * /

   nl,write('Resulting structure: '),nl,

   if1( success_edge( Handle ),
	( write(' this is a correct sentence'), nl ),
	true ),

   nl, pretty_print(0,Structure), nl,nl,nl,
   write_feature_structure_errors( Structure ), nl, nl, nl,


   fail .

print_results(_,_) .
*/
    
%%%%  FIT_GRAMMAR

fit_grammar([])
 :-
    ! .

fit_grammar([Name_of_Invoked_Rule|Rest_of_Names_of_Invoked_Rules])
 :-
    rule_push_in(Name_of_Invoked_Rule),

    fit_grammar(Rest_of_Names_of_Invoked_Rules),

    !.



