/*************************************************************************

         name: drt.pl
      version: Oct 15, 2003
  description: DRS-threading (Johnson & Klein 1986)
      authors: Johan Bos
 
*************************************************************************/

:- module(threadingDRT,[drt/0,drt/2]).

:- ensure_loaded(comsemOperators).

:- use_module(drs2fol,[drs2fol/2]).

:- use_module(readLine,[readLine/1]).

:- use_module(comsemLib,[compose/3,printRepresentations/1]).

:- [englishGrammar].

:- [discourseGrammar].


/*========================================================================
   Driver Predicate 
========================================================================*/

drt:-
   readLine(Discourse),
   d2(DRS,Discourse,[]),
   printRepresentations([DRS]),
   drs2fol(DRS,FOL),
   printRepresentations([FOL]).


/*========================================================================
   Driver Predicate (takes a discourse and returns DRSs)
========================================================================*/

drt(Discourse,DRSs):-
   setof(DRS,d2(DRS,Discourse,[]),DRSs).


/*========================================================================
   Semantic Rules
========================================================================*/
 
combine(d2:Drs,[d1:D1]):-
   D1 = [drs:[in:[drs([],[])],out:[Drs]],ana:[in:[],out:Ana]],
   checkConstraints(Ana),
   bindingDrs(Drs).
 
combine(d1:D1,[s2:S2]):- 
   D1 = [drs:Drs,ana:Ana],
   S2 = [drs:Drs,ana:Ana].

combine(d1:D1,[s2:S2,conj,d1:D2]):-
   D1 = [drs:[in:K1,out:K3],ana:[in:A1,out:A3]],
   S2 = [drs:[in:K1,out:K2],ana:[in:A1,out:A2]],
   D2 = [drs:[in:K2,out:K3],ana:[in:A2,out:A3]].

combine(s2:S2,[s1:S1]):-
   S2 = [drs:[in:In,out:Out],ana:Ana],
   S1 = [drs:[in:In,out:Out|_],ana:Ana].

combine(s2:S2,[s1:S1,cond,s1:S3]):-
   S2 = [drs:[in:[drs(D,C)|S],out:[drs(D,[A > B|C])|S]],ana:[in:A1,out:A3]],
   S1 = [drs:[in:[drs([],[]),drs(D,C)|S],out:[A|_]|_],ana:[in:A1,out:A2]],
   S3 = [drs:[in:[drs([],[]),drs(D,C),A|S],out:[B|_]|_],ana:[in:A2,out:A3]].

combine(s1:S,[np2:NP,vp2:VP]):-
   S = [drs:Sem,ana:[in:A1,out:A3]],
   NP = [arg:[index:I],drs:Sem,ana:[in:A1,out:A2]],
   VP = [arg:[subj:I,obj:_],drs:Drs,ana:[in:A2,out:A3]],
   Sem = [in:_,out:_,restr:_,scope:Drs].

combine(np2:A,[np1:A]).

combine(np1:NP,[det:Det,n2:N]):-
   NP = [arg:Arg,drs:Drs,ana:[in:A1,out:A3]],
   Det = [drs:Drs,ana:[in:A1,out:A2]],
   N = [arg:Arg,drs:Restr,ana:[in:A2,out:A3]],
   Drs = [in:_,out:_,restr:Restr,scope:_].

combine(np1:A,[pn:A]).

combine(np1:A,[pro:A]).

combine(np1:A,[np:A]).

combine(n2:A,[n1:A]).

combine(n1:N1,[adj:Ad,n1:N2]):-
   N1 = [arg:Arg,drs:[in:A,out:C],ana:[in:A1,out:A3]],
   Ad = [arg:Arg,drs:[in:A,out:B],ana:[in:A1,out:A2]],
   N2 = [arg:Arg,drs:[in:B,out:C],ana:[in:A2,out:A3]].

combine(n1:A,[noun:A]).

combine(n1:N1,[noun:No,pp:PP]):-
   N1 = [arg:Arg,drs:[in:A,out:C],ana:[in:A1,out:A3]],
   No = [arg:Arg,drs:[in:A,out:B],ana:[in:A1,out:A2]],
   PP = [arg:Arg,drs:[in:B,out:C],ana:[in:A2,out:A3]].
 
