1% This file is part of the Attempto Parsing Engine (APE).
    2% Copyright 2008-2013, Attempto Group, University of Zurich (see http://attempto.ifi.uzh.ch).
    3%
    4% The Attempto Parsing Engine (APE) is free software: you can redistribute it and/or modify it
    5% under the terms of the GNU Lesser General Public License as published by the Free Software
    6% Foundation, either version 3 of the License, or (at your option) any later version.
    7%
    8% The Attempto Parsing Engine (APE) is distributed in the hope that it will be useful, but WITHOUT
    9% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
   10% PURPOSE. See the GNU Lesser General Public License for more details.
   11%
   12% You should have received a copy of the GNU Lesser General Public License along with the Attempto
   13% Parsing Engine (APE). If not, see http://www.gnu.org/licenses/.
   14
   15
   16:- module(drs_utils, [
   17		get_toplevel_object_referents/2
   18	]).

Attempto DRS utils

author
- Kaarel Kaljurand
version
- 2009-04-08

*/

 get_toplevel_object_referents(+ConditionList:list, -Toplevel:term) is det
Returns a term toplevel(ReferentList, SubjectList, ObjectList, NamedList) where
   39get_toplevel_object_referents(ConditionList, toplevel(ReferentList, SubjectList, ObjectList, NamedList)) :-
   40	get_toplevel_object_referents_x(
   41		ConditionList,
   42		toplevel(
   43			-([], ReferentList),
   44			-([], SubjectList),
   45			-([], ObjectList),
   46			-([], NamedList)
   47		)
   48	).
 get_toplevel_object_referents_x(+ConditionList:list, -Toplevel:term) is det
Arguments:
ConditionList- is a list of DRS conditions
Toplevel- is a term containing top-level DRS discourse referents
   56get_toplevel_object_referents_x([], toplevel(R-R, S-S, O-O, N-N)).
   57
   58get_toplevel_object_referents_x([Condition | ConditionList], toplevel(R1-R2, S1-S2, O1-O2, N1-N2)) :-
   59	condition_referents(Condition, toplevel(R1-RT, S1-ST, O1-OT, N1-NT)),
   60	get_toplevel_object_referents_x(ConditionList, toplevel(RT-R2, ST-S2, OT-O2, NT-N2)).
 condition_referents(+Condition:term) is det
Note: the referents of plural objects, mass-objects, query-objects, and objects in the relation-condition are considered as named-objects, i.e. they will not be verbalized by "there is/are". BUG: This is a hack, and it is DRACE specific.
Arguments:
Condition- is a DRS condition
   72% BUG: ???
   73condition_referents(object(Ref, Noun, Type, _, _Eq, na)-_, toplevel(R-[Ref | R], S-S, O-O, N-N)) :-
   74	Noun \= na,
   75	Type \= named,
   76	Type \= mass,
   77	!.
   78
   79% Plural objects (i.e. NP conjunction). BUG: we consider them named-objects for the time being.
   80condition_referents(object(Ref, na, _, _, _, _)-_, toplevel(R-[Ref | R], S-S, O-O, N1-[Ref | N1])) :- !.
   81
   82% Mass objects. BUG: we consider them objects as named-objects for the time being.
   83condition_referents(object(Ref, _, mass, _, _, _)-_, toplevel(R-[Ref | R], S-S, O-O, N1-[Ref | N1])) :- !.
   84
   85% Parts of plural objects. BUG: we consider them named-objects for the time being.
   86condition_referents(has_part(_, Ref)-_, toplevel(R-R, S-S, O-O, N1-[Ref | N1])) :- !.
   87
   88% Relation object. BUG: we consider them named-objects for the time being.
   89condition_referents(relation(Ref1, of, Ref2)-_, toplevel(R-R, S-S, O-O, N-[Ref1, Ref2 | N])) :- !.
   90
   91% Query objects. BUG: we consider them named-objects for the time being.
   92condition_referents(query(Ref, _)-_, toplevel(R-[Ref | R], S-S, O-O, N1-[Ref | N1])) :- !.
   93
   94/* BUG: is the var/nonvar stuff really necessary? */
   95
   96condition_referents(predicate(_, _, Ref)-_, toplevel(R-R, S-[Ref | S], O-O, N-N)) :-
   97	var(Ref),
   98	!.
   99
  100condition_referents(predicate(_, _, Ref, O1)-_, toplevel(R-R, S-[Ref | S], O-[O1 | O], N-N)) :-
  101	var(Ref), var(O1),
  102	!.
  103
  104condition_referents(predicate(_, _, Ref, O1)-_, toplevel(R-R, S-[Ref | S], O-O, N-N)) :-
  105	var(Ref), nonvar(O1),
  106	!.
  107
  108condition_referents(predicate(_, _, Ref, O1)-_, toplevel(R-R, S-S, O-[O1 | O], N-N)) :-
  109	nonvar(Ref), var(O1),
  110	!.
  111
  112condition_referents(predicate(_, _, Ref, O1, O2)-_, toplevel(R-R, S-[Ref | S], O-[O1, O2 | O], N-N)) :-
  113	var(Ref), var(O1), var(O2),
  114	!.
  115
  116condition_referents(predicate(_, _, Ref, O1, O2)-_, toplevel(R-R, S-S, O-[O1, O2 | O], N-N)) :-
  117	nonvar(Ref), var(O1), var(O2),
  118	!.
  119
  120condition_referents(predicate(_, _, Ref, O1, O2)-_, toplevel(R-R, S-[Ref | S], O-[O2 | O], N-N)) :-
  121	var(Ref), nonvar(O1), var(O2),
  122	!.
  123
  124condition_referents(predicate(_, _, Ref, O1, O2)-_, toplevel(R-R, S-[Ref | S], O-[O1 | O], N-N)) :-
  125	var(Ref), var(O1), nonvar(O2),
  126	!.
  127
  128condition_referents(predicate(_, _, Ref, O1, O2)-_, toplevel(R-R, S-S, O-[O2 | O], N-N)) :-
  129	nonvar(Ref), nonvar(O1), var(O2),
  130	!.
  131
  132condition_referents(predicate(_, _, Ref, O1, O2)-_, toplevel(R-R, S-S, O-[O1 | O], N-N)) :-
  133	nonvar(Ref), var(O1), nonvar(O2),
  134	!.
  135
  136condition_referents(predicate(_, _, Ref, O1, O2)-_, toplevel(R-R, S-[Ref | S], O-O, N-N)) :-
  137	var(Ref), nonvar(O1), nonvar(O2),
  138	!.
  139
  140condition_referents(_, toplevel(R-R, S-S, O-O, N-N))