2:- module(input,[openInput/0,
    3                 preferred/2,     % +ID, -CCG
    4                 identifyIDs/1]).    5
    6:- use_module(boxer(slashes)).    7:- use_module(boxer(transform),[topcat/2]).    8:- use_module(semlib(options),[option/2]).    9:- use_module(semlib(errors),[error/2,warning/2]).   10
   11
   12/*========================================================================
   13    Declare Dynamic Predicates
   14========================================================================*/
   15
   16:- multifile ccg/2, id/2, sem/5, coref/2.   17:- discontiguous ccg/2, id/2, sem/5, coref/2.   18:- dynamic inputtype/1.   19
   20
   21/*------------------------------------------------------------------------
   22   Open Input File
   23------------------------------------------------------------------------*/
   24
   25openInput:-
   26   option('--input',user_input), 
   27   option('--stdin',do), !,
   28   prompt(_,''),
   29   catch(load_files('',[autoload(true),encoding(utf8),stream(user_input)]),_,fail),
   30   checkInputType.
   31
   32openInput:-
   33   option('--stdin',dont), 
   34   option('--input',File), 
   35   \+ File = user_input, !,
   36   checkInput(File).
   37
   38
   39/*========================================================================
   40   Check Input File
   41========================================================================*/
   42
   43checkInput(File):-
   44   \+ atom(File), !,
   45   error('file name format of ~p not allowed',[File]),
   46   fail.
   47
   48checkInput(File):-
   49   \+ exists_file(File), !,
   50   error('file ~p does not exist',[File]),
   51   fail.
   52
   53checkInput(File):-
   54   \+ access_file(File,read), !,
   55   error('file ~p not readable',[File]),
   56   fail.
   57
   58checkInput(File):-
   59   catch(load_files([File],[autoload(true),encoding(utf8)]),_,fail), !,
   60   checkInputType.
   61
   62checkInput(File):-
   63   error('file ~p not Prolog readable',[File]),
   64   !, fail.
   65
   66
   67/*========================================================================
   68   Check Input Type
   69========================================================================*/
   70
   71checkInputType:-
   72   input:ccg(_,_), !,
   73   retractall(input:inputtype(_)),
   74   assert(input:inputtype(ccg)).
   75
   76checkInputType:-
   77   input:sem(_,_,_,_,_), !,
   78   retractall(input:inputtype(_)),
   79   assert(input:inputtype(drs)).
   80
   81checkInputType:-
   82   warning('input file contains no data',[]),
   83   retractall(input:inputtype(_)),
   84   assert(input:inputtype(unknown)).
   85  
   86
   87/*------------------------------------------------------------------------
   88   Identify IDs in the input file
   89------------------------------------------------------------------------*/
   90
   91identifyIDs(List):-
   92   findall(id(Id,Numbers),id(Id,Numbers),List),
   93   \+ List=[], !.
   94
   95identifyIDs(List):-
   96   option('--integrate',false), 
   97   ccg(_,_),
   98   setof(id(Id,[Id]),X^ccg(Id,X),List), !.
   99
  100identifyIDs([id(1,List)]):-
  101   option('--integrate',true), 
  102   ccg(_,_),
  103   setof(Id,X^ccg(Id,X),List), !.
  104
  105identifyIDs([]):-
  106   \+ id(_,_), \+ ccg(_,_), !,
  107   warning('input file contains no ccg/2 terms',[]).
  108
  109
  110/*------------------------------------------------------------------------
  111   Preferred CCG analysis
  112------------------------------------------------------------------------*/
  113   
  114preferred(N,CCG):-
  115   preferred([t:_,s:_,np],N,CCG).
  116
  117preferred([],N,CCG):-
  118   ccg(N,CCG), !.
  119
  120preferred([Cat|_],N,CCG):-
  121   ccg(N,CCG), 
  122   topcat(CCG,Cat), !.
  123
  124preferred([_|L],N,CCG):-
  125   preferred(L,N,CCG)