2:- module(input,[openInput/1,inputDRS/2,lenDRS/2,openModel/3]).    3
    4:- use_module(semlib(errors),[error/2,warning/2]).    5
    6
    7/*------------------------------------------------------------------------
    8   Dynamic Predicates
    9------------------------------------------------------------------------*/
   10
   11:- dynamic inputDRS/2.   12
   13:- multifile     sem/3, id/2.   14:- discontiguous sem/3, id/2.   15:- dynamic       sem/3, id/2.   16
   17
   18/*------------------------------------------------------------------------
   19   Open Input Files
   20------------------------------------------------------------------------*/
   21
   22openInput(Dir):-
   23   retractall(inputDRS(_,_)),
   24
   25   retractall(id(_,_)),
   26   retractall(sem(_,_,_)),
   27   openInputDrs(Dir,t),
   28
   29   retractall(id(_,_)),
   30   retractall(sem(_,_,_)),
   31   openInputDrs(Dir,h),
   32
   33   retractall(id(_,_)),
   34   retractall(sem(_,_,_)),
   35   openInputDrs(Dir,th).
   36
   37
   38/*------------------------------------------------------------------------
   39   Open Input File and assert to database
   40------------------------------------------------------------------------*/
   41
   42openInputDrs(Dir,Type):-
   43   atomic_list_concat([Dir,'/',Type,'.drs'],File),
   44   checkInput(File),
   45   loadDRS(DRS), !,
   46   assert(inputDRS(Type,DRS)).
   47
   48openInputDrs(_,_).
   49
   50
   51/*========================================================================
   52   Read Model from File
   53========================================================================*/
   54
   55openModel(Dir,Type,Model):-
   56   atomic_list_concat([Dir,'/',Type,'.mod'],File),
   57   atom(File), exists_file(File), access_file(File,read),
   58   open(File,read,Stream),
   59   read(Stream,Model), !,
   60   close(Stream).
   61
   62openModel(_,_,unknown).
   63
   64
   65/*========================================================================
   66   Check Input File
   67========================================================================*/
   68
   69checkInput(File):-
   70   \+ atom(File), !,
   71   error('file name format of ~p not allowed',[File]),
   72   fail.
   73
   74checkInput(File):-
   75   \+ exists_file(File), !,
   76   error('file ~p does not exist',[File]),
   77   fail.
   78
   79checkInput(File):-
   80   \+ access_file(File,read), !,
   81   error('file ~p not readable',[File]),
   82   fail.
   83
   84checkInput(File):-
   85   catch(load_files([File],[autoload(true),encoding(utf8)]),_,fail), !.
   86
   87checkInput(File):-
   88   error('file ~p not Prolog readable',[File]),
   89   !, fail.
   90
   91/* ------------------------------------------------------------------------
   92   Identify IDs in the input file
   93------------------------------------------------------------------------ */
   94
   95loadDRS(D):-
   96   id(_,I),
   97   sem(I,_A,D), !.
   98
   99loadDRS(_):-
  100   \+ id(_,_), !,
  101   error('DRS input file contains no id/2 terms',[]), 
  102   fail.
  103
  104loadDRS(_):-
  105   \+ sem(_,_,_), !,
  106   error('DRS input file contains no sem/3 terms',[]), 
  107   fail.
  108
  109
  110/* ------------------------------------------------------------------------
  111   Determine length of DRS
  112------------------------------------------------------------------------ */
  113
  114lenDRS(alfa(_,_,B),Len):- !, lenDRS(B,Len).
  115lenDRS(smerge(B,_),Len):- !, lenDRS(B,Len1), Len is Len1 + 1.
  116lenDRS(_,1)