1/*  
    2% ===================================================================
    3% File 'dbase_c_term_expansion'
    4% Purpose: Emulation of OpenCyc for SWI-Prolog
    5% Maintainer: Douglas Miles
    6% Contact: $Author: dmiles $@users.sourceforge.net ;
    7% Version: 'interface' 1.0.0
    8% Revision:  $Revision: 1.9 $
    9% Revised At:   $Date: 2002/06/27 14:13:20 $
   10% ===================================================================
   11% File used as storage place for all predicates which change as
   12% the world is run.
   13%
   14% props(Obj,height(ObjHt))  == holds(height,Obj,ObjHt) == rdf(Obj,height,ObjHt) == height(Obj,ObjHt)
   15% padd(Obj,height(ObjHt))  == padd(height,Obj,ObjHt,...) == add(QueryForm)
   16% kretract[all](Obj,height(ObjHt))  == kretract[all](Obj,height,ObjHt) == pretract[all](height,Obj,ObjHt) == del[all](QueryForm)
   17% keraseall(AnyTerm).
   18%
   19% when deciding the setting for a pred in file foof.pl
   20%
   21%  foom:foo(1):-bar(2).
   22%
   23%      we search in this order:  SOURCE:LOADTYPE:PRED
   24%
   25% SOURCETYPE
   26%                  source_file('/dir/foof.pl')
   27%                  source_module(foom)
   28%                  source_user(ax)
   29%                  source_filetype(pl)
   30%                  source_caller(user)   % module it's being loaded for
   31%                  (missing)*
   32% LOADTYPE
   33%                  consult
   34%                  assert
   35%                  (missing)*
   36%                  
   37% CLAUSETYPE
   38%                  rule
   39%                  fact
   40%                  directive
   41%                  (missing)*
   42%                  
   43% PRED INDICATOR
   44%                  
   45%                  foo(int),
   46%                  foo/1
   47%                  foo,
   48%                  (:-)/2  % neck used
   49%                  (missing)*
   50%
   51%
   52%
   53% clause types: (:-)/1, (:-)/2, (=>)/1,  (=>)/2,  (==>)/1,  (==>)/2, (<-)/1,  (<-)/2, (<==>)/2, fact/1
   54%
   55*/
   56% :- if(( ( \+ ((current_prolog_flag(logicmoo_include,Call),Call))) )).
   57module_mpred_expansion:- fail, nop(module(mpred_expansion,
   58          [ a/2,
   59            acceptable_xform/2,
   60            additiveOp/1,
   61            alt_calls/1,
   62            any_op_to_call_op/2,
   63            as_is_term/1,as_is_term/1,
   64            as_list/2,
   65            cheaply_u/1,
   66            cheaply_u/1,
   67            maybe_prepend_mt/3,
   68            compare_op/4,
   69            comparitiveOp/1,
   70            compound_all_open/1,
   71            conjoin_l/3,
   72            try_expand_head/3,
   73            db_expand_0/3,
   74            db_expand_chain/3,
   75            db_expand_final/3,
   76            db_expand_maplist/5,
   77            db_op_sentence/4,
   78            db_op_simpler/3,
   79            db_quf/4,
   80            db_quf_l/5,
   81            db_quf_l_0/5,
   82            default_te/3,
   83            demodulize/3,
   84            remodulize/3,
   85            replaced_module/3,
   86            fully_expand_into_cache/3,
   87            do_expand_args/3,
   88            do_expand_args_l/3,
   89            do_expand_args_pa/4,
   90            ex_argIsa/3,
   91            exact_args/1,
   92            exact_args0/1,
   93            expand_isEach_or_fail/2,
   94            expand_goal_correct_argIsa/2,
   95            expand_props/3,
   96            expand_props/4,
   97            expanded_different/2,
   98            expanded_different_1/2,
   99            expanded_different_ic/2,
  100            %expands_on/2,
  101            fix_negations/2,
  102            fixed_negations/2,
  103            fixed_syntax/2,
  104            foreach_arg/7,
  105            from_univ/4,
  106            fully_expand/2,            
  107            fully_expand/3,
  108            fully_expand_clause/3,
  109            fully_expand_goal/3,
  110            fully_expand_head/3,
  111            fully_expand_into_cache/3,
  112            fully_expand_real/3,
  113            fully_expand_into_cache/3,
  114            %full_transform_warn_if_changed_UNUSED/3,
  115            functor_declares_collectiontype/2,
  116            functor_declares_instance/2,
  117            functor_declares_instance_0/2,
  118            holds_args/2,
  119            %if_expands_on/3,
  120            infix_op/2,
  121            instTypePropsToType/2,
  122            into_functor_form/3,
  123            into_functor_form/5,
  124            into_mpred_form/2,
  125            into_mpred_form6/6,
  126            into_mpred_form_ilc/2,
  127            is_arity_pred/1,
  128            is_meta_functor/3,
  129            is_pred_declarer/1,
  130            is_relation_type/1,
  131            is_stripped_module/1,
  132            is_unit/1,
  133			is_unit_like/1,
  134                        post_expansion/3,
  135            is_unit_functor/1,
  136            listToE/2,
  137            map_f/2,
  138            mpred_expand_rule/2,
  139            should_expand/1,
  140            must_remodulize/3,
  141            recommify/2,
  142            recommify/3,
  143            reduce_clause/3,
  144            reduce_clause_from_fwd/3,
  145            show_doall/1,
  146            string_to_mws/2,
  147            simply_functors/3,
  148            to_reduced_hb/4,
  149            transform_functor_holds/5,
  150            transform_holds/3,
  151            transform_holds_3/3,
  152            transitive_lc_nr/3,
  153            translate_args/9,
  154            translateListOps/8,
  155            translateOneArg/8,
  156            was_isa_ex/3,
  157
  158          mpred_expansion_file/0,
  159          expand_kif_string/2,
  160         temp_comp/4,
  161         get_ruleRewrite/2,
  162         expand_kif_string_or_fail/3,
  163         to_predicate_isas/2,
  164         append_as_first_arg/3,
  165         try_expand_head/3,
  166         expand_isEach_or_fail/2,
  167         % expand_kif_string/3,
  168         is_elist_functor/1
  169          
  170          ])).
  171
  172:- include('mpred_header.pi').  173
  174% :- endif.
  175
  176
  177:- meta_predicate 
  178   % mpred_expansion
  179   cheaply_u(+),
  180   cheaply_u(+),
  181   db_expand_maplist(2,*,*,*,*),
  182   % mpred_expansion
  183   transitive_lc_nr(2,*,*),
  184   simply_functors(2,*,*).  185          
  186
  187:- thread_local(t_l:disable_px/0).  188
  189
  190:- use_module(library(apply)).  191:- use_module(library(logicmoo/attvar_serializer)).  192
  193%= :- kb_shared(was_chain_rule/1).
  194%= :- kb_shared(baseKB:rtReformulatorDirectivePredicate/1).
  195%= :- kb_shared(props/2).
  196
  197:- dynamic(baseKB:col_as_isa/1).  198:- dynamic(baseKB:col_as_unary/1).  199
  200:- kb_shared(baseKB:wid/3).  201
  202:- style_check(+singleton).
 default_te(?IF, ?VAR, ?VAL) is semidet
Default Te.
  208default_te(IF,VAR,VAL):-assertz(te_setting(IF,VAR,VAL)).
  209
  210:- default_te([source_filetype(pl) ],use_te,file_prolog).  211:- default_te([source_filetype(pfc) ],use_te,file_pfc).  212:- default_te([source_filetype(console) ],use_te,file_prolog).  213
  214:- default_te(file_prolog,proccess_directive, proccess_directive).  215:- default_te(file_prolog,compile_clause, compile_clause).  216:- default_te(file_prolog,rule_neck, (head :- body)).  217:- default_te(file_prolog,fact_neck, (head :- true)).  218
  219:- default_te(file_pfc, compile_clause, ain).  220:- default_te(file_pfc, expand_clause, fully_expand_clause).  221:- default_te(file_pfc, proccess_directive, proccess_directive).  222:- default_te(file_pfc, fact_neck, (clause <- true)).
  223:- default_te(file_pfc, rule_neck, (head :- body)).  224
  225:- default_te(file_syspreds,isa_detector, always_fail(i,c)).  226:- default_te(file_syspreds,isa_holder, c(i)).  227:- default_te(file_syspreds,isa_varholder, (t(c,i))).  % was isa(i,c).
  228:- default_te(file_syspreds,pred_holder, head).  % was isa(i,c).
  229:- default_te(file_syspreds,pred_varholder,  univ_safe(newhead , [t,pred|args])).  230:- default_te(file_syspreds,proccess_directive, proccess_directive).  231:- default_te(file_syspreds,compile_clause, compile_clause).  232:- default_te(file_syspreds,rule_neck, (head :- body)).  233:- default_te(file_syspreds,fact_neck, (clause :- true)).  234:- default_te(file_syspreds, expand_clause, (=)).  235
  236:- default_te(file_syspreds:pred(*), neck_override, (cwc)).  237:- default_te(file_pfc:pred(*), neck_override, (hybrid)).  238:- default_te(file_prolog:pred(*), neck_override, (hybrid)).  239
  240:- default_te((:-)/1, compile_clause, proccess_directive).  241:- default_te((:-)/2, rule_neck, clause).  242:- default_te((=>),use_te, file_pfc).  243:- default_te((<==>),use_te, file_pfc).  244:- default_te((<-),use_te, file_pfc).  245
  246/*
  247% :- directive:  process_directive, call
  248% fact:  fwc(pfc), bwc(pfc), *cwc(prolog), bwc(pttp), implies(kif), other
  249% :- rule:  fwc(pfc), bwc(pfc), *cwc(prolog), bwc(pttp), implies(kif), other
  250% <- rule:   fwc(pfc), *bwc(pfc), cwc(prolog), bwc(pttp), implies(kif), other
  251% <= rule:   *fwc(pfc), bwc(pfc), cwc(prolog), bwc(pttp), implies(kif), other
  252% <- fact:   fwc(pfc), *bwc(pfc), cwc(prolog), bwc(pttp), implies(kif), other
  253% => fact:   *fwc(pfc), bwc(pfc), cwc(prolog), bwc(pttp), implies(kif), other
  254% loading:  compile_clause, process_directive, assertz, 
  255% head types: code, *hybrid, safe_functor(outer), holds(outer)
  256% body types: code, *hybrid, safe_functor(outer), holds(outer)
  257% isa holder:   isa(i,c), t(c,i),  *c(i).
  258% isa holder is_ftVar c:   isa(i,c), *t(c,i).
  259% varpred_head:  *t(P,A,B).
  260% varpred_body:  *t(P,A,B).
  261% body types: code, *hybrid, safe_functor(outer), holds(outer)
  262
  263Interestingly there are three main components I have finally admit to needing despite the fact that using Prolog was to provide these exact components.  
  264First of all a defaulting system using to shadow (hidden) behind assertions
  265Axiomatic semantics define the meaning of a command in a program by describing its effect on assertions about the program state.
  266The assertions are logical statements - predicates with variables, where the variables define the state of the program.
  267Predicate transformer semantics to combine programming concepts in a compact way, before logic is realized.   
  268This simplicity makes proving the correctness of programs easier, using Hoare logic.
  269
  270Axiomatic semantics
  271Writing in Prolog is actually really easy for a MUD is when X is chosen
  272
  273%
  274% Dec 13, 2035
  275% Douglas Miles
  276*/
  277
  278%:-use_module(pfc_lib).
  279%:-use_module(mpred_type_wff).
  280
  281
  282% ============================================
  283% inital a/2 database
  284% ============================================
  285
  286% baseKB:hasInstance_dyn(W,SS):-nonvar(W),nonvar(SS),SS=isKappaFn(_,S),nonvar(S),!.
  287
  288
  289/*
  290disabled a(T,I):- not(current_predicate(deduce_M/1)),!,baseKB:hasInstance_dyn(T,I).
  291disabled a(T,I):- !, (mudIsa_motel(I,T) *-> true ; (((atom(I),must(not(baseKB:hasInstance_dyn(T,I)))),fail))).
  292disabled a(T,I):- rdf_x(I,rdf:type,T).
  293*/
  294:- system:op(700,xfx,('univ_safe')).
 a(?C, ?I) is nondet
A.
  300:- meta_predicate a(+,?).  301% WANT (but will loop) a(C,I):- !, quietly((atom(C),G  univ_safe  [C,I], no_repeats(call_u(G)))).
  302a(C,I):- quietly((atom(C),current_predicate(C/1), G  univ_safe  [C,I], no_repeats(lookup_u(G)))).
  303
  304
  305%=  :- was_export(alt_calls/1).
  306
  307%= 	 	 
 alt_calls(+Op) is semidet
Alt Calls.
  313alt_calls(call).
  314alt_calls(call_u).
  315alt_calls(clause_u).
  316alt_calls(lookup_u).
  317alt_calls(clause_asserted_i).
  318alt_calls(t).
  319alt_calls(is_entailed_u).
  320alt_calls(call_u).
  321alt_calls(ireq).
  322
  323
  324
  325:- meta_predicate compare_op(*,2,?,?).  326
  327
  328:- meta_predicate show_doall(0).  329
  330%= 	 	 
 show_doall(:Goal) is semidet
Show Doall.
  336show_doall(Call):- doall(show_call(why,Call)).
  337
  338
  339/*
  340Name               Meaning                            
  341
  342speed              speed of the runtime code
  343safety             run-time error checking            
  344
  345correct         run-time error correction            
  346
  347compilation-speed  speed of the compilation process   
  348debug              ease of debugging     
  349
  350
  351cheaply_u(G):- quickly(quietly(Goal)).
  352
  353*/
  354
  355% lookup_u/cheaply_u/call_u/clause_b
  356
  357cheaply_u(rtArgsVerbatum(G)):- !, clause_b(rtArgsVerbatum(G)).
  358cheaply_u(functorDeclares(F)):-!, clause_b(functorDeclares(F)).
  359cheaply_u(prologBuiltin(G)):- !,clause_b(prologBuiltin(G)).
  360cheaply_u(call(ereq,G)):- !,sanity(callable(G)),cheaply_u(G).
  361% cheaply_u(G):-!,call(G).
  362cheaply_u(G):- quietly(lookup_u(G)).
  363
  364%cheaply_u(G):- need_speed,!, (ground(G)->(quietly(baseKB:G),!);quietly(lookup_u(G))).
  365%cheaply_u(G):- loop_check(cheaply_u(G),loop_check_term(cheaply_u(G),ilc2(G),fail)).
  366%cheaply_u(G):- predicate_property(G,number_of_rules(N)),N=0,!,lookup_u(G).
  367%cheaply_u(G):- strip_module(G,_,C),G\==C,!,cheaply_u(C).
  368
  369
  370was_isa_ex(ISA,I,C):- if_defined(was_isa(ISA,I,C),fail).
  371%= 	 	 
 is_pred_declarer(?P) is semidet
If Is A Predicate Declarer.
  377is_pred_declarer(P):-functor_declares_instance(P,tPred).
  378
  379%= 	 	 
 is_relation_type(?P) is semidet
If Is A Relation Type.
  385is_relation_type(tRelation).
  386is_relation_type(tFunction).
  387is_relation_type(tPred).
  388is_relation_type(P):-is_pred_declarer(P).
  389
  390
  391%= 	 	 
 functor_declares_instance(?F, ?C) is semidet
Functor Declares Instance.
  397functor_declares_instance(F,C):- fail, functor_declares_instance_0(F,C0),!,C=C0. % , nop(sanity(F\=C0)).
  398
  399%= 	 	 
 functor_declares_instance_0(?P, ?P) is semidet
safe_functor declares instance Primary Helper.
  407functor_declares_instance_0(isa,_):-!,fail.
  408functor_declares_instance_0(props,_):-!,fail.
  409functor_declares_instance_0(F,F):- cheaply_u(functorDeclares(F)).
  410functor_declares_instance_0(F,F):- a(ttRelationType,F).
  411
  412:- if(false).  413functor_declares_instance_0(P,P):- arg(_,s(ttExpressionType,ttModuleType,tSet,ttTypeType,tFunction),P).
  414
  415functor_declares_instance_0(P,P):- arg(_,s(tCol,ftSpec),P).
  416functor_declares_instance_0(P,P):- 
  417  arg(_,s(tPred,prologMultiValued, prologOrdered,prologNegByFailure,prologHybrid,prologPTTP,prologSideEffects,
  418       predIsFlag,prologBuiltin,prologKIF,prologDynamic,prologListValued,prologSingleValued),P).
  419functor_declares_instance_0(P,P):- arg(_,s(predCanHaveSingletons,functorIsMacro),P).
  420% functor_declares_instance_0(P,P):- arg(_,s(mpred_isa),P),!,fail.
  421functor_declares_instance_0(col_as_isa,col_as_isa).
  422
  423functor_declares_instance_0(F,F):- between(2,5,A),arity_no_bc(F,A),!,fail.
  424functor_declares_instance_0(F,F):- arity_no_bc(F,A),A>5,!,fail.
  425
  426% functor_declares_instance_0(F,F):- arity_no_bc(F,1).
  427
  428functor_declares_instance_0(_,_):- !, fail.  % @TODO COMMENT THIS OUT
  429
  430% functor_declares_instance_0(COL,COL):- call_u(isa(COL,ttTypeType)).
  431functor_declares_instance_0(COL,COL):- call_u(isa(COL,tSet)).
  432functor_declares_instance_0(P,P):- isa_asserted(P,ttRelationType),!.
  433
  434functor_declares_instance_0(_,_):- !, fail.  % @TODO COMMENT THIS OUT
  435
  436% @TODO CONFIRM THIS IS WRONG functor_declares_instance_0(functorIsMacro,tRelation).
  437functor_declares_instance_0(P,ttRelationType):-isa_from_morphology(P,ttRelationType).
  438functor_declares_instance_0(P,tFunction):-isa_from_morphology(P,ftFunctional).
  439functor_declares_instance_0(P,tFunction):-isa_from_morphology(P,O)->O=tFunction.
  440%functor_declares_instance_0(COL,COL):- call_u(isa(COL,tCol)).
  441%functor_declares_instance_0(P,tCol):-isa_asserted(P,functorDeclares),\+functor_declares_instance_0(P,tPred).
  442
  443
  444
  445functor_adds_instance_0(decl_mpred,tPred).
  446functor_adds_instance_0(kb_shared,prologHybrid).
  447functor_adds_instance_0(kb_shared,prologHybrid).
  448functor_adds_instance_0(decl_mpred_prolog,prologBuiltin).
  449functor_adds_instance_0(decl_mpred_prolog,prologDynamic).
  450
  451% functor_adds_instance_0(meta_argtypes,tRelation).
  452
  453:- endif.  454
  455
  456% ========================================
  457% Logic Preds Shared
  458% ========================================
  459
  460%= %= :- was_export(is_svo_functor/1).
 is_svo_functor(?Prop) is semidet
