1/* Part of LogicMOO Base Logicmoo Debug Tools 2% =================================================================== 3% File '$FILENAME.pl' 4% Purpose: An Implementation in SWI-Prolog of certain debugging tools 5% Maintainer: Douglas Miles 6% Contact: $Author: dmiles $@users.sourceforge.net ; 7% Version: '$FILENAME.pl' 1.0.0 8% Revision: $Revision: 1.1 $ 9% Revised At: $Date: 2002/07/11 21:57:28 $ 10% Licience: LGPL 11% =================================================================== 12*/ 13 14%:- if(( ( \+ ((current_prolog_flag(logicmoo_include,Call),Call))) )). 15 16%:- throw(module(pfcumt,[umt/1])). 17 18hide_this:- nop(module(pfc_lib, [ 19 /* 20 get_startup_uu/1, 21 call_u_no_bc/1,%fix_mp/3, 22 fix_mp/4, %fix_mp/3, 23 mpred_fwc/1, 24 get_mpred_is_tracing/1, 25 show_if_debug/1, 26 full_transform_warn_if_changed/3, 27 full_transform_warn_if_same/3, 28 full_transform/3, 29 maybe_mpred_break/1, 30 each_E/3, 31 call_m_g/3, 32 same_modules/2, 33 throw_depricated/0, 34 mpred_post_exactly/1, 35 lookup_m_g/3, 36 head_to_functor_name/2, 37 ain_expanded/1, 38 mpred_notrace_exec/0, 39 get_unnegated_functor/3, 40 mpred_post1_rem/2, 41 mpred_post1/1, 42 mpred_post1_rem2/2, 43 mpred_post2/2, 44 mpred_post12/2, 45 fwc1s_post1s/2, 46 mpred_mark_as_ml/3, 47 mpred_mark_fa_as/5, 48 %mpred_te/0, 49 %mpred_te/2, 50 maybe_updated_value/3, 51 log_failure/1, 52 code_sentence_op/1, 53 quietly_ex/1, 54 mpred_compile_rhs_term_consquent/3, 55 with_fc_mode/2, 56 filter_buffer_n_test/3, 57 filter_buffer_get_n/3, 58 filter_buffer_trim/2, 59 plus_fwc/0, 60 plus_fwc/1, 61 cut_c/0, 62 to_u/2, 63 fresh_mode/0, 64 mpred_mark_as/3, 65 get_first_user_reason/2, 66 assert_u_confirm_if_missing/1, 67 assert_u_confirmed_was_missing/1, 68 mpred_notrace_exec/0, 69 remove_negative_version/1, 70 listing_u/1, 71 72 call_u_mp/2, 73 call_u_mp_fa/4, 74 call_u_mp_lc/4, 75 76 get_source_uu/1, 77 get_source_mfl/1, 78 is_source_ref1/1, 79 get_why_uu/1, 80 set_fc_mode/1, 81 82 with_no_breaks/1, 83 mpred_remove1/2, 84 check_never_assert/1,check_never_retract/1, 85 oinfo/1, 86 why_was_true/1, 87 mpred_fwc0/1, 88 with_no_mpred_trace_exec/1, 89 mpred_set_default/2, 90 mpred_ain/1,mpred_ain/1,mpred_ain/2, 91 action_is_undoable/1, 92 mpred_assumption/1,mpred_assumptions/2,mpred_axiom/1,bagof_or_nil/3,bases_union/2,brake/1,build_rhs/3, 93 mpred_BC_CACHE0/2, 94 build_neg_test/4,build_rule/3,build_code_test/3, 95 build_trigger/4, 96 defaultmpred_select/1,fc_eval_action/2, 97 % foreach/2, 98 get_next_fact/1, 99 justification/2,justifications/2, 100 call_u/1, 101 variant_u/2, 102 mpred_BC_CACHE/2, 103 call_u_no_bc/1,mpred_METACALL/2,mpred_METACALL/3,mpred_METACALL/3, 104 mpred_halt/0,mpred_halt/1,mpred_halt/2, 105 mpred_ain_db_to_head/2,mpred_ain_actiontrace/2,mpred_trace_op/2,mpred_add_support/2,mpred_ain_trigger_reprop/2, 106 mpred_ain_by_type/2, 107 mpred_prompt_ask/2, 108 mpred_METACALL/3,mpred_BC_w_cache/2, 109 ain_fast/1, 110 ain_fast/2, 111 setup_mpred_ops/0, 112 mpred_assert_w_support/2,mpred_asserta_w_support/2,mpred_assertz_w_support/2,mpred_basis_list/2,mpred_bt_pt_combine/3,mpred_child/2,mpred_children/2, 113 mpred_classifyFacts/4,mpred_collect_supports/1,mpred_unhandled_command/3,mpred_compile_rhs_term/3,mpred_conjoin/3,mpred_neg_connective/1, 114 mpred_database_item/1, 115 % mpred_database_term/3, 116 mpred_db_type/2,mpred_set_default/2,mpred_define_bc_rule/3,mpred_descendant/2, 117 mpred_descendants/2,mpred_enqueue/2,mpred_error/1,mpred_error/2,mpred_eval_lhs/2,mpred_eval_lhs_1/2,mpred_eval_rhs/2,mpred_fact/1, 118 mpred_fact/2,mpred_facts/1,mpred_facts/2,mpred_facts/3,mpred_fwc/1,mpred_get_support/2,lookup_u/1,lookup_u/2, 119 mpred_literal/1,mpred_load/1,mpred_make_supports/1,mpred_ain_object/1,mpred_aina/2,mpred_ainz/2,mpred_aina/1,mpred_ainz/1, 120 mpred_negated_literal/1,mpred_unnegate/2,mpred_nf/2,mpred_nf1_negation/2,mpred_nf_negation/2,mpred_nf_negations/2,mpred_notrace/0,mpred_nowatch/0, 121 mpred_nospy/0,mpred_nospy/1,mpred_nospy/3,mpred_positive_literal/1,mpred_post/2,pp_qu/0,mpred_undo_action/1, 122 mpred_rem_support/2,mpred_remove_old_version/1,mpred_remove_supports_whine/1,mpred_remove_supports_quietly/1,mpred_reset_kb_0/0,mpred_retract_i/1,mpred_retract_i_or_warn/1,mpred_retract_supported_relations/1, 123 mpred_retract_type/2,mpred_select_justification_node/3,mpred_set_warnings/1,mpred_pp_db_justifications/2, 124 mpred_spy/1,mpred_spy/2,mpred_spy/3,mpred_step/0,mpred_support_relation/1,mpred_supported/1,mpred_supported/2, 125 mpred_trace/0,mpred_trace/1,mpred_trace/2,mpred_trace_maybe_print/3,mpred_trace_maybe_break/3,mpred_trace_exec/0,mpred_trace_op/3, 126 mpred_trace_op/2,mpred_trace_msg/1,mpred_trace_msg/2,mpred_trigger_key/2,mpred_trigger_key/2,mpred_undo/1,mpred_unfwc/1, 127 mpred_unfwc_check_triggers/1,mpred_union/3,mpred_unique_u/1,mpred_untrace/0,mpred_untrace/1,mpred_warn/0,mpred_warn/1, 128 mpred_warn/2,mpred_watch/0,well_founded_0/2,clear_proofs/0,mpred_why/0,mpred_why/1,mpred_whyBrouse/2,mpred_handle_why_command/3, 129 nompred_warn/0, % pfcl_do/1, 130 pp_DB/0,pp_db_facts/0,pp_db_facts/1,pp_db_facts/2,pp_db_items/1, 131 pp_db_rules/0,pp_db_supports/0,pp_db_triggers/0,mpred_load/1,process_rule/3, 132 remove_if_unsupported/1,remove_selection/1,mpred_withdraw1/2, 133 134 mpred_post1/2,get_mpred_assertion_status/3,mpred_post_update4/4,get_mpred_support_status/5,same_file_facts/2,clause_asserted_u/1, 135 136 137 mpred_run/0, 138 139 fa_to_p/3, 140 call_u_no_bc/1, 141 with_umt/2, 142 asserta_u/1,assert_u/1,assertz_u/1,retract_u/1,retractall_u/1, 143 retract_u0/1,retractall_u0/1, 144 clause_u/1,clause_u/2,clause_u/3, 145 % clause_ii/3, 146 147 lookup_u/1, 148 149mpred_load_term/1, 150pos_2_neg/2, 151not_not_ignore_quietly_ex/1, 152mpred_trace_all/0, 153really_mpred_mark/4, 154 155 156unassertable/1, 157log_failure_red/0, 158convention_to_symbolic_mt/5, 159attvar_op_fully/2, 160closest_u/2, 161pred_check/1, 162pp_why/0, 163get_unnegated_functor/3, 164is_user_reason/1, 165mpred_retract_i_or_warn_1/1, 166mpred_is_silent/0, 167pp_why/1, 168bad_head_pred/1, 169get_mpred_current_db/1, 170mpred_call_no_bc0/1, 171to_real_mt/3, 172all_closed/1, 173convention_to_mt/4, 174 175copy_term_vn/2, 176get_assertion_head_unnegated/2, 177mpred_undo1/1, 178convention_to_symbolic_mt_ec/5, 179 180push_current_choice/1, 181 182 183 184 get_fc_mode/3,mpred_rem_support_if_exists/2,get_tms_mode/2, 185 186 stop_trace/1,with_mpred_trace_exec/1, 187 select_next_fact/1,supporters_list/2,triggerSupports/2,well_founded/1,well_founded_list/2, 188 do_assumpts/2,mpred_do_fcnt/2,mpred_do_fcpt/2,mpred_fwc1/1,mpred_do_rule/1,mpred_descendant1/3,mpred_eval_rhs1/2,mpred_nf1/2, 189 mpred_post1/2,mpred_withdraw/1,mpred_withdraw/2,mpred_remove/1, 190 mpred_remove/2,mpred_post1/2, 191 mpred_pp_db_justification1/3,mpred_pp_db_justifications2/4,mpred_spy1/3, 192 mpred_unfwc_check_triggers0/1,mpred_unfwc1/1,mpred_why1/1,mpred_blast/1 193 % trigger_trigger1/2 , trigger_trigger/3, 194 */ 195 ])). 196 197%:- use_module(mpred_kb_ops). 198%:- use_module(library(util_varnames)). 199%:- use_module(library(no_repeats)). 200 201:- include('mpred_header.pi'). 202:- current_prolog_flag(mpred_pfc_silent,false)-> true ; set_prolog_flag(mpred_pfc_silent,true). 203 204:- dynamic(lmcache:mpred_is_spying_pred/2). 205 206:- system:use_module(library(edinburgh)). 207:- system:use_module(library(ordsets)). 208:- system:use_module(library(oset)). 209 210:- use_module(library(pfc_test)). 211%:- endif. 212:- use_module(library(logicmoo_common)). 213:- use_module(library(logicmoo/misc_terms)). 214:- meta_predicate 215 %call_u_mp(+,*,+), 216 call_u(), 217 call_u_mp_lc(,,,), 218 call_u_no_bc(), 219 clause_asserted_u(), 220 clause_u(), 221 clause_u(,,), 222 clause_u(,), 223 each_E(,,), 224 fc_eval_action(,), 225 fix_mp(,,,), 226 %foreach(*,?), 227 %lookup_kb(?,*), 228 %lookup_kb(?,*,?), 229 quietly_ex(), 230 ain_expanded(), 231 mpred_add(), 232 mpred_ain(), 233 %mpred_BC_CACHE(+,+), 234 %mpred_BC_CACHE0(+,+), 235 mpred_call_no_bc0(), 236 mpred_fact_mp(,), 237 mpred_METACALL(,), 238 mpred_METACALL(,,), % 1,-,+ 239 240 % pfcl_do(*), % not all arg1s are callable 241 retract_u0(), 242 with_no_breaks(), 243 with_umt(,), 244 brake(), 245 with_no_mpred_trace_exec(), 246 with_mpred_trace_exec(), 247 with_fc_mode(,). 248 249 250:- meta_predicate mpred_retract_i_or_warn(). 251:- meta_predicate mpred_retract_i_or_warn_1(). 252:- meta_predicate not_not_ignore_quietly_ex(). 253:- meta_predicate must_notrace_pfc(). 254:- multifile(baseKB:safe_wrap/4). 255:- dynamic(baseKB:safe_wrap/4). 256 257 258:- op(700,xfx,('univ_safe')). 259 260 261:- system:use_module(library(lists)). 262 263:- module_transparent lookup_u/1,lookup_u/2,mpred_unfwc_check_triggers0/1,mpred_unfwc1/1,mpred_why1/1,mpred_blast/1. 264 265must_ex(G):- (*->true;(wdmsg_pretty(must_ex(G)),if_interactive((ignore(rtrace(G)),wdmsg_pretty(must_ex(G)), break)))). 266 267must_notrace_pfc(G):- must_ex((G)). 268 269:- thread_local(t_l:assert_to/1). 270 271/* 272 273 ?- dynamic(f2/2),gensym(nnn,N),sanity_attvar_08:attr_bind([name_variable(A, 'ExIn'), form_sk(A, 'SKF-66')], true), 274 IN=f2(N,A),OUT=f2(N,B),copy_term_vn(IN,OUT), 275 asserta_u(IN),clause_asserted_u(OUT),!. % ,nl,writeq(A=@=B). 276*/ 277:- meta_predicate with_each_item(,,).
apply(P,[Ele|ArgList]) on each Ele(ment) in the EleList.
EleList is a List, a Conjuction Terms or a single element.
284with_each_item(P,HV,S):- var(HV),!, apply(P,[HV|S]). 285with_each_item(P,M:HT,S) :- !, must_be(atom,M), M:with_each_item(P,HT,S). 286with_each_item(P,[H|T],S) :- !, apply(P,[H|S]), with_each_item(P,T,S). 287with_each_item(P,(H,T),S) :- !, with_each_item(P,H,S), with_each_item(P,T,S). 288with_each_item(P,H,S) :- apply(P,[H|S]).
299:- nodebug(logicmoo(pfc)). 300 301% mined from program database 302 303:- dynamic(baseKB:pt/2). 304:- system:import(baseKB:pt/2). 305 306:- dynamic(baseKB:pm/1). 307:- system:import(baseKB:pm/1). 308 309:- dynamic(baseKB:nt/3). 310:- system:import(baseKB:nt/3). 311 312:- dynamic(baseKB:spft/3). 313:- system:import(baseKB:spft/3). 314 315:- dynamic(baseKB:bt/2). 316:- system:import(baseKB:bt/2). 317 318:- dynamic(baseKB:do_and_undo/2). 319:- system:import(baseKB:do_and_undo/2). 320 321:- dynamic(baseKB:tms/1). 322:- system:import(baseKB:tms/1). 323 324 325 326/* 327*/ 328:- dynamic(baseKB:mpred_is_tracing_exec/0). 329:- export(baseKB:mpred_is_tracing_exec/0). 330 331mpred_database_term_syntax(do_and_undo,2,rule(_)). 332 333mpred_database_term_syntax(('::::'),2,rule(_)). 334mpred_database_term_syntax((<-),2,rule(_)). 335mpred_database_term_syntax((<==>),2,rule(_)). 336mpred_database_term_syntax((==>),2,rule(_)). 337 338mpred_database_term_syntax(mdefault,1,fact(_)). 339mpred_database_term_syntax((==>),1,fact(_)). 340mpred_database_term_syntax((~),1,fact(_)). 341 342 343baseKBmpred_database_term(F,A,syntaxic(T)):- pfc_lib:mpred_database_term_syntax(F,A,T). 344baseKBmpred_database_term(F,A,T):- pfc_lib:mpred_core_database_term(F,A,T). 345 346mpred_core_database_term(genlPreds,2,fact(_)). 347% mpred_core_database_term(rtArgsVerbatum,1,fact(_)). 348 349% forward,backward chaining database 350mpred_core_database_term(spft,3,support). 351 352mpred_core_database_term(nt,3,trigger(pt)). 353mpred_core_database_term(pt,2,trigger(nt)). 354mpred_core_database_term(bt,2,trigger(bt)). 355 356% transient state 357mpred_core_database_term(actn,1,state). 358mpred_core_database_term(que,2,state). 359mpred_core_database_term(hs,1,state). 360 361% forward,backward settings 362mpred_core_database_term(mpred_current_db,1,setting). 363mpred_core_database_term(mpred_select_hook,1,setting). 364mpred_core_database_term(tms,1,setting). 365mpred_core_database_term(pm,1,setting). 366 367% debug settings 368mpred_core_database_term(mpred_is_tracing_exec,0,debug). 369%mpred_core_database_term(lmcache:mpred_is_spying_pred,2,debug). 370mpred_core_database_term(mpred_warnings,1,debug). 371% mpred_core_database_term(t_l:whybuffer,2,debug). 372 373mpred_core_database_term(mpred_prop,4,fact(_)). 374 375mpred_core_database_term(predicateConventionMt,2,fact(_)). 376% mpred_core_database_term(genlMt,2,fact(_)). 377%mpred_core_database_term(arity,2,fact(_)). 378%mpred_core_database_term(rtArgsVerbatum,1,fact(_)). 379 380 381import_everywhere:- 382 forall(baseKB:mpred_database_term(F,A,_), 383 (dynamic(baseKB:F/A),baseKB:export(baseKB:F/A), 384 system:import(baseKB:F/A))). 385:- import_everywhere. 386 387:- thread_local(t_l:whybuffer/2). 388% :- dynamic(baseKB:que/2). 389 390:- meta_predicate show_mpred_success(,). 391show_mpred_success(Type,G):- *->mpred_trace_msg(success(Type,G)) ; fail. 392 393% :- ensure_loaded(library(logicmoo_utils)). 394 395:- module_transparent((assert_u_confirmed_was_missing/1,mpred_trace_exec/0, % pfcl_do/1, 396 call_u_mp_fa/4,call_u_mp_lc/4, 397 mpred_post1/2,get_mpred_assertion_status/3,mpred_post_update4/4,get_mpred_support_status/5,same_file_facts/2, 398 399 asserta_u/1,assert_u/1,assertz_u/1,retract_u/1,retractall_u/1, 400 401 retract_u0/1,retractall_u0/1, 402 mpred_trace_op/3)). 403 404:- thread_local(t_l:no_breaks/0). 405 406decl_rt(RT) :- 407 '@'((( 408 sanity(atom(RT)), 409 univ_safe(Head , [RT,FP]), 410 AIN = ((Head :- cwc, /* dmsg_pretty(warn(call(Head))), */ mpred_prop(M,FP,_,RT))), 411 (clause_asserted(AIN) -> 412 (nop(listing(RT)), 413 sanity((predicate_property(RHead,number_of_clauses(CL)),predicate_property(RHead,number_of_rules(RL)),CL=RL))); 414 415 (( 416 (current_predicate(RT/1)-> 417 ( nop(listing(RT)), 418 RHead univ_safe [RT,F/A], 419 forall(retract(RHead),ain(mpred_prop(M,F,A,RT))), 420 forall(retract(Head),(get_arity(FP,F,A),sanity(atom(F)),sanity(integer(A)),ain(mpred_prop(M,F,A,RT)))), 421 sanity((predicate_property(RHead,number_of_clauses(CL)),CL==0)), 422 sanity((predicate_property(RHead,number_of_rules(RL)),RL==0)), 423 abolish(RT,1));true), 424 425 asserta(AIN), 426 % compile_predicates([Head]), 427 nop(decl_rt(RT))))))),baseKB). 428 429quietly_ex(G):- !,,!. 430quietly_ex(G):- quietly(G). 431 432trace_or_throw_ex(G):- trace_or_throw(G). 433 434% ================================================= 435% ============== UTILS BEGIN ============== 436% ================================================= 437% copy_term_vn(A,A):- current_prolog_flag(unsafe_speedups , true) ,!. 438copy_term_vn(B,A):- ground(B),!,A=B. 439copy_term_vn(B,A):- !,copy_term(B,A). 440copy_term_vn(B,A):- need_speed,!,copy_term(B,A). 441copy_term_vn(B,A):- get_varname_list(Vs),length(Vs,L),L<30, shared_vars(B,Vs,Shared),Shared\==[],!,copy_term(B+Vs,A+Vs2),append(Vs,Vs2,Vs3),set_varname_list(Vs3),!. 442copy_term_vn(B,A):- nb_current('$old_variable_names',Vs),length(Vs,L),L<30, shared_vars(B,Vs,Shared),Shared\==[],!,copy_term(B+Vs,A+Vs2),append(Vs,Vs2,Vs3),b_setval('$old_variable_names',Vs3),!. 443copy_term_vn(B,A):- copy_term(B,A). 444 445 446setup_mpred_ops:- 447 op(500,fx,'-'), 448 op(300,fx,'~'), 449 op(1050,xfx,('==>')), 450 op(1050,xfx,'<==>'), 451 op(1050,xfx,('<-')), 452 op(1100,fx,('==>')), 453 op(1150,xfx,('::::')), 454 op(500,fx,user:'-'), 455 op(300,fx,user:'~'), 456 op(1050,xfx,(user:'==>')), 457 op(1050,xfx,user:'<==>'), 458 op(1050,xfx,(user:'<-')), 459 op(1100,fx,(user:'==>')), 460 op(1150,xfx,(user:'::::')). 461:- setup_mpred_ops. 462 463 464% :- mpred_ain_in_thread. 465% :- current_thread_pool(ain_pool)->true;thread_pool_create(ain_pool,20,[]). 466:- multifile thread_pool:create_pool/1. 467:- dynamic thread_pool:create_pool/1. 468thread_poolcreate_pool(ain_pool) :- 469 thread_pool_create(ain_pool, 50, [detached(true)] ). 470 471:- use_module(library(http/thread_httpd)). 472:- use_module(library(thread_pool)). 473 474is_ain_pool_empty:- thread_pool_property(ain_pool,running(N)),!,N==0. 475is_ain_pool_empty. 476 477show_ain_pool:- forall(thread_pool_property(ain_pool,PP),fmt(show_ain_pool(PP))). 478 479await_ain_pool:- is_ain_pool_empty->true;(repeat, sleep(0.005), is_ain_pool_empty). 480 481ain_in_thread(MAIN):- strip_module(MAIN,M,AIN), call_in_thread(M:ain(AIN)). 482 483call_in_thread(MG):- strip_module(MG,M,G), copy_term(M:G,GG,_),numbervars(GG,0,_),term_to_atom(GG,TN), call_in_thread(TN,M,G). 484 485call_in_thread(TN,M,G):- thread_property(_,alias(TN)),!,dmsg_pretty(already_queued(M,G)). 486call_in_thread(TN,M,G):- current_why(Why), thread_create_in_pool(ain_pool,call_in_thread_code(M,G,Why,TN),_Id,[alias(TN)]). 487 488call_in_thread_code(M,G,Why,TN):- 489 with_only_current_why(Why, 490 catch(( M:G-> nop(dmsg_pretty(suceeded(exit,TN)));dmsg_pretty(failed(exit,TN))),E,dmsg_pretty(error(E-->TN)))). 491 492% why_dmsg(Why,Msg):- with_current_why(Why,dmsg_pretty(Msg)). 493 494u_to_uu(U,(U,ax)):- var(U),!. 495u_to_uu(U,U):- nonvar(U),U=(_,_),!. 496u_to_uu([U|More],UU):-list_to_conj([U|More],C),!,u_to_uu(C,UU). 497u_to_uu(U,(U,ax)):-!.
503:- module_transparent((get_source_uu)/1). 504get_source_uu(UU):- must(((get_source_ref1(U),u_to_uu(U,UU)))),!. 505 506get_source_ref1(U):- quietly_ex(((current_why(U),nonvar(U)));ground(U)),!. 507get_source_ref1(U):- quietly_ex(((get_source_mfl(U)))),!. 508 509 510:- module_transparent((get_why_uu)/1). 511get_why_uu(UU):- findall(U,current_why(U),Whys),Whys\==[],!,u_to_uu(Whys,UU). 512get_why_uu(UU):- get_source_uu(UU),!. 513 514 515get_startup_uu(UU):-u_to_uu((isRuntime,mfl4(VarNameZ,baseKB, user_input, _)),UU),varnames_load_context(VarNameZ). 516 517is_user_reason((_,U)):-atomic(U). 518only_is_user_reason((U1,U2)):- freeze(U2,is_user_reason((U1,U2))). 519 520is_user_fact(P):-get_first_user_reason(P,UU),is_user_reason(UU). 521 522 523get_first_real_user_reason(P,UU):- nonvar(P), UU=(F,T), 524 quietly_ex(( ((((lookup_spft(P,F,T))),is_user_reason(UU))*-> true; 525 ((((lookup_spft(P,F,T))), \+ is_user_reason(UU))*-> (!,fail) ; fail)))). 526 527get_first_user_reason(P,(F,T)):- 528 UU=(F,T), 529 ((((lookup_spft(P,F,T))),is_user_reason(UU))*-> true; 530 ((((lookup_spft(P,F,T))), \+ is_user_reason(UU))*-> (!,fail) ; 531 (clause_asserted_u(P),get_source_uu(UU),is_user_reason(UU)))),!. 532get_first_user_reason(_,UU):- get_why_uu(UU),is_user_reason(UU),!. 533get_first_user_reason(_,UU):- get_why_uu(UU),!. 534get_first_user_reason(P,UU):- must_ex(ignore(((get_first_user_reason0(P,UU))))),!. 535get_first_user_reason0(_,(M,ax)):-get_source_mfl(M). 536 537%get_first_user_reason(_,UU):- get_source_uu(UU),\+is_user_reason(UU). % ignore(get_source_uu(UU)). 538 539%:- export(mpred_at_box:defaultAssertMt/1). 540%:- system:import(defaultAssertMt/1). 541%:- pfc_lib:import(mpred_at_box:defaultAssertMt/1). 542 543:- module_transparent((get_source_mfl)/1). 544get_source_mfl(M):- current_why(M), nonvar(M) , M =mfl4(_VarNameZ,_,_,_). 545get_source_mfl(mfl4(VarNameZ,M,F,L)):- defaultAssertMt(M), current_source_location(F,L),varnames_load_context(VarNameZ). 546 547get_source_mfl(mfl4(VarNameZ,M,F,L)):- defaultAssertMt(M), current_source_file(F:L),varnames_load_context(VarNameZ). 548get_source_mfl(mfl4(VarNameZ,M,F,_L)):- defaultAssertMt(M), current_source_file(F),varnames_load_context(VarNameZ). 549get_source_mfl(mfl4(VarNameZ,M,_F,_L)):- defaultAssertMt(M), varnames_load_context(VarNameZ). 550%get_source_mfl(M):- (defaultAssertMt(M)->true;(atom(M)->(module_property(M,class(_)),!);(var(M),module_property(M,class(_))))). 551get_source_mfl(M):- fail,dtrace, 552 ((defaultAssertMt(M) -> !; 553 (atom(M)->(module_property(M,class(_)),!); 554 mpred_error(no_source_ref(M))))). 555 556is_source_ref1(_). 557 558unassertable(Var):-var(Var),!. 559unassertable((M:V)):-nonvar(M),!,unassertable(V). 560unassertable((_;_)). 561unassertable((_,_)). 562 563:- style_check(+discontiguous). 564 565to_real_mt(_Why,abox,ABOX):- defaultAssertMt(ABOX),!. 566to_real_mt(_Why,tbox,TBOX):- get_current_default_tbox(TBOX),!. 567to_real_mt(_Why,BOX,BOX).
fix_mp(Why,I,UO):- compound(UO),dtrace,UO=(U:O),!,quietly_must(fix_mp(Why,I,U,O)).
fix_mp(Why,I,MT:UO):- current_prolog_flag(unsafe_speedups , true) , !, strip_module(I,_,UO),defaultAssertMt(MT).
575fix_mp(Why,I,UO):- quietly_must(fix_mp(Why,I,U,O)),maybe_prepend_mt(U,O,UO). 576 577 578fix_mp(Why,G,M,GOO):- 579 must_ex((quietly_ex((fix_mp0(Why,G,M,GO),strip_module(GO,_,GOO))))). 580 581meta_split(PQ,P,OP,Q):-PQ univ_safe [OP,P,Q],arg(_,v('<-','==>','<==>','==>',(','),(';')),OP). 582 583fix_mp0(Nonvar,Var,ABox,VarO):- sanity(nonvar(Nonvar)), is_ftVar(Var),!,Var=VarO,defaultAssertMt(ABox),!. 584fix_mp0(Why, '~'(G), M, '~'(GO)):-nonvar(G),!,fix_mp0(Why,G,M,GO). 585fix_mp0(Why,'?-'(G),M, '?-'(GO)):-nonvar(G),!,fix_mp0(Why,G,M,GO). 586fix_mp0(Why,':-'(G),M, ':-'(GO)):-nonvar(G),!,fix_mp0(Why,G,M,GO). 587fix_mp0(Why,(:- G),M,(:- GO)):- !, fix_mp0(Why,G,M,GO). 588fix_mp0(Why,(G :- B),M,( GO :- B)):- !, fix_mp0(Why,G,M,GO). 589% fix_mp0(Why,(G <- B),M,( GO <- B)):- !, fix_mp0(Why,G,M,GO). 590fix_mp0(Why,CM:(G :- B),M,( GO :- B)):- !, CM:fix_mp0(Why,G,M,GO). 591 592fix_mp0(_Why,spft(P,(mfl4(VarNameZ,FromMt,File,Lineno),UserWhy)),FromMt,spft(P,(mfl4(VarNameZ,FromMt,File,Lineno),UserWhy))):-!. 593 594fix_mp0(Why,M:P,MT,P):- to_real_mt(Why,M,MT)->M\==MT,!,fix_mp0(Why,MT:P,MT,P). 595 596% fix_mp0(Why,PQ,M,PPQQ):- meta_split(PQ,P,OP,Q),!,fix_mp(Why,P,M1,PP),fix_mp(Why,Q,M2,QQ),(M1\==M2 -> (QQ\==Q->M=M2;M=M1) ; M=M1),!,meta_split(PPQQ,PP,OP,QQ). 597 598fix_mp0(_Why,Mt:P,Mt,P):- clause_b(mtExact(Mt)),!. 599 600 601fix_mp0(Why,G,M,GO):- /*Why = change(_,_),*/ strip_module(G,WAZ,GO), 602 % ((G==GO; (context_module(CM),CM==WAZ) ; (defaultAssertMt(ABox),ABox==WAZ) ; \+ clause_b(mtHybrid(WAZ)) ; (header_sane==WAZ); (abox==WAZ))), 603 must_ex(get_unnegated_functor(GO,F,A)) 604 -> % loop_check 605 (WAZ:convention_to_mt(WAZ,Why,F,A,M)),!. 606 607 608fix_mp0(_Why,Mt:P,Mt,P):- clause_b(mtHybrid(Mt)),!. 609 610fix_mp0(_Why,I,ABox,I):- defaultAssertMt(ABox),!. 611 612/* 613fix_mp(Why,Junct,ABox,Result):- fail, (mpred_db_type(Junct,rule(_));(safe_functor(Junct,F,_),bad_head_pred(F))),!, 614 must_ex((mpred_rule_hb(Junct,HC,BC),nonvar(HC))), 615 Junct univ_safe [F|List], 616 must_maplist(fix_mp(call(hb(HC,BC,Op))),List,ListO), 617 Result univ_safe [F|ListO], 618 defaultAssertMt(ABox),!. 619 620%fix_mp(call(hb(HC,_BC,Op)),H,M,HH):- contains_var(H,HC),!, 621% fix_mp(change(assert,Op),H,M,HH). 622 623fix_mp(call(hb(_HC,BC,Op)),B,M,BB):- contains_var(B,BC),B\=@=BC,!, 624 fix_mp(call(Op),B,M,BB). 625 626 627 628% fix_mp(Why,Unassertable,_,_):- Why = clause(_,_), unassertable(Unassertable),!,trace_or_throw_ex(unassertable_fix_mp(Why,Unassertable)). 629 630*/ 631system_between(A,B,C):-call(call,between,A,B,C). 632 633mpred_truth_value(Call,vTrue,vAsserted):-clause_b(Call),!. 634mpred_truth_value(Call,vTrue,vDeduced):-call_u(Call),!. 635mpred_truth_value(_Call,vUnknown,vFailed). 636 637convention_to_mt(From,Why,F,A,RealMt):-convention_to_symbolic_mt_ec(From,Why,F,A,Mt),to_real_mt(Why,Mt,RealMt). 638 639get_unnegated_mfa(M:G,M,F,A):-!,get_unnegated_functor(G,F,A). 640get_unnegated_mfa(G,M,F,A):- strip_module(G,M0,_),get_unnegated_functor(G,F,A), 641 convention_to_mt(M0,get_unnegated_mfa(G,M,F,A),F,A,M). 642 643get_unnegated_functor(G,F,A):- strip_module(G,_,GO), 644 get_assertion_head_unnegated(GO,Unwrap), 645 nonvar(Unwrap), 646 safe_functor(Unwrap,F,A), 647 ignore(show_failure(\+ bad_head_pred(F))),!. 648 649 650:- module_transparent( (get_assertion_head_unnegated)/2). 651 652get_assertion_head_unnegated(Head,Unwrap):- 653 get_assertion_head(Head,Mid), 654 maybe_unnegated(Mid,Unwrap). 655 656 657maybe_unnegated(Head,Head):- \+ compound(Head),!. 658maybe_unnegated(~ Head,Unwrap):- \+ is_ftVar(Head),!, get_assertion_head(Head,Unwrap). 659maybe_unnegated( \+ Head,Unwrap):- \+ is_ftVar(Head),!, get_assertion_head(Head,Unwrap). 660maybe_unnegated(Head,Unwrap):- get_assertion_head(Head,Unwrap). 661 662 663get_assertion_head(Head,Head):- \+ compound(Head),!. 664get_assertion_head(Head,Unwrap):- is_ftVar(Head),!,Head=Unwrap. 665get_assertion_head( ( Head :- _ ),Unwrap):- nonvar(Head), !, get_assertion_head(Head,Unwrap). 666get_assertion_head(Head,Unwrap):- strip_module(Head,_,HeadM),Head\=@=HeadM,!,get_assertion_head(HeadM,Unwrap). 667% Should? 668get_assertion_head( ( _,Head),Unwrap):- \+ is_ftVar(Head),!, get_assertion_head(Head,Unwrap). 669% Should? 670get_assertion_head((P/_),PP):- \+ is_ftVar(P),!,get_assertion_head(P,PP). 671% Should? 672% NOOOO get_assertion_head((P<-_),PP):-compound(P),!,get_assertion_head(P,PP). 673% disabled 674get_assertion_head( Head,UnwrapO):- fail, mpred_rule_hb(Head,Unwrap,_),nonvar(Unwrap), 675 Head \=@= Unwrap,!,get_assertion_head(Unwrap,UnwrapO). 676get_assertion_head(P,P). 677 678 679get_head_term(Form,Form):-var(Form),!. 680get_head_term(F/A,Form):- integer(A),safe_functor(Form,F,A),!. 681get_head_term(Form0,Form):- get_assertion_head_unnegated(Form0,Form). 682 683 684bad_head_pred([]). 685bad_head_pred('[]'). 686bad_head_pred((.)). 687bad_head_pred('{}'). 688bad_head_pred('[|]'). 689bad_head_pred(','). 690bad_head_pred(':'). 691bad_head_pred('/'). 692bad_head_pred(':-'). 693bad_head_pred(';'). 694bad_head_pred( \+ ). 695bad_head_pred_neg('~'). 696 697% bad_head_pred('=>'). 698% bad_head_pred('<-'). 699% bad_head_pred('==>'). 700% Probably bad_head_pred('==>'). 701 702% the next line transforms to pfc_lib:convention_to_symbolic_mt(_From,_Why,A, _, B) :- call(ereq, predicateConventionMt(A, B)), !. 703 704convention_to_symbolic_mt_ec(From,Why,F,A,Mt):-convention_to_symbolic_mt(From,Why,F,A,Mt). 705 706/*convention_to_symbolic_mt(_From,_Why,predicateConventionMt,2,baseKB):-!. 707convention_to_symbolic_mt(_From,_Why,genlMt,2,baseKB):-!. 708convention_to_symbolic_mt(_From,_Why,mtNonAssertable,1,baseKB):-!. 709convention_to_symbolic_mt(_From,_Why,mtProlog,1,baseKB):-!. 710convention_to_symbolic_mt(_From,_Why,functorDeclares,1,baseKB):-!. 711convention_to_symbolic_mt(_From,_Why,functorIsMacro,1,baseKB):-!. 712*/ 713 714convention_to_symbolic_mt(_From,_Why,mtHybrid,1,baseKB):-!. 715convention_to_symbolic_mt(From,_Why,F,_,Mt):- clause_b(From:predicateConventionMt(F,Mt)),!. 716convention_to_symbolic_mt(_From,_Why,F,A,M):- lmcache:already_decl(kb_global,M,F,A),!. 717 718 719 720 721% convention_to_symbolic_mt(From,Why,F,A,Error):- bad_head_pred(F),!,dumpST,dmsg_pretty(bad_head_pred(F)),break,trace_or_throw_ex(error_convention_to_symbolic_mt(From,Why,F,A,Error)). 722convention_to_symbolic_mt(_From,_Why,F,A,M):- lmcache:already_decl(kb_global,M,F,A),!. 723convention_to_symbolic_mt(_From,_Why,F,A,abox):- mpred_database_term_syntax(F,A,_). 724convention_to_symbolic_mt(_From,_Why,F,A,abox):- lmcache:already_decl(kb_shared,_,F,A),!. 725convention_to_symbolic_mt(_From,_Why,F,A,abox):- lmcache:already_decl(kb_local,_,F,A),!. 726 727convention_to_symbolic_mt(_From,_Why,F,A,Mt):- safe_functor(P,F,A),show_success(predicate_property(P,imported_from(Mt))),!. 728convention_to_symbolic_mt(_From,_Why,F,A, M):- lmcache:already_decl(kb_global,M,F,A),!. 729convention_to_symbolic_mt(_From,_Why,F,A,abox):- mpred_database_term(F,A,_). 730convention_to_symbolic_mt(_From,_Why,F,A,abox):- clause_b(safe_wrap(_M,F,A,ereq)). 731 732 733convention_to_symbolic_mt(From,Why,F,A,Error):- bad_head_pred(F),!,Error = From, 734 if_interactive(( 735 dumpST,dmsg_pretty(bad_head_pred(F)),break,trace_or_throw_ex(error_convention_to_symbolic_mt(From,Why,F,A,Error)))). 736 737 738% convention_to_symbolic_mt(_From,_Why,_,_,M):- atom(M),!. 739 740full_transform_warn_if_changed(_,MH,MHH):-!,MH=MHH. 741full_transform_warn_if_changed(Why,MH,MHH):- full_transform(Why,MH,MHH),!,sanity(MH=@=MHH). 742full_transform_warn_if_same(Why,MH,MHH):- full_transform(Why,MH,MHH),!,sanity(MH \=@= MHH). 743 744/* 745full_transform_and_orignal(Why,MH,MHO):- full_transform(Why,MH,MHH), 746 (MH=@=MHH -> MHO=MH ; (MHO = MHH ; MHO = MH )). 747 748 749 750full_transform(Op,ISA,SentO):- nonvar(ISA),isa(I,C)=ISA,!, must_ex(fully_expand_real(Op,isa(I,C),SentO)),!. 751full_transform(Op,Sent,SentO):- safe_functor(Sent,F,A),may_fully_expand(F,A),!, 752 must_ex(fully_expand_real(Op,Sent,SentO)),!. 753 754*/ 755%:- use_module(mpred_expansion). 756 757/* 758full_transform(Why,MH,MHH):- has_skolem_attrvars(MH),!, 759 rtrace(fully_expand_real(change(assert,skolems(Why)),MH,MHH)),!, 760 nop(sanity(on_f_debug(same_modules(MH,MHH)))),!. 761*/ 762%full_transform(Why,MH,MHH):- \+ compound(MH),!, 763% must_det(fully_expand_real(change(assert,Why),MH,MHH)),!. 764 % nop(sanity(on_f_debug(same_modules(MH,MHH)))). 765%full_transform(Op,==> CI,SentO):- nonvar(CI),!, full_transform(Op,CI,SentO). 766%full_transform(Op,isa(I,C),SentO):- nonvar(C),!,must_ex(fully_expand_real(Op,isa(I,C),SentO)),!. 767%full_transform(_,CI,SentO):- CI univ_safe [_C,I], atom(I),!,if_defined(do_renames(CI,SentO),CI=SentO),!. 768full_transform(Why,MH,MHH):- 769 must_det(fully_expand_real(change(assert,Why),MH,MHH)),!, 770 nop(sanity(on_f_debug(same_modules(MH,MHH)))). 771 772same_modules(MH,MHH):- strip_module(MH,HM,_),strip_module(MHH,HHM,_),!, 773 HM==HHM. 774 775%full_transform_compound(Op,ISA,SentO):- compound(ISA),isa(I,C)=ISA,!, must_ex(fully_expand_real(Op,isa(I,C),SentO)),!. 776%full_transform_compound(Why,MH,MHH):- 777% must_det(fully_expand_real(change(assert,Why),MH,MHH)),!. 778 % nop(sanity(on_f_debug(same_modules(MH,MHH)))). 779 780 781%:- if(\+ current_prolog_flag(umt_local,false)). 782 783listing_i(MP):- % strip_module(MP,M,P),!, 784 forall(to_mpi_matcher(MP,MM:PI), 785 listing_mpi(MP,MM:PI)). 786 787:- reconsult(library(listing)). 788%:- system:reexport(library(xlisting)). 789 790%listing_mpi(_MP,MMPI):- (predicate_property(MMPI,number_of_clauses(NC))->NC==0;true),!, 791% unify_listing_header(MMPI),prolog_listing_list_clauses(MMPI, none),!. 792%listing_mpi(_MP,MMPI):- !,unify_listing_header(MMPI), 793% prolog_listing:list_clauses(MMPI, none). 794listing_mpi(_MP,MM:PI):- forall(clause_u(MM:PI,B,R),foo:once(portray_hbr(MM:PI,B,R))). 795 796listing_u(P):-call_u_no_bc(xlisting((P,-lmcache,/*-spft,*/-xlisting))),!. 797 798attvar_op_fully(What,MH):- !, attvar_op(What,MH). 799%attvar_op_fully(What,M:H):- must_notrace_pfc(full_transform_warn_if_changed(change(What,attvar_op_fully),H,true,HH,true)),!,each_E(attvar_op(What),M:HH,[]). 800%attvar_op_fully(What,MH):- full_transform_warn_if_changed(What, MH,MHH),each_E(attvar_op(What),MHH,[]). 801 802throw_depricated:- trace_or_throw_ex(throw_depricated). 803 804do_db_checks:- fail. 805 806assert_u(MH):- assert_u_no_dep(MH). 807 808assert_u_no_dep(X):- do_db_checks, check_never_assert(X),fail. 809assert_u_no_dep(MH):- fix_mp(change(assert,assert_u),MH,MHA), 810 attvar_op_fully(db_op_call(assert,assert_i), MHA),expire_tabled_list(MHA). 811 812asserta_u(X):- do_db_checks, check_never_assert(X),fail. 813asserta_u(MH):- fix_mp(change(assert,asserta_u),MH,MHA),attvar_op_fully(db_op_call(asserta,asserta_i),MHA). 814 815assertz_u(X):- do_db_checks, check_never_assert(X),fail. 816assertz_u(MH):- fix_mp(change(assert,assertz_u),MH,MHA),attvar_op_fully(db_op_call(asserta,assertz_i),MHA). 817 818% retract_u((H:-B)):- !, show_failure(retract((H:-B))). 819retract_u(H):- retract_u0(H) *-> true; ((fail,attvar_op_fully(db_op_call(retract,retract_u0),H))). 820 821retract_u0(X):- do_db_checks, check_never_retract(X),fail. 822retract_u0(H0):- strip_module(H0,_,H),(H = ( \+ _ )),!,trace_or_throw_ex(mpred_warn(retract_u(H0))),expire_tabled_list(H). 823retract_u0(M:(H:-B)):- atom(M),!, M:clause_u(H,B,R),erase(R),expire_tabled_list(H). 824retract_u0(M:(H)):- atom(M),!, M:clause_u(H,true,R),erase(R),expire_tabled_list(H). 825retract_u0((H:-B)):-!,clause_u(H,B,R),erase(R),expire_tabled_list(H). 826retract_u0(H):- clause_u(H,true,R),erase(R),expire_tabled_list(H). 827 828:- lmcache:import(retract_u0/1). 829 830retractall_u(X):- do_db_checks, check_never_retract(X),fail. 831retractall_u(H):- attvar_op_fully(db_op_call(retractall,retractall_u0),H). 832 833retractall_u0(X):- do_db_checks, check_never_retract(X),fail. 834retractall_u0(H):- forall(clause_u(H,_,R),erase(R)),expire_tabled_list(H). 835 836 837 838clause_u(C):- expand_to_hb(C,H,B),!,clause_u(H,B).
844% clause_u(H,B):- current_prolog_flag(unsafe_speedups , true) , ground(H:B),!,clause(H,B). 845clause_u(H,B):- clause_u(H,B,_). 846%clause_u(H,B):- clause_true( ==>( B , H) ). 847%clause_u(H,B):- clause_true( <-( H , B) ). 848 849match_attvar_clauses(HH,BB,H,B):- 850 matrialize_clause((H:-B),C), 851 matrialize_clause((HH:-BB),CC),!, 852 C=CC. 853 854matrialize_clause((H:-B),(H:-B)):- \+ compound(B),!. 855matrialize_clause((H:-attr_bind(Attribs,B)),(H:-B)):-!, attr_bind(Attribs). 856matrialize_clause((H:-attr_bind(Attribs)),(H:-true)):-!, attr_bind(Attribs). 857 858:- set_prolog_flag(clause_u_h_exact,false). 859:- set_prolog_flag(clause_u_mh_inherit,false). 860 861should_inherit(_, M,_,TF):- mtInherits(M),!,TF=true. 862should_inherit(_, M,_,TF):- mtNotInherits(M),!,TF=false. 863should_inherit(h, _,_,TF):- current_prolog_flag(clause_u_h_exact,false) -> TF = true ; TF = false. 864should_inherit(mh,_,_,TF):- current_prolog_flag(clause_u_mh_inherit,TF).
870clause_u(MH,B,R):- nonvar(R),!,must_ex(clause_i(M:H,B,R)),must_ex((MH=(M:H);MH=(H))),!. 871clause_u(H,B,Ref):-var(H),!,trace_or_throw_ex(var_clause_u(H,B,Ref)). 872clause_u((H:-BB),B,Ref):- is_true(B),!, trace_or_throw_ex(malformed(clause_u((H:-BB),B,Ref))),clause_u(H,BB,Ref). 873clause_u((H:-B),BB,Ref):- is_true(B),!, trace_or_throw_ex(malformed(clause_u((H:-B),BB,Ref))),clause_u(H,BB,Ref). 874 875clause_u(H,B,R):-clause_u_visible(H,B,R),B \= inherit_above(_,_). 876 877module_clause(MHB):- strip_module(MHB,M,HB), expand_to_hb(HB,H,B),clause(M:,B,R),clause_property(R,module(CM)),CM==M. 878 879clause_u_visible(M:H,B,R):- !, clause_i(M:H,B,R),clause_ref_module(R). % need? \+ reserved_body_helper(B) 880clause_u_visible(MH,B,R):- Why = clause(clause,clause_u), 881 quietly_ex(fix_mp(Why,MH,M,H)), 882 (clause(M:,B,R)*->true;clause_i(M:H,B,R)). 883 884% clause_u(H,B,Why):- has_cl(H),clause_u(H,CL,R),mpred_pbody(H,CL,R,B,Why). 885%clause_u(H,B,backward(R)):- R=(<-(H,B)),clause_u(R,true). 886%clause_u(H,B,equiv(R)):- R=(<==>(LS,RS)),clause_u(R,true),(((LS=H,RS=B));((LS=B,RS=H))). 887%clause_u(H,true, pfcTypeFull(R,Type)):-is_ftNonvar(H),!,pfcDatabaseTerm(F/A),make_functor(R,F,A),pfcRuleOutcomeHead(R,H),clause(R,true),pfcTypeFull(R,Type),Type\=rule. 888%clause_u(H,true, pfcTypeFull(R)):-pfcDatabaseTerm(F/A),make_functor(R,F,A),pfcTypeFull(R,Type),Type\=rule,clause(R,true),once(pfcRuleOutcomeHead(R,H)). 889%clause_u('nesc'(H),B,forward(Proof)):- is_ftNonvar(H),!, clause_u(H,B,Proof). 890%clause_u(H,B,forward(R)):- R=(==>(B,H)),clause_u(R,true). 891 892clause_uu(H,B,Ref):- var(H),var(Ref),!,trace_or_throw_ex(var_clause_u(H,B,Ref)). 893clause_uu(M:H,B,R):- safe_functor(H,F,A),safe_functor(HH,F,A),!,should_inherit(mh,M,H,TF),clause_u_attv_m(mh,TF,M,HH,BB,R),match_attvar_clauses(HH,BB,H,B). 894clause_uu( H,B,R):- safe_functor(H,F,A),safe_functor(HH,F,A),!,defaultAssertMt(M),should_inherit(h,M,H,TF),clause_u_attv_m(mh,TF,M,HH,BB,R),match_attvar_clauses(HH,BB,H,B). 895 896 897clause_u_attv_m(MP,Herit,M,H,B,Ref):-var(H),var(Ref),!,trace_or_throw_ex(var_clause_u_attv_m(MP,Herit,M,H,B,Ref)). 898clause_u_attv_m(_,_,M,H,B,R):- nonvar(R),!,must_ex(clause_i(M:H,B,R)),!. % must_ex((MH=(M:H);MH=(H))),!. 899clause_u_attv_m(MP,Herit,M,(H:-BB),B,Ref):- is_true(B),!, trace_or_throw_ex(malformed(clause_u(MP,Herit,M,(H:-BB),B,Ref))),clause_u(H,BB,Ref). 900clause_u_attv_m(MP,Herit,M,(H:-B),BB,Ref):- is_true(B),!, trace_or_throw_ex(malformed(clause_u(MP,Herit,M,(H:-B),BB,Ref))),clause_u(H,BB,Ref). 901clause_u_attv_m(MP,Herit,M,H,B,Ref):- clause_u_attv_b(MP,Herit,M,H,B,Ref), 902 B \= inherit_above(M,_), (->clause_ref_module(Ref);clause_ref_module(M,Ref)). 903 904clause_u_attv_b(mh,false,M,H,B,R):- !, clause_i(M:H,B,R), B \= inherit_above(M,_). 905clause_u_attv_b(mh,true,IM,H,B,R):- genlMt_each(IM,M),clause_i(M:H,B,R), B \= inherit_above(M,_). 906clause_u_attv_b(mh,_,M,H,B,R):- !, clause_u_attv_mhbr(M:H,B,R). 907clause_u_attv_b(h,false,M,H,B,R):- clause_i(M:H,B,R). 908clause_u_attv_b(h,_,M,H,B,R):- clause_u_attv_mhbr(M:H,B,R). 909clause_u_attv_b(h,true,M,H,B,R):- clause_i(M:H,B,R). 910 911genlMt_each(M,M). 912genlMt_each(M,O):- genlMt(M,P),(O=P;genlMt(P,O)). 913 914clause_u_attv_mhbr(MH,B,R):- 915 Why = clause(clause,clause_u), 916 ((quietly_ex(fix_mp(Why,MH,M,H)), 917 clause(M:,B,R))*->true; 918 (fix_mp(Why,MH,M,CALL)->clause_i(M:CALL,B,R))).
clause_u(pfc,H,B,Proof):-clause_u(H,B,Proof).
928clause_ref_module(M,Ref):- (clause_property(Ref,module(CM))-> M=CM; false). % clause_ref_module(Ref) ? 929clause_ref_module(Ref):- clause_property(Ref,module(CM)),module_direct(CM). 930 931module_direct(CM):- t_l:exact_kb(M)*->CM=M; true. 932 933with_exact_kb(MM,Call):- locally_tl(exact_kb(MM),Call). 934 935 936lookup_kb(MM,MHB):- strip_module(MHB,M,HB), 937 expand_to_hb(HB,H,B), 938 (MM:clause(M:H,B,Ref)*->true; M:clause(MM:H,B,Ref)), 939 %clause_ref_module(Ref), 940 clause_property(Ref,module(MM)). 941 942% lookup_u/cheaply_u/call_u/clause_b 943lookup_m(SPFT):- callable(SPFT),!,clause_b(SPFT). 944lookup_m(SPFT):- callable(SPFT),!,baseKB:on_x_rtrace(SPFT). 945 946 947lookup_u(SPFT):- callable(SPFT),on_x_rtrace(SPFT). 948% baseKB:SPFT:- current_prolog_flag(unsafe_speedups , true) , !,baseKB:mtHybrid(MT),call(MT:SPFT). 949% lookup_u(H):-lookup_u(H,_). 950 951lookup_u(MH,Ref):- nonvar(Ref),!, 952 must_ex(clause(H,B,Ref)), 953 clause_ref_module(Ref), 954 must_ex(hb_to_clause(H,B,MHI)),!, 955 MH=MHI. 956 957lookup_u((MH,H),Ref):- nonvar(MH),!,lookup_u(MH),lookup_u(H,Ref). 958lookup_u(MH,Ref):- clause_u(MH,true,Ref),clause_ref_module(Ref). 959 960 961:- thread_local(t_l:current_defaultAssertMt/1). 962:- was_module_transparent(with_umt/2). 963:- was_export(with_umt/2).
969with_umt(mud_telnet,P):- !,with_umt(baseKB,P). 970with_umt(U,G):- sanity(stack_check(5000)), 971 (t_l:current_defaultAssertMt(W)->W=U,!,call_from_module(U,G)). 972%with_umt(user,P):- !,with_umt(baseKB,P). 973with_umt(M,P):- 974 (clause_b(mtHybrid(M))-> W=M;defaultAssertMt(W)),!, 975 locally_tl(current_defaultAssertMt(W), 976 call_from_module(W,P)). 977 978 979/* 980listing_u(P):- (listing(P)). 981assert_u(A):- assert(A). 982asserta_u(A):- asserta(A). 983assertz_u(A):- assertz(A). 984retract_u((H:-B)):-!, clause_u(H,B,R),erase(R). 985retract_u(H):-!, clause_u(H,true,R),erase(R). 986retractall_u(H):- forall(clause_u(H,_,R),erase(R)). 987clause_u(H,B):- clause_u(H,B,_). 988clause_u(H,B,R):- clause_i(H,B,R). 989call_u_no_bc(G):- G. 990*/
996each_E(P,HV,S):- check_context_module, var(HV),!,apply(P,[HV|S]). 997each_E(P,M:(H,T),S) :- must_be(atom,M),!,each_E(P,M:H,S), each_E(P,M:T,S). 998each_E(P,M:[H],S) :- must_be(atom,M),!,each_E(P,M:H,S). 999each_E(P,M:[H|T],S) :- must_be(atom,M),!,each_E(P,M:H,S), each_E(P,M:T,S). 1000each_E(P,M:HT,S) :- M=='$si$',!,apply(P,[M:HT|S]). 1001each_E(P,M:HT,S) :- !, must_be(atom,M),M:each_E(P,HT,S). 1002each_E(P,[H],S) :- !, each_E(P,H,S). 1003each_E(P,[H|T],S) :- !, each_E(P,H,S), each_E(P,T,S). 1004each_E(P,(H,T),S) :- !, each_E(P,H,S), each_E(P,T,S). 1005each_E(P,H,S) :- apply(P,[H|S]). 1006 1007 1008% ================================================= 1009% ============== UTILS END ============== 1010% ================================================= 1011 1012:- style_check(+singleton). 1013% File : mpred_syntax.pl 1014% Author : Tim Finin, finin@prc.unisys.com 1015% Purpose: syntactic sugar for Pfc - operator definitions and term expansions. 1016 1017:- op(500,fx,'-'). 1018:- op(300,fx,'~'). 1019:- op(1050,xfx,('==>')). 1020:- op(1050,xfx,'<==>'). 1021:- op(1050,xfx,('<-')). 1022:- op(1100,fx,('==>')). 1023:- op(1150,xfx,('::::')). 1024 1025:- export('__aux_maplist/2_call+0'/1). 1026:- meta_predicate('__aux_maplist/2_call+0'()). 1027'__aux_maplist/2_call+0'([]). 1028'__aux_maplist/2_call+0'([A|B]) :-!, 1029 call(A), 1030 '__aux_maplist/2_call+0'(B). 1031'__aux_maplist/2_call+0'(_:[]). 1032'__aux_maplist/2_call+0'(M:[A|B]) :- 1033 M:call(A), 1034 '__aux_maplist/2_call+0'(M:B). 1035 1036 1037:- use_module(library(lists)). 1038 1039 1040 1041% predicates to examine the state of mpred_ 1042 1043 1044pp_qu:- call_u_no_bc(listing(que/1)). 1045 1046% File : pfc_lib.pl 1047% Author : Tim Finin, finin@prc.unisys.com 1048% Updated: 10/11/87, ... 1049% 4/2/91 by R. McEntire: added calls to valid_dbref as a 1050% workaround for the Quintus 3.1 1051% bug in the recorded database. 1052% Purpose: core Pfc predicates. 1053 1054 1055% ============================================ 1056% % initialization of global assertons 1057% ============================================
1065mpred_set_default(GeneralTerm,Default):- 1066 clause_u(GeneralTerm,true) -> true ; assert_u_no_dep(Default). 1067 1068% tms is one of {none,local,cycles} and controles the tms alg. 1069% :- mpred_set_default(tms(_),tms(cycles)). 1070 1071% Pfc Propagation strategy. pm(X) where P is one of {direct,depth,breadth} 1072% :- must_ex(mpred_set_default(pm(_), pm(direct))). 1073 1074 1075ain_expanded(IIIOOO):- mpred_ain((IIIOOO)). 1076 1077ain_expanded(IIIOOO,S):- mpred_ain((IIIOOO),S).
1084mpred_ainz(G):- locally_tl(assert_to(z),mpred_ain(G)). 1085mpred_ainz(G,S):- locally_tl(assert_to(z),mpred_ain(G,S)).
1091mpred_aina(G):- locally_tl(assert_to(a),mpred_ain(G)). 1092mpred_aina(G,S):- locally_tl(assert_to(a),mpred_ain(G,S)).
mpred_ain/2 and mpred_post/2 are the proper ways to add new clauses into the database and have forward reasoning done.
1101mpred_ain(_:P):- retractall(t_l:busy(_)), P==end_of_file,!. 1102mpred_ain(_:props(_,EL)):- EL==[],!. 1103mpred_ain(M:P):- M:get_source_uu(UU),M:mpred_ain(M:P,UU). 1104 1105mpred_add(P):- mpred_ain(P).
1112decl_assertable_module(AM):- nop((must_ex(dynamic(AM:spft/3)))). 1113 1114% mpred_ain_cm(SM:(==>(AM:P)),P,AM,SM):- SM\==AM, current_predicate(SM:spft/3),!,decl_assertable_module(SM). 1115mpred_ain_cm(SM:(==>(AM:P)),==>P,AM,SM):- AM==SM,!,decl_assertable_module(AM). 1116mpred_ain_cm(SM:(==>(_:(AM:P :- B))),==>(AM:P :- SM:B),AM,SM):- nonvar(P), decl_assertable_module(AM). 1117mpred_ain_cm(SM:(==>(AM:P)),==>P,AM,AM):- decl_assertable_module(AM),!,decl_assertable_module(SM). 1118mpred_ain_cm((==>(AM:P)),==>P,AM,AM):- decl_assertable_module(AM),!. 1119mpred_ain_cm((==>(P)),==>P,AM,SM):- get_assert_to(AM), guess_pos_source_to(SM),!. 1120mpred_ain_cm(M:(==>(P)),==>P,AM,AM):- context_module(M),get_assert_to(AM),!. % guess_pos_source_to(SM). 1121mpred_ain_cm(AM:(==>(P)),==>P,AM,AM):- !. 1122 1123mpred_ain_cm(AM:P,P,SM,AM):- !, context_module(SM). 1124mpred_ain_cm( P,P,SM,AM):- get_assert_to(AM), context_module(SM). 1125 1126 1127guess_pos_assert_to(ToMt):- 1128 ((guess_pos_source_to(ToMt), \+ is_code_module(ToMt), mtCanAssert(ToMt))*-> true; 1129 ((guess_pos_source_to(ToMt), \+ is_code_module(ToMt))*-> true ; 1130 ((guess_pos_source_to(ToMt), mtCanAssert(ToMt))*-> true; 1131 guess_pos_source_to(ToMt)))). 1132 1133:- dynamic(baseKB:mtExact/1). 1134 1135 1136% guess_pos_source_to(ToMt):- t_l:current_defaultAssertMt(ToMt). 1137 1138guess_pos_source_to(ToMt):- no_repeats(ToMt,guess_pos_source_to0(ToMt)). 1139 1140guess_pos_source_to0(ToMt):- t_l:current_defaultAssertMt(ToMt). 1141guess_pos_source_to0(ToMt):- '$current_source_module'(ToMt). 1142guess_pos_source_to0(ToMt):- context_module(ToMt). 1143guess_pos_source_to0(ToMt):- '$current_typein_module'(ToMt). 1144guess_pos_source_to0(ToMt):- guess_pfc_file(File),module_property(ToMt,file(File)),File\==ToMt. 1145guess_pos_source_to0(ToMt):- prolog_load_context(module,ToMt). 1146guess_pos_source_to0(ToMt):- defaultAssertMt(ToMt). 1147guess_pos_source_to0(baseKB). 1148 1149guess_pfc_file(File):- which_file(File). 1150guess_pfc_file(File):- loading_source_file(File),get_file_type_local(File,pfc). 1151 1152get_assert_to(ABox):- (var(ABox)->guess_pos_assert_to(ABox);(guess_pos_assert_to(ABoxVar),ABox=ABoxVar)),!. 1153 1154% get_query_from(SM):- '$current_source_module'(SM). 1155get_query_from(SM):- guess_pos_assert_to(SM), \+ is_code_module(SM),!. 1156get_query_from(baseKB). 1157 1158:- baseKB:import(is_code_module/1). 1159is_code_module(system). 1160is_code_module(user). 1161is_code_module(baseKB):-!,fail. 1162is_code_module(pfc_lib). 1163is_code_module(M):- clause_b(mtProlog(M)),!,fail. 1164is_code_module(M):- module_property(M,class(system)). 1165is_code_module(M):- module_property(M,class(library)). 1166is_code_module(baseKB):-!,fail. 1167is_code_module(Mt):- clause_b(mtHybrid(Mt)),!,fail. 1168is_code_module(M):- module_property(M,file(_)). 1169%call_u_mp(user, P1 ):- !, call_u_mp(baseKB,P1). 1170 1171 1172mpred_ain(MTP,S):- quietly_ex(is_ftVar(MTP)),!,trace_or_throw_ex(var_mpred_ain(MTP,S)). 1173mpred_ain(MTP,S):- mpred_ain_cm(MTP,P,AM,SM),mpred_ain_now4(SM,AM,P,S). 1174 1175 1176mpred_ain_now4(SM,ToMt,P,(mfl4(VarNameZ,FromMt,File,Lineno),UserWhy)):- sanity(stack_check),ToMt \== FromMt,!, 1177 mpred_ain_now4(SM,ToMt,P,(mfl4(VarNameZ,ToMt,File,Lineno),UserWhy)). 1178 1179mpred_ain_now4(SM0,AM0,PIn,S):- SM0==AM0, is_code_module(AM0),!, 1180 get_assert_to(AM),get_query_from(SM),!,mpred_ain_now4(SM,AM,PIn,S). 1181 1182mpred_ain_now4(SM,AM,PIn,S):- % module_sanity_check(SM), 1183 nop(module_sanity_check(AM)), 1184 call_from_module(AM, 1185 with_source_module(SM, 1186 locally_tl(current_defaultAssertMt(AM), SM:mpred_ain_now(PIn,S)))). 1187 1188mpred_ain_now(PIn,S):- 1189 PIn=P, % must_ex(add_eachRulePreconditional(PIn,P)), 1190 must_ex(full_transform(ain,P,P0)),!, % P=P0, 1191 must_ex(ain_fast(P0,S)),!, 1192 nop(ignore((P\=@=P0, mpred_db_type(P,fact(_)),show_failure(mpred_fwc(P))))). 1193 1194mpred_ain_now(P,S):- mpred_warn("mpred_ain(~p,~p) failed",[P,S]),!,fail. 1195 1196 1197ain_fast(P):- \+ t_l:is_repropagating(_),clause_asserted(P),!. 1198ain_fast(P):- call_u((( get_source_uu(UU), ain_fast(P,UU)))). 1199 1200ain_fast(P,S):- quietly_ex((maybe_updated_value(P,RP,OLD),subst(S,P,RP,RS))),!,ain_fast(RP,RS),ignore(mpred_retract_i(OLD)). 1201 1202% ain_fast(P,S):- loop_check_term(ain_fast0(P,S),ain_fast123(P),(trace,ain_fast0(P,S))). 1203 1204ain_fast(P,S):- 1205 %retractall(t_l:busy(_)), 1206 fwc1s_post1s(One,Two), 1207 filter_buffer_trim('$last_mpred_fwc1s',One), 1208 filter_buffer_trim('$last_mpred_post1s',Two), 1209 each_E(mpred_post1,P,[S]),!, 1210 mpred_run. 1211 1212:- abolish(lmconf:eachRule_Preconditional/1). 1213:- abolish(lmconf:eachFact_Preconditional/1). 1214:- dynamic(lmconf:eachRule_Preconditional/1). 1215:- dynamic(lmconf:eachFact_Preconditional/1). 1216lmconfeachRule_Preconditional(true). 1217lmconfeachFact_Preconditional(true). 1218 1219add_eachRulePreconditional(A,A):-var(A),!. 1220add_eachRulePreconditional(B::::A,B::::AA):-add_eachRulePreconditional(A,AA). 1221add_eachRulePreconditional(A==>B,AA==>B):-!,add_eachRulePreconditional_now(A,AA). 1222add_eachRulePreconditional(A<==>B, ('==>'(AA , B) , (BB ==> A)) ):-!,add_eachRulePreconditional_now(A,AA),add_eachRulePreconditional_now(B,BB). 1223add_eachRulePreconditional((B <- A), (B <- AA)) :-!,add_eachRulePreconditional_now(A,AA). 1224add_eachRulePreconditional(A,AA):-add_eachFactPreconditional_now(A,AA). 1225 1226add_eachFactPreconditional_now(A,A):- lmconf:eachFact_Preconditional(true),!. 1227add_eachFactPreconditional_now(A,(Was==>A)):- lmconf:eachFact_Preconditional(Was),!. 1228 1229add_eachRulePreconditional_now(A,A):- lmconf:eachRule_Preconditional(true),!. 1230add_eachRulePreconditional_now(A,(Was,A)):- lmconf:eachRule_Preconditional(Was),!. 1231 1232 1233 1234 1235remove_negative_version(_P):- current_prolog_flag(unsafe_speedups , true) ,!. 1236remove_negative_version((H:-B)):- !, 1237 % TODO extract_predciates((H:-B),Preds),trust(Preds), 1238 with_no_mpred_trace_exec(( 1239 once((get_why_uu(S),!, 1240 must_ex(mpred_ain(\+ (~(H) :- B), S)))))),!. 1241remove_negative_version(P) :- \+ mpred_non_neg_literal(P),!. 1242 1243remove_negative_version(P):- 1244 % TODO extract_predciates(P,Preds),trust(Preds), 1245 with_no_mpred_trace_exec(( 1246 once((get_why_uu(S),!, 1247 must_ex(mpred_ain(\+ (~(P)), S)))))),!. 1248 1249%fwc1s_post1s(0,0):-!. 1250fwc1s_post1s(1,1):-!. 1251%fwc1s_post1s(1,2):-!. 1252/* 1253fwc1s_post1s(3,0):-!. 1254fwc1s_post1s(3,0):-!. 1255%fwc1s_post1s(1,2):- flag_call(unsafe_speedups == false) ,!. 1256 1257fwc1s_post1s(1,3):- fresh_mode,!. 1258fwc1s_post1s(1,2):- current_prolog_flag(pfc_booted,true),!. 1259% fwc1s_post1s(10,20):- defaultAssertMt(Mt)->Mt==baseKB,!. 1260fwc1s_post1s(1,2). 1261*/ 1262 1263fresh_mode :- \+ current_prolog_flag(pfc_booted,true), \+ flag_call(unsafe_speedups == false) . 1264plus_fwc :- \+ fresh_mode. 1265 1266plus_fwc(P):- is_ftVar(P),!,trace_or_throw_ex(var_plus_fwc(P)). 1267plus_fwc(support_hilog(_,_)):-!. 1268plus_fwc('==>'(_,_)):-!. 1269plus_fwc(P):- gripe_time(0.6, 1270 (plus_fwc 1271 -> 1272 loop_check_term(must_ex(mpred_fwc(P)),plus_fwc(P),true);true)),!. 1273 1274 1275maybe_updated_value(UP,R,OLD):- % \+ current_prolog_flag(unsafe_speedups , true) , 1276 compound(UP), 1277 get_assertion_head_unnegated(UP,P),!, 1278 compound(P), 1279 once((arg(N,P,UPDATE),is_relative(UPDATE))), 1280 must_ex(flag_call(unsafe_speedups == false) ), 1281 replace_arg(P,N,Q_SLOT,Q), 1282 must_ex(call_u(Q)), update_value(Q_SLOT,UPDATE,NEW), must_ex( \+ is_relative(NEW)), 1283 replace_arg(Q,N,NEW,R),!,R\=@=UP,subst(UP,P,Q,OLD). 1284 1285 1286 1287implicitly_true(Var):- is_ftVar(Var),!,fail. 1288implicitly_true(true). 1289implicitly_true(end_of_file). 1290implicitly_true(props(_,L)):- L ==[]. 1291 1292abby_normal_ERR(Var):- is_ftVar(Var),!. 1293abby_normal_ERR( isa(_,_,_), _). 1294abby_normal_ERR( tCol(COMMA), _):- COMMA==','. 1295abby_normal_ERR( tCol(VAR), _):- var(VAR). 1296abby_normal_ERR( P, _):- \+ \+ P = props(_,[]).
1303mpred_post(P, S):- full_transform(post,P,P0),each_E(mpred_post1,P0,[S]). 1304 1305mpred_post( P):- get_why_uu(UU), mpred_post( P, UU). 1306mpred_post1( P):- get_why_uu(UU), mpred_post1( P, UU).
1315mpred_post1(P, S) :- show_success(abby_normal_ERR(P,S)),break_ex,!,fail. 1316mpred_post1(P, S):- each_E(mpred_post2,P,[S]). 1317 1318 1319mpred_post2( P, S):- quietly_ex(( sanity(nonvar(P)),fixed_negations(P,P0),P\=@=P0)),!, mpred_post2( P0, S). 1320 1321mpred_post2(Fact, _):- quietly_ex(((true;current_prolog_flag(unsafe_speedups , true)) , ground(Fact), 1322 \+ t_l:is_repropagating(_), 1323 fwc1s_post1s(One,_Two),Three is One * 1, 1324 filter_buffer_n_test('$last_mpred_post1s',Three,Fact))),!. 1325 1326%mpred_post2(P,S):- gripe_time(0.6,loop_check_early(mpred_post12(P,S),true)). 1327mpred_post2(P,S):- gripe_time(16,(mpred_post12(P,S),true)). 1328 1329 1330mpred_post_exactly(P):- current_why(S),mpred_enqueue(P,S). 1331mpred_remove_exactly(P):- remove_if_unsupported(P). 1332 1333:- module_transparent(mpred_post_exactly/1). 1334:- module_transparent(mpred_post1/2). 1335:- module_transparent(mpred_post12/2). 1336:- export(mpred_post12/2). 1337 1338leave_some_vars_at_el(action_rules). 1339leave_some_vars_at_el(agent_text_command). 1340leave_some_vars_at_el(rtArgsVerbatum). 1341leave_some_vars_at_el(==>). 1342 1343is_ftOpen(A):- member(A,['$VAR'('????????????'),'$VAR'(_)]). 1344 1345is_ftOpenSentence(P):- compound(P), safe_functor(P,F,N), \+ leave_some_vars_at_el(F), 1346 (arg(N,P,A);(N\==1,arg(1,P,A))),is_ftOpen(A). 1347is_ftOpenSentence(P):- is_ftOpen(P). 1348 1349 1350mpred_post12_withdraw( P, S):- show_call(mpred_withdraw(P,S)), \+ mpred_supported(P),!. 1351%mpred_post12_withdraw( P, S):- is_user_reason(S), show_call(mpred_withdraw(P)), \+ mpred_supported(P),!. 1352%mpred_post12_withdraw( P, S):- is_user_reason(S),!, (mpred_withdraw_fail_if_supported(P,S) -> true ; show_call(mpred_remove2(P,S))). 1353mpred_post12_withdraw( P, S):- ignore(show_call(mpred_withdraw_fail_if_supported(P,S))),!. 1354 1355mpred_post12_negated( P, S):- mpred_withdraw_fail_if_supported(P,S), mpred_post13(~P,S),!. 1356mpred_post12_negated( P, S):- mpred_remove2(P,S), show_call( \+ mpred_supported(P)),!, show_call((nop(2), mpred_post13(~P,S))),!. 1357mpred_post12_negated( P, S) :- mpred_get_support(P,S2), 1358 color_line(magenta,2), 1359 dmsg_pretty((mpred_post12( ~ P, S) :- mpred_get_support(P,S2))), 1360 color_line(magenta,1),color_line(green,1),color_line(yellow,1), 1361 color_line(magenta,1),color_line(green,1),color_line(yellow,1), 1362 color_line(magenta,1),color_line(green,1),color_line(yellow,1), 1363 mpred_trace_op(blast,P), 1364 mpred_why_1(P), 1365 must(mpred_unfwc(P)), 1366 must(mpred_post13(~P,S)),!. 1367 1368 1369 1370 1371mpred_post12(P, _):- must_be(nonvar,P),P==true,!. 1372% mpred_post12(P, S):- quietly_ex((is_ftOpenSentence(P)->wdmsg_pretty((warn((var_mpred_post1(P, S))))))),fail. 1373mpred_post12( \+ P, S):- mpred_post12_withdraw( P, S),!. 1374mpred_post12( ~ P, S):- mpred_post12_negated( P, S),!. 1375 1376/* 1377mpred_post12( \+ P, S):- (must_be(nonvar,P)), !,doall( must_ex(mpred_post1_rem(P,S))). 1378 1379% TODO - FIGURE OUT WHY THIS IS NEEDED - WELL THINKING AOBUT IT AND UIT SEEMS WRONG 1380mpred_post12( ~ P, S):- fail, (must_be(nonvar,P)), sanity((ignore(show_failure(\+ is_ftOpenSentence(P))))), 1381 quietly_ex(( \+ mpred_unique_u(P))), 1382 with_current_why(S,with_no_breaks((nonvar(P),doall(mpred_remove(P,S)),must_ex(mpred_undo(P))))),fail. 1383*/ 1384 1385mpred_post12(P,S):- quietly_ex((maybe_updated_value(P,RP,OLD))),!,subst(S,P,RP,RS),mpred_post13(RP,RS),ignore(mpred_retract_i(OLD)). 1386 1387% TODO MAYBE 1388mpred_post12(actn(P),S):- !, 1389 with_current_why(S,call(P)), mpred_post13(actn(P),S). 1390 1391mpred_post12(P,S):- mpred_post13(P,S). 1392 1393% Two versions exists of this function one expects for a clean database (fresh_mode) and adds new information. 1394% tries to assert a fact or set of fact to the database. 1395% The other version is if the program is been running before loading this module. 1396% 1397mpred_post13_unused(P,S):- fail, 1398 fresh_mode,!, 1399 % db mpred_ain_db_to_head(P,P2), 1400 % mpred_remove_old_version(P), 1401 \+ \+ mpred_add_support(P,S), 1402 ( (\+ mpred_unique_u(P)) -> true ; 1403 ( assert_u_confirm_if_missing(P), 1404 !, 1405 mpred_trace_op(add,P,S), 1406 !, 1407 mpred_enqueue(P,S), 1408 !)), 1409 plus_fwc(P),!. 1410 1411 1412% this would be the very inital by Tim Finnin... 1413mpred_post13_unused(P,S):- fail, fresh_mode, 1414 ignore(( % db mpred_ain_db_to_head(P,P2), 1415 % mpred_remove_old_version(P), 1416 mpred_add_support(P,S), 1417 mpred_unique_u(P), 1418 assert_u_confirm_if_missing(P), 1419 mpred_trace_op(add,P,S), 1420 !, 1421 mpred_enqueue(P,S))), 1422 !. 1423 1424 1425/* 1426% Expects a clean database and adds new information. 1427mpred_post13_unused(P,S):- fail,!, 1428 % db mpred_ain_db_to_head(P,P2), 1429 % mpred_remove_old_version(P), 1430 must_ex( \+ \+ mpred_add_support(P,S)), 1431 ( \+ mpred_unique_u(P) 1432 -> clause_asserted_u(P) 1433 ; ( assert_u_confirmed_was_missing(P), 1434 !, 1435 mpred_trace_op(add,P,S), 1436 !, 1437 mpred_enqueue(P,S), 1438 !)). 1439*/ 1440 1441/* 1442mpred_post13((H:-B),S):- 1443 with_current_why(S, 1444 show_call(mpred_do_hb_catchup_now_maybe(H,B))), 1445 fail. 1446*/ 1447 1448% this for complete repropagation 1449mpred_post13(P,S):- t_l:is_repropagating(_),!, 1450 ignore(( % db mpred_ain_db_to_head(P,P2), 1451 % mpred_remove_old_version(P), 1452 mpred_add_support(P,S), 1453 (mpred_unique_u(P)-> 1454 assert_u_confirmed_was_missing(P); 1455 assert_u_confirm_if_missing(P)), 1456 mpred_trace_op(add,P,S), 1457 !, 1458 mpred_enqueue(P,S))), 1459 !. 1460 1461/* 1462mpred_post13(P,S):- true, !, 1463 ignore(( % db mpred_ain_db_to_head(P,P2), 1464 % mpred_remove_old_version(P), 1465 mpred_add_support(P,S), 1466 (mpred_unique_u(P)-> 1467 assert_u_confirmed_was_missing(P); 1468 assert_u_confirm_if_missing(P)), 1469 mpred_trace_op(add,P,S), 1470 !, 1471 mpred_enqueue(P,S))), 1472 !. 1473*/ 1474 1475 1476% Expects a *UN*clean database and adds new information. 1477% (running the program is been running before loading this module) 1478% 1479% (gets the status in Support and in Database) 1480mpred_post13(P,S):- !, 1481 % set_varname_list([]),!, 1482 copy_term_vn((P,S),(PP,SS)), 1483 % checks to see if we have forward chain the knowledge yet or 1484 gripe_time(0.1, must_ex(get_mpred_support_status(P,S,PP,SS,Was))),!, 1485 mpred_post123(P,S,PP,Was). 1486 1487 1488:- thread_local(t_l:exact_assertions/0). 1489 1490with_exact_assertions(Goal):- 1491 locally_tl(exact_assertions,Goal). 1492 1493 1494% The cyclic_break is when we have regressions arouind ~ ~ ~ ~ ~ 1495 1496get_mpred_support_status(_P,_S, PP,(F,T),Was):- 1497 t_l:exact_assertions,!, 1498 (clause_asserted_u(spft(PP,F,T)) -> Was = exact ; Was = none). 1499 1500get_mpred_support_status(_P,_S, PP,(F,T),Was):- 1501 % t_l:exact_assertions, 1502 !, 1503 (clause_asserted_u(spft(PP,F,T)) -> Was = exact ; Was = none). 1504 1505get_mpred_support_status(P,_S, PP,(FF,TT),Was):- 1506 Simular=simular(none), 1507 copy_term(PP,PPP), 1508 ((((lookup_spft(PPP,F,T),variant_u(P,PP))) *-> 1509 ((variant_u(TT,T),same_file_facts0(F,FF)) -> (Was = exact , ! ) ; 1510 (nb_setarg(1,Simular,(F,T)),!,fail)) 1511 ; Was = none) -> true ; ignore(Was=Simular)),!. 1512 1513% mpred_post123(_P,_S,_PP,exact):- current_prolog_flag(pfc_cheats,true), !. 1514 1515mpred_post123(P,S,PP,Was):- 1516 % cyclic_break((P,S,PP,Was)), 1517 % if we''ve asserted what we''ve compiled 1518 gripe_time(0.22, must_ex(get_mpred_assertion_status(P,PP,AStatus))),!, 1519 gripe_time(0.44, must_ex(mpred_post_update4(AStatus,P,S,Was))),!. 1520 1521get_mpred_assertion_status(P,_PP,Was):- 1522 (t_l:exact_assertions ; mpred_db_type(P,rule(_))),!, 1523 quietly(((clause_asserted_u(P)-> Was=identical; Was= unique))). 1524 1525get_mpred_assertion_status(P,PP,Was):- 1526 quietly(((clause_asserted_u(P)-> Was=identical; 1527 ( 1528 (((locally(set_prolog_flag(occurs_check,true),clause_u(PP)),cyclic_break((PPP)))-> (Was= partial(PPP));Was= unique)))))). 1529 1530 1531same_file_facts(S1,S2):-reduce_to_mfl(S1,MFL1),reduce_to_mfl(S2,MFL2),!,same_file_facts0(MFL1,MFL2). 1532same_file_facts0(mfl4(VarNameZ,M,F,_),mfl4(VarNameZ,M,FF,_)):-nonvar(M),!, FF=@=F. 1533same_file_facts0(F,FF):- FF=@=F,!. 1534 1535reduce_to_mfl(MFL,MFL):- MFL=mfl4(_VarNameZ,_,_,_),!. 1536reduce_to_mfl((MFL,_),MFLO):- !,reduce_to_mfl(MFL,MFLO).
1542mpred_post_update4(Was,P,S,What):- 1543 not_not_ignore_quietly_ex(( (get_mpred_is_tracing(P);get_mpred_is_tracing(S)), 1544 fix_mp(change(assert,post),P,M,PP), 1545 must_ex(S=(F,T)),wdmsg_pretty(call_mpred_post4:- (Was,post1=M:PP,fact=F,trig=T,What)))), 1546 fail. 1547 1548mpred_post_update4(identical,_P,_S,exact):-!. 1549mpred_post_update4(unique,P,S,none):- !, 1550 must_det(mpred_add_support_fast(P,S)), 1551 must_det(assert_u_confirmed_was_missing(P)), 1552 must_det(mpred_trace_op(add,P,S)), 1553 must_ex(mpred_enqueue(P,S)),!. 1554 1555mpred_post_update4(Identical,P,S,Exact):- !, 1556 ((Exact\==exact ->mpred_add_support_fast(P,S);true), 1557 (Identical==identical-> true ; 1558 (assert_u_confirmed_was_missing(P),mpred_trace_op(add,P,S),mpred_enqueue(P,S)))),!. 1559 1560mpred_post_update4(identical,P,S,none):-!,mpred_add_support_fast(P,S), 1561 mpred_enqueue(P,S). 1562 1563mpred_post_update4(identical,P,S,simular(_)):- !,mpred_add_support_fast(P,S). 1564 1565/* 1566mpred_post_update4(Was,P,S,What):- 1567 not_not_ignore_quietly_ex(( \+ (get_mpred_is_tracing(P);get_mpred_is_tracing(S)), 1568 fix_mp(change(assert,post),P,M,PP), 1569 must_ex(S=(F,T)),wdmsg_pretty(mpred_post_update4:- (Was,post1=M:PP,fact=F,trig=T,What)))), 1570 fail. 1571*/ 1572 1573mpred_post_update4(partial(_Other),P,S,none):-!, 1574 mpred_add_support_fast(P,S), 1575 assert_u_confirmed_was_missing(P), 1576 mpred_trace_op(add,P,S), 1577 mpred_enqueue(P,S). 1578 1579mpred_post_update4(partial(_Other),P,S,exact):-!, 1580 assert_u_confirmed_was_missing(P), 1581 mpred_trace_op(add,P,S), 1582 mpred_enqueue(P,S). 1583 1584mpred_post_update4(unique,P,S,exact):-!, 1585 assert_u_confirmed_was_missing(P), 1586 mpred_trace_op(add,P,S). 1587 1588 1589mpred_post_update4(partial(_),P,S,exact):- !, 1590 assert_u_confirmed_was_missing(P), 1591 mpred_trace_op(add,P,S). 1592 1593 1594mpred_post_update4(partial(_),P,S,simular(_)):- !, 1595 mpred_add_support_fast(P,S), 1596 ignore((mpred_unique_u(P),assert_u_confirmed_was_missing(P),mpred_trace_op(add,P,S))), 1597 mpred_enqueue(P,S). 1598 1599mpred_post_update4(unique,P,S,simular(_)):-!, 1600 mpred_add_support_fast(P,S), 1601 assert_u_confirmed_was_missing(P), 1602 mpred_trace_op(add,P,S), 1603 mpred_enqueue(P,S). 1604 1605 1606mpred_post_update4(Was,P,S,What):-dmsg_pretty(mpred_post_update4(Was,P,S,What)),dtrace,fail. 1607 1608mpred_post_update4(Was,P,S,What):-!,trace_or_throw_ex(mpred_post_update4(Was,P,S,What)). 1609 1610/* 1611assert_u_confirmed_was_missing(P):- once((get_unnegated_functor(P,F,_),get_functor(P,FF,_))), 1612 F==FF, 1613 call_u(prologSingleValued(F)),!, 1614 \+ \+ must_ex((db_assert_sv(P))), 1615 \+ \+ sanity((clause_asserted_u(P))),!. 1616*/ 1617 1618% assert_u_confirmed_was_missing(P):- mpred_enqueue(onChange(P),'was_missing'), fail. 1619 1620% assert_u_confirmed_was_missing(P):- term_attvars(P,L),L\==[],!, \+ \+ must_ex(assert_to_mu(P)),!. 1621 1622assert_u_confirmed_was_missing(P):- 1623 \+ \+ must_ex(assert_to_mu(P)),!, 1624 nop((sanity((( (\+ clause_asserted_u(P)) -> (rtrace(assert_to_mu(P)),break) ; true))))),!. 1625 1626assert_u_confirmed_was_missing(P):- 1627 copy_term_vn(P,PP), 1628 must_ex(assert_u_no_dep(P)),!,dtrace, 1629(nonvar(PP) -> true ; must_ex((P=@=PP,clause_asserted_u(PP),P=@=PP))),!. 1630 1631assert_to_mu(P):- 1632 (t_l:assert_to(Where) -> 1633 (Where = a -> asserta_mu(P); assertz_mu(P)); 1634 assert_mu(P)). 1635 1636assert_u_confirm_if_missing(P):- 1637 must_ex(clause_asserted_u(P)-> true ; assert_u_confirmed_was_missing(P)).
(was nothing)
1645get_mpred_current_db(Db):-lookup_u(mpred_current_db(Db)),!. 1646get_mpred_current_db(true).
1653mpred_ain_db_to_head(P,NewP):-
1654 lookup_u(mpred_current_db(Db)),
1655 (Db=true -> NewP = P;
1656 P=(Head:-Body) -> NewP = (Head:- (Db,Body));
1657 otherwise -> NewP = (P:- Db)).1664mpred_unique_u(P):- t_l:exact_assertions,!, \+ clause_asserted_u(P). 1665%mpred_unique_u((Head:-Tail)):- !, \+ clause_u(Head,Tail). 1666%mpred_unique_u(P):- !, \+ clause_u(P,true). 1667mpred_unique_u(P):- \+ clause_asserted_u(P).
1675%get_fc_mode(_P,_S,direct):-!. 1676get_fc_mode(P,_S,Mode):- get_unnegated_mfa(P,M,F,A),mpred_prop(M,F,A,Mode),is_fwc_mode(Mode),!. 1677get_fc_mode(mpred_prop(_,_,_,_),_S,direct). 1678get_fc_mode(P,_S,direct):- compound(P),functor(P,_,1). 1679get_fc_mode(_P,_S,Mode):- get_fc_mode(Mode). 1680 1681get_fc_mode(Mode):- t_l:mpred_fc_mode(Mode),!. 1682get_fc_mode(Mode):- lookup_m(pm(Mode)),!. 1683get_fc_mode(Mode):- !, Mode=direct. 1684 1685 1686:- thread_local(t_l:mpred_fc_mode/1).
1692with_fc_mode(Mode,Goal):- locally_tl(mpred_fc_mode(Mode),((Goal))). 1693 1694set_fc_mode(Mode):- asserta(t_l:mpred_fc_mode(Mode)).
1701mpred_enqueue(P):- mpred_enqueue(P,_S). 1702 1703mpred_enqueue(P,_):- show_mpred_success(que,lookup_m(que(P,_))),!. 1704%mpred_enqueue(P,_):- nb_current('$current_why',wp(_,P)),!,trace_or_throw_ex(why(P)). 1705%mpred_enqueue(P,_):- t_l:busy(P),!,nop(dmsg_pretty(t_l:busy(P))). 1706%mpred_enqueue(P,S):- locally_each(t_l:busy(P),mpred_enqueue2(P,S)). 1707mpred_enqueue(P,S):- 1708 (var(S)->current_why(S);true), 1709 (must_ex(get_fc_mode(P,S,Mode)) 1710 -> mpred_enqueue_w_mode(S,Mode,P) 1711 ; mpred_error("No pm mode")). 1712 1713mpred_enqueue_w_mode(S,Mode,P):- 1714 (Mode=direct -> mpred_enqueue_direct(S,P) ; 1715 Mode=thread -> mpred_enqueue_thread(S,P) ; 1716 Mode=depth -> mpred_asserta_w_support(que(P,S),S) ; 1717 Mode=paused -> mpred_asserta_w_support(que(P,S),S) ; 1718 Mode=breadth -> mpred_assertz_w_support(que(P,S),S) ; 1719 Mode=next -> mpred_asserta_w_support(que(P,S),S) ; 1720 Mode=last -> mpred_assertz_w_support(que(P,S),S) ; 1721 true -> mpred_error("Unrecognized pm mode: ~p", Mode)). 1722 1723is_fwc_mode(direct). 1724is_fwc_mode(thread). 1725is_fwc_mode(depth). 1726is_fwc_mode(paused). 1727is_fwc_mode(breadth). 1728is_fwc_mode(next). 1729is_fwc_mode(last). 1730 1731 1732get_support_module(mfl4(_,Module,_,_), Module). 1733get_support_module((S1,S2),Module):- !, (get_support_module(S1,Module);get_support_module(S2,Module)). 1734get_support_module((S2:S1),Module):- !, (get_support_module(S1,Module);get_support_module(S2,Module)). 1735 1736of_queue_module(_, M:_, M):- atom(M), !. 1737of_queue_module(S, _, Module):- get_support_module(S, Module), !. 1738of_queue_module(_, _, Module):- get_query_from(Module), !. 1739 1740mpred_enqueue_direct(S,P):- 1741 of_queue_module(S,P,Module), 1742 loop_check_term(Module:mpred_fwc(P),mpred_enqueueing(P),true). 1743 1744/* 1745mpred_enqueue_thread(S,P):- 1746 with_only_current_why(S, 1747 call_in_thread( 1748 with_fc_mode(direct, % maybe keep `thread` mode? 1749 loop_check_term(mpred_fwc(P),mpred_enqueueing(P),true)))). 1750 1751*/ 1752 1753mpred_enqueue_thread(S,P):- 1754 with_only_current_why(S, 1755 call_in_thread(fwc_wlc(P))). 1756 1757fwc_wlc(P):- in_fc_call(loop_check_term(mpred_fwc(P),mpred_enqueueing(P),true)). 1758 1759% maybe keep `thread` mode? 1760% in_fc_call(Goal):- with_fc_mode( thread, Goal). 1761in_fc_call(Goal):- with_fc_mode( direct, Goal). 1762% in_fc_call(Goal):- !, call(Goal).
1768mpred_remove_old_version((Identifier::::Body)):- 1769 % this should never happen. 1770 var(Identifier), 1771 !, 1772 mpred_warn("variable used as an rule name in ~p :::: ~p", 1773 [Identifier,Body]). 1774 1775 1776mpred_remove_old_version((Identifier::::Body)):- 1777 nonvar(Identifier), 1778 clause_u((Identifier::::OldBody),_), 1779 \+(Body=OldBody), 1780 mpred_withdraw((Identifier::::OldBody)), 1781 !. 1782mpred_remove_old_version(_). 1783 1784 1785 1786% mpred_run compute the deductive closure of the current database. 1787% How this is done depends on the propagation mode: 1788% direct - mpred_fwc has already done the job. 1789% depth or breadth - use the queue mechanism. 1790 1791mpred_run :- get_fc_mode(Mode)->Mode=paused,!. 1792% mpred_run :- repeat, \+ mpred_step, !. 1793mpred_run:- 1794 mpred_step, 1795 mpred_run. 1796mpred_run:- retractall(t_l:busy(_)). 1797 1798 1799% mpred_step removes one entry from the queue and reasons from it. 1800 1801:-thread_local(t_l:busy/1). 1802:-thread_local(t_l:busy_s/1). 1803 1804mpred_step:- 1805 % if hs/1 is true, reset it and fail, thereby stopping inferencing. (hs=halt_signal) 1806 quietly_ex((lookup_m(hs(Was)))), 1807 mpred_retract_i(hs(Was)), 1808 mpred_trace_msg('Stopping on: ~p',[hs(Was)]), 1809 !, 1810 fail. 1811 1812mpred_step:- 1813 % draw immediate conclusions from the next fact to be considered. 1814 % fails iff the queue is empty. 1815 get_next_fact(P), 1816 %asserta(t_l:busy(P)), 1817 ignore(mpred_fwc(P)), 1818 % ignore(retract(t_l:local_current_why(_,P))), 1819 %retractall(t_l:busy(P)), 1820 !. 1821 1822get_next_fact(P):- 1823 %identifies the nect fact to mpred_fwc from and removes it from the queue. 1824 select_next_fact(P), 1825 remove_selection(P). 1826 1827remove_selection(P):- 1828 lookup_u(que(P,_),Ref), 1829 erase(Ref), 1830 % must_ex(mpred_retract_i(que(P,_))), 1831 mpred_remove_supports_quietly(que(P,_)), 1832 !. 1833remove_selection(P):- 1834 brake(format("~Nmpred_:get_next_fact - selected fact not on Queue: ~p", 1835 [P])). 1836 1837 1838% select_next_fact(P) identifies the next fact to reason from. 1839% It tries the user defined predicate first and, failing that, 1840% the default mechanism. 1841:- dynamic(baseKB:mpred_select_hook/1). 1842select_next_fact(P):- 1843 lookup_u(baseKB:mpred_select_hook(P)), 1844 !. 1845select_next_fact(P):- 1846 defaultmpred_select(P), 1847 !. 1848 1849% the default selection predicate takes the item at the froint of the queue. 1850defaultmpred_select(P):- lookup_m(que(P,_)),!. 1851 1852% mpred_halt stops the forward chaining. 1853mpred_halt:- mpred_halt(anonymous(mpred_halt)). 1854 1855mpred_halt(Format,Args):- format_to_message(Format,Args,Info), mpred_halt(Info). 1856 1857mpred_halt(Now):- 1858 mpred_trace_msg("New halt signal ",[Now]), 1859 (lookup_m(hs(Was)) -> 1860 mpred_warn("mpred_halt finds halt signal already set to: ~p ",[Was]) 1861 ; assert_u_no_dep(hs(Now))). 1862 1863 1864% stop_trace(Info):- quietly_ex((tracing,leash(+all),dtrace(dmsg_pretty(Info)))),!,rtrace. 1865stop_trace(Info):- dtrace(dmsg_pretty(Info)).
1871mpred_ain_trigger_reprop(PT,Support):- PT = pt(Trigger,Body), !, 1872 mpred_trace_msg('~N~n\tAdding positive~n\t\ttrigger: ~p~n\t\tbody: ~p~n\t Support: ~p~n',[Trigger,Body,Support]),!, 1873 sanity(\+ string(Support)),sanity(\+ string(Trigger)),sanity(\+ string(Body)), 1874 must(mpred_mark_as(Support,Trigger,pfcPosTrigger)), 1875 must((( 1876 % (debugging(logicmoo(_))->dtrace;true), 1877 1878 mpred_assert_w_support(PT,Support), 1879 copy_term(PT,Tcopy),!, 1880 forall(call_u_no_bc(Trigger), 1881 forall(mpred_eval_lhs(Body,(Trigger,Tcopy)),true))))),!. 1882 1883 1884 1885mpred_ain_trigger_reprop(nt(Trigger,Test,Body),Support):- NT = nt(TriggerCopy,Test,Body),!, 1886 copy_term_vn(Trigger,TriggerCopy), 1887 mpred_mark_as(Support,Trigger,pfcNegTrigger), 1888 mpred_trace_msg('~N~n\tAdding negative~n\t\ttrigger: ~p~n\t\ttest: ~p~n\t\tbody: ~p~n\t Support: ~p~n',[Trigger,Test,Body,Support]), 1889 mpred_assert_w_support(NT,Support), 1890 %stop_trace(mpred_assert_w_support(NT,Support)), 1891 !, 1892 ignore((\+ call_u_no_bc(Test), 1893 mpred_eval_lhs(Body,((\+Trigger),NT)))). 1894 1895mpred_ain_trigger_reprop(BT,Support):- BT = bt(Trigger,Body),!, 1896 1897 % UNEEDED Due to a trigger that creates it? 1898 % get_bc_clause(Trigger,Post),mpred_post1(Post), 1899 mpred_mark_as(Support,Trigger,pfcBcTrigger), 1900 % UNEEDED Due to a trigger that does it? 1901 % if_defined(kb_shared(Trigger),true), 1902 mpred_trace_msg('~N~n\tAdding backwards~n\t\ttrigger: ~p~n\t\tbody: ~p~n\t Support: ~p~n',[Trigger,Body,Support]), 1903 mpred_assert_w_support(BT,Support), 1904 !, 1905 mpred_bt_pt_combine(Trigger,Body,Support). 1906 1907mpred_ain_trigger_reprop(X,Support):- 1908 mpred_warn("Unrecognized trigger to mpred_ain_trigger_reprop: ~p\n~~p~n",[X,Support]). 1909 1910 1911mpred_bt_pt_combine(Head,Body,Support):- 1912 % a backward trigger (bt) was just added with head and Body and support Support 1913 % find any pt''s with unifying heads and add the instantied bt body. 1914 lookup_u(pt(Head,Body)), 1915 mpred_eval_lhs(Body,Support), 1916 fail. 1917mpred_bt_pt_combine(_,_,_):- !. 1918 1919 1920 1921% 1922% predicates for manipulating action traces. 1923% (Undoes side-effects) 1924% 1925 1926mpred_ain_actiontrace(Action,Support):- 1927 % adds an action trace and it''s support. 1928 mpred_add_support(actn(Action),Support). 1929 1930mpred_undo_action(actn(Did)):- 1931 (clause_asserted_u(do_and_undo(Did,Undo))->true;lookup_u(do_and_undo(Did,Undo))), 1932 call_u_no_bc(Undo), 1933 !.
1936mpred_prolog_retractall(X):- 1937 get_assertion_head_unnegated(X,P), 1938 mpred_prolog_retract(P),fail. 1939mpred_prolog_retractall(_).
1942mpred_prolog_retract(X):-
1943 % retract an arbitrary thing.
1944 mpred_db_type(X,Type),!,
1945 mpred_retract_type(Type,X).1954mpred_retract_i(X):- 1955 % retract an arbitrary thing. 1956 mpred_db_type(X,Type),!, 1957 mpred_retract_type(Type,X), 1958 !. 1959 1960mpred_retract_type(fact(_FT),X):- 1961 % db mpred_ain_db_to_head(X,X2), retract_u(X2). 1962 % stop_trace(mpred_retract_type(fact(FT),X)), 1963 (retract_u(X) 1964 *-> mpred_unfwc(X) ; (mpred_unfwc(X),!,fail)). 1965 1966mpred_retract_type(rule(_RT),X):- 1967 % db mpred_ain_db_to_head(X,X2), retract_u(X2). 1968 (retract_u(X) 1969 *-> mpred_unfwc(X) ; (mpred_unfwc(X),!,fail)). 1970 1971mpred_retract_type(trigger(_TT),X):- 1972 retract_u(X) 1973 -> mpred_unfwc(X) 1974 ; mpred_warn("Trigger not found to retract_u: ~p",[X]). 1975 1976mpred_retract_type(action,X):- mpred_undo_action(X).
1983mpred_ain_object(X):- 1984 % what type of P do we have? 1985 mpred_db_type(X,Type), 1986 % call the appropriate predicate. 1987 mpred_ain_by_type(Type,X). 1988 1989mpred_ain_by_type(fact(_FT),X):- 1990 mpred_unique_u(X), 1991 assert_u_confirmed_was_missing(X),!. 1992mpred_ain_by_type(rule(_RT),X):- 1993 mpred_unique_u(X), 1994 assert_u_confirmed_was_missing(X),!. 1995mpred_ain_by_type(trigger(_TT),X):- 1996 assert_u_confirmed_was_missing(X). 1997mpred_ain_by_type(action,_ZAction):- !.
2005mpred_withdraw(P):- mpred_reduced_chain(mpred_withdraw,P),!. 2006 2007mpred_withdraw(mfl4(_VarNameZ,_,_,_)):-!. 2008mpred_withdraw(P) :- 2009 only_is_user_reason(UU), 2010 % iterate down the list of facts to be mpred_withdraw''ed. 2011 (is_list(P)-> 2012 mpred_withdraw_list(P,UU); 2013 % mpred_withdraw/1 is the user's interface - it withdraws user support for P. 2014 mpred_withdraw(P,UU)). 2015 2016 2017mpred_withdraw_list(P) :- 2018 only_is_user_reason(UU), 2019 mpred_withdraw_list(P,UU). 2020 2021mpred_withdraw_list([H|T],UU) :- 2022 % mpred_withdraw each element in the list. 2023 mpred_withdraw(H,UU), 2024 mpred_withdraw_list(T,UU). 2025 2026maybe_user_support(P,S,SS):- 2027 (mpred_get_support(P,S) -> 2028 (frozen(S,Goals), 2029 (Goals == true -> SS=S ; SS = freeze(S,Goals))); SS = unKnown_suppoRt). 2030 2031mpred_withdraw(P,S) :- 2032 maybe_user_support(P,S,SS), 2033 (SS \== unKnown_suppoRt -> 2034 % pfcDebug(format("~Nremoving support ~p from ~p",[SS,P])), 2035 (mpred_trace_msg('\n Removing support: ~p~n',[SS]), 2036 mpred_trace_msg(' Which was for: ~p~n',[P])); 2037 nop(dmsg_pretty(mpred_withdraw(P,S)))), 2038 ignore(mpred_withdraw_fail_if_supported(P,S)). 2039 2040mpred_withdraw_fail_if_supported(mfl4(_VarNameZ,_,_,_),_):-!. 2041mpred_withdraw_fail_if_supported(P,S):- 2042 maybe_user_support(P,S,SS), 2043 (((lookup_spft(P,F,T), S= (F,T), mpred_rem_support(P,S), nop(dmsg_pretty(found(mpred_rem_support1(P,S))))) 2044 -> (remove_if_unsupported(P),retractall(t_l:busy(_))) 2045 ; ((mpred_withdraw_fail_if_supported_maybe_warn(SS,P), 2046 \+ show_still_supported(P))))). 2047 2048mpred_withdraw_fail_if_supported_maybe_warn(_,P):- P== singleValuedInArg(arity, 2). 2049mpred_withdraw_fail_if_supported_maybe_warn(_,P):- P= prologSingleValued(_Arity). 2050% mpred_withdraw_fail_if_supported_maybe_warn(_,~P):- nonvar(P),!. 2051mpred_withdraw_fail_if_supported_maybe_warn(unKnown_suppoRt,P):- 2052 maybe_user_support(P,S,SS), 2053 (((lookup_spft(P,F,T), S= (F,T), call(mpred_rem_support(P,S)), 2054 nop(dmsg_pretty(found(mpred_rem_support2(P,S))))) 2055 -> (remove_if_unsupported(P),retractall(t_l:busy(_))) 2056 ; (( nop(mpred_withdraw_fail_if_supported_maybe_warn(SS,P)), 2057 \+ show_still_supported(P))))). 2058mpred_withdraw_fail_if_supported_maybe_warn(S,P):- 2059 mpred_get_support(P,S),SS=S, 2060 (((lookup_spft(P,F,T), S= (F,T), mpred_rem_support(P,S),dmsg_pretty(found(mpred_rem_support3(P,S)))) 2061 -> (remove_if_unsupported(P),retractall(t_l:busy(_))) 2062 ; (( nop(mpred_withdraw_fail_if_supported_maybe_warn(SS,P)), 2063 \+ show_still_supported(P))))). 2064mpred_withdraw_fail_if_supported_maybe_warn(SS,P):- 2065 mpred_trace_msg("mpred_withdraw/2 Could not find support ~p to remove (fact): ~p",[SS,P]). 2066 2067show_still_supported(P):- ((mpred_supported(P),mpred_trace_msg('~p',[still_supported(P)]))).
2077mpred_remove(P):- mpred_withdraw(P), (mpred_supported(P) -> mpred_blast(P); true). 2078 2079mpred_remove2(P):- mpred_reduced_chain(mpred_remove2,P),!. 2080 2081mpred_remove2(P) :- only_is_user_reason(UU), 2082 % mpred_remove2/1 is the user's interface - it withdraws user support for P. 2083 mpred_remove2(P,UU). 2084 2085mpred_remove2(P,S) :- 2086 mpred_withdraw(P,S), 2087 (call_u(P) 2088 -> ( mpred_blast(P) ) 2089 ; true). 2090 2091mpred_retract_is_complete(mfl4(_VarNameZ,_,_,_)):-!. 2092mpred_retract_is_complete(P) :- \+ mpred_supported(local,P), \+ call_u(P). 2093 2094mpred_retract(P):- mpred_withdraw(P), mpred_retract_is_complete(P),!,mpred_trace_msg(' Withdrew: ~p',[P]). 2095mpred_retract(P):- mpred_retract_preconds(P), mpred_retract_is_complete(P),!,mpred_trace_msg(' Retracted: ~p~n',[P]). 2096mpred_retract(P):- listing(P),mpred_why_1(P),show_call(mpred_blast(P)),mpred_retract_is_complete(P),!,mpred_trace_msg(' Blasted: ~p~n',[P]). 2097mpred_retract(P):- ok_left_over(P),mpred_trace_msg(' Still True (ok_left_over): ~p~n',[P]),!,ignore((with_no_retry_undefined((mpred_why_1(P),listing(P))))). 2098mpred_retract(P):- listing(P),mpred_why_1(P),!,with_no_retry_undefined(P),mpred_warn(' Still True: ~p~n',[P]), 2099 log_failure_red,sleep(2),!,ok_left_over(P). 2100 2101 2102ok_left_over(P):- strip_module(P,M,H),ok_left_over(M,H). 2103ok_left_over(_,arity(_,_)). 2104 2105mpred_retract_preconds(P):- mpred_retract_1preconds(P). 2106 2107mpred_retract_1preconds(P):- 2108 supporters_list0(P,WhyS), 2109 member(S,WhyS), 2110 mpred_db_type(S,fact(_)), 2111 mpred_children(S,Childs), 2112 Childs=[C],C=@=P, 2113 mpred_trace_msg(' Removing support1: ~p~n',[S]), 2114 mpred_trace_msg(' Which was for: ~p~n',[P]), 2115 show_call(mpred_retract(S)). 2116 2117mpred_retract_1preconds(P):- 2118 supporters_list0(P,WhyS), 2119 member(S,WhyS), 2120 mpred_db_type(S,fact(_)), 2121 mpred_children(S,Childs), 2122 mpred_trace_msg(' Removing support2: ~p~n',[S]), 2123 mpred_trace_msg(' Childs: ~p~n',[Childs]), 2124 show_call(mpred_retract(S)). 2125 2126 2127 2128mpred_retract1(P):- 2129 supporters_list0(P,WhyS), 2130 must_maplist(mpred_retract_if_fact,WhyS). 2131 2132 2133mpred_retract_if_fact(P):- mpred_db_type(P,fact(_)),!, mpred_retract1(P). 2134mpred_retract_if_fact(_). 2135 2136% 2137% mpred_blast(+F) retracts fact F from the DB and removes any dependent facts 2138% 2139 2140mpred_blast(F) :- 2141 mpred_remove_supports_whine(F), 2142 mpred_undo(F). 2143 2144mpred_retract_all(P):- 2145 repeat, \+ mpred_retract(P). 2146 2147% removes any remaining supports for fact F, complaining as it goes. 2148 2149mpred_remove_supports_whine(P) :- 2150 lookup_spft(P,F,S), 2151 mpred_trace_msg("~p was still supported by ~p",[F,S]), 2152 % mpred_retract_i_or_warn(spft(P,F,S)). 2153 fail. 2154mpred_remove_supports_whine(_). 2155 2156mpred_remove_supports_quietly(F) :- 2157 mpred_rem_support(F,_), 2158 fail. 2159mpred_remove_supports_quietly(_).
2169mpred_undo(P):- mpred_reduced_chain(mpred_undo,P),!. 2170mpred_undo(X):- mpred_undo1(X),!. 2171 2172 2173% maybe still un-forward chain? 2174mpred_undo_unfwd(Fact):- 2175 % undo a random fact, printing out the dtrace, if relevant. 2176 (mpred_unfwc(Fact) *-> mpred_trace_msg(mpred_unfwc(Fact));mpred_trace_msg( \+ mpred_unfwc(Fact))). 2177% mpred_undo(X):- doall(mpred_undo1(X)). 2178 2179mpred_undo1((H:-B)):- reduce_clause(unpost,(H:-B),HB), HB\=@= (H:-B),!,mpred_undo1((HB)). 2180mpred_undo1(actn(A)):- 2181 % undo an action by finding a method and successfully executing it. 2182 !, 2183 show_call(mpred_undo_action(actn(A))). 2184 2185mpred_undo1(pt(Key,Head,Body)):- 2186 % undo a positive trigger 3. 2187 % 2188 !, 2189 (show_mpred_success(mpred_undo1_pt_unfwc_3,retract_u(pt(Key,Head,Body))) 2190 -> mpred_unfwc(pt(Head,Body)) 2191 ; mpred_warn("Trigger not found to undo: ~p",[pt(Head,Body)])). 2192 2193mpred_undo1(pt(Head,Body)):- 2194 % undo a positive trigger. 2195 % 2196 !, 2197 (show_mpred_success(mpred_undo1_pt_unfwc_2,retract_u(pt(Head,Body))) 2198 -> mpred_unfwc(pt(Head,Body)) 2199 ; mpred_warn("Trigger not found to undo: ~p",[pt(Head,Body)])). 2200 2201mpred_undo1(nt(Head,Condition,Body)):- 2202 % undo a negative trigger. 2203 !, 2204 ( 2205 show_mpred_success(mpred_undo1_nt_unfwc,(nt(Head,Condition,Body), 2206 dmsg_pretty(mpred_undo1(nt(Head,Condition,Body))),retract_u(nt(Head,Condition,Body)))) 2207 -> (mpred_unfwc(nt(Head,Condition,Body))->true;show_call(assert_u(nt(Head,Condition,Body)))) 2208 ; mpred_trace_msg("WARNING?? Trigger not found to undo: ~p",[nt(Head,Condition,Body)])). 2209 2210mpred_undo1(P):- mpred_reduced_chain(mpred_undo1,P),!. 2211 2212mpred_undo1(Fact):- 2213 % undo a random fact, printing out the dtrace, if relevant. 2214 (retract_u(Fact)*->true; mpred_trace_msg(show_failure(mpred_undo1,retract_u(Fact)))), 2215 mpred_trace_op(rem,Fact), 2216 mpred_unfwc(Fact).
2228mpred_unfwc(P):- mpred_reduced_chain(mpred_unfwc,P),!. 2229mpred_unfwc(F):- 2230 show_failure(mpred_retract_supported_relations(F)), 2231 mpred_unfwc1(F). 2232 2233mpred_unfwc1(F):- 2234 mpred_unfwc_check_triggers(F), 2235 % is this really the right place for mpred_run<? 2236 mpred_run,!. 2237 2238 2239mpred_unfwc_check_triggers(F):- 2240 loop_check(mpred_unfwc_check_triggers0(F), 2241 (mpred_warn(looped_mpred_unfwc_check_triggers0(F)), mpred_run)). 2242 2243mpred_unfwc_check_triggers0(F):- 2244 mpred_db_type(F,_), 2245 doall(( copy_term_vn(F,Fcopy), 2246 lookup_u(nt(Fcopy,Condition,Action)), 2247 \+ call_u_no_bc(Condition), 2248 mpred_eval_lhs(Action,((\+F),nt(F,Condition,Action))))), 2249 !. 2250 2251 2252mpred_unfwc_check_triggers0(F):- 2253 mpred_db_type(F,FT), 2254 dmsg_pretty(unknown_rule_type(mpred_db_type(F,FT))),!. 2255 2256 2257 2258mpred_retract_supported_relations(Fact):- 2259 mpred_db_type(Fact,Type),Type=trigger(_), 2260 mpred_rem_support_if_exists(P,(_,Fact)), 2261 must_ex(nonvar(P)), 2262 remove_if_unsupported(P), 2263 fail. 2264 2265mpred_retract_supported_relations(Fact):- 2266 mpred_rem_support_if_exists(P,(Fact,_)), 2267 must_ex(nonvar(P)), 2268 remove_if_unsupported(P), 2269 fail. 2270 2271mpred_retract_supported_relations(_). 2272 2273 2274 2275% remove_if_unsupported(+Ps) checks to see if all Ps are supported and removes 2276% it from the DB if they are not. 2277remove_if_unsupported(P):- 2278 loop_check(remove_if_unsupported0(P),true). 2279remove_if_unsupported0(P):- \+ mpred_supported(P),!,doall((mpred_undo(P))). 2280remove_if_unsupported0(P):- \+ is_single_valued(P),!,mpred_trace_msg('~p',[still_supported(P)]). 2281remove_if_unsupported0(P):- mpred_trace_msg('~p',[sv_still_supported(P)]), doall((mpred_undo(P))). 2282 2283is_single_valued(P):- get_unnegated_functor(P,F,_)->call_u(prologSingleValued(F)).
2291mpred_fwc(Ps):- each_E(mpred_fwc0,Ps,[]). 2292:- module_transparent((mpred_fwc0)/1).
mpred_fwc1(P)
this line filters sequential (and secondary) dupes
2299 % mpred_fwc0(genls(_,_)):-!. 2300mpred_fwc0(Fact):- fail, quietly_ex(ground(Fact)), 2301 \+ t_l:is_repropagating(_), 2302 quietly_ex((once(((fwc1s_post1s(_One,Two),Six is Two * 1))))), 2303 show_mpred_success(filter_buffer_n_test,(filter_buffer_n_test('$last_mpred_fwc1s',Six,Fact))),!. 2304mpred_fwc0(Fact):- quietly_ex(copy_term_vn(Fact,FactC)), 2305 loop_check(mpred_fwc1(FactC),true). 2306 2307 2308filter_buffer_trim(Name,N):- quietly_ex(( 2309 filter_buffer_get_n(Name,List,N), 2310 nb_setval(Name,List))). 2311 2312filter_buffer_get_n(Name,FactS,N):- 2313 nb_current(Name,Fact1s), 2314 length(Fact1s,PFs),!, 2315 ((PFs =< N) 2316 -> FactS=Fact1s; 2317 (length(FactS,N),append(FactS,_,Fact1s))). 2318filter_buffer_get_n(_,[],_). 2319 2320 2321% filter_buffer_n_test(_Name,_,_Fact):- \+ need_speed, !,fail. 2322filter_buffer_n_test(Name,N,Fact):- filter_buffer_get_n(Name,FactS,N), 2323 (memberchk(Fact,FactS)-> true ; (nb_setval(Name,[Fact|FactS]),fail)). 2324 2325:- meta_predicate(mpred_reduced_chain(,)). 2326:- meta_predicate(mpred_reduced_chain(,)). 2327mpred_reduced_chain(P1,(Fact:- (FWC, BODY))):- FWC==fwc,!,call(P1,{BODY}==>Fact). 2328mpred_reduced_chain(P1,(Fact:- (BWC, BODY))):- BWC==bwc,!,call(P1,(Fact<-BODY)). 2329mpred_reduced_chain(P1,(P:-AB)):- compound(AB),AB=attr_bind(L,R),!,must_ex(attr_bind(L)),call(P1,(P:-R)). 2330mpred_reduced_chain(P1,(P:-True)):- True==true,call(P1,P). 2331 2332mpred_reduced_chain(P1,==>(Fact),P1):- sanity(nonvar(Fact)),!, 2333 must_ex(full_transform(mpred_fwc1,==>(Fact),ExpandFact)),!, 2334 mpred_trace_msg((expanding_mpred_chain(P1,Fact) ==> ExpandFact)), 2335 sanity(ExpandFact\== (==>(Fact))), 2336 each_E(P1,ExpandFact,[]).
mpred_fwc1(P)2343mpred_fwc1(clause_asserted_u(Fact)):-!,sanity(clause_asserted_u(Fact)). 2344mpred_fwc1(P):- mpred_reduced_chain(mpred_fwc1,P),!. 2345mpred_fwc1(support_hilog(_,_)):-!. 2346mpred_fwc1(mpred_unload_option(_,_)):-!. 2347 2348% mpred_fwc1(singleValuedInArg(_, _)):-!. 2349% this line filters sequential (and secondary) dupes 2350% mpred_fwc1(Fact):- current_prolog_flag(unsafe_speedups , true) , ground(Fact),fwc1s_post1s(_One,Two),Six is Two * 3,filter_buffer_n_test('$last_mpred_fwc1s',Six,Fact),!. 2351mpred_fwc1(Prop):-'$current_source_module'(Sm),mpred_m_fwc1(Sm,Prop). 2352 2353 2354:-thread_local(t_l:busy_f/1). 2355:-thread_local(t_l:busy_s/1). 2356 2357mpred_m_fwc1(Sm,Prop):- fixed_syntax(Prop,After),!,must(Prop\=@=After),mpred_m_fwc1(Sm,After). 2358mpred_m_fwc1(Sm,Prop):- clause_asserted(t_l:busy_s(Prop)),dmsg_pretty(Sm:warn(busy_mpred_m_fwc1(Prop))),!. 2359mpred_m_fwc1(Sm,Prop):- clause_asserted(t_l:busy_f(Prop)),dmsg_pretty(Sm:warn(busy_mpred_m_fwc1_f(Prop))),!. 2360mpred_m_fwc1(Sm,Prop):- % clause_asserted(t_l:busy_f(Prop)),!, 2361 setup_call_cleanup( 2362 asserta(t_l:busy_s(Prop),R), 2363 ignore(mpred_m_fwc2(Sm,Prop)), 2364 ignore(catch(erase(R),_,fail))). 2365% mpred_m_fwc1(Sm,Prop):- mpred_m_fwc2(Sm,Prop). 2366 2367mpred_m_fwc2(Sm,Prop):- 2368 mpred_trace_msg(Sm:mpred_fwc1(Prop)), 2369 %ignore((mpred_non_neg_literal(Prop),remove_negative_version(Prop))), 2370 \+ \+ ignore(mpred_do_rule(Prop)), 2371 setup_call_cleanup( 2372 asserta(t_l:busy_f(Prop),R), 2373 ignore(mpred_do_fact(Prop)), 2374 ignore(catch(erase(R),_,fail))).
2382mpred_do_rule((P==>Q)):- 2383 !, 2384 process_rule(P,Q,(P==>Q)). 2385mpred_do_rule((Name::::P==>Q)):- 2386 !, 2387 process_rule(P,Q,(Name::::P==>Q)). 2388mpred_do_rule((P<==>Q)):- 2389 !, 2390 process_rule(P,Q,(P<==>Q)), 2391 process_rule(Q,P,(P<==>Q)). 2392mpred_do_rule((Name::::P<==>Q)):- 2393 !, 2394 process_rule(P,Q,((Name::::P<==>Q))), 2395 process_rule(Q,P,((Name::::P<==>Q))). 2396 2397mpred_do_rule(('<-'(P,Q))):- 2398 !, 2399 mpred_define_bc_rule(P,Q,('<-'(P,Q))). 2400 2401mpred_do_rule(('<=='(P,Q))):- 2402 !, 2403 mpred_define_bc_rule(P,Q,('<-'(P,Q))). 2404 2405mpred_do_rule((H:-B)):- fail, 2406 !, 2407 mpred_do_hb_catchup(H,B). 2408 2409 2410is_head_LHS(H):- nonvar(H),get_functor(H,F,A),must_ex(suggest_m(M)),lookup_u(mpred_prop(M,F,A,pfcLHS)). 2411body_clause(SK,Cont):-nonvar(SK),SK=Cont. 2412 2413mpred_do_hb_catchup(H, _B):- \+ is_head_LHS(H),!. 2414mpred_do_hb_catchup(_H, B):- \+ \+ (B=true),!. 2415mpred_do_hb_catchup(_H, B):- compound(B), \+ \+ reserved_body_helper(B),!. 2416 2417% prolog_clause mpred_do_rule VAR_H 2418mpred_do_hb_catchup(H,B):- sanity(nonvar(B)), 2419 var(H),!,dmsg_pretty(warn(is_VAR_H((H:-B)))), 2420 trace, % THe body needs to sanify (bind) the Head 2421 forall(call_u(B), 2422 (sanity(nonvar(H)),mpred_ain(H))),!. 2423 2424mpred_do_hb_catchup(H,Body):- is_head_LHS(H), 2425 body_clause(Body,attr_bind(AG,B)), 2426% Should we repropagate(H) ? 2427 attr_bind(AG),!, 2428 mpred_do_hb_catchup_now(H,B). 2429 2430 2431% prolog_clause mpred_do_rule pfcLHS 2432mpred_do_hb_catchup(H,B):- %is_head_LHS(H), 2433% Should we repropagate(H) if body failed? 2434 mpred_do_hb_catchup_now(H,B). 2435 2436% mpred_do_hb_catchup(H,B):- !,mpred_do_hb_catchup_now(H,B). 2437 2438% mpred_do_hb_catchup_now_maybe(_,_):-!. 2439mpred_do_hb_catchup_now_maybe(H,B):- B\=(cwc,_), 2440 mpred_do_hb_catchup_now(H,B). 2441 2442% mpred_do_hb_catchup_now(_,_):-!. 2443mpred_do_hb_catchup_now(H,B):- B\=(cwc,_),nonvar(B), 2444 with_exact_assertions(catch( (forall(call_u(B),mpred_fwc(H));true),_,true)),!. 2445 2446 2447% prolog_clause mpred_do_clause COMMENTED 2448% mpred_do_clause(Fact,H,B):- nonvar(H),mpred_do_fact({clause(H,B)}),fail. 2449 2450% prolog_clause mpred_do_clause (_ :- _) 2451 2452mpred_do_clause(H,B):- 2453 with_exact_assertions(mpred_do_clause0(H,B)). 2454 2455mpred_do_clause0(Var, B):- is_ftVar(Var),!,trace_or_throw(var_mpred_do_clause0(Var, B)). 2456mpred_do_clause0((=>(_,_)),_):-!. 2457mpred_do_clause0((==>(_,_)),_):-!. 2458mpred_do_clause0(H,B):- 2459 % Fact = {clause(H,B)}, 2460 Fact = (H :- B), B\=(cwc,_),!, 2461 copy_term(Fact,Copy), 2462 % check positive triggers 2463 loop_check(mpred_do_fcpt(Copy,Fact),true), % dmsg_pretty(trace_or_throw_ex(mpred_do_clause(Copy)))), 2464 % check negative triggers 2465 mpred_do_fcnt(Copy,Fact), 2466 mpred_do_hb_catchup(H,B). 2467 2468:- dynamic(baseKB:todo_later/1). 2469is_cutted(Cutted):- contains_var(!,Cutted). 2470do_later(mpred_do_clause(_,Cutted)):- is_cutted(Cutted),!. 2471do_later(mpred_do_clause(~_H,_B)):- !. 2472do_later(G):- assertz(baseKB:todo_later(G)),nop(dmsg(do_later(G))). 2473 2474% prolog_clause mpred_do_fact (_ :- _) 2475mpred_do_fact(Fact):- 2476 Fact = (_:-_), 2477 copy_term_vn(Fact,(H:-B)), 2478 B\=(cwc,_),!, 2479 do_later(mpred_do_clause(H,B)),!. 2480 2481mpred_do_fact(Fact):- 2482 copy_term_vn(Fact,Copy), 2483 % check positive triggers 2484 loop_check(mpred_do_fcpt(Copy,Fact),true), % dmsg_pretty(trace_or_throw_ex(mpred_do_rule(Copy)))), 2485 % check negative triggers 2486 mpred_do_fcnt(Copy,Fact), 2487 nop(mpred_do_clause(Fact,true)). 2488 2489 2490get_tms_mode(_P,Mode):- lookup_m(tms(ModeO)),!,ModeO=Mode. 2491get_tms_mode(_P,Mode):- Mode=local. 2492 2493 2494% do all positive triggers 2495mpred_do_fcpt(mpred_prop(swish_help, index_json, 2, kb_shared),_):- dumpST, break. 2496mpred_do_fcpt(Copy,Trigger):- 2497 forall((call_u(pt(Trigger,Body)), 2498 mpred_trace_msg('~N~n\tFound positive trigger: ~p~n\t\tbody: ~p~n', 2499 [Trigger,Body])), 2500 forall(mpred_eval_lhs_no_nc(Body,(Copy,pt(Trigger,Body))), 2501 true)),!. 2502 2503%mpred_do_fcpt(Trigger,F):- 2504% lookup_u(pt(presently(F),Body)), 2505% mpred_e val_lhs(Body,(presently(Fact),pt(presently(F),Body))), 2506% fail. 2507% mpred_do_fcpt(_,_). 2508 2509% do all negative triggers 2510mpred_do_fcnt(_ZFact,Trigger):- 2511 NT = nt(Trigger,Condition,Body), 2512 (call_u(NT)*-> lookup_spft(X,F1,NT) ; lookup_spft(X,F1,NT)), 2513 %clause(SPFT,true), 2514 mpred_trace_msg('~N~n\tFound negative trigger: ~p~n\t\tcond: ~p~n\t\tbody: ~p~n\tSupport: ~p~n', 2515 [Trigger,Condition,Body,spft(X,F1,NT)]), 2516 call_u_no_bc(Condition), 2517 mpred_withdraw(X,(F2,NT)), 2518 sanity(F1=F2), 2519 fail. 2520mpred_do_fcnt(_,_).
2528mpred_define_bc_rule(Head,_ZBody,Parent_rule):- 2529 (\+ mpred_literal_nonvar(Head)), 2530 mpred_warn("Malformed backward chaining rule. ~p not atomic.",[Head]), 2531 mpred_error("caused by rule: ~p",[Parent_rule]), 2532 !, 2533 fail. 2534 2535mpred_define_bc_rule(Head,Body,Parent_rule):- 2536 must_notrace_pfc(get_source_mfl(U)),!, 2537 copy_term(Parent_rule,Parent_ruleCopy), 2538 build_rhs(U,Head,Rhs), 2539 % kb_local(Head), 2540 % UNEEDED Due to a trigger that creates it? 2541 % get_bc_clause(Head,Post),ain(Post), 2542 foreach(mpred_nf(Body,Lhs), 2543 ignore((build_trigger(Parent_ruleCopy,Lhs,rhs(Rhs),Trigger), 2544 ain_fast(bt(Head,Trigger),(Parent_ruleCopy,U))))). 2545 2546get_bc_clause(Head,(HeadC:- BodyC)):- get_bc_clause(Head,HeadC,BodyC). 2547 2548get_bc_clause(HeadIn, ~HeadC, Body):- compound(HeadIn), HeadIn = ~Head,!, 2549 Body = ( awc, 2550 ( nonvar(HeadC)-> (HeadC = Head,!) ; (HeadC = Head)), 2551 mpred_bc_and_with_pfc(~Head)). 2552get_bc_clause(Head, Head, Body):- % % :- is_ftNonvar(Head). 2553 Body = ( awc, !, mpred_bc_and_with_pfc(Head)). 2554 2555:- thread_initialization(nb_setval('$pfc_current_choice',[])). 2556 2557push_current_choice:- current_prolog_flag(pfc_support_cut,false),!. 2558push_current_choice:- prolog_current_choice(CP),push_current_choice(CP),!. 2559push_current_choice(CP):- nb_current('$pfc_current_choice',Was)->b_setval('$pfc_current_choice',[CP|Was]);b_setval('$pfc_current_choice',[CP]). 2560 2561cut_c:- current_prolog_flag(pfc_support_cut,false),!. 2562cut_c:- must_ex(nb_current('$pfc_current_choice',[CP|_WAS])),prolog_cut_to(CP).
2570mpred_eval_lhs(X,S):- 2571 push_current_choice, 2572 Loop = _, 2573 with_current_why(S, 2574 loop_check(mpred_eval_lhs_0(X,S),Loop=true)), 2575 (nonvar(Loop)-> (fail,dumpST,break) ; true). 2576 2577mpred_eval_lhs_no_nc(X,S):- mpred_eval_lhs_0(X,S).
2584mpred_eval_lhs_0(rhs(X),Support):- !, mpred_eval_rhs(X,Support). 2585mpred_eval_lhs_0(X,Support):- mpred_eval_lhs_1(X,Support).
2592mpred_eval_lhs_1(Var,Support):- var(Var),!,trace_or_throw_ex(var_mpred_eval_lhs_0(Var,Support)). 2593mpred_eval_lhs_1((Test *-> Body),Support):- % Noncutted *-> 2594 !, 2595 (call_u_no_bc(Test) *-> mpred_eval_lhs_0(Body,Support)). 2596 2597mpred_eval_lhs_1((Test -> Body),Support):- !, % cutted -> 2598 call_u_no_bc(Test) -> mpred_eval_lhs_0(Body,Support). 2599 2600 2601%mpred_eval_lhs_1(snip(X),Support):- 2602% snip(Support), 2603% mpred_eval_lhs_1(X,Support). 2604 2605mpred_eval_lhs_1(X,Support):- mpred_db_type(X,trigger(_TT)),!,must(mpred_ain_trigger_reprop(X,Support)),!. 2606 2607mpred_eval_lhs_1(X,_):- mpred_warn("Unrecognized item found in trigger body, namely ~p.",[X]). 2608 2609 2610args_swapped(~P1,~P2):-!,args_swapped(P1,P2). 2611args_swapped(P1,P2):- P1 univ_safe [F,Y,X], P2 univ_safe [F,X,Y]. 2612fxy_args_swapped(F,X,Y,P1,P2):- P1 univ_safe [F,X,Y], P2 univ_safe [F,Y,X].
2619mpred_eval_rhs([],_):- !. 2620mpred_eval_rhs([Head|Tail],Support):- 2621 mpred_eval_rhs1(Head,Support), 2622 mpred_eval_rhs(Tail,Support). 2623 2624mpred_eval_rhs1(Action,Support):- is_ftVar(Action),throw(mpred_eval_rhs1(Action,Support)). 2625mpred_eval_rhs1([X|Xrest],Support):- 2626 % embedded sublist. 2627 !, 2628 mpred_eval_rhs([X|Xrest],Support). 2629 2630mpred_eval_rhs1({Action},Support):- 2631 % evaluable Prolog code. 2632 !, 2633 fc_eval_action(Action,Support). 2634 2635mpred_eval_rhs1( \+ ~P, _Support):- nonvar(P), !, 2636 %mpred_trace_msg('~N~n~n\t\tRHS-Withdrawing: ~p \n\tSupport: ~p~n',[~P,Support]), 2637 mpred_withdraw(~P). 2638 2639 2640% if negated litteral \+ P 2641mpred_eval_rhs1(\+ P,Support):- nonvar(P), 2642 % predicate to remove. 2643 \+ mpred_negated_literal( P), 2644 %TODO Shouldn''t we be mpred_withdrawing the Positive version? 2645 % perhaps we aready negated here dirrent nf1_* 2646 mpred_trace_msg('~N~n~n\t\tRHS-Withdrawing-Neg: ~p \n\tSupport: ~p~n',[P,Support]), 2647 !, 2648 mpred_withdraw(P). 2649 2650 2651% Dmiles replaced with this 2652mpred_eval_rhs1( P,Support):- 2653 % predicate to remove. 2654 P\= ~(_), 2655 mpred_unnegate( P , PN),!, 2656 %TODO Shouldn''t we be mpred_withdrawing the Positive version? (We are) 2657 % perhaps we aready negated here from mpred_nf1_negation?! 2658 mpred_trace_msg('~N~n~n\t\tNegation causes RHS-Withdrawing: ~p \n\tSupport: ~p~n',[P,Support]), 2659 !, 2660 mpred_withdraw(PN). 2661 2662 2663% if negated litteral \+ P 2664mpred_eval_rhs1( P,Support):- 2665 % predicate to remove. 2666 P \= ~(_), 2667 \+ \+ mpred_negated_literal( P), 2668 %TODO Shouldn''t we be mpred_withdrawing the Positive version? 2669 % perhaps we aready negated here dirrent nf1_* 2670 mpred_trace_msg('~N~n~n\t\tRHS-Withdrawing-mpred_negated_literal: ~p \n\tSupport: ~p~n',[P,Support]), 2671 !, 2672 mpred_withdraw(P). 2673 2674mpred_eval_rhs1(Assertion,Support):- !, 2675 % an assertion to be added. 2676 mpred_trace_msg('~N~n~n\tRHS-Post1: ~p \n\tSupport: ~p~n',[Assertion,Support]),!, 2677 (quietly(mpred_post(Assertion,Support)) *-> 2678 true; 2679 mpred_warn("\n\t\t\n\t\tMalformed rhs of a rule (mpred_post1 failed)\n\t\tPost1: ~p\n\t\tSupport=~p.",[Assertion,Support])). 2680 2681% mpred_eval_rhs1(X,_):- mpred_warn("Malformed rhs of a rule: ~p",[X]).
2689fc_eval_action(CALL,Support):- 2690 mpred_METACALL(fc_eval_action_rev(Support),CALL). 2691 2692fc_eval_action_rev(Support,Action):- 2693 (call_u_no_bc(Action)), 2694 (show_success(action_is_undoable(Action)) 2695 -> mpred_ain_actiontrace(Action,Support) 2696 ; true). 2697 2698/* 2699% 2700% 2701% 2702 2703trigger_trigger(Trigger,Body,_ZSupport):- 2704 trigger_trigger1(Trigger,Body). 2705trigger_trigger(_,_,_). 2706 2707 2708%trigger_trigger1(presently(Trigger),Body):- 2709% !, 2710% copy_term_vn(Trigger,TriggerCopy), 2711% call_u(Trigger), 2712% mpred_eval_lhs(Body,(presently(Trigger),pt(presently(TriggerCopy),Body))), 2713% fail. 2714 2715trigger_trigger1(Trigger,Body):- 2716 copy_term_vn(Trigger,TriggerCopy), 2717 call_u(Trigger), 2718 mpred_eval_lhs(Body,(Trigger,pt(TriggerCopy,Body))), 2719 fail. 2720*/ 2721 2722 2723call_m_g(To,_M,G):- To:call(G). 2724lookup_m_g(To,_M,G):- clause(To:,true).
call_u(P):- predicate_property(P,number_of_rules(N)),N=0,!,lookup_u(P).
2735% :- table(call_u/1). 2736 2737 2738 2739 2740call_u(functorDeclares(H)):- get_var_or_functor(H,F),!,clause_b(functorDeclares(F)). 2741call_u(singleValuedInArg(H,A)):- get_var_or_functor(H,F),!,clause_b(singleValuedInArg(F,A)). 2742call_u(singleValuedInArgAX(H,A,N)):- get_var_or_functor(H,F),!,clause_b(singleValuedInArgAX(F,A,N)). 2743call_u(ttRelationType(C)):- !, clause_b(ttRelationType(C)). 2744 2745% call_u(M:G):- !,module_sanity_check(M),call_u_mp(M,G). 2746 2747%call_u(G):- \+ current_prolog_flag(retry_undefined, kb_shared),!, 2748% strip_module(G,M,P), no_repeats(gripe_time(5.3,on_x_rtrace(call_u_mp(M,P)))). 2749%call_u(M:G):- !, M:call(G). 2750 2751% prolog_clause call_u ? 2752%call_u(G):- G \= (_:-_), !, quietly_ex(defaultAssertMt(M)),!,call_u_mp(M,G). 2753call_u(G):- strip_module(G,M,P), !, call_u_mp(M,P). 2754 2755get_var_or_functor(H,F):- compound(H)->get_functor(H,F);H=F. 2756 2757%call_u(G):- strip_module(G,M,P), no_repeats(gripe_time(5.3,on_x_rtrace(call_u_mp(M,P)))). 2758 2759 2760call_u_mp(pfc_lib, P1 ):- !, call_u_mp(query, P1 ). 2761% call_u_mp(pfc_lib, P1 ):- !, break_ex,'$current_source_module'(SM),SM\==pfc_lib,!, call_u_mp(SM,P1). 2762call_u_mp(query, P1 ):- !, must(get_query_from(SM)),sanity(pfc_lib\==SM),call_u_mp(SM,P1). 2763call_u_mp(assert, P1 ):- !, must(get_assert_to(SM)),call_u_mp(SM,P1). 2764call_u_mp(System, P1 ):- is_code_module(System),!, call_u_mp(query,P1). 2765call_u_mp(M,P):- var(P),!,call((clause_b(mtExact(M))->mpred_fact_mp(M,P);(defaultAssertMt(W),with_umt(W,mpred_fact_mp(W,P))))). 2766call_u_mp(_, M:P1):-!,call_u_mp(M,P1). 2767call_u_mp(M, (P1,P2)):-!,call_u_mp(M,P1),call_u_mp(M,P2). 2768call_u_mp(M, (P1*->P2;P3)):-!,(call_u_mp(M,P1)*->call_u_mp(M,P2);call_u_mp(M,P3)). 2769call_u_mp(M, (P1->P2;P3)):-!,(call_u_mp(M,P1)->call_u_mp(M,P2);call_u_mp(M,P3)). 2770call_u_mp(M, (P1->P2)):-!,(call_u_mp(M,P1)->call_u_mp(M,P2)). 2771call_u_mp(M, (P1*->P2)):-!,(call_u_mp(M,P1)*->call_u_mp(M,P2)). 2772call_u_mp(M, (P1;P2)):- !,(call_u_mp(M,P1);call_u_mp(M,P2)). 2773call_u_mp(M,( \+ P1)):-!, \+ call_u_mp(M,P1). 2774call_u_mp(M,must_ex(P1)):-!, must_ex( call_u_mp(M,P1)). 2775call_u_mp(M, 't'(P1)):-!, call_u_mp(M,P1). 2776call_u_mp(M,'{}'(P1)):-!, call_u_mp(M,P1). 2777call_u_mp(M,ttExpressionType(P)):-!,clause_b(M:ttExpressionType(P)). 2778call_u_mp(M,mtHybrid(P)):-!,clause_b(M:mtHybrid(P)). 2779%call_u_mp(_,is_string(P)):- !, logicmoo_util_bugger:is_string(P). 2780call_u_mp(M,call(O,P1)):- append_term(O,P1,P),!,call_u_mp(M,P). 2781call_u_mp(M,call(P1)):- !, call_u_mp(M,P1). 2782call_u_mp(M,call_u(P1)):- !, call_u_mp(M,P1). 2783% call_u_mp(MaseKB,call_u_no_bc(P)):- !, call_u_mp(MaseKB,P). 2784 2785 2786/* 2787call_u_mp(M,call_u(X)):- !, call_u_mp(M,X). 2788call_u_mp(M,clause(H,B,Ref)):-!,M:clause_u(H,B,Ref). 2789call_u_mp(M,clause(H,B)):-!,M:clause_u(H,B). 2790call_u_mp(M,clause(HB)):- expand_to_hb(HB,H,B),!, M:clause_u(H,B). 2791call_u_mp(M,asserta(X)):- !, M:mpred_aina(X). 2792call_u_mp(M,assertz(X)):- !, M:mpred_ainz(X). 2793call_u_mp(M,assert(X)):- !, M:mpred_ain(X). 2794call_u_mp(M,retract(X)):- !, M:mpred_prolog_retract(X). 2795call_u_mp(M,retractall(X)):- !, M:mpred_prolog_retractall(X). 2796*/ 2797 2798 2799% prolog_clause call_u 2800% call_u_mp(M, (H:-B)):- B=@=call(BA),!,B=call(BA),!, (M:clause_u(H,BA);M:clause_u(H,B)),sanity(\+ reserved_body(B)). 2801call_u_mp(M, (H:-B)):- !,call_u_mp(M,clause_u(H,B)),(\+ reserved_body(B)). 2802% call_u_mp(M, (H:-B)):- !,call_u_mp(M,clause_u(H,B)),sanity(\+ reserved_body(B)). 2803 2804% call_u_mp(M,P1):- predicate_property(M:P1,foreign),!,M:call(P1). 2805% call_u_mp(M,P1):- predicate_property(M:P1,static),!,M:call(P1). 2806 2807call_u_mp(M,P1):- !,M:call(P1). 2808 2809 2810%call_u_mp(M,P1):- predicate_property(M:P1,built_in),!, M:call(P1). 2811%call_u_mp(M,P1):- predicate_property(M:P1,dynamic),!, M:call(P1). 2812%call_u_mp(M,P1):- predicate_property(M:P1,defined),!, M:call(P1). 2813% NEVER GETS HERE 2814call_u_mp(M,P):- safe_functor(P,F,A), call_u_mp_fa(M,P,F,A). 2815 2816make_visible(R,M:F/A):- wdmsg_pretty(make_visible(R,M:F/A)),fail. 2817make_visible(_,_):- !. 2818make_visible(M,M:F/A):- quietly_ex(M:export(M:F/A)). 2819make_visible(R,M:F/A):- must_det_l((M:export(M:F/A),R:import(M:F/A),R:export(M:F/A))). 2820 2821make_visible(R,M,F,A):- wdmsg_pretty(make_visible(R,M,F,A)),fail. 2822make_visible(system,M,F,A):- trace_or_throw_ex(unexpected(make_visible(system,M,F,A))). 2823make_visible(user,M,F,A):- trace_or_throw_ex(unexpected(make_visible(user,M,F,A))). 2824make_visible(TM,M,F,A):- 2825 must_ex((TM:import(M:F/A),TM:export(TM:F/A))), 2826 must_ex((TM:module_transparent(M:F/A))). % in case this has clauses th 2827 2828reserved_body(B):-var(B),!,fail. 2829reserved_body(attr_bind(_)). 2830reserved_body(attr_bind(_,_)). 2831reserved_body(B):-reserved_body_helper(B). 2832 2833reserved_body_helper(B):- \+ compound(B),!,fail. 2834reserved_body_helper((ZAWC,_)):- atom(ZAWC),is_pfc_chained(ZAWC). 2835%reserved_body_helper(inherit_above(_,_)). 2836%reserved_body_helper(Body):- get_bc_clause(_Head,_Head2,BCBody),!,Body=BCBody. 2837%reserved_body_helper((_,Body)):-!,reserved_body_helper(Body). 2838 2839call_u_mp_fa(M,P,F,A):- !,loop_check(call_u_mp_lc(M,P,F,A)). 2840 2841call_u_mp_fa(_,P,F,_):- (F==t; ( \+ clause_b(prologBuiltin(F)), 2842 F \= isT,F \= isTT, \+ predicate_property(P,file(_)))),if_defined(t_ify0(P,TGaf),fail), if_defined(isT(TGaf),false). 2843call_u_mp_fa(M,P,F,A):- loop_check(call_u_mp_lc(M,P,F,A)). 2844 2845%call_u_mp_lc(pfc_lib,P,F,A):-!, call_u_mp_lc(baseKB,P,F,A). 2846%call_u_mp_lc(M,P,F,A):- current_predicate(M:F/A),!,throw(current_predicate(M:F/A)),catch(M:P,E,(wdmsg_pretty(call_u_mp(M,P)),wdmsg_pretty(E),dtrace)). 2847% call_u_mp_lc(baseKB,P,F,A):- kb_shared(F/A),dmsg_pretty(kb_shared(F/A)),!, call(P). 2848 2849call_u_mp_lc(M,P,_,_):- !, M:call_u_mp(M,P). 2850call_u_mp_lc(M,P,_,_):- !, M:call(P). 2851 2852/* 2853call_u_mp_lc(M,P,_,_):- predicate_property(M:P,file(_)),!,call(M:P). 2854call_u_mp_lc(M,P,_,_):- source_file(M:P,_),!,call(M:P). 2855call_u_mp_lc(R,P,F,A):- source_file(M:P,_),!,make_visible(R,M:F/A),call(R:P). 2856call_u_mp_lc(R,P,F,A):- find_module(R:P,M),dmsg_pretty(find_module(R:P,M)),make_visible(R,M:F/A),!,catch(R:call(P),E,(wdmsg_pretty(call_u_mp(R,M:P)),wdmsg_pretty(E),dtrace)). 2857%call_u_mp_lc(M,P):- \+ clause_b(mtHybrid(M)),!,clause_b(mtHybrid(MT)),call_u_mp(MT,P). 2858call_u_mp_lc(M,P,F,A):- wdmsg_pretty(dynamic(M:P)),must_det_l((dynamic(M:F/A),make_visible(user,M:F/A),multifile(M:F/A))),!,fail. 2859*/ 2860/* 2861Next 2862call_u_mp(_G,M,P):- var(P),!,call((baseKB:mtExact(M)->mpred_fact_mp(M,P);(defaultAssertMt(W),with_umt(W,mpred_fact_mp(W,P))))). 2863% call_u_mp(mtHybrid(P),_,mtHybrid(P)):-!,baseKB:mtHybrid(P). 2864call_u_mp((P),M,(P)):-!,catch(call(P),E,(wdmsg_pretty(M:call_u_mp(P)),wdmsg_pretty(E),dtrace)). 2865% call_u_mp(P,M,P):- !,catch(M:call(P),E,(wdmsg_pretty(M:call_u_mp(P)),wdmsg_pretty(E),dtrace)). 2866call_u_mp(_G,M,P):- call((baseKB:mtExact(M)->M:call(P);call(P))). 2867*/ 2868 2869mpred_BC_w_cache(W,P):- must_ex(mpred_BC_CACHE(W,P)),!,clause(P,true). 2870 2871mpred_BC_CACHE(M,P0):- ignore( \+ loop_check_early(mpred_BC_CACHE0(M,P0),trace_or_throw_ex(mpred_BC_CACHE(P0)))). 2872 2873mpred_BC_CACHE0(_,P00):- var(P00),!. 2874mpred_BC_CACHE0(M,must_ex(P00)):-!,mpred_BC_CACHE0(M,P00). 2875mpred_BC_CACHE0(_,P):- predicate_property(P,static),!. 2876% mpred_BC_CACHE0(_,P):- predicate_property(P,built_in),!. 2877mpred_BC_CACHE0(_, :-(_,_)):-!. 2878mpred_BC_CACHE0(_,bt(_,_)):-!. 2879mpred_BC_CACHE0(_,clause(_,_)):-!. 2880mpred_BC_CACHE0(_,spft(_,_,_)):-!. 2881mpred_BC_CACHE0(_,P):- 2882 ignore(( 2883 cyclic_break(P), 2884 % trigger any bc rules. 2885 lookup_u(bt(P,Trigger)), 2886 copy_term_vn(bt(P,Trigger),bt(CP,CTrigger)), 2887 must_ex(lookup_spft(bt(CP,_Trigger),F,T)), 2888 mpred_eval_lhs(CTrigger,(F,T)), 2889 fail)). 2890 2891 2892 2893% I''d like to remove this soon 2894%call_u_no_bc(P0):- strip_module(P0,M,P), sanity(stack_check),var(P),!, M:mpred_fact(P). 2895%call_u_no_bc(_:true):-!. 2896call_u_no_bc(P):- no_repeats(call_u(P)). 2897% call_u_no_bc(P):- !, call_u(P). 2898%call_u_no_bc(G):- !, call(G). 2899% call_u_no_bc(P):- no_repeats(loop_check(mpred_METACALL(call_u, P))). 2900 2901% mpred_call_no_bc0(P):- lookup_u(P). 2902% mpred_call_no_bc0(P):- defaultAssertMt(Mt), Mt:lookup_u(P). 2903% mpred_call_no_bc0((A,B)):-!, mpred_call_no_bc0(A),mpred_call_no_bc0(B). 2904%mpred_call_no_bc0(P):- defaultAssertMt(Mt),current_predicate(_,Mt:P),!,Mt:call(P). 2905%mpred_call_no_bc0(P):- defaultAssertMt(Mt),rtrace(Mt:call(P)). 2906% TODO .. mpred_call_no_bc0(P):- defaultAssertMt(Mt), clause_b(genlMt(Mt,SuperMt)), call_umt(SuperMt,P). 2907%mpred_call_no_bc0(P):- mpred_call_with_no_triggers(P). 2908% mpred_call_no_bc0(P):- nonvar(P),predicate_property(P,defined),!, P. 2909mpred_call_no_bc0(P):- current_prolog_flag(unsafe_speedups , true) ,!,call(P). 2910mpred_call_no_bc0(P):- loop_check(mpred_METACALL(ereq, P)). 2911 2912pred_check(A):- var(A),!. 2913% catch module prefix issues 2914pred_check(A):- nonvar(A),must_ex(atom(A)). 2915 2916%mpred_METACALL(How,P):- current_prolog_flag(unsafe_speedups , true) ,!,call(How,P). 2917mpred_METACALL(How,P):- mpred_METACALL(How, Cut, P), (var(Cut)->true;(Cut=cut(CutCall)->(!,);call_u_no_bc(Cut))). 2918 2919mpred_METACALL(How, Cut, Var):- var(Var),!,trace_or_throw_ex(var_mpred_METACALL_MI(How,Cut,Var)). 2920mpred_METACALL(How, Cut, (H:-B)):-!,mpred_METACALL(How, Cut, clause_asserted_call(H,B)). 2921% this is probably not advisable due to extreme inefficiency. 2922mpred_METACALL(_How,_Cut, Var):-is_ftVar(Var),!,mpred_call_with_no_triggers(Var). 2923mpred_METACALL(How, Cut, call_u_no_bc(G0)):- !,mpred_METACALL(How, Cut, (G0)). 2924mpred_METACALL(_How, Cut, mpred_METACALL(How2, G0)):- !,mpred_METACALL(How2, Cut, (G0)). 2925mpred_METACALL(How, Cut, mpred_METACALL(G0)):- !,mpred_METACALL(How, Cut, (G0)). 2926mpred_METACALL(_How, cut(true), !):- !. 2927 2928mpred_METACALL(How, Cut, (C1->C2;C3)):-!,(mpred_METACALL(How, Cut, C1)->mpred_METACALL(How, Cut, C2);mpred_METACALL(How, Cut, C3)). 2929mpred_METACALL(How, Cut, (C1*->C2;C3)):-!,(mpred_METACALL(How, Cut, C1)*->mpred_METACALL(How, Cut, C2);mpred_METACALL(How, Cut, C3)). 2930 2931mpred_METACALL(How, Cut, (C1->C2)):-!,(mpred_METACALL(How, Cut, C1)->mpred_METACALL(How, Cut, C2)). 2932mpred_METACALL(How, Cut, (C1*->C2)):-!,(mpred_METACALL(How, Cut, C1)*->mpred_METACALL(How, Cut, C2)). 2933mpred_METACALL(How, Cut, (C1,C2)):-!,mpred_METACALL(How, Cut, C1),mpred_METACALL(How, Cut, C2). 2934mpred_METACALL(How, Cut, (C1;C2)):-!,(mpred_METACALL(How, Cut, C1);mpred_METACALL(How, Cut, C2)). 2935% check for system predicates first 2936% mpred_METACALL(_How, _SCut, P):- predicate_property(P,built_in),!, call(P). 2937 2938 2939mpred_METACALL(How, Cut, M):- fixed_syntax(M,O),!,mpred_METACALL(How, Cut, O). 2940mpred_METACALL(How, Cut, U:X):-U==user,!,mpred_METACALL(How, Cut, X). 2941% mpred_METACALL(How, Cut, t(A,B)):-(atom(A)->true;(no_repeats(arity(A,1)),atom(A))),ABC univ_safe [A,B],mpred_METACALL(How, Cut, ABC). 2942% mpred_METACALL(How, Cut, isa(B,A)):-(atom(A)->true;(no_repeats(tCol(A)),atom(A))),ABC univ_safe [A,B],mpred_METACALL(How, Cut, ABC). 2943%mpred_METACALL(How, Cut, t(A,B)):-!,(atom(A)->true;(no_repeats(arity(A,1)),atom(A))),ABC univ_safe [A,B],mpred_METACALL(How, Cut, ABC). 2944mpred_METACALL(How, Cut, t(A,B,C)):-!,(atom(A)->true;(no_repeats(arity(A,2)),atom(A))),ABC univ_safe [A,B,C],mpred_METACALL(How, Cut, ABC). 2945mpred_METACALL(How, Cut, t(A,B,C,D)):-!,(atom(A)->true;(no_repeats(arity(A,3)),atom(A))),ABC univ_safe [A,B,C,D],mpred_METACALL(How, Cut, ABC). 2946mpred_METACALL(How, Cut, t(A,B,C,D,E)):-!,(atom(A)->true;(no_repeats(arity(A,4)),atom(A))),ABC univ_safe [A,B,C,D,E],mpred_METACALL(How, Cut, ABC). 2947mpred_METACALL(How, Cut, call(X)):- !, mpred_METACALL(How, Cut, X). 2948mpred_METACALL(How, Cut, call_u(X)):- !, mpred_METACALL(How, Cut, X). 2949mpred_METACALL(How, Cut, once(X)):- !, once(mpred_METACALL(How, Cut, X)). 2950mpred_METACALL(How, Cut, must_ex(X)):- !, must_ex(mpred_METACALL(How, Cut, X)). 2951mpred_METACALL(How, Cut, \+(X)):- !, \+ mpred_METACALL(How, Cut, X). 2952mpred_METACALL(How, Cut, not(X)):- !,\+ mpred_METACALL(How, Cut, X). 2953mpred_METACALL(_How, _Cut, clause(H,B,Ref)):-!,clause_u(H,B,Ref). 2954mpred_METACALL(_How, _Cut, clause(H,B)):-!,clause_u(H,B). 2955mpred_METACALL(_How, _Cut, clause(HB)):-expand_to_hb(HB,H,B),!,clause_u(H,B). 2956mpred_METACALL(_How, _Cut, asserta(X)):- !, aina(X). 2957mpred_METACALL(_How, _Cut, assertz(X)):- !, ainz(X). 2958mpred_METACALL(_How, _Cut, assert(X)):- !, mpred_ain(X). 2959mpred_METACALL(_How, _Cut, retract(X)):- !, mpred_prolog_retract(X). 2960mpred_METACALL(_How, _Cut, retractall(X)):- !, mpred_prolog_retractall(X). 2961% TODO: test removal 2962%mpred_METACALL(How, Cut, prologHybrid(H)):-get_functor(H,F),!,isa_asserted(F,prologHybrid). 2963% mpred_METACALL(How, Cut, HB):-quietly_ex((full_transform_warn_if_changed(mpred_METACALL,HB,HHBB))),!,mpred_METACALL(How, Cut, HHBB). 2964%mpred_METACALL(How, Cut, argIsa(mpred_isa,2,mpred_isa/2)):- trace_or_throw_ex(mpred_METACALL(How, Cut, argIsa(mpred_isa,2,mpred_isa/2))),!,fail. 2965% TODO: test removal 2966% mpred_METACALL(How, Cut, isa(H,B)):-!,isa_asserted(H,B). 2967mpred_METACALL(_How, _Cut, (H:-B)):- !, clause_u((H :- B)). 2968mpred_METACALL(_How, _Cut, M:(H:-B)):- !, clause_u((M:H :- B)). 2969 2970% TODO: mpred_METACALL(_How, _Cut, M:HB):- current_prolog_flag(unsafe_speedups , true) ,!, call(M:HB). 2971 2972%mpred_METACALL(_How, _SCut, P):- fail, predicate_property(P,built_in),!, call(P). 2973%mpred_METACALL(How, Cut, (H)):- is_static_pred(H),!,show_pred_info(H),dtrace(mpred_METACALL(How, Cut, (H))). 2974mpred_METACALL( How, Cut, P) :- fail, predicate_property(P,number_of_clauses(_)),!, 2975 clause_u(P,Condition), 2976 mpred_METACALL(How,Cut,Condition), 2977 (var(Cut)->true;(Cut=cut(CutCall)->(!,);call_u_no_bc(Cut))). 2978 2979% mpred_METACALL(_How,_SCut, P):- must_ex(current_predicate(_,M:P)),!, call_u(M:P). 2980%mpred_METACALL(How, Cut, H):- !, locally_tl(infAssertedOnly(H),call_u(H)). 2981mpred_METACALL(How, _SCut, P):- call(How,P).
2990action_is_undoable(G):- lookup_u(do_and_undo(G,_)). 2991action_is_undoable(G):- safe_functor(G,F,_),lookup_u(do_and_undo(F,Undo)),atom(Undo).
3002/* 3003mpred_nf({LHS},List):- !, 3004 mpred_nf((nondet,{LHS}),List). 3005*/ 3006 3007mpred_nf(LHS,List):- 3008 mpred_nf1(LHS,List2), 3009 mpred_nf_negations(List2,List).
3017% handle a variable. 3018 3019mpred_nf1(P,[P]):- is_ftVar(P), !. 3020 3021% these next two rules are here for upward compatibility and will go 3022% away eventually when the P/Condition form is no longer used anywhere. 3023 3024mpred_nf1(P/Cond,[(\+P)/Cond]):- mpred_negated_literal(P), !, 3025 nop(dmsg_pretty(warn(mpred_nf1(P/Cond,[(\+P)/Cond])))). 3026 3027mpred_nf1(P/Cond,[P/Cond]):- var(P),!. 3028mpred_nf1(P/Cond,[P/Cond]):- ((mpred_db_type(P,trigger(_));mpred_literal_nonvar(P))), !. 3029 3030% handle a negated form 3031 3032mpred_nf1(NegTerm,NF):- 3033 mpred_unnegate(NegTerm,Term), 3034 !, 3035 mpred_nf1_negation(Term,NF). 3036 3037% disjunction. 3038 3039mpred_nf1((P;Q),NF):- 3040 !, 3041 (mpred_nf1(P,NF) ; mpred_nf1(Q,NF)). 3042 3043 3044% conjunction. 3045 3046mpred_nf1((P,Q),NF):- 3047 !, 3048 mpred_nf1(P,NF1), 3049 mpred_nf1(Q,NF2), 3050 append(NF1,NF2,NF). 3051 3052mpred_nf1([P|Q],NF):- 3053 !, 3054 mpred_nf1(P,NF1), 3055 mpred_nf1(Q,NF2), 3056 append(NF1,NF2,NF). 3057 3058 3059% prolog_clause mpred_nf1 3060mpred_nf1((H :- B) , [(H :- B)]):- 3061 mpred_positive_literal(H),!. 3062 3063/* 3064% prolog_clause mpred_nf1 COMMENTED 3065mpred_nf1((H :- B) ,[P]):- 3066 mpred_positive_literal(H), 3067 P={clause(H , B)}, 3068 dmsg_pretty(warn(mpred_nf1((H :- B) ,[P]))),!. 3069 3070% prolog_clause mpred_nf1 COMMENTED 3071mpred_nf1((H :- B) ,[P]):- 3072 mpred_positive_literal(H), 3073 P={clause(H , B)}, 3074 dmsg_pretty(warn(mpred_nf1((H :- B) ,[P]))),!. 3075*/ 3076 3077% handle a random literal. 3078 3079mpred_nf1(P,[P]) :- is_ftVar(P), !. 3080mpred_nf1(P,[P]):- 3081 mpred_literal_nonvar(P), 3082 !. 3083 3084mpred_nf1(Term,[Term]):- mpred_trace_msg("mpred_nf Accepting ~p",[Term]),!. 3085 3086 3087%=% shouldn''t we have something to catch the rest as errors? 3088mpred_nf1(Term,[Term]):- 3089 mpred_warn("mpred_nf doesn't know how to normalize ~p",[Term]),dtrace,!,fail. 3090 3091notiffy_p(P,\+(P)):- var(P),!. % prevents next line from binding 3092notiffy_p(\+(P),P):- dmsg_pretty(notiffy_p(\+(P),P)), !. 3093notiffy_p(P,\+(P)).
3099mpred_nf1_negation(P,[\+P]):- is_ftVar(P),!. 3100mpred_nf1_negation((P/Cond),[NOTP/Cond]):- notiffy_p(P,NOTP), !. 3101 3102mpred_nf1_negation((P;Q),NF):- 3103 !, 3104 mpred_nf1_negation(P,NFp), 3105 mpred_nf1_negation(Q,NFq), 3106 append(NFp,NFq,NF). 3107 3108mpred_nf1_negation((P,Q),NF):- 3109 % this code is not correct! twf. 3110 !, 3111 mpred_nf1_negation(P,NF) 3112 ; 3113 (mpred_nf1(P,Pnf), 3114 mpred_nf1_negation(Q,Qnf), 3115 append(Pnf,Qnf,NF)). 3116 3117mpred_nf1_negation(P,[\+P]).
3130mpred_nf_negations(X,X) :- !. % I think not! twf 3/27/90 3131 3132mpred_nf_negations([],[]). 3133 3134mpred_nf_negations([H1|T1],[H2|T2]):- 3135 mpred_nf_negation(H1,H2), 3136 mpred_nf_negations(T1,T2).
3143mpred_nf_negation(Form,{\+ X}):- 3144 nonvar(Form), 3145 Form=(-({X})), 3146 !. 3147mpred_nf_negation(X,X).
3154build_rhs(_Sup,X,[X]):- 3155 var(X), 3156 !. 3157 3158build_rhs(Sup,(A,B),[A2|Rest]):- 3159 !, 3160 mpred_compile_rhs_term(Sup,A,A2), 3161 build_rhs(Sup,B,Rest). 3162 3163build_rhs(Sup,X,[X2]):- 3164 mpred_compile_rhs_term(Sup,X,X2). 3165 3166 3167mpred_compile_rhs_term(_Sup,P,P):-is_ftVar(P),!. 3168 3169% TODO confirm this is not reversed (mostly confirmed this is correct now) 3170mpred_compile_rhs_term(Sup, \+ ( P / C), COMPILED) :- nonvar(C), !, 3171 mpred_compile_rhs_term(Sup, ( \+ P ) / C , COMPILED). 3172 3173% dmiles added this to get PFC style lazy BCs 3174mpred_compile_rhs_term(Sup,(P/C),((P0 <- C0))) :- fail, !,mpred_compile_rhs_term(Sup,P,P0), 3175 build_code_test(Sup,C,C0),!. 3176 3177mpred_compile_rhs_term(Sup,(P/C),((P0 :- C0))) :- !,mpred_compile_rhs_term(Sup,P,P0), 3178 build_code_test(Sup,C,C0),!. 3179 3180mpred_compile_rhs_term(Sup,I,O):- mpred_compile_rhs_term_consquent(Sup,I,O).
3187 % 3188 % is true if N is a negated term and P is the term 3189 % with the negation operator stripped. (not Logical ~ negation however) 3190 % 3191 mpred_unnegate(P,_):- is_ftVar(P),!,fail. 3192 mpred_unnegate((\+(P)),P). 3193 mpred_unnegate((-P),P). 3194 mpred_unnegate((~P),P).
3199 % 3200 % PFC Negated Literal. 3201 % 3202 %mpred_negated_literal(P):- is_ftVar(P),!,fail. 3203 mpred_negated_literal(P):- 3204 mpred_unnegate(P,Q), 3205 mpred_positive_literal(Q). 3206 %mpred_negated_literal(~(_)). 3207 3208 3209 mpred_literal_or_var(X):- is_ftVar(X),!. 3210 mpred_literal_or_var(X):- mpred_negated_literal(X),!. 3211 mpred_literal_or_var(X):- mpred_positive_literal(X),!. 3212 3213 mpred_literal(X):- is_ftVar(X),!. 3214 mpred_literal(X):- mpred_negated_literal(X),!. 3215 mpred_literal(X):- mpred_positive_literal(X),!. 3216 3217 mpred_literal_nonvar(X):- is_ftVar(X),!,fail. 3218 mpred_literal_nonvar(X):- mpred_negated_literal(X),!. 3219 mpred_literal_nonvar(X):- mpred_positive_literal(X),!. 3220 3221 mpred_positive_literal(X):- 3222 is_ftNonvar(X), 3223 X \= ~(_), % MAYBE COMMENT THIS OUT 3224 \+ mpred_db_type(X,rule(_RT)), 3225 get_functor(X,F,_), 3226 \+ mpred_neg_connective(F), 3227 !. 3228 3229 mpred_positive_fact(X):- mpred_positive_literal(X), X \= ~(_), 3230 mpred_db_type(X,fact(_FT)), \+ mpred_db_type(X,trigger). 3231 3232 mpred_is_trigger(X):- mpred_db_type(X,trigger(_)). 3233 3234 3235 3236 mpred_connective(Var):-var(Var),!,fail. 3237 mpred_connective(';'). 3238 mpred_connective(','). 3239 mpred_connective('/'). 3240 mpred_connective('{}'). 3241 mpred_connective('|'). 3242 mpred_connective(('==>')). 3243 mpred_connective(('<-')). 3244 mpred_connective('<==>'). 3245 mpred_connective('-'). 3246 % mpred_connective('~'). 3247 mpred_connective(('\\+')). 3248 3249 3250 mpred_neg_connective('-'). 3251 % mpred_neg_connective('~'). 3252 mpred_neg_connective('\\+'). 3253 3254 is_simple_lhs(ActN):- is_ftVar(ActN),!,fail. 3255 is_simple_lhs( \+ _ ):-!,fail. 3256 is_simple_lhs( ~ _ ):-!,fail. 3257 is_simple_lhs( _ / _ ):-!,fail. 3258 is_simple_lhs((Lhs1,Lhs2)):- !,is_simple_lhs(Lhs1),is_simple_lhs(Lhs2). 3259 is_simple_lhs((Lhs1;Lhs2)):- !,is_simple_lhs(Lhs1),is_simple_lhs(Lhs2). 3260 is_simple_lhs(ActN):- is_active_lhs(ActN),!,fail. 3261 is_simple_lhs((Lhs1/Lhs2)):- !,fail, is_simple_lhs(Lhs1),is_simple_lhs(Lhs2). 3262 is_simple_lhs(_). 3263 3264 3265 is_active_lhs(ActN):- var(ActN),!,fail. 3266 is_active_lhs(!). 3267 is_active_lhs(cut_c). 3268 is_active_lhs(actn(_Act)). 3269 is_active_lhs('{}'(_Act)). 3270 is_active_lhs((Lhs1/Lhs2)):- !,is_active_lhs(Lhs1);is_active_lhs(Lhs2). 3271 is_active_lhs((Lhs1,Lhs2)):- !,is_active_lhs(Lhs1);is_active_lhs(Lhs2). 3272 is_active_lhs((Lhs1;Lhs2)):- !,is_active_lhs(Lhs1);is_active_lhs(Lhs2). 3273 3274 3275 add_lhs_cond(Lhs1/Cond,Lhs2,Lhs1/(Cond,Lhs2)):-!. 3276 add_lhs_cond(Lhs1,Lhs2,Lhs1/Lhs2).
3280 % 3281 % Creates a somewhat sane Guard. 3282 % 3283 % To turn this feature off... 3284 % ?- set_prolog_flag(constrain_meta,false). 3285 % 3286 % 3287 constrain_meta(_,_):- current_prolog_flag(constrain_meta,false),!,fail. 3288 % FACT 3289 constrain_meta(P,mpred_positive_fact(P)):- is_ftVar(P),!. 3290 % NEG chaining 3291 constrain_meta(~ P, CP):- !, constrain_meta(P,CP). 3292 constrain_meta(\+ P, CP):- !, constrain_meta(P,CP). 3293 % FWD chaining 3294 constrain_meta((_==>Q),nonvar(Q)):- !, is_ftVar(Q). 3295 % EQV chaining 3296 constrain_meta((P<==>Q),(nonvar(Q);nonvar(P))):- (is_ftVar(Q);is_ftVar(P)),!. 3297 % BWD chaining 3298 constrain_meta((Q <- _),mpred_literal_nonvar(Q)):- is_ftVar(Q),!. 3299 constrain_meta((Q <- _),CQ):- !, constrain_meta(Q,CQ). 3300 % CWC chaining 3301 constrain_meta((Q :- _),mpred_literal_nonvar(Q)):- is_ftVar(Q),!. 3302 constrain_meta((Q :- _),CQ):- !, constrain_meta(Q,CQ).
3312/* 3313 3314Next Line converts: 3315((prologHybrid(F),arity(F,A))==>{kb_shared(F/A)}). 3316 3317To: 3318arity(F,A)/prologHybrid(F)==>{kb_shared(F/A)}. 3319prologHybrid(F)/arity(F,A)==>{kb_shared(F/A)}. 3320 3321In order to reduce the number of postivie triggers (pt/2s) 3322*/ 3323 3324process_rule(LhsIn,Rhs,Parent_rule):- constrain_meta(LhsIn,How),!, 3325 process_rule0(LhsIn/How,Rhs,Parent_rule). 3326 3327process_rule(LhsIn,Rhs,Parent_rule):- is_simple_lhs(LhsIn),LhsIn = (Lhs1,Lhs2), 3328 Lhs2\=(_,_), 3329 add_lhs_cond(Lhs1,Lhs2,LhsA), 3330 add_lhs_cond(Lhs2,Lhs1,LhsB), 3331 process_rule0(LhsA,Rhs,Parent_rule), 3332 process_rule0(LhsB,Rhs,Parent_rule). 3333process_rule(Lhs,Rhs,Parent_rule):-process_rule0(Lhs,Rhs,Parent_rule). 3334 3335process_rule0(Lhs,Rhs,Parent_rule):- 3336 must_notrace_pfc(get_source_mfl(U)),!, 3337 copy_term(Parent_rule,Parent_ruleCopy), 3338 build_rhs(U,Rhs,Rhs2), 3339 foreach(mpred_nf(Lhs,Lhs2), 3340 ignore(build_rule(Lhs2,rhs(Rhs2),(Parent_ruleCopy,U)))).
3347build_rule(Lhs,Rhs,Support):- 3348 copy_term_vn(Support,WS), 3349 mpred_mark_as(WS,Lhs,pfcLHS), 3350 build_trigger(WS,Lhs,Rhs,Trigger), 3351 cyclic_break((Lhs,Rhs,WS,Trigger)), 3352 doall(mpred_eval_lhs_no_nc(Trigger,Support)). 3353 3354build_trigger(WS,[],Consequent,ConsequentO):- 3355 mpred_compile_rhs_term_consquent(WS,Consequent,ConsequentO). 3356 3357build_trigger(WS,[V|Triggers],Consequent,pt(V,X)):- 3358 is_ftVar(V), 3359 !, 3360 build_trigger(WS,Triggers,Consequent,X). 3361 3362% T1 is a negation in the next two clauses 3363build_trigger(WS,[TT|Triggers],Consequent,nt(T2,Test2,X)):- 3364 compound(TT), 3365 TT=(T1/Test), 3366 mpred_unnegate(T1,T2), 3367 !, 3368 build_neg_test(WS,T2,Test,Test2), 3369 build_trigger(WS,Triggers,Consequent,X). 3370 3371build_trigger(WS,[(T1)|Triggers],Consequent,nt(T2,Test,X)):- 3372 mpred_unnegate(T1,T2), 3373 !, 3374 build_neg_test(WS,T2,true,Test), 3375 build_trigger(WS,Triggers,Consequent,X). 3376 3377build_trigger(WS,[{Test}|Triggers],Consequent,(Test*->Body)):- % Noncutted -> 3378 !, 3379 build_trigger(WS,Triggers,Consequent,Body). 3380 3381build_trigger(WS,[T/Test|Triggers],Consequent,pt(T,X)):- 3382 !, 3383 build_code_test(WS, Test,Test2), 3384 build_trigger(WS,[{Test2}|Triggers],Consequent,X). 3385 3386 3387%build_trigger(WS,[snip|Triggers],Consequent,snip(X)):- 3388% !, 3389% build_trigger(WS,Triggers,Consequent,X). 3390 3391 3392build_trigger(WS,[T|Triggers],Consequent,Reslt):- 3393 constrain_meta(T,Test)-> 3394 build_trigger(WS,[T/Test|Triggers],Consequent,Reslt),!. 3395 3396build_trigger(WS,[T|Triggers],Consequent,pt(T,X)):- 3397 !, 3398 build_trigger(WS,Triggers,Consequent,X).
3408build_neg_test(WS,T,Testin,Testout):-
3409 build_code_test(WS,Testin,Testmid),
3410 mpred_conjoin((call_u_no_bc(T)),Testmid,Testout).3417%check_never_assert(_Pred):-!. 3418%:-dumpST. 3419check_never_assert(MPred):- strip_module(MPred,M,_Pred), 3420 quietly_ex(ignore((check_db_sanity(never_assert_u,M,MPred)))). 3421 3422check_db_sanity(Checker,CModule,Pred):- 3423 (current_predicate(CModule:Checker/2)->Module=CModule;Module=baseKB),!, 3424 copy_term_and_varnames(Pred,Pred_2), 3425 CheckerCall univ_safe [ Checker,Pred_2,_Why], 3426 call_u_no_bc(Module:CheckerCall), 3427 sanity(variant_u(Pred,Pred_2)), 3428 trace_or_throw_ex(Module:CheckerCall). 3429 3430%check_never_assert(Pred):- quietly_ex(ignore(( copy_term_and_varnames(Pred,Pred_2),call_u_no_bc(never_assert_u(Pred_2)),variant_u(Pred,Pred_2),trace_or_throw_ex(never_assert_u(Pred))))). 3431%check_never_assert(Pred):- quietly_ex((( copy_term_and_varnames(Pred,Pred_2),call_u_no_bc(never_assert_u(Pred_2,Why)), variant_u(Pred,Pred_2),trace_or_throw_ex(never_assert_u(Pred,Why))))),fail.
3438%check_never_retract(_Pred):-!. 3439check_never_retract(MPred):- strip_module(MPred,M,_Pred), 3440 quietly_ex(ignore((check_db_sanity(never_retract_u,M,MPred)))). 3441 3442 3443:- export(mpred_mark_as_ml/3).
3449mpred_mark_as_ml(Sup,Type,P):- mpred_mark_as(Sup,P,Type).3456pos_2_neg(p,n):-!. 3457pos_2_neg(n,p):-!. 3458pos_2_neg(P,~(P)):- (var(P); P \= '~'(_)),!. 3459% pos_2_neg(P,~(P)).
3466mpred_mark_as(_,P,_):- is_ftVar(P),!. 3467mpred_mark_as(Sup,M:P,Type):- atom(M),mtHybrid(M),!,M:mpred_mark_as(Sup,P,Type). 3468mpred_mark_as(Sup,_:P,Type):- !, mpred_mark_as(Sup,P,Type). 3469mpred_mark_as(Sup,\+(P),Type):- !,mpred_mark_as(Sup,P,Type). 3470mpred_mark_as(Sup,~(P),Type):- !,mpred_mark_as(Sup,P,Type). 3471mpred_mark_as(Sup,-(P),Type):- !,mpred_mark_as(Sup,P,Type). 3472mpred_mark_as(Sup,not(P),Type):- !,mpred_mark_as(Sup,P,Type). 3473mpred_mark_as(Sup,[P|PL],Type):- is_list(PL), !,must_maplist(mpred_mark_as_ml(Sup,Type),[P|PL]). 3474mpred_mark_as(Sup,( P / CC ),Type):- !, mpred_mark_as(Sup,P,Type),mpred_mark_as(Sup,( CC ),pfcCallCode). 3475mpred_mark_as(Sup,( P :- _CC), Type):- !, mpred_mark_as(Sup,P, Type) /* , mpred_mark_as(Sup, ( CC ), pfcCallCode) */ . 3476mpred_mark_as(Sup,'{}'( CC ), _Type):- mpred_mark_as(Sup,( CC ),pfcCallCode). 3477mpred_mark_as(Sup,( A , B), Type):- !, mpred_mark_as(Sup,A, Type),mpred_mark_as(Sup,B, Type). 3478mpred_mark_as(Sup,( A ; B), Type):- !, mpred_mark_as(Sup,A, Type),mpred_mark_as(Sup,B, Type). 3479mpred_mark_as(Sup,( A ==> B), Type):- !, mpred_mark_as(Sup,A, Type),mpred_mark_as(Sup,B, pfcRHS). 3480mpred_mark_as(Sup,( B <- A), Type):- !, mpred_mark_as(Sup,A, Type),mpred_mark_as(Sup,B, pfcRHS). 3481mpred_mark_as(Sup,P,Type):-get_functor(P,F,A),ignore(mpred_mark_fa_as(Sup,P,F,A,Type)),!.
3489% mpred_mark_fa_as(_Sup,_P,'\=',2,_):- dtrace. 3490% BREAKS SIMPLE CASES 3491% mpred_mark_fa_as(_Sup,_P,_,_,Type):- Type \== pfcLHS, Type \== pfcRHS, current_prolog_flag(unsafe_speedups , true) ,!. 3492mpred_mark_fa_as(_Sup,_P,isa,_,_):- !. 3493%mpred_mark_fa_as(_Sup,_P,_,_,pfcCallCode):- !. 3494mpred_mark_fa_as(_Sup,_P,t,_,_):- !. 3495mpred_mark_fa_as(_Sup,_P,argIsa,N,_):- !,must_ex(N=3). 3496mpred_mark_fa_as(_Sup,_P,arity,N,_):- !,must_ex(N=2). 3497mpred_mark_fa_as(_Sup,_P,mpred_prop,N,_):- !,must_ex(N=4). 3498%mpred_mark_fa_as(_Sup,_P,mpred_isa,N,_):- must_ex(N=2). 3499mpred_mark_fa_as(_Sup,_P,'[|]',N,_):- dtrace,must_ex(N=2). 3500mpred_mark_fa_as(_Sup,_P,_:mpred_prop,N,_):- must_ex(N=4). 3501mpred_mark_fa_as(Sup, _P,F,A,Type):- really_mpred_mark(Sup,Type,F,A),!. 3502 3503% i hope i am not exagerating but anniepoo used to enter this yearly contest for whom could build graphical assets the most pretty and complex the quickest in secondlife.. (now it makes sense she used a 3d mouse) she won so much, they and she had to ban herself becasue she always won hands down.. so with this agility to create the physical aspects of a wolrd veery easily .. we realized we could make a fun leanring inpiring world for AIs .. however 3504 3505really_mpred_mark(_ ,Type,F,A):- call_u_no_bc(mpred_prop(_M,F,A,Type)),!. 3506really_mpred_mark(Sup,Type,F,A):- 3507 current_assertion_module(M), 3508 MARK = mpred_prop(M,F,A,Type), 3509 check_never_assert(MARK), 3510 why_marked(M,Sup,WM), 3511 with_no_mpred_trace_exec(with_fc_mode(direct,mpred_post1(MARK,(WM,ax)))). 3512 %with_no_mpred_trace_exec(with_fc_mode(direct,mpred_post1(MARK,(why_marked(Sup),ax)))). 3513 % with_no_mpred_trace_exec(with_fc_mode(direct,mpred_fwc1(MARK,(why_marked(Sup),ax)))),!. 3514 3515why_marked(M,_Sup,mfl4(VarNameZ,M,F,L)):- source_location(F,L),!,varnames_load_context(VarNameZ). 3516why_marked(_,Sup,Sup).
3522fa_to_p(F,A,P):-is_ftNameArity(F,A),safe_functor(P,F,A),
3523 ( P \= call_u_no_bc(_) ),( P \= '$VAR'(_)).what this does...
strips away any currly brackets
converts cuts to cut_c/0
converts variable Ps to call_u_no_bc(P)
3536build_code_test(_Support,Test,TestO):- is_ftVar(Test),!,must_ex(TestO=call_u_no_bc(Test)). 3537build_code_test(WS,{Test},TestO) :- !,build_code_test(WS,Test,TestO). 3538build_code_test(_Sup,!,cut_c):-!. 3539build_code_test(WS,rhs(Test),rhs(TestO)) :- !,build_code_test(WS,Test,TestO). 3540build_code_test(WS,Test,TestO):- is_list(Test),must_maplist(build_code_test(WS),Test,TestO). 3541build_code_test(_WS,(H:-B),clause_asserted_u(H,B)):- !. 3542build_code_test(_WS,M:(H:-B),clause_asserted_u(M:H,B)):- !. 3543build_code_test(WS,Test,TestO):- code_sentence_op(Test),Test univ_safe [F|TestL],must_maplist(build_code_test(WS),TestL,TestLO),TestO univ_safe [F|TestLO],!. 3544build_code_test(WS,Test,Test):- must_ex(mpred_mark_as(WS,Test,pfcCallCode)),!. 3545build_code_test(_,Test,Test).
3552mpred_compile_rhs_term_consquent(_ ,Test,Test):- is_ftVar(Test),!. 3553mpred_compile_rhs_term_consquent(_ ,Test,TestO):-is_ftVar(Test),!,TestO=added(Test). 3554mpred_compile_rhs_term_consquent(_Sup,!,{cut_c}):-!. 3555mpred_compile_rhs_term_consquent(WS,'{}'(Test),'{}'(TestO)) :- !,build_code_test(WS,Test,TestO). 3556mpred_compile_rhs_term_consquent(WS,rhs(Test),rhs(TestO)) :- !,mpred_compile_rhs_term_consquent(WS,Test,TestO). 3557mpred_compile_rhs_term_consquent(WS,Test,TestO):- is_list(Test),must_maplist(mpred_compile_rhs_term_consquent(WS),Test,TestO). 3558 3559mpred_compile_rhs_term_consquent(_WS,(H:-B),(H:-B)):-!. 3560 3561mpred_compile_rhs_term_consquent(WS,Test,TestO):- 3562 code_sentence_op(Test),Test univ_safe [F|TestL], 3563 must_maplist(mpred_compile_rhs_term_consquent(WS),TestL,TestLO), 3564 TestO univ_safe [F|TestLO],!. 3565 3566mpred_compile_rhs_term_consquent(Sup,I,O):- 3567 % TODO replace the next line with I=O, 3568 full_transform_warn_if_changed(compile_rhs,I,O), 3569 must_ex(mpred_mark_as(Sup,O,pfcRHS)),!.
3577code_sentence_op(Var):-is_ftVar(Var),!,fail. 3578code_sentence_op(rhs(_)). 3579code_sentence_op(~(_)). 3580code_sentence_op(-(_)). 3581code_sentence_op(-(_)). 3582code_sentence_op((_,_)). 3583code_sentence_op((_;_)). 3584code_sentence_op(\+(_)). 3585code_sentence_op(call(_)). 3586code_sentence_op(call_u(_)). 3587code_sentence_op(call_u_no_bc(_,_)). 3588code_sentence_op(Test:-_):-!,code_sentence_op(Test). 3589code_sentence_op(Test):- 3590 predicate_property(Test,built_in), 3591 predicate_property(Test,meta_predicate(PP)), \+ (( arg(_,PP,N), N \= 0)).
3598all_closed(C):- \+is_ftCompound(C)->true;(safe_functor(C,_,A),A>1,\+((arg(_,C,Arg),is_ftVar(Arg)))),!. 3599 3600 3601%head_to_functor_name(I,F):- is_ftCompound(I),get_head(I,H),is_ftCompound(I),get_functor_name(I,F). 3602head_to_functor_name(I,F):- is_ftCompound(I),get_functor(I,F).
simple typeing for Pfc objects
3611mpred_db_type(Var,Type):- var(Var),!, Type=fact(_FT). 3612mpred_db_type(_:X,Type):- !, mpred_db_type(X,Type). 3613mpred_db_type(~_,Type):- !, Type=fact(_FT). 3614mpred_db_type(('==>'(_,_)),Type):- !, Type=rule(fwd). 3615mpred_db_type(('<==>'(_,_)),Type):- !, Type=rule(<==>). 3616mpred_db_type(('<-'(_,_)),Type):- !, Type=rule(bwc). 3617mpred_db_type((':-'(_,_)),Type):- !, Type=rule(cwc). 3618mpred_db_type(pt(_,_,_),Type):- !, Type=trigger(pt). 3619mpred_db_type(pt(_,_),Type):- !, Type=trigger(pt). 3620mpred_db_type(nt(_,_,_),Type):- !, Type=trigger(nt). 3621mpred_db_type(bt(_,_),Type):- !, Type=trigger(bt). 3622mpred_db_type(actn(_),Type):- !, Type=action. 3623mpred_db_type((('::::'(_,X))),Type):- !, mpred_db_type(X,Type). 3624mpred_db_type(_,fact(_FT)):- 3625 % if it''s not one of the above, it must_ex be a fact! 3626 !. 3627 3628mpred_assert_w_support(P,Support):- 3629 (clause_asserted_u(P) ; assert_u_confirmed_was_missing(P)), 3630 !, 3631 mpred_add_support(P,Support). 3632 3633mpred_asserta_w_support(P,Support):- 3634 (clause_asserted_u(P) ; asserta_u(P)), 3635 !, 3636 mpred_add_support(P,Support). 3637 3638mpred_assertz_w_support(P,Support):- 3639 (clause_asserted_u(P) ; assertz_u(P)), 3640 !, 3641 mpred_add_support(P,Support).
3650:- module_transparent(clause_asserted_call/2). 3651clause_asserted_call(H,B):-clause_asserted(H,B). 3652 3653clause_asserted_u(P):- clause_asserted_i(P),!. 3654 3655 3656/* 3657clause_asserted_u0(P):-clause_asserted(P),!,sanity(clause_asserted_u1(P)),!. 3658clause_asserted_u0(P):- sanity( \+ clause_asserted_u1(P)),fail. 3659clause_asserted_u1(M:(H:-B)):- nonvar(M),!, clause_asserted_u0(M,H,B). 3660clause_asserted_u1((M:H):-B):- nonvar(M),!, clause_asserted_u0(M,H,B). 3661clause_asserted_u1(MH):- strip_module(MH,M,H),clause_asserted_u0(M,H,true),!. 3662 3663clause_asserted_u0(M,H,_):- sanity((nonvar(H), ignore(show_failure(\+ is_static_predicate(M:H))))),fail. 3664% clause_asserted_u0(MH,_):- \+ ground(MH),must_notrace_pfc(full_transform(change(assert,assert_u),MH,MA)),MA\=@=MH,!,clause_asserted_u(MA). 3665% clause_asserted_u0(M,H,B):- current_prolog_flag(unsafe_speedups, true), !,clause_asserted_ii(M,H,B). 3666clause_asserted_u0(M,H,B):- must_ex(quietly_ex(fix_mp(clause(clause,clause_asserted_u),M:H,M,H))),clause_asserted_ii(M,H,B). 3667*/ 3668clause_asserted_ii(M,H,B):- system:clause(M:H,B,Ref),system:clause(_:HH,BB,Ref),H=@=HH,B=@=BB,!. 3669 3670variant_m(_:H,_:HH):-!,H=@=HH. 3671variant_m(H,_:HH):-!,H=@=HH. 3672variant_m(_:H,HH):-!,H=@=HH. 3673variant_m(H,HH):-!,H=@=HH. 3674 3675variant_u(HeadC,Head_copy):-variant_i(HeadC,Head_copy). 3676 3677/* 3678%% foreach(+Binder, ?Body) is det. 3679% 3680% Foreachl Do. 3681% 3682foreach(Binder,Body):- Binder,pfcl_do(Body),fail. 3683foreach(_,_). 3684 3685 3686%% pfcl_do(+X) is semidet. 3687% 3688% executes P once and always succeeds. 3689% 3690pfcl_do(X):- X,!. 3691pfcl_do(_). 3692*/
3699mpred_union([],L,L). 3700mpred_union([Head|Tail],L,Tail2):- 3701 memberchk(Head,L), 3702 !, 3703 mpred_union(Tail,L,Tail2). 3704mpred_union([Head|Tail],L,[Head|Tail2]):- 3705 mpred_union(Tail,L,Tail2). 3706 3707 3708% mpred_conjoin(+Conjunct1,+Conjunct2,?Conjunction). 3709% arg3 is a simplified expression representing the conjunction of 3710% args 1 and 2. 3711 3712mpred_conjoin(True,X,X):- True==true, !. 3713mpred_conjoin(X,True,X):- True==true, !. 3714mpred_conjoin(C1,C2,(C1,C2)). 3715 3716 3717% File : pfcdb.pl 3718% Author : Tim Finin, finin@prc.unisys.com 3719% Author : Dave Matuszek, dave@prc.unisys.com 3720% Author : Dan Corpron 3721% Updated: 10/11/87, ... 3722% Purpose: predicates to manipulate a Pfc database (e.ax. save, 3723% restore, reset, etc.)
3729mpred_reset:-
3730 mpred_reset_kb,
3731 forall((clause_b(mtHybrid(Module)),Module\==baseKB),
3732 mpred_reset_kb(Module)).3739mpred_reset_kb:- defaultAssertMt(Module), 3740 (Module\==baseKB->mpred_reset_kb(Module);true). 3741 3742mpred_reset_kb_facts(Module):- nop(Module). 3743 3744mfl_module(mfl4(_VarNameZ,M,_,_),Module):- Module==M,!. 3745mfl_module(mfl4(_VarNameZ,_,F,_),Module):- atom(F), 3746 module_property(M,file(F)), 3747 \+ ((module_property(M2,file(F)),M\==M2)), 3748 Module==M. 3749 3750mpred_reset_kb(Module):- 3751 with_exact_kb(Module,mpred_reset_kb_0(Module)). 3752 3753mpred_reset_kb_0(Module):- mpred_reset_kb_facts(Module),fail. 3754mpred_reset_kb_0(Module):- 3755 only_is_user_reason((ZF,ZTrigger)), 3756 clause(Module:spft(P,ZF,ZTrigger),_,Ref), 3757 nonvar(P), 3758 once(clause_property(Ref,module(Module)); mfl_module(ZF,Module)), 3759 must_ex(mpred_reset_mp(Module,P)), 3760 ( \+ clause(Module:spft(P,ZF,ZTrigger),_,Ref) -> true; 3761 (must_ex((clause(_SPFT,_SB,Ref),erase(Ref))))), % must_ex((mpred_retract_i_or_warn_1(P);(fail,mpred_retract_i_or_warn(SPFT)))), 3762 fail. 3763mpred_reset_kb_0(Module):- 3764 clause(Module:spft(P,ZF,ZTrigger),_,Ref), 3765 nonvar(P), 3766 once(clause_property(Ref,module(Module)); mfl_module(ZF,Module)), 3767 must_ex(mpred_reset_mp(Module,P)), 3768 ( \+ clause(Module:spft(P,ZF,ZTrigger),_,Ref) -> true; 3769 (must_ex((clause(_SPFT,_SB,Ref),erase(Ref))))), % must_ex((mpred_retract_i_or_warn_1(P);(fail,mpred_retract_i_or_warn(SPFT)))), 3770 fail. 3771 3772mpred_reset_kb_0(Module):- mpred_reseted_kb_check(Module),!. 3773 3774 3775mpred_reseted_kb_check(Module):- with_exact_kb(Module,mpred_reseted_kb_check_0(Module)). 3776 3777mpred_reseted_kb_check_0(Module):- \+ mpred_database_item(Module,_),!,mpred_trace_msg("Reset DB complete for ~p",[Module]). 3778mpred_reseted_kb_check_0(Module):- mpred_trace_msg("Couldn't full mpred_reseted_kb_check(~w).~n",[Module]), 3779 pp_DB,mpred_database_item(Module,T), 3780 wdmsg_pretty(mpred_database_item(Module,T)),!. 3781 %mpred_warn("Pfc database [~w] not empty: ~p.~n",[Module,T]),!, 3782 %mpred_error("Pfc database [~w] not empty: ~p.~n",[Module,T]),!. 3783 3784mpred_reset_mp(Module,P):- P \= ( _:-_ ), mpred_retract(Module:P),!. 3785mpred_reset_mp(Module,P):- 3786 doall(( 3787 expand_to_hb(P,H,B), 3788 clause_asserted(Module:H,B,PRef1), 3789 clause_property(PRef1,module(Module)), 3790 % show_failure((((lookup_u(Module:P,PRef2),PRef2==PRef1)))), 3791 (must_ex(mpred_retract_i(Module:P))->true;mpred_warn("Couldn't retract ~p: ~p.~n",[Module,P])), 3792 sanity(\+ clause_asserted(_H0,_B0,PRef1)))). 3793 3794 3795% true if there is some Pfc crud still in the database. 3796mpred_database_item(Module,P):- 3797 current_module(Module), 3798 mpred_database_term(F,A,Type), 3799 Type\=debug,Type\=setting, 3800 safe_functor(H,F,A), 3801 % H \= ~(_), 3802 P = (H:-B), 3803 Module:clause(H,B,Ref), 3804 clause_property(Ref,module(Module)), 3805 \+ reserved_body_helper(B). 3806 3807 3808mpred_retract_i_or_warn(X):- ignore(show_failure((mpred_retract_i_or_warn_1(X) *-> true; mpred_retract_i_or_warn_2(X)))). 3809 3810mpred_retract_i_or_warn_1(X):- sanity(is_ftNonvar(X)), 3811 ((((X=spft(_,_,_), call_u(X), retract_u(X))) *-> true ; retract_u(X))), 3812 nop((mpred_trace_msg('~NSUCCESS: ~p~n',[retract_u(X)]))). 3813 3814% mpred_retract_i_or_warn_2(SPFT):- \+ \+ SPFT = spft(_,a,a),!,fail. 3815% mpred_retract_i_or_warn_2(X):- fail,mpred_warn("Couldn't retract_u ~p.~n",[X]),(debugging_logicmoo(logicmoo(pfc))->rtrace(retract_u(X));true),!. 3816mpred_retract_i_or_warn_2(X):- mpred_trace_msg("Couldn't retract_i: ~p.~n",[X]),fail. 3817%mpred_retract_i_or_warn_2(X):- mpred_warn("Couldn't retract_i: ~p.~n",[X]),!. 3818 3819 3820 3821 3822% File : pfcdebug.pl 3823% Author : Tim Finin, finin@prc.unisys.com 3824% Author : Dave Matuszek, dave@prc.unisys.com 3825% Updated: 3826% Purpose: provides predicates for examining the database and debugginh 3827% for Pfc. 3828 3829%:- mpred_set_default(baseKB:mpred_warnings(_), baseKB:mpred_warnings(true)). 3830% tms is one of {none,local,cycles} and controles the tms alg. 3831% :- during_boot(mpred_set_default(mpred_warnings(_), mpred_warnings(true))). 3832 3833% mpred_fact(P) is true if fact P was asserted into the database via add. 3834 3835mpred_fact_mp(M,G):- current_predicate(_,M:G),\+ predicate_property(M:G,imported_from(_)), 3836 mpred_fact(G),ignore((lookup_u(G,Ref),clause_property(Ref,module(MW)))),MW=M. 3837 3838mpred_fact(P):- mpred_fact(P,true). 3839 3840% mpred_fact(P,C) is true if fact P was asserted into the database via 3841% add and contdition C is satisfied. For example, we might do: 3842% 3843% mpred_fact(X,mpred_userFact(X)) 3844% 3845 3846mpred_fact(P,C):- mpred_fact0(P,C). 3847mpred_fact(P,C):- compound(P),safe_functor(P,F,2),clause_b(rtSymmetricBinaryPredicate(F)),args_swapped(P,Q),mpred_fact0(Q,C). 3848mpred_fact(~P,C):- compound(P),safe_functor(P,F,2),clause_b(rtSymmetricBinaryPredicate(F)),args_swapped(P,Q),mpred_fact0(~Q,C). 3849mpred_fact0(P,C):- 3850 mpred_get_support(P,_), 3851 mpred_db_type(P,fact(_FT)), 3852 call_u_no_bc(C). 3853 3854% mpred_facts_in_kb(MM,-ListofPmpred_facts) returns a list of facts added. 3855 3856mpred_facts(L):- mpred_facts_in_kb(_,L). 3857mpred_facts_in_kb(MM,L):- mpred_facts_in_kb(MM,_,true,L). 3858 3859mpred_facts(P,L):- mpred_facts_in_kb(_,P,L). 3860mpred_facts(KB,P,L):- mpred_facts_in_kb(KB,P,L). 3861mpred_facts_in_kb(MM,P,L):- mpred_facts_in_kb(MM,P,true,L). 3862 3863% mpred_facts_in_kb(MM,Pattern,Condition,-ListofPmpred_facts) returns a list of facts added.
3869mpred_facts_in_kb(MM,P,C,L):- with_exact_kb(MM,setof(P,mpred_fact(P,C),L)).3876brake(X):- , break. 3877 3878 3879% 3880% predicates providing a simple tracing facility 3881% 3882 3883% this is here for upward compat. - should go away eventually. 3884mpred_trace_op(Add,P):- 3885 not_not_ignore_quietly_ex((get_why_uu(Why), !, mpred_trace_op(Add,P,Why))). 3886 3887 3888mpred_trace_op(Add,P,S):- 3889 not_not_ignore_quietly_ex((mpred_trace_maybe_print(Add,P,S), 3890 mpred_trace_maybe_break(Add,P,S))). 3891 3892 3893mpred_trace_maybe_print(Add,P,S):- 3894 not_not_ignore_quietly_ex(( 3895 \+ get_mpred_is_tracing(P) -> true; 3896 ( 3897 ((to_u(S,U),atom(U)) 3898 -> wdmsg_pretty("~NOP: ~p (~p) ~p",[Add,U,P]) 3899 ; wdmsg_pretty("~NOP: ~p (:) ~p~N\tSupported By: ~q",[Add,P,S]))))),!. 3900 3901to_u(S,U):-S=(U,ax),!. 3902to_u(S,U):-S=(U,_),!. 3903to_u(S,U):-S=(U),!. 3904 3905 3906mpred_trace_maybe_break(Add,P0,_ZS):- 3907 get_head_term(P0,P), 3908 ( 3909 \+ call_u(lmcache:mpred_is_spying_pred(P,Add)) -> true; 3910 (wdmsg_pretty("~NBreaking on ~p(~p)",[Add,P]), 3911 break)). 3912 3913 3914 3915pfc_hide(P):-call(P). 3916 3917mpred_trace:- mpred_trace(_). 3918 3919mpred_trace(Form0):- get_head_term(Form0,Form), 3920 assert_u_no_dep(lmcache:mpred_is_spying_pred(Form,print)).
3926get_mpred_is_tracing(_):-!,fail. 3927get_mpred_is_tracing(Form0):- get_head_term(Form0,Form), t_l:hide_mpred_trace_exec,!, 3928 \+ \+ ((quietly_ex(call_u(lmcache:mpred_is_spying_pred(Form,print))))). 3929get_mpred_is_tracing(Form0):- get_head_term(Form0,Form), 3930 once(t_l:mpred_debug_local ; tracing ; clause_asserted_u(mpred_is_tracing_exec) ; 3931 call_u(lmcache:mpred_is_spying_pred(Form,print))).
3938mpred_trace(Form0,Condition):- get_head_term(Form0,Form), 3939 assert_u_no_dep((lmcache:mpred_is_spying_pred(Form,print):- Condition)). 3940 3941mpred_spy(Form):- mpred_spy(Form,[add,rem],true). 3942 3943mpred_spy(Form,Modes):- mpred_spy(Form,Modes,true). 3944 3945mpred_spy(Form0,List,Condition):- is_list(List),!,get_head_term(Form0,Form), 3946 !,must_maplist(mpred_spy1(Condition,Form),List). 3947 3948mpred_spy(Form0,Mode,Condition):- get_head_term(Form0,Form), 3949 mpred_spy1(Condition,Form,Mode). 3950 3951mpred_spy1(Condition,Form0,Mode):- get_head_term(Form0,Form), 3952 assert_u_no_dep((lmcache:mpred_is_spying_pred(Form,Mode):- Condition)). 3953 3954mpred_nospy:- mpred_nospy(_,_,_). 3955 3956mpred_nospy(Form):- mpred_nospy(Form,_,_). 3957 3958mpred_nospy(Form0,Mode,Condition):- get_head_term(Form0,Form), 3959 clause_u(lmcache:mpred_is_spying_pred(Form,Mode), Condition, Ref), 3960 erase(Ref), 3961 fail. 3962mpred_nospy(_,_,_). 3963 3964mpred_notrace:- mpred_untrace. 3965mpred_untrace:- mpred_untrace(_). 3966mpred_untrace(Form0):- get_head_term(Form0,Form), retractall_u(lmcache:mpred_is_spying_pred(Form,print)). 3967 3968 3969% not_not_ignore_quietly_ex(G):- ignore(quietly(\+ \+ G)). 3970% not_not_ignore_quietly_ex(G):- ignore( \+ (G)). 3971not_not_ignore_quietly_ex(G):- notrace(ignore(quietly_ex(\+ \+ G))). 3972 3973% needed: mpred_trace_rule(Name) ... 3974 3975log_failure(ALL):- quietly_ex((log_failure_red,maybe_mpred_break(ALL),log_failure_red)). 3976 3977log_failure_red:- quietly(doall(( 3978 show_current_source_location, 3979 between(1,3,_), 3980 ansifmt(red,"%%%%%%%%%%%%%%%%%%%%%%%%%%% find log_failure_red in srcs %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n"), 3981 ansifmt(yellow,"%%%%%%%%%%%%%%%%%%%%%%%%%%% find log_failure_red in srcs %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n")))).
3987:- thread_local(t_l:no_breaks/0). 3988with_no_breaks(G):- locally_tl(no_breaks,G). 3989 3990break_ex:- quietly((log_failure_red,dumpST,log_failure_red)), 3991 (t_l:no_breaks -> ansifmt(red,"NO__________________DUMP_BREAK/0") ;dbreak). 3992 3993maybe_mpred_break(Info):- (t_l:no_breaks->true;(debugging(logicmoo(pfc))->dtrace(dmsg_pretty(Info));(dmsg_pretty(Info)))),break_ex. 3994%maybe_mpred_break(Info):- (t_l:no_breaks->true;(debugging(logicmoo(pfc))->dtrace(dmsg_pretty(Info));(dmsg_pretty(Info)))),break_ex. 3995 3996% if the correct flag is set, dtrace exection of Pfc 3997mpred_trace_msg(_):- current_prolog_flag(mpred_pfc_silent,true). 3998mpred_trace_msg(Info):- not_not_ignore_quietly_ex(((((clause_asserted_u(mpred_is_tracing_exec);tracing)->(show_wdmsg(Info));true)))). 3999mpred_trace_msg(Format,Args):- not_not_ignore_quietly_ex((((clause_asserted_u(mpred_is_tracing_exec);tracing)-> (show_wdmsg(Format,Args))))),!. 4000% mpred_trace_msg(Format,Args):- not_not_ignore_quietly_ex((((format_to_message(Format,Args,Info),mpred_trace_msg(Info))))). 4001 4002show_wdmsg(A,B):- current_prolog_flag(mpred_pfc_silent,true)-> true; wdmsg_pretty(A,B). 4003show_wdmsg(A):- current_prolog_flag(mpred_pfc_silent,true)-> true; wdmsg_pretty(A). 4004 4005mpred_warn(Info):- not_not_ignore_quietly_ex((((color_line(red,1), lookup_u(mpred_warnings(true));tracing) -> 4006 wdmsg_pretty(warn(logicmoo(pfc),Info)) ; mpred_trace_msg('WARNING/PFC: ~p ',[Info])), 4007 nop(maybe_mpred_break(Info)))). 4008 4009mpred_warn(Format,Args):- not_not_ignore_quietly_ex((((format_to_message(Format,Args,Info),mpred_warn(Info))))). 4010 4011mpred_error(Info):- not_not_ignore_quietly_ex(((tracing -> wdmsg_pretty(error(logicmoo(pfc),Info)) ; mpred_warn(error(Info))))). 4012mpred_error(Format,Args):- not_not_ignore_quietly_ex((((format_to_message(Format,Args,Info),mpred_error(Info))))). 4013 4014mpred_pfc_silent(TF):-set_prolog_flag(mpred_pfc_silent,TF). 4015 4016 4017mpred_watch:- mpred_trace_exec,mpred_pfc_silent(false). 4018mpred_nowatch:- mpred_notrace_exec. 4019 4020mpred_trace_exec:- assert_u_no_dep(mpred_is_tracing_exec),mpred_pfc_silent(false). 4021mpred_notrace_exec:- retractall_u(mpred_is_tracing_exec). 4022 4023mpred_trace_all:- mpred_trace_exec,mpred_trace,mpred_set_warnings(true),mpred_pfc_silent(false). 4024mpred_notrace_all:- mpred_notrace_exec,mpred_notrace,mpred_set_warnings(false). 4025 4026 4027:- thread_local(t_l:hide_mpred_trace_exec/0).
4034% with_mpred_trace_exec(P):- locally_each(-t_l:hide_mpred_trace_exec,locally_each(t_l:mpred_debug_local, must_ex(show_if_debug(P)))). 4035 4036with_mpred_trace_exec(P):- lookup_u(mpred_is_tracing_exec),!,show_if_debug(P). 4037with_mpred_trace_exec(P):- 4038 locally_each(-t_l:hide_mpred_trace_exec, 4039 locally_each(t_l:mpred_debug_local, 4040 must_ex(show_if_debug(P)))).
4047with_no_mpred_trace_exec(P):-
4048 with_no_dmsg((
4049 locally_each(-t_l:mpred_debug_local,locally_each(t_l:hide_mpred_trace_exec, must_ex(/*show_if_debug*/(P)))))).4055:- meta_predicate(show_if_debug()). 4056% show_if_debug(A):- !,show_call(why,A). 4057show_if_debug(A):- get_mpred_is_tracing(A) -> show_call(mpred_is_tracing,call_u(A)) ; call_u(A). 4058 4059:- thread_local(t_l:mpred_debug_local/0).
4065mpred_is_silent :- t_l:hide_mpred_trace_exec,!, \+ tracing. 4066mpred_is_silent :- quietly_ex(( \+ t_l:mpred_debug_local, \+ lookup_u(mpred_is_tracing_exec), \+ lookup_u(lmcache:mpred_is_spying_pred(_,_)), 4067 current_prolog_flag(debug,false), is_release)) ,!. 4068 4069oinfo(O):- xlisting((O, - spft, - ( ==> ), - pt , - nt , - bt , - mdefault, - lmcache)). 4070 4071mpred_must(\+ G):-!, ( \+ call_u(G) -> true ; (log_failure(failed_mpred_test(\+ G)),!,ignore(why_was_true(G)),!,break_ex)). 4072mpred_must(G):- (call_u(G) -> true ; (ignore(sanity(why_was_true(\+ G))),(log_failure(failed_mpred_test(G))),!,break_ex)). 4073 4074 4075mpred_load_term(:- module(_,L)):-!, call_u_no_bc(maplist(export,L)). 4076mpred_load_term(:- TermO):- call_u_no_bc(TermO). 4077mpred_load_term(TermO):-mpred_ain_object(TermO). 4078 4079 4080% 4081% These control whether or not warnings are printed at all. 4082% mpred_warn. 4083% nompred_warn. 4084% 4085% These print a warning message if the flag mpred_warnings is set. 4086% mpred_warn(+Message) 4087% mpred_warn(+Message,+ListOfArguments) 4088% 4089 4090mpred_warn:- 4091 retractall_u(mpred_warnings(_)), 4092 assert_u_no_dep(mpred_warnings(true)). 4093 4094nompred_warn:- 4095 retractall_u(mpred_warnings(_)), 4096 assert_u_no_dep(mpred_warnings(false)).
4103mpred_set_warnings(True):- 4104 retractall_u(mpred_warnings(_)), 4105 assert_u_no_dep(mpred_warnings(True)). 4106mpred_set_warnings(false):- 4107 retractall_u(mpred_warnings(_)).
Get a key from the trigger that will be used as the first argument of the trigger base clause that stores the trigger.
4117mpred_trigger_key(X,X):- var(X), !. 4118mpred_trigger_key(pt(Key,_),Key). 4119mpred_trigger_key(pk(Key,_,_),Key). 4120mpred_trigger_key(nt(Key,_,_),Key). 4121mpred_trigger_key(Key,Key). 4122 4123% For chart parser 4124mpred_trigger_key(chart(word(W),_ZL),W):- !. 4125mpred_trigger_key(chart(stem([Char1|_ZRest]),_ZL),Char1):- !. 4126mpred_trigger_key(chart(Concept,_ZL),Concept):- !. 4127mpred_trigger_key(X,X). 4128 4129 4130:-module_transparent(mpred_ain/1). 4131:-module_transparent(mpred_aina/1). 4132:-module_transparent(mpred_ainz/1). 4133:-system:import(mpred_ain/1). 4134:-system:import(mpred_ain/2). 4135 4136/* 4137:-module_transparent(mpred_ain/1). 4138:-module_transparent(mpred_aina/1). 4139:-module_transparent(mpred_ainz/1). 4140*/ 4141 4142% :- '$current_source_module'(M),forall(mpred_database_term(F,A,_),(abolish(pfc_lib:F/A),abolish(user:F/A),abolish(M:F/A))). 4143% :- initialization(ensure_abox(baseKB)). 4144 4145 4146% % :- set_prolog_flag(mpred_pfc_file,true). 4147% local_testing 4148 4149:- set_prolog_flag(expect_pfc_file,never). 4150 4151:- fixup_exports. 4152 4153% :- kb_shared(lmcache:mpred_is_spying_pred/2).