1:- module(interpret, [chatterbot/4]).    2
    3:- use_module(tokenize).    4:- use_module(library(http/http_error)).    5
    6/*
    7catagory([], [], [], 'I have no response for that.').
    8
    9%
   10%  pattern_match(+In, +Pattern, -Star)
   11%   determine if in matches pattern. If so, Star binds to the portion
   12%   matched by asterisks or [] (as a string)
   13pattern_match(In, Pattern, Star) :-
   14	name(In, Instring),
   15	name(Pattern, Pstring),
   16	pmatch(Instring, Pstring, [], Star).
   17
   18%
   19%%   pmatch(+Instring, +PatternString,
   20% TODO this isn't handling setting the output
   21% % TODO think in detail about this whole thing
   22%
   23
   24pmatch([] , [_], _, _) :- !,fail.
   25pmatch([] , [], _, _).
   26pmatch([] , [], _, _) :- !, fail.
   27pmatch([_], [], _, _) :- !,fail.
   28pmatch([HI|TI], [42|TP], StarSoFar, Out) :-
   29	pmatch(TI, TP, StarSoFar, Out).
   30pmatch(TI, [42|TP], StarSoFar, Out) :-
   31	pmatch(TI, [42|TP], StarSoFar, Out).
   32pmatch([HI|TI], [HP|TP], StarSoFar, Out) :-
   33	(HI is HP;
   34	 HI is HP+32;
   35	 HI+32 is HP),
   36	pmatch(TI, TP , StarSoFar, Out).
   37*/
   38
   39% hard coded default catagory so we don't have to worry about match
   40% failing
   41
   42category([nt('#$THAT'), star(0), nt('#$TOPIC'), star(0), nt('#$IN'), star(0)], [word('Replace'), word('the'),
   43		     word('default'), word('catagory'),special('.')], star(0)).
   44
   45% match patterns per the spec
   46%
   47% Annie - note, NEVER write a header comment like that again!
   48% You've spent too much time debugging this because you weren't clear
   49% what it was supposed to do when you started.
   50% and the code's not clear
   51%
   52% Patt is the tokenized pattern
   53% In is the tokenized input
   54% PartStar is a reversed, partially accumulated * match
   55% InStars is a reversed list of stars
   56% Stars is the final list of * matches in reversed order
   57%
   58% Direct matches
   59pattern_match([word(A)|T], [word(A)|TA], [] , IS, Stars) :-
   60	pattern_match(T, TA, [], IS , Stars).
   61pattern_match([nt(A)|T], [nt(A)|TA], [] , IS, Stars) :-
   62	pattern_match(T, TA, [], IS , Stars).
   63
   64% termination matches
   65pattern_match([], [], [], Stars, Stars).
   66pattern_match([], [], PartStar, [RP|Stars], Stars) :-
   67	reverse(PartStar, RP).
   68
   69% star matches
   70% stop creeping
   71pattern_match([star(0)|T], Raw, PartStar, InStars, Stars)  :-
   72	reverse(PartStar, RP),
   73	pattern_match(T, Raw, [], [RP|InStars], Stars).
   74pattern_match(Pattern, [star(0)|TRaw], PartStar, InStars, Stars)  :-
   75	reverse(PartStar, RP),
   76	pattern_match(Pattern, TRaw, [], [RP|InStars], Stars).
   77% this handles star(0) on both sides without special case
   78
   79% continue creeping
   80pattern_match([star(0)|T], [HA|TA], PartStar, InStars, Stars) :-
   81	pattern_match([star(0)|T], TA, [HA|PartStar], InStars, Stars).
   82pattern_match([word(_)|TP], [star(0)|TA], PartStar, InStars, Stars) :-
   83	pattern_match(TP, [star(0)|TA], PartStar, InStars, Stars).
   84
   85expand_template([], _, []).
   86expand_template([star(0)|T], [Star|TStars], [Star|RT]) :-
   87	expand_template(T, TStars, RT).
   88expand_template([H|T], Stars, [H|RT]) :-
   89	expand_template(T, Stars, RT).
   90
   91match(Tokens, memory(That, Topic), Response, NewTopic) :-
   92	append([nt('#$THAT')|That],
   93	       [nt('#$TOPIC')|Topic],A),
   94	append(A, [nt('#$IN')|Tokens], RawMatch),
   95	category(Pattern, Template, NewTopic),
   96	pattern_match(Pattern, RawMatch, [], [], Stars),
   97	reverse(Stars, OutStars),
   98	expand_template(Template, OutStars, Response).
   99
  100chatterbot(memory(That, Topic), Intext, Response, NewTopic) :-
  101	token_stream_of(Intext, InTokens),
  102	% TODO preprocess token stream
  103	match(InTokens, memory(That, Topic), ResponseTokens, NewTopic),
  104       	detokenize(ResponseTokens , Response).
  105%	swritef(Response, 'InTokens is %q', [InTokens]),
  106%	NewTopic=Topic.  % temporary
  107/*	catagory(AnInPattern, AThatPattern, ATopicPattern, Template),
  108	pattern_match(Intext, AnInPattern, Star),
  109	pattern_match(That, AThatPattern),
  110	pattern_match(Topic, ATopicPattern),
  111	template_reduce(Template , Star, Response, NewTopic). */