1/* @(#)clotab.pl	24.1 2/23/88 */
    2
    3
    4/* 
    5	Copyright 1986, Fernando C.N. Pereira and David H.D. Warren,
    6
    7			   All Rights Reserved
    8*/
    9/*
   10 _________________________________________________________________________
   11|	Copyright (C) 1982						  |
   12|									  |
   13|	David Warren,							  |
   14|		SRI International, 333 Ravenswood Ave., Menlo Park,	  |
   15|		California 94025, USA;					  |
   16|									  |
   17|	Fernando Pereira,						  |
   18|		Dept. of Architecture, University of Edinburgh,		  |
   19|		20 Chambers St., Edinburgh EH1 1JZ, Scotland		  |
   20|									  |
   21|	This program may be used, copied, altered or included in other	  |
   22|	programs only for academic purposes and provided that the	  |
   23|	authorship of the initial program is aknowledged.		  |
   24|	Use for commercial purposes without the previous written 	  |
   25|	agreement of the authors is forbidden.				  |
   26|_________________________________________________________________________|
   27
   28*/
   29
   30% Normal form masks
   31
   32ix_is_pp(#(1,_,_,_)).
   33
   34ix_is_pred(#(_,1,_,_)).
   35
   36% unused?
   37% is_trace(#(_,_,1,_)).
   38
   39ix_is_adv(#(_,_,_,1)).
   40
   41ix_trace(#(_,_,1,_),#(0,0,0,0)).
   42
   43ix_trace(#(0,0,1,0)).
   44
   45ix_adv(#(0,0,0,1)).
   46
   47ix_empty(#(0,0,0,0)).
   48
   49ix_np_all(#(1,1,1,0)).
   50
   51ix_s_all(#(1,0,1,1)).
   52
   53ix_np_no_trace(#(1,1,0,0)).
   54
   55% Mask operations
   56
   57ix_plus(#(B1,B2,B3,B4),#(C1,C2,C3,C4),#(D1,D2,D3,D4)) :-
   58   or_xmask(B1,C1,D1),
   59   or_xmask(B2,C2,D2),
   60   or_xmask(B3,C3,D3),
   61   or_xmask(B4,C4,D4).
   62
   63ix_minus(#(B1,B2,B3,B4),#(C1,C2,C3,C4),#(D1,D2,D3,D4)) :-
   64   not_xmask(B1,C1,D1),
   65   not_xmask(B2,C2,D2),
   66   not_xmask(B3,C3,D3),
   67   not_xmask(B4,C4,D4).
   68
   69or_xmask(1,_,1).
   70or_xmask(0,1,1).
   71or_xmask(0,0,0).
   72
   73not_xmask(X,0,X).
   74not_xmask(_X,1,0).
   75
   76% Noun phrase position features
   77
   78ix_role(subj,_,#(1,0,0)).
   79ix_role(compl,_,#(0,_,_)).
   80ix_role(undef,main,#(_,0,_)).
   81ix_role(undef,aux,#(0,_,_)).
   82ix_role(undef,decl,_).
   83ix_role(nil,_,_).
   84
   85subj_case(#(1,0,0)).
   86verb_case(#(0,1,0)).
   87prep_case(#(0,0,1)).
   88compl_case(#(0,_,_))