1% ===================================================================
    2% File 'logicmoo_module_aiml_eval.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/*:- if((current_prolog_flag(version,MMmmPP),MMmmPP<70000)).
   16:- style_check(-atom).
   17:- style_check(-string).
   18:- endif.
   19*/

   20
   21:-discontiguous(tag_eval/3).
   22
   23% ===================================================================
   24%  Prolog-like call
   25% ===================================================================
   26:- meta_predicate(aiml_call(+,+)).
   27
   28aiml_call(Ctx,_ - Calls):- must(nonvar(Calls)), !,aiml_call(Ctx,Calls),!.
   29
   30aiml_call(Ctx,[Atomic|Rest]):- atom(Atomic),!, %%atrace, 
   31            aiml_eval(Ctx,[Atomic|Rest],Output),!,
   32            debugFmt(resultOf(aiml_call(Ctx,[Atomic|Rest]),Output)),!.
   33
   34aiml_call(Ctx,[Atomic|Rest]):- !, %%atrace, 
   35            aiml_eval(Ctx,[Atomic|Rest],Output),!,
   36            debugFmt(resultOf(aiml_call(Ctx,[Atomic|Rest]),Output)),!.
   37
   38% ============================================
   39% Test Suite  
   40% ============================================
   41:-dynamic(ju:unitTestResult/2).
   42
   43aiml_call(Ctx,element('testsuite',ATTRIBS,LIST)):-
   44     withAttributes(Ctx,ATTRIBS,maplist_safe(aiml_call(Ctx),LIST)),
   45     unify_listing(ju:unitTestResult(unit_passed,PRINTRESULT),Passed),
   46     unify_listing(ju:unitTestResult(unit_failed,PRINTRESULT),Failed),
   47     dmsg(testsuite_passed_failed(Passed,Failed)),!.
   48
   49aiml_call(Ctx,Current):- Current=element(TC,ATTRIBS,_LIST), member(TC,['testcase','TestCase']),!,
   50  prolog_must((
   51     attributeValue(Ctx,Current,['name'],Name,'SomeName'),
   52     attributeValue(Ctx,Current,['Input','Pattern'],Input,'ERROR Input'),
   53     attributeValue(Ctx,Current,['Description'],Description,'No Description'),
   54     attributeValue(Ctx,Current,['ExpectedAnswer'],ExpectedAnswer,['noExpectedAnswer']),
   55     findall(ExpectedKeywords0,(attributeValue(Ctx,Current,['ExpectedKeywords'],ExpectedKeywords,['noExpectedKeywords']),
   56                                listify(ExpectedKeywords,ExpectedKeywords0)),ExpectedKeywordsList),
   57     testIt(ATTRIBS,Input,ExpectedAnswer,ExpectedKeywordsList,_Result,Name,Description,Ctx))),!.
   58
   59aiml_call(Ctx,element(A, B, C)):- tagType(A, immediate), prolog_must(nonvar(C)),
   60      convert_name(A,AA),
   61      convert_attributes(Ctx,B,BB),
   62      convert_template(Ctx,C,CC),
   63      (element(A, B, C) \== element(AA, BB, CC)),!,      
   64      aiml_call(Ctx,element(AA, BB, C)),!.
   65
   66
   67aiml_call(Ctx,element(A, B, C)):- prolog_must(nonvar(C)),
   68      convert_name(A,AA),
   69      convert_attributes(Ctx,B,BB),
   70      convert_template(Ctx,C,CC),
   71      (element(A, B, C) \== element(AA, BB, CC)),!,atrace,
   72      aiml_call(Ctx,element(AA, BB, C)),!.
   73
   74aiml_call(Ctx,element(Learn, ATTRIBS, Value)):-  member(Learn,[load,learn]),!,
   75 prolog_must((
   76     attributeValue(Ctx,ATTRIBS,[graph],Graph,'$current_value'),
   77     pathAttrib(PathAttrib),
   78     attributeValue(Ctx,ATTRIBS,PathAttrib,Filename,'$value'(Value)),
   79      withAttributes(Ctx,[srcfile=Filename,graph=Graph|ATTRIBS],
   80      load_aiml_files(Ctx,Filename)))).
   81
   82aiml_call(Ctx,Call):- Call \= element(_,_,_), callEachElement(Ctx,Call),!.
   83
   84aiml_call(Ctx,INNER_XML):-aiml_eval(Ctx,INNER_XML,Rendered),!, debugFmt(Rendered),!.
   85
   86aiml_call(Ctx,element(genlmt,TOFROM,_)):-
   87 prolog_must((
   88      attributeValue(Ctx,TOFROM,[to,name],TO,'$error'),
   89      attributeValue(Ctx,TOFROM,[graph,from],FROM,'$current_value'),
   90      immediateCall(Ctx,assertz(genlMtGraph(TO,FROM))))),!.
   91
   92 aiml_call(Ctx,element(Learn, ATTRIBS, Value)):- aiml_error(aiml_call(Ctx,element(Learn, ATTRIBS, Value))),!.
   93
   94
   95% ===================================================================
   96%  Prolog-like call
   97% ===================================================================
   98
   99callEachElement(Ctx,[C|Calls]):-!, callEachElement(Ctx,C),callEachElement(Ctx,Calls).
  100callEachElement(Ctx,element(A,B,C)):- convert_element(Ctx,element(A,B,C),ELE),callEachElement(Ctx,ELE),!.
  101callEachElement(_Ctx,C):-callInteractive(C,_).
  102
  103% ===================================================================
  104%  render templates
  105% ===================================================================
  106
  107aiml_eval_to_unit(Ctx,ValueI,ValueO):-is_list(ValueI),!,aiml_eval_each(Ctx,ValueI,ValueO),!.
  108aiml_eval_to_unit(Ctx,ValueI,ValueO):-aiml_eval0(Ctx,ValueI,ValueO),!.
  109
  110render_value(template,ListOut,Render):-aiml_eval(_Ctx,ListOut,Render),!.
  111
  112aiml_eval_each(Ctx,In,Out):-prolog_must((prolog_mostly_ground(In),var(Out))),aiml_eval_each_l(Ctx,In,Out).
  113aiml_eval_each_l(Ctx,[A|ATTRXML],Output):-aiml_eval0(Ctx,A,R),!,aiml_eval_each_l(Ctx,ATTRXML,RESULT),prolog_must(Output=[R|RESULT]).
  114aiml_eval_each_l(_Ctx,[],[]):-!.
  115
  116aiml_eval(_Ctx,TAGATTRXML,RESULT):- TAGATTRXML == [],!,RESULT=TAGATTRXML.
  117aiml_eval(_Ctx,TAGATTRXML,_RESULT):- prolog_must(nonvar(TAGATTRXML)),fail.
  118aiml_eval(Ctx,TAGATTRXML,RESULT):- 
  119           immediateCall(Ctx,aiml_eval_now(Ctx,TAGATTRXML)),
  120           aiml_eval0(Ctx,TAGATTRXML,RESULT),!.
  121
  122aiml_eval_now(Ctx,TAGATTRXML):-Ctx==[[fctx]],!,aiml_eval_now0(_,TAGATTRXML).
  123aiml_eval_now(Ctx,TAGATTRXML):-aiml_eval_now0(Ctx,TAGATTRXML).
  124aiml_eval_now0(Ctx,TAGATTRXML):-aiml_eval(Ctx,TAGATTRXML,RESULT),!,debugFmt(aiml_eval_now(Ctx,TAGATTRXML,RESULT)).
  125
  126
  127immediateCall(Ctx,:-(Call)):-!,immediateCall0(Ctx,:-(Call)),!.
  128immediateCall(Ctx,Call):-immediateCall0(Ctx,:-(Call)),!.
  129
  130immediateCall0(Ctx,C):-functor(C,call,_),prolog_mustEach((C=..[call,A|Args],A=..L,append(L,Args,Out),Call=..Out,!,immediateCall0(Ctx,Call))).
  131immediateCall0(Ctx,C):-toReadableObject(C,Call),immediateCall1(Ctx,Call),!.
  132%%immediateCall1(_Ctx,C):- prolog_mostly_ground((C)),fail.
  133immediateCall1(_Ctx,_Call):- noConsoleDebug,isConsole,!.
  134immediateCall1(_Ctx,Call):- fresh_line,(format('~q.',[Call])),fresh_line. %%,debugFmt(Call),!.
  135
  136%aiml_eval0(Ctx,[ValueI],ValueO):-atom(ValueI),!,aiml_eval(Ctx,ValueI,ValueO),!.
  137%aiml_eval0(Ctx,[Value|I],ValueO):-atom(Value),atomic_list_concat_aiml([Value|I],' ',ValueI),!,aiml_eval(Ctx,ValueI,ValueO),!.
  138%aiml_eval0(Ctx,ValueI,ValueO):- !,ValueI=ValueO,!.
  139
  140aiml_eval0(Ctx,I,R):- nonvar(R),throw_safe(var(R=aiml_eval0(Ctx,I,R))),!.
  141aiml_eval0(Ctx,_ - Calls,_):- var(Calls),throw_safe(var(Ctx=Calls)),!.
  142
  143aiml_eval0(Ctx,_Num - Msg,Result):-is_list(Msg),!,aiml_eval_each(Ctx,Msg,Result),!.
  144
  145aiml_eval0(Ctx,_Num - Msg,Result):-!,aiml_eval(Ctx,Msg,Result),!.
  146
  147%aiml_evalL(_Ctx,[],[]):-!.
  148%aiml_evalL(Ctx,[Atomic|Rest],[Atomic|Output]):-atomic(Atomic),!,aiml_eval_each(Ctx,Rest,Output),!.
  149
  150aiml_eval0(_Ctx,A,B):-atomic(A),!,B=A.
  151
  152aiml_eval0(Ctx,element(Srai,ATTRIBS,DOIT),RETURN):- memberchk(Srai,[srai,template]),
  153      withAttributes(Ctx,ATTRIBS,
  154         (aiml_notrace((aiml_eval_each(Ctx,DOIT,INNER),
  155          computeAnswer(Ctx,1,element(Srai,ATTRIBS,INNER),RMID,_Votes))))),
  156       RMID=RETURN.
  157
  158aiml_eval0(Ctx,element(A, B, C), XML):-tagType(A, immediate),
  159      convert_name(A,AA),
  160      convert_attributes(Ctx,B,BB),
  161      aiml_eval_each(Ctx,C,CC),
  162      (element(A, B, C) \== element(AA, BB, CC)),!,
  163      aiml_eval(Ctx,element(AA, BB, CC),XML),!.
  164
  165
  166% NEXT aiml_evalL(Ctx,[A|AA], [B|BB]):- aiml_eval(Ctx,A,B),convert_template(Ctx,AA,BB),!.
  167%aiml_eval(Ctx,[A|AA], [B|BB]):- convert_element(Ctx,A,B),aiml_eval(Ctx,AA,BB),!.
  168%%aiml_eval(Ctx,[A|AA], [B|BB]):- convert_element(Ctx,A,B),convert_template(Ctx,AA,BB),!.
  169
  170
  171
  172% ===================================================================
  173%  template tag impl
  174% ===================================================================
  175
  176
  177%aiml_eval(Ctx,INNER_XML,[debugFmt(Rendered)]):-aiml_eval(Ctx,INNER_XML,Rendered),!.
  178
  179
  180% ===================================================================
  181%  MISSING tag impl
  182% ===================================================================
  183%%aiml_eval(Ctx,AIML,[debugFmt(aiml_eval_missing(AIML))]):-!.
  184
  185
  186aiml_eval0(_Ctx,element(In, ATTRIBS, Value),element(In, ATTRIBS, Value)):- preserveTag(In,_Out),!.
  187aiml_eval0(Ctx,element(Learn, ATTRIBS, Value),RESULT):- tag_eval(Ctx,element(Learn, ATTRIBS, Value),RESULT),!.
  188
  189aiml_eval0(Ctx,TAGATTRXML,RESULT):-TAGATTRXML=..[TAG,ATTR,[]],isAimlTag(TAG),!,tag_eval(Ctx,element(TAG,ATTR,[]),RESULT),!.
  190aiml_eval0(Ctx,TAGATTRXML,RESULT):-TAGATTRXML=..[TAG,ATTR,[X|ML]],isAimlTag(TAG),!,tag_eval(Ctx,element(TAG,ATTR,[X|ML]),RESULT),!.
  191
  192aiml_eval0(Ctx,element(In, ATTRIBS, Value),Result):- convert_element(Ctx,element(In, ATTRIBS, Value),Result),!.
  193
  194aiml_eval0(Ctx,element(Learn, ATTRIBS, Value),_):- aiml_error(aiml_eval(Ctx,element(Learn, ATTRIBS, Value))),!.
  195
  196aiml_eval0(_Ctx,RESULT,RESULT):-!.
  197
  198
  199% ===================================================================
  200%  eval tag impl
  201% ===================================================================
  202tag_eval(Ctx,In,Out):-isGenTemplate(Ctx,[]),!,Out=eval(In).
  203
  204tag_eval(Ctx,element(eval,ATTRIBS,INNER_XML),Rendered):-!,
  205   withAttributes(Ctx,ATTRIBS,aiml_eval_each(Ctx,INNER_XML,Rendered)),!.
  206
  207% ===================================================================
  208%  system tag impl
  209% ===================================================================
  210tag_eval(Ctx,I,R):- nonvar(R),throw_safe(var(R=tag_eval(Ctx,I,R))),!.
  211tag_eval(Ctx,_ - Calls,_):- var(Calls),throw_safe(var(tag_eval(Ctx=Calls))),!.
  212
  213tag_eval(Ctx,element(system,ATTRIBS,INNER_XML),Output):-
  214         aiml_eval_each(Ctx,INNER_XML,Rendered),
  215         attributeValue(Ctx,ATTRIBS,[lang],Lang,['bot']),        
  216         systemCall(Ctx,Lang,Rendered,Output),!.
  217
  218
  219systemCall(Ctx,[Lang],Eval,Out):- nonvar(Lang),!, systemCall(Ctx,Lang,Eval,Out).
  220
  221systemCall(_Ctx,_Lang,[],[]):-!.
  222systemCall(Ctx,Lang,[Skipable|REST],DONE):-isWhiteWord(Skipable),!,systemCall(Ctx,Lang,REST,DONE).
  223systemCall(Ctx,Lang,[FIRST|REST],DONE):-atom_concat_safe('@',CMD,FIRST),!,systemCall(Ctx,Lang,[CMD|REST],DONE).
  224systemCall(Ctx,Lang,[FIRST|REST],DONE):-atom_contains(FIRST,' '),atomWSplit(FIRST,CMD),append(CMD,REST,CMDREST),!,systemCall(Ctx,Lang,CMDREST,DONE).
  225systemCall(Ctx,'bot',REST,OUT):-!,prolog_must(systemCall_Bot(Ctx,REST,OUT)),!.
  226systemCall(Ctx,Lang,[Eval],Out):-systemCall(Ctx,Lang,Eval,Out).
  227systemCall(Ctx,Lang,Eval,Out):-once((atom(Eval),atomWSplit(Eval,Atoms))),Atoms=[_,_|_],!,atrace,systemCall(Ctx,Lang,Atoms,Out).
  228systemCall(_Ctx,Lang,Eval,writeq(evaled(Lang,Eval))):- aiml_error(evaled(Lang,Eval)).
  229
  230systemCall_Bot(Ctx,['@'|REST],DONE):-!,systemCall_Bot(Ctx,REST,DONE).
  233systemCall_Bot(Ctx,ALLREST,template([mutiple,DONE1,DONE])):-append([F|IRST],['@'|REST],ALLREST),!,
  234      systemCall_Bot(Ctx,[F|IRST],DONE1),systemCall_Bot(Ctx,REST,DONE).
  235
  236systemCall_Bot(Ctx,[Skipable|REST],DONE):-isWhiteWord(Skipable),!,systemCall_Bot(Ctx,REST,DONE).
  237systemCall_Bot(Ctx,[FIRST|REST],DONE):-atom_concat_safe('@',CMD,FIRST),CMD\=='',!,systemCall_Bot(Ctx,['@',CMD|REST],DONE).
  238systemCall_Bot(_Ctx,['eval'|DONE],template([evaled,DONE])):-!.
  239systemCall_Bot(Ctx,['say'|REST],template([said,Output])):- computeTemplateOutput(Ctx,1,REST,Output,_VotesOut).
  240systemCall_Bot(Ctx,['say1'|REST],Output):- computeTemplateOutput(Ctx,1,REST,Output,_VotesOut).
  241
  242systemCall_Bot(_Ctx,['echo'|DONE],DONE):-!.
  243systemCall_Bot(Ctx,['set'],template([setted,Ctx])):-!,unify_listing(getUserDicts(_User,_Name,_Value)),!.
  244systemCall_Bot(Ctx,['set',Dict,Name,'='|Value],template([setted,Name,Value])):- setAliceMem(Ctx,Dict,Name,Value),!.
  245systemCall_Bot(Ctx,['set',Name,'='|Value],template([setted,Name,Value])):- setAliceMem(Ctx,'user',Name,Value),!.
  246systemCall_Bot(Ctx,['set',Name|Value],template([setted,Name,Value])):- setAliceMem(Ctx,'user',Name,Value),!.
  247
  248systemCall_Bot(Ctx,['get',Name|MajorMinor],template([getted,Dict,Value,Found1])):- getDictFromAttributes(Ctx,evalsrai,[],SYM),
  249  list_to_set_preserve_order([SYM,user,robot,Name],List),
  250  debugFmt(getIndexedValue(Ctx,List,Name,MajorMinor,values)),
  251  forall(member(Dict,List),ignore((unify_listing(getIndexedValue(Ctx,Dict,Name,MajorMinor,Value),Found),Found>0,Found1=Found))),!.
  252
  253systemCall_Bot(Ctx,['get'],template([getted,Passed])):- unify_listing(getContextStoredValue(Ctx,_,_,_),Passed).
  254systemCall_Bot(Ctx,['ctx'],template([ctxed,Atom])):-!,term_to_atom(Ctx,Atom),!.
  255systemCall_Bot(Ctx,['ctx'],template([ctxed,prologCall(Atom,term_to_atom(Ctx,Atom))])):-!,showCtx(Ctx).
  256systemCall_Bot(Ctx,['load'|REST],OUT):- !, prolog_must(systemCall_Load(Ctx,REST,OUT)),!.
  257systemCall_Bot(Ctx,['find'|REST],OUT):- !, prolog_must(systemCall_Find(Ctx,REST,OUT)),!.
  258systemCall_Bot(Ctx,['chgraph',Graph],['successfully','set','to','graph',Graph]):- setAliceMem(Ctx,user,graph,Graph),!.
  259systemCall_Bot(_Ctx,['substs',DictName],['substsof',DictName]):- unify_listing(dictReplace(DictName,_,_)),!.
  260systemCall_Bot(_Ctx,['substs'],['substsof','all']):- unify_listing(dictReplace(_DictName,_,_)),!.
  261
  262
  263systemCall_Bot(Ctx,['ctxlist'],template([ctxed])):-!,showCtx(Ctx),!.
  264systemCall_Bot(Ctx,['ctxlist'],template([ctxed,current_value(Ctx,Name,Value),Count])):-!,unify_listing(getCtxValue_nd(Ctx,Name,Value),Count),!.
  265
  266
  267
  268
  269systemCall_Bot(Ctx,[FIRST|REST],DONE):-toLowerIfAtom(FIRST,CMD),FIRST\==CMD,!,systemCall_Bot(Ctx,[CMD|REST],DONE).
  270systemCall_Bot(Ctx,List,YN):- append(New,[('.')],List),!,systemCall_Bot(Ctx,New,YN).
  271
  272systemCall_Bot(_Ctx,[prolog],YN):- prolog  -> YN=['Yes.'] ; YN=['No.'].
  273systemCall_Bot(_Ctx,[prolog,Call],YN):- predicate_property(Call,defined),!,call(Call)-> YN=['Yes.'] ; YN=['No.'].
  274systemCall_Bot(_Ctx,DONE,template([delayed,DONE])).
  275
  276showCtx(Ctx):-forall(
  277  (get_ctx_frame_holder(Ctx,Dict,Frame,Held)),
  278  writeq(get_ctx_frame_holder(Ctx,Dict,Frame,Held))).
  279
  280systemCall_Load(Ctx,[],template([loaded,Ctx])):-!.
  281systemCall_Load(Ctx,[File,Name|S],Output):-joinAtoms([File,Name|S],'',Filename),!,systemCall(Ctx,'bot',['load',Filename],Output).
  282
  283systemCall_Load(Ctx,[Filename],Result):-
  284 with_no_gc(
  285   (peekNameValue(Ctx,_,graph,GraphI,'$first'(['$current_value','$value'('*')])), 
  286    systemCall_Load_Graph(Ctx,Filename,GraphI,Result))).
  287
  288systemCall_Load_Graph(Ctx,Filename,GraphI,template([loaded,Filename,into,Graph])):-
  289 with_no_gc(
  290  ((GraphI=='*'->Graph=default; Graph=GraphI),
  291    ATTRIBS=[srcfile=Filename,graph=Graph],
  292    gather_aiml_graph(Ctx,ATTRIBS,Graph,Filename,AIML),
  293    warnIf(not(atomic(Graph))),
  294    warnIf(not(atomic(Filename))),
  295    withAttributes(Ctx,ATTRIBS,load_aiml_structure(Ctx,AIML)))),!.
  296
  297systemCall_Find(_Ctx,REST,proof(CateSig,REST)):-
  298         findall(U,(member(L,REST),literal_atom(L,U)),UUs),
  299         aimlCateSig(CateSig),
  300         findall(CateSig,
  301             (CateSig,once((term_to_atom(CateSig,Atom),literal_atom(Atom,U1),member(U2,UUs),sub_atom(U1,_,_,_,U2),
  302              debugFmt(CateSig)))),_List),!.
  303
  304% ===================================================================
  305%  learn tag impl
  306% ===================================================================
  307
  308% 0.9 version
  309tag_eval(Ctx,element(Learn, ATTRIBS, EXTRA),[loaded,Filename,via,Learn,into,Graph]/*NEW*/):- 
  310  member(Learn,[load,learn]),
  311 prolog_must((
  312     attributeValue(Ctx,ATTRIBS,[graph],Graph,'$current_value'),
  313     pathAttribS(PathAttribS),
  314     attributeValue(Ctx,ATTRIBS,PathAttribS,Filename,EXTRA),
  315      gather_aiml_graph(Ctx,ATTRIBS,Graph,Filename,MOREXML),
  316      append(EXTRA,MOREXML,NEWXML),      
  317      ATTRIBSNEW=[srcfile=Filename,graph=Graph|ATTRIBS],
  318       NEW = element(aiml,ATTRIBSNEW,NEWXML),  
  319        withAttributes(Ctx,ATTRIBSNEW,
  320            load_aiml_structure(Ctx,NEW)))),!.
  321
  322
  323gather_aiml_graph(Ctx,XML,Graph,Filename,AIML):-
  324 ATTRIBS=[srcfile=Filename,graph=Graph|XML],
  325 withAttributes(Ctx,ATTRIBS,graph_or_file(Ctx,ATTRIBS, Filename, AIML)).
  326
  327% ============================================
  328% Test Suite  (now uses aiml_call/2 instead of tag_eval/3)
  329% ============================================
  330:-dynamic(ju:unitTestResult/2).
  331
  332tagIsCall('testsuite').
  333tagIsCall('testcase').
  334tagIsCall('TestCase').
  335
  336tag_eval(Ctx,element(CallTag,ATTRIBS,LIST),prologCall(aiml_call(Ctx,element(CallTag,ATTRIBS,LIST)))):-tagIsCall(CallTag),!.
  337
  338prologCall(Call):-catch(prolog_must(Call),E,debugFmt(failed_prologCall(Call,E))),!.
  339
  340testIt(ATTRIBS,Input,ExpectedAnswer,ExpectedKeywords,Result,Name,Description,Ctx):- 
  341   notrace(ExpectedKeywords==[[noExpectedKeywords]] -> PASSGOAL = sameBinding(Resp,ExpectedAnswer);  PASSGOAL = containsEachBinding(Resp,ExpectedKeywords)),
  343    withAttributes(Ctx,ATTRIBS,(( runUnitTest(alicebotCTX(Ctx,Input,Resp),PASSGOAL,Result),
  344     prolog_must(ground(Resp)),
  345    toReadableObject(testIt(Input,Name,Description,PASSGOAL),PRINTRESULT),
  346    toReadableObject([Result,Name,Description,Input], STORERESULT),
  347    debugFmt(PRINTRESULT)))),flush_output,
  348    once(
  349     contains_term(STORERESULT,unit_failed) ->
  350      (assert(ju:unitTestResult(unit_failed,f(PRINTRESULT,PASSGOAL))), true );
  351      assert(ju:unitTestResult(unit_passed,PRINTRESULT))),!
  351.
  352
  353
  354containsEachBinding(_-Resp,ExpectedList):-!,containsEachBinding(Resp,ExpectedList).
  355containsEachBinding(Resp,ExpectedList):-maplist_safe(containsSubBinding(Resp),ExpectedList).
  356
  357containsSubBinding(X,Y):-hotrace((sameBinding_listify(X,X1),sameBinding_listify(Y,Y1))),!,subList(X1,Y1),!.
  358
  359sameBinding_listify(X,X1):-sameBinding1(X,X0),listify(X0,X1),!.
  360
  361subList(X1,Y1):-append(Y1,_,Y1Opened),!,append(_,Y1Opened,X1),!.
  362
  363
  364tag_eval(_Ctx,element(In, ATTRIBS, Value),element(In, ATTRIBS, Value)):- preserveTag(In,_Out),!.
  365tag_eval(_Ctx,LIST1,LIST2):-debugFmt(tag_eval(LIST1->LIST1)),!,prolog_must(LIST1=LIST2),!.
  366
  367
  368preserveTag(In,Out):- member(Out,['input','description',expectedAnswer,expectedkeywords,'Name']),atomsSameCI(In,Out),!.
  369
  370runUnitTest(Call,Req,Result):-runUnitTest1(Call,Result1),!,runUnitTest2(Req,Result2),!,Result=unit(Result1,Result2),debugFmt(Result),!.
  371
  372runUnitTest1(Req,Result):-hotrace(error_catch((Req-> Result=unit_passed(Req); Result=unit_failed(Req)),E,Result=unit_error(E,Req))).
  373runUnitTest2(Req,Result):-hotrace(error_catch((Req-> Result=unit_passed(Req); Result=unit_failed(Req)),E,Result=unit_error(E,Req))).
  374
  375sameBinding(X,Y):-hotrace((sameBinding1(X,X1),sameBinding1(Y,Y1),!,X1=Y1)),!.
  376
  377sameBinding1(X,X):-var(X),!.
  378sameBinding1(_-X,Y):-nonvar(X),!,sameBinding1(X,Y).
  379sameBinding1(X,Z):- convertToMatchableCS(X,Y),X\==Y,!,sameBinding1(Y,Z).
  380%sameBinding1([A|B],AB):-convertToMatchableCS([A|B],AB),!.
  381sameBinding1(X,Y):- X=Y,!.
  382%sameBinding1(X,Y):- balanceBinding(X,Y),!.
  383
  384
  385sameBindingIC(X,Y):-hotrace((sameBinding1(X,X1),convertToMatchable(X1,X2),sameBinding1(Y,Y1),convertToMatchable(Y1,Y2),!,closeEnough1(X2,Y2))),!.
  386
  387closeEnough1(X,Y):-X=Y,!.
  388closeEnough1(X,Y):-X\=[],Y\=[],closeEnough2(X,Y),!.
  389closeEnough2(X,Y):-starMatch(Y,X,_) ; starMatch(X,Y,_).
  390
  391
  392
  393/*
  394sameBindingIC([yes,i,agree],[no,i,dont,agree]).
  395sameBindingIC([yes,i,agree],[*,agree])
  396sameBindingIC([*,agree,*],[yes,i,agree,to]).
  397
  398
  399*/