% This file test the HYPROLOG system
% with a combination of DCG, assumptions and abducibles.

% Copyright (C) Henning Christiansen, November 2005, 2008
% Decls. of CHR constraints changed to SWI / SICStus 4 syntax.

% ?- hyprolog(shootingLuckyLukeAdvanced).

% Extends simple version with time (to prevent dead people from shooting)
% plurals, case (object/subject, e.g., him/he)


abducibles event/4,          % Example: event(12,shooting,joeDalton,luckyLuke)
                             % ... the shooting event took place at noon
                             % Arguments may also be lists
           dead/2, alive/2.  % person X is dead/alive at time N.


assumptions acting/2.  % for pronoun resolution

:- chr_constraint all_leq/1,          % wrt. @<, used to avoid permutation of certain lists
            selectAllNonDead/2. % another little helper


%%%%%% GRAMMAR %%%%%%%%%%%%%%%%%%%%%

discourse --> ss(0).

ss(_)    --> [].
ss(Time)    --> s(Time), {TimePlus1 is Time+1}, ss(TimePlus1).

s(Time)    --> np(subject,_,Who,Num),vp(What,Whom,Num), {event(Time,What,Who,Whom)}.

np(X,Gender,Who,Num)   --> pro(X,Gender,Who,Num).
np(_,Gender,Who,Num)  --> name(Gender,Who,Num), {*acting(Gender,Who)}.

vp(What,Whom,Num)        --> v(What,Num),np(object,_,Whom,_).

name(masc,luckyLuke,sing)  --> [luckyLuke].
name(masc,joeDalton,sing)  --> [joeDalton].
name(masc,jackDalton,sing)  --> [jackDalton].
name(masc,williamDalton,sing)  --> [williamDalton].
name(masc,averellDalton,sing)  --> [averellDalton].
name(masc,huey,sing)  --> [huey].
name(masc,dewey,sing)  --> [dewey].
name(masc,louie,sing)  --> [louie].
name(masc,donald,sing)  --> [donald].
name(fem,calamityJane,sing)   --> [calamityJane].
name(fem,maDalton,sing)   --> [maDalton].
name(fem,daisy,sing)   --> [daisy].

name(mix,AliveDaltons,plu) --> [the,daltons],
  {selectAllNonDead([averellDalton,jackDalton,joeDalton,williamDalton],
                  AliveDaltons)}.

pro(subject,masc,Who,sing) --> [he], {-acting(masc,Who)}.
pro(subject,fem,Who,sing) --> [she], {-acting(masc,Who)}.
pro(object,masc,Whom,sing)  --> [him], {-acting(masc,Whom)}.
pro(object,fem,Whom,sing)  --> [her], {-acting(masc,Whom)}.

pro(object,mixed,Whom,plu)  --> [them], {expect_2_or_more_acting(mix,Whom)}.
pro(subject,mixed,Who,plu)  --> [they], {expect_2_or_more_acting(mix,Who)}.


v(shooting,sing) --> [shoots].

v(shooting,plu) --> [shoot].
          
%%%%%%%%%% ICs

event(Time,shooting,Who,Whom) ==>
   alive(Time,Who), dead(Time,Whom).

alive(TimeLive,X), dead(TimeDead,X) ==> TimeLive < TimeDead.

event(Time1,shooting,Who,Whom), dead(Time2,Whom1) ==>
   (Whom==Whom1 ; member(Whom, Whom1))
   |
   Time1=Time2. % Die only once

alive(Time,[]) <=> true.
alive(Time,[X|Xs]) <=> alive(Time,X), alive(Time,Xs).

dead(Time,[]) <=> true.
dead(Time,[X|Xs]) <=> dead(Time,X), dead(Time,Xs).

% Non-declarative CHR, I'm afraid:

dead(_,D) \ selectAllNonDead([D|Ds],L) <=> selectAllNonDead(Ds,L).

selectAllNonDead([D|Ds],L) <=> L=[D|L1], selectAllNonDead(Ds,L1).

selectAllNonDead([],L) <=> L=[].

%%%% help predicate 

expect_2_or_more_acting(Gender,[X1,X2|Xs]):-
    all_leq([X1,X2|Xs]),
    expect_1_acting(Gender,X1),
    expect_1_acting(Gender,X2),
    expect_0_or_more_acting(mix,Xs).

expect_0_or_more_acting(_,[]).

expect_0_or_more_acting(Gender,[X|Xs]):-
   expect_1_acting(Gender,X),
   expect_0_or_more_acting(Gender,Xs).

expect_1_acting(Gender,X):-
    Gender == mix -> -acting(_,X)
    ;
    -acting(Gender,X).


%% helper constraint

all_leq([]) <=> true.
all_leq([X]) <=> true.
all_leq([X1,X2|Xs]) <=>
   ground(X1), ground(X2) | X1 @< X2, all_leq([X2|Xs]).


%%%% another story

duckville:-
   *acting(male,huey),*acting(male,dewey),*acting(male,louie),
   *acting(male,donald), *acting(female,daisy).

/************** 

?- phrase(discourse, [luckyLuke,shoots,calamityJane]).

?- phrase(discourse, [he,shoots,maDalton]).

?- phrase(discourse, [luckyLuke,shoots,calamityJane, he,shoots,maDalton]).

?- phrase(discourse, [luckyLuke,shoots,jackDalton, he,shoots,maDalton]).

?- phrase(discourse, [luckyLuke,shoots,jackDalton,
                      calamityJane,shoots,averellDalton,
                      joeDalton,shoots,them]).
                      
?- phrase(discourse, [luckyLuke,shoots,jackDalton,
                      calamityJane,shoots,averellDalton,
                      they,shoot,joeDalton]).
                      
?- duckville, phrase(discourse, [they,shoot,them]).
                      
?- duckville, phrase(discourse, [they,shoot,donald]).

******************/