1:- module(logicmoo_lps,[
    2  run_lps/1,
    3  test_logicmoo_lps/1,
    4  test_logicmoo_lps/0, 
    5  test_logicmoo_lps_sanity/0,
    6  test_logicmoo_lps_full/0]).    7
    8% [Required] Load the Logicmoo Library Utils
    9:- ensure_loaded(library(logicmoo_common)).   10
   11:- reexport(logicmoo_planner).   12
   13:- if(\+ exists_source(swish(lib/render))).   14   :- if(exists_directory('../logicmoo_webui/swish')).   15      :- add_absolute_search_folder(swish,'../logicmoo_webui/swish').   16   :- else. :- if(exists_directory('../../logicmoo_webui/swish')).   17      :- add_absolute_search_folder(swish,'../../logicmoo_webui/swish').   18   :- endif. :- endif.   19:- endif.   20
   21
   22
   23:- if( \+ current_predicate(swish:is_really_module/0)).   24swish:is_really_module.
   25:- endif.   26
   27
   28:- user:use_module(library(listing)).   29:- prolog_listing:use_module(library(lists)).   30
   31run_lps(File):- is_list(File), maplist(run_lps,File).
   32run_lps(File):- wdmsg(run_lps(File)),fail.
   33run_lps(File):- absolute_file_name(File,DB), exists_file(DB),!, 
   34  update_changed_files, 
   35  atom_concat("mod_",DB,Mod),run_lps_db(Mod,DB).
   36run_lps(File):- with_abs_paths(run_lps,File).
   37
   38run_lps_db(DB,File):-
   39   DB:unload_file(File),
   40   abolish_lps_module(DB),
   41   setup_call_cleanup(true,
   42     run_lps_db_now(DB,File),
   43     ((DB:unload_file(File),
   44       abolish_lps_module(DB)))).
   45
   46run_lps_db_now(DB,File):-
   47   DB:use_module(library(lps_corner)), 
   48   %listing(db:actions/1),
   49   %listing(interpreter:actions/1),
   50   interpreter:check_lps_program_module(DB),
   51   interpreter:must_lps_program_module(DB),
   52   DB:consult(File),
   53      interpreter:must_lps_program_module(DB),
   54   write('% '), writeq(:-listing(DB:_)),writeln('.\n'),
   55   elsewhere:listing(DB:_),!,
   56   prolog_statistics:time(DB:golps(X)),
   57   %listing(interpreter:lps_program_module/1),
   58   wdmsg(dB(DB,X)).
   59
   60abolish_lps_module(DB):- 
   61 forall((current_predicate(DB:F/A),functor(P,F,A),\+ predicate_property(DB:P,imported_from(_))),abolish(DB:F/A)).
   62
   63%load_lps_corner:-!.
   64
   65test_logicmoo_lps(Files):- run_lps(Files).
   66
   67test_logicmoo_lps_full:- 
   68  debug(lps(term_expand)),
   69  run_lps(library('../examples/binaryChop2.pl')),
   70  %test_logicmoo_lps('../test/lps_user_examples/*.lps'),
   71  test_logicmoo_lps(library(('../test/lps_user_examples/{s,S}*.pl'))),
   72  test_logicmoo_lps(library(('../test/lps_user_examples/*.pl'))),
   73  nodebug(lps(term_expand)),!,
   74  test_logicmoo_lps_sanity.
   75  
   76
   77test_logicmoo_lps:- test_logicmoo_lps_sanity.
   78
   79test_logicmoo_lps_sanity:- 
   80  debug(lps(term_expand)),
   81  test_logicmoo_lps('../test/lps_user_examples/*cooking*.pl'),!,
   82  test_logicmoo_lps('../test/lps_user_examples/*goat*.pl'),!,
   83  nodebug(lps(term_expand)),!