combine(n1:N1,[noun:No,rc:RC]):-
   N1 = [arg:Arg,drs:[in:A,out:C],ana:[in:A1,out:A3]],
   No = [arg:Arg,drs:[in:A,out:B],ana:[in:A1,out:A2]],
   RC = [arg:Arg,drs:[in:B,out:C],ana:[in:A2,out:A3]].
  
combine(vp2:A,[vp1:A]).

combine(vp1:A,[v2:A]).

combine(vp1:VP1,[mod:Mod,v2:V2]):-
   VP1 = [arg:Arg,drs:[in:A,out:B],ana:[in:A1,out:A3]],
   Mod = [drs:[in:A,out:B,scope:VP],ana:[in:A1,out:A2]],
   V2 = [arg:Arg,drs:VP,ana:[in:A2,out:A3]].

combine(v2:V2,[cop:Co,np2:NP]):-
   V2 = [arg:Arg,drs:[in:In,out:Out],ana:[in:A1,out:A3]],
   Co = [arg:Arg,drs:Drs,ana:[in:A1,out:A2]],
   NP = [arg:[index:I],drs:[in:In,out:Out,restr:_,scope:Drs],ana:[in:A2,out:A3]],
   Arg = [subj:_,obj:I].   

combine(v2:V2,[cop:Co,neg:Ne,np2:NP]):-
   V2 = [arg:Arg,drs:[in:In,out:Out],ana:[in:A1,out:A4]],
   Co = [arg:Arg,drs:Drs,ana:[in:A1,out:A2]],
   NP = [arg:[index:I],drs:[in:A,out:B,restr:_,scope:Drs],ana:[in:A2,out:A3]],
   Ne = [drs:[in:In,out:Out,scope:[in:A,out:B]],ana:[in:A3,out:A4]],
   Arg = [subj:_,obj:I].   

combine(v2:A,[v1:A]).

combine(v1:A,[iv:A]).

combine(v1:V1,[tv:TV,np2:NP]):-
   V1 = [arg:Arg,drs:[in:In,out:Out],ana:[in:A1,out:A3]],
   TV = [arg:Arg,drs:Drs,ana:[in:A1,out:A2]],
   NP = [arg:[index:I],drs:[in:In,out:Out,restr:_,scope:Drs],ana:[in:A2,out:A3]],
   Arg = [subj:_,obj:I].   

combine(pp:PP,[prep:Prep,np2:NP]):-
   PP = [arg:[index:X],drs:[in:In,out:Out],ana:[in:A1,out:A3]],
   Prep = [arg:[ext:X,int:Y],drs:Drs,ana:[in:A1,out:A2]],
   NP = [arg:[index:Y],drs:[in:In,out:Out,restr:_,scope:Drs],ana:[in:A2,out:A3]].

combine(rc:RC,[relpro:_,vp2:VP]):-
   RC = [arg:[index:X],drs:Sem,ana:Ana],
   VP = [arg:[subj:X,_],drs:Sem,ana:Ana].

 
/*========================================================================
   Checking the Constraints
========================================================================*/

checkConstraints([]).
checkConstraints([X|L]):-
   call(X),
   checkConstraints(L).


/*========================================================================
   Semantic Macros
========================================================================*/

detSem(indef,[drs:Drs,ana:[in:A,out:A]]):-
   Drs = [in:X,
          out:Z,
          restr:[in:X,out:Y],
          scope:[in:Y,out:Z]].

detSem(uni,[drs:Drs,ana:[in:A,out:A]]):-
   Drs = [in:[drs(D,C)|S],
          out:[drs(D,[Y>Z|C])|S],
          restr:[in:[drs([],[]),drs(D,C)|S],out:[Y|T]],
          scope:[in:[drs([],[]),Y|T],out:[Z|_]]].