If Is A Svo Functor.
  468is_svo_functor(Prop):- quietly((atom(Prop),arg(_,svo(svo,prop,valueOf,rdf),Prop))).
  469
  470%= %= :- was_export(hilog_functor/1).
 hilog_functor(?VALUE1) is semidet
Hilog Functor.
  478hilog_functor(true_t).
  479
  480%= %= :- was_export(is_holds_true_not_hilog/1).
 is_holds_true_not_hilog(?HOFDS) is semidet
If Is A Holds True Not Hilog.
  488is_holds_true_not_hilog(HOFDS):-is_holds_true(HOFDS),\+ hilog_functor(HOFDS).
  489
  490%= %= :- was_export(is_holds_true/1).
 is_holds_true(?Prop) is semidet
If Is A Holds True.
  498is_holds_true(Prop):- quietly((atom(Prop),is_holds_true0(Prop))),!.
  499
  500% k,p,..
  501
  502
  503is_holds_functor(F):- atom(F),is_holds_functor0(F),!, \+ isBodyConnective(F).
  504is_holds_functor0(F):- atom_concat('proven_',_,F).
  505is_holds_functor0(F):- atom_concat('ex_',_,F).
  506is_holds_functor0(F):- atom_concat(_,'_t',F).
  507is_holds_functor0(F):- is_2nd_order_holds(F).
  508
  509must_be_unqualified(_):-!.
  510must_be_unqualified(Var):- \+ compound(Var),!.
  511must_be_unqualified(Var):-strip_module(Var,_,O),Var\==O,!,break_ex.
  512must_be_unqualified(Var):-forall(arg(_,Var,E),must_be_unqualified(E)).
  513
  514
  515:- dynamic(isBodyConnective/1).
 isBodyConnective(?Funct) is semidet
If Is A Body Connective.
  522isBodyConnective(Funct):-atom_concat(_,'_',Funct),!.
  523isBodyConnective(Funct):-atom_concat('t~',_,Funct),!.
  524isBodyConnective(Funct):-atom_concat('f~',_,Funct),!.
  525isBodyConnective(Funct):-member(Funct,[and,or,until,',',';',':-',unless,xor,holdsDuring]). % Other Propositional Wrhtml_appers
 is_holds_true0(?Prop) is semidet
If Is A Holds True Primary Helper.
  534is_holds_true0(Prop):-arg(_,vvv(holds,holds_t,t,t,asserted_mpred_t,assertion_t,true_t,assertion,secondOrder,firstOrder),Prop).
  535
  536
  537% is_holds_true0(Prop):-atom_concat(_,'_t',Prop).
  538
  539%= %= :- was_export(is_2nd_order_holds/1).
 is_2nd_order_holds(?Prop) is semidet
If Is A 2nd Order Holds.
  547is_2nd_order_holds(Prop):- is_holds_true(Prop) ; is_holds_false(Prop).
  548
  549%= %= :- was_export(is_holds_false/1).
 is_holds_false(?Prop) is semidet
If Is A Holds False.
  557is_holds_false(Prop):-quietly((atom(Prop),is_holds_false0(Prop))).
 is_holds_false0(?Prop) is semidet
If Is A Holds False Primary Helper.
  566is_holds_false0(Prop):-member(Prop,[not,nholds,holds_f,mpred_f,aint,assertion_f,not_true_t,asserted_mpred_f,retraction,not_secondOrder,not_firstOrder]).
  567%is_holds_false0(Prop,Stem):-atom_concat('not_',Stem,Prop).
  568%is_holds_false0(Prop,Stem):-atom_concat('int_not_',Stem,Prop).
  569%is_holds_false0(Prop,Stem):-atom_concat(Stem,'_f',Prop).
  570%is_holds_false0(Prop):-is_holds_false0(Prop,Stem),is_holds_true0(Stem).
  571%is_holds_false0(Prop,Stem):-atom_concat(Stem,'_not',Prop).
  572%is_holds_false0(Prop,Stem):-atom_concat(Stem,'_false',Prop).
  573
  574
  575%= 	 	 
 with_assert_op_override(?Op, ?Call) is semidet
Using Assert Oper. Override.
  581with_assert_op_override(Op,Call):-locally_tl(assert_op_override(Op),Call).
  582
  583
  584
  585%= 	 	 
 functor_declares_collectiontype(+Op, ?VALUE2) is semidet
Functor Declares Collectiontype.
  591functor_declares_collectiontype(typeProps,ttTemporalType).
  592
  593
  594%= 	 	 
 instTypePropsToType(+Op, ?VALUE2) is semidet
Inst Type Props Converted To Type.
  600instTypePropsToType(instTypeProps,ttSpatialType222).
  601
  602
  603:- thread_local(t_l:into_goal_code/0).  604
  605
  606%= 	 	 
 reduce_clause(?Op, ?C, ?HB) is semidet
Reduce Clause.
  612reduce_clause(Op,C,HB):-must(nonvar(C)),quietly_must(demodulize(Op,C,CB)),CB\=@=C,!,reduce_clause(Op,CB,HB).
  613reduce_clause(_,C,C):- t_l:into_goal_code,!.
  614reduce_clause(Op,clause(C, B),HB):-!,reduce_clause(Op,(C :- B),HB).
  615reduce_clause(Op,(C:- B),HB):- is_true(B),!,reduce_clause(Op,C,HB).
  616reduce_clause(_,C,C).
 demodulize(?Op, ?H, ?HH) is semidet
Demodulize.
  624demodulize(_Op,H,H):-!.
  625demodulize(_Op,H,HH):- not_ftCompound(H),!,HH=H.
  626demodulize(Op,H,HHH):- strip_module(H,M,HH),H\==HH,old_is_stripped_module(M),!,demodulize(Op,HH,HHH).
  627demodulize(Op,[I|HL],[O|HHL]):- \+ is_list(HL), !, demodulize(Op,I,O),demodulize(Op,HL,HHL).
  628demodulize(Op,H,HH):- is_list(H),must_maplist(demodulize(Op),H,HH),!.
  629demodulize(Op,H,HH):- H  univ_safe  [F|HL],must_maplist(demodulize(Op),HL,HHL),HH  univ_safe  [F|HHL],!.
  630% lmcache:completely_expanded
  631
  632
  633
  634old_is_stripped_module(user).
  635old_is_stripped_module(baseKB).
  636%= 	 	 
 to_reduced_hb(?Op, ?HB, ?HH, ?BB) is semidet
Converted To Reduced Head+body.
  642to_reduced_hb(Op,HB,HH,BB):-reduce_clause(Op,HB,HHBB),expand_to_hb(HHBB,HH,BB).
  643
  644
  645/*
  646dbase_head_expansion(_,V,V ):-is_ftVar(V),!.
  647dbase_head_expansion(Op,H,GG):-correct_negations(Op,H,GG),!.
  648dbase_head_expansion(_,V,V).
  649*/
  650
  651% ================================================
  652% db_expand_maplist/3
  653% ================================================
  654
  655
  656%= 	 	 
 any_op_to_call_op(+Op, ?VALUE2) is semidet
Any Oper. Converted To Call Oper..
  662any_op_to_call_op(_,call(conjecture)).
  663
  664
  665%= 	 	 
 db_expand_maplist(:PRED2FE, ?List, ?T, ?G, ?O) is semidet
Database Expand Maplist.
  671db_expand_maplist(FE,[E],E,G,O):- !,call(FE,G,O).
  672db_expand_maplist(FE,[E|List],T,G,O):- copy_term(T+G,CT+CG),E=CT,!,call(FE,CG,O1),db_expand_maplist(FE,List,T,G,O2),conjoin_l(O1,O2,O).
  673db_expand_maplist(FE,List,T,G,O):-bagof(M, (member(T,List),call(FE,G,M)), ML),list_to_conjuncts(ML,O).
  674
  675
  676% ================================================
  677% fully_expand/3
  678%   SIMPLISTIC REWRITE (this is not the PRECANONICALIZER)
  679% ================================================
  680
  681
  682%= 	 	 
 should_expand(:TermG) is semidet
Must Be Successfull Expand.

TODO Maybe later? should_expand(G):- \+ skip_expand(G), arg(_,G,E),compound(E).

  689should_expand(G):- \+ compound(G),!,fail.
  690should_expand(_:G):- !,should_expand(G).
  691should_expand((G:-_)):- !,should_expand(G).
  692should_expand(G):- safe_functor(G,F,_),should_expand_f(F),!.
  693should_expand(G):- safe_functor(G,F,_),exact_args_f(F),!,fail.  % Will expand these only after evaluation
  694should_expand(G):- arg(A,G,C),(string(C);(compound(C),A==2)),!.
  695
  696
  697should_expand_f(kif).
  698should_expand_f(pkif).
  699should_expand_f('==>').
  700should_expand_f('~').
  701
  702should_expand_f(props).
  703should_expand_f(iprops).
  704should_expand_f(upprop).
  705should_expand_f(typeProps).
  706should_expand_f(mudLabelTypeProps).
  707should_expand_f(iprops).
  708should_expand_f(isa).
  709should_expand_f(t).
  710should_expand_f(isEach).
  711
  712% Collecton Hooks
  713should_expand_f(tPred).
  714should_expand_f(tFunction).
  715should_expand_f(tRelation).
  716should_expand_f(tCol).
  717should_expand_f(tSet).
  718should_expand_f(F):-atom_concat('tt',_,F).
  719should_expand_f(F):-atom_concat('rt',_,F).
  720
  721% Pred Impl Hooks
  722should_expand_f(singleValuedHybrid).
  723%should_expand_f(prologHybrid).
  724%should_expand_f(prologBuiltin).
  725%should_expand_f(prologDynamic).
  726should_expand_f(F):-atom_concat('prolog',_,F).
  727should_expand_f(F):-atom_concat('pddl',_,F).
  728should_expand_f(F):-atom_concat('pfc',_,F).
  729should_expand_f(F):-atom_concat('mpred_',_,F).
  730
  731
  732%= 	 	 
 full_transform_warn_if_changed_UNUSED(?A, ?B, ?O) is semidet
Fully Expand Warn.
  738full_transform_warn_if_changed_UNUSED(A,B,O):-
  739  must(fully_expand_real(A,B,C)),!,
  740  sanity(ignore(show_failure(why,same_terms(B,C)))),(O=C;must(sanity(ignore(show_failure(why,same_terms(O,C)))))),!.
  741
  742
  743
  744
  745:- export(fully_expand/3).  746
  747
  748:- export(fully_expand/2).  749
  750%= 	 	 
Fully Expand.
  756fully_expand(X,Y):- must((fully_expand(clause(unknown,cuz),X,Y))).
  757
  758%:- mpred_trace_nochilds(fully_expand/3).
  759
  760
  761
  762%% fully_expand( ++Op, ^Sent, --SentO) is det.
  763%
  764% Fully Expand.
  765%
  766%  Op = the type of operation we are expanding for.. currently there are
  767%  change(_,_) - for inclusion and testing of present in plain prolog
  768%  query(_,_) - for call/ask that is dirrectly runnable
  769%  pfc(_,_) - for salient language based analysis at a human level
  770%
  771
  772
  773%fully_expand(_,Var,Var):- \+ compound(Var),!.
  774%fully_expand(Op,Sent,SentO):- safe_functor(Sent,F,A),should_fully_expand(F,A),!,must(fully_expand_real(Op,Sent,SentO)),!.
  775fully_expand(Op,Sent,SentO):- quietly(fully_expand_real(Op,==>Sent,SentO)),!.
  776% fully_expand(Op,Sent,Sent):- sanity((ignore((fully_expand_real(Op,Sent,SentO)->sanity((Sent=@=SentO)))))).
  777
  778/*
  779fully_expand(Op,Sent,SentO):- must(fully_expand_real(Op,Sent,SentO)),!,
  780   fully_expand_check(Op,Sent,SentO).
  781
  782fully_expand_check(_Op,Sent,SentO):- Sent=@=SentO.
  783fully_expand_check(Op,Sent,SentO):- break,throw(fully_expand_real(Op,Sent,SentO)).
  784
  785*/
  786/*
  787should_fully_expand(~,1).
  788should_fully_expand(==>,_).
  789should_fully_expand(props,2).
  790should_fully_expand(t,_).
  791should_fully_expand(ereq,_).
  792should_fully_expand(arity,2).
  793should_fully_expand(F,_):-clause_b(functorIsMacro(F)).
  794should_fully_expand(F,_):-clause_b(functorDeclares(F)).
  795*/
  796
  797:- meta_predicate memoize_on_local(*,*,0).  798memoize_on_local(_Why,_,Goal):- call(Goal),!.
  799% memoize_on_local(_Why,Sent->SentO,Goal):- memoize_on(fully_expand_real,Sent->SentO,Goal).
  800
  801has_skolem_attrvars(Sent):- quietly((term_attvars(Sent,Attvars),member(Var,Attvars),get_attr(Var,skk,_))),!.
  802
  803
  804% for trace testing
  805fully_expand_real(X,Y):- must((fully_expand_real(clause(unknown,cuz),X,Y))).
  806
  807
  808
  809fully_expand_real(_Op,Sent,SentO):- \+ compound(Sent),!,Sent=SentO.
  810fully_expand_real(Op,isa(I,C),SentO):- !,fully_expand_real_2(Op,isa(I,C),SentO).
  811fully_expand_real(Op,==>(Sent),SentO):- !,fully_expand_real_2(Op,Sent,SentO).
  812fully_expand_real(Op,==>(SentA,SentB),SentOO):- !,fully_expand_real_2(Op,==>(SentA,SentB),SentOO).
  813fully_expand_real(Op,mudKeyword(SentA,SentB),SentOO):- !,fully_expand_real_2(Op,mudKeyword(SentA,SentB),SentOO).
  814fully_expand_real(Op,<==>(SentA,SentB),SentOO):- !,fully_expand_real_2(Op,<==>(SentA,SentB),SentOO).
  815fully_expand_real(Op,(Sent/I),(SentO/O)):- !,fully_expand_real_2(Op,Sent,SentO),fully_expand_goal(Op,I,O).
  816fully_expand_real(_Op,{}(IC),{}(IC)):- !.
  817fully_expand_real(Op,Sent,SentO):- safe_functor(Sent,F,A),always_quite_expand_fa(F,A),!,fully_expand_real_2(Op,Sent,SentO).
  818fully_expand_real(Op,(SentA,SentB),(SentAA,SentBB)):- !,
  819  fully_expand_real(Op,SentA,SentAA),fully_expand_real(Op,SentB,SentBB).
  820fully_expand_real(Op,SentI,SentO):- maybe_expand_reduce(Op,SentI,Sent),!,
  821   fully_expand_real_2(Op,Sent,SentO),!,
  822   (Sent=@=SentO-> true ;            
  823     (SentI \=@= Sent -> true ; 
  824       show_expansion("~N-----++",Op,Sent,SentO))).
  825fully_expand_real(_Op,Sent,Sent):- current_prolog_flag(runtime_speed,3),!.
  826fully_expand_real(_Op,Sent,Sent):- current_prolog_flag(runtime_safety,0),!.
  827fully_expand_real(_Op,(H:-B),(H:-B)):-!.
  828
  829fully_expand_real(Op,Sent,SentO):- !, fully_expand_real_2(Op,Sent,SentO),!.
  830fully_expand_real(Op,Sent,SentO):-
  831  fully_expand_real_2(Op,Sent,SentO),!,
  832  (Sent=@=SentO-> true ; 
  833    (dumpST,show_expansion("~N<!--BREAK-ERROR--->",Op,Sent,SentO),nop(break))).
  834
  835show_expansion(Prefix,Op,Sent,SentO):-dmsg_pretty(Prefix),dmsg_pretty(-->(Op)),dmsg_pretty(Sent),dmsg_pretty(-->),dmsg_pretty(SentO),!.
  836
  837fully_expand_real_2(Op,Sent,SentO):- has_skolem_attrvars(Sent),!,
  838   gripe_time(0.2,
  839    (must_det(quietly(serialize_attvars(Sent,SentI))),
  840      sanity(\+ has_skolem_attrvars(SentI)),
  841     must_det(fully_expand_real_3(Op,SentI,SentO)),!)),!.
  842fully_expand_real_2(Op,Sent,SentO):- fully_expand_real_3(Op,Sent,SentO).
  843
  844fully_expand_real_3(Op,Sent,SentO):-
  845   gripe_time(0.2,
  846    must_det(locally_tl(disable_px,
  847       (locally(local_override(no_kif_var_coroutines,true),
  848       (must_det(fully_expand_into_cache(Op,Sent,SentIO)),
  849                   must_det(quietly(maybe_deserialize_attvars(SentIO,SentO))))))))).
  850
  851
  852maybe_expand(_Op,C,_):- \+ compound(C),!,fail.
  853maybe_expand(Op,M:P,M:PP):-!,maybe_expand(Op,P,PP).
  854maybe_expand(_Op,C,_):- compound_name_arity(C,_,0),!,fail.
  855maybe_expand(_Op,P,_):- var(P),!,fail.
  856maybe_expand(Op,P,P):-maybe_expand_p(Op,P),!.
  857
  858
  859maybe_expand_reduce(_Op,==>(P),P).
  860maybe_expand_reduce(_Op,expand(P),P).
  861maybe_expand_reduce(_Op,Sent,Sent):- safe_functor(Sent,F,_), clause_b(rtSymmetricBinaryPredicate(F)).
  862
  863
  864maybe_expand_p( Op, H:-_ ):- !, maybe_expand_p(Op,H).
  865maybe_expand_p(_Op,==>(_,_)).
  866maybe_expand_p(_Op,mudKeyword(_,_)).
  867maybe_expand_p(_Op,isa(_,_)).
  868maybe_expand_p(_Op,(_/_)).
  869maybe_expand_p(_Op,(_,_)).
  870maybe_expand_p(_Op,P):- safe_functor(P,F,A),!,always_quite_expand_fa(F,A).
  871
  872always_quite_expand_fa(F,1):- maybe_expand_f(F).
  873always_quite_expand_fa(F,2):- clause_b(rtSymmetricBinaryPredicate(F)).
  874always_quite_expand_fa(t,_).
  875%always_quite_expand_fa(F,2):- should_expand_f(F).
  876
  877maybe_expand_f(meta_argtypes).
  878maybe_expand_f(functorIsMacro).
  879maybe_expand_f(tPred).
  880maybe_expand_f(t).
  881maybe_expand_f(ttExpressionType).
  882maybe_expand_f(prologHybrid).
  883maybe_expand_f(prologBuiltin).
  884maybe_expand_f(prologSingleValued).
  885maybe_expand_f(prologHybrid).
  886maybe_expand_f(singleValuedHybrid).
  887maybe_expand_f(prologSideEffects).
  888maybe_expand_f(prologMultiValued).
  889%maybe_expand_f(F):- should_expand_f(F).
  890
  891
  892maybe_deserialize_attvars(X,Y):- current_prolog_flag(expand_attvars,true) 
  893  -> deserialize_attvars(X,Y) ; X=Y.
  894%maybe_deserialize_attvars(X,X):-!.
  895
  896
  897/*
  898fully_expand_real(Op,Sent,SentO):-
  899   gripe_time(0.2,
  900    (quietly(maybe_deserialize_attvars(Sent,SentI)),
  901     locally_tl(disable_px,
  902       locally(local_override(no_kif_var_coroutines,true),
  903       fully_expand_into_cache(Op,SentI,SentO))))),!.
  904*/ 
 is_stripped_module(+Op) is semidet
