1/* LogicMOO User Modules Setup 2% 3% 4% Dec 13, 2035 5% Douglas Miles 6 7*/ 8:- module(logicmoo_lib, [logicmoo_webbot/0,setup_logicmoo_operators/0]). 9:- set_module(class(library)). 10 11 12 13% ============================================== 14% SETUP KB EXTENSIONS 15% ============================================== 16 17:- use_module(library(logicmoo_utils)). 18 19/* 20 21:- current_prolog_flag(readline,Base),writeln(readline=Base). 22:- if(exists_source(library(editline))). 23:- set_prolog_flag(readline,editline). 24:- endif. 25% :- set_prolog_flag(readline,true). 26 27:- if(current_prolog_flag(readline,editline)). 28:- system:ensure_loaded(library(readline)). 29:- listing(prolog:history/2). 30:- abolish(prolog:history/2). 31:- system:reconsult(library(editline)). 32:- else. 33:- if(exists_source(library(readline))). 34:- if(exists_source(library(editline))). 35:- system:ensure_loaded(library(editline)). 36:- listing(prolog:history/2). 37:- abolish(prolog:history/2). 38:- endif. 39:- unload_file(library(readline)). 40:- system:consult(library(readline)). 41:- endif. 42:- endif. 43:- current_prolog_flag(readline,Base),writeln(readline=Base). 44*/ 45 46 47 48% :- multifile prolog:message//1, prolog:message_hook/3. 49% prolog:message(ignored_weak_import(Into, From:PI))--> { nonvar(Into),Into \== system,dtrace(dmsg(ignored_weak_import(Into, From:PI))),fail}. 50% prolog:message(Into)--> { nonvar(Into),functor(Into,_F,A),A>1,arg(1,Into,N),\+ number(N),dtrace(wdmsg(Into)),fail}. 51% prolog:message_hook(T,error,Warn):- dtrace(wdmsg(nessage_hook(T,warning,Warn))),fail. 52% prolog:message_hook(T,warning,Warn):- dtrace(wdmsg(nessage_hook(T,warning,Warn))),fail. 53 54:- if(app_argv('--pdt')). 55:- if(\+ app_argv('-nopce')). 56:- if(\+ (getenv('DISPLAY',X) -> \+ atom_string(X,""))). 57%:- guitracer. 58:- else. 59%:- noguitracer. 60:- endif. 61:- endif. 62:- endif. 63 64:- if(app_argv('--wamcl');app_argv('--lispsock')). 65:- user:use_module(library(wamcl_runtime)). 66:- endif. 67 68%:- if(app_argv('--lispsock 3301')). 69%:- start_lspsrv(repl,3301,"Lisp Repl"). 70%:- endif. 71 72:- if(app_argv('--pdt')). 73:- user:use_module(library(logicmoo_pdt)). 74:- endif. 75 76 77/* 78:- flag_call(unsafe_speedups=true). 79:- flag_call(runtime_debug=0). 80:- flag_call(runtime_debug=2). 81% ?- current_prolog_flag(unsafe_speedups , true) . 82:- flag_call(unsafe_speedups=false). 83*/ 84%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 85:- dmsg("SET TOPLEVEL OPTIONS"). 86% ?- listing. (uses varaibles) 87% slows the system startup down consideraly 88%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 89 90% :- set_prolog_flag(toplevel_print_factorized,true). % default false 91%:- set_prolog_flag(toplevel_mode,backtracking). % OR recursive 92%:- after_init(dmsg(qconsult_kb7166)). 93% :- use_listing_vars. 94%:- set_prolog_flag(write_attributes,portray). 95% :- debug. 96 97/* 98:- set_prolog_flag(fileerrors,false). 99:- set_prolog_flag(debug,true). 100%:- set_prolog_flag(gc,false). 101%:- set_prolog_flag(gc,true). 102:- debug. 103 104:- set_prolog_flag(report_error,true). 105:- set_prolog_flag(access_level,system). 106:- set_prolog_flag(toplevel_print_anon,true). 107:- set_prolog_flag(debug_on_error,true). 108:- set_prolog_flag(optimise,false). 109:- set_prolog_flag(last_call_optimisation,false). 110 111*/ 112 113 114%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 115:- dmsg("SETUP KB EXTENSIONS"). 116%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 117 118%:- '$set_typein_module'(baseKB). 119%:- '$set_source_module'(baseKB). 120 121:- use_module(library(plunit)). 122:- kb_global(plunit:loading_unit/4). 123 124% :- ['/home/prologmud_server/lib/swipl/pack/prologmud_samples/prolog/prologmud_sample_games/run_clio']. 125 126%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 127:- dmsg("PACK LOADER"). 128%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 129:- user:load_library_system(logicmoo_packs). 130 131 132 133%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 134:- dmsg("AUTOLOAD PACKAGES"). 135%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 136 137:- before_boot(rescan_pack_autoload_packages). 138 139%:- reload_library_index. 140%:- autoload([verbose(true)]). 141%:- reload_library_index. 142 143:- if(\+ current_module(baseKB)). 144:- set_prolog_flag(logicmoo_qsave,true). 145:- else. 146:- set_prolog_flag(logicmoo_qsave,false). 147:- endif. 148 149/* 150:- if(exists_source(library(yall))). 151:- multifile(yall:lambda_functor/1), 152 dynamic(yall:lambda_functor/1), 153 with_no_mpred_expansions(use_module(yall:library(yall),[])), 154 show_call(retractall(yall:lambda_functor('/'))). 155:- endif. 156*/ 157 158set_default_argv:- dmsg("SETTING DEFAULT ARGV!!!!"), 159 set_prolog_flag(os_argv,[swipl, '-f', '/dev/null','--nonet','--unsafe','--']). 160 161:- (current_prolog_flag(os_argv,[swipl]) ; current_prolog_flag(argv,[])) -> set_default_argv; true. 162 163 164 165%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 166:- dmsg("LOAD PARTS OF SYSTEM EARLY"). 167%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 168 % :- set_prolog_flag(subclause_expansion,default). 169 % :- set_prolog_flag(subclause_expansion,false). 170 % :- set_prolog_flag(dialect_pfc,default). 171 172 173:- user:load_library_system(logicmoo_swilib). 174 175:- if( current_prolog_flag(xpce,true) ). 176:- if(exists_source(library(pce_emacs))). 177% :- user:use_module(library(pce_emacs)). 178:- endif. 179:- endif. 180 181 182:- multifile(swish_trace:installed/1). 183:- dynamic(swish_trace:installed/1). 184:- volatile(swish_trace:installed/1). 185 186:- if(exists_source(library(semweb/rdf_db))). 187%:- use_module(pengine_sandbox:library(semweb/rdf_db)). 188:- endif. 189 190 191%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 192:- dmsg("SETUP LOGICMOO OPERATORS"). 193%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 194setup_logicmoo_operators:- locally(set_prolog_flag(access_level,system), 195 ((op(200,fy,'-'),op(300,fx,'-'), 196 op(1190,xfx,('::::')), 197 op(1180,xfx,('==>')), 198 op(1170,xfx,'<==>'), 199 op(1160,xfx,('<-')), 200 op(1150,xfx,'=>'), 201 op(1140,xfx,'<='), 202 op(1130,xfx,'<=>'), 203 op(600,yfx,'&'), 204 op(600,yfx,'v'), 205 op(350,xfx,'xor'), 206 op(300,fx,'~'), 207 op(300,fx,'-'), 208 op(1199,fx,('==>'))))). 209 210 211 212 213%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 214:- dmsg("SETUP PATHS FOR PROLOGMUD/LOGICMOO"). 215%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 216 217% :- before_boot((user:ensure_loaded(setup_paths))). 218 219% :- user:use_module(library('file_scope')). 220% :- use_module(library('clause_expansion')). 221 222 % :- set_prolog_flag(subclause_expansion,true). 223 224% :- during_boot((sanity((lmce:current_smt(SM,M),writeln(current_smt(SM,M)))))). 225 226%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 227:- dmsg("LOAD LOGICMOO UTILS"). 228%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 229 230libhookmaybe_save_lm:- \+ current_prolog_flag(logicmoo_qsave,true),!. 231libhookmaybe_save_lm:- current_predicate(lmcache:qconsulted_kb7166/0),call(call,lmcache:qconsulted_kb7166),!. 232libhookmaybe_save_lm:- qsave_lm(lm_repl4),!. 233 234%:- user:ensure_loaded(library(logicmoo_utils)). 235 236%:- multifile(prolog:make_hook/2). 237%:- dynamic(prolog:make_hook/2). 238% prolog:make_hook(before, C):- wdmsg(prolog:make_hook(before, C)),fail. 239% prolog:make_hook(after, C):- wdmsg(prolog:make_hook(after, C)),libhook:maybe_save_lm,fail. 240 241%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 242:- dmsg("LOGICMOO/CYC Alignment util"). 243%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 244:- set_prolog_flag(do_renames,restore). 245:- gripe_time(60,baseKB:ensure_loaded(library('logicmoo/plarkc/logicmoo_i_cyc_rewriting'))). 246 247logicmoo_webbot:- whenever_flag_permits(load_network,load_library_system(library(logicmoo_webbot))). 248/* 249%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 250:- dmsg("[Optional] Load the Logicmoo Web System"). 251%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 252:- user:use_module(library(logicmoo_common)). 253 254:- if(\+ app_argv('--nonet')). 255:- logicmoo_webbot. 256:- endif. 257*/ 258 259%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 260:- dmsg("[Required] Load the Logicmoo Type System"). 261%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 262:- load_library_system(library(logicmoo_typesystem)). 263 264%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 265:- dmsg("[Mostly Required] Load the Logicmoo Plan Generator System"). 266%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 267:- if(app_argv('--planner')). 268:- if(exists_source(library(logicmoo_planner))). 269:- load_library_system(library(logicmoo_planner)). 270:- endif. 271:- endif. 272 273%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 274:- dmsg("[Mostly Required] Load the Prolog LarKC System"). 275% LOAD CYC KB EXTENSIONS 276%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 277:- load_library_system(library(logicmoo_plarkc)). 278:- use_module(logicmoo_plarkc). 279:- check_clause_counts. 280 281%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 282:- dmsg("[Mostly Required] logicmoo_clif"). 283%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 284:- load_library_system(library(logicmoo_clif)). 285:- use_module(logicmoo_clif). 286 287%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 288:- dmsg("SETUP CYC KB EXTENSIONS (TINYKB)"). 289%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 290:- before_boot( 291 (set_prolog_flag(do_renames,restore), 292 gripe_time(60,baseKB:ensure_loaded(library('logicmoo/plarkc/logicmoo_u_cyc_kb_tinykb.pl'))))). 293 294%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 295:- dmsg("SETUP CYC KB EXTENSIONS (FULLKB)"). 296%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 297:- during_boot(set_prolog_flag(do_renames,restore)). 298%:- gripe_time(60,baseKB:ensure_loaded(library('logicmoo/plarkc/logicmoo_i_cyc_kb.pl'))). 299:- check_clause_counts. 300 301 302%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 303:- dmsg("[Required] Load the CYC Network Client and Logicmoo CycServer Emulator (currently server is disabled)"). 304%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 305% :- load_library_system(library(plark/logicmoo/logicmoo_u_cyc_api)). 306 307 308%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 309:- dmsg("[Optional] NOT YET Load the Logicmoo RDF/OWL Browser System"). 310%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 311% :- load_library_system(logicmoo(mpred_online/mpred_rdf)). 312 313 314%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 315:- dmsg("[Debugging] Normarily this set as 'true' can interfere with debugging"). 316%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 317% :- set_prolog_flag(gc,false). 318% Yet turning it off we cant even startup without crashing 319% :- set_prolog_flag(gc,true). 320 321 322% :- sanity(doall(printAll(current_prolog_flag(_N,_V)))). 323% :- after_boot(during_net_boot(kill_unsafe_preds)). 324 325%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 326:- dmsg("[Mostly Required] Load the Logicmoo Parser/Generator System"). 327%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 328%:- load_library_system(library(parser_all)). 329:- if(\+ current_module(logicmoo_nlu)). 330% :- load_library_system(library(logicmoo_nlu)). 331%:- noguitracer. 332:- endif. 333%:- load_library_system(library(parser_e2c)). 334 335%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 336:- dmsg("MAYBE QSAVE THIS"). 337%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 338 339:- set_prolog_flag(logicmoo_qsave,false). 340 341:- if( \+ current_prolog_flag(address_bits, 32)). 342%:- before_boot(set_prolog_stack_gb(16)). 343:- endif. 344 345:- fixup_exports. 346 347:- if(false). 348:- statistics. 349:- listing(qsave_lm/1). 350:- endif. 351 352 353 354%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 355% Regression tests that first run whenever a person starts the MUD on the public server 356%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 357 358%:- load_library_system(pack(logicmoo_base/t/examples/pfc/'sanity_col_as_unary.pfc')). 359%:- load_library_system(pack(logicmoo_base/t/examples/pfc/'sanity_birdt.pfc')). 360%:- load_library_system(pack(logicmoo_base/t/examples/pfc/'sanity_sv.pfc')). 361%:- load_library_system(pack(logicmoo_base/t/examples/pfc/'sanity_foob.pfc')).