nounSem(Sym,[arg:[index:X],drs:Drs,ana:[in:A,out:A]]):-
   Drs = [in:[drs(D,C)|S],out:[drs([X|D],[Cond|C])|S]],
   compose(Cond,Sym,[X]).

pnSem(Sym,[arg:[index:X],drs:Drs,ana:[in:A,out:A]]):-
   Drs = [in:[drs(D,C)|S],
          out:Out,
          restr:_,
          scope:[in:[drs([X|D],[X=Sym|C])|S],
                 out:Out]].

proSem(Sym,[arg:[index:X],drs:Drs,ana:Ana]):-
   Drs = [in:[drs(D,C)|S],
          out:Out,
          restr:_,
          scope:[in:[drs(D,[Cond|C])|S],out:Out]],
   compose(Cond,Sym,[X]),
   Ana = [in:A,
          out:[accessible(X,[drs(D,C)|S])|A]].
 
npSem(wh,Sym,[arg:[index:X],drs:Drs,ana:[in:A,out:A]]):-
   compose(Cond,Sym,[X]),
   Drs = [in:[drs(D,C)|S],
          out:lambda(X,Out),
          restr:_,
          scope:[in:[drs(D,[Cond|C])|S],out:[Out]]].

ivSem(Sym,[arg:Arg,drs:Drs,ana:[in:A,out:A]]):-
   compose(Cond,Sym,[X]),
   Arg = [subj:X,obj:_],
   Drs = [in:[drs(D,C)|S],
          out:[drs(D,[Cond|C])|S]].
   
tvSem(Sym,[arg:[subj:X,obj:Y],drs:Drs,ana:[in:A,out:A]]):-
   compose(Cond,Sym,[X,Y]),
   Drs = [in:[drs(D,C)|S],
	  out:[drs(D,[Cond|C])|S]].

relproSem([arg:[],drs:[],ana:[in:A,out:A]]).

prepSem(Sym,[arg:[ext:X,int:Y],drs:Drs,ana:[in:A,out:A]]):-
   compose(Cond,Sym,[X,Y]),
   Drs = [in:[drs(D,C)|S],
          out:[drs(D,[Cond|C])|S]].

adjSem(Sym,[arg:[index:X],drs:Drs,ana:[in:A,out:A]]):-
   compose(Cond,Sym,[X]),
   Drs = [in:[drs(D,C)|S],
	  out:[drs(D,[Cond|C])|S]].

modSem(neg,[drs:Drs,ana:[in:A,out:A]]):-
   Drs = [in:[drs(D,C)|S],
          out:[drs(D,[~B|C])|S],scope:[in:[drs([],[]),drs(D,C)|S],out:[B|_]]].

coordSem(conj,[drs:[arg1:[in:A,out:B],arg2:[in:B,out:C],coord:[in:A,out:C]],ana:[in:A,out:A]]).

coordSem(disj,
	 [
	  drs:[arg1:[in:[drs([],[]),drs(D,C)|S],out:[A|_]],
	       arg2:[in:[drs([],[]),drs(D,C)|S],out:[B|_]],
	       coord:[in:[drs(D,C)|S],out:[drs(D,[A v B|C])|S]]],
          ana:[in:A,out:A]
	 ]).


/*========================================================================
   Accessibility 
========================================================================*/

accessible(X,Space):-
   member(drs(D,_),Space),
   member(X,D).


/*========================================================================
   Binding constraints
========================================================================*/

bindingDrs(drs(_,C)):- 
   bindingConds(C).

bindingConds([]).

bindingConds([~ B|C]):-
   bindingDrs(B),
   bindingConds(C).

bindingConds([B1 > B2|C]):-
   bindingDrs(B1),
   bindingDrs(B2),
   bindingConds(C).

bindingConds([B1 v B2|C]):-
   bindingDrs(B1),
   bindingDrs(B2),
   bindingConds(C).

bindingConds([Cond|C]):-
   \+ Cond = (~ _),
   \+ Cond = (_ > _),
   \+ Cond = (_ v _),
   (  
      compose(Cond,_,[_])
   ;
      compose(Cond,_,[X,Y]),
      \+ X==Y
   ),
   bindingConds(C).