Is a stripped Module (Meaning it will be found via inheritance)
  910is_stripped_module(A):-var(A),!,fail.
  911is_stripped_module(Mt):- call_u(mtExact(Mt)),!,fail.
  912%is_stripped_module(Inherited):-'$current_source_module'(E), default_module(E,Inherited).
  913%is_stripped_module(Inherited):-'$current_typein_module'(E), default_module(E,Inherited).
  914is_stripped_module(abox).
  915% is_stripped_module(_):-!,fail.
  916% is_stripped_module(baseKB).
  917% is_stripped_module(A):- defaultAssertMt(AB),!,AB=A.
Expand isEach/Ns.
  925expand_isEach_or_fail(==>(Sent),SentO):- expand_isEach_or_fail_real(Sent,SentO),!.
  926expand_isEach_or_fail(Sent,SentO):- expand_isEach_or_fail_real(Sent,SentO),!,throw(expand_isEach_or_fail(Sent)).
  927
  928expand_isEach_or_fail_real(Sent,SentO):- compound(Sent),
  929    \+ (Sent  univ_safe  [_,I],atomic(I)), bagof(O,do_expand_args(isEach,Sent,O),L),!,L\=@=[Sent],SentO=L,!.
  930expand_isEach_or_fail_conj(Sent,SentO):- expand_isEach_or_fail_real(Sent,SentM),list_to_conj(SentM,SentO).
 expand_kif_string_or_fail(++Op, ++Sent, --SentO) is semidet
Expand if String of KIF.
  935expand_kif_string_or_fail(_Why,I,O):- string(I), 
  936   locally(t_l:sreader_options(logicmoo_read_kif,true),
  937     ((input_to_forms(string(I),Wff,Vs)->
  938   put_variable_names(Vs) ->
  939   if_defined(sexpr_sterm_to_pterm(Wff,PTerm),Wff=PTerm)->
  940   PTerm\=@=I -> 
  941   O=PTerm))).
  942
  943
  944expand_kif_string(I,O):- any_to_string(I,S), string(S),
  945  locally(t_l:sreader_options(logicmoo_read_kif,true),input_to_forms(string(S),O,Vs))->
  946  put_variable_names(Vs).
 fully_expand_clause(++Op, :TermSent, --SentO) is det
Fully Expand Clause.
  954:- dynamic(lmcache:completely_expanded/2).
Fully Expand Now.
  959fully_expand_into_cache(Op,Sent,SentO):- \+ ground(Sent),!,fully_expand_clause_catch_each(Op,Sent,SentO),!.
  960fully_expand_into_cache(_,Sent,SentO):- lmcache:completely_expanded(_,Sent),!,SentO=Sent.
  961fully_expand_into_cache(_,Sent,SentO):- lmcache:completely_expanded(Sent,SentO),!.
  962fully_expand_into_cache(Op,Sent,SentO):- 
  963 fully_expand_clause_catch_each(Op,Sent,SentO),!,
  964         asserta(lmcache:completely_expanded(Sent,SentO)),!.
  965fully_expand_into_cache(Op,Sent,SentO):- 
  966 trace,break,
  967  (fully_expand_clause_catch_each(Op,Sent,SentO)),
  968         asserta(lmcache:completely_expanded(Sent,SentO)),!.
  969% fully_expand_clause_catch_each(change(assert, ain), arity(functorDeclares, 1), _32410)
  970
  971
  972fully_expand_clause_catch_each(Op,Sent,SentO):-
  973  catch(fully_expand_clause(Op,Sent,SentO),
  974       hasEach,
  975      (must(expand_isEach_or_fail_conj(Sent,SentM)),
  976       must(fully_expand_real(Op,SentM,SentO)))),!.
  977/*
  978
  979fully_expand_into_cache(Op,Sent,SentO):- term_variables(Sent,SentV),copy_term(Sent-SentV,SentI-SentIV),
  980                             numbervars(SentI,311,_),fully_expand_clause_now1a(Op,SentI,SentV-SentIV,Sent,SentO),!.
  981
  982:- dynamic(completely_expanded_v/3).
  983subst_All(B,[],_R,B):-!.
  984subst_All(B,[F|L],R,A):-subst(B,F,R,M),subst_All(M,L,R,A).
  985
  986fully_expand_clause_now1a(_Op,SentI,_,Sent,SentO):- completely_expanded_v(_,SentI),!,SentO=Sent.
  987
  988%  p(A,B).  p(1,2).   ==>  q(2,1).   q(B,A)      SentV-SentIV,   [1,2],[A,B]  % substAll(p(1,2),[1,2],[A,B],O).
  989fully_expand_clause_now1a(Op,SentI,SentV-SentIV,_Sent,SentO):- lmcache:completely_expanded(SentI,SentOM),!,subst_All(SentOM,SentIV,SentV,SentO).
  990fully_expand_clause_now1a(Op,SentI,_,_Sent,SentO):- fully_expand_into_cache(Op,SentI,SentO),
  991         asserta(lmcache:completely_expanded(SentI,SentO)).
  992
  993% fully_expand_into_cache(Op,Sent,SentO):- expand_isEach_or_fail(Sent,SentM)->SentM\=@=Sent,!,must(fully_expand_clause(Op,SentM,SentO)).
  994% fully_expand_into_cache(Op,Sent,SentO):- fully_expand_clause(Op,Sent,SentO),!.
  995fully_expand_into_cache(Op,Sent,SentO):- memoize_on_local(fully_expand_clause,Sent->SentO,(fully_expand_clause(Op,Sent,SentM),
  996  % post_expansion(Op,SentM,SentO)
  997  SentM=SentO
  998  )),!.
  999*/
 1000
 1001
 1002post_expansion(Op,Sent,SentO):- 
 1003   do_renames_expansion(Sent,SentM),!,
 1004   maybe_correctArgsIsa(Op,SentM,SentO),!.
 1005
 1006% 
 1007do_renames_expansion(Sent,Sent):- \+ current_prolog_flag(do_renames,mpred_expansion),!.
 1008do_renames_expansion(Sent,SentM):- if_defined(do_renames(Sent,SentM),=(Sent,SentM)).
 1009
 1010maybe_correctArgsIsa(_ ,SentO,SentO):-!.
 1011maybe_correctArgsIsa(Op,SentM,SentO):- locally_tl(infMustArgIsa,correctArgsIsa(Op,SentM,SentO)),!.
 1012
 1013fully_expand_clause(Op,Sent,SentO):- sanity(is_ftNonvar(Op)),sanity(var(SentO)),var(Sent),!,Sent=SentO.
 1014fully_expand_clause(Op,'==>'(Sent),(SentO)):-!,fully_expand_clause(Op,Sent,SentO),!.
 1015fully_expand_clause(Op,'=>'(Sent),(SentO)):-!,fully_expand_clause(Op,Sent,SentO),!.
 1016fully_expand_clause(Op,(B,H),Out):- !,must((fully_expand_clause(Op,H,HH),fully_expand_clause(Op,B,BB))),!,must(Out=(BB,HH)).
 1017fully_expand_clause(Op,Sent,SentO):- is_list(Sent),!,must_maplist(fully_expand_clause(Op),Sent,SentO).
 1018% fully_expand_clause(_,(:-(Sent)),(:-(Sent))):-!.
 1019fully_expand_clause(Op,':-'(Sent),Out):-!,fully_expand_goal(Op,Sent,SentO),!,must(Out=':-'(SentO)).
 1020
 1021fully_expand_clause(_,Sent,SentO):- t_l:infSkipFullExpand,!,must(Sent=SentO).
 1022
 1023% fully_expand_clause(Op,Sent,SentO):- \+ compound(Sent),!,must(fully_expand_head(Op,Sent,SentO)).
 1024fully_expand_clause(_,aNoExpansionFn(Sent),Sent):- !.
 1025fully_expand_clause(Op,aExpansionFn(Sent),SentO):- fully_expand_clause(Op,Sent,SentO).
 1026fully_expand_clause(Op,M:Sent,SentO):- is_stripped_module(M),!,fully_expand_clause(Op,Sent,SentO).
 1027
 1028fully_expand_clause(Op,(B/H),Out):- !,fully_expand_head(Op,H,HH),fully_expand_goal(Op,B,BB),!,must(Out=(BB/HH)).
 1029
 1030% prolog_clause fully_expand_clause
 1031fully_expand_clause(Op, H :- B, HH :- B):- is_ftVar(B),!,fully_expand_head(Op,H,HH).
 1032
 1033fully_expand_clause(Op,Sent,SentO):- string(Sent),expand_kif_string_or_fail(Op,Sent,SentO),!.
 1034%covered fully_expand_clause(Op ,NC,NCO):- db_expand_final(Op,NC,NCO),!.
 1035fully_expand_clause(Op, HB, OUT):- 
 1036  to_reduced_hb(Op,HB,H,B) ->
 1037  (fully_expand_head(Op,H,HH) ->
 1038  (is_true(B) -> HH = OUT ;
 1039    ( must(fully_expand_goal(Op,B,BB)),
 1040      ((HH \= (_,_)) -> reduce_clause(Op,(HH:-BB),OUT) ;
 1041         reduce_clause(Op,(H:-BB),OUT))))).
 1042
 1043
 1044:- thread_local(t_l:into_form_code/0).
Fully Expand Goal.
 1050fully_expand_goal(change(assert,_),Sent,SentO):- var(Sent),!,SentO=call_u(Sent).
 1051fully_expand_goal(Op,Sent,SentO):- 
 1052 must((
 1053  locally_tl(into_goal_code,locally(t_l:into_form_code,fully_expand_head(Op,Sent,SentM))),
 1054    recommify(SentM,SentO))).
 1055
 1056/*
 1057
 1058?- recommify((a,{((b,c),d)},e),O).
 1059O =  (a, {b, c, d}, e).
 1060
 1061?- recommify((a,{((b,c),d)},e),O).
 1062O =  (a, {b, c, d}, e).
 1063
 1064?- recommify((a,(b,c,d),e),O).
 1065O =  (a, b, c, d, e).
 1066
 1067?- recommify((a,(b,c),(d,e)),O).
 1068O =  (a, b, c, d, e).
 1069
 1070?- recommify((a,(b,c),(true,e)),O).
 1071O =  (a, b, c, e).
 1072
 1073?- recommify((((a0,a),(b,c)),(true,d,e)),O),portray_clause((h:-O)).
 1074O =  (a0, a, b, c, d, e).
 1075
 1076?- recommify((a,(b,c),call((true,e)),true),O).
 1077O =  (a, b, c, call(e)).
 1078
 1079*/
 1080
 1081recommify(A,AA):- \+ compound(A),!,AA=A.
 1082% recommify(A,A):-!.
 1083recommify(A,B):- recommify(true,A,B),!.
 1084
 1085recommify(A,B,C):- \+ compound(B),!,conjoin(A,B,C).
 1086recommify(A,(B,C),D):- \+ compound(B),!, conjoin(A,B,AB), recommify(AB,C,D).
 1087recommify(A,((X,B),C),D):- !, recommify(A,X,AX),recommify(AX,(B,C),D).
 1088recommify(A,(B,C),D):- !, conjoin(A,B,AB), recommify(AB,C,D).
 1089recommify(A,PredArgs,C):- PredArgs  univ_safe  [P|Args],maplist(recommify,Args,AArgs),B  univ_safe  [P|AArgs],conjoin(A,B,C),!.
 1090
 1091list_to_conj([], true).
 1092list_to_conj([C], C) :- !.
 1093list_to_conj([H|T], (H,C)) :-
 1094    list_to_conj(T, C).
 1095
 1096const_or_var(I):- \+ atom(I), (var(I);I='$VAR'(_);(atomic(I),\+ string(I))),!.
 1097
 1098:- export(as_is_term/1).
 as_is_term(:TermNC) is semidet
Converted To If Is A Term Primary Helper.
 1104as_is_term(NC):- cyclic_break(NC), const_or_var(NC),!.
 1105as_is_term(PARSE):-is_parse_type(PARSE),!,fail.
 1106as_is_term(NC):- compound(NC),!,NC  univ_safe  [F,A|R],as_is_term(F,A,R),!.
 1107
 1108as_is_term(F,_,_):- exact_args_f(F).
 1109as_is_term(F,I,[]):- !, (F==I;const_or_var(I)).
 1110% as_is_term(_,I,[C]):- C==I. % const_or_var(I),const_or_var(C),!.
 1111% covered  above as_is_term(CI):- CI  univ_safe  [C,I],C==I,!.
 1112
 1113% covered  as_is_term(P):-safe_functor(P,F,A),safe_functor(C,F,A),C=@=P,!. % all vars
 1114% covered  as_is_term(meta_argtypes(_)):-!.
 1115% covered  as_is_term(meta_argtypes_guessed(_)):-!.
 1116% covered  as_is_term(rtArgsVerbatum(Atom)):- !, \+ compound(Atom).
 1117as_is_term(ftListFn,_,[]):-!.
 1118as_is_term(arity,F,_):- atom(F).
 1119% covered  as_is_term(functorIsMacro(Atom)):- !, \+ compound(Atom).
 1120% covered  as_is_term(functorDeclares(Atom)):- !, \+ compound(Atom).
 1121% covered  above as_is_term('$VAR'(_)).
 1122% covered  above as_is_term(NC):-exact_args(NC),!.
 1123% covered  above as_is_term(NC):-loop_check(is_unit(NC)),!.
 1124% as_is_term(isa(I,C)):- \+ compound(I),atom(C), clause_asserted(baseKB:col_as_isa(C)),!.
 1125
 1126/*
 1127as_is_term((:),_,[NC]):-!,as_is_term(NC). 
 1128as_is_term(Op,_,[_]):- infix_op(Op,_).
 1129*/
 1130
 1131:- mpred_trace_none(as_is_term(_)). 1132:- '$set_predicate_attribute'(as_is_term(_), hide_childs, 1). 1133:- lock_predicate(as_is_term(_)). 1134
 1135%=  :- was_export(infix_op/2).
 1136
 1137%= 	 	 
 infix_op(?Op, ?VALUE2) is semidet
Infix Oper..
 1143infix_op(Op,_):-comparitiveOp(Op).
 1144infix_op(Op,_):-additiveOp(Op).
 1145
 1146%=  :- was_export(comparitiveOp/1).
 1147
 1148%= 	 	 
 comparitiveOp(+Op) is semidet
Comparitive Oper..
 1154comparitiveOp((\=)).
 1155comparitiveOp((\==)).
 1156% comparitiveOp((=)).
 1157comparitiveOp((=:=)).
 1158comparitiveOp((==)).
 1159comparitiveOp((<)).
 1160comparitiveOp((>)).
 1161comparitiveOp((=<)).
 1162comparitiveOp((>=)).
 1163
 1164%=  :- was_export(additiveOp/1).
 1165
 1166%= 	 	 
 additiveOp(+Op) is semidet
Additive Oper..
 1172additiveOp((is)).
 1173additiveOp((*)).
 1174additiveOp(+).
 1175additiveOp(-).
 1176additiveOp((/)).
 1177
 1178
 1179
 1180%= 	 	 
 is_unit(?C) is semidet
