/* Dialogue server. The call server() starts a dialogue server that accepts requests on the port . The following requests are supported. The format of messages is formally defined in $REGULUS/Prolog/check_dialogue_server_messages.pl: Request: client(ClientHost). Response: accept(ClientHost). Request: get_message_mode. Response: message_mode({prolog,xml,json,pure_json}) or error Find out what the current message mode is. IMPORTANT: THIS MESSAGE AND ITS RESPONSE ARE ALWAYS FORMATTED IN PROLOG, SINCE THE WHOLE POINT IS THAT THE CLIENT DOESN'T KNOW WHAT THE RIGHT FORMAT IS Request: restart_server(CFGFile, CommandsAsAtoms, InitParameter). Response: ok or error Reload resources from CFGFile, using CommandsAsAtoms, which should be a list of Regulus commands expressed as atoms. Finally reinitialise the dialogue context using InitParameter, and remove all stored contexts. Request: restart_server(RestartTag). Response: ok or error If there is a declaration of the form user:restart_server_decl(RestartTag, L1, L2, CFGFile, CommandsAsAtoms, InitParameter) then as restart_server(CFGFile, CommandsAsAtoms, InitParameter). Also stores RestartTag so that it can be accessed by the message last_restart_server_tag. Request: last_restart_server_tag Response: restart_tag(Tag) or error Returns the most recent tag used in a restart_server(RestartTag), or error if there is none Request: restart_recognition_processes Response: ok or error Restart the Regserver Request: action(xml_messages). Response: Format future messages in both directions in XML form. Each message will be of the form xml_message(). where is an XML encoding of the corresponding Prolog message produced using the predicate prolog_xml/2 in $REGULUS/PrologLib/prolog_xml.pl. The XML can be converted back into Prolog if necessary using the same predicate. Request: action(json_messages). Response: Format future messages in both directions in JSON form. Each message will be of the form json_message(). where is an JSON encoding of the corresponding Prolog message produced using the predicate prolog_json/2 in $REGULUS/PrologLib/prolog_json_compact.pl. The JSON can be converted back into Prolog if necessary using the same predicate. Request: action(pure_json_messages). Response: Format future messages in both directions in JSON form. Each message will be of the form where is an JSON encoding of the corresponding Prolog message produced using the predicate prolog_json/2 in $REGULUS/PrologLib/prolog_json_compact.pl. The JSON can be converted back into Prolog if necessary using the same predicate. Request: action(prolog_messages). Response: Format future messages in both directions in Prolog form (default). Request: action(concrete_actions). Response: Pass concrete actions to the client (default). Request: action(abstract_actions). Response: Pass abstract actions to the client, so that the client can do its own output management. Request: action(process_rec_string('')). e.g. action(process_rec_string('what meetings are there next week')). Response: [action=tts('')]. e.g. [action=tts('meeting on July 9 2007')]. error. [Something went wrong] Request: action(robust_process_string('')). e.g. action(robust_process_string('like um what meetings are there you know next week')). Response: [action=tts('')]. e.g. [action=tts('meeting on July 9 2007')]. error. [Something went wrong] Request: action(process_nbest_list([nbest_hyp(, ), nbest_hyp(, ), ...])). e.g. action(process_nbest_list([nbest_hyp(55, 'when is next meeting'), nbest_hyp(43, 'what is next meeting')])). Response: [selected=,action=tts('')]. e.g. [selected='when is next meeting',action=tts('meeting on July 9 2007')]. error. [Something went wrong] Request: action(recognise_and_dialogue_process). Request: action(recognise_and_dialogue_process_from_wavfile(Wavfile)). Response: Performs recognition according to current parameters, then performs dialogue processing as with action(process_rec_string(...)) or action(process_nbest_list(...)) above. Requires recognition to be loaded in the server (LOAD_RECOGNITION command) Request: action(slm_recognise_and_dialogue_process). Request: action(slm_recognise_and_dialogue_process_from_wavfile(Wavfile)). Response: Performs recognition according to current parameters, then performs dialogue processing with the input form slm_result(TopHyp) where TopHyp is an atom representing the top/only recognition hypothesis Request: action(get_most_recent_recorded_wavfile). Response: or error. Requires recognition to be loaded in the server (LOAD_RECOGNITION command) Request: action(get_current_recognition_grammar). Response: or error. Request: action(play_wavfile()) Response: Passes play-wavfile request to Regserver Requires recognition to be loaded in the server (LOAD_RECOGNITION command) Request: action(tts()) Response: Passes tts request to Regserver Requires recognition to be loaded in the server (LOAD_RECOGNITION command) Request: action(process_xml_message('')). Response: as with action(process_nbest_list(...)) above Request: action(get_help_examples(, )). e.g. action(get_help_examples('what be next meeting geneva', 2)). Response: help(''). is a string of help responses separated by newlines. e.g. help('when is the next meeting\nwhen is the next meeting in geneva'). error. [Something went wrong] Request: action(return_to_initial_context). Response: ok. [Successful] error. [Something went wrong] Request: action(set_notional_time(Timestamp)). Response: ok. [Successful] error. [Something went wrong] Request: action(log(Message)). Response: ok. [Successful] error. [Something went wrong] Add a timestamped message to the logfile Request: disconnect. Response: disconnect. [Server disconnects but stays up and running] Request: client_shutdown. Response: thread_shutdown. [Server disconnects and closes down] Note the periods after the requests and responses. Socket code adapted from code at http://dlp.cs.vu.nl/~ctv/dlpinfo/srcs/tcp/sicsock.pl.html */ %---------------------------------------------------------------------------------- :- ['$REGULUS/Prolog/load']. :- use_module(generate). :- use_module(regulus_utilities). :- use_module(parse_xml_rec_result). :- use_module(prolog_logging). :- use_module(check_dialogue_server_messages). :- use_module('$REGULUS/PrologLib/utilities'). %:- use_module('$REGULUS/PrologLib/prolog_xml'). :- use_module('$REGULUS/PrologLib/prolog_xml_compact'). :- use_module('$REGULUS/PrologLib/prolog_json_compact'). :- use_module(library(system)). 'SICSTUS4ONLY'( ( :- use_module(library(file_systems)) ) ). :- use_module(library(lists)). :- use_module(library(sockets)). %---------------------------------------------------------------------------------- % Print all error messages to stdout or whatever is doing its % job. This is necessary for remote compilation and loading. user:message_hook(Severity, _Message, Lines):- telling(MyStream), print_message_lines(MyStream, Severity, Lines). %---------------------------------------------------------------------------------- :- dynamic dialogue_server_debug_level/1. valid_debug_level(DebugLevel) :- integer(DebugLevel), 1 =< DebugLevel, DebugLevel =< 5, !. set_dialogue_server_debug_level(DebugLevel) :- retractall(dialogue_server_debug_level(_)), assertz(dialogue_server_debug_level(DebugLevel)), !. get_dialogue_server_debug_level(DebugLevel) :- dialogue_server_debug_level(DebugLevel), !. get_dialogue_server_debug_level(DebugLevel) :- DebugLevel = 5. call_if_debug_level_at_least(Threshold, Goal) :- get_dialogue_server_debug_level(DebugLevel), DebugLevel >= Threshold, !, call(Goal). call_if_debug_level_at_least(_Threshold, _Goal). call_if_debug_level_at_least_or_else(Threshold, Goal1, Goal2) :- get_dialogue_server_debug_level(DebugLevel), ( DebugLevel >= Threshold -> call(Goal1) ; call(Goal2) ). print_timing_info_if_bug_level_at_least(Threshold, Goal, Operation) :- absolute_timed_call(Goal, TimeInSeconds), update_total_processing_times(Operation, TimeInSeconds), get_average_processing_time_for_events_of_type(Operation, AverageTimeInSeconds), safe_format_to_chars('~2f', [TimeInSeconds], TimeString), safe_format_to_chars('~2f', [AverageTimeInSeconds], AverageTimeString), log_dialogue_string_message(' TIMING', Operation, TimeString), log_dialogue_string_message('AV. TIMING', Operation, AverageTimeString), get_dialogue_server_debug_level(DebugLevel), ( DebugLevel >= Threshold -> format('~N--- Time for ~w: ~2f secs~n', [Operation, TimeInSeconds]), format('~N--- Av. time for ~w: ~2f secs~n', [Operation, AverageTimeInSeconds]) ; otherwise -> true ). %---------------------------------------------------------------------------------- :- dynamic number_of_timed_events_of_type/2. :- dynamic total_processing_time_for_events_of_type/2. init_dialogue_server_timing_info :- retractall(number_of_timed_events_of_type(_, _)), retractall(total_processing_time_for_events_of_type(_, _)). get_number_of_timed_events_of_type(Type, N) :- number_of_timed_events_of_type(Type, N), !. get_number_of_timed_events_of_type(_Type, 0). get_total_processing_time_for_events_of_type(Type, Total) :- total_processing_time_for_events_of_type(Type, Total), !. get_total_processing_time_for_events_of_type(_Type, 0). get_average_processing_time_for_events_of_type(Type, Average) :- get_number_of_timed_events_of_type(Type, N), ( N = 0 -> Average is 0.0 ; otherwise -> get_total_processing_time_for_events_of_type(Type, Total), Average is Total / N ), !. get_average_processing_time_for_events_of_type(Type, Average) :- format('~N*** Error: bad call: ~w~n', [get_average_processing_time_for_events_of_type(Type, Average)]), fail. update_total_processing_times(Type, TimeTaken) :- get_number_of_timed_events_of_type(Type, OldN), get_total_processing_time_for_events_of_type(Type, OldTotal), NewN is OldN + 1, NewTotal is OldTotal + TimeTaken, retractall(number_of_timed_events_of_type(Type, _)), retractall(total_processing_time_for_events_of_type(Type, _)), assertz(number_of_timed_events_of_type(Type, NewN)), assertz(total_processing_time_for_events_of_type(Type, NewTotal)), !. update_total_processing_times(Type, TimeTaken) :- format('~N*** Error: bad call: ~w~n', [update_total_processing_times(Type, TimeTaken)]), fail. %---------------------------------------------------------------------------------- server(Port, CFGFile) :- server(Port, CFGFile, ["NUANCE_PARSER", "LOAD_DIALOGUE", "LOAD_HELP"], '$REGULUS/logfiles', []). server(Port, CFGFile, InitCommands, LogfileDir) :- server(Port, CFGFile, InitCommands, LogfileDir, '*no_init_parameter*', []). server(Port, CFGFile, InitCommands, LogfileDir, InitParameter) :- server(Port, CFGFile, InitCommands, LogfileDir, InitParameter, []). server(Port, CFGFile, InitCommands, LogfileDir, InitParameter, OpenStreamParameters) :- %trace, %spy(recognise_and_dialogue_process), set_current_config_file(CFGFile), start_new_dialogue_session_logfile(LogfileDir), init_server(CFGFile, InitCommands), !, server1(Port, InitParameter, OpenStreamParameters). %---------------------------------------------------------------------------------- init_server(CFGFile, InitCommands) :- regulus_batch(CFGFile, InitCommands), init_dialogue_server_timing_info. %---------------------------------------------------------------------------------- server1(Port, InitParameter, OpenStreamParameters) :- safe_socket_server_open(Port, Socket), format('~N~nDialogue server ready to accept connections on port ~d.~n~n', [Port]), flush_output(user), log_dialogue_event(dialogue_server_ready), !, server2(Socket, parameter(InitParameter), OpenStreamParameters). server2(Socket, ParameterOrState, OpenStreamParameters) :- ( OpenStreamParameters = [] -> safe_socket_server_accept(Socket, _Client, Stream) ; otherwise -> safe_socket_server_accept(Socket, _Client, Stream, OpenStreamParameters) ), format('~N~nDialogue server connected.~n~n', []), log_dialogue_event(dialogue_server_connected), %trace, ( ParameterOrState = parameter(InitParameter) -> init_dm(InitParameter, InitialState) ; ParameterOrState = state(InitialState) -> true ; format('~N*** Error: bad second arg "~q" in call to server2~n', [ParameterOrState]), fail ), server_loop(Stream, InitialState, [], EndOrRestart), close(Stream), log_dialogue_event(dialogue_server_disconnect), !, ( EndOrRestart = end -> format('Exit server~n', []), log_dialogue_event(dialogue_server_exit) ; set_message_mode(prolog), server2(Socket, state(InitialState), OpenStreamParameters) ). %---------------------------------------------------------------------------------- server_from_file(File, CFGFile, InitCommands, LogfileDir, Logfile, InitParameter) :- init_server_from_file(CFGFile, InitCommands, InitParameter, InitialState), server_from_file_no_init(File, LogfileDir, Logfile, InitialState). %---------------------------------------------------------------------------------- init_server_from_file(CFGFile, InitCommands, InitParameter, InitialState) :- set_current_config_file(CFGFile), init_server(CFGFile, InitCommands), init_dm(InitParameter, InitialState). %---------------------------------------------------------------------------------- server_from_file_no_init(File, LogfileDir, Logfile, InitialState) :- start_new_dialogue_session_logfile(LogfileDir, Logfile), safe_absolute_file_name(File, AbsFile), open(AbsFile, read, Stream), format('~N~nDialogue server reading input from file ~w.~n~n', [AbsFile]), flush_output(user), server_from_file_loop(Stream, InitialState, []), close(Stream). %---------------------------------------------------------------------------------- init_dm(InitParameter, InitialState) :- ( InitParameter = '*no_init_parameter*' -> initial_dialogue_state(InitialState) ; otherwise -> initial_dialogue_state(InitParameter, InitialState) ), init_saved_dialogue_state, save_dialogue_state(default, InitialState). %---------------------------------------------------------------------------------- server_loop(Stream, InState, InPreviousStates, EndOrRestart) :- %print_long_string, ( get_message_mode(pure_json) -> read_lines_until_non_empty_line(Stream, ClientRequest0) ; otherwise -> read(Stream, ClientRequest0) ), process_server_loop_item(Stream, ClientRequest0, ClientRequest, InState, InPreviousStates, NextState, NextPreviousStates), !, ( ClientRequest == client_shutdown -> EndOrRestart = end ; ClientRequest == disconnect -> EndOrRestart = restart ; server_loop(Stream, NextState, NextPreviousStates, EndOrRestart) ), !. process_server_loop_item(Stream, ClientRequest0, ClientRequest, InState, InPreviousStates, NextState, NextPreviousStates) :- timed_call(process_server_loop_item_main(Stream, ClientRequest0, ClientRequest, InState, InPreviousStates, NextState, NextPreviousStates), TimeTaken), call_if_debug_level_at_least(2, format('~N~nItem processed, ~3f secs~n', [TimeTaken])). process_server_loop_item_main(Stream, ClientRequest0, ClientRequest, InState, InPreviousStates, OutState, OutPreviousStates) :- call_if_debug_level_at_least_or_else(2, format('~N~n----------------------------------------------~n', []), (format('.', []), flush_output(user)) ), print_log_and_possibly_decode_client_request(ClientRequest0, ClientRequest), ( server_input(ClientRequest, InState, InPreviousStates, OutState, OutPreviousStates, ServerReply0) -> true ; format('~N~n*** Error: unable to process message: ~q~n', [ClientRequest]), OutState = InState, OutPreviousStates = InPreviousStates, ServerReply0 = error ), ( no_reply_required_for_request(ClientRequest) -> log_no_reply_required(ServerReply0) ; otherwise -> print_log_and_possibly_encode_client_response(ServerReply0, ServerReply), server_reply(ServerReply, Stream) ), flush_output(user), !. %---------------------------------------------------------------------------------- server_from_file_loop(Stream, InState, InPreviousStates) :- read(Stream, ClientRequest0), call_if_debug_level_at_least_or_else(2, format('~N~n----------------------------------------------~n', []), call_if_debug_level_at_least(1, (format('.', []), flush_output(user))) ), print_log_and_possibly_decode_client_request(ClientRequest0, ClientRequest), server_input(ClientRequest, InState, InPreviousStates, NextState, NextPreviousStates, ServerReply0), print_log_and_possibly_encode_client_response(ServerReply0, _ServerReply), flush_output(user), !, ( member(ClientRequest, [end_of_file, disconnect, client_shutdown]) -> true ; otherwise -> server_from_file_loop(Stream, NextState, NextPreviousStates) ). %---------------------------------------------------------------------------------- print_log_and_possibly_decode_client_request(ClientRequest0, ClientRequest) :- ( ClientRequest0 = get_message_mode ; is_list_of_non_negative_integers(ClientRequest0), is_substring("get_message_mode.", ClientRequest0) ), %trace, ClientRequest = get_message_mode, log_dialogue_event(received(ClientRequest)), !. print_log_and_possibly_decode_client_request(ClientRequest0, ClientRequest) :- ClientRequest0 = xml_message(XMLClientRequestString), current_datime_formatted_as_HMS(Datime), ( safe_prolog_xml(ClientRequest, XMLClientRequestString) -> call_if_debug_level_at_least(2, format('~N~nServer received (~w):~n~s~n~ninterpreted as:~n~n~w~n', [Datime, XMLClientRequestString, ClientRequest])) ; ClientRequest = bad_xml, call_if_debug_level_at_least(2, format('~N~nServer received (~w): "~s"~nbut could not interpret~n', [Datime, XMLClientRequestString])) ), call_if_debug_level_at_least(2, check_client_message(ClientRequest)), %atom_codes(XMLClientRequestAtom, XMLClientRequestString), %log_dialogue_event(received_xml(XMLClientRequestAtom)), log_dialogue_string_message('RECEIVED XML', xml_message, XMLClientRequestString), log_dialogue_event(received(ClientRequest)), !. print_log_and_possibly_decode_client_request(ClientRequest0, ClientRequest) :- ( ClientRequest0 = json_message(JSONClientRequestString) ; get_message_mode(pure_json), ClientRequest0 = JSONClientRequestString, is_list_of_non_negative_integers(JSONClientRequestString) ), current_datime_formatted_as_HMS(Datime), ( safe_prolog_json(ClientRequest, JSONClientRequestString) -> call_if_debug_level_at_least(2, format('~N~nServer received (~w):~n~s~n~ninterpreted as:~n~n~w~n', [Datime, JSONClientRequestString, ClientRequest])) ; ClientRequest = bad_json, call_if_debug_level_at_least(2, format('~N~nServer received (~w): "~s"~nbut could not interpret it~n', [Datime, JSONClientRequestString])) ), call_if_debug_level_at_least(2, check_client_message(ClientRequest)), %atom_codes(JSONClientRequestAtom, JSONClientRequestString), %log_dialogue_event(received_json(JSONClientRequestAtom)), log_dialogue_string_message('RECEIVED JSON', json_message, JSONClientRequestString), log_dialogue_event(received(ClientRequest)), !. print_log_and_possibly_decode_client_request(ClientRequest0, ClientRequest) :- ClientRequest0 = ClientRequest, current_datime_formatted_as_HMS(Datime), call_if_debug_level_at_least(2, format('~N~nServer received (~w): ~w~n', [Datime, ClientRequest])), log_dialogue_event(received(ClientRequest)), call_if_debug_level_at_least(2, check_client_message(ClientRequest)), !. % The response to the "get_message_mode" message is always sent as Prolog. print_log_and_possibly_encode_client_response(ServerReply0, ServerReply) :- ServerReply0 = message_mode(_Mode), log_dialogue_event(response(ServerReply0)), ServerReply = ServerReply0, !. print_log_and_possibly_encode_client_response(ServerReply0, ServerReply) :- ( postprocessing_is_defined -> true ; otherwise -> call_if_debug_level_at_least(2, check_server_message(ServerReply0)) ), current_datime_formatted_as_HMS(Datime), log_dialogue_event(response(ServerReply0)), ( get_message_mode(xml) -> ( safe_prolog_xml(ServerReply0, XMLServerReplyString) -> call_if_debug_level_at_least(2, format(' ~nServer response (~w): ~w~n~nencoded as~n~s~n', [Datime, ServerReply0, XMLServerReplyString])) ; call_if_debug_level_at_least(2, format(' ~nServer response (~w): ~w~n but failed to encoded as XML~n', [Datime, ServerReply0])), XMLServerReplyString = "unable to encode as XML" ), ServerReply = xml_message(XMLServerReplyString) %atom_codes(XMLServerReplyAtom, XMLServerReplyString), %log_dialogue_event(xml_response(XMLServerReplyAtom)) ; get_message_mode(json) -> ( safe_prolog_json(ServerReply0, JSONServerReplyString) -> call_if_debug_level_at_least(2, format(' ~nServer response (~w): ~w~n~nencoded as~n~s~n', [Datime, ServerReply0, JSONServerReplyString])) ; call_if_debug_level_at_least(2, format(' ~nServer response (~w): ~w~n but failed to encoded as JSON~n', [Datime, ServerReply0])), JSONServerReplyString = "unable to encode as JSON" ), ServerReply = json_message(JSONServerReplyString) %atom_codes(JSONServerReplyAtom, JSONServerReplyString), %log_dialogue_event(json_response(JSONServerReplyAtom)) ; get_message_mode(pure_json) -> ( safe_prolog_json(ServerReply0, JSONServerReplyString) -> call_if_debug_level_at_least(2, format(' ~nServer response (~w): ~w~n~nencoded as~n~s~n', [Datime, ServerReply0, JSONServerReplyString])) ; call_if_debug_level_at_least(2, format(' ~nServer response (~w): ~w~n but failed to encoded as JSON~n', [Datime, ServerReply0])), JSONServerReplyString = "unable to encode as JSON" ), ServerReply = JSONServerReplyString ; otherwise -> ServerReply0 = ServerReply ), !. %---------------------------------------------------------------------------------- log_no_reply_required(ServerReply) :- log_dialogue_event(unsent_response(ServerReply)), !. %---------------------------------------------------------------------------------- no_reply_required_for_request(action_with_no_reply(_Request)). no_reply_required_for_request(action_for_user_with_no_reply(_Id, _Request)). no_reply_required_for_request(action_for_session_with_no_reply(_Id, _Request)). %---------------------------------------------------------------------------------- server_input(ClientRequest, InState, InPreviousStates, InState, InPreviousStates, ServerReply) :- ClientRequest = client(ClientHost), !, ServerReply = accept(ClientHost). server_input(ClientRequest, InState, InPreviousStates, InState, InPreviousStates, ServerReply) :- ClientRequest = get_message_mode, !, get_message_mode(Mode), ServerReply = message_mode(Mode). server_input(ClientRequest, InState, InPreviousStates, NewState, NewPreviousStates, ServerReply) :- ClientRequest = restart_server(RestartTag), !, ( \+ current_predicate(user:restart_server_decl/6) -> format('~N*** Error: restart_server_decl/6 is not defined, can\'t process ~w~n', [restart_server(RestartTag)]), NewState = InState, NewPreviousStates = InPreviousStates, Response = error ; user:restart_server_decl(RestartTag, _L1, _L2, CFGFile, CommandsAsAtoms, InitParameter) -> ClientRequest1 = restart_server(CFGFile, CommandsAsAtoms, InitParameter), format('~N--- Trying to restart server with CFG file = ~w, commands = ~w and init parameter = ~w', [CFGFile, CommandsAsAtoms, InitParameter]), server_input(ClientRequest1, InState, InPreviousStates, NewState, NewPreviousStates, ServerReply), set_last_server_restart_tag(RestartTag) ; otherwise -> format('~N*** Error: no restart_server_decl for ~w~n', [RestartTag]), NewState = InState, NewPreviousStates = InPreviousStates, Response = error ). server_input(ClientRequest, InState, InPreviousStates, NewState, NewPreviousStates, ServerReply) :- ClientRequest = last_restart_server_tag, !, ( get_last_server_restart_tag(RestartTag) -> ServerReply = restart_tag(RestartTag) ; otherwise -> ServerReply = error ), NewState = InState, NewPreviousStates = InPreviousStates. server_input(ClientRequest, InState, InPreviousStates, NewState, NewPreviousStates, ServerReply) :- ( ClientRequest = restart_server(CFGFile, CommandsAsAtoms, InitParameter) ; ClientRequest = restart_server(CFGFile, CommandsAsAtoms), InitParameter = '*no_init_parameter*' ), !, ( handle_restart_server(CFGFile, CommandsAsAtoms, InitParameter, NewState, NewPreviousStates, Response) -> ServerReply = Response ; otherwise -> NewState = InState, NewPreviousStates = InPreviousStates, Response = error ). server_input(action_with_no_reply(Request), InState, InPreviousStates, NextState, NextPreviousStates, ServerReply) :- !, server_input(action(Request), InState, InPreviousStates, NextState, NextPreviousStates, ServerReply). server_input(action_for_user_with_no_reply(Id, Request), InState, InPreviousStates, NextState, NextPreviousStates, ServerReply) :- !, server_input(action_for_user(Id, Request), InState, InPreviousStates, NextState, NextPreviousStates, ServerReply). server_input(action_for_session_with_no_reply(Id, Request), InState, InPreviousStates, NextState, NextPreviousStates, ServerReply) :- !, server_input(action_for_session(Id, Request), InState, InPreviousStates, NextState, NextPreviousStates, ServerReply). server_input(ClientRequest, InState, InPreviousStates, NextState, NextPreviousStates, ServerReply) :- ClientRequest = action(Request), !, handle_action_request(Request, InState, InPreviousStates, NextState, NextPreviousStates, Response), ServerReply = Response. server_input(ClientRequest, InState, InPreviousStates, NextState, NextPreviousStates, ServerReply) :- ClientRequest = action_for_user(Id, Request), !, server_input(action_for_session(Id, Request), InState, InPreviousStates, NextState, NextPreviousStates, ServerReply). server_input(ClientRequest, InState, InPreviousStates, NextState, NextPreviousStates, ServerReply) :- ClientRequest = action_for_session(Id, Request), !, %trace, handle_action_request(set_session(Id), InState, InPreviousStates, NextState1, NextPreviousStates1, ok), handle_action_request(Request, NextState1, NextPreviousStates1, NextState, NextPreviousStates, Response), ServerReply = Response. server_input(ClientRequest, InState, InPreviousStates, InState, InPreviousStates, ServerReply) :- ( ClientRequest = end_of_file ; ClientRequest = disconnect ), !, ServerReply = disconnect. server_input(ClientRequest, InState, InPreviousStates, InState, InPreviousStates, ServerReply) :- ClientRequest = client_shutdown, !, ServerReply = thread_shutdown. server_input(ClientRequest, InState, InPreviousStates, InState, InPreviousStates, ServerReply) :- ServerReply = unknown_request(ClientRequest), call_if_debug_level_at_least(2, format('Unknown client request: ~w~n', [ClientRequest])). %---------------------------------------------------------------------------------- server_reply(client_shutdown, _ServerOut) :- call_if_debug_level_at_least(1, format('Server: end of file.~n', [])), !. % The response to the "get_message_mode" message is always sent as Prolog. server_reply(ServerReply, ServerOut) :- ServerReply = message_mode(_Mode), format(ServerOut, '~q.~n', [ServerReply]), flush_output(ServerOut), !. server_reply(ServerReply, ServerOut) :- ( ( ServerReply = xml_message(String), is_list_of_non_negative_integers(String) ) -> quote_layout_chars_in_string(String, String1), format(ServerOut, 'xml_message("~s").~n', [String1]), log_dialogue_string_message('SENT XML', xml_message, String1) ; ( ServerReply = json_message(String), is_list_of_non_negative_integers(String) ) -> quote_layout_chars_in_string(String, String1), format(ServerOut, 'json_message("~s").~n', [String1]), log_dialogue_string_message('SENT JSON', json_message, String1) ; ( get_message_mode(pure_json), ServerReply = String, is_list_of_non_negative_integers(String) ) -> format(ServerOut, '~s~n', [String]), log_dialogue_string_message('SENT JSON', json_message, String) ; otherwise -> format(ServerOut, '~q.~n', [ServerReply]) ), flush_output(ServerOut). %---------------------------------------------------------------------------------- handle_restart_server(CFGFile, CommandsAsAtoms, InitParameter, NewState, NewPreviousStates, Response) :- on_exception( Exception, handle_restart_server1(CFGFile, CommandsAsAtoms, InitParameter, NewState, NewPreviousStates, Response), handle_exception_in_restart_server(Exception, CFGFile, CommandsAsAtoms, InitParameter) ), !. handle_restart_server(CFGFile, CommandsAsAtoms, InitParameter, _NewState, _NewPreviousStates, _Response) :- call_if_debug_level_at_least(2, format('~N~n*** Unable to restart server due to internal error ***~n~n', [])), call_if_debug_level_at_least(2, format('~N~n*** CFGFile = ~w, commands = ~w, init parameter = ~w ***~n~n', [CFGFile, CommandsAsAtoms, InitParameter])), !, fail. handle_exception_in_restart_server(Exception, CFGFile, CommandsAsAtoms, InitParameter) :- call_if_debug_level_at_least(2, format('~N~n*** Unable to restart server due to exception ***~n~n', [])), call_if_debug_level_at_least(2, format('~N~n*** CFGFile = ~w, commands = ~w, init parameter = ~w ***~n~n', [CFGFile, CommandsAsAtoms, InitParameter])), print_message(error, Exception), fail. handle_restart_server1(CFGFile, CommandsAsAtoms, InitParameter, InitialState, InitialPreviousStates, Response) :- ( atom(CFGFile) -> true ; format('~N*** Error: CFG file "~w" in restart message is not an atom~n', [CFGFile]), fail ), unpack_list_of_command_atoms(CommandsAsAtoms, Commands), set_current_config_file(CFGFile), init_server(CFGFile, Commands), init_dm(InitParameter, InitialState), InitialPreviousStates = [], Response = ok. unpack_list_of_command_atoms([], []). unpack_list_of_command_atoms([F | R], [F1 | R1]) :- unpack_command_atom(F, F1), !, unpack_list_of_command_atoms(R, R1). unpack_command_atom(Atom, _String) :- \+ atom(Atom), !, format('~N*** Error: command "~w" in restart message is not an atom~n', [Atom]), fail. unpack_command_atom(Atom, String) :- atom(Atom), atom_codes(Atom, String), !. %---------------------------------------------------------------------------------- handle_action_request(Request, InState, InPreviousStates, NextState, NextPreviousStates, Response) :- on_exception( Exception, handle_action_request1(Request, InState, InPreviousStates, NextState, NextPreviousStates, Response), handle_exception_in_action_request(Exception, InState, InPreviousStates, NextState, NextPreviousStates, Response) ), !. handle_action_request(_Request, InState, InPreviousStates, InState, InPreviousStates, error) :- call_if_debug_level_at_least(2, format('~N~n*** Processing aborted due to internal error ***~n~n', [])), !. handle_exception_in_action_request(Exception, InState, InPreviousStates, NextState, NextPreviousStates, Response) :- Response = error, InState = NextState, InPreviousStates = NextPreviousStates, call_if_debug_level_at_least(2, format('~N~n*** Processing aborted due to internal exception ***~n~n', [])), print_message(error, Exception). %---------------------------------------------------------------------------------- handle_action_request1(ClientRequest, InState, InPreviousStates, OutState, OutPreviousStates, Action) :- ClientRequest =.. [action_sequence | ClientRequests], %trace, handle_action_request1_list(ClientRequests, InState, InPreviousStates, OutState, OutPreviousStates, Actions), Action =.. [action_sequence | Actions], !. handle_action_request1(log(_AnyStructure), InState, InPreviousStates, OutState, OutPreviousStates, Action) :- OutState = InState, OutPreviousStates = InPreviousStates, Action = ok, !. handle_action_request1(set_session(Id), InState, InPreviousStates, OutState, OutPreviousStates, Action) :- get_current_session(Id), OutState = InState, OutPreviousStates = InPreviousStates, Action = ok, !. % Discard the set of previous states when we switch to a new user - it'll be too expensive to store them. handle_action_request1(set_session(NewId), InState, _InPreviousStates, OutState, OutPreviousStates, Action) :- get_current_session(OldId), save_dialogue_state(OldId, InState), get_dialogue_state(NewId, OutState), set_current_session(NewId), OutPreviousStates = [], Action = ok, !. handle_action_request1(process_xml_message(XMLAtom), InState, InPreviousStates, OutState, OutPreviousStates, Action) :- atom_codes(XMLAtom, String), ( using_strcat_semantics -> parse_xml_rec_result(String, keep_sem_strcat, NBestList) ; otherwise -> parse_xml_rec_result(String, discard_sem, NBestList) ), handle_action_request1(process_nbest_list(NBestList), InState, InPreviousStates, OutState, OutPreviousStates, Action), !. handle_action_request1(get_current_recognition_grammar, InState, InPreviousStates, InState, InPreviousStates, Action) :- ( safe_get_recognition_grammar_from_state(InState, Grammar) -> Action = grammar(Grammar) ; otherwise -> Action = error ), !. handle_action_request1(process_nbest_list(_Wavfile, NBestList), InState, InPreviousStates, OutState, [InState | InPreviousStates], Action) :- process_nbest_recogniser_output(NBestList, InState, OutState, Action), !. handle_action_request1(process_nbest_list(NBestList), InState, InPreviousStates, OutState, [InState | InPreviousStates], Action) :- process_nbest_recogniser_output(NBestList, InState, OutState, Action), !. handle_action_request1(process_rec_string(_Wavfile, Words), InState, InPreviousStates, OutState, [InState | InPreviousStates], Action) :- process_recogniser_output(Words, InState, OutState, Action), !. handle_action_request1(process_rec_string(Words), InState, InPreviousStates, OutState, [InState | InPreviousStates], Action) :- process_recogniser_output(Words, InState, OutState, Action), !. handle_action_request1(robust_process_string(Words), InState, InPreviousStates, OutState, [InState | InPreviousStates], Action) :- robust_process_string(Words, InState, OutState, Action), !. handle_action_request1(restart_recognition_processes, InState, InPreviousStates, InState, InPreviousStates, Action) :- try_to_restart_recognition_processes_in_state(Action, InState), !. handle_action_request1(recompile_system, InState, InPreviousStates, InState, InPreviousStates, Action) :- try_to_recompile_system(InState, Action), !. handle_action_request1(reload_system, InState, InPreviousStates, InState, InPreviousStates, Action) :- try_to_reload_system(InState, Action), !. handle_action_request1(get_debug_level, InState, InPreviousStates, InState, InPreviousStates, Action) :- try_to_get_debug_level(Action), !. handle_action_request1(set_debug_level(Level), InState, InPreviousStates, InState, InPreviousStates, Action) :- try_to_set_debug_level(Level, Action), !. handle_action_request1(recognise_and_dialogue_process, InState, InPreviousStates, OutState, [InState | InPreviousStates], Action) :- recognise_and_process_recogniser_one_best_or_nbest_output(live, default, InState, OutState, Action), !. handle_action_request1(recognise_and_dialogue_process_from_wavfile(Wavfile), InState, InPreviousStates, OutState, [InState | InPreviousStates], Action) :- recognise_and_process_recogniser_one_best_or_nbest_output(wavfile(Wavfile), default, InState, OutState, Action), !. handle_action_request1(slm_recognise_and_dialogue_process, InState, InPreviousStates, OutState, [InState | InPreviousStates], Action) :- recognise_and_process_recogniser_one_best_or_nbest_output(live, slm, InState, OutState, Action), !. handle_action_request1(slm_recognise_and_dialogue_process_from_wavfile(Wavfile), InState, InPreviousStates, OutState, [InState | InPreviousStates], Action) :- recognise_and_process_recogniser_one_best_or_nbest_output(wavfile(Wavfile), slm, InState, OutState, Action), !. handle_action_request1(get_most_recent_recorded_wavfile, InState, InPreviousStates, OutState, InPreviousStates, Action) :- get_most_recent_recorded_wavfile(Action), InState = OutState, !. handle_action_request1(play_wavfile(Wavfile), InState, InPreviousStates, OutState, InPreviousStates, Action) :- play_wavfile(Wavfile), InState = OutState, Action = ok, !. handle_action_request1(tts(Atom), InState, InPreviousStates, OutState, InPreviousStates, Action) :- perform_tts(Atom), InState = OutState, Action = ok, !. handle_action_request1(process_non_speech_input(AtomOrTerm), InState, InPreviousStates, OutState, [InState | InPreviousStates], Action) :- process_non_speech_input(AtomOrTerm, InState, OutState, Action), !. handle_action_request1(get_help_examples(Words, NExamples), InState, InPreviousStates, InState, InPreviousStates, Response) :- process_help_request(Words, NExamples, Response), !. handle_action_request1(return_to_initial_context, InState, _InPreviousStates, OutState, [], Response) :- process_return_to_initial_dialogue(InState, OutState, Response), !. handle_action_request1(revert_discourse_context, _InState, [LastState | PreviousStates], LastState, PreviousStates, ok) :- !. handle_action_request1(revert_discourse_context, _InState, [], _NextState, _NextPreviousStates, _Response) :- !, format('~N*** Error: no previous state to revert to~n', []), fail. handle_action_request1(set_notional_time(Timestamp), InState, InPreviousStates, InState, InPreviousStates, ok) :- atom_codes(Timestamp, TimeChars), ( parse_datime(TimeChars, Datime) -> set_notional_time(Datime) ; format('~NUnable to parse time "~w". Format = YYYY-MM-DD_HH-MM-SS, e.g. 2006-12-31_23-59-59~n', [Timestamp]), fail ), !. handle_action_request1(execute_regulus_command(CommandString), InState, InPreviousStates, InState, InPreviousStates, ok) :- get_current_config_file(ConfigFile), regulus_batch(ConfigFile, [CommandString]), !. handle_action_request1(xml_messages, InState, InPreviousStates, InState, InPreviousStates, ok) :- set_message_mode(xml), !. handle_action_request1(json_messages, InState, InPreviousStates, InState, InPreviousStates, ok) :- set_message_mode(json), !. handle_action_request1(pure_json_messages, InState, InPreviousStates, InState, InPreviousStates, ok) :- set_message_mode(pure_json), !. handle_action_request1(prolog_messages, InState, InPreviousStates, InState, InPreviousStates, ok) :- set_message_mode(prolog), !. handle_action_request1(concrete_actions, InState, InPreviousStates, InState, InPreviousStates, ok) :- set_action_mode(concrete), !. handle_action_request1(abstract_actions, InState, InPreviousStates, InState, InPreviousStates, ok) :- set_action_mode(abstract), !. %---------------------------------------------------------------------------------- handle_action_request1_list([], InState, InPreviousStates, OutState, OutPreviousStates, Action) :- InState = OutState, InPreviousStates = OutPreviousStates, Action = [], !. handle_action_request1_list([F | R], InState, InPreviousStates, OutState, OutPreviousStates, [F1 | R1]) :- handle_action_request1(F, InState, InPreviousStates, NextState, NextPreviousStates, F1), !, handle_action_request1_list(R, NextState, NextPreviousStates, OutState, OutPreviousStates, R1). %---------------------------------------------------------------------------------- process_non_speech_input(AtomOrTerm, InState, OutState, Response) :- ( ( atom(AtomOrTerm), atom_codes(AtomOrTerm, Chars), interpret_string_as_raw_lf_input(Chars, LF) ) -> true ; otherwise -> LF = AtomOrTerm ), print_timing_info_if_bug_level_at_least(5, dialogue_process_lf(LF, InState, OutState, Record), 'dialogue processing (non-recognition)'), get_concrete_or_abstract_action_from_record(Record, Action), Response = [action=Action], call_if_debug_level_at_least(3, print_dialogue_processing_record(user, Record)), !. process_non_speech_input(RecogniserOutput, InState, OutState, FinalResponse) :- call_if_debug_level_at_least(2, format('~N~nUnable to process non-speech input: ~w~n~n', [RecogniserOutput])), Response = [action=tts('Sorry, something went wrong')], maybe_postprocess_response(Response, FinalResponse), InState = OutState, !. process_recogniser_output(Atom, InState, OutState, FinalResponse) :- dialogue_process_utterance(Atom, InState, OutState, Record), get_concrete_or_abstract_action_from_record(Record, Action), call_if_debug_level_at_least(3, print_dialogue_processing_record(user, Record)), recognition_result_atom_to_selected_recognition_result_alist(Atom, Selected), ( member(paraphrase=[Paraphrase, _Judgement], Record) -> append(Selected, [action=Action, paraphrase=Paraphrase], Response) ; otherwise -> append(Selected, [action=Action], Response) ), maybe_postprocess_response(Response, FinalResponse), !. process_recogniser_output(RecogniserOutput, InState, OutState, FinalResponse) :- call_if_debug_level_at_least(2, format('~N~nUnable to process recogniser output: ~w~n~n', [RecogniserOutput])), Response = [action=tts('Sorry, something went wrong')], maybe_postprocess_response(Response, FinalResponse), InState = OutState, !. robust_process_string(Atom, InState, OutState, FinalResponse) :- get_help_matches_with_lf(Atom, 1, Matches, Traces), Matches = [[MatchedSent, Move]], Traces = [RobustMatchScore-Details], \+ help_trace_shows_trivial_matching(RobustMatchScore-Details), dialogue_process_sent_and_dialogue_move(MatchedSent, Move, InState, OutState, Record), get_concrete_or_abstract_action_from_record(Record, Action), call_if_debug_level_at_least(3, print_dialogue_processing_record(user, Record)), recognition_result_atom_to_selected_recognition_result_alist(MatchedSent, Selected), ( member(paraphrase=[Paraphrase, _Judgement], Record) -> append(Selected, [action=Action, paraphrase=Paraphrase], Response) ; otherwise -> append(Selected, [action=Action], Response) ), maybe_postprocess_response(Response, FinalResponse), !. robust_process_string(Atom, InState, OutState, FinalResponse) :- call_if_debug_level_at_least(2, format('~N~nUnable to do robust processing on: ~w~n~n', [Atom])), Response = [action=tts('Sorry, something went wrong')], maybe_postprocess_response(Response, FinalResponse), InState = OutState, !. process_nbest_recogniser_output(NBestList, InState, OutState, FinalResponse) :- dialogue_process_nbest_list(NBestList, InState, OutState, Record, RankOfChosenElement), safe_nth(RankOfChosenElement, NBestList, nbest_hyp(_, SelectedSentOrSentAndLF)), possibly_extract_sent_from_sent_and_lf(SelectedSentOrSentAndLF, SelectedSent), get_concrete_or_abstract_action_from_record(Record, Action), call_if_debug_level_at_least(3, print_dialogue_processing_record(user, Record)), recognition_result_atom_to_selected_recognition_result_alist(SelectedSent, Selected), ( member(paraphrase=[Paraphrase, _Judgement], Record) -> append(Selected, [action=Action, paraphrase=Paraphrase], Response) ; otherwise -> append(Selected, [action=Action], Response) ), maybe_postprocess_response(Response, FinalResponse), !. process_nbest_recogniser_output(NBestList, InState, OutState, FinalResponse) :- call_if_debug_level_at_least(2, format('~N~nUnable to process N-best recogniser output:~n~n', [])), call_if_debug_level_at_least(2, prettyprint(NBestList)), call_if_debug_level_at_least(2, format('~n~n', [])), Response = [action=tts('Sorry, something went wrong')], maybe_postprocess_response(Response, FinalResponse), InState = OutState, !. recognition_result_atom_to_selected_recognition_result_alist(Atom, Selected) :- ( % user:atom_to_original_script_and_gloss(Atom, OriginalScriptAtom, GlossAtom) -> % ( fix_recognition_orthography_on_atom(Atom, CleanedUpAtom) -> % Selected = [selected=CleanedUpAtom, selected_original_script=OriginalScriptAtom, selected_gloss=GlossAtom] % ; % otherwise -> % Selected = [selected=Atom, selected_original_script=OriginalScriptAtom, selected_gloss=GlossAtom] % ) % ; user:atom_to_original_script(Atom, OriginalScriptAtom) -> Selected = [selected=OriginalScriptAtom] ; fix_recognition_orthography_on_atom(Atom, CleanedUpAtom) -> Selected = [selected=CleanedUpAtom] ; otherwise -> Selected = [selected=Atom] ). postprocessing_is_defined :- current_predicate(_Package:postprocess_dialogue_server_response/2), !. maybe_postprocess_response(Response, FinalResponse) :- postprocessing_is_defined, !, ( user:postprocess_dialogue_server_response(Response, FinalResponse) -> call_if_debug_level_at_least(5, format('~N~nPostprocessed output: ~w~n', [FinalResponse])) ; otherwise -> format('~N*** Error: bad call: ~w~n', [user:postprocess_dialogue_server_response(Response, FinalResponse)]), fail ), !. maybe_postprocess_response(Response, Response). possibly_extract_sent_from_sent_and_lf(Sent, Sent) :- atom(Sent), !. possibly_extract_sent_from_sent_and_lf(string_and_lf(RecStringAtom, _LF), RecStringAtom) :- !. possibly_extract_sent_from_sent_and_lf(X, Y) :- format('~N*** Error: bad call: ~w~n~n', [possibly_extract_sent_from_sent_and_lf(X, Y)]), fail. get_most_recent_recorded_wavfile(_Action) :- \+ recognition_is_loaded, !, call_if_debug_level_at_least(2, format('~N~nRecognition resources are not loaded: unable to get most recent recorded wavfile~n~n', [])), fail. get_most_recent_recorded_wavfile(AbsWavfile) :- regulus_sockettalk_get_parameter('client.FilenameRecorded', Wavfile), absolute_file_name(Wavfile, AbsWavfile), !. get_most_recent_recorded_wavfile(AbsWavfile) :- format('~N*** Warning: bad call: ~w~n~n', [get_most_recent_recorded_wavfile(AbsWavfile)]). play_wavfile(_Play) :- \+ recognition_is_loaded, !, call_if_debug_level_at_least(2, format('~N~nRecognition resources are not loaded: unable to play wavfile~n~n', [])), fail. play_wavfile(Wavfile) :- recognition_is_loaded, safe_absolute_file_name(Wavfile, AbsWavfile), regulus_sockettalk_say_list_atom(AbsWavfile), !. play_wavfile(Wavfile) :- format('~N*** Warning: bad call: ~w~n~n', [play_wavfile(Wavfile)]), fail. perform_tts(_AtomOrString) :- ( \+ recognition_is_loaded ; \+ tts_is_loaded ), !, call_if_debug_level_at_least(2, format('~N~nTTS resources are not loaded: unable to do TTS~n~n', [])), fail. perform_tts(AtomOrString) :- ( atomic(AtomOrString) -> atom_codes(AtomOrString, String) ; is_prolog_string(AtomOrString) -> AtomOrString = String ), recognition_is_loaded, tts_is_loaded, regulus_sockettalk_say_tts(String), !. perform_tts(AtomOrString) :- format('~N*** Warning: bad call: ~w~n~n', [perform_tts(AtomOrString)]), fail. %--------------------------------------------------------------- try_to_get_debug_level(Action) :- get_dialogue_server_debug_level(DebugLevel) -> Action = debug_level(DebugLevel), !. try_to_set_debug_level(Level, Action) :- ( valid_debug_level(Level) -> set_dialogue_server_debug_level(Level), Action = ok ; otherwise -> format('~N*** Warning: invalid debug level: ~w~n~n', [Level]), Action = error ). %--------------------------------------------------------------- try_to_restart_recognition_processes_in_state(Action, State) :- safe_check_user_is_administrator_in_state(State), restart_recognition_resources(Action), !. try_to_restart_recognition_processes_in_state(Action, _State) :- Action = error. try_to_recompile_system(InState, Action) :- user:regulus_config(recompile_tag, Tag), current_predicate(user:recompile_system/2), !, safe_call_saving_output(( set_current_dialogue_state(InState), user:recompile_system(Tag, CompileStatus) ), ExecuteStatus, OutputAtomList), ( ( ExecuteStatus = ok, CompileStatus = ok ) -> Status = ok ; otherwise -> Status = error ), Action = recompiled(Status, OutputAtomList), !. try_to_recompile_system(_InState, Action) :- Action = recompiled(action_undefined, []), !. try_to_reload_system(InState, Action) :- user:regulus_config(reload_tag, Tag), current_predicate(user:reload_system/1), !, safe_call_saving_output(( set_current_dialogue_state(InState), user:reload_system(Tag) ), Status, OutputAtomList), Action = reloaded(Status, OutputAtomList), !. try_to_reload_system(_InState, Action) :- Action = reloaded(action_undefined, []), !. %--------------------------------------------------------------- recognise_and_process_recogniser_one_best_or_nbest_output(RecSource, InState, OutState, Action) :- recognise_and_process_recogniser_one_best_or_nbest_output(RecSource, default, InState, OutState, Action). recognise_and_process_recogniser_one_best_or_nbest_output(_RecSource, _RecType, _InState, _OutState, _Action) :- \+ recognition_is_loaded, !, call_if_debug_level_at_least(2, format('~N~nRecognition resources are not loaded: unable to perform recognition~n~n', [])), fail. recognise_and_process_recogniser_one_best_or_nbest_output(RecSource, RecType, InState, OutState, Action) :- ( RecSource = live -> ( RecType = slm -> print_timing_info_if_bug_level_at_least(5, recognise_slm_as_defined_by_config_file(Recognised), recognition) ; safe_get_recognition_grammar_from_state(InState, Grammar) -> print_timing_info_if_bug_level_at_least(5, recognise_as_defined_by_config_file(Grammar, Recognised), recognition) ; otherwise -> print_timing_info_if_bug_level_at_least(5, recognise_as_defined_by_config_file(Recognised), recognition) ) ; RecSource = wavfile(Wavfile) -> ( RecType = slm -> print_timing_info_if_bug_level_at_least(5, recognise_slm_from_wavfile_as_defined_by_config_file(Wavfile, Recognised), recognition) ; safe_get_recognition_grammar_from_state(InState, Grammar) -> print_timing_info_if_bug_level_at_least(5, recognise_from_wavfile_as_defined_by_config_file(Grammar, Wavfile, Recognised), recognition) ; otherwise -> print_timing_info_if_bug_level_at_least(5, recognise_from_wavfile_as_defined_by_config_file(Wavfile, Recognised), recognition) ) ; otherwise -> call_if_debug_level_at_least(2, format('~N*** Error: unknown recognition source ~w in recognise_and_process_recogniser_one_best_or_nbest_output/4~n', [RecSource])), fail ), postprocess_recognition_result(Recognised, RecType, Recognised1), call_if_debug_level_at_least(2, format('~N~nProcessing recognition result:~n~n', [])), call_if_debug_level_at_least(2, prettyprint(Recognised1)), call_if_debug_level_at_least(2, format('~N~n', [])), ( Recognised1 = dummy -> Action = [action=dummy], InState = OutState ; RecType = slm -> print_timing_info_if_bug_level_at_least(5, dialogue_process_lf(Recognised1, InState, OutState, Record), 'dialogue processing (SLM recognition)'), get_concrete_or_abstract_action_from_record(Record, Action0), Action = [action=Action0], call_if_debug_level_at_least(3, print_dialogue_processing_record(user, Record)) ; otherwise -> print_timing_info_if_bug_level_at_least(5, recognise_and_process_recogniser_one_best_or_nbest_output1(Recognised1, InState, OutState, Action), 'dialogue processing (recognition)') ), !. recognise_and_process_recogniser_one_best_or_nbest_output(_RecSource, _RecType, InState, OutState, FinalResponse) :- call_if_debug_level_at_least(2, format('~N~nInternal error in recognition processing~n~n', [])), Response = [action=tts('Sorry, something went wrong')], maybe_postprocess_response(Response, FinalResponse), InState = OutState, !. % Treat recognition failure as the text input 'nothing_recognised' %recognise_and_process_recogniser_one_best_or_nbest_output1(Recognised1, InState, OutState, FinalResponse) :- % Recognised1 = recognition_failed, % Response = [action=tts('I couldn\'t recognise anything at all')], % maybe_postprocess_response(Response, FinalResponse), % InState = OutState, % !. recognise_and_process_recogniser_one_best_or_nbest_output1(Recognised1, InState, OutState, Action) :- atom(Recognised1), process_recogniser_output(Recognised1, InState, OutState, Action), !. recognise_and_process_recogniser_one_best_or_nbest_output1(Recognised1, InState, OutState, Action) :- is_list(Recognised1), process_nbest_recogniser_output(Recognised1, InState, OutState, Action), !. recognise_and_process_recogniser_one_best_or_nbest_output1(Recognised1, InState, OutState, Action) :- format('~N*** Error: bad call: ~w~n', [recognise_and_process_recogniser_one_best_or_nbest_output1(Recognised1, InState, OutState, Action)]), fail. safe_get_recognition_grammar_from_state(State, Grammar) :- current_predicate(user:get_recognition_grammar_from_state/2), user:get_recognition_grammar_from_state(State, Grammar), atom(Grammar), !. safe_check_user_is_administrator_in_state(State) :- current_predicate(user:check_user_is_administrator_in_state/1), user:check_user_is_administrator_in_state(State), !. % Help response is of the form help() % where consists of the help responses joined together with newline characters. process_help_request(Sent, NExamples, Response) :- get_help_matches(Sent, NExamples, Matches), package_matches_into_string(Matches, ""-MatchesString), atom_codes(MatchesAtom, MatchesString), Response = help(MatchesAtom). process_return_to_initial_dialogue(_InState, OutState, Response) :- initial_dialogue_state(OutState), Response = ok, !. process_return_to_initial_dialogue(InState, OutState, Response) :- OutState = InState, Response = error, !. %=========================================================== postprocess_recognition_result(Rec, RecType, Rec2) :- postprocess_recognition_result1(Rec, Rec1), postprocess_recognition_result2(Rec1, RecType, Rec2), !. postprocess_recognition_result(Rec, RecType, Rec1) :- format('~N*** Error: bad call: ~w~n', [postprocess_recognition_result(Rec, RecType, Rec1)]), fail. postprocess_recognition_result1(dummy, dummy) :- !. postprocess_recognition_result1(recognition_failed(_), nothing_recognised) :- !. postprocess_recognition_result1(recognition_succeeded(_Conf, Atom, _LF), Atom) :- atom(Atom), !. postprocess_recognition_result1(recognition_succeeded(List), List1) :- is_list(List), format_nbest_list_for_dialogue_server(List, List1), !. postprocess_recognition_result2(dummy, _Type, dummy) :- !. postprocess_recognition_result2(Rec, default, Rec) :- !. postprocess_recognition_result2(SingleHyp, slm, slm_result(SingleHyp)) :- atom(SingleHyp). postprocess_recognition_result2(List, slm, slm_result(TopHyp)) :- is_list(List), List = [nbest_hyp(_Confidence, TopHyp) | _Rest], !. % Nbest list is list of elements of form rec_result(Confidence, Words, [value=LF]) format_nbest_list_for_dialogue_server([], []) :- !. format_nbest_list_for_dialogue_server([F | R], [F1 | R1]) :- format_nbest_list_element_for_dialogue_server(F, F1), !, format_nbest_list_for_dialogue_server(R, R1). format_nbest_list_for_dialogue_server(NBestList, NBestList1) :- format('~N*** Error: bad call: ~w~n', [format_nbest_list_for_dialogue_server(NBestList, NBestList1)]), fail. format_nbest_list_element_for_dialogue_server(rec_result(Confidence, Words, _NLResult), nbest_hyp(Confidence, Words)) :- !. format_nbest_list_element_for_dialogue_server(F, F1) :- format('~N*** Error: bad call: ~w~n', [format_nbest_list_element_for_dialogue_server(F, F1)]), fail. %=========================================================== package_matches_into_string([], String-String) :- !. package_matches_into_string([Match], StringIn-StringOut) :- atom_codes(Match, String), append(StringIn, String, StringOut), !. package_matches_into_string([F | R], StringIn-StringOut) :- atom_codes(F, String), append_list([StringIn, String, "\n"], StringNext), !, package_matches_into_string(R, StringNext-StringOut). %=========================================================== start_new_dialogue_session_logfile(LogfileDir) :- start_new_dialogue_session_logfile(LogfileDir, _Logfile). start_new_dialogue_session_logfile(LogfileDir, Logfile) :- start_new_prolog_format_logfile(LogfileDir, dialogue_event, Logfile). log_dialogue_string_message(Mode, Wrapper, String) :- log_string_event(Mode, Wrapper, String). log_dialogue_event(Term) :- log_event_in_prolog_format(Term, dialogue_event). %=========================================================== :- dynamic message_mode/1. set_message_mode(Mode) :- valid_message_mode(Mode), retractall(message_mode(_)), assertz(message_mode(Mode)), !. set_message_mode(Mode) :- format('~N*** Error: bad call: ~w~n', [set_message_mode(Mode)]), fail. get_message_mode(Mode) :- ( message_mode(Mode0) -> Mode = Mode0 ; Mode = prolog ). valid_message_mode(xml). valid_message_mode(json). valid_message_mode(pure_json). valid_message_mode(prolog). %=========================================================== :- dynamic saved_dialogue_state/2. :- dynamic current_sessionid/1. init_saved_dialogue_state :- retractall(saved_dialogue_state(_, _)), retractall(current_sessionid(_)), format('--- Initialised saved dialogue state table~n', []). save_dialogue_state(SessionId, State) :- retractall(saved_dialogue_state(SessionId, _)), assertz(saved_dialogue_state(SessionId, State)), !. get_dialogue_state(SessionId, State) :- saved_dialogue_state(SessionId, State), !. get_dialogue_state(_SessionId, State) :- saved_dialogue_state(default, State), !. get_dialogue_state(SessionId, State) :- format('~N*** Error: bad call: ~w~n', [get_dialogue_state(SessionId, State)]), fail. get_current_session(SessionId) :- current_sessionid(SessionId), !. get_current_session(SessionId) :- SessionId = default_session. set_current_session(SessionId) :- retractall(current_sessionid(_)), assertz(current_sessionid(SessionId)), !. set_current_session(SessionId) :- format('~N*** Error: bad call: ~w~n', [set_current_session(SessionId)]), fail. %=========================================================== :- dynamic action_mode/1. set_action_mode(Mode) :- valid_action_mode(Mode), retractall(action_mode(_)), assertz(action_mode(Mode)), !. set_action_mode(Mode) :- format('~N*** Error: bad call: ~w~n', [set_action_mode(Mode)]), fail. get_action_mode(Mode) :- ( action_mode(Mode0) -> Mode = Mode0 ; Mode = concrete ). valid_action_mode(concrete). valid_action_mode(abstract). %---------------------------------------------------------------------------------- get_concrete_or_abstract_action_from_record(Record, Action) :- get_action_mode(concrete), member(action=[Action, _Judgement], Record), !. get_concrete_or_abstract_action_from_record(Record, Action) :- get_action_mode(abstract), member(abstract_action_and_out_state=[Action, _OutState, _Judgement], Record), !. %---------------------------------------------------------------------------------- :- dynamic last_server_restart_tag/1. set_last_server_restart_tag(RestartTag) :- retractall(last_server_restart_tag(_)), assertz(last_server_restart_tag(RestartTag)), !. get_last_server_restart_tag(RestartTag) :- last_server_restart_tag(RestartTag), !. %---------------------------------------------------------------------------------- print_long_string :- append_n_copies(25, ['"a"'], X), append_n_copies(100, [X], Y), format('~N', []), prettyprint(Y), format('~N', []). %