%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%  File:  grammar9.pl
%
%  Course:  HPSG Grammars in ALE
%
%  Purpose:  1.  Adds semantics, so:
%            2.  Defines ind, qfpsoa, sem_det, gend, num, and per 
%                types and subtypes (nom_obj, quant, psoa, etc).
%            3.  New features ind, restr, det, restind, gen, num,
%                per, quants, nucleaus, instance, and specific
%                soa features like "giver, givee, gift", and so on.
%            4.  New subtypes of "list" and "set" defined, including
%                "list_synsem, set_psoa", and so on.
%            4.  Adds lots of simple macros and alters some existing
%                ones, such as "s" and "vp".
%            5.  Introduces lexical entries for "a" and "every"
%            6.  Adds appropriate semantics to every lexical entry
%            7.  Adds "cont" feature to lexical rules
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%**********************  Type Hierarchy

bot cons bot.

bot sub [sign,list,set,cat,head,vform,boolean,mod_synsem, 
         loc,nonloc,cont,marking,sl,ind,qfpsoa,sem_det,
         gend,num,per].

mod_synsem sub [synsem,none].                

synsem sub [pre_mod_synsem, post_mod_synsem]  
   intro [loc:loc,
          nonloc:nonloc].

pre_mod_synsem sub [].
post_mod_synsem sub [].
none sub [].

loc sub []
   intro [cat:cat,
          cont:cont].            

% --------------  Semantic types - starting with "cont"

cont sub [nom_obj, quant, psoa].

% ----------------------- nom_obj

nom_obj sub []
        intro [index:ind,
               restr:set_psoa].

% ----------------------- quant

quant sub []
   intro [det:sem_det,
          restind:nom_obj].

sem_det sub [forall,exists,the].

forall sub [].
exists sub [].
the sub [].

%  ----------------------- ind 

ind sub [it, there, ref]
  intro [gen:gend, 
         num:num, 
         per:per].

it sub [].
there sub [].
ref sub [].

gend sub [masc,fem,neut].

masc sub [].
fem sub [].
neut sub [].

num sub [sg,pl].

sg sub [].
pl sub [].

per sub [first,second,third].

first sub [].
second sub [].
third sub [].

% ----------------------- psoa 

psoa sub []
     intro [quants:list_quant, 
            nucleus: qfpsoa].

%----------- qfpsoa def taken from hpsg.pl in ALE

qfpsoa sub [property,un_relation, bin_relation, tri_relation].

property sub [book,red]
   intro [instance:ref].
      book sub [].
      red sub [].

un_relation sub [snore].

snore sub [] 
   intro [snorer:ref].

bin_relation sub [like].

like sub [] 
   intro [liker:ref, 
          likee:ref].

tri_relation sub [give].

give sub [] 
  intro [giver:ref, 
         givee:ref, 
         gift:ref].

% -----  End of semantic types

nonloc sub []
   intro [inherited:sl,
          tobind:sl].

sl sub []
  intro [slash:set].

sign sub []
   intro [synsem:synsem].

cat sub []
   intro [head:head,
          subj:list_synsem,                % Valency features now
          comps:list_synsem,               % take list_synsem type
          spr:list_synsem,                 % as values - defined below
          marking:marking].

marking sub [marked, unmarked].

marked sub [comp,conj].

comp sub [that,for].

that sub [].
for  sub [].

conj sub [].

unmarked sub [].
                                
head sub [subst,func].
                      
subst sub [noun,verb,adj]             
    intro [prd:boolean,               
           mod:mod_synsem].           

func sub [mark,det]   
  intro [spec:synsem].

noun sub [].
det sub [].
adj sub [].
mark sub [].

verb sub []
  intro [vform:vform,
         aux:boolean,
         inv:boolean].

boolean sub [yes,no].

yes sub [].
no sub [].

vform sub [fin,inf,pas,bse].

fin sub [].
pas sub [].
inf sub [].
bse sub [].

