1:- module(logicmoo_repl,[]).    2/*
    3 Basic startup
    4
    5*/
    6:- set_module(class(system)).    7:- '$set_source_module'(baseKB).    8:- set_module(baseKB:class(development)).    9:- ensure_loaded(library(xlisting)).   10:- ensure_loaded(library(xlisting_web)).   11:- ensure_loaded(library(logicmoo_lib)).   12
   13%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   14% LOAD WEB HOOKS AND LOGTALK
   15%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   16
   17logicmoo_web_s:- whenever_flag_permits(load_network,load_library_system(library(logicmoo_webbot))).
   18
   19logicmoo_web :- whenever_flag_permits(load_network,with_no_mpred_expansions(user:ensure_loaded(logicmoo_webbot))).
   20
   21:- set_prolog_flag(access_level,system).   22
   23:- set_prolog_flag(toplevel_print_anon,true).   24% :- set_prolog_flag(toplevel_print_factorized,true).
   25% :- set_prolog_flag(toplevel_mode,recursive).
   26
   27:- if(\+ current_module(baseKB)).   28:- set_prolog_flag(logicmoo_qsave,true).   29:- else.   30:- set_prolog_flag(logicmoo_qsave,false).   31:- endif.   32
   33
   34
   35%:- '$set_source_module'(baseKB).
   36%:- '$set_typein_module'(baseKB).
   37
   38
   39%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   40% INIT BASIC FORWARD CHAINING SUPPORT
   41%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   42
   43:- baseKB:ensure_loaded(library(pfc_lib)).   44
   45init_mud_server:- ensure_loaded(library(prologmud_sample_games/run_mud_server)).
   46
   47run_mud_server:- consult(library(prologmud_sample_games/run_mud_server)).
   48
   49
   50%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   51% [Optionaly] Load the EXTRA Logicmoo WWW System
   52%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   53
   54% forward chaining state browser
   55:- if(exists_source(library(xlisting_web))).   56:- user:ensure_loaded(library(xlisting_web)).   57:- endif.   58
   59:- before_boot(add_history_ideas).   60
   61%:- '$set_source_module'(baseKB).
   62%:- '$set_typein_module'(baseKB).
   63
   64:- set_prolog_flag(do_renames,restore).   65:- use_module(library(gvar_syntax)).   66:- user:use_module(library(dif)).   67
   68:- baseKB:import(dif:dif/2).   69:- baseKB:export(dif:dif/2).   70:- catch(quietly(nodebugx(if_file_exists(baseKB:use_module(library(prolog_predicate))))),E,dmsg(E)).   71
   72%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   73% These are probly loaded by other modules
   74%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   75%:- ensure_loaded(library(multivar)).
   76%:- ensure_loaded(library(udt)).
   77%:- ensure_loaded(library(atts)).
   78%:- use_module(library(persistency)).
   79
   80%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   81% [Optionaly] Load the EXTRA Logicmoo WWW System
   82%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   83% :- user:ensure_loaded(library(xlisting_web)).
   84% :- if_file_exists(ensure_loaded(library(logicmoo/logicmoo_run_pldoc))).
   85% :- if_file_exists(ensure_loaded(library(logicmoo/logicmoo_run_swish))).
   86
   87% :- after_boot(during_net_boot(kill_unsafe_preds)).
   88
   89
   90%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   91% BINA48 Code!!!
   92%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   93%:- load_library_system(daydream).
   94
   95%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   96% INIT LOGICMOO (AUTOEXEC)  Load the infernce engine
   97%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   98:- set_prolog_flag(do_renames,restore).   99:- baseKB:ensure_loaded(library(pfc_lib)).  100:- set_prolog_flag(do_renames,restore).  101
  102% :- ls.
  103
  104:- load_library_system(logicmoo_lib).  105
  106
  107%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  108% SETUP SANITY TEST EXTENSIONS
  109%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  110decl_kb_shared_tests:-
  111 % sanity(listing((kb_global)/1)),
  112 kb_global(baseKB:sanity_test/0),
  113 kb_global(baseKB:regression_test/0),
  114 kb_global(baseKB:feature_test/0),
  115 kb_global(baseKB:(
  116        baseKB:feature_test/0,
  117        baseKB:mud_test/2,
  118        baseKB:regression_test/0,
  119        baseKB:sanity_test/0,
  120        baseKB:agent_call_command/2,
  121        action_info/2,
  122        type_action_info/3)).
  123
  124:- decl_kb_shared_tests.  125
  126
  127%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  128% ONE SANITY TEST
  129%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  130system:iRR7_test:-
  131 baseKB:(
  132    ain(isa(iRR7,tRR)),
  133    ain(genls(tRR,tRRP)),
  134    (\+ tRRP(iRR7) -> (xlisting(iRR7),xlisting(tRRP)) ; true),
  135    must( isa(iRR7,tRR) ),
  136    must( isa(iRR7,tRRP) ),
  137    must( tRRP(iRR7) )).
  138
  139% :- iRR7_test.
  140
  141:- test_runtime_boot(iRR7_test).  142
  143
  144%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  145% KIF READER SANITY TESTS
  146%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  147
  148:- if(exists_source(library(wam_cl/sreader))).  149:- system:use_module(library(wam_cl/sreader)).  150:- endif.  151
  152show_kif(Str):- sanity(must(input_to_forms_debug(Str,sumo_to_pdkb))).
  153:- export(show_kif/1).  154
  155:- add_history((input_to_forms("
  156(=> (disjointDecomposition ?CLASS @ROW) (forall (?ITEM1 ?ITEM2) 
  157  (=> (and (inList ?ITEM1 (ListFn @ROW)) (inList ?ITEM2 (ListFn @ROW)) (not (equal ?ITEM1 ?ITEM2))) 
  158   (disjoint ?ITEM1 ?ITEM2))))"
  159  ,O,Vs),!,wdmsg(O+Vs))).  160
  161/*
  162:- must(input_to_forms("(=> (disjointDecomposition ?CLASS @ROW) (forall (?ITEM1 ?ITEM2) (=> (and (inList ?ITEM1 (ListFn @ROW)) (inList ?ITEM2 (ListFn @ROW)) (not (equal ?ITEM1 ?ITEM2))) (disjoint ?ITEM1 ?ITEM2))))",O,Vs)),!,wdmsg(O+Vs).
  163:- must(((input_to_forms("(=> (disjointDecomposition ?CLASS @ROW) (forall (?ITEM1 ?ITEM2) (=> (and (inList ?ITEM1 (ListFn @ROW)) (inList ?ITEM2 (ListFn @ROW)) (not (equal ?ITEM1 ?ITEM2))) (disjoint ?ITEM1 ?ITEM2))))",O,Vs)),!,wdmsg(O+Vs))).
  164:- must(input_to_forms_debug("(=> (disjointDecomposition ?CLASS @ROW) (forall (?ITEM1 ?ITEM2) (=> (and (inList ?ITEM1 (ListFn @ROW)) (inList ?ITEM2 (ListFn @ROW)) (not (equal ?ITEM1 ?ITEM2))) (disjoint ?ITEM1 ?ITEM2))))",sumo_to_pdkb)).
  165*/
  166:- show_kif("(=> (disjointDecomposition ?CLASS @ROW) (forall (?ITEM1 ?ITEM2) (=> (and (inList ?ITEM1 (ListFn @ROW)) (inList ?ITEM2 (ListFn @ROW)) (not (equal ?ITEM1 ?ITEM2))) (disjoint ?ITEM1 ?ITEM2))))").  167:- show_kif("(=> (isa ?NUMBER ImaginaryNumber) (exists (?REAL) (and (isa ?REAL RealNumber) (equal ?NUMBER (MultiplicationFn ?REAL (SquareRootFn -1))))))").  168:- show_kif("(=> (isa ?PROCESS DualObjectProcess) (exists (?OBJ1 ?OBJ2) (and (patient ?PROCESS ?OBJ1) (patient ?PROCESS ?OBJ2) (not (equal ?OBJ1 ?OBJ2)))))").  169:- show_kif("(=> (contraryAttribute @ROW) (=> (inList ?ELEMENT (ListFn @ROW)) (isa ?ELEMENT Attribute)))").  170:- show_kif("(=> (and (contraryAttribute @ROW1) (identicalListItems (ListFn @ROW1) (ListFn @ROW2))) (contraryAttribute @ROW2))").  171:- show_kif("(=> (contraryAttribute @ROW) (forall (?ATTR1 ?ATTR2) (=> (and (equal ?ATTR1 (ListOrderFn (ListFn @ROW) ?NUMBER1)) (equal ?ATTR2 (ListOrderFn (ListFn @ROW) ?NUMBER2)) (not (equal ?NUMBER1 ?NUMBER2))) (=> (property ?OBJ ?ATTR1) (not (property ?OBJ ?ATTR2))))))").  172:- show_kif("(=> (equal ?NUMBER (MultiplicationFn 1 ?NUMBER)) (equal (MeasureFn ?NUMBER CelsiusDegree) (MeasureFn (DivisionFn (SubtractionFn ?NUMBER 32) 1.8) FahrenheitDegree)))").  173:- show_kif("(DivisionFn (SubtractionFn ?NUMBER 32) 1.8 #C(1.2 9))").  174
  175
  176%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  177% LOAD LOGICMOO KB EXTENSIONS
  178%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  179:- check_clause_counts.  180
  181% :- load_library_system(library(logicmoo_lib)).
  182% :- load_library_system(logicmoo(logicmoo_plarkc)).
  183
  184:- after_boot((set_prolog_flag(pfc_booted,true))).  185
  186:- thread_initialization(nb_setval('$oo_stack',[])).  187:- thread_initialization(b_setval('$oo_stack',[])).  188
  189%
  190
  191
  192
  193
  194%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  195% QSAVE LM_REPL
  196%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  197% {flatTrans(G)}==>{listing(G/2)}.
  198:- if(current_prolog_flag(logicmoo_qsave,true)).  199:- baseKB:qsave_lm(lm_repl).  200:- endif.  201
  202:- set_prolog_flag(access_level,system).  203:- if(false).  204:- statistics.  205:- endif.