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
   32is_pp(#(1,_,_,_)).
   33
   34is_pred(#(_,1,_,_)).
   35
   36is_trace(#(_,_,1,_)).
   37
   38is_adv(#(_,_,_,1)).
   39
   40is_trace82(#(_,_,1,_),#(0,0,0,0)).
   41
   42is_trace_bits(#(0,0,1,0)).
   43
   44is_adv_bits(#(0,0,0,1)).
   45
   46is_empty_bits(#(0,0,0,0)).
   47
   48is_np_all(#(1,1,1,0)).
   49
   50is_s_all(#(1,0,1,1)).
   51
   52is_np_no_trace(#(1,1,0,0)).
   53
   54% Mask operations
   55
   56plus_mask(#(B1,B2,B3,B4),#(C1,C2,C3,C4),#(D1,D2,D3,D4)) :-
   57   or_xmask(B1,C1,D1),
   58   or_xmask(B2,C2,D2),
   59   or_xmask(B3,C3,D3),
   60   or_xmask(B4,C4,D4).
   61
   62minus_mask(#(B1,B2,B3,B4),#(C1,C2,C3,C4),#(D1,D2,D3,D4)) :-
   63   anot_xmask(B1,C1,D1),
   64   anot_xmask(B2,C2,D2),
   65   anot_xmask(B3,C3,D3),
   66   anot_xmask(B4,C4,D4).
   67
   68or_xmask(1,_,1).
   69or_xmask(0,1,1).
   70or_xmask(0,0,0).
   71
   72anot_xmask(X,0,X).
   73anot_xmask(_X,1,0).
   74
   75% Noun phrase position features
   76
   77is_to_role_case(subj80,_,#(1,0,0)).
   78is_to_role_case(compl,_,#(0,_,_)).
   79is_to_role_case(undef,main,#(_,0,_)).
   80is_to_role_case(undef,aux,#(0,_,_)).
   81is_to_role_case(undef,decl,_).
   82is_to_role_case(nil,_,_).
   83
   84is_subj_case(#(1,0,0)).
   85is_verb_case(#(0,1,0)).
   86is_prep_case(#(0,0,1)).
   87is_compl_case(#(0,_,_)).
   88
   89:- op(100,fx,?).   90
   91user:portray('#'(PP,Pred,Trace,Adv)) :-
   92   portray_bit(pp,PP,S0,S1),
   93   portray_bit(pred,Pred,S1,S2),
   94   portray_bit(trace,Trace,S2,S3),
   95   portray_bit(adv,Adv,S3,[]),
   96   write(S0).
   97
   98portray_bit(Bit,Value,[?Bit|Bits],Bits) :- var(Value), !.
   99portray_bit(Bit,1,[+Bit|Bits],Bits).
  100portray_bit(Bit,0,[-Bit|Bits],Bits).
  101portray_bit(Bit,What,[Bit=What|Bits],Bits).
  102portray_bit(_,_,Bits,Bits)