%----------------- Various List and Set types

list sub [ne_list,list_sign,list_synsem,list_quant].   % New list subtypes
 
set sub [ne_set,set_psoa,set_loc].              %  And new set subtypes

e_list sub [].
e_set sub [].

ne_list sub [ne_list_sign, ne_list_synsem,ne_list_quant]
  intro [hd:bot,
         tl:list].

ne_set sub [ne_set_psoa, ne_set_loc]
   intro [elt:bot,
          elts:set].

list_sign sub [e_list,ne_list_sign].

list_synsem sub [e_list,ne_list_synsem].

list_quant sub [e_list,ne_list_quant].

set_psoa sub [e_set,ne_set_psoa].

set_loc sub [e_set,ne_set_loc].

ne_list_sign sub []
       intro [hd:sign,
              tl:list_sign].

ne_list_synsem sub []
       intro [hd:synsem,
              tl:list_synsem].

ne_list_quant sub []
       intro [hd:quant,
              tl:list_quant].

ne_set_psoa sub []
       intro [elt:psoa,
              elts:set_psoa].

ne_set_loc sub []
           intro [elt:loc,
                  elts:set_loc].

%%%**********************  Macros

np(Ind) macro                        % Index argument added
  loc:(cat:(head:noun,         
            comps:[],
            subj:[],
            spr:[],
            marking:unmarked),
       cont:index:Ind).

nbar(Ind) macro                       % Here too
  loc:(cat:(head:noun,                 
            comps:[],
            subj:[],
            spr:[_],
            marking:unmarked),
       cont:index:Ind).

detp(Cont) macro                    % Content argument added
  loc:(cat:(subj:[],
            comps:[],
            spr:[],
            head:det,
            marking:unmarked),
       cont:Cont).

comp macro                    
  loc:cat:(marking:comp,
           head:mark).

marking(Marking) macro
   loc:cat:marking:Marking.

s(Proposition) macro              % Proposition argument added
  loc:(cat:(head:verb,
            comps:[],
            subj:[]),
       cont:Proposition).

vp(Proposition) macro             % Here too
  loc:(cat:(head:verb,
            comps:[],
            subj:[_]),
       cont:Proposition).

noslash macro
   nonloc:(inherited:slash:e_set,
           tobind:slash:e_set).

restr(Restr) macro                   % Some new utility macros:
   loc:cont:restr:Restr.

cont(Cont) macro
   loc:cont:Cont.

mod(Mod) macro
   loc:cat:head:mod:Mod.

subj(Subj) macro
   loc:cat:subj:Subj.

spr(Spr) macro
   loc:cat:spr:Spr.

%%%**********************  Lexical Entries

%----------- Proper nouns

kim ---> 
   synsem:((@ np((per:third,              %  Agreement features added
                 num:sg,                  %  to all nominals
                 gen:masc)),
            @ mod(none)),
            loc:cont:(index:ref,          % Proper nouns just introduce
                      restr:e_set),       % an index and no restriction
            @ noslash).  

sandy ---> 
   synsem:((@ np((per:third,
                 num:sg,
                 gen:fem)),
            @ mod(none)),
           loc:cont:(index:ref,
                     restr:e_set),
           @ noslash).  

%------------ Common Nouns

book --->
    synsem:((@ nbar((per:third,
                     num:sg,
                     gen:neut)),
             @ mod(none),
             @ spr([(@ detp(_))]),
             @ cont((index:Ind,
                     restr:(elt:(nucleus:(book,            % Semantic type
                                          instance:Ind),   % 'book'
                                 quants:[]),               
                            elts:e_set))),
             @ noslash)).  

books --->
    synsem:((@ nbar((per:third,
                     num:pl,
                     gen:neut)),
             @ mod(none),
             @ spr([(@ detp(_))]),
             @ cont((index:Ind,
                     restr:(elt:(nucleus:(book,
                                          instance:Ind),
                                 quants:[]),
                            elts:e_set))),
             @ noslash)).  

