%Prolog version of child dialogue simulator.
%Andreas van Cranenburgh, 2009.
:- [exemplars].

%dialogue is a long word.
go :-
	dialogue.

% Main loop (quit with q)
dialogue :-
        write('Parent: '), readln(Utt),
	(Utt \= [q],	%q = quit.
	% use a depth limit of 5, ie. max 5 exemplars are combined
        %try(call_with_depth_limit(interpret(Utt, _, Meaning), 5, _)),
        try(interpret(Utt, _, Meaning)),
	try(response(Meaning, Reply, ReplyUtt)),
	flatten(Reply, M),
	(express(M, ReplyUtt, Reduced)
	;
	Reduced = ReplyUtt),
	(nonvar(ReplyUtt) ->
		write('	interpretation: '), writeln(Meaning),
		write('	reaction: '), writeln(Reply),
		write('	reduced: '), writeln(ReplyUtt),
		write('Child: '), writeln(Reduced)
	;
		fail,
		write('Child: '), writeln(0)),
        dialogue)
	;
		% I quit!
		true.

% Find a set of exemplars to construct interpretation of an utterance
interpret([], M, M).
interpret(Utt, Meaning, Result) :-
	((nonvar(Meaning),
	  member(A, Utt),
	  atom_concat('[=', W, A), 
	  atom_concat(WW,']', W)) ->
		%fetch meaning of WW and insert!
		exemplar(_, FM),
		(	(	P =.. [_, WW],
				member(P, FM),
				member(P, Meaning)
			)
		;
			(	P =.. [WW, _],
				member(P, FM),
				P =.. [WW, X], var(X),
				member(P, Meaning)
			)
		),
		write('demonstrative: '), 
		write(WW), write(' -> '), writeln(P)
	;
		true
	),
	(	%exact match
		(exemplar(X, Meaning),
		NewMeaning = Meaning
	)
	; 
	(	%match with different order or substituted arguments
		exemplar(X, M1), 
		substify(M1, Meaning, NewMeaning))),
		\+ intersection(Utt, X, []),
		subtract(Utt, X, Rest
	),
	interpret(Rest, NewMeaning, Result).

substify([], A, A).
% unify
substify([H1|A], B, [H1|C]) :-
	select(H1, B, Rest),
	substify(A, Rest, C).

% substitute
substify([H1|A], B, [H1 | B2]) :-
	catch(H1 =.. [P1, _A1], _, fail),
	catch(H2 =.. [P1, _A2], _, fail),
	select(H2, B, B1),
	substify(A, B1, B2).

% Failure is an option.
try(A) :-
	A.
try(_).

% todo: combine multiple exemplars?
response([Operator | Clauses], [ResponseOperator | Reply], ReplyUtt) :-
      	response(Operator, ResponseOperator),
	(	exemplar(ReplyUtt, [ResponseOperator | Reply ]),
		(Clauses = Reply
		;
	        \+ intersection(Clauses, Reply, []))
	).

response(whquestion, assertion).
response(assertion, assertion).
response(ynquestion, confirmation).
response(ynquestion, denial).
response(confirmation, acknowledgement).
response(denial, acknowledgement).
response(imperative, acknowledgement).
response(_, '').

%filter out words not in flattened meaning
express(_, [], _).
express(M, [W | Utt], [W1 | Reduce]) :-
	(member(W, M) ->
		W1 = W
	;
		W1 = ''),
	express(M, Utt, Reduce).

% [assertion, do(hop), animal(bunny)] --> [assertion, do, hop, animal, bunny]
flatten([], []).
flatten([H | Tail1], [H | Tail2]) :-
	atom(H),
	flatten(Tail1, Tail2).
flatten([H | Tail1], [A, B | Tail2]) :-
	catch(H =.. [A, B], _, fail),
	flatten(Tail1, Tail2).

flatten([H | Tail1], [A, B, C | Tail2]) :-
	catch(H =.. [A, B, C], _, fail),
	flatten(Tail1, Tail2).
