3:- mpred_unload_file.    4
    5:- set_prolog_flag_until_eof(do_renames,term_expansion).    6
    7:- file_begin(pfc).    8
    9:- set_fileAssertMt(baseKB).   10% ensure this file does not get unloaded with mpred_reset
   11:- prolog_load_context(file,F), ain(mpred_unload_option(F,never)).   12
   13argumentsConstrained(G):- cwc,ground(G),!.
   14
   15% Example specialized
   16%((transitiveViaArg(P,PT,2)/ \+(P==PT)),arity(P,2)) ==> (t(P,I,Sub):- (cwc, dif(Sub,Super),t(PT,Sub,Super),t(P,I,Super))).
   17%((transitiveViaArgInverse(P,PT,2)/ \+(P==PT)),arity(P,2))==> (t(P,I,Sub):- (cwc, dif(Sub,Super),t(PT,Super,Sub),t(P,I,Super))).
   18
   19functor_any(CONSQ,F,A):- cwc, length(IST,A),apply_term(F,IST,CONSQ),!.
   20
   21fa_replace_arg(F,A,N,CONSQ,CSLOT,ASLOT,ANTE):-cwc, 
   22   functor_any(CONSQ,F,A),arg(N,CONSQ,CSLOT),replace_arg(CONSQ,N,ASLOT,ANTE),!.
   23
   24% Example generalized
   25(((transitiveViaArg(P,B,N) ),   arity(P,A),{fa_replace_arg(P,A,N,CONSQ,CSLOT,ASLOT,ANTE), P\=B,BExpr =..[B,CSLOT,ASLOT]}) ==>  
   26  (CONSQ:- (cwc,argumentsConstrained(CONSQ),dif(CSLOT,ASLOT),call(BExpr), argumentsConstrained(ANTE),call(ANTE)))).
   27
   28(transitiveViaArgInverse(P,B,N),arity(P,A),{fa_replace_arg(P,A,N,CONSQ,CSLOT,ASLOT,ANTE), P\=B,BExpr =..[B,ASLOT,CSLOT]})==> 
   29  (CONSQ:- (cwc,argumentsConstrained(CONSQ),dif(CSLOT,ASLOT),call(BExpr), argumentsConstrained(ANTE),call(ANTE))).
   30
   31
   32coExtensional(A,B)==> 
   33  (((genls(A,Supers)<==>genls(B,Supers)) , (genls(Subs,A)<==>genls(Subs,B)),  (isa(I,A)<==>isa(I,B))),
   34  coExtensional(B,A)).
   35
   36%coExtensional(tPred,'Predicate').
   37%coExtensional(ttPredType,'PredicateType').
   38
   39:- dynamic(anatomicallyCapableOf/3).   40
   41ttRelationType('rtCapabilityPredicate').
   42isa(CAP_PRED,'rtCapabilityPredicate') ==> 
   43  transitiveViaArg(CAP_PRED,genls,2).
   44
   45
   46==> rtCapabilityPredicate(
   47 anatomicallyCapableOf('mobEmbodiedAgent','ttFirstOrderCollection','rtBinaryRolePredicate')).
   48
   49% disjointWith(A,B)==> (isa(I,A)==>~isa(I,B)).
   50
   51%transitiveViaArg(isa,genls,2).
   52%transitiveViaArg(genls,genls,2).
   53%transitiveViaArgInverse(genls,genls,1).
   54
   55/*       
   56
   57~coExtensional(A, C) :- cwc,
   58        isa(B, A),
   59        ~isa(B, C).
   60
   61~isa(B, A) :- cwc,
   62        coExtensional(A, C),
   63        ~isa(B, C).
   64
   65
   66isa(A, C) :- cwc,
   67        coExtensional(B, C),
   68        isa(A, B).
   69
   70"
   71(implies
   72    (and 
   73      (isa ?INST ?TYPE1) 
   74      (isa ?INST ?TYPE2) 
   75      (collectionIntersection2 ?INTERSECTION ?TYPE1 ?TYPE2)) 
   76    (isa ?INST ?INTERSECTION))
   77".
   78
   79*/
   80% :- (compiling -> dmsg("IS COMPILING");dmsg("NOT COMPILING")).
   81:- set_prolog_flag(do_renames,restore).