%------------- Verbs

like ---> 
   synsem:(loc:(cat:(head:(verb,
                           vform:bse,
                           aux:no,
                           inv:no),
                      spr:[(@ comp)],
                      subj:[(@ np(Ind1))], 
                      comps:[(@ np(Ind2))],
                      marking:unmarked),
                cont:(nucleus:(like,           % Semantic type `like'
                               liker:Ind1,     % introduces a `liker' and
                               likee:Ind2),    % a `likee'
                      quants:[])),
                @ mod(none),
           @ noslash).

give ---> 
   synsem:(loc:(cat:(head:(verb,
                           vform:bse,
                           aux:no,
                           inv:no),
                     spr:[(@ comp)],
                     subj:[(@ np(Ind1))], 
                     comps:[(@ np(Ind2)),(@ np(Ind3))],
                     marking:unmarked),
                cont:(nucleus:(give,            % Three semantic arguments
                               giver:Ind1,      % in the `give' type
                               givee:Ind2,
                               gift:Ind3),
                      quants:[])),
               @ mod(none),
            @ noslash).

snore ---> 
   synsem:(loc:(cat:(head:(verb,
                           vform:bse,
                           aux:no,
                           inv:no),
                     spr:[(@ comp)],
                     subj:[(@ np(Ind))], 
                     comps:[],
                     marking:unmarked),
                cont:(nucleus:(snore,
                               snorer:Ind),
                      quants:[])),
                @ mod(none),
            @ noslash).

%------------------ Auxiliaries

