1:- module(boxer,[]).    2% boxer.pl, by Johan Bos
    3
    4/*========================================================================
    5   File Search Paths
    6========================================================================*/
    7
    8:- prolog_load_context(file,File),
    9   absolute_file_name('..',X,[relative_to(File),file_type(directory)]),
   10   asserta(user:file_search_path(candc,X)).   11
   12:- set_prolog_flag(double_quotes,codes).   13
   14user:file_search_path(semlib,     candc(semlib)).
   15user:file_search_path(boxer,      candc(boxer)).
   16user:file_search_path(knowledge,  boxer(knowledge)).
   17user:file_search_path(lex,        boxer(lex)).
   18
   19
   20%:- user:ensure_loaded(library( parser_sharing)).
   21
   22/*========================================================================
   23   Load other libraries
   24========================================================================*/
   25
   26:- use_module(library(lists),[member/2,select/3]).   27
   28:- use_module(boxer(ccg2drs),[ccg2drs/2]).   29:- use_module(boxer(input),[openInput/0,identifyIDs/1,preferred/2]).   30:- use_module(boxer(evaluation),[initEval/0,reportEval/0]).   31:- use_module(boxer(version),[version/1]).   32:- use_module(boxer(printCCG),[printCCG/2]).   33:- use_module(boxer(transform),[preprocess/6]).   34:- use_module(boxer(drs2fdrs),[eqDrs/2]).   35:- use_module(boxer(output),[printHeader/4,printFooter/1,printSem/4]).   36
   37:- use_module(semlib(errors),[error/2,warning/2]).   38:- use_module(semlib(options),[option/2,parseOptions/2,setOption/3,
   39                               showOptions/1,setDefaultOptions/1]).   40
   41/*========================================================================
   42   Main
   43========================================================================*/
   44
   45box(_,_):-
   46   option(Option,do), 
   47   member(Option,['--version','--help']), !, 
   48   version,
   49   help.
   50
   51box(Command,Options):-
   52  (( 
   53   openInput,
   54   openOutput(Stream),
   55   version(Version),
   56   printHeader(Stream,Version,Command,Options),
   57   initEval,
   58   box(Stream), !,
   59   printFooter(Stream),
   60   close(Stream), !,
   61   reportEval)).
   62   
   63box(_,_):-
   64   setOption(boxer,'--help',do), !,
   65   trace, help.
   66
   67
   68/*------------------------------------------------------------------------
   69   Perform depending on input type
   70------------------------------------------------------------------------*/
   71
   72box(Stream):-
   73   ignore(input:inputtype(ccg)), !,   
   74   identifyIDs(List),
   75   buildList(List,1,Stream).
   76
   77box(_):-
   78   input:inputtype(unknown).
   79
   80
   81/*------------------------------------------------------------------------
   82   Open Output File
   83------------------------------------------------------------------------*/
   84
   85openOutput(Stream):-
   86   option('--output',Output),
   87   atomic(Output), 
   88   \+ Output=user_output, 
   89   ( access_file(Output,write), !,
   90     open(Output,write,Stream,[encoding(utf8)])
   91   ; error('cannot write to specified file ~p',[Output]),
   92     Stream=user_output ), !.
   93
   94openOutput(user_output).
   95
   96
   97/*------------------------------------------------------------------------
   98   Print CCG derivations
   99------------------------------------------------------------------------*/
  100
  101printCCGs([],_).
  102
  103printCCGs([N|L],Stream):-  
  104   preferred(N,CCG0),
  105   preprocess(N,CCG0,CCG1,_,1,_), !,
  106   printCCG(CCG1,Stream), 
  107   printCCGs(L,Stream).
  108
  109printCCGs([N|L],Stream):-  
  110   preferred(N,_), !,
  111   warning('cannot produce derivation for ~p',[N]),
  112   printCCGs(L,Stream).
  113
  114printCCGs([N|L],Stream):-  
  115   warning('no syntactic analysis for ~p',[N]),
  116   printCCGs(L,Stream).
  117
  118
  119/*------------------------------------------------------------------------
  120   Build a DRS from a list of identifiers 
  121------------------------------------------------------------------------*/
  122
  123buildList([id(_,Numbers)|L],Index,Stream):- 
  124   option('--ccg',true), !,
  125   sort(Numbers,Sorted),
  126   printCCGs(Sorted,Stream),
  127   buildList(L,Index,Stream).
  128
  129buildList([id(Id,Numbers)|L],Index,Stream):- 
  130   sort(Numbers,Sorted),
  131   ccg2drs(Sorted,XDRS),
  132   outputSem(Stream,Id,Index,XDRS), !,
  133   NewIndex is Index + 1,
  134   buildList(L,NewIndex,Stream).
  135
  136buildList([_|L],Index,Stream):- !,
  137   buildList(L,Index,Stream).
  138
  139buildList([],_,_).
  140
  141
  142/* =======================================================================
  143   Output Semantic Representation
  144========================================================================*/
  145
  146outputSem(Stream,Id,Index,XDRS0):-
  147%   eqDrs(XDRS0,XDRS1),
  148   XDRS0=XDRS1,
  149   printSem(Stream,Id,Index,XDRS1), !.
  150%   nl(Stream).
  151
  152
  153/* =======================================================================
  154   Version
  155========================================================================*/
  156
  157version:-
  158   option('--version',do), !,
  159   version(V),
  160   format(user_error,'~p~n',[V]).
  161
  162version.
  163
  164
  165/* =======================================================================
  166   Help
  167========================================================================*/
  168
  169help:-
  170   option('--help',do), !,
  171   format(user_error,'usage: boxer [options]~n~n',[]),
  172   showOptions(boxer).
  173
  174help:-
  175   option('--help',dont), !.
  176
  177
  178/* =======================================================================
  179   Definition of start
  180========================================================================*/
  181
  182user:start :- boxer_start.
  183
  184cmd_argv(boxer,X):- current_prolog_flag(argv,X),X\==[],!.
  185cmd_argv(boxer,X):- current_prolog_flag(os_argv,ARGV),append(_,['--'|X],ARGV),
  186    set_prolog_flag(argv,[boxer|X]).
  187
  188boxer_start :-    
  189   cmd_argv(Comm,Args),
  190   ignore(boxer_start([Comm|Args])),
  191   halt.
  192
  193boxer_start([Comm|Args]):-
  194%  set_prolog_flag(float_format,'%.20g'),
  195   setDefaultOptions(boxer), 
  196   parseOptions(boxer,Args),
  197   box(Comm,Args), !.
  198boxer_start(Args):- 
  199   error('boxer failed: ~q',[Args]),
  200   fail