1:- module(reif,
    2    [if_/3,
    3     cond_t/3,
    4     (=)/3,
    5     dif/3,
    6     (',')/3,
    7     (;)/3,
    8     memberd_t/3,
    9     tmember/2,
   10     tmember_t/3,
   11     tfilter/3,
   12     tpartition/4
   13    ]).

Reified if, reification library

author
- Ulrich Neumerkel */
   21:- meta_predicate
   22    if_(1, 0, 0),
   23    cond_t(1, 0, ?),
   24    tfilter(2, ?, ?),
   25    tpartition(2, ?, ?, ?),
   26    ','(1, 1, ?),
   27    ;(1, 1, ?),
   28    tmember(2, ?),
   29    tmember_t(2, ?, ?).   30
   31:- op(900, fy, [$]).   32
   33% uwnportray(T) :- write_term(T,[quoted(true)]),nl.
   34
   35uwnportray(T) :- portray_clause(T).  % Item#539
   36
   37$(X) :- uwnportray(call-X),X,uwnportray(exit-X).
   38$(C,V1) :-
   39   $call(C,V1).
   40$(C,V1,V2) :-
   41   $call(C,V1,V2).
   42$(C,V1,V2,V3) :-
   43   $call(C,V1,V2,V3).
   44$(C,V1,V2,V3,V4) :-
   45   $call(C,V1,V2,V3,V4).
   46$(C,V1,V2,V3,V4,V5) :-
   47   $call(C,V1,V2,V3,V4,V5).
   48$(C,V1,V2,V3,V4,V5,V6) :-
   49   $call(C,V1,V2,V3,V4,V5,V6).
   50$(C,V1,V2,V3,V4,V5,V6,V7) :-
   51   $call(C,V1,V2,V3,V4,V5,V6,V7).
   52
   53goal_expanded(MG_0, MGx_0) :-
   54   var(MG_0),
   55   !,
   56   MG_0 = MGx_0.
   57goal_expanded(call(MG_1, X), MGx_0) :-
   58   MG_1 = M:G_1, atom(M), callable(G_1), G_1 \= (_:_),
   59   functor_(G_1, G_0, X),
   60   \+ predicate_property(M:G_0, (meta_predicate _)),
   61   !,
   62   MGx_0 = M:G_0.
   63goal_expanded(call(G_0), Gx_0) :-
   64   acyclic_term(G_0),
   65   nonvar(G_0),
   66   % more conditions
   67   !,
   68   G_0 = Gx_0.
   69goal_expanded(MG_0, MG_0).
   70
   71
   72functor_(T, TA, A) :-
   73   functor(T, F, N0),
   74   N1 is N0+1,
   75   functor(TA, F, N1),
   76   arg(N1, TA, A),
   77   sameargs(N0, T, TA).
   78
   79sameargs(N0, S, T) :-
   80   N0 > 0,
   81   N1 is N0-1,
   82   arg(N0, S, A),
   83   arg(N0, T, A),
   84   sameargs(N1, S, T).
   85sameargs(0, _, _).
   86
   87
   88/*
   89  no !s that cut outside.
   90  no variables in place of goals
   91  no malformed goals like integers
   92*/
   93
   94
   95/* 2do: unqualified If_1: error
   96*/
   97
   98:- multifile
   99        system:goal_expansion/2.  100:- dynamic
  101        system:goal_expansion/2.  102
  103system:goal_expansion(if_(If_1, Then_0, Else_0), G_0) :-
  104   ugoal_expansion(if_(If_1, Then_0, Else_0), G_0).
  105
  106ugoal_expansion(if_(If_1, Then_0, Else_0), Goal) :-
  107   nonvar(If_1), If_1 = (X = Y),
  108   goal_expanded(call(Then_0), Thenx_0),
  109   goal_expanded(call(Else_0), Elsex_0),
  110   !,
  111   Goal =
  112      ( X \= Y -> Elsex_0
  113      ; X == Y -> Thenx_0
  114      ; X = Y,    Thenx_0
  115      ; dif(X,Y), Elsex_0
  116      ).
  117ugoal_expansion(if_(If_1, Then_0, Else_0), Goal) :-
  118   subsumes_term((A_1;B_1), If_1),
  119   (A_1;B_1) = If_1,
  120   !,
  121   Goal = if_(A_1, Then_0, if_(B_1, Then_0, Else_0)).
  122ugoal_expansion(if_(If_1, Then_0, Else_0), Goal) :-
  123   subsumes_term((A_1,B_1), If_1),
  124   (A_1,B_1) = If_1,
  125   !,
  126   Goal = if_(A_1, if_(B_1, Then_0, Else_0), Else_0).
  127ugoal_expansion(if_(If_1, Then_0, Else_0), Goal) :-
  128   goal_expanded(call(If_1, T), Ifx_0),
  129   goal_expanded(call(Then_0), Thenx_0),
  130   goal_expanded(call(Else_0), Elsex_0),
  131   Goal =
  132      (  Ifx_0,
  133         (  T == true -> Thenx_0
  134         ;  T == false -> Elsex_0
  135         ;  nonvar(T) -> throw(error(type_error(boolean,T),
  136                               type_error(call(If_1,T),2,boolean,T)))
  137         ;  throw(error(instantiation_error,
  138                               instantiation_error(call(If_1,T),2)))
  139         )
  140      ).
  141
  142if_(If_1, Then_0, Else_0) :-
  143   call(If_1, T),
  144   (  T == true -> Then_0
  145   ;  T == false -> Else_0
  146   ;  nonvar(T) -> throw(error(type_error(boolean,T),
  147                               type_error(call(If_1,T),2,boolean,T)))
  148   ;  throw(error(instantiation_error,instantiation_error(call(If_1,T),2)))
  149   ).
  150
  151
  152tfilter(C_2, Es, Fs) :-
  153   i_tfilter(Es, C_2, Fs).
  154
  155i_tfilter([], _, []).
  156i_tfilter([E|Es], C_2, Fs0) :-
  157   if_(call(C_2, E), Fs0 = [E|Fs], Fs0 = Fs),
  158   i_tfilter(Es, C_2, Fs).
  159
  160tpartition(P_2, Xs, Ts, Fs) :-
  161   i_tpartition(Xs, P_2, Ts, Fs).
  162
  163i_tpartition([], _P_2, [], []).
  164i_tpartition([X|Xs], P_2, Ts0, Fs0) :-
  165   if_( call(P_2, X)
  166      , ( Ts0 = [X|Ts], Fs0 = Fs )
  167      , ( Fs0 = [X|Fs], Ts0 = Ts ) ),
  168   i_tpartition(Xs, P_2, Ts, Fs).
  169
  170=(X, Y, T) :-
  171   (  X == Y -> T = true
  172   ;  X \= Y -> T = false
  173   ;  T = true, X = Y
  174   ;  T = false,
  175      dif(X, Y)
  176   ).
  177
  178dif(X, Y, T) :-
  179  =(X, Y, NT),
  180  non(NT, T).
  181
  182non(true, false).
  183non(false, true).
  184
  185','(A_1, B_1, T) :-
  186   if_(A_1, call(B_1, T), T = false).
  187
  188;(A_1, B_1, T) :-
  189   if_(A_1, T = true, call(B_1, T)).
  190
  191cond_t(If_1, Then_0, T) :-
  192   if_(If_1, ( Then_0, T = true ), T = false ).
  193
  194memberd_t(E, Xs, T) :-
  195   i_memberd_t(Xs, E, T).
  196
  197i_memberd_t([], _, false).
  198i_memberd_t([X|Xs], E, T) :-
  199   if_( X = E, T = true, i_memberd_t(Xs, E, T) ).
  200
  201tmember(P_2, [X|Xs]) :-
  202   if_( call(P_2, X), true, tmember(P_2, Xs) ).
  203
  204tmember_t(P_2, [X|Xs], T) :-
  205   if_( call(P_2, X), T = true, tmember_t(P_2, Xs, T) )