1% ===================================================================
    2% File 'logicmoo_module_aiml_toplevel.pl'
    3% Purpose: An Implementation in SWI-Prolog of AIML
    4% Maintainer: Douglas Miles
    5% Contact: $Author: dmiles $@users.sourceforge.net ;
    6% Version: 'logicmoo_module_aiml.pl' 1.0.0
    7% Revision:  $Revision: 1.7 $
    8% Revised At:   $Date: 2002/07/11 21:57:28 $
    9% ===================================================================
   10
   11%:-module()
   12%:-include('logicmoo_utils_header.pl'). %<?
   13%:- style_check(-singleton).
   14%%:- style_check(-discontiguous).
   15/*
   16:- if( (current_prolog_flag(version,MMmmPP), MMmmPP<70000) ).
   17%:- style_check(-atom).
   18:- style_check(-string).
   19:- endif.
   20*/

   21
   22% :-catch(noguitracer,E,writeq(E)),nl.
   23
   24:-multifile(what/3).
   25:-multifile(response/2).
   26:-dynamic(dict/3).
   27:-multifile(dict/3).
   28
   29:-dynamic(lineInfoElement/4).
   30
   31aiml_notrace(G):- quietly(G).
   35asserta_if_new_hlper1(C):-catch(C,_,fail),!.
   36asserta_if_new_hlper1(C):-asserta(C),!.
   37
   38:-dynamic(logicmoo_util_filesystem:local_directory_search/1).
   39:-multifile(logicmoo_util_filesystem:local_directory_search/1).
   40:-module_transparent(logicmoo_util_filesystem:local_directory_search/1).
   41
   42addPaths:- source_location(File,_Line),file_directory_name(File, Directory),
   43   %context_module(M),
   44   file_directory_name(Directory,ParentDir),% cd(ParentDir),   
   45   asserta_if_new_hlper1(user:library_directory(ParentDir)),
   46   !,% writeq(M:asserta(user:library_directory(ParentDir))),nl,
   47   file_directory_name(ParentDir,ProgramK),
   48   asserta_if_new_hlper1(user:file_search_path(programk,ProgramK)),
   49   asserta_if_new_hlper1(logicmoo_util_filesystem:local_directory_search(ProgramK)),
   50   absolute_file_name('aiml/',[relative_to(ProgramK),file_type(directory)],AIMLDir),
   51   asserta_if_new_hlper1(user:file_search_path(aiml,AIMLDir)),!.
   52
   53
   54:- addPaths.
   55
   56:-ensure_loaded(library('programk/logicmoo_module_aiml_shared.pl')).
   57:-ensure_loaded(library('programk/logicmoo_module_aiml_graphmaster.pl')).
   58:-ensure_loaded(library('programk/logicmoo_module_aiml_memory.pl')).
   59:-ensure_loaded(library('programk/logicmoo_module_aiml_natlang.pl')).
   60:-ensure_loaded(library('programk/logicmoo_module_aiml_cxt_path.pl')).
   61:-ensure_loaded(library('programk/logicmoo_module_aiml_loader.pl')).
   62:-ensure_loaded(library('programk/logicmoo_module_aiml_convertor.pl')).
   63:-ensure_loaded(library('programk/logicmoo_module_aiml_eval.pl')).
   64%%:-ensure_loaded(library('notaiml/tokenize.pl')).
   65
   66logicmoo_util_filesystem:local_directory_search(ProgramK):- user:file_search_path(programk,ProgramK).
   67logicmoo_util_filesystem:local_directory_search('cynd').
   68logicmoo_util_filesystem:local_directory_search('cynd/programk').
   69logicmoo_util_filesystem:local_directory_search('programk').
   70logicmoo_util_filesystem:local_directory_search('../aiml').
   71logicmoo_util_filesystem:local_directory_search('aiml').
   72logicmoo_util_filesystem:local_directory_search('aiml/test_suite').
   73logicmoo_util_filesystem:local_directory_search('special').
   74logicmoo_util_filesystem:local_directory_search('..').
   75logicmoo_util_filesystem:local_directory_search('../..').
   76
   77
   78local_directory_search_combined2(PL):-logicmoo_util_filesystem:local_directory_search(A),logicmoo_util_filesystem:local_directory_search(B),
   79 join_path(A,B,PL),exists_directory_safe(PL).
   80local_directory_search_combined2(PL):-logicmoo_util_filesystem:local_directory_search(PL),exists_directory_safe(PL).
   81
   82local_directory_search_combined(X):-logicmoo_util_filesystem:local_directory_search(X).
   83local_directory_search_combined(X):-local_directory_search_combined2(X).
   85local_directory_search_combined(PL):-
   86  local_directory_search_combined2(A),logicmoo_util_filesystem:local_directory_search(B),
   87  join_path(A,B,PL),exists_directory_safe(PL).
   88
   89run_chat_tests:-
   90   test_call(alicebot('Hi')),
   91   test_call(alicebot('What is your name')),
   92   test_call(alicebot('My name is Fred.')),
   93   test_call(alicebot('what is my name?')).
   94
   95test_call(G):-writeln(G),ignore(once(error_catch(G,E,writeln(E)))).
   96
   97
   98main_loop1(Atom):- current_input(In),!,
   99            read_line_to_codes(In,Codes),!,            
  100            atom_codes_or_eof(Atom,Codes),!,
  101            ignore(once(alicebot(Atom))),!.
  102
  103atom_codes_or_eof(end_of_file,end_of_file):-!.
  104atom_codes_or_eof(Atom,Codes):- atom_codes(Atom,Codes).
  105
  106
  107ping_default_files:-exists_source(aiml('../temp/aimlCore3.pl')),trace,ensure_loaded(aiml('../temp/aimlCore3.pl')),!.
  108ping_default_files:-exists_source(aiml('../temp/aimlCore.pl')),trace,ensure_loaded(aiml('../temp/aimlCore.pl')),!.
  109ping_default_files.
  110
  111aiml_main_loop:- ping_default_files,repeat,main_loop1(EOF),EOF==end_of_file.
  112
  113:-dynamic(default_channel/1).
  114:-dynamic(default_user/1).
  115
  116%default_channel( "#logicmoo").
  117%default_user(    "default_user").
  118
  119% say(Say):-writeq(Say),nl.
  120
  121% ===============================================================================================
  122% ALICE IN PROLOG
  123% ===============================================================================================
  124
  125say(X):-currentContext(say(X),Ctx),say(Ctx,X),!.
  126say(Ctx,X):- aiml_eval(Ctx,X,Y),!,answerOutput(Y,O),showTransition(O,Y,Trans),debugFmt(say(Trans)),!.
  127
  128showTransition(O,Y,O):-O==Y,!.
  129showTransition(O,Y,O=Y).
  130
  131alicebot:-
  132        currentContext(alicebot,Ctx),
  133        alicebotCTX(Ctx).
  134
  135alicebotCTX(Ctx):-
  136        repeat,
  137        current_input(In),
  138	read_line_to_codes(In,Codes),
  139        ( Codes==end_of_file 
  140         -> ! ;
  141        (tokenizeInput(Codes,Atom),
  142        %%atom_codes(Atom,Codes),
  143         ignore(once(alicebotCTX(Ctx,Atom))),
  144         Atom==end_of_file)).
  145
  146% ===============================================================================================
  147% Main Alice Input
  148% ===============================================================================================
  149
  150alicebot(Input):-
  151  currentContext(alicebot(Input),Ctx),
  152  alicebotCTX(Ctx,Input),!.
  153
  154alicebotCTX(Ctx,Input):- prolog_must(nonvar(Input)), alicebotCTX(Ctx,Input,Resp),!,say(Ctx,Resp),!.
  155%%alicebotCTX(Ctx,_):- atrace, say(Ctx,'-no response-'),!.
  156
  157% ===============================================================================================
  158% Main Alice Input-Output
  159% ===============================================================================================
  160alicebot([],_):-debugFmt('no input'),!,fail.
  161alicebot(Input,Resp):- currentContext(alicebot(Input),Ctx),alicebotCTX(Ctx,Input,Resp),!.
  162alicebot(In,Res):- !,ignore(Res='-no response-'(In)).
  163
  164alicebotCTX(_Ctx,[],[]):-!.
  165alicebotCTX(Ctx,Input,Resp):-
  166      context_module(M),
  167      debugOnError(tokenizeInput(Input,Tokens)),
  168      prolog_statistics:time(M:debugOnError(alicebotCTX4(Ctx,Input,Tokens,Resp))),!.
  169
  170
  171% ===============================================================================================
  172% Main Alice Source-Input-Output
  173% ===============================================================================================
  174%alicebotCTX4(Ctx,String,Input,Res):- callableInput(Ctx,String,Input,Res),!.
  175alicebotCTX4(_Ctx,String,Input,_Resp):- isNoInput(String,Input), debugFmt('no input'),!,fail.
  176alicebotCTX4(Ctx,String,Input,Resp):-
  177  prolog_mustEach((
  178   ground(String),ground(Input),
  179   Atoms = Input,
  180   retractall(posibleResponse(_,_)),
  181   flag(a_answers,_,0),!,
  182   prolog_mustEach((
  183   getAliceMem(Ctx,'bot','you',User),
  184   getAliceMem(Ctx,'bot','me',_Robot),
  185   getAliceMem(Ctx,'bot',default('minanswers',1),MinAns0),unlistify(MinAns0,MinAns1),MinAnsMinusOne is MinAns1 -1,
  186   getAliceMem(Ctx,'bot',default('maxanswers',1),_MaxAns),
  187   %%setAliceMem(Ctx,User,'input',Atoms),
  188   pushInto1DAnd2DArray(Ctx,'request','input',5,Atoms,User),
  189   setAliceMem(Ctx,User,'rawinput',String))),
  190   thread_local_flag(sraiDepth,_,0),
  191   prolog_must((call_with_depth_limit_traceable(computeInputOutput(Ctx,1,Atoms,Output,N),8000,_DL),
  192	 ignore((nonvar(N),nonvar(Output),savePosibleResponse(N,Output))),flag(a_answers,X,X+1),
  193                X>=MinAnsMinusOne)),!,
  194   findall(NR-OR,posibleResponse(NR,OR),L),!,
  195   (format('~n-> ~w~n',[L])),
  196   sort(L,S),
  197   dumpList(S),
  198   reverse(S,[Resp|_RR]),
  199   degrade(Resp),
  200   rememberSaidIt(Ctx,Resp))),!.
  201
  202isNoInput(String,Input):-trimWhitepaceOffEnds(Input,InputTrimed),Input\==InputTrimed,!,isNoInput(String,InputTrimed).
  203isNoInput(_,[]):-!.
  204isNoInput(_,['']):-!.
  205isNoInput(_,_):-fail.
  206% ===============================================================================================
  207% Call like a SRAI tag
  208% ===============================================================================================
  209computeInput(Ctx, VoteIn,NotList,InputM):-not(is_list(NotList)),!,listify(NotList,Input),
  210   maplist_safe(computeInnerEach(Ctx, VoteIn),Input,InputM).
  211computeInput(Ctx, VoteIn,Input,InputM):-maplist_safe(computeInnerEach(Ctx, VoteIn),Input,InputM).
  212
  213computeInputOutput(Ctx,_VoteIn,Input,Output,1):- callableInput(Ctx,Input,Input,Output),!.
  214
  215computeInputOutput(Ctx,VoteIn,Input,Output,VotesOut):-
  216    prolog_mustEach((computeInput(Ctx, VoteIn,Input,InputM),!,
  217                     computeElement(Ctx,VoteIn,srai,[],InputM,OutputM,VotesOM),
  218                     computeTemplateOutput(Ctx,VotesOM,OutputM,Output,VotesOut))).
  219
  220computeInputOutput(Ctx,VoteIn,Input,Output,VotesOut):-
  221   ((prolog_mustEach((computeAnswer(Ctx,VoteIn,element(srai,[],Input),OutputM,VotesOM),
  222                          computeTemplateOutput(Ctx,VotesOM,OutputM,Output,VotesOut))))),!.
  223
  224
  225
  226% ===============================================================================================
  227% Save Possible Responses (Degrade them as well)
  228% ===============================================================================================
  229:-dynamic(posibleResponse/2).
  230
  231savePosibleResponse(_N,Output):-posibleResponse(_,Output),!.
  232savePosibleResponse(N,Output):-
  233   findall(1,degraded(Output),L),!,
  234   length(L,K),
  235   SN is N - (K * 0.6)  , !,
  236   asserta(posibleResponse(SN,Output)).
  237
  238% ===============================================================================================
  239% Degrade Response
  240% ===============================================================================================
  241
  242:-dynamic(degraded/1).
  243
  244degrade(_-OR):-!,degrade(OR).
  245degrade(OR):-asserta(degraded(OR)).
  246
  247
  248% ===============================================================================================
  249% Expand Answers
  250% ===============================================================================================
  251flatten_if_list(List,Flat):-is_list(List),!,flatten(List,Flat),!.
  252
  253computeTemplate(Ctx,Votes,Input,Output,VotesO):-flatten_if_list(Input,Flat),!,computeTemplate0(Ctx,Votes,Flat,Output,VotesO).
  254computeTemplate(Ctx,Votes,Input,Output,VotesO):-computeTemplate0(Ctx,Votes,Input,Output,VotesO).
  255
  256computeTemplate0(Ctx,Votes,Input,Output,VotesO):-prolog_must(computeTemplate1(Ctx,Votes,Input,Output,VotesO)).
  257
  258computeTemplate1(_Ctx,Votes,In,Out,VotesO):-In==[],!,prolog_must((In=Out,Votes=VotesO)).
  259computeTemplate1(Ctx,Votes,IN,Out,VotesO):-IN=[I|N],!,computeTemplate11(Ctx,Votes,[I|N],Out,VotesO).
  260computeTemplate1(Ctx,VotesM,In,Out,VotesM):-traceAIML,expandVar(Ctx,In,Out).
  261computeTemplate1(_Ctx,Votes,In,Out,VotesO):-prolog_must((In=Out,Votes=VotesO)).
  262
  263computeTemplate11(_Ctx,Votes,In,Out,VotesO):-In==[],!,prolog_must((In=Out,Votes=VotesO)).
  264computeTemplate11(Ctx,Votes,[<,BR,/,>|B],OO,VotesO):-atom(BR),!,
  265   computeTemplate11(Ctx,Votes,[element(BR,[],[])|B],OO,VotesO).
  266computeTemplate11(Ctx,Votes,[A|B],[A|BB],VotesO):-atomic(A),!,computeTemplate11(Ctx,Votes,B,BB,VotesO).
  267computeTemplate11(Ctx,Votes,[A|B],OO,VotesO):-expandVar(Ctx,A,AA),computeTemplate11(Ctx,Votes,B,BB,VotesO),once(flatten([AA,BB],OO)).
  268
  269
  270traceAIML:-!.
  271
  272expandVar(_Ctx,Var,Var):-var(Var),!,traceAIML.
  273expandVar(_Ctx,[Var|_],Var):- !,atrace,traceAIML.
  274expandVar(Ctx,In,Out):-atom(In),atom_concat('$',NameVar,In),!,expandVariable(Ctx,NameVar,Out).
  275expandVar(_Ctx,In,Out):-atomic(In),Out=In,!.
  276expandVar(Ctx,star(A,B,C),Out):-!,starName(A,AStar),!,expandVar(Ctx,element(AStar,B,C),Out).
  277expandVar(Ctx,element(A,B,C),Out):-!,computeElementMust(Ctx,1,A,B,C,Out,_VotesO).
  278expandVar(Ctx,In,Out):-computeAnswerMaybe(Ctx,1,In,Out,_VotesO),!.
  279expandVar(_Ctx,In,Out):-atrace,Out=In,!.
  280
  281expandVariable(Ctx,In,Out):-atom(In),atom_concat('$',NameVar,In),!,expandVariable(Ctx,NameVar,Out),!.
  282expandVariable(Ctx,In,Out):-atom(In),atom_concat(NameVar,'$',In),!,expandVariable(Ctx,NameVar,Out),!.
  283expandVariable(Ctx,name=Name,Result):-!,expandVariable(Ctx,Name,Result),!.
  284
  285expandVariable(_Ctx,nick,A):-!,default_user(B),!,from_atom_codes(A,B),!.
  286expandVariable(_Ctx,person,A):-!,default_user(B),!,from_atom_codes(A,B),!.
  287expandVariable(_Ctx,botnick,'jllykifsh'):-!.
  288expandVariable(_Ctx,mynick,'jllykifsh'):-!.
  289expandVariable(_Ctx,version,[push_nobrkspace,'1','.','0','.','1',pop_nobrkspace]):-!.
  290expandVariable(_Ctx,id,'$botnick$'):-!.
  291expandVariable(_Ctx,size,Size):-aimlCateSig(X),predicate_property(X,number_of_clauses(Size)),!.
  292%TODO extract the machine TimeZone
  293expandVariable(_Ctx,date,[Y,'-',M,'-',D]):-get_time(TimeStamp),stamp_date_time(TimeStamp,DateTime,'UTC'),date_time_value(date,DateTime,date(Y,M,D)),!.
  294expandVariable(_Ctx,mychan,A):-!,default_channel(B),!,from_atom_codes(A,B),!.
  295expandVariable(Ctx,NameVar,Result):-getAliceMem(Ctx,'bot',NameVar,Result),!.
  296expandVariable(Ctx,NameVar,Result):-getAliceMem(Ctx,'global',NameVar,Result),!.
  297
  298
  299globalAliceTagVar(BOT_ATOM):-not(atom(BOT_ATOM)),!,fail.
  300globalAliceTagVar(BOT_ATOM):-member(BOT_ATOM,[version,id,favfood,date,size,news,emotion,time,favoritebook,birthdate]).
  301globalAliceTagVar(BOT_ATOM):-atom_concat('fav',_,BOT_ATOM).
  302globalAliceTagVar(BOT_ATOM):-atom_concat('bot_',_,BOT_ATOM).
  303globalAliceTagVar(BOT_ATOM):-atom_concat('get_',_,BOT_ATOM).
  304globalAliceTagVar(BOT_ATOM):-atom_concat('get',_,BOT_ATOM).
  305
  306
  307from_atom_codes(Atom,Atom):-atom(Atom),!.
  308from_atom_codes(Atom,Codes):-convert_to_string(Codes,Atom),!.
  309from_atom_codes(Atom,Codes):-atom_codes(Atom,Codes).
  310
  311
  312:-dynamic(recursiveTag/1).
  313
  314
  315notRecursiveTag(system).
  316%%notRecursiveTag(template).
  317notRecursiveTag(condition).
  318notRecursiveTag(Loader):-loaderTag(Loader).
  319notRecursiveTag(li).
  320
  321loaderTag(Loader):-member(Loader,[aiml,topic,category,learn,load]).
  322
  323recursiveTag(random).
  324recursiveTag(srai).
  325recursiveTag(NoRec):-notRecursiveTag(NoRec),!,fail.
  326recursiveTag(_).
  327
  328isAimlTag(result):-!,fail.
  329isAimlTag(proof):-!,fail.
  330isAimlTag(get).
  331isAimlTag(_).
  332
  333prolog_mostly_ground(Out):-ground(Out),!.
  334prolog_mostly_ground(Out):-var(Out),!,atrace.
  335prolog_mostly_ground([H|_Out]):-!,prolog_must(prolog_mostly_ground1(H)),!.
  336prolog_mostly_ground(Out):- ((arg(_N,Out,Arg),prolog_must(prolog_mostly_ground1(Arg)),fail));true.
  337prolog_mostly_ground1(Out):-prolog_must(nonvar(Out)).
  338
  339computeInner(_Ctx, _Votes, In, Out) :- atom(In),!,Out=In.
  340computeInner(Ctx,Votes, In, Out) :- not(Out=(_-_)),!,computeAnswer(Ctx,Votes, In, Out, _VoteMid),!.
  341computeInner(Ctx,Votes, In, VoteMid-Out) :-  computeAnswer(Ctx,Votes, In, Out, VoteMid),!,prolog_must(nonvar(Out)),prolog_must(nonvar(VoteMid)).
  342
  343computeInnerEach(_Ctx, _Votes, In, Out) :- atom(In), !, Out=In , prolog_mostly_ground(Out).
  344
  345computeInnerEach(Ctx, _Votes, element(eval,ATTRIBS,INNER_XML),Rendered):-!,
  346   withAttributes(Ctx,ATTRIBS,aiml_eval_each(Ctx,INNER_XML,Rendered)),!.
  347
  348computeInnerEach(  Ctx, Votes, In, Out) :- prolog_must(computeAnswer(Ctx,Votes, In, Out, _VoteMid)),!, prolog_mostly_ground(Out).
  349computeInnerEach(_Ctx, _Votes, In, Out) :- !, Out=In,  prolog_mostly_ground((Out)).
  350
  351isNonCallable(A):-atomic(A),!.
  352isNonCallable([_|_]):-!.
  353isNonCallable(Pred):-predicate_property(Pred,number_of_clauses(_)),!,fail.
  354isNonCallable(_).
  355
  356isCallable(Pred):-not(isNonCallable(Pred)).
  357
  358% ===============================================================================================
  359% Compute Answer Element Probilities
  360% ===============================================================================================
  361computeElementMust(Ctx,Votes,Tag,Attribs,InnerXml,Resp,VotesO):-prolog_must(catch(computeElement(Ctx,Votes,Tag,Attribs,InnerXml,Resp,VotesO),E,throw(E))).
  362
  363computeAnswerMaybe(Ctx,Votes,element(Tag,Attribs,InnerXml),Output,VotesO):-!,computeElement(Ctx,Votes,Tag,Attribs,InnerXml,Output,VotesO).
  364computeAnswerMaybe(Ctx,Votes,InnerXml,Resp,VotesO):-isCallable(InnerXml),!,prolog_ecall(computeAnswerMaybeInnerLast(Ctx,Votes,Resp,VotesO),InnerXml).
  365computeAnswerMaybe(Ctx,Votes,InnerXml,Resp,VotesO):-computeAnswer(Ctx,Votes,InnerXml,Resp,VotesO).
  366computeAnswerMaybe(Ctx,Votes,InnerXml,Resp,VotesO):-debugFmt(computeAnswerMaybe(Ctx,Votes,InnerXml,Resp,VotesO)),fail.
  367
  368computeAnswerMaybeInnerLast(Ctx,Votes,Resp,VotesO,InnerXml):-computeAnswerMaybe(Ctx,Votes,InnerXml,Resp,VotesO).
  369
  370unused_computeElement(Ctx,Votes, Tag, ATTRIBS, [DO|IT], OUT, VotesO) :- recursiveTag(Tag),!,
  371      withAttributes(_Ctx,ATTRIBS,
  372        ((findall(Out,((member(In,[DO|IT]),computeTemplate(Ctx,Votes, In, Out, _VoteMid))),INNERDONE),
  373         NOUT=..[Tag,ATTRIBS,INNERDONE],!,
  374         computeAnswer(Ctx,Votes,NOUT,OUT,VotesO)))).
  375
  376% element inner reductions
  377still_computeElement(Ctx,Votes, Tag, ATTRIBS, [DO|IT], OUT, VotesO) :- recursiveTag(Tag),not(DO=(_-_)),!,
  378     appendAttributes(Ctx,ATTRIBS, [computeAnswer=[side_effects_allow=[transform],intag=Tag]], ATTRIBS_NEW),
  379     withAttributes(_Ctx,ATTRIBS_NEW,
  380       ((findall(OutVoteMid,((member(In,[DO|IT]),computeInner(Ctx,Votes, In, OutVoteMid))),INNERDONE),
  381        NOUT=..[Tag,ATTRIBS,INNERDONE]))),!,
  382         withAttributes(Ctx,ATTRIBS,computeInnerTemplate(Ctx,Votes,NOUT,OUT,VotesO)).
  383
  384:-discontiguous(computeElement/7).%%ah iot would be fine to move the OXY
  385
  386computeElement(_Ctx,Votes,Tag,ATTRIBS,InnerXml,Output,VotesO):- G=a(Votes,Tag,ATTRIBS,InnerXml),
  387   (prolog_must(ground(G)),not(var(Output);var(VotesO))),!,atrace,throw(G).
  388
  389% <justthat ...>
  390computeElement(Ctx,Votes,justthat,ATTRIBS,InnerXml,Output,VotesO):-!, computeElement(Ctx,Votes,input,[index=[2]|ATTRIBS],InnerXml,Output,VotesO).
  391computeElement(Ctx,Votes,justhat,ATTRIBS,InnerXml,Output,VotesO):-!, computeElement(Ctx,Votes,input,[index=[2]|ATTRIBS],InnerXml,Output,VotesO).
  392
  393% <beforethat ...>
  394computeElement(Ctx,Votes,beforethat,ATTRIBS,InnerXml,Output,VotesO):-!, computeElement(Ctx,Votes,input,[index=[3]|ATTRIBS],InnerXml,Output,VotesO).
  395
  396% <justbeforethat ...>
  397computeElement(Ctx,Votes,justbeforethat,ATTRIBS,InnerXml,Output,VotesO):-!, computeElement(Ctx,Votes,that,[index=[2,1]|ATTRIBS],InnerXml,Output,VotesO).
  398
  399% <html:br/>
  400computeElement(Ctx,Votes,Htmlbr,ATTRIBS,Input,Output,VotesO):- atom(Htmlbr),atom_concat_safe('html:',Br,Htmlbr),!,
  401   computeElementMust(Ctx,Votes,html:Br,ATTRIBS,Input,Output,VotesO).
  402computeElement(Ctx,Votes,html:Br,ATTRIBS,Input,Output,VotesO):- atom(Br),
  403   computeElementMust(Ctx,Votes,Br,ATTRIBS,Input,Output,VotesO).
  404
  405% <br/>
  406computeElement(_Ctx,Votes,br,[],[],'\n',Votes):-!.
  407% <p/>
  408computeElement(_Ctx,Votes,p,[],[],'\r\n',Votes):-!.
  409
  410% <sr/>
  411computeElement(Ctx,Votes,sr,ATTRIBS,Input,Output,VotesO):- !,
  412   computeElementMust(Ctx,Votes,srai,ATTRIBS,[element(star,ATTRIBS,Input)],Output,VotesO).
  413
  414computeElement(Ctx,Votes,Tag,ATTRIBS,Input,element(Tag,ATTRIBS,Output),VotesO):- isGenTemplate(Ctx,ATTRIBS),member(Tag,[srai,personf]),!,computeInnerTemplate(Ctx,Votes,Input,Output,VotesO).
  415
  416% <srai/>s
  417computeElement(_Ctx,Votes,srai,ATTRIBS,[],result([],srai=ATTRIBS),VotesO):-atrace,!,VotesO is Votes * 0.6.
  418
  419% <srai>s
  420computeElement(Ctx,Votes,srai,ATTRIBS,Input,Output,VotesO):- !, % for evalSRAI
  421  withAttributes(Ctx,ATTRIBS,((
  422    computeInnerTemplate(Ctx,Votes,Input,Middle,VotesM),!,
  423     prolog_must(computeSRAIElement(Ctx,VotesM,ATTRIBS,Middle,Output,VotesO))))),!.
  424
  425% genTemplate strippers
  426computeElement(Ctx,Votes,Tag,ATTRIBS,Input,Output,VotesO):-member(Tag,[li,template,pre]),isGenTemplate(Ctx,ATTRIBS),!,computeInnerTemplate(Ctx,Votes,Input,Output,VotesO).
  427
  428% <li...>
  429computeElement(Ctx,Votes,li,Preconds,InnerXml,OutProof,VotesO):- !, computeElement_li(Ctx,Votes,Preconds,InnerXml,OutProof,VotesO).
  430
  431% <li> PASSED
  432computeElement_li(Ctx,Votes,Preconds,InnerXml,OutProof,VotesO):-
  433     precondsTrue(Ctx,Preconds),!,computeInnerTemplate(Ctx,Votes,InnerXml,Output,VotesM),VotesO is VotesM * 1.1,!,
  434     prolog_must(OutProof = proof(Output,li(Preconds))).
  435
  436% <li> FAILED ==> []
  437computeElement_li(Ctx,Votes,Preconds,_InnerXml,OutProof,VotesO):-makeBlank(Ctx,Votes,failed(li(Preconds)),OutProof,VotesO),!.
  438
  439  precondsTrue(Ctx,PC):-lastMember(name=Name,PC,WO),lastMember(value=Value,WO,Rest),!,precondsTrue0(Ctx,[Name=Value|Rest]).
  440  precondsTrue(_Ctx,PC):-PC==[];var(PC),!.
  441  precondsTrue(Ctx,PC):-precondsTrue0(Ctx,PC).
  442
  443  precondsTrue0(_Ctx,PC):-PC==[];var(PC),!.
  444  precondsTrue0(Ctx,[NV|MORE]):-!,precondsTrue0(Ctx,MORE),!,precondsTrue0(Ctx,NV).
  445  precondsTrue0(Ctx,N=V):- peekNameValue(Ctx,user,N,Value,'$value'([])),!,(valuesMatch(Ctx,Value,V)->debugFmt(valuesMatch(Value,V));debugFmt(valuesMatch(not,Value,V))),valuesMatch(Ctx,Value,V).
  446  precondsTrue0(_Ctx,_NV):-atrace.
  447
  448%%%%%%%%%%%%%%%%%%%%%
  449% <random...>
  450%%%%%%%%%%%%%%%%%%%%%
  451computeElement(Ctx,Votes,random,Attribs,List,AA,VotesO):-isGenTemplate(Ctx,Attribs),!,member(Pick,List),computeAnswer(Ctx,Votes,Pick,AA,VotesO).
  452computeElement(Ctx,Votes,random,_Attribs,List,AA,VotesO):-!,randomPick(List,Pick),computeAnswer(Ctx,Votes,Pick,AA,VotesO).
  453
  454%%%%%%%%%%%%%%%%%%%%%
  455% <condition...>
  456%%%%%%%%%%%%%%%%%%%%%
  457computeElement(Ctx,Votes,condition,Attribs,List,AA,VotesO):-isGenTemplate(Ctx,Attribs),!,member(Pick,List),computeAnswer(Ctx,Votes,Pick,AA,VotesO).
  458computeElement(Ctx,Votes,condition,CondAttribs,InnerXml,Result,VotesO):-
  459     prolog_must(computeElement_condition(Ctx,Votes,CondAttribs,InnerXml,Result,VotesO)),!.
  460
  461% <condition name="foo" value="bar"> (acts like a <li name="foo" value="bar">)
  462computeElement_condition(Ctx,Votes,CondAttribs,InnerXml,Result,VotesO):-
  463   copy_term(CondAttribs,CondAttribsCopy),
  464     attributesContainOneOf0(CondAttribsCopy,[value=_]),attributesContainOneOf0(CondAttribsCopy,[var=_,name=_]),!,
  465      prolog_must(prolog_may(computeAnswerMaybe(Ctx,Votes,element(li,CondAttribs,InnerXml),Result,VotesO));makeBlank(Ctx,Votes,failed(CondAttribs),Result,VotesO)),!.
  466
  467% <condition name="foo"> <li value="bar"...>
  468computeElement_condition(Ctx,Votes,CondAttribs,InnerXml,Result,VotesO):-
  469   last(InnerXml,Last),
  470   copy_term(CondAttribs,CondAttribsCopy),
  471     not(attributesContainOneOf0(CondAttribsCopy,[value=_])),attributesContainOneOf0(CondAttribsCopy,[var=VarName,name=VarName]),!,
  472   lastKVMember(Ctx,[var,name],VarName,CondAttribs,_NEWCondAttribs),
  473   isValid(VarName),
  474   debugFmt(condition(varname=VarName,InnerXml)),
  475   withAttributes(Ctx, [name=VarName|CondAttribs],
  476      once((member(Pick,InnerXml),once((computeAnswerMaybe(Ctx,Votes,withAttributes(CondAttribs,Pick),Result,VotesO),isNonBlank(Result)))))
  477         ; (Result = Last,VotesO is Votes * 0.9)),!.
  478
  479% <condition><li..>
  480computeElement_condition(Ctx,Votes,CondAttribs,InnerXml,Result,VotesO):-
  481  last(InnerXml,Last),
  482   withAttributes(Ctx, CondAttribs,
  483     once(
  484      once((member(Pick,InnerXml),once((computeAnswerMaybe(Ctx,Votes,withAttributes(CondAttribs,Pick),Result,VotesO),isNonBlank(Result)))))
  485         ; (Result = Last, VotesO is Votes * 0.9))),!.
  486
  487makeBlank(_Ctx,Votes,Message,result([],Message),VotesO):- VotesO is Votes * 0.3 . %%%failed(CondAttribs)
  488
  489attributesContainOneOf(CondAttribs,AllOf):-copy_term(CondAttribs,CondAttribsCopy),attributesContainOneOf0(CondAttribsCopy,AllOf),!.
  490attributesContainOneOf0(CondAttribsCopy,AllOf):-member(Find,AllOf),member(Find,CondAttribsCopy),!.
  491isNonBlank(Result):-answerOutput(Result,Stuff),!,nonvar(Stuff),Stuff\==[].
  492
  493% <input/response/that index="1"...>
  494computeElement(Ctx,Votes,InputResponse,Attribs,InnerXml,Resp,VotesO):-member(InputResponse,[input,response,that]),!,
  495  lastMemberOrDefault(index=Index,Attribs,AttribsNew,['1']),
  496  prolog_must(computeMetaStar(Ctx,Votes,InputResponse,Index,AttribsNew,InnerXml,Resp,VotesO)).
  497
  498% <gossip...>
  499computeElement(Ctx,Votes,gossip,_Attribs,Input,Output,VotesO):-!,computeAnswer(Ctx,Votes,Input,Output,VotesO).
  500
  501% <think...>
  502computeElement(Ctx,Votes,think,Attribs,_Input,[],Votes):-isGenTemplate(Ctx,Attribs),!.
  503computeElement(Ctx,Votes,formatter,[type=[think]],_Input,[],Votes):-isGenTemplate(Ctx,[]),!.
  504computeElement(Ctx,Votes,think,_Attribs,Input,proof([],think=Hidden),VotesO):-!,computeInnerTemplate(Ctx,Votes,Input,Hidden,VotesO).
  505
  506% <formatter type="prologcall">
  507computeElement(Ctx,Votes,formatter,Attribs,Input,Result,VotesO):-
  508      computeInnerTemplate(Ctx,Votes,Input,Mid,VotesO),
  509      lastMember(type=ProcI,Attribs,_NEW),listify(ProcI,[Proc|More]),atom(Proc),atomic_list_concat_aiml(['format_',Proc|More],Pred),
  510      functor(Callable,Pred,3),predicate_property(Callable,_),!,
  511      computeCall(Ctx,Pred,Mid,Result,'$error'),Result\=='$error'.
  512
  513% <formatter type="sometag">
  514computeElement(Ctx,Votes,formatter,Attribs,Input,Result,VotesO):- !,
  515      computeInnerTemplate(Ctx,Votes,Input,Hidden,VotesO),
  516      lastMember(type=ProcI,Attribs,NEW),unlistify(ProcI,Proc),!,
  517      withAttributes(Ctx,NEW,computeElement(Ctx,Votes,Proc,NEW,Hidden,Result,VotesO)),!.
  518
  519%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  520% <get,set,bot...>
  521%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  522
  523computeElement(Ctx,Votes,GetSetBot,Attribs,InnerXml,Resp,VotesO):-member(GetSetBot,[get,set,bot]),!,computeGetSet(Ctx,Votes,GetSetBot,Attribs,InnerXml,Resp,VotesM),VotesO is VotesM * 1.1,!.
  524
  525%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  526% for sure botvar-ish
  527% <version/id/date/size>
  528%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  529computeElement(Ctx,Votes,BOT_ATOM,Attribs,InnerXml,element(BOT_ATOM,Attribs,InnerXml),Votes):- isGenTemplate(Ctx,Attribs), globalAliceTagVar(BOT_ATOM),!.
  530% HANDLE this in computeAnswer now convert_ele(Ctx,element(BOT_ATOM, ALIST, V),element(bot,[name=BOT_ATOM|ALIST],VV)):- globalAliceTagVar(BOT_ATOM),convert_template(Ctx,V,VV),!.
  531computeElement(Ctx,Votes,BOT_ATOM,[],[],proof(Resp,globalAliceTagVar(BOT_ATOM)),VotesO):- globalAliceTagVar(BOT_ATOM),!,expandVariable(Ctx,BOT_ATOM,Resp),VotesO is Votes  * 1.1.
  532
  533% <topicstar,star,thatstar...>
  534computeElement(Ctx,Votes,StarTag,Attribs,InnerXml,Resp,VotesO):- hotrace(starType(StarTag,StarName)),!, %%atrace,
  535      computeStar(Ctx,Votes,StarName,Attribs,InnerXml,Resp,VotesM),VotesO is VotesM * 1.1,!.
  536
  537
  538computeElement(Ctx,Votes,Tag,Attribs,Input,element(Tag,Attribs,Input),Votes):-  isGenTemplate(Ctx,Attribs),verbatumGenTemplate(Tag),!.
  539
  540verbatumGenTemplate(Tag):-member(Tag,[cycsystem,cyceval,cycquery,cycrandom,embed,img,script]).
  541verbatumGenTemplate(Tag):-member(Tag,[system,eval,load,learn]).
  542
  543
  544% <cycrandom...>
  545computeElement(Ctx,Votes,cycrandom,_Attribs,RAND,Output,VotesO):-!, computeAnswer(Ctx,Votes,cyceval(RAND),RO,VotesO),randomPick(RO,Output).
  546
  547% <system...>
  548computeElement(Ctx,Votes,Tag,Attribs,Input,result(RESULT,Tag=EVAL),VotesO):-
  549   member(Tag,[system]),
  550   checkNameValue(peekNameValue,Ctx,Attribs,[lang],Lang, '$value'('bot')),
  551   computeInnerTemplate(Ctx,Votes,Input,EVAL,VotesO),
  552   systemCall(Ctx,Lang,EVAL,RESULT).
  553
  554% <cyc..>
  555computeElement(Ctx,Votes,Tag,Attribs,Input,result(RESULT,Tag=EVAL),VotesO):-
  556   member(Tag,[cycsystem,cyceval,cycquery]),
  557   checkNameValue(peekNameValue,Ctx,Attribs,[lang],Lang,'$value'(Tag)),
  558   computeInnerTemplate(Ctx,Votes,Input,EVAL,VotesO),
  559   systemCall(Ctx,Lang,EVAL,RESULT).
  560
  561% <template, pre ...>
  562computeElement(Ctx,Votes,Tag,Attribs, DOIT, result(OUT,Tag=Attribs), VotesO) :- member(Tag,[template,pre]), isGenTemplate(Ctx,Attribs), !,
  563  computeTemplate(Ctx,Votes,DOIT,OUT,VotesO).
  564computeElement(Ctx,Votes,Tag,Attribs, DOIT, result(OUT,Tag=Attribs), VotesO) :- member(Tag,[template,pre]), !,
  565  computeTemplate(Ctx,Votes,DOIT,OUT,VotesO).
  566
  567% <uppercase, lowercase ...>
  568computeElement(Ctx,Votes,Tag,Attribs, Input, Output, VotesO) :- formatterProc(Tag),
  569   formatterTypeMethod(Tag,Type,Method),!,
  570   computeInnerTemplate(Ctx,Votes,Input,Mid,VotesO),
  571   computeCall(Ctx,Method,Mid,Output,prologCall(Method, result(Mid,element(Tag,[type=Type|Attribs])))),!.
  572
  573% .... computeCall to formatter ....
  574computeCall(Ctx,Method,Mid,Output,ElseResult):-
  575   error_catch(prolog_must(call(Method,Ctx,Mid,Output)),
  576     E, (debugFmt(error(E,call(Method,Mid,Output))), atrace, Output = ElseResult)).
  577computeCall(_Ctx,_Pred,_Mid,Result,ElseResult):-prolog_must(Result=ElseResult).
  578
  579% .... formatters ....
  580format_formal(_Ctx,In,Out):-toPropercase(In,Out),!.
  581format_sentence(_Ctx,[In1|In],[Out1|Out]):-In=Out,toPropercase(In1,Out1),!.
  582format_sentence(_Ctx,In,Out):-In=Out.
  583format_think(_Ctx,_In,Out):-[]=Out.
  584format_gossip(_Ctx,In,Out):-In=Out.
  585format_uppercase(_Ctx,In,Out):-toUppercase(In,Out),!.
  586format_lowercase(_Ctx,In,Out):-toLowercase(In,Out),!.
  587
  588
  589% <gender..>
  590computeElement(Ctx,Votes,Gender,Attribs,Input,Result,VotesO):- substitutionDictsName(Gender,DictName),!,
  591   computeElement_subst(Ctx,Votes,Gender,DictName,Attribs,Input,Result,VotesO).
  592
  593% <gender|person2/>
  594computeElement_subst(Ctx,Votes,_Gender,DictName,Attribs,[],Result,VotesO):-
  595    computeElementMust(Ctx,Votes,star,Attribs,[],Hidden,VotesO),
  596    substituteFromDict(Ctx,DictName,Hidden,Result),!.
  597
  598computeElement_subst(Ctx,Votes,_Gender,DictName,Attribs,Input,Result,VotesO):-
  599      withAttributes(Ctx,Attribs,((computeInnerTemplate(Ctx,Votes,Input,Hidden,VotesO),
  600      substituteFromDict(Ctx,DictName,Hidden,Result)))),!.
  601
  602% <load...>
  603computeElement(Ctx,Votes,Tag,ATTRIBS,Input,result(RESULT,Tag=EVAL),VotesO):-
  604   member(Tag,[load]),!,
  605   computeInnerTemplate(Ctx,Votes,Input,EVAL,VotesO),
  606   tag_eval(Ctx,element(Tag,ATTRIBS,EVAL),RESULT).
  607
  608% <learn...>
  609computeElement(Ctx,Votes,Tag,ATTRIBS, NEWXML, result([learned,Diff,new,patterns]),Votes) :-
  610  member(Tag,[learn]),!,
  611       NEW = element(aiml,ATTRIBS,NEWXML),
  612       aimlCateSig(CateSig),
  613       predicate_property(CateSig,number_of_clauses(Before)),
  614        withAttributes(Ctx,ATTRIBS, load_aiml_structure(Ctx,NEW)),!,
  615           predicate_property(CateSig,number_of_clauses(After)),
  616           Diff is After - Before.
  617
  618% <aiml/topic/category...>
  619computeElement(Ctx,Votes,Tag,ATTRIBS, NEWXML, result([learned,Tag,Diff,new,patterns]),Votes) :- member(Tag,[aiml,topic,category]),!,
  620       NEW = element(Tag,ATTRIBS,NEWXML),
  621       aimlCateSig(CateSig),
  622       predicate_property(CateSig,number_of_clauses(Before)),
  623        withAttributes(Ctx,ATTRIBS, load_aiml_structure(Ctx,NEW)),!,
  624           predicate_property(CateSig,number_of_clauses(After)),
  625           Diff is After - Before.
  626
  627% <eval...>
  628computeElement(Ctx,Votes,Tag,ATTRIBS, DOIT, RESULT, Votes) :- member(Tag,[eval]),!,
  629      withAttributes(Ctx,ATTRIBS,aiml_eval(Ctx,DOIT,RESULT)),!.
  630
  631% other evals
  632computeElement(Ctx,Votes,Tag,ATTRIBS,Input,RESULT,VotesO):- evaluatorTag(Tag),
  633   computeInnerTemplate(Ctx,Votes,Input,EVAL,VotesO),!,
  634   tag_eval(Ctx,element(Tag,ATTRIBS,EVAL),RESULT),!.
  635
  636% maybe not for sure botvar-ish
  637% <favfood/master>
  638% HANDLE this in computeAnswer now convert_ele(Ctx,element(BOT_ATOM, ALIST, V),element(bot,[name=BOT_ATOM|ALIST],VV)):- globalAliceTagVar(BOT_ATOM),convert_template(Ctx,V,VV),!.
  639computeElement(Ctx,Votes,BOT_ATOM,[],[],proof(Resp,globalAliceTagVar(BOT_ATOM)),VotesO):- expandVariable(Ctx,BOT_ATOM,Resp),!, VotesO is Votes  * 1.1.
  640
  641% rewrites
  642computeElement(_Ctx,Votes,Tag,[],[],result([reply,from,tag,Tag],element(Tag,[],[])),Votes):-!.
  643computeElement(_Ctx,Votes,Tag,Attribs,[],result([reply,from,Tag|Attribs],Tag,Attribs),Votes):-!,atrace.
  644computeElement(Ctx,Votes,Tag,Attribs,InnerXml,Resp,VotesO):-
  645  GETATTRIBS = element(Tag,Attribs,InnerXml),
  646  convert_element(Ctx,GETATTRIBS,GETATTRIBS0),
  647  GETATTRIBS \== GETATTRIBS0,!,
  648  %%atrace,
  649  convert_element(Ctx,GETATTRIBS,_GETATTRIBS1),
  650  computeAnswer(Ctx,Votes,GETATTRIBS0, Resp,VotesO).
  651
  652
  653% ===============================================================================================
  654% Compute Star
  655% ===============================================================================================
  656
  657starName(get_star,star):-!.
  658starName(StarStar,StarStar):- atom_concat(_,'star',StarStar),!.
  659starName(Star,StarStar):- atom_concat(Star,'star',StarStar),!.
  660
  661starElementName(starstar,star).
  662starElementName(pattern,star).
  663starElementName(get_star,star).
  664starElementName(star,star).
  665starElementName(patternstar,star).
  666starElementName(StarStar,StarStar):- atom_concat(_Star,'star',StarStar),!.
  667starElementName(Star,StarStar):- atom_concat(Star,'star',StarStar),!.
  668
  669:-dynamic(inGenOutput/0).
  670isGenerateUnknown(_Ctx,_ATTRIBS):-!,inGenOutput,!.
  671isGenerateUnknown(Ctx,ATTRIBS):- peekNameValue(Ctx,ATTRIBS,generateUnknownVars,GenerateUnknown,'false'),!,GenerateUnknown=true.
  672isGenTemplate(_Ctx,_ATTRIBS):-!,inGenOutput,!.
  673isGenTemplate(Ctx,Attribs):-peekNameValue(Ctx,Attribs,generateTemplate,GenTempl,'$failure'),GenTempl=true.
  674
  675computeStar(Ctx,Votes,Star,Attribs,InnerXml,Resp,VotesO):-
  676   isGenTemplate(Ctx,Attribs),!,VotesO=Votes,
  677   starElementName(Star,EName),Resp=element(EName,Attribs,InnerXml),!.
  678
  679computeStar(Ctx,Votes,Star,Attribs,InnerXml,Resp,VotesO):-
  680   starName(Star,StarStar),Star \== StarStar,!,
  681   computeStar(Ctx,Votes,StarStar,Attribs,InnerXml,Resp,VotesO),!.
  682
  683computeStar(Ctx,Votes,Star,Attribs,InnerXml,Resp,VotesO):-
  684    lastMember(index=Index,Attribs,AttribsNew),!,
  685    computeStar1(Ctx,Votes,Star,Index,AttribsNew,InnerXml,Resp,VotesO),!.
  686
  687computeStar(Ctx,Votes,Star,Attribs,InnerXml,Resp,VotesO):-
  688    computeStar1(Ctx,Votes,Star,[1],Attribs,InnerXml,Resp,VotesO),!.
  689
  690computeStar1(Ctx,Votes,Star,Major,ATTRIBS,InnerXml,Proof,VotesO):-atomic(Major),!,
  691    computeStar1(Ctx,Votes,Star,[Major],ATTRIBS,InnerXml,Proof,VotesO),!.
  692
  693computeStar1(Ctx,Votes,Star,Index,ATTRIBS,_InnerXml,proof(ValueO,StarVar=ValueI),VotesO):- is_list(Index),
  694      CALL=atomic_list_concat_aiml([Star|Index],StarVar),
  695      prolog_must(error_catch(CALL,E,(debugFmt(CALL->E),fail))),
  696   getDictFromAttributes(Ctx,'evalsrai',ATTRIBS,Dict),
  697   computeStar2(Ctx,Votes,Dict,ATTRIBS,StarVar,ValueI,ValueO,VotesM),!,
  698   VotesO is VotesM * 1.1.
  699
  700computeStar1(_Ctx,Votes,Star,Index,ATTRIBS,InnerXml,Resp,VotesO):-
  701      traceIf(Resp = result(InnerXml,Star,Index,ATTRIBS)),!,VotesO is Votes * 1.1.
  702
  703computeStar2(Ctx,Votes,Dict,ATTRIBS,StarVar,ValueI,ValueO,VotesM):-
  704   getStoredStarValue(Ctx,Dict,StarVar,ValueI),
  705   %%ValueO=ValueI,VotesM=Votes,
  706   computeTemplate(Ctx,Votes,element(template,ATTRIBS,ValueI),ValueO,VotesM),
  707   !.
  708
  709getStoredStarValue(Ctx,_Dict,StarVar,ValueI):-current_value(Ctx,StarVar,ValueI),!.
  710getStoredStarValue(Ctx,Dict,StarVar,ValueI):-getStoredValue(Ctx,Dict,StarVar,ValueI),!.
  711getStoredStarValue(_Ctx,Dict,StarVar,[starvar,StarVar,Dict]):-!,unify_listing(dict(Dict,_,_)),atrace.
  712
  713
  714computeMetaStar(Ctx,Votes,Star,Index,ATTRIBS,InnerXml,Resp,VotesO):-computeMetaStar0(Ctx,Votes,Star,Index,ATTRIBS,InnerXml,Resp,VotesO),!.
  715
  716computeMetaStar0(Ctx,Votes,Star,MajorMinor,ATTRIBS,InnerXml,Resp,VotesO):-isGenTemplate(Ctx,ATTRIBS),!,VotesO=Votes,Resp=element(Star,[index=MajorMinor|ATTRIBS],InnerXml).
  717
  718computeMetaStar0(Ctx,Votes,Star,MajorMinor,ATTRIBS,_InnerXml,proof(ValueO,Star=ValueI),VotesO):-
  719      getDictFromAttributes(Ctx,'evalsrai',ATTRIBS,Dict),
  720      getIndexedValue(Ctx,Dict,Star,MajorMinor,ValueI),!,
  721      computeInnerTemplate(Ctx,Votes,element(template,ATTRIBS,[ValueI]),ValueO,VotesM),VotesO is VotesM * 1.1.
  722
  723computeMetaStar0(_Ctx,Votes,Star,Index,ATTRIBS,InnerXml,Resp,VotesO):- atrace,
  724      traceIf(Resp = result(InnerXml,Star,Index,ATTRIBS)),!,VotesO is Votes * 0.9.
  725
  726%%%%%%  peekNameValue(Ctx,Scope,Name,Value,else). %%
  727getDictFromAttributes(Ctx,VarHolder,_ATTRIBS,SYM):-current_value(Ctx,VarHolder,SYM).
  728getDictFromAttributes(_Ctx,_VarHolder,_ATTRIBS,'user'):-!. %%atrace.
  729
  730% ===============================================================================================
  731% Compute Get/Set Probilities
  732% ===============================================================================================
  733/*
  734
  735computeGetSet(Ctx,Votes,GetSetBot,ATTRIBS,[],Resp,VotesO):- !,computeGetSet(Ctx,Votes,GetSetBot,user,ATTRIBS,Resp,VotesO).
  736computeGetSet(Ctx,Votes,GetSetBot,name=NAME,MORE,Resp,VotesO):- !, computeGetSet(Ctx,Votes,GetSetBot,user,[name=NAME|MORE],Resp,VotesO).
  737computeGetSet(Ctx,Votes,GetSetBot,WHO,[X],Resp,VotesO):- !,computeGetSet(Ctx,Votes,GetSetBot,WHO,X,Resp,VotesO).
  738computeGetSet(Ctx,Votes,GetSetBot,ATTRIBS,Value,Resp,VotesO):- delete(ATTRIBS,type=bot,NEW),!,computeGetSet(Ctx,Votes,bot=GetSetBot,NEW,Value,Resp,VotesO).
  739computeGetSet(Ctx,Votes,GetSetBot,TYPE,[],Resp,VotesO):- !,computeGetSet(Ctx,Votes,GetSetBot,user,TYPE,Resp,VotesO).
  740
  741*/

  742
  743computeGetSet(Ctx,Votes,bot,ATTRIBS,InnerXml,Resp,VotesO):- !, computeGetSetVar(Ctx,Votes,bot,get,_VarName,ATTRIBS,InnerXml,Resp,VotesO),!.
  744
  745computeGetSet(Ctx,Votes,GetSet,ATTRIBS,InnerXml,Resp,VotesO):- computeGetSetVar(Ctx,Votes,user,GetSet,_VarName,ATTRIBS,InnerXml,Resp,VotesO),!.
  746
  747dictVarName(N):-member(N,[dictionary,dict,userdict,type,user,botname,username,you,me]).
  748% tests the dictionary contains at least one value
  749dictFromAttribs(Ctx,ATTRIBS,Dict,NEW):-dictVarName(N),lastMember(N=DictV,ATTRIBS,NEW),convert_dictname(Ctx,DictV,Dict),getContextStoredValue(Ctx,Dict,_Name,Value),valuePresent(Value),!.
  750dictFromAttribs(Ctx,ATTRIBS,Dict,NEW):-dictVarName(N),lastMember(N=DictV,ATTRIBS,NEW),atrace,convert_dictname(Ctx,DictV,Dict),!,atrace.
  751
  752lastKVMember(_Ctx,Keys,Value,ATTRIBS,NEW):-member(N,Keys),lastMember(N=Value,ATTRIBS,NEW),prolog_must(isValid(Value)),!.
  753lastKVMember(Ctx,Keys,Value,ATTRIBS,ATTRIBS):-member(N,Keys),current_value(Ctx,N,Value),prolog_must(isValid(Value)),!.
  754lastKVMember(Ctx,Keys,Value,ATTRIBS,ATTRIBS):-member(N,Keys),peekNameValue(Ctx,ATTRIBS,N,Value,'$failure'),prolog_must(isValid(Value)),!.
  755
  756%%computeGetSetVar(Ctx,Votes,_Dict,bot,VarName,ATTRIBS,InnerXml,Resp,VotesO):- !,computeGetSetVar(Ctx,Votes,user,get,VarName,ATTRIBS,InnerXml,Resp,VotesO).
  757%% computeGetSetVar(Ctx,Votes,Dict,GetSetBot,VarName,ATTRIBS,InnerXml,Resp,VotesO).
  758
  759
  760computeGetSetVar(Ctx,Votes,Dict,GetSet,OVarName,ATTRIBS,InnerXml,Resp,VotesO):- atom(ATTRIBS),ATTRIBS \= [],!, VarName = ATTRIBS,
  761   nop(debugFmt(computeGetSetVarName(GetSet,Dict:OVarName->VarName))),
  762     computeGetSetVar(Ctx,Votes,Dict,GetSet,VarName,[],InnerXml,Resp,VotesO),!.
  763
  764computeGetSetVar(Ctx,Votes,Dict,GetSet,OVarName,ATTRIBS,InnerXml,Resp,VotesO):-
  765      member(N,[var,name]),lastMember(N=VarName,ATTRIBS,NEW),!,
  766   nop(debugFmt(computeGetSetVarDict(GetSet,Dict:OVarName->VarName))),
  767      computeGetSetVar(Ctx,Votes,Dict,GetSet,VarName,NEW,InnerXml,Resp,VotesO).
  768
  769computeGetSetVar(Ctx,Votes,OldDict,GetSet,VarName,ATTRIBS,InnerXml,Resp,VotesO):-
  770     dictFromAttribs(Ctx,ATTRIBS,Dict,NEW),
  771   nop(debugFmt(computeGetSetVarDict2(GetSet,OldDict->Dict,VarName))),
  773      computeGetSetVar(Ctx,Votes,Dict,GetSet,VarName,NEW,InnerXml,Resp,VotesO)
  773.
  774
  775computeGetSetVar(Ctx,Votes,_Dict,'set',OVarName,Attribs,_InnerXml,OVarName,Votes):-isGenTemplate(Ctx,Attribs),getStoredValue(Ctx,setReturn(_Default),OVarName,NameOrValue),NameOrValue=name,!.
  776computeGetSetVar(Ctx,Votes,_Dict,'set',_OVarName,Attribs,InnerXml,Resp,VotesO):-isGenTemplate(Ctx,Attribs),!,computeTemplate(Ctx,Votes,InnerXml,Resp,VotesO).
  777computeGetSetVar(Ctx,Votes,Dict,GetSetBot,OVarName,Attribs,InnerXml,Resp,VotesO):-isGenTemplate(Ctx,Attribs),!,VotesO=Votes,Resp=element(GetSetBot,[dict=Dict,ovar=OVarName|Attribs],InnerXml).
  778
  779computeGetSetVar(Ctx,Votes,Dict,get,VarName,ATTRIBS,_InnerXml,proof(ValueO,VarName=ValueI),VotesO):-
  780      getAliceMemComplete(Ctx,Dict,VarName,ValueI),!,
  781      computeAnswer(Ctx,Votes,element(template,ATTRIBS,ValueI),ValueO,VotesM),VotesO is VotesM * 1.1.
  782
  783% GET no value found
  784computeGetSetVar(Ctx,Votes,Dict,get,VarName,ATTRIBS,_InnerXml,proof(ReturnValueO,Dict:VarName='OM',ATTRIBS),VotesO):-!,VotesO is Votes * 0.7,
  785     once(isGenerateUnknown(Ctx,ATTRIBS) -> DefaultEmpty=[unKnowN,VarName,of,Dict];DefaultEmpty=[]),
  786     lastMemberOrDefault('default'=DefaultValue,ATTRIBS,_AttribsNew,DefaultEmpty),
  787     returnNameOrValue(Ctx,Dict,VarName,DefaultValue,ReturnValueO),!.
  788
  789computeGetSetVar(Ctx,Votes,Dict,set,VarName,ATTRIBS,InnerXml,proof(ReturnValue,VarName=InnerXml),VotesO):-!,
  790      computeAnswer(Ctx,Votes,element(template,ATTRIBS,InnerXml),ValueM,VotesM),
  791      computeInnerTemplate(Ctx,VotesM,ValueM,ValueO,VotesMO),
  792      ensureValue(ValueO,ValueOO),
  793      setAliceMem(Ctx,Dict,VarName,ValueOO),!,
  794      returnNameOrValue(Ctx,Dict,VarName,ValueO,ReturnValue),
  795      VotesO is VotesMO * 1.1.
  796
  797%%computeGetSetVar(_Ctx,_Votes,_Get,_,_,_,_):-!,fail.
  798
  799returnNameOrValue(Ctx,IDict,VarNameI,Value,ReturnValue):-dictNameDictNameC(Ctx,IDict,VarNameI,Scope,Name),!,returnNameOrValue(Ctx,Scope,Name,Value,ReturnValue).
  800returnNameOrValue(Ctx,_Dict,VarName,ValueO,ReturnValueO):-
  801      once(getStoredValue(Ctx,setReturn(_Default),VarName,NameOrValue);NameOrValue=value),
  802      returnNameOrValue0(NameOrValue,VarName,ValueO,ReturnValue),!,listify(ReturnValue,ReturnValueO).
  803
  804returnNameOrValue0([NameOrValue],VarName,ValueO,ReturnValue):-!,returnNameOrValue0(NameOrValue,VarName,ValueO,ReturnValue),!.
  805returnNameOrValue0(name,VarName,_ValueO,VarName).
  806returnNameOrValue0(_Value,_VarName,ValueO,ValueO).
  807
  808
  809% ===============================================================================================
  810% Compute Answer Probilities
  811% ===============================================================================================
  812computeAnswer(Ctx,Votes,IN,Result,VotesOut):-computeAnswerND(Ctx,Votes,IN,Result,VotesOut),!.
  813
  814:-discontiguous(computeAnswerND/5).
  815
  816computeAnswerND(Ctx,Votes,IN,Result,VotesOut):- not(tracing),computeAnswer0(Ctx,Votes,IN,Result,VotesOut),fail.
  817
  818computeAnswer0(Ctx,Votes,IN,Result,VotesOut):- prolog_must((number(Votes),nonvar(IN),var(Result),var(VotesOut))),
  819      nop(debugFmt(computeAnswer(Ctx,Votes,IN,Result,VotesOut))),fail.
  820
  821computeAnswer0(Ctx,Votes,MidVote - In,Out,VotesO):- prolog_must(nonvar(MidVote)),
  822                           atrace, !, computeAnswer(Ctx,Votes,In,Out,VotesA), VotesO is VotesA * MidVote.
  823
  824computeAnswer0(_Ctx,Votes,_I,_,_):-(Votes>20;Votes<0.3),!,fail.
  825
  826%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  827% elements
  828%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  829
  830% element inner reductions
  831computeAnswer_1_disabled(Ctx,Votes, element(Tag, ATTRIBS, [DO|IT]), OUT, VotesO) :- recursiveTag(Tag),not(DO=(_-_)),!,
  832     appendAttributes(Ctx,ATTRIBS, [computeAnswer=[side_effects_allow=[transform],intag=Tag]], ATTRIBS_NEW),
  833       withAttributes(_Ctx,ATTRIBS_NEW, findall(Each,((member(In,[DO|IT]),computeInner(Ctx,Votes, In, Each))),INNERDONE)),
  834       computeElementMust(Ctx,Votes,Tag, ATTRIBS, INNERDONE, OUT, VotesO).
  835
  836computeAnswerND(Ctx,Votes, element(Tag, ATTRIBS, [DO|IT]), OUT, VotesO) :- recursiveTag(Tag),not(DO=(_-_)),!,
  837     appendAttributes(Ctx,ATTRIBS, [computeAnswer=[side_effects_allow=[transform],intag=Tag]], ATTRIBS_NEW),
  838         withAttributes(Ctx,ATTRIBS_NEW, computeInput(Ctx, Votes,[DO|IT],INNERDONE)),
  839       prolog_mostly_ground((INNERDONE)),
  840       computeElementMust(Ctx,Votes,Tag, ATTRIBS, INNERDONE, OUT, VotesO).
  841
  842computeAnswerND(Ctx,Votes,element(Tag,Attribs,List),Out,VotesO):-!,computeElement(Ctx,Votes,Tag,Attribs,List,Out,VotesO).
  843
  844% never gets here due to element/3 cutted above
  845computeAnswerND(Ctx,Votes,element(Tag,Attribs,List),Output,VotesO):- computeElement(Ctx,Votes,Tag,Attribs,List,Output,VotesO),!.
  846computeAnswerND(Ctx,Votes,element(Tag,Attribs,List),Output,VotesO):-atrace,computeElement(Ctx,Votes,Tag,Attribs,List,Output,VotesO),!.
  847
  848
  849%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  850% strings (must happen before list-check)
  851%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  852computeAnswerND(Ctx,Votes,String,Out,VotesO):-string(String),string_to_atom(String,Atom),!,computeAnswer(Ctx,Votes,Atom,Out,VotesO).
  853computeAnswerND(_Ctx,Votes,String,Atom,Votes):-is_string(String),toCodes(String,Codes),!,from_atom_codes(Atom,Codes),!.
  854computeAnswerND(_Ctx,Votes,'$stringCodes'(List),AA,Votes):-!,from_atom_codes(AA,List),!.
  855
  856%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  857% list-check
  858%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  859% (should be no stars)
  860computeAnswerND(_Ctx,_Votes,Pattern,_,_):- traceIf(isStarValue(Pattern)),fail.
  861
  862computeAnswerND(_Ctx,Votes,[],[],Votes):-!.
  863computeAnswerND(Ctx,Votes,[A|B],OO,VotesO):-
  864    atomic(A) ->
  865      (!,computeTemplate(Ctx,Votes,B,BB,VotesO),OO=[A|BB]) ;
  866      computeTemplate(Ctx,Votes,[A|B],OO,VotesO).
  867
  868%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  869% atomic
  870%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  871computeAnswerND(Ctx,Votes,randomsentence,Output,VotesO):-!, choose_randomsentence(X),!,computeAnswer(Ctx,Votes,X,Output,VotesO).
  872
  873computeAnswerND(Ctx,Votes,In,Out,Votes):-atomic(In),expandVar(Ctx,In,Out).
  874computeAnswerND(_Ctx,Votes,Resp,Resp,Votes):-atomic(Resp),!.
  875
  876%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  877% prologCall
  878%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  879computeAnswerND(Ctx,Votes,prologCall(Method,Stuff),Resp,VotesO):-
  880  computeAnswer(Ctx,Votes,Stuff,Mid,VotesO),
  881  call(Method,Ctx,Mid,Resp),!.
  882
  883computeAnswerND(_Ctx,Votes,prologCall(Method),Resp,VotesO):- atrace,
  884   once(call(Method)->(Resp=pass(Method),VotesO=Votes);(Resp=failed(Method),VotesO is Votes*0.5)),!.
  885
  886%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  887% Star Compounds
  888%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  889computeAnswerND(Ctx,Votes,star(Star,Attribs,InnerXml),Output,VotesO):- computeStar(Ctx,Votes,Star,Attribs,InnerXml,Output,VotesO),!.
  890
  891%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  892% withAttributes Compounds
  893%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  894
  895computeAnswerND(Ctx,Votes,Input,Output,VotesO):- functor(Input,withAttributes,_),
  896  Input = withAttributes(OuterAttribs,element(Tag,Attribs,InnerXml)),
  897  append(Attribs,OuterAttribs,AllAttribs),
  898  withAttributes(Ctx,OuterAttribs,once(computeAnswer(Ctx,Votes,element(Tag,AllAttribs,InnerXml),Output,VotesO);Failed=failed)),!,Failed \== failed.
  899
  900computeAnswerND(Ctx,Votes,withAttributes(OuterAttribs,InnerXml),Output,VotesO):-
  901  withAttributes(Ctx,OuterAttribs,once(computeAnswer(Ctx,Votes,InnerXml,Output,VotesO);Failed=failed)),!,Failed \== failed.
  902
  903computeAnswerND(Ctx,Votes,compute(InnerXml),Output,VotesO):-!, computeAnswer(Ctx,Votes,InnerXml,Output,VotesO).
  904
  905%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  906% Result or Proof already
  907%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  908
  909computeAnswerND(_Ctx,Votes,Res, Res,Votes):-resultOrProof(Res,_Mid),!.
  910
  911%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  912% Other Compounds
  913%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  914
  915computeAnswerND(Ctx,Votes,GETATTRIBS, Resp,VotesO):-
  916  convert_element(Ctx,GETATTRIBS,GETATTRIBS0),
  917  GETATTRIBS \== GETATTRIBS0,!,
  918  atrace,
  919  convert_element(Ctx,GETATTRIBS,_GETATTRIBS1),
  920  computeAnswer(Ctx,Votes,GETATTRIBS0, Resp,VotesO).
  921
  922%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  923% errors
  924%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55
  925
  926computeAnswerND(Ctx,Votes,GETATTRIBS, Resp,VotesO):- GETATTRIBS=..[GET], isAimlTag(GET), !, computeElementMust(Ctx,Votes,GET,[],[],Resp,VotesO).
  927computeAnswerND(Ctx,Votes,GETATTRIBS, Resp,VotesO):- GETATTRIBS=..[GET,ATTRIBS], isAimlTag(GET), !, computeElementMust(Ctx,Votes,GET,ATTRIBS,[],Resp,VotesO).
  928computeAnswerND(Ctx,Votes,GETATTRIBS, Resp,VotesO):- GETATTRIBS=..[GET,ATTRIBS,INNER], isAimlTag(GET), !, computeElementMust(Ctx,Votes,GET,ATTRIBS,INNER,Resp,VotesO).
  929
  930computeAnswerND(_Ctx,Votes,Resp,Resp,Votes):-atrace,aiml_error(computeAnswer(Resp)).
  931
  932% ===============================================================================================
  933% Run answer procs
  934% ===============================================================================================
  935
  936choose_randomsentence(X):-
  937	repeat,
  938		retract(random_sent(Y)),
  939		assertz(random_sent(Y)),
  940		4 is random(10),!,
  941		Y=X.
  942
  943% ===============================================================================================
  944% Get and rember Last Said
  945% ===============================================================================================
  946%% using dict now :-dynamic(getLastSaid/1).
  947%%:-setAliceMem(_,_,that,(['where',am,'I'])).
  948
  949rememberSaidIt(_Ctx,[]):-!.
  950rememberSaidIt(Ctx,_-R1):-!,rememberSaidIt(Ctx,R1).
  951rememberSaidIt(Ctx,R1):-append(New,'.',R1),!,rememberSaidIt(Ctx,New).
  952rememberSaidIt(Ctx,R1):-answerOutput(R1,SR1),R1\==SR1,!,rememberSaidIt(Ctx,SR1).
  953rememberSaidIt(Ctx,R1):- !,
  954   getAliceMem(Ctx,'bot','you',User),
  955   getAliceMem(Ctx,'bot','me',Robot),
  956   rememberSaidIt_SH(Ctx,R1,Robot,User).
  957
  958rememberSaidIt_SH(_Ctx,[],_Robot,_User):-!.
  959rememberSaidIt_SH(Ctx,_-R1,Robot,User):-!,rememberSaidIt_SH(Ctx,R1,Robot,User).
  960rememberSaidIt_SH(Ctx,R1,Robot,User):-append(New,[Punct],R1),sentenceEnderOrPunct_NoQuestion(Punct),!,rememberSaidIt_SH(Ctx,New,Robot,User).
  961rememberSaidIt_SH(Ctx,R1,Robot,User):-answerOutput(R1,SR1),!,
  962   setAliceMem(Ctx,Robot,'lastSaid',SR1),
  963   pushInto1DAnd2DArray(Ctx,'response','that',5,SR1,User).
  964
  965getRobot(Robot):-atrace,getAliceMem(_Ctx,'bot','me',Robot),!.
  966
  967getLastSaid(LastSaid):-getRobot(Robot),getAliceMem(_Ctx,Robot,'lastSaid',LastSaid).
  968
  969getLastSaidAsInput(LastSaidMatchable):-getLastSaid(That),convertToMatchable(That,LastSaidMatchable),!.
  970
  971% set some sane defaults to be overiden in config.xmls
  972:-prolog_must(setAliceMem('bot','me','bot')).
  973:-setAliceMem('bot','you','user').
  974:-setAliceMem('bot','name',['The','Robot']).
  975:-setAliceMem('bot',version,'1.0.1').
  976:-setAliceMem('user','name',['Unknown','Partner']).
  977:-setAliceMem('user','me','user').
  978:-setAliceMem('user','is_type','agent').
  979:-setAliceMem('bot','is_type','agent').
  980:-setAliceMem('default','is_type','role').
  981:-setAliceMem('bot','infinite-loop-input',['INFINITE','LOOP']).
  982%%:-setAliceMem(substitutions(_DictName),'is_type','substitutions').
  983
  984
  985% ===============================================================================================
  986% Template Output to text
  987% ===============================================================================================
  990computeTemplateOutput(Ctx,Votes,Input,Output,VotesO):-prolog_must(computeTemplate(Ctx,Votes,Input,Output,VotesO)).
  993computeInnerTemplate(Ctx,Votes,Input,Output,VotesO):-
  994    prolog_mustEach((computeTemplateOutput(Ctx,Votes,Input,Mid,VotesO),answerOutput(Mid,Output))).
  995
  996answerOutput(Output,NonVar):-nonvar(NonVar),answerOutput(Output,Var),!,valuesMatch(_Ctx,Var,NonVar).
  997answerOutput(Output,[Output]):-var(Output),!.
  998answerOutput([],Output):- !, Output=[].
  999%answerOutput(Output,Split):-atom(Output),atomWSplit(Output,Split),Split==[Output],!.
 1000%answerOutput(Output,Split):-atom(Output),atrace,atomWSplit(Output,Split),!.
 1001answerOutput('<br/>',['\n']):-!.
 1002answerOutput('<p/>',['\r\n']):-!.
 1003answerOutput(element('br',[],[]),['\n']):-!.
 1004answerOutput(Output,[Output]):-atomic(Output),!.
 1005answerOutput([<,BR,/,>|B],OO):-atom(BR),!,
 1006  answerOutput([element(BR,[],[])|B],OO),!.
 1007answerOutput([A|AA],Output):-!,
 1008   answerOutput(A,B),
 1009   answerOutput(AA,BB),
 1010   flatten([B,BB],Output).
 1011
 1012answerOutput(element(template,[],InnerXML),Output):- answerOutput(InnerXML,Output),!.
 1013
 1014answerOutput(element(Tag,Attribs,InnerXML),[element(Tag,Attribs,Output)]):- answerOutput(InnerXML,Output),!.
 1015answerOutput(star(Tag,Attribs,InnerXML),[star(Tag,Attribs,Output)]):- answerOutput(InnerXML,Output),!.
 1016answerOutput(Term,Output):-resultOrProof(Term,Mid),!,answerOutput(Mid,Output).
 1017answerOutput(Term,Output):-compound(Term),Term=..[_,Mid|_],debugFmt(answerOutput(Term->Mid)),!,answerOutput(Mid,Output).
 1018answerOutput(Output,[Output]):-!.
 1019
 1020lastMemberOrDefault(E,L,N,_D):-lastMember(E,L,N),!.
 1021lastMemberOrDefault(_Named=E,L,N,D):-L=N,E=D,!.
 1022lastMemberOrDefault(E,L,N,D):-L=N,E=D.
 1023
 1024
 1025% ===================================================================
 1026% Substitution based on Pred like sameWordsDict(String,Pattern).
 1027% ===================================================================
 1028
 1029convert_substs(A,D):-simplify_atom0(A,M),A\==M,!,convert_substs(M,D).
 1030convert_substs(A,D):-A=D.
 1031
 1032simplify_atom0(A,A):-A==[],!.
 1033simplify_atom0(A0,DD):- is_list(A0),joinAtoms(A0,' ',A),!,simplify_atom0(A,D),!,atomWSplit(D,DD),!.
 1034simplify_atom0(A,D):- atom(A),!,literal_atom(A,B),atomic_list_concat_aiml(L0,'\\b',B),delete(L0,'',L),joinAtoms(L,' ',C),!,atomWSplit(C,D),!.
 1035
 1036
 1037sameWordsDict([String|A],[Pattern|B]):-!,sameWordsDict0(String,Pattern),!,sameWordsDict_l(A,B),!.
 1038sameWordsDict(String,Pattern):-sameWordsDict0(String,Pattern),!.
 1039
 1040sameWordsDict_l([String|A],[Pattern|B]):-sameWordsDict0(String,Pattern),sameWordsDict_l(A,B),!.
 1041sameWordsDict_l([],[]):-!.
 1042
 1043sameWordsDict0(verbatum(_String),_):-!,fail.
 1044sameWordsDict0(_,verbatum(_Pattern)):-!,fail.
 1045sameWordsDict0(String,Pattern):-compound(String),
 1046   prolog_must((answerOutput_atom(String,String1),debugFmt(interactStep(String,String1,Pattern)),String \== String1)),!,
 1047   sameWordsDict0(String1,Pattern).
 1048
 1049sameWordsDict0(String,Pattern):-compound(Pattern),
 1050   prolog_must((answerOutput_atom(Pattern,Pattern1),debugFmt(interactStep(Pattern,Pattern1,String)), Pattern \== Pattern1)),!,
 1051   sameWordsDict0(String,Pattern1).
 1052
 1053sameWordsDict0(String,Pattern):-String==Pattern,!,debugFmt(sameWordsDict(String,Pattern)).
 1054%sameWordsDict0(String,Pattern):-debugFmt(sameWordsDict0(String,Pattern)),wildcard_match(Pattern,String),!.
 1055%sameWordsDict0(String,Pattern):-dwim_match(Pattern,String),!.
 1056
 1057answerOutput_atom(Pattern,Pattern1):-unresultify(Pattern,Pattern0),unlistify(Pattern0,Pattern1),!,prolog_must(atomic(Pattern1)).
 1058
 1059dictReplace(DictName,Before,After):-dict(substitutions(DictName),Before,After).%%convert_substs(Before,B),convert_template(Ctx,After,A).
 1060
 1061substituteFromDict(Ctx,DictName,Hidden,Output):-answerOutput(Hidden,Mid),Hidden\==Mid,!,substituteFromDict(Ctx,DictName,Mid,Output),!.
 1062
 1063substituteFromDict(Ctx,DictName,Hidden,Output):- dictReplace(DictName,_,_),prolog_must(substituteFromDict_l(Ctx,DictName,Hidden,Output)),!.
 1064
 1065substituteFromDict(_Ctx,DictName,Hidden,Output):- dictReplace(DictName,_,_),!,
 1066      recorda(DictName,Hidden),
 1067      forall(dictReplace(DictName,Before,After),
 1068          (recorded(DictName,Start,Ref),
 1069          erase(Ref),
 1070          pred_subst(sameWordsDict,Start,Before,verbatum(After),End),
 1071          recorda(DictName,End))),
 1072      recorded(DictName,Output,Ref),
 1073      debugFmt(substituteFromDict(Hidden,Output)),
 1074      erase(Ref),!.
 1075
 1076substituteFromDict(Ctx,DictName,Hidden,Result):- isGenTemplate(Ctx,[]),!,Result=[substs,DictName,on,Hidden].
 1077substituteFromDict(_Ctx,DictName,Hidden,result([substs,DictName,on,Hidden],Result)):-Result=..[DictName,Hidden].
 1078
 1079substituteFromDict_l(_Ctx,_DictName,Hidden,Output):-atomic(Hidden),!,Hidden=Output.
 1080substituteFromDict_l(Ctx,DictName,[V|Hidden],[V|Output]):-verbatum(_)==V,!,substituteFromDict_l(Ctx,DictName,Hidden,Output).
 1081substituteFromDict_l(Ctx,DictName,Hidden,[verbatum(After)|Output]):-dictReplace(DictName,Before,After),
 1082   debugOnError((length(Before,Left),length(NewBefore,Left))),
 1083   append(NewBefore,Rest,Hidden),sameBinding(NewBefore,Before),!,substituteFromDict_l(Ctx,DictName,Rest,Output).
 1084substituteFromDict_l(Ctx,DictName,[V|Hidden],[V|Output]):-substituteFromDict_l(Ctx,DictName,Hidden,Output).
 1085
 1086:- addScopeParent(toplevel,cateFallback).
 1087:- addScopeParent(filelevel,toplevel).
 1088:- addScopeParent(category,filelevel).
 1089:- prolog_mustEach((cateFallback(ATTRIBS), pushAttributes(_Ctx,cateFallback,ATTRIBS))).
 1090%%:- prolog_mustEach((cateFallback(ATTRIBS), popAttributes(_Ctx,cateFallback,ATTRIBS), !)).
 1091%%:- cateFallback(ATTRIBS), pushAttributes(_Ctx,cateFallback,ATTRIBS).
 1092
 1093% run main loop if this was the toplevel file
 1094do_main_if_load:- current_prolog_flag(associated_file,File),file_base_name(File, 'logicmoo_module_aiml.pl')->aiml_main_loop;true.
 1095
 1096:- writeln('%~ MAYBE:  @load aiml/lilSophia').
 1097:- writeln('%~ MAYBE:  @load aiml/lilSo.aiml').
 1098:- writeln('%~ MAYBE:  @load aiml/lilSo2.aiml').
 1099:- writeln('%~ MAYBE:  @load aiml/lilSo3.aiml').