%-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% % % File: eliza.m. % Main author: bromage. % % This source file is hereby placed in the public domain. -bromage. % % Eliza, the famous psychotherapist. % %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- module eliza. :- interface. :- import_module io. :- pred main(io::di, io::uo) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module assoc_list. :- import_module bool. :- import_module char. :- import_module list. :- import_module map. :- import_module maybe. :- import_module pair. :- import_module string. :- import_module require. %-----------------------------------------------------------------------------% % Print the opening banner, initialise the response state, run the main % loop. % main(!IO) :- io.write_string("\nHi! I'm Eliza. Please tell me your problem.\n", !IO), initial_state(State), main_loop([], State, !IO), io.write_string("\nGoodbye.\n", !IO). :- pred main_loop(list(string)::in, eliza_state::in, io::di, io::uo) is det. main_loop(Prev, StateIn, !IO) :- eliza.read_line(MaybeLine, !IO), ( MaybeLine = yes(Line0), parse(Line0, Line1), ( Line1 = [], main_loop(Prev, StateIn, !IO) ; Line1 = [_ | _], ( if Line1 = Prev then generate_repeat(StateIn, StateOut, !IO) else generate_response(Line1, StateIn, StateOut, !IO) ), main_loop(Line1, StateOut, !IO) ) ; MaybeLine = no ). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% % Response state processing functions % The response state consists of two parts: a set of % (type - messages) pairs and a list of repeat messages. % The response messages are used in response to a context, % and the repeat messages are used in response to a repeated % input line. :- type response_state == assoc_list(message_type, list(message)). :- type repeat_state == list(string). :- type eliza_state ---> state(response_state, repeat_state). % Initialise the state by reading in the initial message % database. % :- pred initial_state(eliza_state::out) is det. initial_state(state(ResMsg,RepMsg)) :- repeat_messages(RepMsg), response_messages(ResMsg). % Get a repeat message, and then cycle the list so that % a new one will come up next time. % :- pred get_repeat(string::out, eliza_state::in, eliza_state::out) is det. get_repeat(MsgOut, state(Res, RepIn), state(Res, RepOut)) :- ( RepIn = [Msg | Rest], MsgOut = Msg, list.append(Rest, [Msg], RepOut) ; RepIn = [], error("Error: No repeat messages.\n") ). % Get a response message, and then cycle the list so that % a new one will come up next time. % :- pred get_response(message_type::in, message::out, eliza_state::in, eliza_state::out) is det. get_response(Type, MsgOut, state(ResIn, Rep), state(ResOut, Rep)) :- get_response2(Type, MsgOut, ResIn, ResOut). :- pred get_response2(message_type::in, message::out, response_state::in, response_state::out) is det. get_response2(_Type, _MsgOut, [], []) :- error("Error: Cannot match message type.\n"). get_response2(Type, MsgOut, [Type2 - Msgs2 | RestIn], [Type2 - Msgs3 | RestOut]) :- ( if Type = Type2 then ( if Msgs2 = [MsgOut1 | MsgOutRest] then MsgOut = MsgOut1, RestOut = RestIn, list.append(MsgOutRest, [MsgOut], Msgs3) else error("Error: Empty response list.\n") ) else Msgs2 = Msgs3, get_response2(Type, MsgOut, RestIn, RestOut) ). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% % Write a prompt, then read a line. % :- pred read_line(maybe(list(char))::out, io::di, io::uo) is det. read_line(MaybeLine, !IO) :- io.write_string("\n> ", !IO), io.flush_output(!IO), io.input_stream(Stdin, !IO), io.read_line(Stdin, Result, !IO), io.write_string("\n", !IO), ( Result = ok(Line1), MaybeLine = yes(Line1) ; ( Result = eof ; Result = error(_) ), MaybeLine = no ). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% % These are the characters that we must strip from a line during parsing. % :- pred is_punct(char::in) is semidet. is_punct('.'). is_punct(','). is_punct('!'). is_punct('?'). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% % Parse the input string into words. This is % achieved in three phases: % % - Strip leading whitespace and intermediate % punctuation symbols. % % - Turn the resulting line into a list of words (each % word stored as a list of characters). % % - Turn each word into a string. % :- pred parse(list(char)::in, list(string)::out) is det. parse --> strip, form_words, words_to_strings. :- pred strip(list(char)::in, list(char)::out) is det. strip([], []). strip([X | Xs], Ys) :- ( if char.is_whitespace(X) then strip(Xs, Ys) else strip2([X | Xs], Ys) ). :- pred strip2(list(char)::in, list(char)::out) is det. strip2([], []). strip2([X | Xs], Ys) :- ( if is_punct(X) then strip2([' ' | Xs], Ys) else strip2(Xs, Ys1), ( if char.is_whitespace(X), Ys1 = [] then Ys = [] else Ys = [X | Ys1] ) ). :- pred form_words(list(char)::in, list(list(char))::out) is det. form_words([], []). form_words([X | Xs], Ys) :- ( if char.is_whitespace(X) then form_words(Xs, Ys) else form_word(Xs, [X], Word, Rest), form_words(Rest, Words), Ys = [Word | Words] ). :- pred form_word(list(char)::in, list(char)::in, list(char)::out, list(char)::out) is det. form_word([], Word1, Word2, []) :- list.reverse(Word1, Word2). form_word([X | Xs], WordIn, WordOut, Rest) :- ( if char.is_whitespace(X) then list.reverse(WordIn, WordOut), Rest = Xs else form_word(Xs, [X | WordIn], WordOut, Rest) ). :- pred words_to_strings(list(list(char))::in, list(string)::out) is det. words_to_strings([], []). words_to_strings([X | Xs], [Y | Ys]) :- string.from_char_list(X, Y), words_to_strings(Xs, Ys). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% % Generate and display a repeat message % :- pred generate_repeat(eliza_state::in, eliza_state::out, io::di, io::uo) is det. generate_repeat(!State, !IO) :- get_repeat(Msg, !State), io.write_string(Msg, !IO), io.write_string("\n", !IO). % Generate and display a repeat message % :- pred generate_response(list(string)::in, eliza_state::in, eliza_state::out, io::di, io::uo) is det. generate_response(Words, !State, !IO) :- % Find out what sort of message we are dealing with. find_handle(Words, MsgType, Rest), get_response(MsgType, Maybe - String, !State), io.write_string(String, !IO), % If we must parrot back part of the original message, % resolve conjugates, write that string and then add % a trailing punctuation mark. ( Maybe = yes(C), perform_conjugate(Rest, Postfix), eliza_write_strings(Postfix, !IO), io.write_char(C, !IO) ; Maybe = no ), io.write_string("\n", !IO). % Write a list of strings to the output stream with % words thrown in between. % :- pred eliza_write_strings(list(string)::in, io::di, io::uo) is det. eliza_write_strings([], !IO). eliza_write_strings([X | Xs], !IO) :- io.write_char(' ', !IO), io.write_string(X, !IO), eliza_write_strings(Xs, !IO). :- pred match_prefix(list(string)::in, list(string)::in, list(string)::out) is semidet. match_prefix([], Ys, Ys). match_prefix([X | Xs], [Y | Ys], Zs) :- string.to_upper(Y, X), match_prefix(Xs,Ys,Zs). :- pred find_handle(list(string)::in, message_type::out, list(string)::out) is det. find_handle(In, MsgType, Out) :- response_handles(Handles), find_handle2(In, MsgType, Out, Handles). :- pred find_handle2(list(string)::in, message_type::out, list(string)::out, assoc_list(list(string), message_type)::in) is det. find_handle2(In, no_key_message, In, []). find_handle2(In, Type, Out, [Prefix - Type2 | Handles]) :- ( if find_handle3(In, Prefix, Rest) then Out = Rest, Type = Type2 else find_handle2(In, Type, Out, Handles) ). :- pred find_handle3(list(string)::in, list(string)::in, list(string)::out) is semidet. find_handle3([X | Xs], Prefix, Rest) :- ( if match_prefix(Prefix, [X | Xs], Rest2) then Rest = Rest2 else find_handle3(Xs, Prefix, Rest) ). :- pred perform_conjugate(list(string)::in, list(string)::out) is det. perform_conjugate([], []). perform_conjugate([X | Xs], [Y | Ys]) :- ( if ( X = "I", Xs = [] ) then Y = "me", Ys = [] else conjugate_map(Map), string.to_upper(X, Xupp), ( if map.search(Map, Xupp, Result) then Y = Result else Y = X ), perform_conjugate(Xs, Ys) ). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- type message == pair(maybe(char), string). :- type message_type ---> can_you ; can_i ; you_are ; i_dont ; i_feel ; why_dont ; why_cant ; are_you ; i_cant ; i_am ; you ; yes ; no ; computer ; i_want ; question ; name ; because ; sorry ; dream ; hello ; maybe ; your ; always ; think ; alike ; friend ; no_key_message. :- pred conjugate_map(map(string, string)::out) is det. conjugate_map(MapOut) :- one_way_conjugates(AL1), two_way_conjugates(AL2), assoc_list.reverse_members(AL2, AL3), list.append(AL1, AL2, AL12), list.append(AL12, AL3, AL123), prepare_conj(AL123, ALFinal), map.from_assoc_list(ALFinal, MapOut). :- pred prepare_conj(assoc_list(string, string)::in, assoc_list(string, string)::out) is det. prepare_conj([], []). prepare_conj([X - V | Xs], [Y - V | Ys]) :- string.to_upper(X,Y), prepare_conj(Xs, Ys). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- pred response_handles(assoc_list(list(string), message_type)::out) is det. response_handles([ ["CAN","YOU"] - can_you, ["CAN","I"] - can_i, ["YOU","ARE"] - you_are, ["YOU'RE"] - you_are, ["I","DON'T"] - i_dont, ["I","FEEL"] - i_feel, ["WHY","DON'T","YOU"] - why_dont, ["WHY","CAN'T","I"] - why_cant, ["ARE","YOU"] - are_you, ["I","CAN'T"] - i_cant, ["I","AM"] - i_am, ["I'M"] - i_am, ["YES"] - yes, ["NO"] - no, ["COMPUTER"] - computer, ["COMPUTERS"] - computer, ["I","WANT"] - i_want, ["WHAT"] - question, ["HOW"] - question, ["WHO"] - question, ["WHERE"] - question, ["WHEN"] - question, ["WHY"] - question, ["NAME"] - name, ["BECAUSE"] - because, ["CAUSE"] - because, ["SORRY"] - sorry, ["DREAM"] - dream, ["DREAMS"] - dream, ["HI"] - hello, ["HELLO"] - hello, ["MAYBE"] - maybe, ["YOUR"] - your, ["ALWAYS"] - always, ["THINK"] - think, ["ALIKE"] - alike, ["FRIEND"] - friend, ["FRIENDS"] - friend, ["YOU"] - you ]). :- pred one_way_conjugates(assoc_list(string, string)::out) is det. one_way_conjugates([ "me" - "you" ]). :- pred two_way_conjugates(assoc_list(string, string)::out) is det. two_way_conjugates([ "are" - "am", "were" - "was", "you" - "I", "your" - "my", "I've" - "you've", "I'm" - "you're" ]). :- pred repeat_messages(repeat_state::out) is det. repeat_messages([ "Why did you repeat yourself?", "Do you expect a different answer by repeating yourself?", "Come, come, elucidate your thoughts.", "Please don't repeat yourself!" ]). :- pred response_messages(response_state::out) is det. response_messages( [ can_you - [ yes('?') - "Don't you believe that I can", yes('?') - "Perhaps you would like to be able to", yes('?') - "You want me to be able to" ], can_i - [ yes('?') - "Perhaps you don't want to", yes('?') - "Do you want to be able to" ], you_are - [ yes('?') - "What makes you think I am", yes('?') - "Does it please you to believe I am", yes('?') - "Perhaps you would like to be", yes('?') - "Do you sometimes wish you were" ], i_dont - [ yes('?') - "Don't you really", yes('?') - "Why don't you", yes('?') - "Do you wish to be able to", no - "Does that trouble you?" ], i_feel - [ no - "Tell me more about such feelings.", yes('?') - "Do you often feel", yes('?') - "Do you enjoy feeling" ], why_dont - [ yes('?') - "Do you really believe I don't", yes('.') - "Perhaps in good time I will", yes('?') - "Do you want me to" ], why_cant - [ yes('?') - "Do you think you should be able to", yes('?') - "Why can't you" ], are_you - [ yes('?') - "Why are you interested in whether or not I am", yes('?') - "Would you prefer if I were not", yes('?') - "Perhaps in your fantasies I am" ], i_cant - [ yes('?') - "How do you know you can't", no - "Have you tried?", yes('?') - "Perhaps you can now" ], i_am - [ yes('?') - "Did you come to me because you are", yes('?') - "How long have you been", yes('?') - "Do you believe it is normal to be", yes('?') - "Do you enjoy being" ], you - [ no - "We were discussing you --not me.", yes('?') - "Oh,", no - "You're not really talking about me, are you?" ], yes - [ no - "You seem quite positive.", no - "Are you sure?", no - "I see.", no - "I understand." ], no - [ no - "Are you saying no just to be negative?", no - "You are being a bit negative.", no - "Why not?", no - "Are you sure?", no - "Why no?" ], computer - [ no - "Do computers worry you?", no - "Are you talking about me in particular?", no - "Are you frightened by machines?", no - "Why do you mention computers?", no - "What do you think machines have to do with your problems?", no - "Don't you think computers can help people?", no - "What is it about machines that worries you?" ], i_want - [ yes('?') - "Why do you want", yes('?') - "What would it mean to you if you got", yes('?') - "Suppose you got", yes('?') - "What if you never got", yes('.') - "I sometimes also want" ], question - [ no - "Why do you ask?", no - "Does that question interest you?", no - "What answer would please you the most?", no - "What do you think?", no - "Are such questions on your mind often?", no - "What is it that you really want to know?", no - "Have you asked anyone else?", no - "Have you asked such questions before?", no - "What else comes to mind when you ask that?" ], name - [ no - "Names don't interest me.", no - "I don't care about names --please go on." ], because - [ no - "Is that the real reason?", no - "Don't any other reasons come to mind?", no - "Does that reason explain anything else?", no - "What other reasons might there be?" ], sorry - [ no - "Please don't apologise!", no - "Apologies are not necessary.", no - "What feelings do you have when you apologise?", no - "Don't be so defensive!" ], dream - [ no - "What does that dream suggest to you?", no - "Do you dream often?", no - "What persons appear in your dreams?", no - "Are you disturbed by your dreams?" ], hello - [ no - "How do you...please state your problem." ], maybe - [ no - "You don't seem quite certain.", no - "Why the uncertain tone?", no - "Can't you be more positive?", no - "You aren't sure?", no - "Don't you know?" ], your - [ yes('?') - "Why are you concerned about my", yes('?') - "What about your own" ], always - [ no - "Can you think of a specific example?", no - "When?", no - "What are you thinking of?", no - "Really, always?" ], think - [ no - "Do you really think so?", yes('?') - "But you are not sure you", yes('?') - "Do you doubt you" ], alike - [ no - "In what way?", no - "What resemblance do you see?", no - "What does the similarity suggest to you?", no - "What other connections do you see?", no - "Could there really be some connection?", no - "How?" ], friend - [ no - "Why do you bring up the topic of friends?", no - "Do your friends worry you?", no - "Do your friends pick on you?", no - "Are you sure you have any friends?", no - "Do you impose on your friends?", no - "Perhaps your love for friends worries you." ], no_key_message - [ no - "I'm not sure I understand you fully.", no - "What does that suggest to you?", no - "I see.", no - "Can you elaborate on that?", no - "Say, do you have any psychological problems?" ] ]). %-----------------------------------------------------------------------------% :- end_module eliza. %-----------------------------------------------------------------------------%