If Is A Unit.
 1186is_unit(A):-quietly(is_unit_like(A)).
 1187
 1188is_unit_like(A):- atomic(A),!.
 1189is_unit_like(C):-is_unit_like0(C).
 1190
 1191is_unit_like0(C):- var(C),!, dictoo:oo_get_attr(C,skk,_),!.
 1192is_unit_like0(C):- \+ compound(C),!.
 1193is_unit_like0(C):- C\='VAR'(_),C\='$VAR'(_),C\=(_:-_),C\=ftRest(_),C\=ftListFn(_),get_functor(C,F),is_unit_functor(F).
 1194
 1195
 1196
 1197%= 	 	 
 is_unit_functor(?F) is semidet
If Is A Unit Functor.
 1203is_unit_functor(F):- (\+ atom(F)),!,fail.
 1204is_unit_functor(F):-atom_concat('sk',_,F).
 1205is_unit_functor(F):-atom_concat(_,'Fn',F).
 1206
 1207
 1208%= 	 	 
Get Rule Rewrite.

TODO - remove the fail (added just to speed up testing and initial debugging)

 1215get_ruleRewrite(Sent,SentM):- fail, cheaply_u(ruleRewrite(Sent,SentM)).
 1216
 1217
 1218
 1219transitive_lc_nr(P,A,B):- call(P,A,B),!.
 1220transitive_lc_nr(_,A,A).
 1221%= 	 	 
 1222
 1223renamed_atom(F,FO):-atom(F),if_defined(best_rename(F,FO),fail),!.
 1224
 1225%% mpred_expand_rule( ?PfcRule, ?Out) is det.
 1226%
 1227% Managed Predicate Expand.
 1228%
 1229mpred_expand_rule(PfcRule,Out):- 
 1230   is_ftCompound(PfcRule),
 1231   safe_functor(PfcRule,F,A),
 1232   clause_b(mpred_database_term(F,A,_)),
 1233   PfcRule  univ_safe  [F|Args],maplist(fully_expand_goal(assert),Args,ArgsO),!,Out  univ_safe  [F|ArgsO].
 1234
 1235is_parse_type(Var):- \+ compound(Var),!,fail.
 1236is_parse_type('kif'(NV)):-nonvar(NV).
 1237is_parse_type('pkif'(NV)):-nonvar(NV).
 db_expand_final(+Op, +TermNC, ?NC) is semidet
Database Expand Final.
 1245string_to_mws_2(NC,NG):- \+ ground(NC),!, NG=NC.
 1246string_to_mws_2([String,A|B],OUT):- is_list(B),!,OUT  univ_safe  [s,String,A|B].
 1247string_to_mws_2([String],String):-!.
 1248string_to_mws_2(String,String).
 1249
 1250
 1251string_to_mws(NC,NCO):- string(NC),!,convert_to_cycString(NC,NCM),string_to_mws_2(NCM,NCO).
 1252string_to_mws(NC,_):- \+ compound(NC),!,fail.
 1253string_to_mws(NC,NO):- safe_functor(NC,s,_),!,NO=NC.
 1254string_to_mws([String],NCO):-string(String),!,must((convert_to_cycString(String,NCM),string_to_mws_2(NCM,NCO))).
 1255
 1256string_to_mws([String,A|B],OUT):- (string(String);string(A)),!,must((string_to_mws_2([String,A|B],OUT))).
 1257%MAYBE string_to_mws([String|Rest],O):-string(String),!,(Rest==[]->O=String;O=[String|Rest]).
 1258
 1259
 1260db_expand_final(_ ,NC,NC):-  is_ftVar(NC),!.
 1261%db_expand_final(Op,t(EL),O):- !, db_expand_final(Op,EL,O).
 1262db_expand_final(change(assert,_),props(_Obj,List),true):-  List==[],dumpST,!.
 1263db_expand_final(_,props(Obj,List),{nonvar(Obj)}):- (List==[] ; List==true).
 1264db_expand_final(_ ,sumo_rule(NC),sumo_rule(NC)):- !.
 1265
 1266db_expand_final(Op, CMP,    O  ):- compound(CMP),meta_argtypes(Args)=CMP,
 1267  is_ftCompound(Args),safe_functor(Args,Pred,A),
 1268    (Pred=t->  (fully_expand_head(Op, Args,ArgsO),O=meta_argtypes(ArgsO)) ; 
 1269      (assert_arity(Pred,A),O=meta_argtypes(Args))).
 1270
 1271% db_expand_final(_,NC,NCO):- string_to_mws(NC,NCO),!.
 1272
 1273%db_expand_final(_ ,NC,NCO):- atom(NC),do_renames_expansion(NC,NCO),!.
 1274db_expand_final(_ ,NC,NC):- atomic(NC),!.
 1275db_expand_final(_,PARSE,_):- is_parse_type(PARSE),!,fail.
 1276db_expand_final(Op,M:Sent,SentO):- atom(M),is_stripped_module(M),!,db_expand_final(Op,Sent,SentO).
 1277db_expand_final(_,Sent,_):- arg(_,Sent,E),compound(E),safe_functor(E,isEach,_),throw(hasEach).
 1278db_expand_final(_,[_|_],_):- !,fail.
 1279db_expand_final(_,Arg,Arg):- safe_functor(Arg,s,_),!.
 1280db_expand_final(_,Sent,Sent):- Sent  univ_safe  [_,A],(atom(A);var(A);number(A);is_ftVar(A)),!.
 1281
 1282db_expand_final(_ ,isa(Args,Meta_argtypes),  meta_argtypes(Args)):-Meta_argtypes==meta_argtypes,!,is_ftCompound(Args),!,safe_functor(Args,Pred,A),assert_arity(Pred,A).
 1283% covered db_expand_final(Op,Sent,Sent):- Sent  univ_safe  [_,A],atom(A),!.
 1284%db_expand_final(_,PARSE,ISA):- PARSE  univ_safe  [t,C,I],atom(C),atom(I),ISA  univ_safe  [C,I],!.
 1285% covered db_expand_final(_ ,NC,NC):-safe_functor(NC,_,1),arg(1,NC,T),(not_ftCompound(T)),!.
 1286db_expand_final(_, Sent,Sent):-is_true(Sent).
 1287% covered db_expand_final(_,Term,Term):- is_ftCompound(Term),safe_functor(Term,F,_),(cheaply_u(prologBuiltin(F));cheaply_u(rtArgsVerbatum(F))).
 1288% covered db_expand_final(_, arity(F,A),arity(F,A)):- not_ftCompound(F),not_ftCompound(A),!, (maybe_ain_arity(F,A)).
 1289%unused db_expand_final(_, tPred(V),tPred(V)):-!,fail, not_ftCompound(V),!.
 1290%db_expand_final(_ ,NC,NC):-safe_functor(NC,_,1),arg(1,NC,T),db_expand_final(_,T,_),!.
 1291
 1292db_expand_final(_ ,IN,OUT):- IN  univ_safe  [F,A,B], \+ is_ftVar(A), \+ is_ftVar(B), clause_b(rtSymmetricBinaryPredicate(F)), (A@<B -> OUT=IN ; OUT  univ_safe  [F,B,A]).
 1293
 1294db_expand_final(_ ,isa(Atom,PredArgTypes), tRelation(Atom)):-PredArgTypes==meta_argtypes,atom(Atom),!.
 1295db_expand_final(_ ,meta_argtypes(F,Args),    meta_argtypes(Args)):-atom(F),!,safe_functor(Args,Pred,A),assert_arity(Pred,A).
 1296%covered db_expand_final(_ ,meta_argtypes(Args),      meta_argtypes(Args)):-!.
 1297%covered db_expand_final(_ ,meta_argtypes_guessed(Args),      meta_argtypes_guessed(Args)):-!.
 1298%covered db_expand_final(Op,(A,B),(AA,BB)):-  !,db_expand_final(Op,A,AA),db_expand_final(Op,B,BB).
 1299%db_expand_final(Op,props(A,B),PROPS):- (is_ftNonvar(A);is_ftNonvar(B)),!,expand_props(_,Op,props(A,B),Props),!,Props\=props(_,_),fully_expand_head(Op,Props,PROPS).
 1300db_expand_final(_ ,NCO,NCO):- NCO   univ_safe  [F,A|R],as_is_term(F,A,R),!.
 1301/*
 1302db_expand_final(_, MArg1User, NewMArg1User):- is_ftCompound(MArg1User), fail,
 1303   MArg1User  univ_safe  [M,Arg1,Arg2|User],
 1304   compound_all_open(Arg1),
 1305   get_functor(Arg1,F,A),F\==(t),F\==(/),
 1306   member(F,[arity,predicateConventionMt]),
 1307   NewMArg1User  univ_safe  [M,F/A,Arg2|User],!.
 1308*/
 1309
 1310
 1311
 1312%= 	 	 
 is_elist_functor(+Op) is semidet
If Is A Elist Functor.
 1318is_elist_functor(isList).
 1319is_elist_functor(ftListfn).
 1320is_elist_functor(isEach).
 1321is_elist_functor(isAnd).
 1322
 1323
 1324%= 	 	 
 as_list(?EC, ?AL) is det
Converted To List.
 1330as_list(ftListFn(Atom),[Atom]):- atom(Atom),!.
 1331as_list(Atom,[]):-is_elist_functor(Atom),!.
 1332as_list(_,Atom):- \+ var(Atom), \+ is_list(Atom),!,fail.
 1333as_list(EC,AL):-compound(EC),EC  univ_safe  [IsEach,A|List],is_elist_functor(IsEach),!,((List==[],is_list(A))->AL=A;AL=[A|List]).
 1334as_list(List,AL):-sanity(is_list(List)),AL=List.
 1335
 1336
 1337
 1338%= 	 	 
 1339
 1340%% listToE( ?EL, ?E) is det.
 1341%
 1342% List Converted To E.
 1343%
 1344listToE(EL,E):-nonvar(EL),!,must(as_list(EL,List)),sanity(is_list(List)),E  univ_safe  [isEach|List].
 1345
 1346
 1347
 1348%= 	 	 
 db_expand_chain(+Op, ?M, ?PO) is det
Database Expand Chain.
 1354db_expand_chain(_,V,_):-var(V),!,fail.
 1355db_expand_chain(_,M:PO,PO) :- atom(M),!.
 1356db_expand_chain(_,isa(I,Not),INot):-Not==not,!,INot   univ_safe   [Not,I].
 1357db_expand_chain(_,_,_):- t_l:into_goal_code,!,fail.
 1358db_expand_chain(_,(P:-B),P) :-is_true(B),!.
 1359db_expand_chain(_,B=>P,P) :-is_true(B),!.
 1360db_expand_chain(_,<=(P,B),P) :-is_true(B),!.
 1361db_expand_chain(_,P<==>B,P) :-is_true(B),!.
 1362db_expand_chain(_,B<==>P,P) :-is_true(B),!.
 1363db_expand_chain(_,P<-B,P) :-is_true(B),!.
 1364%db_expand_chain(_,P,PE):-fail,cyc_to_clif_entry(P,PE).
 1365%db_expand_chain(_,('nesc'(P)),P) :- !.
 fully_expand_head(?A, ?B, ?C) is semidet
Database Expand A Noloop.
 1375% covered fully_expand_head(_,Sent,SentO):- as_is_term(Sent),!,SentO=Sent,!.
 1376
 1377fully_expand_head(Why,Before,After):-
 1378  % quietly(subst(Before,mpred_isa,isa,Before1)),
 1379  into_mpred_form(Before,Before2),
 1380  must(try_expand_head(Why,Before2,After1)),
 1381  must(post_expansion(Why,After1,After)).
 1382
 1383
 1384try_expand_head(_,A,B):- t_l:infSkipFullExpand,!,A=B.
 1385% try_expand_head(Op,Sent,SentO):- transitive_lc(db_expand_0(Op),Sent,OO),!,SentO=OO.
 1386
 1387
 1388try_expand_head(Op,~Sent,~SentO):- nonvar(Sent),!,try_expand_head(Op,Sent,SentO).
 1389try_expand_head(Op,Sent,SentO):- db_expand_0(Op,Sent,M)->( M==Sent->SentO=M;db_expand_0(Op,M,SentO)),!.
 1390
 1391
 1392:- meta_predicate temp_comp(*,*,2,?). 1393
 1394% prolog_clause fully_expand_clause
 1395temp_comp(H,B,PRED,OUT):- nonvar(H),term_variables(B,Vs1),Vs1\==[], term_attvars(B,AVs1), AVs1==[],   
 1396   quietly((asserta(('$temp_comp123'(H,B):- B),Ref),clause('$temp_comp123'(H,_),BO,Ref),erase(Ref))),
 1397   B\=@=BO,!,
 1398   must((term_variables(BO,Vs2),!,must_maplist(=,Vs1,Vs2),call(PRED,(H:-BO),OUT))).
 1399
 1400
 1401:- discontiguous db_expand_0/3.
Database expand Primary Helper.

