1% =====================================================
    2% File: sanity_tests.pl
    3% =====================================================
    4
    5:- use_module(library(multivar)).    6:- use_module(library(pfc_lib)).    7
    8isa(i1,c1).
    9predicate_function_canonical(isa,instanceOf).
   10
   11% weaken_goals/2 that converts arguments (from legacy code)
   12% into metaterms which allow logical constraints to be placed upon unification
   13% in the case of atoms, they are "weakened" to non ground terms
   14predicate_hold_aliases(Spec),{mpred_functor(Spec,F,A),functor(P,F,A)} 
   15  ==> (  P, { weaken_goal(P,Q) } ==> {ignore(call(retract,P))},Q ).
   16       
   17predicate_hold_aliases(loves/2).
   18
   19% the predicate is weakened on read (all args)
   20loves(sue,joe).
   21loves(joe,fred).
   22
   23/*
   24?- loves(X,joe).
   25X = _{ '$value'= X, iz = sue}.
   26*/
   27
   28% so that one may use "typed unification"
   29tFemale(sue).
   30~tFemale(joe).
   31
   32/*
   33?-  use_module(library(attvar_reader)).  % allows attvars to be read from files and console
   34
   35?- loves( X{iza=tFemale},joe).
   36X = _{ '$value'= X, iz = sue, iza=[tFemale]}.
   37Yes.
   38
   39?- loves( sue, Y{iza=tFemale}).
   40Y = _{ '$value'= X, iz = fred}.
   41Yes.
   42
   43% this was Joe was asserted to specifically not to be a tFemale.
   44% However the gender of Fred is still unknown
   45
   46*/
   47
   48:- if(false).   49
   50%  @TODO  Move this to a different set of exmaples
   51% this gets hairy to the instances can belong to several intensional types, extensional collections and datatypes.
   52:- ensure_loaded(library('logicmoo/pfc/user_transitiveViaArg.pfc')).   53% both arguments must have at least some type attributes in common
   54meta_argtypes(loves(X,X)).  % 
   55
   56
   57:- endif.   58
   59% =====================================================