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(lexicon_interface, [
   17	adv/2,
   18	adv_comp/2,
   19	adv_sup/2,
   20	adj_itr/2,
   21	adj_itr_comp/2,
   22	adj_itr_sup/2,
   23	adj_tr/3,
   24	adj_tr_comp/3,
   25	adj_tr_sup/3,
   26	noun_sg/3,
   27	noun_pl/3,
   28	noun_mass/3,
   29	mn_sg/2,
   30	mn_pl/2,
   31	pn_sg/3,
   32	pn_pl/3,
   33	pndef_sg/3,
   34	pndef_pl/3,
   35	iv_finsg/2,
   36	iv_infpl/2,
   37	tv_finsg/2,
   38	tv_infpl/2,
   39	tv_pp/2,
   40	dv_finsg/3,
   41	dv_infpl/3,
   42	dv_pp/3,
   43	prep/2,
   44	common_noun/1,
   45	verb/1,
   46	attributive_adjective/1
   47	]).   48
   49:- use_module(clex).   50:- use_module(ulex).   51
   52
   53% Calls to the lexicon.
   54% The user lexicon (ulex) is preferred to
   55% the common lexicon (clex).
   56%
   57% BUG: it looks ugly, maybe there is a nicer way to do it.
   58
   59adv(WordForm, Word) :- var(WordForm), var(Word), !, fail.
   60adv(WordForm, Word) :- ulex:adv(WordForm, Word).
   61adv(WordForm, Word) :- clex_switch(on), clex:adv(WordForm, Word).
   62
   63adv_comp(WordForm, Word) :- var(WordForm), var(Word), !, fail.
   64adv_comp(WordForm, Word) :- ulex:adv_comp(WordForm, Word).
   65adv_comp(WordForm, Word) :- clex_switch(on), clex:adv_comp(WordForm, Word).
   66
   67adv_sup(WordForm, Word) :- var(WordForm), var(Word), !, fail.
   68adv_sup(WordForm, Word) :- ulex:adv_sup(WordForm, Word).
   69adv_sup(WordForm, Word) :- clex_switch(on), clex:adv_sup(WordForm, Word).
   70
   71adj_itr(WordForm, Word) :- var(WordForm), var(Word), !, fail.
   72adj_itr(WordForm, Word) :- ulex:adj_itr(WordForm, Word).
   73adj_itr(WordForm, Word) :- clex_switch(on), clex:adj_itr(WordForm, Word).
   74
   75adj_itr_comp(WordForm, Word) :- var(WordForm), var(Word), !, fail.
   76adj_itr_comp(WordForm, Word) :- ulex:adj_itr_comp(WordForm, Word).
   77adj_itr_comp(WordForm, Word) :- clex_switch(on), clex:adj_itr_comp(WordForm, Word).
   78
   79adj_itr_sup(WordForm, Word) :- var(WordForm), var(Word), !, fail.
   80adj_itr_sup(WordForm, Word) :- ulex:adj_itr_sup(WordForm, Word).
   81adj_itr_sup(WordForm, Word) :- clex_switch(on), clex:adj_itr_sup(WordForm, Word).
   82
   83adj_tr(WordForm, Word, _Prep) :- var(WordForm), var(Word), !, fail.
   84adj_tr(WordForm, Word, Prep) :-  ulex:adj_tr(WordForm, Word, Prep).
   85adj_tr(WordForm, Word, Prep) :-  clex_switch(on), clex:adj_tr(WordForm, Word, Prep).
   86
   87adj_tr_comp(WordForm, Word, _Prep) :- var(WordForm), var(Word), !, fail.
   88adj_tr_comp(WordForm, Word, Prep) :- ulex:adj_tr_comp(WordForm, Word, Prep).
   89adj_tr_comp(WordForm, Word, Prep) :- clex_switch(on), clex:adj_tr_comp(WordForm, Word, Prep).
   90
   91adj_tr_sup(WordForm, Word, _Prep) :- var(WordForm), var(Word), !, fail.
   92adj_tr_sup(WordForm, Word, Prep) :- ulex:adj_tr_sup(WordForm, Word, Prep).
   93adj_tr_sup(WordForm, Word, Prep) :- clex_switch(on), clex:adj_tr_sup(WordForm, Word, Prep).
   94
   95noun_sg(WordForm, Word, _Gender) :- var(WordForm), var(Word), !, fail.
   96noun_sg(WordForm, Word, Gender) :- ulex:noun_sg(WordForm, Word, Gender).
   97noun_sg(WordForm, Word, Gender) :- clex_switch(on), clex:noun_sg(WordForm, Word, Gender).
   98
   99noun_pl(WordForm, Word, _Gender) :- var(WordForm), var(Word), !, fail.
  100noun_pl(WordForm, Word, Gender) :- ulex:noun_pl(WordForm, Word, Gender).
  101noun_pl(WordForm, Word, Gender) :- clex_switch(on), clex:noun_pl(WordForm, Word, Gender).
  102
  103noun_mass(WordForm, Word, _Gender) :- var(WordForm), var(Word), !, fail.
  104noun_mass(WordForm, Word, Gender) :- ulex:noun_mass(WordForm, Word, Gender).
  105noun_mass(WordForm, Word, Gender) :- clex_switch(on), clex:noun_mass(WordForm, Word, Gender).
  106
  107mn_sg(WordForm, Word) :- var(WordForm), var(Word), !, fail.
  108mn_sg(WordForm, Word) :- ulex:mn_sg(WordForm, Word).
  109mn_sg(WordForm, Word) :- clex_switch(on), clex:mn_sg(WordForm, Word).
  110
  111mn_pl(WordForm, Word) :- var(WordForm), var(Word), !, fail.
  112mn_pl(WordForm, Word) :- ulex:mn_pl(WordForm, Word).
  113mn_pl(WordForm, Word) :- clex_switch(on), clex:mn_pl(WordForm, Word).
  114
  115pn_sg(WordForm, Word, _Gender) :- var(WordForm), var(Word), !, fail.
  116pn_sg(WordForm, Word, Gender) :- ulex:pn_sg(WordForm, Word, Gender).
  117pn_sg(WordForm, Word, Gender) :- clex_switch(on), clex:pn_sg(WordForm, Word, Gender).
  118
  119pn_pl(WordForm, Word, _Gender) :- var(WordForm), var(Word), !, fail.
  120pn_pl(WordForm, Word, Gender) :- ulex:pn_pl(WordForm, Word, Gender).
  121pn_pl(WordForm, Word, Gender) :- clex_switch(on), clex:pn_pl(WordForm, Word, Gender).
  122
  123pndef_sg(WordForm, Word, _Gender) :- var(WordForm), var(Word), !, fail.
  124pndef_sg(WordForm, Word, Gender) :- ulex:pndef_sg(WordForm, Word, Gender).
  125pndef_sg(WordForm, Word, Gender) :- clex_switch(on), clex:pndef_sg(WordForm, Word, Gender).
  126
  127pndef_pl(WordForm, Word, _Gender) :- var(WordForm), var(Word), !, fail.
  128pndef_pl(WordForm, Word, Gender) :- ulex:pndef_pl(WordForm, Word, Gender).
  129pndef_pl(WordForm, Word, Gender) :- clex_switch(on), clex:pndef_pl(WordForm, Word, Gender).
  130
  131iv_finsg(WordForm, Word) :- var(WordForm), var(Word), !, fail.
  132iv_finsg(WordForm, Word) :- ulex:iv_finsg(WordForm, Word).
  133iv_finsg(WordForm, Word) :- clex_switch(on), clex:iv_finsg(WordForm, Word).
  134
  135iv_infpl(WordForm, Word) :- var(WordForm), var(Word), !, fail.
  136iv_infpl(WordForm, Word) :- ulex:iv_infpl(WordForm, Word).
  137iv_infpl(WordForm, Word) :- clex_switch(on), clex:iv_infpl(WordForm, Word).
  138
  139tv_finsg(WordForm, Word) :- var(WordForm), var(Word), !, fail.
  140tv_finsg(WordForm, Word) :- ulex:tv_finsg(WordForm, Word).
  141tv_finsg(WordForm, Word) :- clex_switch(on), clex:tv_finsg(WordForm, Word).
  142
  143tv_infpl(WordForm, Word) :- var(WordForm), var(Word), !, fail.
  144tv_infpl(WordForm, Word) :- ulex:tv_infpl(WordForm, Word).
  145tv_infpl(WordForm, Word) :- clex_switch(on), clex:tv_infpl(WordForm, Word).
  146
  147tv_pp(WordForm, Word) :- var(WordForm), var(Word), !, fail.
  148tv_pp(WordForm, Word) :- ulex:tv_pp(WordForm, Word).
  149tv_pp(WordForm, Word) :- clex_switch(on), clex:tv_pp(WordForm, Word).
  150
  151dv_finsg(WordForm, Word, _Prep) :- var(WordForm), var(Word), !, fail.
  152dv_finsg(WordForm, Word, Prep) :- ulex:dv_finsg(WordForm, Word, Prep).
  153dv_finsg(WordForm, Word, Prep) :- clex_switch(on), clex:dv_finsg(WordForm, Word, Prep).
  154
  155dv_infpl(WordForm, Word, _Prep) :- var(WordForm), var(Word), !, fail.
  156dv_infpl(WordForm, Word, Prep) :- ulex:dv_infpl(WordForm, Word, Prep).
  157dv_infpl(WordForm, Word, Prep) :- clex_switch(on), clex:dv_infpl(WordForm, Word, Prep).
  158
  159dv_pp(WordForm, Word, _Prep) :- var(WordForm), var(Word), !, fail.
  160dv_pp(WordForm, Word, Prep) :- ulex:dv_pp(WordForm, Word, Prep).
  161dv_pp(WordForm, Word, Prep) :- clex_switch(on), clex:dv_pp(WordForm, Word, Prep).
  162
  163prep(WordForm, Word) :- var(WordForm), var(Word), !, fail.
  164prep(WordForm, Word) :- ulex:prep(WordForm, Word).
  165prep(WordForm, Word) :- clex_switch(on), clex:prep(WordForm, Word).
  166
  167
  168common_noun(WordForm) :-
  169	(
  170		noun_sg(WordForm, _, _)
  171	;
  172		noun_pl(WordForm, _, _)
  173	;
  174		noun_mass(WordForm, _, _)
  175	).
  176
  177
  178verb(WordForm) :-
  179	(
  180		iv_finsg(WordForm, _)
  181	;
  182		iv_infpl(WordForm, _)
  183	;
  184		tv_finsg(WordForm, _)
  185	;
  186		tv_infpl(WordForm, _)
  187	;
  188		dv_finsg(WordForm, _, _)
  189	;
  190		dv_infpl(WordForm, _, _)
  191	).
 attributive_adjective(+WordForm:atom) is det
Arguments:
WordForm- is an ACE token

Succeeds if WordForm is an attributive adjective

  200attributive_adjective(WordForm) :-
  201	(
  202		adj_itr(WordForm, _)
  203	;
  204		adj_itr_comp(WordForm, _)
  205	;
  206		adj_itr_sup(WordForm, _)
  207	)