:- meta_predicate(term_expansion(':'(:-),(:-))). :- mode(term_expansion(+,--)).

 1410db_expand_0(_Op,Sent,Sent):- var(Sent),!.
 1411db_expand_0(Op,not(Sent),not(SentO)):- !, db_expand_0(Op,Sent,SentO).
 1412db_expand_0(Op,\+(Sent),\+(SentO)):- !, db_expand_0(Op,Sent,SentO).
 1413db_expand_0(Op,~(Sent),~(SentO)):- !, db_expand_0(Op,Sent,SentO).
 1414db_expand_0(Op,poss(Sent),poss(SentO)):- !, db_expand_0(Op,Sent,SentO).
 1415db_expand_0(Op,nesc(Sent),nesc(SentO)):- !, db_expand_0(Op,Sent,SentO).
 1416db_expand_0(Op,Sent,SentO):- cyclic_break(Sent),db_expand_final(Op ,Sent,SentO),!.
 1417
 1418db_expand_0(_,Sent,Sent):- \+ compound(Sent),!.
 1419
 1420db_expand_0(_Op,GG,SentO):-ground(GG),GG  univ_safe  [_,G],(G= -kif(_);G= -pkif(_)),!,SentO=G.
 1421db_expand_0(Op,pkif(SentI),SentO):- nonvar(SentI),!,must((any_to_string(SentI,Sent),must(expand_kif_string_or_fail(Op,Sent,SentM)),SentM\=@=Sent,!,db_expand_0(Op,SentM,SentO))).
 1422db_expand_0(_Op,kif(Sent),SentO):- nonvar(Sent),!, must(expand_kif_string(Sent,SentM)),if_defined(sexpr_sterm_to_pterm(SentM,SentO),SentM=SentO).
 1423
 1424%TODO DONT RUIN 
 1425db_expand_0(Op,==>(EL),O):- !, db_expand_0(Op,EL,O).
 1426db_expand_0(_,t(Sent),t(Sent)):- ftVar(Sent),!.
 1427%TODO DONT RUIN   
 1428db_expand_0(Op,t(EL),O):- !, db_expand_0(Op,EL,O).
 1429
 1430db_expand_0(Op,[G|B],[GG|BB]):-!,db_expand_0(Op,G,GG),db_expand_0(Op,B,BB).
 1431db_expand_0(_Op,=>(G,B),=>(G,B)):-!.
 1432db_expand_0(Op,(G,B),(GG,BB)):-!,db_expand_0(Op,G,GG),db_expand_0(Op,B,BB).
 1433db_expand_0(Op,G:B,GG:BB):-!,db_expand_0(Op,G,GG),db_expand_0(Op,B,BB).
 1434
 1435db_expand_0(Op,{Sent},{SentO}):- !,fully_expand_goal(Op,Sent,SentO),!.
 1436
 1437db_expand_0(Op,SentI,SentO):- SentI  univ_safe  [NOT,Sent],arg(_,v( ( \+ ), '{}' , (~) , ( :- )  ),NOT),
 1438  db_expand_0(Op,Sent,SentM)-> 
 1439  (Sent\=@=SentM -> (SentMM  univ_safe  [NOT,SentM],fully_expand_goal(Op,SentMM,SentO)) ; SentO   univ_safe  [NOT,SentM]),!.
 1440
 1441
 1442db_expand_0(_,Sent,SentO):- copy_term(Sent,NoVary),get_ruleRewrite(Sent,SentO),must(Sent\=@=NoVary),SentO \=@= Sent.
 1443db_expand_0(call(Op),Sent,SentO):-  mreq(quasiQuote(QQuote)),subst(Sent,QQuote,isEach,MID),Sent\=@=MID,!,must(db_expand_0(call(Op),MID,SentO)).
 1444
 1445db_expand_0(Op,Sent,SentO):- transitive_lc(db_expand_chain(Op),Sent,SentO)-> SentO \=@= Sent.
 1446
 1447
 1448db_expand_0(_Op,P,PO):-db_expand_argIsa(P,PO),!.
 1449
 1450db_expand_0(_Op,P,PO):- fail,
 1451  compound(P),
 1452  P  univ_safe  [_TYPE,UNIT],
 1453  is_unit(UNIT),!,
 1454  PO=P.
 1455
 1456%:- kb_shared(is_svo_functor/1).
 1457
 1458% prolog_clause db_expand_0
 1459% db_expand_0(_Op,(H:-B),(H:-B)):- !.
 1460db_expand_0(Op,(H:-B),OUT):- fully_expand_clause(Op,(H:-B),OUT),!,  
 1461                         (((H:-B)=@=OUT)->true;dmsg_pretty(warn(db_expand_0(Op,(H:-B),OUT)))).
 1462% prolog_clause db_expand_0
 1463% db_expand_0(Op,(H:-B),OUT):- temp_comp(H,B,db_expand_0(Op),OUT),!.
 1464db_expand_0(Op,(:-(CALL)),(:-(CALLO))):-with_assert_op_override(Op,db_expand_0(Op,CALL,CALLO)).
 1465db_expand_0(Op,isa(I,O),INot):-Not==not,!,INot   univ_safe   [Not,I],!,db_expand_0(Op,INot,O).
 1466db_expand_0(Op,isa(I,O),INot):-Not== ( \+ ) ,!,INot   univ_safe   [Not,I],!,db_expand_0(Op,INot,O).
 1467
 1468db_expand_0(Op,THOLDS,OUT):- THOLDS  univ_safe  [t,P|ARGS],atom(P),!,HOLDS  univ_safe  [P|ARGS],db_expand_0(Op,HOLDS,OUT).
 1469db_expand_0(Op,RDF,OUT):- RDF  univ_safe  [SVO,S,V,O],if_defined(is_svo_functor(SVO)),!,must_det(from_univ(_,Op,[V,S,O],OUT)).
 1470db_expand_0(Op,G,OUT):- G  univ_safe  [Pred,InstFn,VO],compound(InstFn),InstFn=isInstFn(Type),is_ftNonvar(Type),from_univ(relationMostInstance,Op,[Pred,Type,VO],OUT).
 1471db_expand_0(Op,G,OUT):- G  univ_safe  [Pred,InstFn|VO],compound(InstFn),InstFn=isInstFn(Type),is_ftNonvar(Type),GO  univ_safe  [Pred,Type|VO],db_expand_0(Op,GO,OUT).
 1472
 1473db_expand_0(Op,props(A,F),OO):-!,expand_props(_Prefix,Op,props(A,F),OO),!.
 1474db_expand_0(Op,iprops(A,F),OO):-!,expand_props(_Prefix,Op,props(A,F),OO),!.
 1475db_expand_0(Op,upprop(A,F),ain(OO)):-!,expand_props(_Prefix,Op,props(A,F),OO),!.
 1476db_expand_0(Op,padd(A,F),ain(OO)):-!,expand_props(_Prefix,Op,props(A,F),OO),!.
 1477
 1478
 1479db_expand_0(Op,(call_u(CALL)),(call_u(CALLO))):-with_assert_op_override(Op,db_expand_0(Op,CALL,CALLO)).
 1480db_expand_0(_ ,include(CALL),(load_data_file_now(CALL))):- dtrace, !.
 1481
 1482db_expand_0(Op,=>(G),(GG)):-!,db_expand_0(Op,(G),(GG)).
 1483db_expand_0(Op,(G,B),(GGBB)):-!,db_expand_0(Op,G,GG),db_expand_0(Op,B,BB),conjoin_l(GG,BB,GGBB).
 1484
 1485db_expand_0(Op,(G==>B),(GG==>BB)):-!,db_expand_0(Op,G,GG),db_expand_0(Op,B,BB).
 1486
 1487
 1488db_expand_0(Op,(G;B),(GG;BB)):-!,db_expand_0(Op,G,GG),db_expand_0(Op,B,BB).
 1489db_expand_0(Op,(G:-B),(GG:-BB)):-!,db_expand_0(Op,G,GG),fully_expand_goal(Op,B,BB).
 1490
 1491db_expand_0(Op,M:Sent,SentO):- atom(M),is_stripped_module(M),!,db_expand_0(Op,Sent,SentO).
 1492db_expand_0(Op,M:Sent,R:SentO):- replaced_module(Op,M,R),!,db_expand_0(Op,Sent,SentO).
 1493
 1494:- if(false). 1495db_expand_0(_Op,pddlSomethingIsa(I,EL),(isa(I,IC),O)):- icn_tcn(I,IC), listToE(EL,E),expand_isEach_or_fail(==>genls(IC,E),O),!.
 1496:- endif. 1497
 1498db_expand_0(_Op,pddlSomethingIsa(I,EL),O):- listToE(EL,E),expand_isEach_or_fail(==>isa(I,E),O).
 1499db_expand_0(_Op,pddlDescription(I,EL),O):- listToE(EL,E),expand_isEach_or_fail(==>mudDescription(I,E),O).
 1500db_expand_0(_Op,pddlObjects(I,EL),O):- listToE(EL,E),expand_isEach_or_fail(==>isa(E,I),O).
 1501db_expand_0(_Op,pddlSorts(I,EL),O):- listToE(EL,E),expand_isEach_or_fail(==>genls(E,I),O).
 1502db_expand_0(_Op,pddlTypes(EL),O):- listToE(EL,E),expand_isEach_or_fail(==>isa(E,tCol),O).
 1503db_expand_0(_Op,pddlPredicates(EL),O):- listToE(EL,E),expand_isEach_or_fail(==>prologHybrid(E),O).
 1504
 1505db_expand_0(_,prop_mpred(M,RT,F,A),mpred_prop(M,F,A,RT)).
 1506
 1507db_expand_0(Op,DECL,OUT):- 
 1508    is_ftCompound(DECL)->
 1509    DECL  univ_safe  [D,FA|Args0] ->
 1510    functor_declares_instance_not_ft(D,DT)->
 1511    flat_list(Args0,Args)->   
 1512    maplist(nonvar,[FA|Args]) ->
 1513    db_expand_set(Op,[DT,FA|Args],OUT).
 1514
 1515db_expand_0(_,Sent,mpred_prop(M,F,A,RT)):- Sent  univ_safe  [RT,MFA],a(ttRelationType,RT),nonvar(MFA),get_mfa(MFA,M,F,A),atom(F),!.
 1516
 1517get_mfa(M:FA,M,F,A):- !, get_fa(FA,F,A).
 1518get_mfa(FA,M,F,A):- get_fa(FA,F,A),must(current_assertion_module(M)).
 1519
 1520
 1521flat_list([Args],Args):-is_list(Args),!.
 1522flat_list(Args,Args).
 1523
 1524functor_declares_instance_not_ft(F,C):- functor_declares_instance_0(F,C0),!,C=C0. % , nop(sanity(F\=C0)).
 1525
 1526% tSet(tMySet,comment("this was my set"))
 1527db_expand_set(Op,[TPRED,F,A|Args],OUT):- atom(F),number(A),!,db_expand_set(Op,[TPRED,F/A|Args],OUT),!, (maybe_ain_arity(F,A)).
 1528db_expand_set(Op,[TPRED,F/A|Args],OUT):- is_ftNameArity(F,A),
 1529   db_expand_set(Op,[TPRED,F| Args],OUT),!,
 1530    (maybe_ain_arity(F,A)).
 1531db_expand_set(Op,[TPRED,F|Args],OUT):- atom(F),!,db_expand_0(Op,props(F,[TPRED|Args]),OUT).
 1532db_expand_set(Op,[TPRED,FARGS|Args],(meta_argtypes(FARGS),OUT)):- 
 1533   compound(FARGS), \+ ((arg(_,FARGS,E),is_ftVar(E))),safe_functor(FARGS,F,A),!,
 1534   db_expand_set(Op,[TPRED,F/A|Args],OUT).
 1535
 1536
 1537:- thread_local(t_l:no_db_expand_props/0). 1538
 1539% @TODO uncomment IMMEDIATELY
 1540db_expand_0(Op,ClassTemplate,OUT):- \+ t_l:no_db_expand_props, db_expand_props(Op,ClassTemplate,OUT),!.
 1541
 1542db_expand_props(Op,DECL,O):- fail, arg(_,DECL,S),string(S),DECL  univ_safe  [F|Args],maplist(destringify,Args,ArgsO),
 1543  ArgsO\=@=Args,!,DECLM  univ_safe  [F|ArgsO],db_expand_0(Op,DECLM,O).
 1544
 1545
 1546db_expand_props(Op,DECL,((isa(F,TPRED),O))):-DECL  univ_safe  [D,FA|Args],compound(FA),FA= (F/A),
 1547  is_ftNameArity(F,A),functor_declares_instance(D,TPRED),
 1548  is_ftNonvar(TPRED),is_relation_type(TPRED),expand_props(_Prefix,Op,props(F,[D|Args]),O),!,
 1549   (maybe_ain_arity(F,A)).
 1550
 1551db_expand_props(Op,DECL,(isa(F,TPRED),O)):-DECL  univ_safe  [D,F,A|Args],is_ftNameArity(F,A),functor_declares_instance(D,TPRED),
 1552  arity_zor(D,1),
 1553  is_ftNonvar(TPRED),is_relation_type(TPRED),expand_props(_Prefix,Op,props(F,[D|Args]),O),!,
 1554   (maybe_ain_arity(F,A)).
 1555
 1556:- if(false). 1557db_expand_props(Op,DECL,(isa(F,TPRED),O)):-DECL  univ_safe    [D,C|Args],is_ftCompound(C),functor_declares_instance(D,TPRED),
 1558  \+ is_ftVar(C),
 1559  \+ \+ is_non_unit(C),
 1560  get_functor(C,F,A),  
 1561  arity_zor(D,1),
 1562  is_ftNonvar(TPRED),expand_props(_Prefix,Op,props(F,[D|Args]),M),!,
 1563  (\+((arg(_,C,Arg),is_ftVar(Arg))) -> O = (meta_argtypes(C),M) ; (O= (M))),
 1564   (maybe_ain_arity(F,A)).
 1565:- endif. 1566
 1567db_expand_props(Op,DECL,O):-DECL  univ_safe  [D,F,A1|Args], functor_declares_instance(D,DType),
 1568   arity_zor(D,1),
 1569   %\+ is_relation_type(DType),
 1570   expand_props(_Prefix,Op,props(F,[DType,D,A1|Args]),O),!.
 1571
 1572db_expand_props(Op,DECL,O):-DECL  univ_safe  [D,F|Args],functor_declares_instance(D,DType),
 1573   %\+ is_relation_type(DType),
 1574   arity_zor(D,1)->
 1575   expand_props(_Prefix,Op,props(F,[DType,D|Args]),O),!.
 1576
 1577
 1578% shift/1 reset/3
 1579%  room_template(iLivingRoom7,.....).
 1580db_expand_props(Op,ClassTemplate,(tCol(PropsIsa),isa(Inst,PropsIsa),OUT)):- 
 1581   ClassTemplate  univ_safe  [TypePropsFunctor,Inst|Props],
 1582   functor_declares_instance(TypePropsFunctor,PropsIsa),
 1583   arity_zor(TypePropsFunctor,1)->
 1584   \+ compound_all_open(ClassTemplate),
 1585   %ain(isa(PropsIsa,tCol)),
 1586   %ain(isa(Inst,PropsIsa)),
 1587   expand_props(t,Op,props(Inst,[PropsIsa|Props]),OUT),!.
 1588
 1589% typeProps(tCrackers,.....).
 1590db_expand_props(Op,ClassTemplate,(tCol(PropsIsa),isa(Type,PropsIsa),OUT)):-
 1591   ClassTemplate  univ_safe  [TypeTypePropsFunctor,Type|Props],
 1592   functor_declares_collectiontype(TypeTypePropsFunctor,PropsIsa),
 1593   arity_zor(TypeTypePropsFunctor,1),
 1594   \+ compound_all_open(ClassTemplate),
 1595   %ain(isa(Type,tCol)),
 1596   %ain(isa(Type,PropsIsa)),
 1597   expand_props(relationMostInstance,Op,props(Type,Props),OUT),!.
 1598
 1599% tRegion_inst_template(X, tLivingRoom,.....).
 1600db_expand_props(Op,ClassTemplate,(isa(TypePropsIsa,Type),ONEPROP)):- isa_one_prop(NewInst,Type,OUT,ONEPROP),
 1601  ClassTemplate  univ_safe  [FunctorTypePropsIsa,NewInst,Type|Props],
 1602  instTypePropsToType(FunctorTypePropsIsa,TypePropsIsa),
 1603  arity_zor(FunctorTypePropsIsa,2),
 1604   \+ compound_all_open(ClassTemplate),
 1605  expand_props(Op,props(NewInst,Props),OUT),!.
 1606
 1607/*
 1608
 1609% tRegion_template(tLivingRoom,.....).
 1610db_expand_props(Op,typeProps(C,Props),(isa(I,C)==>mdefault(OOUT))):- (is_ftNonvar(C);is_ftNonvar(Props)), expand_props(Prefix,Op,props(I,Props),OUT),dtrace,list_to_conjuncts(OUT,OUTC),conjuncts_to_list(OUTC,OUTL),
 1611   ISEACH  univ_safe  [isEach|OUTL],
 1612  db_expand_0(Op,mdefault(ISEACH),OOUT).
 1613
 1614*/
 1615
 1616% db_expand_0(Op,C,F/A):-compound_all_open(C),get_functor(C,F,A).
 1617db_expand_props(Op,ClassTemplate,OUT):- ClassTemplate  univ_safe  [props,Inst,Second,Third|Props],!,
 1618   must(expand_props(_Prefix,Op,props(Inst,[Second,Third|Props]),OUT)),!.
 1619db_expand_props(Op,arity(F,A),O):-expand_props(_Prefix,Op,props(F,arity(A)),O),!.
 1620
 1621maybe_ain_arity(F,A):- ignore((atom(F),integer(A),ain(arity(F,A)))).
 1622
 1623db_expand_0(Op,IN,OUT):- IN  univ_safe  [F|Args],F==t,!,must(from_univ(_,Op,Args,OUT)).
 1624db_expand_0(Op,isa(A,F),OO):-atom(F),O  univ_safe  [F,A],!,db_expand_0(Op,O,OO).
 1625db_expand_0(Op,isa(A,F),OO):-is_ftNonvar(A),is_ftNonvar(F),expand_props(_Prefix,Op,props(A,F),OO),!.
 1626db_expand_0(_Op,isa(A,F),isa(A,F)):-!.
 1627db_expand_0(Op,props(A,F),OO):-expand_props(_Prefix,Op,props(A,F),OO),!.
 1628db_expand_0(Op,typeProps(A,F),EXP):-expand_props(_Prefix,Op,props(I,F),OO),!,fully_expand(Op,(isa(I,A)==>OO),EXP).
 1629
 1630% covered db_expand_0(_,arity(F,A),arity(F,A)):-atom(F),!.
 1631db_expand_0(Op,IN,OUT):- 
 1632   cnas(IN,F,Args),
 1633   % wdmsg_pretty(db_expand_0(Op,IN)),
 1634   sanity(F \== isa),
 1635   must_maplist(db_expand_0(Op),Args,ArgsO),
 1636   map_f(F,FO),OUT  univ_safe  [FO|ArgsO].
 1637   
 1638isa_one_prop(NewInst,Type,OUT,ONEPROP):- ONEPROP = (isa(NewInst,Type)==>OUT).
 1639
 1640%= 	 	 
 is_arity_pred(+Op) is semidet
If Is A Arity Predicate.
 1646is_arity_pred(argIsa).
 1647is_arity_pred(arity).
 1648
 1649arity_zor(D,ZOR) :- atom(D),D\==isa, \+ (arity_no_bc(D,N),!,N>ZOR).
 1650
 1651%= 	 	 
 map_f(?F, ?F) is semidet
Map False.
 1657map_f(M:F,M:FO):-atom(M),map_f(F,FO).
 1658% map_f(mpred_isa,isa).
 1659% map_f(props,isa).
 1660map_f(F,F):-!.
 1661
 1662
 1663%= 	 	 
 ex_argIsa(?P, ?N, ?C) is semidet
ex Argument (isa/2).
 1669ex_argIsa(P,N,C):- clause(_:argIsa(P,N,C),true).
 1670
 1671db_expand_argIsa(P,_):- \+ compound(P),!,fail.
 1672db_expand_argIsa(P,_):- is_dict(P),!,fail.
 1673db_expand_argIsa(P,PO):- 
 1674  P  univ_safe  [ARE,FF,AA],
 1675   atom_concat('arg',REST,ARE),
 1676   member(E,['Genl','Isa','SometimesIsa','Format','QuotedIsa']),atom_concat(N,E,REST),
 1677   atom_number(N,NN),
 1678   atom_concat('arg',E,AE),
 1679  PO  univ_safe  [AE,FF,NN,AA],!.
 1680
 1681db_expand_argIsa(P,PO):- 
 1682  P  univ_safe  [ARE,FF,C1,C2],
 1683   atom_concat('interArg',REST,ARE),
 1684   member(E,['Isa','Genl','Format','QuotedIsa','GenlQuantity','NotIsa','SometimesIsa','NotQuotedIsa']),
 1685   atom_concat(E,Nums,REST),
 1686   (atomic_list_concat([A1,A2],'-',Nums);atomic_list_concat([A1,A2],'_',Nums)),!,
 1687   atom_number(A1,N1),
 1688   atom_number(A2,N2),
 1689   atomic_list_concat(['interArg',E],AE),
 1690  PO  univ_safe  [AE,FF,N1,C1,N2,C2],!.
 1691
 1692db_expand_argIsa(P,PO):- 
 1693  P  univ_safe  [ARE,FF,AA,RESULT],
 1694   atom_concat('interArg',REST,ARE),
 1695   member(E,['ResultGenl','ResultIsa','ResultNotIsa','ResultSometimesIsa','ResultFormat','ResultQuotedIsa','ResultNotQuotedIsa']),
 1696   atom_concat(N,E,REST),
 1697   atom_number(N,NN),
 1698   atom_concat('interArg',E,AE),
 1699  PO  univ_safe  [AE,FF,NN,AA,RESULT],!.
 1700
 1701
 1702%= 	 	 
 compound_all_open(?C) is semidet
