1% ===================================================================
    2% File 'logicmoo_module_aiml_main.pl'
    3% Purpose: To load and test the AIML interpretor (sanity checks)
    4% Maintainers: Douglas Miles/Annie Ogborn/Kino Coursey
    5% Contact: $Author: dmiles $@users.sourceforge.net ;
    6% Version: 'logicmoo_module_aiml_main.pl' 1.0.0
    7% Revision:  $Revision: 1.7 $
    8% Revised At:   $Date: 2002/07/11 21:57:28 $
    9% ===================================================================
   10
   11:-ensure_loaded(logicmoo_module_aiml_toplevel).
   12
   13:-dynamic(recordedTime/2).           
   14timeRecorded(Call):-timeRecorded(Call,Time),asserta(recordedTime(Time,Call)),listing(recordedTime/2),!.
   15timeRecorded(Call,Time):- statistics(cputime,Start),context_module(M),prolog_statistics:time(M:Call),statistics(cputime,End),Time is End - Start.
   16% :-catch(noguitracer,E,writeq(E)),nl.
   17
   18save:-tell(aimlCate),
   19   aimlCateSig(CateSig),
   20   listing(CateSig),
   21   listing(dict),
   22   told,
   23   predicate_property(CateSig,number_of_clauses(N)),
   24   predicate_property(dict(_,_,_),number_of_clauses(ND)),
   25   debugFmt([aimlCate=N,dict=ND]),!.
   26
   27dt:- withAttributes(Ctx,[graph='ChomskyAIML'],load_aiml_files(Ctx,'chomskyAIML/*.aiml')).
   28
   29do:-load_aiml_files,alicebot.
   30
   31
   32hasLibrarySupport :- absolute_file_name(library('programk/logicmoo_module_aiml_toplevel.pl'),File),exists_file(File).
   33throwNoLib:-  absolute_file_name('.',Here),throw(error(existence_error(url, Here), context(_, status(404, Here)))).
   34
   35% up one if we are in same directory
   36 up_one_if :- absolute_file_name('./logicmoo_module_aiml_toplevel.pl',File),(exists_file(File)->cd('../');true).
   37
   38%:- leash(-all).
   39
   40%:- trace.
   41
   42%:- up_one_if.
   43
   44
   45% if not has library suport, add this directory as a library directory
   46addSupportHere:-
   47  absolute_file_name('logicmoo_module_aiml_toplevel.pl',File),
   48  (exists_file(File)-> ((
   49  absolute_file_name('.',Here),
   50  asserta(library_directory(Here))));true).
   51
   52%:-not(hasLibrarySupport)->addSupportHere;true.
   53
   54%:-hasLibrarySupport->true;throwNoLib.
   55
   56% goal is to remove this next line and have it work!
   57%%:-ensure_loaded(library('autolog/autolog.pl')).
   58%:-ensure_loaded(library('programk/logicmoo_module_aiml_toplevel.pl')).
   59
   60
   61%:-ensure_loaded('bootstrap.aiml.pl').
   62
   63% :- tell(listing1),listing,told.
   64
   65dtt:- timeRecorded(dt),statistics,alicebot.
   66
   67dttt:-timeRecorded(consult(aimlCate_checkpoint)),alicebot.
   68
   69:-catch(noguitracer,_,true).
   70:-traceAll.
   71
   72% :-asserta((portray_text:do_portray_text(X) :- writeq(p(X)))).
   73
   74% :-list_undefined.
   75
   76% :-debug.
   77
   78%:-dttt.
   79%:-do.
   80%:-load_aiml_files.
   81%:-debug,run_chat_tests.
   82%:-main_loop.
   83% :-'trace'(findall/3,[-all]).
   84
   85stdCatchAll:-
   86 % Catch all
   87   assert_cate_in_load(aimlCate(*,*,*,*,*,*,*,*,*,*,
   88      [element(srai,[],['STDCATCHALL',star(pattern,[],[])])],
   89       element(category,[],[element(pattern,[],[*]),
   90        element(template,[],[element(srai,[],['STDCATCHALL',element(star,[],[])])])]),
   91    'c:/development/opensim4opencog/bin/cynd/programk/test_suite/customtagtest.aiml':737-20056,aruleStd2)),
   92 % Complain
   93  assert_cate_in_load(aimlCate(*,*,*,*,*,['STDCATCHALL',*],*,*,*,*,
   94    ['ERROR',understanding,:,star(pattern,[],[])],
   95     element(category,[],[element(pattern,[],['STDCATCHALL *']),
   96      element(template,[],['ERROR understanding:',element(star,[],[])])]),
   97   'c:/development/opensim4opencog/bin/cynd/programk/test_suite/customtagtest.aiml':44-3205,aruleStd3)).
   98
   99unusedCates:-assert_cate_in_load(aimlCate(*,*,*,*,*,[34],*,*,*,*,element(template,[],[element(srai,[],[1])]),foo3,'c:/development/opensim4opencog/bin/cynd/programk/test_suite/customtagtest.aiml':44-3205)),
  100 assert_cate_in_load(aimlCate(*,*,*,*,*,['34'],*,*,*,*,element(template,[],[element(srai,[],[2])]),foo3,'c:/development/opensim4opencog/bin/cynd/programk/test_suite/customtagtest.aiml':44-3205)),
  101 assert_cate_in_load(aimlCate(*,*,*,*,*,[35],*,*,*,*,element(template,[],[element(srai,[],[3])]),foo3,'c:/development/opensim4opencog/bin/cynd/programk/test_suite/customtagtest.aiml':44-3205)),
  102 assert_cate_in_load(aimlCate(*,*,*,*,*,['35'],*,*,*,*,element(template,[],[element(srai,[],[4])]),foo3,'c:/development/opensim4opencog/bin/cynd/programk/test_suite/customtagtest.aiml':44-3205)),
  103 assert_cate_in_load(aimlCate(*,*,*,*,*,[37],*,*,*,*,element(template,[],[element(srai,[],['6'])]),foo3,'c:/development/opensim4opencog/bin/cynd/programk/test_suite/customtagtest.aiml':44-3205)),
  104 assert_cate_in_load(aimlCate(*,*,*,*,*,['38'],*,*,*,*,element(template,[],[element(srai,[],['7'])]),foo3,'c:/development/opensim4opencog/bin/cynd/programk/test_suite/customtagtest.aiml':44-3205)),
  105 assert_cate_in_load(aimlCate(*,*,*,*,*,[39],*,*,*,*,element(template,[],[element(srai,[],['8'])]),foo3,'c:/development/opensim4opencog/bin/cynd/programk/test_suite/customtagtest.aiml':44-3205)),
  106 assert_cate_in_load(aimlCate(*,*,*,*,*,['40'],*,*,*,*,element(template,[],[element(srai,[],['9'])]),foo3,'c:/development/opensim4opencog/bin/cynd/programk/test_suite/customtagtest.aiml':44-3205)).
  107
  108%%chomskyAIML:-catch(consult(chomskyAIML),_,fail),!.
  109chomskyAIML:-once(load_aiml_files(('chomskyAIML/*.aiml'))).
  110
  111test_suite_files:-once(load_aiml_files(('test_suite/*.aiml'))).
  112
  113loadBasicDictionaries:-once(load_aiml_files(('test_suite/ProgramD/predicates.xml'))),fail.
  114loadBasicDictionaries:-once(load_aiml_files(('test_suite/ProgramD/properties.xml'))),fail.
  115loadBasicDictionaries:-once(load_aiml_files(('test_suite/ProgramD/substitutions.xml'))),fail.
  116loadBasicDictionaries.
  117
  118run_chat_tests_here(Ctx):-     
  119   timeRecorded(test_suite_files),
  120   timeRecorded(test_call(alicebotCTX(Ctx,'qt'))),
  121   timeRecorded(test_call(alicebotCTX(Ctx,'qt1'))),!.
  122
  123run2(Ctx):-
  124   %%test_call(alicebotCTX(Ctx,'Hi')),
  125   test_call(alicebotCTX(Ctx,'What is your name')),
  126   test_call(alicebotCTX(Ctx,'What is your thing')),
  127   test_call(alicebotCTX(Ctx,'My name is Fred.')),
  128   test_call(alicebotCTX(Ctx,'what is my name?')).
  129
  130blackjack_test_load:-  test_call(alicebot('@load blackjack.aiml')).
  131blackjack_test:- blackjack_test_load,
  132   test_call(alicebotCTX(Ctx,'blackjack')),
  133   test_call(alicebotCTX(Ctx,'d')),
  134   test_call(alicebotCTX(Ctx,'3')),!.
  135
  136annie:-withNamedContext(toplevel,Ctx),timeRecorded(run_chat_tests_here(Ctx)),unify_listing(ju:unitTestResult(unit_failed,_)).
  137
  138%%:-timeRecorded(test_suite_files).
  139
  140%%:-timeRecorded(blackjack_test_load).
  141/*
  142:-timeRecorded(load_aiml_files('chomskyAIML/update007.aiml')).
  143:-timeRecorded(blackjack_test_load).
  144:-timeRecorded(blackjack_test).
  145%:-timeRecorded(chomskyAIML).
  146:-timeRecorded(load_aiml_files('chomskyAIML/update013.aiml')).
  147:-timeRecorded(load_aiml_files('chomskyAIML/update012.aiml')).
  148*/

  149
  150
  151
  152%%:-unify_listing(ju:unitTestResult(unit_passed,_)).
  153
  154%%:-timeRecorded(ppfs('../aiml/chomskyAIML/*.aiml')).
  155
  156
  157%%:-timeRecorded(ppfs('../aiml/std_alice/*.aiml')).
  158
  159%%:-timeRecorded(load_aiml_files('chomskyAIML/*.aiml')).
  160%%:-timeRecorded(alicebot).
  161
  162setupTesting:- 
  163 stdCatchAll,
  164 alicebot('<category><pattern>*</pattern><that>what was it</that><template><think><set name="it"><star/></set></think></template></category>'),
  165 alicebot('<category><pattern>pppp</pattern><template>555555</template><that>*</that></category>'),
  166 alicebot('<category><pattern>suggest a topic</pattern><template><srai>random topic</srai></template><that>*</that></category>').
  167
  168stdalice:-timeRecorded(load_aiml_files('std_alice/*.aiml')),!. %%timeRecorded(load_aiml_files('std_alice/hide/*.aiml')).
  169
  170%%:-initialization((stdalice,statistics)).
  171
  172saveAIMLCore :- tell('aimlCore.pl'),listing(aimlCate),listing(argNFound),listing(dict),told.
  173saveAIMLCore2 :- tell('aimlCore2.pl'),listing(aimlCate),listing(argNFound),listing(dict),told.
  174
  175%%:-initialization(timeRecorded(alicebot)).
  176
  177blastAll:-aimlCateSig(Sig),retractall(Sig),fail.
  178blastAll:-retractall(argNFound(_,_,_,_)),fail.
  179blastAll.
  180
  181% :-sdtCatchAll.
  182
  183run_aiml_tests:- 
  184 setupTesting,
  185 timeRecorded(annie),
  186 unify_listing(ju:unitTestResult(unit_passed,_)),
  187 unify_listing(ju:unitTestResult(unit_failed,_)),
  188 !