can --->
  synsem:(loc:(cat:(head:(verb,
                          mod:none,
                          vform:fin,
                          aux:yes),
                    spr:Spr,
                    subj:Subj,
                    comps:[(@ vp(Prop),              %  VP semantics 
                            @ subj(Subj),            %  unified with the
                            @ spr(Spr),              %  value of `cont'
                            loc:cat:head:vform:bse)],
                    marking:unmarked),
               cont:Prop),
          @ noslash).

does --->
  synsem:(loc:(cat:(head:(verb,
                          mod:none,
                          vform:fin,
                          aux:yes),
                    spr:Spr,
                    subj:Subj,
                    comps:[(@ vp(Prop),
                            @ subj(Subj),
                            @ spr(Spr),
                            loc:cat:head:vform:bse)],
                    marking:unmarked),
               cont:Prop),
          @ noslash).

was ---> 
  synsem:(loc:(cat:(head:(verb,
                          mod:none,
                          vform:fin,
                          aux:yes),
                    spr:Spr,
                    subj:Subj,
                    comps:[(@ vp(Prop),
                            @ subj(Subj),
                            @ spr(Spr),
                            loc:cat:head:vform:pas)],
                    marking:unmarked),
               cont:Prop),
          @ noslash).

%-------------- Determiners

every --->
   synsem:(loc:(cat:(head:(det,
                           spec:((@ cont(Cont),
                                  @ nbar((num:sg))))),
                     spr:[],
                     subj:[], 
                     comps:[],
                     marking:unmarked),
                cont:(det:forall,           
                      restind:Cont)),  % The restricted-index value is
           @ noslash).                 % unified with the nbar's content

a --->
  synsem:(loc:(cat:(head:(det,
                          spec:((@ cont(Cont),
                                 @ nbar((num:sg))))),
                    spr:[],
                    subj:[], 
                    comps:[],
                    marking:unmarked),
               cont:(det: exists,
                     restind: Cont)),
          @ noslash).

the --->
   synsem:(loc:(cat:(head:(det,
                           spec:((@ cont(Cont),
                                  @ nbar(_)))),
                     spr:[],
                     subj:[], 
                     comps:[],
                     marking:unmarked),
                cont:(det: exists,
                      restind: Cont)),
           @ noslash).

%------------------ Complementisers  --------------------------

that --->
  synsem:(loc:(cat:(head:(mark,
                          spec:(@ s(_),
                                loc:cat:(head:vform:(fin;bse),
                                         marking:unmarked))),
                    spr:[],
                    subj:[],
                    comps:[],
                    marking:that)),
          @ noslash).

for --->
  synsem:(loc:(cat:(head:(mark,
                          spec:(@ s(_),
                                loc:cat:(head:vform:inf,
                                         marking:unmarked))),
                    spr:[],
                    subj:[],
                    comps:[],
                    marking:for)),
          @ noslash).

%--------------- Non-predicative Adjectives

red --->
  synsem:(loc:(cat:(head:(adj,
                          prd:no,
                          mod:(pre_mod_synsem,
                               @ nbar(Ind),
                               @ restr(Restrs))),
                    spr:[],
                    subj:[],
                    comps:[],
                    marking:unmarked),
              cont:(index:Ind,
                    restr:(elt:(nucleus:(red,
                                         instance:Ind),
                                quants:[]),
                           elts:Restrs))),
          @ noslash).

%%**********  Lexical Rules

%------  3rd person singular

pres_3s lex_rule
  (synsem:(loc:(cat:(head:(verb,
                           vform:bse,
                           aux:no,
                           mod:Mod,
                           inv:Inv),
                     spr:Spr,
                     subj:[Subj],
                     comps:Comps,   
                     marking:Marking),
                cont:Cont),                    % Content added
           nonloc:(inherited:slash:e_set,
                   tobind:slash:e_set)))
  **>
  (synsem:(loc:(cat:(head:(verb,
                           vform:fin,
                           aux:no,
                           mod:Mod,
                           inv:Inv),
                     spr:Spr,
                     subj:[NewSubj],
                     comps:Comps,
                     marking:Marking),
                cont:Cont),
           nonloc:(inherited:slash:e_set,
                   tobind:slash:e_set)))
  if  pres_3s_act(Subj,NewSubj)              % Add 3rd sg features
  morphs
    (X,y) becomes (X,ies),
    X becomes (X,s).

pres_3s_act((NP,@ np(_)),
            (NP,@ np((per:third,num:sg)))) if
  !,true.
pres_3s_act(X,X) if
  true.

%------  Non-3rd person singular

pres_non3s lex_rule
  (synsem:(loc:(cat:(head:(verb,
                           vform:bse,
                           aux:no,
                           mod:Mod,
                           inv:Inv),
                     spr:Spr,
                     subj:[Subj],
                     comps:Comps,
                     marking:Marking),
                cont:Cont),
           nonloc:(inherited:slash:e_set,
                   tobind:slash:e_set)))
  **>
  (synsem:(loc:(cat:(head:(verb,
                          vform:fin,
                          aux:no,
                          mod:Mod,
                          inv:Inv),
                    spr:Spr,
                    subj:[NewSubj],
                    comps:Comps,
                    marking:Marking),
               cont:Cont),
          nonloc:(inherited:slash:e_set,
                  tobind:slash:e_set)))
  if pres_non3s_act(Subj,NewSubj)        % Add non-3s features
  morphs
    X becomes X.

pres_non3s_act((NP,@ np(_)),
               (NP,@ np((per:(first;second);     % Either it's 1st or 2nd 
                         num:pl)))) if true.     % sg, or it's plural

% Passive Formation
% ----------------------------------------------------------------------------
% adapted from hpsg.pl in ALE

passive lex_rule
  (synsem:(loc:(cat:(head:(verb,
                           vform:bse,
                           aux:no,
                           inv:Inv,
                           prd:Prd,
                           mod:Mod),
                     comps:([loc:(cat:(head:(noun,
                                            prd:SubPrd,
                                            mod:SubMod),
                                       subj:[],
                                       comps:[],
                                       marking:SubMarking),
                                  cont:SubCont)|SubRest]),   % Add Content
                     marking:Marking),
                cont:Cont),                              % Here too
           nonloc:(inherited:slash:e_set,
                   tobind:slash:e_set)))
  **>
  (synsem:(loc:(cat:(head:(verb,
                           vform:pas,
                           aux:no,
                           inv:Inv,
                           prd:Prd,
                           mod:Mod),
                     subj:[(loc:(cat:(head:(noun,
                                            prd:SubPrd,
                                            mod:SubMod),
                                      subj:[],
                                      comps:[],
                                      marking:SubMarking),
                                 cont:SubCont))],          % Content added
                     comps:SubRest,
                     marking:Marking),
                cont:Cont),                             % And here
           nonloc:(inherited:slash:e_set,
                   tobind:slash:e_set)))

  morphs
    give becomes given,
    (X,e) becomes (X,ed),
    X becomes (X,ed).

%------- Complement Extraction Lexical Rule

celr lex_rule
  (synsem:(loc:(cat:(head:Head,
                     spr:Spr,
                     subj:Subj,
                     comps:Compsin,
                     marking:Marking),
                cont:Cont),                   % Content added
           nonloc:(inherited:slash:e_set,
                   tobind:slash:e_set)))
  **>

  (synsem:(loc:(cat:(head:Head,
                     spr:Spr,
                     subj:Subj,
                     comps:Compsout,
                     marking:Marking),
                cont:Cont),                 % And here
           nonloc:(inherited:slash:(elt:Loc,
                                    elts:e_set),
                   tobind:slash:e_set)))
  if 
    select((loc:Loc),Compsin,Compsout)
  morphs
    X becomes X.

select(X,(hd:X,tl:Z),Z) if true.
select(X,[Hd|Y],[Hd|Z]) if select(X,Y,Z).

%------- Subject Extraction Lexical Rule

selr lex_rule
  (synsem:(loc:(cat:(head:Head,
                     spr:Spr,
                     subj:Subj,
                     comps:Compsin,
                     marking:Marking),
                cont:Cont),                        % Add Content
           nonloc:(inherited:slash:e_set,
                   tobind:slash:e_set)))
  **>
  (synsem:(loc:(cat:(head:Head,
                     spr:Spr,
                     subj:Subj,
                     comps:Compsout,
                     marking:Marking),
                cont:Cont),                      % Here too
           nonloc:(inherited:slash:(elt:Loc,
                                    elts:e_set),
                   tobind:slash:e_set)))
  if 
    subst((loc:(cat:(head:vform:fin,
                     subj:e_list,
                     comps:e_list),
                cont:SCont)),             % And in the 'transformation'
          (loc:(cat:(head:vform:fin,    
                     subj:[(@ np(_),
                            loc:Loc)],
                     comps:e_list),
                cont:SCont)),
          Compsin,
          Compsout)
  morphs
    X becomes X.

subst(X,Y,(hd:X,tl:Z),(hd:Y,tl:Z)) if true.
subst(X,Y,[Hd|Tl1],[Hd|Tl2]) if subst(X,Y,Tl1,Tl2).

%%%**********************  Grammmar Rules

subject_head rule
(Mother,synsem:loc:cat:(spr:Spr,
                        subj:[], 
                        comps:[]))
===>
cat> (SubjDtr),  
goal> (sign_to_synsem(SubjDtr,SubjSynsem)),
cat> (HeadDtr,synsem:loc:cat:(spr:Spr,
                              subj:[SubjSynsem],
                              comps:[])),
goal> (head_feature_principle(Mother,HeadDtr),
       semantics_principle(Mother,HeadDtr),    % New principle in all rules
       marking_principle(Mother,HeadDtr),
       nonlocal_feature_principle(Mother,HeadDtr,[SubjDtr])).

head_complement rule
(Mother,synsem:loc:cat:(spr:Spr,
                        subj:Subjs,
                        comps:[]))
===>
cat> (HeadDtr,synsem:loc:cat:(spr:Spr,
                              subj:Subjs, 
                              comps:CompSynsems)),
goal> (list_sign_to_synsem(CompDtrs,CompSynsems)),
cats> (CompDtrs,ne_list),
goal> (head_feature_principle(Mother,HeadDtr),
       semantics_principle(Mother,HeadDtr),
       marking_principle(Mother,HeadDtr),
       nonlocal_feature_principle(Mother,HeadDtr,CompDtrs)).

head_subject_complement rule
(Mother,synsem:loc:cat:(spr:[],
                        subj:[],
                        comps:[]))
===>
cat> (HeadDtr,synsem:loc:(cat):(head:inv:yes,
                                subj:[SubjSynsem], 
                                comps:CompSynsems)),
goal> (list_sign_to_synsem(CompDtrs,CompSynsems)),
cat> (SubjDtr),
goal> (sign_to_synsem(SubjDtr,SubjSynsem)),
cats> (CompDtrs,ne_list),
goal> (head_feature_principle(Mother,HeadDtr),
       semantics_principle(Mother,HeadDtr),
       marking_principle(Mother,HeadDtr),
       nonlocal_feature_principle(Mother,HeadDtr,[SubjDtr|CompDtrs])).

specifier_head rule
(Mother,synsem:loc:cat:(spr:[],
                        subj:[],
                        comps:[]))
===>
cat> (SpecDtr,synsem:loc:cat:(spr:[],
                              subj:[],
                              comps:[])),
goal> (sign_to_synsem(SpecDtr,SpecSynsem)),
cat> (HeadDtr,synsem:loc:cat:(spr:[SpecSynsem],
                              subj:[], 
                              comps:[])),
goal> (head_feature_principle(Mother,HeadDtr),
       semantics_principle(Mother,HeadDtr),
       marking_principle(Mother,SpecDtr),
       spec_principle(SpecDtr,HeadDtr),
       nonlocal_feature_principle(Mother,HeadDtr,[SpecDtr])).

adjunct_head rule
(Mother,synsem:loc:cat:(spr:Spr, 
                        subj:Subj, 
                        comps:[]))
===>
cat> (AdjDtr,synsem:loc:cat:(head:mod:(pre_mod_synsem,Mod),
                             spr:[],
                             subj:[],
                             comps:[])),
cat> (HeadDtr,synsem:(Mod,loc:cat:(spr:Spr, 
                                   subj:Subj,
                                   comps:[]))),
goal> (head_feature_principle(Mother,HeadDtr),
       marking_principle(Mother,HeadDtr),
       semantics_principle(Mother,AdjDtr),             % SP different here
       nonlocal_feature_principle(Mother,HeadDtr,[AdjDtr])).

head_adjunct rule
(Mother,synsem:loc:cat:(spr:Spr,
                            subj:Subj,
                            comps:[]))
===>
cat> (HeadDtr,synsem:(Mod,loc:cat:(spr:Spr,
                                   subj:Subj,
                                   comps:[]))),
cat> (AdjDtr,synsem:loc:cat:(head:mod:(post_mod_synsem,Mod),
                             spr:[],
                             subj:[],
                             comps:[])),
goal> (head_feature_principle(Mother,HeadDtr),
       marking_principle(Mother,HeadDtr),
       semantics_principle(Mother,AdjDtr),             % SP different again
       nonlocal_feature_principle(Mother,HeadDtr,[AdjDtr])).

filler_head rule
(Mother,synsem:loc:cat:(head:(verb,
                              vform:fin),
                        spr:Spr,
                        subj:[],
                        comps:[]))
===>
cat> (FillerDtr, synsem:loc:Slashloc),  
cat> (HeadDtr,synsem:(loc:cat:(spr:Spr,
                               subj:[],
                               comps:[]),
                      nonloc:(inherited:slash:elt:Slashloc,
                              tobind:slash:elt:Slashloc))),
goal> (head_feature_principle(Mother,HeadDtr),
       semantics_principle(Mother,HeadDtr),
       marking_principle(Mother,HeadDtr),
       nonlocal_feature_principle(Mother,HeadDtr,[FillerDtr])).

%%********************** Universal Principles

% head_feature_principle(Mother,Head-Daughter)

head_feature_principle(synsem:loc:cat:head:Head,
                       synsem:loc:cat:head:Head)
   if true.

% semantics_principle(Mother, SemHead)

semantics_principle(synsem:loc:cont:Cont,      % New semantics principle -
                    synsem:loc:cont:Cont)      % just pass up the Content
   if true.

% spec_principle(Spec-Dtr,Head-Dtr)

spec_principle(synsem:loc:cat:head:Head,
               synsem:HeadSynsem) 
 if
  specp_act(Head,HeadSynsem).

specp_act(subst,_) if      % substantive head
  true.
specp_act(spec:X,X) if     % functional head
  true.

% marking_principle(Mother,Head-Daughter)

marking_principle(synsem:loc:cat:marking:Marking,
                  synsem:loc:cat:marking:Marking) 
  if true.

% nonlocal_feature_principle(Mother,Head-Daughter,Other-Dtrs)
% adapted from hpsg4.pl

nonlocal_feature_principle(
            (synsem:nonloc:inherited:slash:MISlash),
            (HDtr, synsem:nonloc:tobind:slash:HTSlash),
            ODtrs) if
   islashes_of([HDtr|ODtrs],e_set,DISlash),
   set_diff(HTSlash,DISlash,MISlash).

/********************** Definite Constraints **********************/

append([],Xs,Xs) if
  true.
append([H|T1],L2,[H|T2]) if
  append(T1,L2,T2).

sign_to_synsem(synsem:Synsem,Synsem) if
     true.

list_sign_to_synsem([],[]) if
     true.

list_sign_to_synsem([H|T],[S|R]) if
     sign_to_synsem(H,S),
     list_sign_to_synsem(T,R). 

%% from hpsg.pl

islashes_of([],ISlash,ISlash) if
  true.
islashes_of([(synsem:nonloc:inherited:slash:e_set)|Dtrs],Accum,ISlash) if
  islashes_of(Dtrs,Accum,ISlash),
  !.
islashes_of([(synsem:nonloc:inherited:slash:DISlash)|Dtrs],Accum,ISlash) if
  union(Accum,DISlash,NewAccum),
  islashes_of(Dtrs,NewAccum,ISlash).

% union(?set1,+set2,?union)
union(e_set,Xs,Xs) if       
  true.
union((elt:X,elts:Xs),Ys,Zs) if
  set_member_eq(X,Ys),
  !,union(Xs,Ys,Zs).
union((elt:X,elts:Xs),Ys,(elt:X,elts:Zs)) if
  set_select(X,Ys,YsRest),
  union(Xs,YsRest,Zs).
union((elt:X,elts:Xs),Ys,(elt:X,elts:Zs)) if
  union(Xs,Ys,Zs).

set_diff(e_set,Set,Set) if   %first arg should be instantiated, so cut
  !,true.                    % in case it isn't, and it should also be subset
                             % of the second
set_diff((elt:X,elts:Xs),Set,Diff) if
  set_select_eq(X,Set,Rest),
  set_diff(Xs,Rest,Diff).

set_select(X,(elt:X,elts:Xs),Xs) if
  true.
set_select(Member,(elt:X,elts:Xs),(elt:X,elts:Rest)) if
  set_select(Member,Xs,Rest).

% set_select_eq(+member,+set,?rest)
set_select_eq(X,(elt:Y,elts:Xs),Xs) if    
  (X =@ Y).
set_select_eq(Member,(elt:X,elts:Xs),(elt:X,elts:Rest)) if
  set_select_eq(Member,Xs,Rest).

%%%**********************  End of File