Compound All Open.
 1708compound_all_open(C):-compound(C),safe_functor(C,_,A),A>1,\+((arg(_,C,Arg),is_ftNonvar(Arg))),!.
 1709
 1710/*
 1711db_expand_0(Op,Mt:Term,Mt:O):- is_kb_module(Mt),!,locally_tl(caller_module(baseKB,Mt),db_expand_0(Op,Term,O)).
 1712db_expand_0(Op,DB:Term,DB:O):- defaultAssertMt(DB),!,locally_tl(caller_module(db,DB),db_expand_0(Op,Term,O)).
 1713db_expand_0(Op,KB:Term,KB:O):- atom(KB),!,locally_tl(caller_module(prolog,KB),db_expand_0(Op,Term,O)).
 1714*/
 1715
 1716% db_expand_0(query(HLDS,Must),props(Obj,Props)):- is_ftNonvar(Obj),is_ftVar(Props),!,gather_props_for(query(HLDS,Must),Obj,Props).
 1717
 1718replaced_module(_,V,_):- \+ atom(V),!,fail.
 1719replaced_module(_,umt,ABox):-defaultAssertMt(ABox).
 1720replaced_module(_,abox,ABox):-defaultAssertMt(ABox).
 1721replaced_module(_,tbox,TBox):-get_current_default_tbox(TBox).
 1722
 1723:- thread_local(t_l:current_defaultAssertMt/1). 1724
 1725maybe_prepend_mt(MT,I,O):- t_l:current_defaultAssertMt(ABOX)->ABOX==MT,!,maybe_prepend_mt(abox,I,O).
 1726maybe_prepend_mt(abox,H,HH):-nonvar(HH),dtrace,maybe_prepend_mt(abox,H,HHH),must(HHH=HH),!.
 1727maybe_prepend_mt(abox,H,HH):-var(H),must(HH=H),!.
 1728maybe_prepend_mt(_,CL,CL):- compound(CL),CL=(_,_),!.
 1729maybe_prepend_mt(_,H,HH):-predicateSystemCode(H,HH),!.
 1730maybe_prepend_mt(abox,_:HH,HH):-!.
 1731maybe_prepend_mt(abox,HH,HH):-!.
 1732maybe_prepend_mt(Mt,Mt:HH,Mt:HH):-!.
 1733maybe_prepend_mt(_,Mt:HH,Mt:HH):-!.
 1734maybe_prepend_mt(Mt,HH,Mt:HH):-!.
 1735
 1736predicateSystemCode(P,PP):-strip_module(P,_,PP),predicate_property(system:PP,defined),
 1737  \+ predicate_property(system:PP,imported_from(baseKB)).
 remodulize(?Op, ?H, ?HH) is det
Re-Modulize.
 1743remodulize(_, H,H):- is_ftVar(H),!.
 1744remodulize(_, H,H):- \+ compound(H),!. % this disables the two next rules
 1745remodulize(Op, H,HH):- atom(H),strip_module(H,FROM,_HHH),convention_to_symbolic_mt(FROM,Op,H,0,M),maybe_prepend_mt(M,H,HH).
 1746remodulize(call(Op),M,R):-atom(M),replaced_module(Op,M,R),!.
 1747remodulize(Op,M:H,M:HHH):-is_ftVar(M),!,must_remodulize(mvar(Op),H,HHH).
 1748remodulize(Op,H,HH):-is_list(H),!,must_maplist(remodulize(Op),H,HH),!.
 1749remodulize(Op,':-'(G),':-'(GG)):-!,must_remodulize(call(Op),G,GG).
 1750remodulize(Op,(H:-G),(HH:-GG)):-!,must_remodulize(clause(Op,(':-')),H,HH),must_remodulize(call(Op),G,GG).
 1751remodulize(Op,(H,G),(HH,GG)):-!,must_remodulize(call(Op),H,HH),must_remodulize(call(Op),G,GG).
 1752remodulize(Op,(H;G),(HH;GG)):-!,must_remodulize(call(Op),H,HH),must_remodulize(call(Op),G,GG).
 1753
 1754remodulize(Op,M:H,R:HHH):- replaced_module(Op,M,R),!,must_remodulize(Op,H,HHH).
 1755remodulize(Op,M:H,HHH):- is_stripped_module(M),!,must_remodulize(Op,H,HHH).
 1756
 1757remodulize(Op,Mt:H,HHHH):- is_ftCompound(H),H  univ_safe  [F|HL],!,must_maplist(remodulize(Op),HL,HHL),HH  univ_safe  [F|HHL],!,
 1758  must((remodulize_pass2(Op,HH,HHH),maybe_prepend_mt(Mt,HHH,HHHH))).
 1759
 1760remodulize(Op,H,HHH):-is_ftCompound(H),H  univ_safe  [F|HL],!,must_maplist(remodulize(Op),HL,HHL),HH  univ_safe  [F|HHL],!,
 1761  must(remodulize_pass2(Op,HH,HHH)).
 1762
 1763remodulize_pass2(Op,MHH,HHH):- strip_module(MHH,FROM,HH),safe_functor(HH,F,A),convention_to_symbolic_mt(FROM,Op,F,A,Mt),maybe_prepend_mt(Mt,HH,HHH).
 1764% remodulize_pass2(Op,HH,HHH):- fix_mp(Op,HH,HHH),!. % this is overzealous
 1765remodulize_pass2(_Why,HH,HH):- !.
 1766
 1767%:- kb_shared(is_sentence_functor/1).
 1768
 1769must_remodulize(Op,H,HHH):-must(demodulize(Op,H,HHH)),!.
 1770%= 	 	 
 1771
 1772%% is_meta_functor( ^ Sent, ?F, ?List) is semidet.
 1773%
 1774% If Is A Meta Functor.
 1775%
 1776is_meta_functor(Sent,F,List):-is_ftCompound(Sent),Sent  univ_safe  [F|List], (predicate_property(Sent,meta_predicate(_));   is_sentence_functor(F);F==pfcDefault),!.
 is_sentence_functor(?And) is semidet
If Is A Sentence Functor.
 1789is_sentence_functor(And):-quietly(is_logical_functor0(And)).
 is_logical_functor0(?X) is semidet
If Is A Logical Functor Primary Helper.
 1797is_logical_functor0(&).
 1798is_logical_functor0(v).
 1799is_logical_functor0(exists).
 1800is_logical_functor0(all).
 1801is_logical_functor0(X):-atom(X),member(X,[',',';',xor,'\\+',~]).
 1802is_logical_functor0(X):- a(logical_functor_pttp,X).
 1803is_logical_functor0(X):- a(is_quantifier,X).
 1804is_logical_functor0(And):-member(And,[(,),(;),('<-'),('=>'),('<=>'),(':-'),(and),nop]).
 1805
 1806
 1807
 1808%= 	 	 
 from_univ(?Prefix, ?Op, :TermMORE, ?Out) is semidet
Converted From Univ.
 1814from_univ(Prefix,Op,[T|MORE],Out):-T==t,!,from_univ(Prefix,Op,MORE,Out).
 1815% MAYBE from_univ(Prefix,Op,[C,I],Out):- is_tspec(C),!,to_isa_form(I,C,Out).
 1816
 1817from_univ(Prefix,Op,[PROP,Obj|MORE],Out):-PROP==props,!,expand_props(Prefix,Op,props(Obj,MORE),Out).
 1818% from_univ(Prefix,Op,MORE,Out):-atom(Prefix),!,from_univ(_,Op,[Prefix|MORE],Out).
 1819from_univ(_Prefix,_Op,[PROP|MORE],Out):-atom(PROP),!,Out  univ_safe  [PROP|MORE]. % ,db_expand_up(Prefix,Op,Mid,Out).
 1820from_univ(_Prefix,_Op,In,Out):- Out  univ_safe  [t|In],!.
 1821
 1822
 1823%= 	 	 
 db_expand_up(?Prefix, ?Op, ?Mid, ?OOUT) is semidet
Database Expand Up.
 1829db_expand_up(Prefix,Op,Mid,OOUT):- fully_expand_head(Op,Mid,Out), 
 1830  is_ftCompound(Prefix),subst(Prefix,value,Out,OOUT).
 1831db_expand_up(_,Op,Mid,Out):- fully_expand_head(Op,Mid,Out).
 expand_props(?Op, ?Term, ?OUT) is semidet
Expand Props.
 1840expand_props(Op,Term,OUT):-expand_props(_,Op,Term,OUT).
 1841
 1842
 1843%= 	 	 
Expand Props.
 1849expand_props(_Prefix,_,Sent,OUT):- t_l:no_db_expand_props, (not_ftCompound(Sent)),!,OUT=Sent.
 1850%expand_props(Prefix,Op,Term,OUT):- stack_check,(is_ftVar(OpeR);is_ftVar(Term)),!,trace_or_throw_ex(var_expand_units(OpeR,Term,OUT)).
 1851expand_props(Prefix,Op,Sent,OUT):-  Sent  univ_safe  [And|C12],is_sentence_functor(And),!,maplist(expand_props(Prefix,Op),C12,O12),OUT  univ_safe  [And|O12].
 1852expand_props(_Prefix,_ ,props(Obj,Open),props(Obj,Open)):- is_ftVar(Open),!. % ,trace_or_throw_ex(expand_props(Prefix,Op,props(Obj,Open))->OUT).
 1853expand_props(_Prefix,change(assert,_),props(_Obj,List),true):- List==[],!.
 1854expand_props(_Prefix,_,props(Obj,List),{nonvar(Obj)}):- List==[],!.
 1855% expand_props(_Prefix,_ ,props(_Obj,List),true):- List==[],!.
 1856expand_props(Prefix,Op,props(Obj,[P|List]),OUT):- List==[],expand_props(Prefix,Op,props(Obj,P),OUT),!.
 1857% expand_props(Prefix,Op,props(Obj,[P]),OUT):- is_ftNonvar(P),!,expand_props(Prefix,Op,props(Obj,P),OUT).
 1858expand_props(Prefix,Op,props(Obj,[P|ROPS]),OUT):- !,expand_props(Prefix,Op,props(Obj,P),OUT1),
 1859   expand_props(Prefix,Op,props(Obj,ROPS),OUT2),
 1860   conjoin_l(OUT1,OUT2,OUT).
 1861expand_props(Prefix,Op,props(Obj,PropVal),OUT):- atom(PropVal),!,from_univ(Prefix,Op,[PropVal,Obj],OUT).
 1862
 1863expand_props(_Prefix,_Op,props(Obj,PropVal),(PropVal2,{OPVAL})):- PropVal  univ_safe  [OpeR,Pred|Val],comparitiveOp(OpeR),
 1864   not(comparitiveOp(Pred)),!,OPVAL  univ_safe  [OpeR,NewVar|Val],PropVal2  univ_safe  [Pred,Obj,NewVar],!.    
 1865
 1866expand_props(_,_,props(Obj,PropVal),OUT):- var(Obj),atomic(PropVal), \+ atom(PropVal),OUT=[PropVal],!.
 1867expand_props(_,_,props(Obj,PropValS),OUT):- var(Obj),member(PropVal,PropValS),atomic(PropVal), \+ atom(PropVal),OUT=PropValS,!.
 1868expand_props(Prefix,Op,props(Obj,PropVal),OUT):- safe_univ(PropVal,[Prop,NonVar|Val]),Obj==NonVar,!,from_univ(Prefix,Op,[Prop,Obj|Val],OUT).
 1869expand_props(Prefix,Op,props(Obj,PropVal),OUT):- 
 1870   PropVal  univ_safe  [OpeR,Pred|Val],comparitiveOp(OpeR),
 1871   not(comparitiveOp(Pred)),!,OPVAL  univ_safe  [OpeR|Val],PropVal2  univ_safe  [Pred,OPVAL],
 1872    expand_props(Prefix,Op,props(Obj,PropVal2),OUT),!.
 1873expand_props(Prefix,Op,props(Obj,PropVal),OUT):- PropVal  univ_safe  [Prop|Val], \+ (infix_op(Prop,_)),!,from_univ(Prefix,Op,[Prop,Obj|Val],OUT).
 1874expand_props(Prefix,Op,props(Obj,PropVal),OUT):- PropVal  univ_safe  [Prop|Val],!,dtrace(from_univ(Prefix,Op,[Prop,Obj|Val],OUT)).
 1875expand_props(Prefix,Op,props(Obj,Open),props(Obj,Open)):- trace_or_throw_ex(unk_expand_props(Prefix,Op,props(Obj,Open))).
 1876
 1877expand_props(Prefix,OpeR,ClassTemplate,OUT):- ClassTemplate  univ_safe  [props,Inst,Second,Third|Props],!,
 1878   expand_props(Prefix,OpeR,props(Inst,[Second,Third|Props]),OUT),!.
 1879
 1880expand_props(_Prefix,_,Sent,Sent).
 1881
 1882
 1883%= 	 	 
 conjoin_l(?A, :TermAA, ?C) is semidet
Conjoin (list Version).
 1889conjoin_l(A,AA,C):-A==AA,!,C=A.
 1890conjoin_l(A,AAB,C):- compound(AAB),AAB=(B,AA), A==AA,!,conjoin_l(A,B,C).
 1891conjoin_l(A,AAB,C):- compound(AAB),AAB=(AA,B), A==AA,!,conjoin_l(A,B,C).
 1892conjoin_l(A,B,C):-conjoin(A,B,C).
 1893
 1894
 1895
 1896% ========================================
 1897% into_mpred_form/2 (removes a second order functors until the common mpred form is left)
 1898% ========================================
 1899%=  :- was_export(into_mpred_form/2).
 1900
 1901%= 	 	 
 into_mpred_form(:TermV, ?VO) is semidet
