2%:- gripe_time(60,baseKB:ensure_loaded(library('logicmoo/plarkc/logicmoo_i_cyc_rewriting'))).
    3
    4
    5:- mpred_unload_file.    6:- set_fileAssertMt(baseKB).    7% ensure this file does not get unloaded with mpred_reset
    8:- prolog_load_context(file,F), ain(mpred_unload_option(F,never)).    9%:- listing(mpred_unload_option/2).
   10
   11:- set_prolog_flag_until_eof(do_renames,term_expansion).   12:- install_constant_renamer_until_eof.   13
   14:- file_begin(pfc).   15
   16ttBarrierStr(A),{atomic_list_concat([A,"Type"],AType0),
   17  atomic_list_concat([A,''],Type0),
   18  if_defined(do_renames(Type0,Type),true),
   19  if_defined(do_renames(AType0,TypeType),true)} ==> barrierSpindle(TypeType,Type).
   20
   21
   22:- if(false).   23:- set_prolog_flag(gc,true).   24:- trim_stacks.   25:- garbage_collect_atoms.   
   26:- garbage_collect_clauses.   27:- garbage_collect.   28:- statistics.   29% :- set_prolog_flag(gc,false).
   30:- endif.   31
   32
   33barrierSpindle(TypeType,Type)==> 
   34   generatesAsFirstOrder(Type), isa(TypeType,ttBarrierType),isa(Type,ttBarrier),typeGenls(TypeType,Type).
   35
   36ttBarrier(C)==>tSet(C).
   37(ttBarrierType(C)==>(tSet(C),ttTypeType(C))).
   38
   39/*
   40
   41@ TODO RE-ENABLE WHEN NEEDED
   42ttBarrier(C)==>(isa(I,C)==>mainClass(I,C)).
   43
   44ttBarrier(A)/dif(A,B),ttBarrier(B)==> disjointWith(A,B).
   45% ttBarrierType(A)/dif(A,B),ttBarrierType(B)==> disjointWith(A,B).
   46
   47*/
   48
   49ttBarrierStr("Action").
   50ttBarrierStr("Agent").
   51ttBarrierStr("Artifact").
   52barrierSpindle('ttSpecifiedPartTypeCollection','tPartTypePhysicalPartOfObject').
   53ttBarrierStr("Capability").
   54ttBarrierStr("Event").
   55ttBarrierStr("FormulaTemplate").
   56ttBarrierStr("Goal").
   57ttBarrierStr("Group").
   58ttBarrierStr("LinguisticObject").
   59ttBarrierStr("Microtheory").
   60ttBarrierStr("PersonTypeByActivity").
   61ttBarrierStr("Place").
   62ttBarrierStr("Quantity").
   63ttBarrierStr("Relation").
   64ttBarrierStr("ScalarInterval").
   65ttBarrierStr("Situation").
   66ttBarrierStr("ExpressionType").
   67ttBarrierStr("TimeParameter").
   68ttBarrierStr("Topic").
   69% ttBarrierStr("Collection").