2:- module(presupDRT,[resolveDrs/2,resolveDrs/3]).    3
    4:- use_module(boxer(mergeDRT),[mergeDrs/2]).    5:- use_module(boxer(bindingViolation),[bindingViolationDrs/1]).    6:- use_module(boxer(freeVarCheck),[freeVarCheckDrs/1]).    7:- use_module(boxer(sortalCheck),[sortalCheckDrs/2]).    8:- use_module(library(lists),[member/2,append/3,select/3]).    9:- use_module(semlib(options),[option/2]).   10:- use_module(semlib(errors),[warning/2]).   11
   12/* ========================================================================
   13   Main predicate: resolveDrs/2
   14======================================================================== */
   15
   16resolveDrs(B1,B2):- 
   17   resolveDrs(B1,B2,_).
   18
   19
   20/* ========================================================================
   21   Main predicate: resolveDrs/3 (DRS)
   22======================================================================== */
   23
   24resolveDrs(alfa(top,B1,B2),RDRS,Links):- 
   25   option('--theory',drt), !,
   26   resolveDrs(alfa(top,B1,B2),RDRS,[],Links).
   27
   28resolveDrs(smerge(alfa(top,B1,B2),B3),RDRS,Links):-
   29   option('--theory',drt), !,
   30   resolveDrs(alfa(top,B1,smerge(B2,B3)),RDRS,[],Links).
   31
   32resolveDrs(B,RDRS,Links):- 
   33   option('--theory',drt), !,
   34   resolveDrs(alfa(top,drs([],[]),B),RDRS,[],Links).
   35
   36
   37/* ========================================================================
   38   Main predicate: resolveDrs/3 (SDRS)
   39======================================================================== */
   40
   41resolveDrs(B,SDRS,Links):- 
   42   option('--theory',sdrt), 
   43   \+ B = sdrs(_,_), !,
   44   resolveDrs(sdrs([sub(lab(K1,drs([],[])),lab(K2,B))],[[]:rel(K1,K2,presupposition)]),SDRS,[],Links).
   45
   46resolveDrs(B,SDRS,Links):- 
   47   option('--theory',sdrt), 
   48   B = sdrs(_,Rel), \+ member(_:rel(_,_,presupposition),Rel), !, 
   49   resolveDrs(sdrs([sub(lab(K1,drs([],[])),lab(K2,B))],[[]:rel(K1,K2,presupposition)]),SDRS,[],Links).
   50
   51resolveDrs(B,SDRS,Links):- 
   52   option('--theory',sdrt), 
   53   resolveDrs(B,SDRS,[],Links).
   54
   55
   56/* ========================================================================
   57   Resolution
   58
   59   Resolves alpha-DRSs one by one until they are all resolved. The variable 
   60   "Alfa" contains the anaphoric DRS, the variable "Type" the corresponding 
   61   alpha-type.  The third and fourth argument of resolveDrs/4 represent the 
   62   binding links. "Ac" holds a list of accommodation sites (represented as 
   63   a/1 terms), and "Bi" a list of binding sites (represented as r/2 terms).
   64
   65======================================================================== */
   66
   67resolveDrs(ADRS,DRS,L1,L3):-
   68   findAlfaDrs(ADRS,RDRS,alfa(Type,Alfa),Ac,[]-Bi), !,
   69   resolveAlfa(Alfa,Type,Ac,Bi,RDRS,L1,L2), 
   70   !, %%% Required for large DRSs (too many choice points)
   71   resolveDrs(RDRS,DRS,L2,L3).
   72
   73resolveDrs(RDRS,DRS,L0,L0):-
   74   mergeDrs(RDRS,DRS), !.
   75
   76
   77/* ========================================================================
   78   Find First Alfa-DRS (DRSs)
   79======================================================================== */
   80
   81findAlfaDrs(alfa(top,B1,B3),Res,Alfa,Ac,Bi1-Bi2):- !,
   82   mergeDrs(B1,M1),
   83   findAlfaDrs(B3,R2,Alfa,Ac0,[r(M1,R1)|Bi1]-Bi2),
   84   Res = alfa(top,merge(R1,A),R2),
   85   Ac = [a(A)|Ac0].
   86
   87findAlfaDrs(alfa(T,B1,B2),Res,Alfa,Ac,Bi1-Bi2):- !,
   88   (  
   89      findAlfaDrs(B1,R1,Alfa,Ac,Bi1-Bi2), !,
   90      Res=alfa(T,R1,B2)
   91   ;
   92      Res=merge(A,B2),
   93      mergeDrs(B1,M1),
   94      Alfa=alfa(T,M1),
   95      Ac=[a(A)],
   96      Bi1=Bi2
   97   ).
   98
   99findAlfaDrs(merge(B1,B2),Res,Alfa,Ac,Bi1-Bi2):- !,
  100   (  
  101      findAlfaDrs(B1,R1,Alfa,Ac,Bi1-Bi2), !,
  102      Res = merge(R1,B2)
  103   ;
  104      mergeDrs(B1,M1),
  105      findAlfaDrs(B2,R2,Alfa,Ac,[r(M1,R1)|Bi1]-Bi2),
  106      Res = merge(R1,R2)
  107   ). 
  108
  109findAlfaDrs(smerge(B1,B2),Res,Alfa,Ac,Bi1-Bi2):- !,
  110   (  
  111      findAlfaDrs(B1,R1,Alfa,Ac,Bi1-Bi2), !,
  112      Res = smerge(R1,B2)
  113   ;
  114      mergeDrs(B1,M1),
  115      findAlfaDrs(B2,R2,Alfa,Ac,[r(M1,R1)|Bi1]-Bi2),
  116      Res = smerge(R1,R2)
  117   ). 
  118
  119findAlfaDrs([sub(lab(K1,B1),lab(K2,B2))|C1],Res,Alfa,Ac,Bi1-Bi2):- !,
  120   (  
  121      findAlfaDrs(B1,R1,Alfa,Ac,Bi1-Bi2), !,
  122      Res = [sub(lab(K1,R1),lab(K2,B2))|C1]
  123   ;
  124      mergeDrs(B1,M1),
  125      (
  126         findAlfaDrs(B2,R2,Alfa,Ac0,[r(M1,R1)|Bi1]-Bi2), !,
  127         Res = [sub(lab(K1,merge(R1,A)),lab(K2,R2))|C1],
  128         Ac = [a(A)|Ac0]
  129      ;
  130         findAlfaDrs(C1,R2,Alfa,Ac,[r(M1,R1)|Bi1]-Bi2),
  131         Res = [sub(lab(K1,R1),lab(K2,B2))|R2]
  132      )
  133   ). 
  134
  135findAlfaDrs([lab(K,B1)|C1],Res,Alfa,Ac,Bi1-Bi2):- !,
  136   (  
  137      findAlfaDrs(B1,R1,Alfa,Ac,Bi1-Bi2), !,
  138      Res = [lab(K,R1)|C1]
  139   ;
  140      mergeDrs(B1,M1),
  141      findAlfaDrs(C1,R2,Alfa,Ac,[r(M1,R1)|Bi1]-Bi2),
  142      Res = [lab(K,R1)|R2]
  143   ). 
  144
  145findAlfaDrs(drs(D,C1),merge(A,R),Alfa,[a(A)|Ac],Bi1-Bi2):- !,
  146   findAlfaConds(C1,C2,Alfa,Ac,[r(drs(D,C2),R)|Bi1]-Bi2).
  147
  148findAlfaDrs(sdrs(D1,C),sdrs(D2,C),Alfa,Ac,Bi1-Bi2):-
  149   findAlfaDrs(D1,D2,Alfa,Ac,Bi1-Bi2).
  150
  151
  152/* ========================================================================
  153   Find First Alfa-DRS (DRS-Conditions)
  154======================================================================== */
  155
  156findAlfaConds([I:X1|C1],[I:X2|C2],Alfa,Ac,Bi1-Bi2):- !,
  157   findAlfaConds([X1|C1],[X2|C2],Alfa,Ac,Bi1-Bi2).
  158
  159findAlfaConds([imp(B1,B3)|C],Res,Alfa,Ac,Bi1-Bi2):- 
  160   (
  161      findAlfaDrs(B1,B2,Alfa,Ac,Bi1-Bi2), !,
  162      Res = [imp(B2,B3)|C]
  163   ;
  164      mergeDrs(B1,M1),
  165      findAlfaDrs(B3,R2,Alfa,Ac0,[r(M1,R1)|Bi1]-Bi2),
  166      Res = [imp(merge(R1,A),R2)|C],
  167      Ac = [a(A)|Ac0]
  168   ), !.
  169
  170findAlfaConds([duplex(Type,B1,Var,B3)|C],Res,Alfa,Ac,Bi1-Bi2):- 
  171   (
  172      findAlfaDrs(B1,B2,Alfa,Ac,Bi1-Bi2), !,
  173      Res = [duplex(Type,B2,Var,B3)|C]
  174   ;
  175      mergeDrs(B1,M1),
  176      findAlfaDrs(B3,R2,Alfa,Ac0,[r(M1,R1)|Bi1]-Bi2),
  177      Ac = [a(A)|Ac0],
  178      Res = [duplex(Type,merge(R1,A),Var,R2)|C]
  179   ), !.      
  180
  181findAlfaConds([or(B1,B2)|C],Res,Alfa,Ac,Bi1-Bi2):-
  182   (
  183      findAlfaDrs(B1,B3,Alfa,Ac,Bi1-Bi2), !,
  184      Res = [or(B3,B2)|C]
  185   ;
  186      findAlfaDrs(B2,B3,Alfa,Ac,Bi1-Bi2), 
  187      Res = [or(B1,B3)|C]
  188   ), !.
  189
  190findAlfaConds([not(B1)|C],[not(B2)|C],Alfa,Ac,Bi1-Bi2):- 
  191   findAlfaDrs(B1,B2,Alfa,Ac,Bi1-Bi2), !.
  192
  193findAlfaConds([nec(B1)|C],[nec(B2)|C],Alfa,Ac,Bi1-Bi2):- 
  194   findAlfaDrs(B1,B2,Alfa,Ac,Bi1-Bi2), !.
  195
  196findAlfaConds([pos(B1)|C],[pos(B2)|C],Alfa,Ac,Bi1-Bi2):- 
  197   findAlfaDrs(B1,B2,Alfa,Ac,Bi1-Bi2), !.
  198
  199findAlfaConds([prop(X,B1)|C],[prop(X,B2)|C],Alfa,Ac,Bi1-Bi2):-
  200   findAlfaDrs(B1,B2,Alfa,Ac,Bi1-Bi2), !.
  201
  202findAlfaConds([Cond|C1],[Cond|C2],Alfa,Ac,Bi1-Bi2):-
  203   findAlfaConds(C1,C2,Alfa,Ac,Bi1-Bi2).
  204
  205
  206/* ========================================================================
  207   Resolve alfa: binding or accommodation
  208======================================================================== */
  209
  210resolveAlfa(Alfa,Type,Ac,Bi,B,L1,L2):-
  211   option('--presup',max),
  212   bindAlfa(Type,Bi,Alfa,L1,L2),
  213   dontResolve(Ac),
  214   \+ bindingViolationDrs(B),
  215   freeVarCheckDrs(B), !.
  216
  217resolveAlfa(Alfa,Type,Ac,Bi,B,L0,L0):-
  218   accommodateAlfa(Type,Ac,Alfa),
  219   dontResolve(Bi),
  220   freeVarCheckDrs(B).
  221
  222
  223/* ------------------------------------------------------------------------
  224   Typology:   atype(Type, Global, Local, Binding)
  225------------------------------------------------------------------------ */
  226
  227atype(def,1,1,1). % definite descriptions
  228atype(nam,1,0,1). % proper names
  229atype(pro,1,0,1). % personal pronouns
  230atype(dei,1,0,1). % anaphoric tense
  231atype(ref,1,0,1). % reflexive pronouns
  232atype(fac,1,1,0). % factives, clefts, "only"
  233atype(ind,0,1,0). % indefinites
  234
  235
  236/* ------------------------------------------------------------------------
  237   Binding: select an antecedent, then merge the domain and the conditions
  238------------------------------------------------------------------------ */
  239
  240bindAlfa(Type,[a(drs([],[]))|P],Alfa,L1,L2):- 
  241   !,  %%% cannot bind here, so try next level of DRS
  242   bindAlfa(Type,P,Alfa,L1,L2).
  243
  244bindAlfa(_,[r(drs(D2,C2),DRS)|P],drs([AnaIndex:X|D1],C1),L,[bind(AnaIndex,AntIndex)|L]):-
  245   input:coref(Ana,Ant), 
  246   common(AnaIndex,Ana),                         % there is external coref info for this anaphor
  247   member(AntIndex:X,D2),                        % select candidate antecedent discourse referent
  248   common(AntIndex,Ant), !,
  249   warning('using external coref info for anaphoric expression ~p',[AnaIndex]),
  250   mergeDomains(D1,D2,D3), 
  251   mergeConditions(C1,C2,C3),
  252   DRS = drs(D3,C3),
  253   dontResolve(P).
  254
  255bindAlfa(Type,[r(drs(D2,C2),DRS)|P],drs([AnaIndex:X|D1],C1),L,[bind(AnaIndex,AntIndex)|L]):-
  256   \+ option('--semantics',drg),
  257   atype(Type,_,_,1),                            % check whether type permits binding
  258   member(AntIndex:X,D2),                        % select candidate antecedent discourse referent
  259   match(Type,C1,C2,X),                          % check if this candidate matches
  260   coordinated(AnaIndex,AntIndex,L),
  261   mergeDomains(D1,D2,D3), 
  262   mergeConditions(C1,C2,C3),
  263   DRS = drs(D3,C3),
  264   sortalCheckDrs(DRS,X),
  265   dontResolve(P).
  266
  267bindAlfa(Type,[r(drs(D2,C2),DRS)|P],drs([AnaIndex:X|D1],C1),L,[bind(AnaIndex,AntIndex)|L]):-
  268   option('--semantics',drg),
  269   atype(Type,_,_,1),                            % check whether type permits binding
  270   member(AntIndex:Y,D2),                        % select candidate antecedent discourse referent
  271   coordinated(AnaIndex,AntIndex,L),             % copied material must have same antecedent
  272   \+ \+ (Y=X, match(Type,C1,C2,X)),             % check if this candidate matches
  273   mergeDomains(D1,D2,D3), 
  274   mergeConditions(C1,C2,C3),
  275   DRS = drs([AnaIndex:X|D3],[[]:eq(X,Y)|C3]),
  276   \+ \+ (Y=X, sortalCheckDrs(drs(D3,C3),X)),
  277   dontResolve(P).
  278
  279bindAlfa(Type,[r(R,R)|P],Alfa,L1,L2):-
  280   bindAlfa(Type,P,Alfa,L1,L2).
  281
  282
  283/* ------------------------------------------------------------------------
  284   Check if two indices share a common element
  285------------------------------------------------------------------------ */
  286
  287common(Index1,Index2):- member(X,Index1), member(X,Index2), !.
  288
  289
  290/* ------------------------------------------------------------------------
  291   Check if coordinated items are resolved to the same antecedent 
  292------------------------------------------------------------------------ */
  293
  294coordinated(AnaIndex,AntIndex,Bound):-
  295   \+ ( member(bind(AnaIndex,OtherIndex),Bound),
  296        \+ AnaIndex=[], \+ OtherIndex=[],
  297        \+ OtherIndex = AntIndex ).
  298
  299
  300/*------------------------------------------------------------------------
  301   Check for partial match 
  302------------------------------------------------------------------------*/
  303
  304match(nam,C1,C2,X0):-
  305   member(_:named(X1,Sym,Type,Sense),C1), X0==X1, \+ Type=ttl,
  306   member(_:named(X2,Sym,Type,Sense),C2), X1==X2, !.
  307
  308match(nam,C1,C2,X0):-
  309   member(_:timex(X1,date(_:D1,_:D2,_:D3,_:D4)),C1), X0==X1, 
  310   member(_:timex(X2,date(_:D1,_:D2,_:D3,_:D4)),C2), X1==X2, !.
  311
  312match(def,C1,C2,X0):-
  313   member(_:pred(X1,Sym,n,Sense),C1), X0==X1,
  314   member(_:pred(X2,Sym,n,Sense),C2), X1==X2, !.
  315
  316match(def,C1,C2,X0):-
  317   member(_:named(X1,Sym,Type,Sense),C1), X0==X1, \+ Type=ttl,
  318   member(_:named(X2,Sym,Type,Sense),C2), X1==X2, !.
  319
  320match(def,C1,C2,X0):-
  321   member(_:timex(X1,date(_:D1,_:D2,_:D3,_:D4)),C1), X0==X1, 
  322   member(_:timex(X2,date(_:D1,_:D2,_:D3,_:D4)),C2), X1==X2, !.
  323
  324match(dei,C1,C2,X0):-
  325   member(_:pred(X1,Sym,a,_),C1), X0==X1, 
  326   member(_:pred(X2,Sym,a,_),C2), X1==X2, !.
  327
  328match(pro,C1,C2,X0):-
  329   member(_:pred(X1,Sym,a,_),C1), X0==X1, 
  330   member(_:pred(X2,Sym,a,_),C2), X1==X2, !.
  331
  332match(pro,C1,C2,X0):-
  333   member(_:pred(X1,male,n,2),C1), X0==X1, 
  334   member(_:named(X2,_,per,_),C2), X1==X2, !.
  335
  336match(pro,C1,C2,X0):-
  337   member(_:pred(X1,female,n,2),C1), X0==X1, 
  338   member(_:named(X2,_,per,_),C2),   X1==X2, !.
  339
  340match(pro,C1,C2,X0):-
  341   member(_:pred(X1,neuter,a,_),C1), X0==X1, 
  342   ( NE=org ; NE=loc; NE=art; NE=nat ), 
  343   member(_:named(X2,_,NE,_),C2),    X1==X2, !.
  344
  345
  346/* ------------------------------------------------------------------------
  347   Forced local accommodation (option 'presup --min')
  348------------------------------------------------------------------------ */
  349
  350accommodateAlfa(_,[a(Alfa)],Alfa):- 
  351   option('--presup',min), !. %%% force local accommodation
  352
  353accommodateAlfa(Type,[a(drs([],[]))|P],Alfa):- 
  354   option('--presup',min), !, %%% force local accommodation
  355   accommodateAlfa(Type,P,Alfa).
  356
  357
  358/* ------------------------------------------------------------------------
  359   Accommodation
  360
  361   P is a list of accommodation sites (represented as a/1 terms). The
  362   order of the list corresponds to the level of the accommodation
  363   site: the first a/1 term is the most global site, the last element
  364   the most local accommodation site. 
  365------------------------------------------------------------------------ */
  366
  367accommodateAlfa(Type,[r(R,R)|P],Alfa):- !,
  368   accommodateAlfa(Type,P,Alfa).
  369
  370accommodateAlfa(Type,[a(B)|P],Alfa):- 
  371   atype(Type,1,0,_), !, B = Alfa,
  372   dontResolve(P).
  373
  374accommodateAlfa(Type,[a(B)|P],Alfa):-
  375   atype(Type,1,1,_), !,
  376   ( dontResolve(P), B = Alfa
  377   ; B = drs([],[]), accommodateAlfa(Type,P,Alfa) ).
  378
  379accommodateAlfa(Type,[a(B)],Alfa):- 
  380   atype(Type,0,1,_), !, B = Alfa.
  381
  382accommodateAlfa(Type,[a(B)|P],Alfa):- 
  383   atype(Type,0,1,_), !, B = drs([],[]),
  384   accommodateAlfa(Type,P,Alfa).
  385
  386accommodateAlfa(Type,[a(B)|P],Alfa):-
  387   warning('unknown alfa-type: ~p',[Type]), !, B = Alfa,
  388   dontResolve(P).
  389
  390
  391/* ========================================================================
  392   Do not resolve remaining of projection path
  393======================================================================== */
  394
  395dontResolve([]):- !.
  396
  397dontResolve([a(drs([],[]))|L]):- !,
  398   dontResolve(L).
  399
  400dontResolve([r(X,X)|L]):- !,
  401   dontResolve(L).
  402
  403
  404/* ========================================================================
  405   Merge Domains - Check for Duplicates; Copy Indexes
  406======================================================================== */
  407
  408mergeDomains([],L,L):- !.
  409
  410mergeDomains([I1:X|R],L1,L3):-
  411   option('--semantics',tacitus),
  412   select(I2:Y,L1,L2), X==Y, !,
  413   append(I1,I2,I3), sort(I3,I4),
  414   mergeDomains(R,[I4:X|L2],L3).
  415
  416mergeDomains([_:X|R],L1,L3):-
  417   select(I:Y,L1,L2), X==Y, !,
  418   mergeDomains(R,[I:X|L2],L3).
  419
  420mergeDomains([X|R],L1,[X|L2]):-
  421   option('--semantics',tacitus), !,
  422   mergeDomains(R,L1,L2).
  423
  424mergeDomains([_:X|R],L1,[[]:X|L2]):-
  425   mergeDomains(R,L1,L2).
  426
  427
  428/* ========================================================================
  429   Merge Conditions - Check for Duplicates; Copy Indexes
  430======================================================================== */
  431
  432mergeConditions([],L,L):- !.
  433
  434%mergeConditions([_:named(X,Sym,_,Sense)|R],L1,L3):-      %%% merge names with
  435%   select(I:named(Y,Sym,Type,Sense),L1,L2), X==Y, !,     %%% different types
  436%   mergeConditions(R,[I:named(X,Sym,Type,Sense)|L2],L3).
  437
  438mergeConditions([I1:X|R],L1,L3):-
  439   option('--semantics',tacitus),  
  440   select(I2:Y,L1,L2), X==Y, !,
  441   append(I1,I2,I3), sort(I3,I4),
  442   mergeConditions(R,[I4:X|L2],L3).
  443
  444mergeConditions([_:X|R],L1,L3):-                         %%% merge identical
  445   select(I:Y,L1,L2), X==Y, !,                           %%% conditions, keep
  446   mergeConditions(R,[I:X|L2],L3).                       %%% index of antecedent
  447
  448mergeConditions([I1:timex(X,date(D1,D2,D3,D4))|R],L1,L3):-
  449   option('--semantics',drg),
  450   select(I2:timex(Y,date(E1,E2,E3,E4)),L1,L2), 
  451   mergeConditions([D1],[E1],[F1]),
  452   mergeConditions([D2],[E2],[F2]),
  453   mergeConditions([D3],[E3],[F3]),
  454   mergeConditions([D4],[E4],[F4]),
  455   X==Y, !,
  456   append(I1,I2,I3), sort(I3,I4),
  457   mergeConditions(R,[I4:timex(X,date(F1,F2,F3,F4))|L2],L3).
  458
  459mergeConditions([_:timex(X,date(D1,D2,D3,D4))|R],L1,L3):-
  460   select(I:timex(Y,date(E1,E2,E3,E4)),L1,L2), 
  461   mergeConditions([D1],[E1],[F1]),
  462   mergeConditions([D2],[E2],[F2]),
  463   mergeConditions([D3],[E3],[F3]),
  464   mergeConditions([D4],[E4],[F4]),
  465   X==Y, !,
  466   mergeConditions(R,[I:timex(X,date(F1,F2,F3,F4))|L2],L3).
  467
  468mergeConditions([X|R],L1,[X|L2]):-
  469   mergeConditions(R,L1,L2)