:-dynamic a_rule_some_exist/0, parse_successful/0, a_rule_inner_rule_last_nbr/1, edges_combination_inner_info/3, edge_inner_info/5 , 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/4, stack_operation/2, current_stack_operation/2, success_edge/1, stack_inner_structure/4, start_inner_node/1, 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, [ constituent_type = _ConstType | RestSynsemStruct ] ), NewEdgeStructure = [ synsem = [ constituent_type = lexical | 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_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) :- 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(start_inner_node(NodeHandle)). set_end_node(NodeHandle) :- asserta_to_db(end_inner_node(NodeHandle)). is_last_node_defined :- last_node(NodeHandle). start_node(NodeHandle) :- ask_db(start_inner_node(NodeHandle)). last_node(NodeHandle) :- ask_db(end_inner_node(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) :- nonvar(Cond), Cond, !, Then. if1(Cond, Then, Else) :- ( var(Cond), !, % nl, write('Runtime Warning: "if" invoked with empty %Condition'),nl, 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 */ /* 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) 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 ) :- assert_to_db(edge_inner_info( EdgeHandle, Useable, LeftGrowable, StartNodeHandle, EndNodeHandle )), assert_to_db(edge_inner_structure( EdgeHandle, EdgeStructure )), assert_to_db(edge_inner_min_structure( EdgeHandle, MinStructure )), !. l_edge_make_new_edge( EdgeStructure, Useable, LeftGrowable, MinStructure, StartNodeHandle, EndNodeHandle, EdgeHandle ) :- new_handle(EdgeHandle), l_edge_remake_new_edge( EdgeStructure, Useable, LeftGrowable, MinStructure, StartNodeHandle, EndNodeHandle, true, EdgeHandle ), !. make_new_input_edge(EdgeStructure, MinStructure, StartNodeHandle, EndNodeHandle) :- l_edge_make_new_edge(EdgeStructure, true, fail, MinStructure, StartNodeHandle, EndNodeHandle, E), init_info_edge(E). /* 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, EdgeHandle). make_new_edge(NewStructure, MinStructure, StartNodeHandle, EndNodeHandle, EdgeHandle) :- l_edge_make_new_edge(NewStructure, true, true, MinStructure, StartNodeHandle, EndNodeHandle, EdgeHandle). 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_inner_structure(EdgeHandle, EdgeStructure)). edge_ret_your_minimal_structure(EdgeHandle, MinStructure) :- ask_db(edge_inner_min_structure(EdgeHandle, MinStructure)). edge_ret_start_node(EdgeHandle, StartNodeHandle) :- ask_db(edge_inner_info(EdgeHandle, _, _, StartNodeHandle, _)). edge_ret_end_node(EdgeHandle, EndNodeHandle) :- ask_db(edge_inner_info(EdgeHandle, _, _, _, EndNodeHandle)). useable_edge_handle_starting_at(NodeHandle, EdgeHandle) :- ask_db(edge_inner_info(EdgeHandle, true, _, NodeHandle, _)). left_growable_edge_handle_starting_at(NodeHandle, EdgeHandle) :- ask_db(edge_inner_info(EdgeHandle, _, true, NodeHandle, _)). init_lo_edges :- init_ds_module, retract_all_with_head(edge_inner_info(_,_,_,_,_)), retract_all_with_head(edge_inner_structure(_,_)), 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 ) :- retract_from_db(edge_inner_info( EdgeHandle, Useable, LeftGrowable, StartNodeHandle, EndNodeHandle )), retract_from_db(edge_inner_structure( EdgeHandle, EdgeStructure )), 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_inner_structure( Edge, _EdgeStructure ) ), assert_to_db( edge_inner_structure( 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_all_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 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(handle_counter_inner(X)), asserta_to_db(handle_counter_inner(0)). new_handle(Handle) :- retract_from_db(handle_counter_inner(Handle)), NewCounter is Handle + 1, asserta_to_db(handle_counter_inner(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), ( 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)), (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 :- make_reduction_info_change_curr_to_dady(ReductionInfo, FatherStackHandle), reduce_ret_edges_handles(ReductionInfo, ListOfEdgesHandles), father_dady_read_edges(ListOfEdgesHandles, so_possleftreduct, FatherStackHandle). 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), 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 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). 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 = []. 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. 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_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)), !, 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_lists(OneList, SecList) :- (var(OneList); var(SecList)), !, 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_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) :- 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) :- !, unify_feature_structures(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), f_unify_find_term(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: incorrect 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 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 cislo 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 cisla 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 cisel 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 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) 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 ), ( 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), ask_db(Rule2Structure). rule_2_structure_ret_h_structure(Rule2Structure, H2Struct) :- Rule2Structure = rule_2_inner_structure(MinStructure, Rule2Nbr, FeatureStructure, H2Struct). rule_2_structure_ret_feature_structure(Rule2Structure, EndStructure) :- Rule2Structure = rule_2_inner_structure(MinStructure, Rule2Nbr, EndStructure, H2Struct). :- op(1200, xfx, is_a_nucleus_expansion_rule_if). :- op(1200, xfx, is_a_complement_expansion_rule_if). :- op(1200, xfx, is_an_uncoplete_complement_expansion_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_readed_term(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(stack_operation(_,_)), 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(_)), retractall(edge_inner_structure(_,_)), retractall(handle_counter_inner(_)), retractall(read_edge_inner_information(_,_)), retractall(reduction_inner_information(_,_,_,_)), retractall(start_inner_node(_)), 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__( _,_,_ ) ). 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_readed_term( Rule ) :- nonvar( Rule ), if1( Rule = ( Name : Structure ), true, ( Structure = Rule, a_rule_new_rule_nbr( Name ) ) ), a_rule_readed_term_make( Structure, Name ). a_rule_readed_term(_) :- seen, a_rule_new_rule_nbr(RuleNbr), nl,write('Syntax error near rule nr. '),write(RuleNbr),nl,error(' '). a_rule_readed_term_make( (Feature is_a_nucleus_expansion_rule_if Action), RuleNbr ) :- 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), assert_to_db(rule_1B_inner_structure(MinStructure, RuleNbr, FeatureStructure, BottomStruct, HStruct, RightStruct, Action)). a_rule_readed_term_make( (Feature is_a_complement_expansion_rule_if Action), RuleNbr ) :- 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), assert_to_db(rule_1A_inner_structure(MinStructure, RuleNbr, FeatureStructure, BottomStruct, RightStruct, Action, true)). a_rule_readed_term_make( (Feature is_an_uncoplete_complement_expansion_rule_if Action), RuleNbr ) :- 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), assert_to_db(rule_1A_inner_structure(MinStructure, RuleNbr, FeatureStructure, BottomStruct, RightStruct, Action, fail)). a_rule_readed_term_make( (Feature is_a_phrase_termination_rule), RuleNbr ) :- nonvar(Feature), !, clean_feature_structure_tell( Feature, FeatureStructure ), big_feature_ret_minimal_condition(FeatureStructure, MinStructure), big_feature_ret_h_structure(FeatureStructure, HStruct), assert_to_db(rule_2_inner_structure(MinStructure, RuleNbr, FeatureStructure, HStruct)). %%%%%%%%%%%%%%%%%%%%%%%%%%% %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]) . %%%%%%%%%%%%%%%%% :- op(1200,xfx,invokes_rules) . :- op(200,xfx,is_subsumed_in) . :- op(1200,xfx,is_an_instance_of) . :- op(1200,xfx,assigns_feature_set) . :- op(1200,xfx,has_partitions) . :- op(1200,xfx,is_a_subclass_of) . :- op(1100,xfx,to_lexical_sign) . :- op(1100,xfx,for_lexical_sign) . :- op(1100,fx,class) . :- op(1100,fx,type) . :- op(1100,fx,partition) . :- op(1050,xfx,if) . :- op(1100,fx,<<) . :- op(1100,xf,>>) . :- op(0,fx,case). % SELECTIVELY_UNIFY selectively_unify( Real_Structure, [], Real_Structure ) :- ! . selectively_unify( Var, Structure, Real_Structure ) :- var(Var), !, perestroika( Structure, Real_Structure), ! . selectively_unify( First, [Attr=Val_2|Rest_Second], [Attr=Val_3|Rest_Third] ) :- nonvar_efface_if_member( Attr=Val_1, First, Rest_First ), !, ( ( (var(Value_1),!; atomic(Value_1),!; Value_1 = list(_),!; Value_1 = frame(_,_)), ! ; (var(Value_2),!; atomic(Value_2),!; Value_2 = list(_),!; Value_2 = frame(_,_)), ! ), Val_1 = Val_3, ! ; selectively_unify( Val_1, Val_2, Val_3 ), ! ; Val_1 = Val_3 ), selectively_unify( Rest_First, Rest_Second, Rest_Third ), ! . selectively_unify( First, [Feature|Rest_Second], [Feature|Rest_Third] ) :- selectively_unify( First, Rest_Second, Rest_Third ), ! . % PROCESS_CLASSES process_classes( (Class,Rest_Classs), Input_Structure, Output_Structure) :- process_class( Class, Input_Structure, Intermediary_Structure), process_classes( Rest_Classs, Intermediary_Structure, Output_Structure ) . process_classes( Class, Input_Structure, Output_Structure) :- atomic( Class), process_class( Class, Input_Structure, Output_Structure) . % PROCESS_CLASS process_class( supremum, Structure, Structure) :- ! . process_class( Class, Input_Structure, Output_Structure) :- ( assigns_feature_set( Class, Structure_1, Assigned_Structure, Constraints_1 ), ! ; Assigned_Structure = [], Structure_1 = [], Constraints_1 = true ), ( has_partitions( Class, Partitions ) , ! ; Partitions = [] ), ( is_a_subclass_of( Class, Superclass ), ! ; Superclass = supremum ), ( invokes_rules( Class, Structure_2, Rule_List, Constraints_2 ), ! ; Structure_2 = [], Rule_List = [], Constraints_2 = true ), ( glue_goals([from_rule_is_subsumed_in_real( Structure_1, Input_Structure ), selectively_unify( Input_Structure, Assigned_Structure, First_Intermediary_Structure) ]), call( Constraints_1) ; not((from_rule_is_subsumed_in_real( Structure_1, Input_Structure), call( Constraints_1))), First_Intermediary_Structure = Input_Structure ), process_partitions( First_Intermediary_Structure, Partitions, Second_Intermediary_Structure), process_rule_invocations( Second_Intermediary_Structure, Structure_2, Rule_List, Constraints_2 ), process_class( Superclass, Second_Intermediary_Structure, Output_Structure ) . % PROCESS_PARTITIONS process_partitions( Input_Structure, (Partition,Rest_Partitions), Output_Structure) :- assigns_feature_set( Partition, Structure, Assigned_Structure, Constraints ), ( /* Success of the unification AND existence of at least one instantiation of features satisfying the constraints to be made sure */ glue_goals( [not( not(( from_rule_unify_with_real( Structure, Input_Structure ), call( Constraints) ))), from_rule_unify_with_real( Structure, Input_Structure )]), call( Constraints), selectively_unify( Input_Structure, Assigned_Structure, Intermediary_Structure) ; not(( from_rule_unify_with_real( Structure, Input_Structure ), call( Constraints) )), Input_Structure = Intermediary_Structure, ! ), process_partitions( Intermediary_Structure, Rest_Partitions, Output_Structure ) . process_partitions( Input_Structure, Partition, Output_Structure) :- atomic( Partition), assigns_feature_set( Partition, Structure, Assigned_Structure, Constraints ), ( /* Success of the unification AND existence of at least one instantiation of features satisfying the constraints to be made sure */ not( not(( from_rule_unify_with_real( Structure, Input_Structure ), call( Constraints) ))), from_rule_unify_with_real( Structure, Input_Structure ), call( Constraints), selectively_unify( Input_Structure, Assigned_Structure, Output_Structure ) ; not(( from_rule_unify_with_real( Structure, Input_Structure ), call( Constraints) )), Input_Structure = Output_Structure, ! ) . process_partitions( Structure, [], Structure ) . % PROCESS_RULE_INVOCATIONS process_rule_invocations( _, _, [], _ ) :- ! . process_rule_invocations( Lexical_Sign, Structure, Rule_List, Constraints ) :- glue_goals( [from_rule_is_subsumed_in_real( Structure, Lexical_Sign ), call( Constraints) ]), !, invoke_rules(Rule_List) . process_rule_invocations( _, _, _, _ ) . % INVOKE_RULES invoke_rules((A,B)) :- ( invoked(A), ! ; assertz(invoked(A)) ), invoke_rules(B), ! . invoke_rules(A) :- ( invoked(A), ! ; assertz(invoked(A)) ), ! . % 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], if( 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], if( 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), !, perestroika( Brezhnev_Attribute, Gorbachev_Attribute), !, 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]) :- perestroika( Brezhnev_Attribute, Gorbachev_Attribute), !, 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, clean_db, retractall(parse_successful), 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(_)), retractall(edge_inner_structure(_,_)), retractall(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(_)), 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([ start_parsing([temporary_lexicon]), start_node(Start_Node), last_node(End_Node), if1(edge_inner_info(Handle,_,_,Start_Node,End_Node), ( assert(parse_successful), write('Parse successful.'),nl, write('Should the resulting structure(s) be shown (y/n) ? '), ttyget(Response), if1(Response=121, print_results(Start_Node,End_Node), true) ), true) ]), fail . main_loop(121) :- nl,nl,nl, if1(parse_successful, retract(parse_successful), (write(' No 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), edge_inner_structure(Handle,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(_,_) . */ /* pretty_print1 (InputFS, Result) first most simple version pretty_print2 (InputFS, Result) more informative version pretty_print3 (InputFS, Result) most informative version */ /* pretty_print1 /2 */ pretty_print1(FS, PL) :- feature_structure_find_feature(FS, rule, 0), !, feature_structure_find_feature(FS, phon, list([PL])). pretty_print1(FS,[]) :- feature_structure_find_feature(FS, phon, list([])), !. pretty_print1(FS,[H|Rest]) :- feature_structure_find_feature(FS, first, FSF), pretty_print1(FSF, H), feature_structure_find_feature(FS, rest, FSR), pretty_print1(FSR, Rest). /* pretty_print2 /2 */ pretty_print2(FS, word(C,PL)) :- feature_structure_find_feature(FS, rule, 0), !, big_feature_ret_minimal_condition(FS, C), feature_structure_find_feature(FS, phon, list([PL])). pretty_print2(FS,tn(C)) :- feature_structure_find_feature(FS, phon, list([])), !, big_feature_ret_minimal_condition(FS, C). pretty_print2(FS,[node(C,H)|Rest]) :- feature_structure_find_feature(FS, first, FSF), big_feature_ret_minimal_condition(FS, C), pretty_print2(FSF, H), feature_structure_find_feature(FS, rest, FSR), pretty_print2(FSR, Rest). /* pretty_print3 /3 */ pretty_print3(FS, word(C,PL)) :- feature_structure_find_feature(FS, rule, 0), !, big_feature_ret_minimal_condition(FS, C), feature_structure_find_feature(FS, phon, list([PL])). pretty_print3(FS,tn(C,R)) :- feature_structure_find_feature(FS, phon, list([])), !, feature_structure_find_feature(FS, rule, R), big_feature_ret_minimal_condition(FS, C). pretty_print3(FS,[node(C,R,H)|Rest]) :- big_feature_ret_minimal_condition(FS, C), feature_structure_find_feature(FS, rule, R), feature_structure_find_feature(FS, first, FSF), pretty_print3(FSF, H), feature_structure_find_feature(FS, rest, FSR), pretty_print3(FSR, Rest).