:- dynamic forests/3.

parse(Ws, Tree) :-
        retractall(forests(_,_,_)),
        add(forests(0,[],[])),
        reduce(0,Ws),
        start_symbol(S),
        length(Ws,N),
        forests(N,[S],[Tree]).

shift(I,[W|Ws]) :-
        word(W,A),
        forests(I,Roots,Forest),
        J is I + 1,
        add(forests(J,[A|Roots],
                    [[A,W]|Forest])),
        fail.
shift(I,[W|Ws]) :-
        J is I + 1, reduce(J,Ws).
shift(I,[]).
reduce(I,_Ws) :-
        forests(I,Roots,Forest),
        reduce(I,Roots,Forest),
        fail. 
reduce(I,Ws) :-
        shift(I,Ws).

reduce(I,Roots,Forest) :- 
        explain('Reduce: ',Roots),
        (B ---> Beta),
        tupleToList(Beta,BetaL),
        length(BetaL,N),
        reverse(BetaL,BetaRev),
        append(BetaRev,AlphaRev,Roots),
        length(BetaForest,N),
        append(BetaForest,AlphaForest,Forest),
        reverse(BetaForest,BetaTrees),
        NewForest = [[B|BetaTrees]|AlphaForest],
        NewRoots = [B|AlphaRev],
        add(forests(I,NewRoots,NewForest)),
        explain('Reduced: ',NewRoots),
        reduce(I,NewRoots,NewForest),
        fail.
reduce(I,Roots,Forest).

tupleToList((B,C),[B|Cs]) :- !, tupleToList(C,Cs).
tupleToList([],[]).
tupleToList([W],[[W]]).
tupleToList(B,[B]).

add(T) :- (known_instance(T) -> true ; assertz(T)).

known_instance(Term) :- % (for callable terms only)
        \+ \+ (numbervars(Term,const,0,_), Term).

explain(Atom,Stack) :-
        nl,write(Atom),reverse(Stack,Roots),write(Roots).