% Shift-reduce parser
% progsr.pl

:-op(1100, xfx, --->).
:-op(1100, xfx, ===>).

shift(Stack, [Word | Stack], [Word | Words], Words).

reduce(Stack, NewStack, Input, Input) :-
    reduce_aux(Stack, [], NewStack).

reduce_aux(Rest, RHS, [LHS | Rest]) :-
    ((LHS ---> RHS) ;
     (LHS ===> RHS)).

reduce_aux([Cat | Cats], RevStack, NewStack) :-
    reduce_aux(Cats, [Cat | RevStack], NewStack).

sr_parse([Stack], [Stack], Input, Input).

sr_parse(Stack, ResultStack, Input, ResultInput) :-
   shift(Stack, NewStack, Input, NewInput),
   sr_parse(NewStack, ResultStack, NewInput, ResultInput).

sr_parse(Stack, ResultStack, Input, ResultInput) :-
   reduce(Stack, NewStack, Input, NewInput),
   sr_parse(NewStack, ResultStack, NewInput, ResultInput).

parse(Input, Start) :-
   sr_parse([], [Start], Input, []).