Converted To Managed Predicate Form.
 1908% into_mpred_form(Var,MPRED):- is_ftVar(Var), trace_or_throw_ex(var_into_mpred_form(Var,MPRED)).
 1909into_mpred_form(V,VO):- (not_ftCompound(V)),!,VO=V.
 1910into_mpred_form(M:X,M:O):- atom(M),!,into_mpred_form(X,O),!.
 1911% convered into_mpred_form(Sent,SentO):-is_ftNonvar(Sent),get_ruleRewrite(Sent,SentM),!,into_mpred_form(SentM,SentO).
 1912into_mpred_form((H:-B),(HH:-BB)):-!,into_mpred_form(H,HH),into_mpred_form(B,BB).
 1913into_mpred_form((H:-B),(HH:-BB)):-!,into_mpred_form(H,HH),into_mpred_form(B,BB).
 1914into_mpred_form((H,B),(HH,BB)):-!,into_mpred_form(H,HH),into_mpred_form(B,BB).
 1915into_mpred_form((H;B),(HH;BB)):-!,into_mpred_form(H,HH),into_mpred_form(B,BB).
 1916into_mpred_form((H/B),(HH/BB)):-!,into_mpred_form(H,HH),into_mpred_form(B,BB).
 1917into_mpred_form(WAS,isa(I,C)):- was_isa_ex(WAS,I,C),!.
 1918into_mpred_form(t(P),O):-is_ftNonvar(P),!,into_mpred_form(P,O).
 1919into_mpred_form(t(P,A),O):-atom(P),!,O  univ_safe  [P,A].
 1920into_mpred_form(t(P,A,B),O):-atom(P),!,O  univ_safe  [P,A,B].
 1921into_mpred_form(t(P,A,B,C),O):-atom(P),!,O  univ_safe  [P,A,B,C].
 1922into_mpred_form(IN,OUT):- 
 1923   cnas(IN,F,Args),
 1924   must_maplist(into_mpred_form,Args,ArgsO),!,
 1925   map_f(F,FO),
 1926   cnas(OUT,FO,ArgsO).
 1927
 1928
 1929% into_mpred_form(I,O):- /*quietly*/(loop_check(into_mpred_form_ilc(I,O),O=I)). % trace_or_throw_ex(into_mpred_form(I,O).
 1930
 1931%:- mpred_trace_nochilds(into_mpred_form/2).
 1932
 1933
 1934%= 	 	 
 1935
 1936%% into_mpred_form_ilc( ?G, ?O) is semidet.
 1937%
 1938% Converted To Managed Predicate Form Inside Of Loop Checking.
 1939%
 1940into_mpred_form_ilc([F|Fist],O):- is_list([F|Fist]),!,G  univ_safe  [t|[F|Fist]], into_mpred_form(G,O).
 1941into_mpred_form_ilc(G,O):- safe_functor(G,F,A),G  univ_safe  [F,P|ARGS],!,into_mpred_form6(G,F,P,A,ARGS,O),!.
 1942
 1943% TODO confirm negations
 1944
 1945:- expire_tabled_list(all).
 into_mpred_form6(?X, ?H, ?P, ?N, ?A, ?O) is semidet
Converted To Managed Predicate Form6.
 1952into_mpred_form6(C,_,_,2,_,C):-!.
 1953% into_mpred_form6(H,_,_,_,_,G0):- once(locally(t_l:into_form_code,(expand_term( (H :- true) , C ), reduce_clause(assert,C,G)))),expanded_different(H,G),!,into_mpred_form(G,G0),!.
 1954into_mpred_form6(_,F,_,1,[C],O):-alt_calls(F),!,into_mpred_form(C,O),!.
 1955into_mpred_form6(_,':-',C,1,_,':-'(O)):-!,into_mpred_form_ilc(C,O).
 1956into_mpred_form6(_,not,C,1,_,not(O)):-into_mpred_form(C,O),!.
 1957into_mpred_form6(C,isa,_,2,_,C):-!.
 1958into_mpred_form6(C,_,_,_,_,isa(I,T)):-was_isa_ex(C,I,T),!.
 1959into_mpred_form6(_X,t,P,_N,A,O):-!,(atom(P)->O  univ_safe  [P|A];O  univ_safe  [t,P|A]).
 1960into_mpred_form6(G,_,_,1,_,G):-predicate_property(G,number_of_rules(N)),N >0, !.
 1961into_mpred_form6(G,F,C,1,_,O):-real_builtin_predicate(G),!,into_mpred_form(C,OO),O  univ_safe  [F,OO].
 1962into_mpred_form6(_X,H,P,_N,A,O):-a(is_holds_false,H),(atom(P)->(G  univ_safe  [P|A],O=not(G));O  univ_safe  [holds_f,P|A]).
 1963into_mpred_form6(_X,H,P,_N,A,O):-a(is_holds_true,H),(atom(P)->O  univ_safe  [P|A];O  univ_safe  [t,P|A]).
 1964into_mpred_form6(G,F,_,_,_,G):-a(prologHybrid,F),!.
 1965into_mpred_form6(G,F,_,_,_,G):-a(prologDynamic,F),!.
 1966into_mpred_form6(G,F,_,_,_,G):-nop(dmsg_pretty(warn(unknown_mpred_type(F,G)))).
 1967
 1968% ========================================
 1969% acceptable_xform/2 (when the form is a isa/2, do a validity check)
 1970% ========================================
 1971
 1972%= 	 	 
 acceptable_xform(?From, ?To) is semidet
Acceptable Xform.
 1978acceptable_xform(From,To):- From \=@= To,  (To = isa(I,C) -> was_isa_ex(From,I,C); true).
 1979
 1980% ========================================
 1981% transform_holds(Functor,In,Out)
 1982% ========================================
 1983
 1984%= 	 	 
 transform_holds(?H, ?In, ?Out) is semidet
Transform Holds.
 1990transform_holds(H,In,Out):- once(transform_holds_3(H,In,Out)),!,ignore((In\=Out,fail,dmsg_pretty(transform_holds(H,In,Out)))).
 1991
 1992
 1993% foreach_arg/7 
 1994%  is a maping predicate
 1995
 1996%= 	 	 
 foreach_arg(:TermARGS, ?N, ?ArgIn, ?ArgN, ?ArgOut, ?Call, :TermARGS) is semidet
Foreach Argument.
 2002foreach_arg(ARGS,_N,_ArgIn,_ArgN,_ArgOut,_Call,ARGS):- (not_ftCompound(ARGS)),!.
 2003foreach_arg([ArgIn1|ARGS],ArgN1,ArgIn,ArgN,ArgOut,Call1,[ArgOut1|ARGSO]):-
 2004     copy_term( a(ArgIn1,ArgOut1,ArgN1,Call1), a(ArgIn,ArgOut,ArgN,Call) ),
 2005      call(Call),
 2006      ArgN2 is ArgN + 1,
 2007      foreach_arg(ARGS,ArgN2,ArgIn,ArgN,ArgOut,Call,ARGSO).
 2008
 2009
 2010%= 	 	 
 transform_functor_holds(+Op, ?F, ?ArgInOut, ?N, ?ArgInOut) is semidet
Transform Functor Holds.
 2016transform_functor_holds(_,F,ArgInOut,N,ArgInOut):- once(call_u(argQuotedIsa(F,N,FT))),FT=ftTerm,!.
 2017transform_functor_holds(Op,_,ArgIn,_,ArgOut):- transform_holds(Op,ArgIn,ArgOut),!.
 2018
 2019
 2020%= 	 	 
 transform_holds_3(+Op, :TermA, ?A) is semidet
Transform Holds Helper Number 3..
 2026transform_holds_3(_,A,A):- (not_ftCompound(A)),!.
 2027transform_holds_3(_,props(Obj,Props),props(Obj,Props)):-!.
 2028%transform_holds_3(Op,Sent,OUT):-Sent  univ_safe  [And|C12],is_sentence_functor(And),!,maplist(transform_holds_3(Op),C12,O12),OUT  univ_safe  [And|O12].
 2029transform_holds_3(_,A,A):-compound(A),safe_functor(A,F,N), predicate_property(A,_),arity_no_bc(F,N),!.
 2030transform_holds_3(HFDS,M:Term,M:OUT):-atom(M),!,transform_holds_3(HFDS,Term,OUT).
 2031transform_holds_3(HFDS,[P,A|ARGS],DBASE):- is_ftVar(P),!,DBASE  univ_safe  [HFDS,P,A|ARGS].
 2032transform_holds_3(HFDS, ['[|]'|ARGS],DBASE):- trace_or_throw_ex(list_transform_holds_3(HFDS,['[|]'|ARGS],DBASE)).
 2033transform_holds_3(Op,[SVOFunctor,Obj,Prop|ARGS],OUT):- if_defined(is_svo_functor(SVOFunctor)),!,transform_holds_3(Op,[Prop,Obj|ARGS],OUT).
 2034transform_holds_3(Op,[P|ARGS],[P|ARGS]):- not(atom(P)),!,dmsg_pretty(transform_holds_3),trace_or_throw_ex(transform_holds_3(Op,[P|ARGS],[P|ARGS])).
 2035transform_holds_3(HFDS,[HOFDS,P,A|ARGS],OUT):- a(is_holds_true,HOFDS),!,transform_holds_3(HFDS,[P,A|ARGS],OUT).
 2036transform_holds_3(HFDS,[HOFDS,P,A|ARGS],OUT):- HFDS==HOFDS, !, transform_holds_3(HFDS,[P,A|ARGS],OUT).
 2037transform_holds_3(_,HOFDS,isa(I,C)) :- was_isa_ex(HOFDS,I,C),!.
 2038transform_holds_3(_,[Type,Inst],isa(Inst,Type)):-is_ftNonvar(Type),a(tCol,Type),!.
 2039transform_holds_3(_,HOFDS,isa(I,C)):- holds_args(HOFDS,[ISA,I,C]),ISA==isa,!.
 2040
 2041transform_holds_3(Op,[Fogical|ARGS],OUT):-  
 2042         call(call,is_sentence_functor(Fogical)),!,sanity( \+ (a(is_svo_functor,Fogical))),
 2043         must_det(foreach_arg(ARGS,1,ArgIn,ArgN,ArgOut,transform_functor_holds(Op,Fogical,ArgIn,ArgN,ArgOut),FARGS)),
 2044         OUT  univ_safe  [Fogical|FARGS].
 2045
 2046transform_holds_3(_,[props,Obj,Props],props(Obj,Props)).
 2047transform_holds_3(_,[Type,Inst|PROPS],props(Inst,[isa(Type)|PROPS])):- 
 2048                  is_ftNonvar(Inst), not(Type=props), (cheaply_u(tCol(Type));a(functorDeclares,Type)), 
 2049                  must_det(\+(if_defined(is_never_type(Type)))),!.
 2050
 2051transform_holds_3(_,[P,A|ARGS],DBASE):- atom(P),!,DBASE  univ_safe  [P,A|ARGS].
 2052transform_holds_3(Op,[P,A|ARGS],DBASE):- !, is_ftNonvar(P),dumpST,trace_or_throw_ex(transform_holds_3(Op,[P,A|ARGS],DBASE)), DBASE  univ_safe  [P,A|ARGS].
 2053transform_holds_3(Op,DBASE_T,OUT):- DBASE_T  univ_safe  [P,A|ARGS],!,transform_holds_3(Op,[P,A|ARGS],OUT).
 2054
 2055
 2056
 2057%= 	 	 
 holds_args(?HOFDS, ?FIST) is semidet
Holds Arguments.
 2063holds_args([H|FIST],FISTO):- !, a(is_holds_true,H),!,FIST=FISTO.
 2064holds_args(HOFDS,FIST):- is_ftCompound(HOFDS),HOFDS  univ_safe  [H|FIST],a(is_holds_true,H),!.
 do_expand_args(?Op, ?Term, ?Term) is semidet
Do Expand Arguments.
 2071do_expand_args(_,Term,TermO):- \+ compound(Term),!,must(Term=TermO).
 2072do_expand_args(Exp,M:Sent,M:SentO):- atom(M),!,do_expand_args(Exp,Sent,SentO).
 2073do_expand_args(_,Term,Term):- safe_functor(Term,F,_),cheaply_u(rtArgsVerbatum(F)),!.
 2074do_expand_args(Exp,[L|IST],Out):- !,must(do_expand_args_l(Exp,[L|IST],Out)).
 2075do_expand_args(Exp,Term,Out):- Term  univ_safe  [P|ARGS],do_expand_args_pa(Exp,P,ARGS,Out).
 2076
 2077
 2078%= 	 	 
 do_expand_args_pa(?Exp, ?P, ?ARGS, ?Out) is semidet
Do Expand Arguments Pa.
 2085% allows ?- fully_expand(arity(isEach([X,TY,OO]),4),O).
 2086do_expand_args_pa(Exp,Exp,[ARGS|Some],Out):- (Some==[]),is_list(ARGS),!,member(Out,ARGS).
 2087% allows ?- fully_expand(arity(isEach(X,TY,OO),4),O).
 2088do_expand_args_pa(Exp,Exp,ARGS,Out):- !,member(Out,ARGS).
 2089do_expand_args_pa(Exp,P,ARGS,Out):- do_expand_args_l(Exp,ARGS,EARGS), Out  univ_safe  [P|EARGS].
 2090
 2091
 2092%= 	 	 
 do_expand_args_l(+Op, :TermA, :TermA) is semidet
Do Expand Arguments (list Version).
 2099% do_expand_args_l(Exp,ARGS,EARGS):- do_expand_args(Exp,A,E),do_expand_args_l(Exp,RGS,ARGS).
 2100
 2101do_expand_args_l(_,A,A):- is_ftVar(A),!.
 2102do_expand_args_l(Exp,[A|RGS],[E|ARGS]):- is_list(RGS),!,do_expand_args(Exp,A,E),do_expand_args_l(Exp,RGS,ARGS).
 2103do_expand_args_l(_,A,A).
 2104
 2105
 2106
 2107% :- mpred_trace_nochilds(functor_safe/2).
 2108% :- mpred_trace_nochilds(functor_safe/3).
 2109
 2110
 2111% ================================================
 2112%  expand_goal_correct_argIsa/2
 2113% ================================================
 2114
 2115%= 	 	 
 expands_on(?EachOf, ?Term) is semidet
Expands Whenever.

expands_on(EachOf,Term):-subst(Term,EachOf,foooz,Term2),!,Term2\=Term, \+ ((do_expand_args(EachOf,Term,O),O = Term)).

 2123%= 	 	 
 if_expands_on(?EachOf, ?Term, ?Call) is semidet
If Expands Whenever.

if_expands_on(EachOf,Term,Call):- expands_on(EachOf,Term),subst(Call,Term,O,OCall),!, forall(do_expand_args(EachOf,Term,O),OCall).

 2131/*
 2132%db_reop(WhatNot,Call) :- into_mpred_form(Call,NewCall),NewCall\=@=Call,!,db_reop(WhatNot,NewCall).
 2133db_reop(Op,Term):- expands_on(isEach,Term), !,forall(do_expand_args(isEach,Term,O),db_reop_l(Op,O)).
 2134db_reop(Op,Term):-db_reop_l(Op,Term).
 2135
 2136db_reop_l(query(_HLDS,Must),Call) :- !,preq(Must,Call).
 2137db_reop_l(Op,DATA):-no_loop_check(db_op0(Op,DATA)).
 2138
 2139 dm sg_hook(transform_holds(t,_What,props(ttSpatialType,[isa(isa),isa]))):-trace_or_throw_ex(dtrace).
 2140
 2141*/
 2142
 2143
 2144% expand_goal_correct_argIsa(A,A):-simple_code,!.
 2145
 2146%= 	 	 
 expand_goal_correct_argIsa(?A, ?B) is semidet
expand goal correct Argument (isa/2).
 2152expand_goal_correct_argIsa(A,B):- expand_goal(A,B).
 2153
 2154% db_op_simpler(query(HLDS,_),MODULE:C0,call_u(call,MODULE:C0)):- atom(MODULE), is_ftNonvar(C0),not(not(predicate_property(C0,_PP))),!. % , functor_catch(C0,F,A), dmsg_pretty(todo(unmodulize(F/A))), %trace_or_throw_ex(module_form(MODULE:C0)), %   db_op(Op,C0).
 2155
 2156%= 	 	 
 db_op_simpler(+Op, ?VALUE2, :TermARG3) is semidet
Database Oper. Simpler.
 2162db_op_simpler(Op,Sent,SentO):- call_last_is_var(db_op_simpler(Op,Sent,SentO)).
 2163
 2164db_op_simpler(_,TypeTerm,props(Inst,[isa(Type)|PROPS])):- TypeTerm  univ_safe  [Type,Inst|PROPS],is_ftNonvar(Inst),a(functorDeclares,Type),!.
 2165
 2166
 2167
 2168%= 	 	 
 2169
 2170%% db_op_sentence( ?Op, ?Prop, ?ARGS, ?C0) is semidet.
 2171%
 2172% Database Oper. Sentence.
 2173%
 2174db_op_sentence(_Op,Prop,ARGS,C0):- atom(Prop),!, C0  univ_safe  [Prop|ARGS].
 2175db_op_sentence(_Op,Prop,ARGS,C0):- C0  univ_safe  [t,Prop|ARGS].
 2176
 2177
 2178%=  :- was_export(simply_functors/3).
 2179
 2180%= 	 	 
 simply_functors(:PRED2Db_pred, ?Op, ?Wild) is semidet
Simply Functors.
 2186simply_functors(Db_pred,query(HLDS,Must),Wild):- once(into_mpred_form(Wild,Simpler)),Wild\=@=Simpler,!,call(Db_pred,query(HLDS,Must),Simpler).
 2187simply_functors(Db_pred,Op,Wild):- once(into_mpred_form(Wild,Simpler)),Wild\=@=Simpler,!,call(Db_pred,Op,Simpler).
 2188
 2189
 2190% -  dmsg_hook(db_op(query(HLDS,call),holds_t(ft_info,tCol,'$VAR'(_)))):-trace_or_throw_ex(dtrace).
 2191
 2192lin_visits(P,Visits):-attvar(P),get_attr(P,linv,num(Visits)),!.
 2193lin_visits(_,0).
 2194
 2195set_lin_visits(P,Visits):-attvar(P),get_attr(P,linv,NumVisits),!,setarg(1,NumVisits,Visits).
 2196set_lin_visits(P,Visits):-put_attr(P,linv,num(Visits)).
 2197
 2198linearize_headvar_dupes(In,Out,How):- 
 2199  term_variables(In,Vs),
 2200  linearize_headvar_dupes((=),In,Out,How),
 2201  maplist(del_attr_rl(linv),Vs).
 2202
 2203del_attr_rl(Attr,Vs):- del_attr(Vs,Attr).
 2204
 2205linearize_headvar_dupes(Equ,In,Out,How):- linearize_headvar_dupes(Equ,In,Out,true,How).
 2206linearize_headvar_dupes(_Equ,P,PO,Left,Connector):- 
 2207  (var(P),lin_visits(P,Visits)->Visits==0),!,
 2208  set_lin_visits(P,1),PO=P,Left=Connector.
 2209linearize_headvar_dupes(Equ,P,PO,Left,Connector):- var(P),!,PO=_,conjoin(Left,call(Equ,P,PO),Connector),!.
 2210linearize_headvar_dupes(_Equ,P,PO,Left,Connector):- \+ compound(P),PO=P,Connector=Left,!.
 2211linearize_headvar_dupes(Equ,[P1|M],[PO1|PL2],Left,Connector):-!, 
 2212  linearize_headvar_dupes(Equ,P1,PO1,Left,MID),
 2213  linearize_headvar_dupes(Equ,M,PL2,MID,Connector).
 2214linearize_headvar_dupes(Equ,P,PO,Left,Connector):-P  univ_safe  [F|M],
 2215 linearize_headvar_dupes(Equ,M,POL,Left,Connector),PO  univ_safe  [F|POL].
 2216
 2217
 2218fixed_syntax(I,O):- compound(I), with_vars_locked(I,fix_syntax(I,O))->I\=@=O.
 2219
 2220fix_syntax(P0,P0):- \+ compound(P0),!.
 2221fix_syntax(I,O):-sub_compound_of(I,~(P/Cond)), !,O= preventedWhen(P,{Cond}).
 2222fix_syntax(I,O):- sub_compound_of(I, (~P/Cond)), !,fix_syntax(~(P/Cond),O).
 2223fix_syntax(~I,O):- compound(I),linearize_headvar_dupes(I,M,Cond)->Cond\==true,!,O= preventedWhen(M,{Cond}).
 2224%fix_syntax(~I,O):- compound(I),linearize_headvar_dupes(I,M,Cond),!,O= preventedWhen(M,{Cond}).
 2225fix_syntax(I,O):- fixed_negations(I,M),fix_syntax(M,O).
 2226%fix_syntax(~P/Cond,O):-  !,O=(((P/Cond)==> ~P)).
 2227%fix_syntax((~P)/Cond,O):- !,O=((~P <- {Cond} )).
 2228%fix_syntax((~P)/Cond,O):- !,O=(((P/Cond)==> ~P)).
 2229%fix_syntax((~P)/Cond,O):- !,O=(((P/Cond)==> ~P)).
 2230%fix_syntax((~P)/Cond,O):- !,O=(((P/ (\+Cond)) ==> \+ ~P)).
 2231%fix_syntax(P/Cond,O):- mpred_literal_nonvar(P),!,O=((P <- { Cond } )).
 2232fix_syntax(P/Cond,O):- !,O=((P <- {Cond} )).
 2233fix_syntax(I, O):- sub_compound_of(I,((P/Cond):-B)),!,O=(P :- (B, Cond)).
 2234fix_syntax(P:-B,PP:-B):-!, fix_syntax(P,PP).
 2235% fix_syntax(I,O):- compound(I),linearize_headvar_dupes(I,PL,Cond)->Cond\==true,!,O= enabledWhen(PL,{Cond}).
 2236fix_syntax(P,P).
 2237
 2238sub_compound_of(I,Of):- compound(I),compound(Of),compound_name_arity(I,IN,IA),compound_name_arity(Of,ON,OA),
 2239   (IA\==OA ; IN\==ON),!,fail.  
 2240sub_compound_of(I,Of):- \+ \+ (numbervars(I,99,_,[attvar(bind)]),I=Of ), I = Of.
 2241
 2242fixed_negations(I,O):- compound(I), with_some_vars_locked(I,fix_negations(I,O))->I\=@=O.
 2243
 2244fix_negations(P0,P0):- not_ftCompound(P0),!.
 2245fix_negations(~(P0),~(P0)):- not_ftCompound(P0),!.
 2246fix_negations(\+(P0),\+(P0)):- not_ftCompound(P0),!.
 2247fix_negations(\+ \+ (P0), (P0)):- not_ftCompound(P0),!.
 2248
 2249fix_negations(\+ \+ (I), (O)):- !, fix_negations((I), (O)).
 2250
 2251fix_negations(P==>Q, PP==>QQ):-!,
 2252  fix_negations(P,PP),
 2253  fix_negations(Q,QQ),!.
 2254
 2255fix_negations(~(~I),O):- !, fix_negations(\+(~I),O).
 2256fix_negations(~not(I),O):- !, fix_negations(\+(~I),O).
 2257fix_negations(~~(I),O):- safe_functor(~~(I),~~,1),!, fix_negations(\+(~I),O).
 2258fix_negations(not(I),O):- !, fix_negations(\+(I),O).
 2259fix_negations(~(I),~(O)):- !, fix_negations(I,O).
 2260fix_negations(\+(I),\+(O)):- !, fix_negations(I,O).
 2261fix_negations(C,C):- if_defined(exact_args(C),fail),!.
 2262fix_negations([H|T],[HH|TT]):-!,fix_negations(H,HH),fix_negations(T,TT),!.
 2263fix_negations(C,CO):-C  univ_safe  [F|CL],must_maplist(fix_negations,CL,CLO),!,CO  univ_safe  [F|CLO].
 reduce_clause_from_fwd(Op, +H, ?H) is semidet
Reduce Clause Converted From Forward Repropigated.
 2270reduce_clause_from_fwd(_Op,H,H):- quietly(\+is_ftCompound(H)),!.
 2271reduce_clause_from_fwd(Op,(H:-B),HH):-B==true,reduce_clause_from_fwd(Op,H,HH).
 2272reduce_clause_from_fwd(Op,(B==>H),HH):-B==true,reduce_clause_from_fwd(Op,H,HH).
 2273reduce_clause_from_fwd(Op,I,O):- quietly(fixed_negations(I,M)),!,reduce_clause_from_fwd(Op,M,O).
 2274reduce_clause_from_fwd(Op,(==>H),HH):-!,reduce_clause_from_fwd(Op,H,HH).
 2275reduce_clause_from_fwd(Op,(H<- B),HH):-B==true,reduce_clause_from_fwd(Op,H,HH).
 2276reduce_clause_from_fwd(Op,(B<==> H),HH):-B==true,reduce_clause_from_fwd(Op,'==>'(H),HH).
 2277reduce_clause_from_fwd(Op,(H<==> B),HH):-B==true,reduce_clause_from_fwd(Op,H,HH).
 2278reduce_clause_from_fwd(Op,(H,B),(HH,BB)):-!,reduce_clause_from_fwd(Op,H,HH),reduce_clause_from_fwd(Op,B,BB).
 2279reduce_clause_from_fwd(_Op,H,H).
 2280        
 2281
 2282
 2283%% append_as_first_arg( +C, ?I, ?V) is semidet.
 2284%
 2285% Append Converted To First Argument.
 2286%
 2287append_as_first_arg(C,I,V):-C  univ_safe  [F|ARGS],V  univ_safe  [F,I|ARGS].
 to_predicate_isas(:TermV, :TermV) is semidet
Converted To Predicate Isas.
 2295to_predicate_isas(V,V):- (\+is_ftCompound(V)),!.
 2296to_predicate_isas({V},{V}):-!.
 2297% to_predicate_isas(eXact(V),V):-!.
 2298to_predicate_isas([H|T],[HH|TT]):-!,to_predicate_isas(H,HH),to_predicate_isas(T,TT),!.
 2299to_predicate_isas((H,T),(HH,TT)):-!,to_predicate_isas(H,HH),to_predicate_isas(T,TT),!.
 2300%to_predicate_isas(I,I):-contains_term(S,I),is_ftNonvar(S),exact_args(S),!.
 2301to_predicate_isas(t(C,I),V):-atom(C)->V  univ_safe  [C,I];(is_ftVar(C)->V=t(C,I);append_as_first_arg(C,I,V)).
 2302to_predicate_isas(isa(I,C),V):-!,(atom(C)->V  univ_safe  [C,I];(is_ftVar(C)->V=isa(I,C);append_as_first_arg(C,I,V))).
 2303to_predicate_isas(C,C):- exact_args(C),!.
 2304to_predicate_isas(C,CO):-C  univ_safe  [F|CL],must_maplist(to_predicate_isas,CL,CLO),!,CO  univ_safe  [F|CLO].
 exact_args(+Q) is semidet
Exact Arguments.
 2311exact_args(Q):- is_ftVar(Q),!,fail.
 2312exact_args(Q):- \+ compound(Q), !.
 2313exact_args(isEach):-!,fail.
 2314%exact_args(_:Q):- !,(exact_args0(Q),fail).
 2315exact_args(_:Q):- !,(exact_args0(Q)).
 2316exact_args(Q):- exact_args0(Q),!.
 2317
 2318
 2319
 2320exact_args0(Q):- \+ compound(Q), !.
 2321exact_args0((A/B)):- (is_ftVar(A);(number(B);is_ftVar(B))),!.
 2322exact_args0(==>(_,_)):-!,fail.
 2323% exact_args0(Q):- Q  univ_safe  [_,A],atomic(A),!.
 2324exact_args0(Q):- compound_name_arity(Q,F,A),A>0,!,exact_args_f(F),!.
 2325
 2326exact_args_f(-->).
 2327exact_args_f(if_defined).
 2328exact_args_f(txtConcatFn).
 2329exact_args_f(dif).
 2330
 2331exact_args_f(maplist).
 2332exact_args_f(action_info).
 2333exact_args_f(never_retract_u).
 2334exact_args_f(install_converter).
 2335exact_args_f(installed_converter).
 2336exact_args_f(actn).
 2337exact_args_f(wid).
 2338exact_args_f(wdmsg_pretty).
 2339exact_args_f(fol_to_pkif).
 2340exact_args_f(ftListFn).
 2341exact_args_f(vtActionTemplate).
 2342exact_args_f(txtConcatFn).
 2343exact_args_f(spft).
 2344exact_args_f(skip_expand_fa).
 2345exact_args_f(sformat).
 2346exact_args_f(second_order).
 2347exact_args_f(retract_eq_quitely).
 2348exact_args_f(not_undoable).
 2349exact_args_f(mtExact).
 2350exact_args_f(vQuotientFn).
 2351exact_args_f(uSubLQuoteFn).
 2352exact_args_f(mpred_prop).
 2353exact_args_f(mpred_ain).
 2354exact_args_f(meta_argtypes_guessed).
 2355exact_args_f(meta_argtypes).
 2356exact_args_f(ignore).
 2357exact_args_f(format).
 2358exact_args_f(dynamic).
 2359exact_args_f(dmsg_pretty).
 2360exact_args_f(call_u).
 2361exact_args_f(say).
 2362exact_args_f(call).
 2363exact_args_f(assertz_if_new).
 2364exact_args_f(asserts_eq_quitely).
 2365exact_args_f(asserted).
 2366exact_args_f(rtArgsVerbatum).
 2367exact_args_f((  univ_safe  )).
 2368exact_args_f((=)).
 2369exact_args_f('$was_imported_kb_content$'):-!. %dtrace.
 2370exact_args_f(F):-clause_b(rtArgsVerbatum(F)),!.
 2371exact_args_f(F):-cheaply_u(prologBuiltin(F)),!.
 2372
 2373:- source_location(F,_),asserta(absolute_source_location_pfc(F)). 2374% exact_args((_:-_)).
 2375% exact_args((:-( _))).
 2376% exact_args(C):-source_file(C,I),absolute_source_location_pfc(I).
 2377
 2378
 2379:- module_transparent(is_stripped_module/1). 2380
 2381
 2382%= 	 	 
 2383
 2384%% db_quf_l( ?Op, ?And, ?C12, ?Pre2, ?Templ2) is semidet.
 2385%
 2386% Database Quf (list Version).
 2387%
 2388db_quf_l(Op,And,[C],D2,D4):- !, db_quf(Op,C,D2,D3),!,D4  univ_safe  [And,D3].
 2389db_quf_l(Op,And,C12,Pre2,Templ2):-db_quf_l_0(Op,And,C12,Pre2,Templ2).
 2390
 2391
 2392%= 	 	 
 db_quf_l_0(?Op, ?And, :TermC, ?D2, ?D3) is semidet
Database quf (List version) Primary Helper.
 2398db_quf_l_0(Op,_And,[C],D2,D3):- db_quf(Op,C,D2,D3),!.
 2399db_quf_l_0(Op, And,[C|C12],PreO,TemplO):-
 2400  db_quf(Op,C,Pre,Next),
 2401  db_quf_l_0(Op,And,C12,Pre2,Templ2),
 2402  conjoin_l(Pre,Pre2,PreO),
 2403  conjoin_op(And,Next,Templ2,TemplO).
 2404
 2405%=  :- was_export(db_quf/4).
 2406
 2407%= 	 	 
 db_quf(+Op, ?C, ?Pretest, ?Template) is semidet
Database Quf.
 2414db_quf(Op,C,Template):- db_quf(Op,C,true,Template),!.
 2415
 2416db_quf(_ ,C,Pretest,Template):- (not_ftCompound(C)),!,must(Pretest=true),must(Template=C).
 2417db_quf(Op,C,Pretest,Template):-is_ftVar(C),!,trace_or_throw_ex(var_db_quf(Op,C,Pretest,Template)).
 2418db_quf(_ ,C,Pretest,Template):-as_is_term(C),!,must(Pretest=true),must(Template=C),!.
 2419
 2420db_quf(Op,M:C,Pretest,M:Template):-atom(M),!,must(db_quf(Op,C,Pretest,Template)).
 2421
 2422db_quf(Op,C,Pretest,Template):- C  univ_safe  [Holds,OBJ|ARGS],a(is_holds_true,Holds),atom(OBJ),!,C1  univ_safe  [OBJ|ARGS],must(db_quf(Op,C1,Pretest,Template)).
 2423db_quf(_Op,C,true,C):- C  univ_safe  [Holds,OBJ|_],a(is_holds_true,Holds),is_ftVar(OBJ),!.
 2424db_quf(Op,Sent,D2,D3):- Sent  univ_safe  [And|C12],C12=[_|_],is_sentence_functor(And),!, db_quf_l(Op,And,C12,D2,D3).
 2425db_quf(Op,C,Pretest,Template):- C  univ_safe  [Prop,OBJ|ARGS],
 2426      safe_functor(C,Prop,A),
 2427      show_failure(why,translate_args(Op,Prop,A,OBJ,2,ARGS,NEWARGS,true,Pretest)),
 2428      Template   univ_safe   [Prop,OBJ|NEWARGS],!.
 2429db_quf(_Op,C,true,C).
 2430
 2431
 2432%= 	 	 
 translate_args(?O, ?Prop, ?A, ?OBJ, ?N, :TermARG6, :TermARG7, ?GIN, ?GIN) is semidet
Translate Arguments.
 2438translate_args(_O,_Prop,_A,_OBJ,_N,[],[],GIN,GIN).
 2439translate_args(Op,Prop,A,OBJ,N1,[ARG|S],[NEW|ARGS],GIN,GOALS):-
 2440   Type = argIsaFn(Prop,N1),
 2441   translateOneArg(Op,Prop,OBJ,Type,ARG,NEW,GIN,GMID),
 2442   N2 is N1 +1,
 2443   translate_args(Op,Prop,A,OBJ,N2,S,ARGS,GMID,GOALS).
 2444
 2445
 2446% ftVar
 2447
 2448%= 	 	 
 translateOneArg(?Op, ?Prop, ?Obj, ?Type, ?VAR, ?VAR, ?G, ?G) is semidet
Translate One Argument.
 2454translateOneArg(_Op,_Prop,_Obj,_Type,VAR,VAR,G,G):-is_ftVar(VAR),!.
 2455
 2456% not an expression
 2457translateOneArg(_O,_Prop,_Obj,_Type,ATOMIC,ATOMIC,G,G):-atomic(ATOMIC),!.
 2458% translateOneArg(_O,_Prop,_Obj,Type,ATOMIC,ATOMICUSE,G,(G,same_arg(tCol(Type),ATOMIC,ATOMICUSE))):-atomic(ATOMIC),!.
 2459
 2460% translateOneArg(_O,_Prop,_Obj,Type,VAR,VAR,G,G):-ignore(isa(VAR,Type)),!.
 2461
 2462% props(Obj,size < 2).
 2463translateOneArg(_O,Prop,Obj,Type,ARG,OLD,G,(GETTER,COMPARE,G)):-
 2464       safe_functor(ARG,F,2), comparitiveOp(F),!,
 2465       ARG  univ_safe  [F,Prop,VAL],
 2466       GETTER  univ_safe  [Prop,Obj,OLD],
 2467       COMPARE= compare_op(Type,F,OLD,VAL),!.
 2468
 2469% props(Obj,isOneOf(Sz,[size+1,2])).
 2470translateOneArg(Op,Prop,O,Type,isOneOf(VAL,LIST),VAL,G,(G0,G)):-
 2471   translateListOps(Op,Prop,O,Type,VAL,LIST,G,G0).
 2472
 2473% db_op(Op, Obj,size + 2).
 2474translateOneArg(_O,Prop,Obj,_Type,ARG,NEW,G,(GETTER,STORE,G)):-
 2475       ground(ARG),
 2476       safe_functor(ARG,F,2), additiveOp(F),!,
 2477       ARG  univ_safe  [F,Prop,VAL],
 2478       GETTER  univ_safe  [Prop,Obj,OLD],
 2479       STORE= update_value(OLD,VAL,NEW),!.
 2480
 2481translateOneArg(_O,_Prop,_Obj,_Type,NART,NART,G,G):-!. % <- makes us skip the next bit of code
 2482translateOneArg(_O,_Prop,_Obj,Type,ATOMIC,ATOMICUSE,G,(G,ignore(same_arg(tCol(Type),ATOMIC,ATOMICUSE)))).
 2483
 2484
 2485%= 	 	 
 translateListOps(?O, ?Prop, ?Obj, ?Type, ?VAL, :TermARG6, ?G, ?G) is semidet
Translate List Oper.s.
 2491translateListOps(_O,_Prop,_Obj,_Type,_VAL,[],G,G).
 2492translateListOps(Op,Prop,Obj,Type,VAL,[L|LIST],G,GO2):-
 2493   translateOneArg(Op,Prop,Obj,Type,L,VAL,G,G0),
 2494   translateListOps(Op,Prop,Obj,Type,VAL,LIST,G0,GO2).
 2495
 2496
 2497%= 	 	 
 compare_op(?Type, :PRED2F, ?OLD, ?VAL) is semidet
Compare Oper..
 2503compare_op(Type,F,OLD,VAL):-nop(Type),show_call(why,(call(F,OLD,VAL))),!.
 2504
 2505
 2506% load_motel:- defrole([],time_state,restr(time,period)).
 2507% :-load_motel.
 2508
 2509% ========================================
 2510% expanded_different compares fact terms to see if they are different
 2511% ========================================
 2512
 2513:- '$hide'(expanded_different/2). 2514%=  :- was_export(expanded_different/2).
 2515
 2516
 2517%= 	 	 
 expanded_different(?G0, ?G1) is semidet
Expanded Different.
 2523expanded_different(G0,G1):-call(expanded_different_ic(G0,G1)).
 2524
 2525
 2526%= 	 	 
 expanded_different_ic(?G0, ?G1) is semidet
Expanded Different Ic.
 2532expanded_different_ic(G0,G1):-G0==G1,!,fail.
 2533expanded_different_ic(G0,G1):-expanded_different_1(G0,G1),!.
 2534expanded_different_ic(G0,G1):- G0\==G1.
 2535
 2536
 2537%= 	 	 
 expanded_different_1(?G0, :TermG1) is semidet
expanded different Secondary Helper.
 2543expanded_different_1(NV:G0,G1):-is_ftNonvar(NV),!,expanded_different_1(G0,G1).
 2544expanded_different_1(G0,NV:G1):-is_ftNonvar(NV),!,expanded_different_1(G0,G1).
 2545expanded_different_1(G0,G1):- (is_ftVar(G0);is_ftVar(G1)),!,trace_or_throw_ex(expanded_different(G0,G1)).
 2546expanded_different_1(G0,G1):- G0 \= G1,!.
 2547
 2548
 2549% ========================================
 2550% into_functor_form/3 (adds a second order safe_functor onto most predicates)
 2551% ========================================
 2552%=  :- was_export(into_functor_form/3).
 2553
 2554%= 	 	 
 into_functor_form(?HFDS, ?X, ?O) is semidet
Converted To Functor Form.
 2560into_functor_form(HFDS,M:X,M:O):- atom(M),! ,into_functor_form(HFDS,X,O),!.
 2561into_functor_form(HFDS,X,O):-call((( X  univ_safe  [F|A],into_functor_form(HFDS,X,F,A,O)))),!.
 2562
 2563% TODO finish negations
 2564
 2565%= 	 	 
 into_functor_form(?Dbase_t, ?X, ?Dbase_t, ?A, ?X) is semidet
Converted To Functor Form.
 2571into_functor_form(Dbase_t,X,Dbase_t,_A,X):-!.
 2572into_functor_form(Dbase_t,_X,holds_t,A,Call):-Call  univ_safe  [Dbase_t|A].
 2573into_functor_form(Dbase_t,_X,t,A,Call):-Call  univ_safe  [Dbase_t|A].
 2574% into_functor_form(Dbase_t,_X,HFDS,A,Call):- a(is_holds_true,HFDS), Call  univ_safe  [Dbase_t|A].
 2575into_functor_form(Dbase_t,_X,F,A,Call):-Call  univ_safe  [Dbase_t,F|A].
 2576
 2577
 2578% these do not get defined!?%= :- kb_shared user_db:assert_user/2, user_db:grant_openid_server/2, user_db:retractall_grant_openid_server/2, user_db:retractall_user/2, user_db:assert_grant_openid_server/2.
 2579
 2580
 2581:- fixup_exports. 2582
 2583:- export(mpred_expansion_file/0). 2584mpred_expansion_file