2:- module(drs2fdrs,[eqDrs/2,         %%% should go in its own module!
    3                    instDrs/1,
    4                    instDrs/2]).    5
    6:- use_module(library(lists),[select/3,member/2]).    7:- use_module(semlib(options),[option/2]).    8
    9
   10/*========================================================================
   11   Dynamic  Predicates
   12========================================================================*/
   13
   14:- dynamic refcounter/2.   15
   16
   17/*========================================================================
   18  Init Counters
   19========================================================================*/
   20
   21init:- 
   22   retractall(refcounter(_,_)),
   23   assert(refcounter(116,1)), % t
   24   assert(refcounter(118,1)), % l
   25   assert(refcounter(120,1)), % x
   26   assert(refcounter(115,1)), % s
   27   assert(refcounter(112,1)), % p
   28   assert(refcounter(101,1)), % e
   29   assert(refcounter(102,1)), % f
   30   assert(refcounter(107,1)), % k
   31   assert(refcounter( 98,1)). % b
   32
   33
   34
   35/*========================================================================
   36   Main Predicates
   37========================================================================*/
   38
   39instDrs(B):- 
   40   init, 
   41   instantDrs(B).
   42
   43instDrs(B,N):- 
   44   init, 
   45   instantDrs(B), 
   46   refcounter(107,K),
   47   refcounter(101,E),
   48   N is K+E.
   49
   50
   51/*========================================================================
   52   Variable
   53========================================================================*/
   54
   55avar(Var):- var(Var), !.
   56avar(Var):- atom(Var), !.
   57avar(Var):- functor(Var,'$VAR',1).
   58
   59
   60/*========================================================================
   61   Referent
   62========================================================================*/
   63
   64ref(Ref,Code):-
   65   var(Ref), !,
   66   getIndex(Code,X),
   67   number_codes(X,Codes),
   68   atom_codes(Ref,[Code|Codes]).
   69
   70ref(_,_).
   71
   72
   73/*========================================================================
   74   Get Index
   75========================================================================*/
   76
   77getIndex(Sort,X):-
   78   refcounter(Sort,X), !,
   79   retract(refcounter(Sort,X)),
   80   Y is X + 1,
   81   assert(refcounter(Sort,Y)).
   82
   83getIndex(Sort,X):- 
   84   \+ Sort = 120,
   85   getIndex(120,X).
   86
   87
   88/*========================================================================
   89   Sort Referent: time (116), event (101), proposition (112), entity (120)
   90========================================================================*/
   91
   92sortref(X,Conds,116):- member(_:_:pred(Y,now,a,1),Conds), X==Y, !.
   93sortref(X,Conds,116):- member(_:_:rel(_,Y,temp_overlap,1),Conds), X==Y, !.
   94sortref(X,Conds,116):- member(_:_:rel(_,Y,temp_before,1),Conds), X==Y, !.
   95sortref(X,Conds,116):- member(_:_:rel(Y,_,temp_before,1),Conds), X==Y, !.
   96sortref(X,Conds,116):- member(_:_:rel(_,Y,temp_included,1),Conds), X==Y, !.
   97
   98sortref(X,Conds,101):- member(_:_:pred(Y,_,v,_),Conds), X==Y, !.
   99sortref(X,Conds,101):- member(_:_:rel(_,Y,temp_abut,1),Conds), X==Y, !.
  100sortref(X,Conds,101):- member(_:_:rel(Y,_,temp_abut,1),Conds), X==Y, !.
  101sortref(X,Conds,101):- member(_:_:rel(Y,_,temp_overlap,1),Conds), X==Y, !.
  102
  103sortref(X,Conds,120):- member(_:_:pred(Y,_,n,_),Conds), X==Y, !.
  104sortref(X,Conds,115):- member(_:_:pred(Y,_,a,_),Conds), X==Y, !.
  105
  106sortref(X,Conds,112):- member(_:_:prop(Y,_),Conds), X==Y, !.
  107sortref(_,_    ,120).
  108
  109
  110/*========================================================================
  111   Instantiating DRSs
  112========================================================================*/
  113
  114instantDrs(Var):- var(Var), !, ref(Var,102).
  115
  116instantDrs(Var):- atom(Var), !.
  117
  118instantDrs(Var):- Var =.. ['$VAR',_], !.
  119
  120instantDrs(drs([_:Ref|Dom],Conds)):- !,
  121   sortref(Ref,Conds,Sort),
  122   ref(Ref,Sort), 
  123   instantDrs(drs(Dom,Conds)).
  124
  125instantDrs(B:drs([Lab:_:Ref|Dom],Conds)):- !,
  126   ref(Lab,98), 
  127   sortref(Ref,Conds,Sort),
  128   ref(Ref,Sort), 
  129   instantDrs(B:drs(Dom,Conds)).
  130
  131instantDrs(B:drs([],Conds)):- !,
  132   ref(B,98), 
  133   instantConds(Conds).
  134
  135instantDrs(drs([],Conds)):- !,
  136   instantConds(Conds).
  137
  138instantDrs(merge(A1,A2)):- !,
  139   instantDrs(A1),
  140   instantDrs(A2).
  141
  142instantDrs(sdrs([],_)):- !.
  143
  144instantDrs(sdrs([X|L],C)):- !,
  145   instantDrs(X),
  146   instantDrs(sdrs(L,C)).
  147
  148instantDrs(lab(K,B)):- !,
  149   ref(K,107),
  150   instantDrs(B).
  151
  152instantDrs(sub(B1,B2)):- !,
  153   instantDrs(B1),
  154   instantDrs(B2).
  155
  156instantDrs(alfa(_,A1,A2)):- !,
  157   instantDrs(A1),
  158   instantDrs(A2).
  159
  160instantDrs(app(A1,A2)):- !,
  161   instantDrs(A1),
  162   instantDrs(A2).
  163
  164instantDrs(lam(X,A)):- !,
  165   ref(X,118),
  166   instantDrs(A).
  167
  168
  169/*========================================================================
  170   Instantiating DRS-Conditions
  171========================================================================*/
  172
  173instantConds([]).
  174
  175instantConds([Label:_:Cond|Conds]):- !,
  176   ref(Label,98),
  177   instantCond(Cond),
  178   instantConds(Conds).
  179
  180instantConds([_:Cond|Conds]):- !,
  181   instantCond(Cond),
  182   instantConds(Conds).
  183
  184
  185/*========================================================================
  186   Instantiating DRS-Condition
  187========================================================================*/
  188
  189instantCond(imp(A1,A2)):- !, instantDrs(A1), instantDrs(A2).
  190
  191instantCond(or(A1,A2)):- !,  instantDrs(A1), instantDrs(A2).
  192
  193instantCond(duplex(_,A1,_,A2)):- !, instantDrs(A1), instantDrs(A2).
  194
  195instantCond(not(A)):- !, instantDrs(A).
  196
  197instantCond(nec(A)):- !, instantDrs(A).
  198
  199instantCond(pos(A)):- !, instantDrs(A).
  200
  201instantCond(prop(_,A)):- !, instantDrs(A).
  202
  203instantCond(_).
  204
  205
  206/*========================================================================
  207   Eliminate Equality from DRS 
  208========================================================================*/
  209
  210eqDrs(xdrs(Tags,DRS1),xdrs(Tags,DRS2)):-
  211   option('--elimeq',true), !,
  212   elimEqDrs(DRS1,DRS2).
  213
  214eqDrs(DRS1,DRS2):-
  215   option('--elimeq',true), !,
  216   elimEqDrs(DRS1,DRS2).
  217
  218eqDrs(DRS,DRS).
  219
  220
  221/*========================================================================
  222   Eliminate Equality
  223========================================================================*/
  224
  225elimEqDrs(Var,Var):- avar(Var), !.
  226
  227elimEqDrs(B:drs(Dom1,Conds1),B:drs(Dom2,Conds2)):-
  228   elimEqConds(Conds1,Conds2,Dom1,Dom2).
  229
  230elimEqDrs(merge(A1,A2),merge(B1,B2)):-
  231   elimEqDrs(A1,B1),
  232   elimEqDrs(A2,B2).
  233
  234elimEqDrs(sub(A1,A2),sub(B1,B2)):-
  235   elimEqDrs(A1,B1),
  236   elimEqDrs(A2,B2).
  237
  238elimEqDrs(sdrs([],C),sdrs([],C)).
  239
  240elimEqDrs(sdrs([X1|L1],C1),sdrs([X2|L2],C2)):-
  241   elimEqDrs(X1,X2),
  242   elimEqDrs(sdrs(L1,C1),sdrs(L2,C2)).
  243
  244elimEqDrs(alfa(T,A1,A2),alfa(T,B1,B2)):-
  245   elimEqDrs(A1,B1),
  246   elimEqDrs(A2,B2).
  247
  248elimEqDrs(lab(X,A1),lab(X,B1)):-
  249   elimEqDrs(A1,B1).
  250
  251elimEqDrs(lam(X,A1),lam(X,B1)):-
  252   elimEqDrs(A1,B1).
  253
  254elimEqDrs(app(A1,A2),app(B1,B2)):-
  255   elimEqDrs(A1,B1),
  256   elimEqDrs(A2,B2).
  257
  258
  259/*========================================================================
  260   Instantiating DRS-Conditions
  261========================================================================*/
  262
  263elimEqConds([],[],D,D).
  264
  265elimEqConds([B:I:imp(A1,A2)|Conds1],[B:I:imp(B1,B2)|Conds2],D1,D2):- !,
  266   elimEqDrs(A1,B1),
  267   elimEqDrs(A2,B2),
  268   elimEqConds(Conds1,Conds2,D1,D2).
  269
  270elimEqConds([B:I:or(A1,A2)|Conds1],[B:I:or(B1,B2)|Conds2],D1,D2):- !,
  271   elimEqDrs(A1,B1),
  272   elimEqDrs(A2,B2),
  273   elimEqConds(Conds1,Conds2,D1,D2).
  274
  275elimEqConds([B:I:duplex(X,A1,T,A2)|Conds1],[B:I:duplex(X,B1,T,B2)|Conds2],D1,D2):- !,
  276   elimEqDrs(A1,B1),
  277   elimEqDrs(A2,B2),
  278   elimEqConds(Conds1,Conds2,D1,D2).
  279
  280elimEqConds([B:I:not(A1)|Conds1],[B:I:not(B1)|Conds2],D1,D2):- !,
  281   elimEqDrs(A1,B1),
  282   elimEqConds(Conds1,Conds2,D1,D2).
  283
  284elimEqConds([B:I:nec(A1)|Conds1],[B:I:nec(B1)|Conds2],D1,D2):- !,
  285   elimEqDrs(A1,B1),
  286   elimEqConds(Conds1,Conds2,D1,D2).
  287
  288elimEqConds([B:I:pos(A1)|Conds1],[B:I:pos(B1)|Conds2],D1,D2):- !,
  289   elimEqDrs(A1,B1),
  290   elimEqConds(Conds1,Conds2,D1,D2).
  291
  292elimEqConds([B:I:prop(X,A1)|Conds1],[B:I:prop(X,B1)|Conds2],D1,D2):- !,
  293   elimEqDrs(A1,B1),
  294   elimEqConds(Conds1,Conds2,D1,D2).
  295
  296elimEqConds([_:_:eq(X,Y)|Conds1],Conds2,D1,D2):- 
  297   select(_:Z,D1,D3), X==Z, !, X=Y,
  298   elimEqConds(Conds1,Conds2,D3,D2).
  299
  300elimEqConds([_:_:eq(X,Y)|Conds1],Conds2,D1,D2):- 
  301   select(_:Z,D1,D3), Y==Z, !, X=Y,
  302   elimEqConds(Conds1,Conds2,D3,D2).
  303
  304elimEqConds([C|Conds1],[C|Conds2],D1,D2):- !,
  305   elimEqConds(Conds1,Conds2,D1,D2)