/*******************************************************/
/*    Bottom-up chart engine (parser and generator)    */
/*         for PSG with indexed logical forms          */
/*                                                     */
/*  Adapted from bottom-up chart parser (buchart1.pl)  */
/*        Gazdar & Mellish, NLP in Prolog 1989         */
/*   and generation algorithm for categorial grammar   */
/*      "Generation of Text from Logical Formulae"     */
/*       John Phillips, Machine Translation 1993       */
/*    and input_string for English from SAX parser     */
/*        Yuji Matsumoto & Yasuharu Den 1992           */
/*                                                     */
/*    Graham Wilcock (graham@ccl.umist.ac.uk) 97/10    */
/*******************************************************/

:- use_module(lists, library(lists), [is_list/1, permutation/2, reverse/2]).

parse(String, Category, Tree) :-
    abolish(edge,5),
    start_parse(1,N,String),
    clause( edge(1,N,Category,[],Parse), true ),
    reverse_tree(Parse,Tree).

start_parse(V0,V0,[]).
start_parse(V0,VN,[Word|Words]) :-
      V1 is V0 + 1,
      foreach( lookup_word(Word,Category),
	       add_edge(V0,V1,Category,[],[Word,Category]) ),
      start_parse(V1,VN,Words).

generate(Semantics, Category, Tree) :-
    abolish(edge,5),
    start_gen(0,0,Semantics),
    clause( edge(0,0,Category,[],Parse), true ),
    semantics(Category,EdgeSem),
    permutation(Semantics,EdgeSem),
    reverse_tree(Parse,Tree).

start_gen(0,0,[]).
start_gen(0,0,[Term|Terms]) :-
    foreach( lookup_term(Term,Word,Category),
             add_edge(0,0,Category,[],[Word,Category]) ),
    start_gen(0,0,Terms).

add_edge(V0, V1, Category, Categories, Parse) :-
    clause( edge(V0, V1, Category, Categories, Parse), true ), !.
add_edge(V1, V2, Category1, [], Parse) :-
    assert_edge(V1, V2, Category1, [], Parse),
    foreach( rule(Category2, [Category1|Categories]),
      add_edge(V1, V1, Category2, [Category1|Categories], [Category2]) ),
    foreach( edge(V0, V1, Category2, [Category1|Categories], Parses),
      add_edge(V0, V2, Category2, Categories, [Parse|Parses]) ).
add_edge(V0, V1, Category1, [Category2|Categories], Parses) :-
    assert_edge(V0, V1, Category1, [Category2|Categories], Parses),
    foreach( edge(V1, V2, Category2, [], Parse),
      add_edge(V0, V2, Category1, Categories, [Parse|Parses]) ).

rule(Mother,Daughters) :-
    (Mother ---> Daughters),
     is_list(Daughters).
rule(Mother,List_of_daughters) :-
    (Mother ---> Daughters),
     \+ is_list(Daughters),
    conjtolist(Daughters,List_of_daughters).

conjtolist((Term,Terms),[Term|List_of_terms]) :- !,
    conjtolist(Terms,List_of_terms).
conjtolist(Term,[Term]).

foreach(X,Y) :- X, do(Y), fail.
foreach(_,_) :- true.
do(Y) :- Y,!.

assert_edge(V1,V2,Category1,[],Parse1) :-
    asserta((edge(V1,V2,Category1,[],Parse1))),
    trace_edges(inactive(V1,V2,Category1)).
assert_edge(V1,V2,Category1,[Category2|Categories],Parse1) :-
    asserta((edge(V1,V2,Category1,[Category2|Categories],Parse1))),
    trace_edges(active(V1,V2,Category1,[Category2|Categories])).

:- dynamic trace_active/0, trace_inactive/0.

trace(active) :- assert(trace_active).
trace(inactive) :- assert(trace_inactive).
trace(off) :- retractall(trace_active), retractall(trace_inactive).

trace_edges(active(V1,V2,Cat,Cats)) :- 
	trace_active, portray(active(V1,V2,Cat,Cats)),nl, !.
trace_edges(inactive(V1,V2,Cat)) :- 
	trace_inactive, portray(inactive(V1,V2,Cat)),nl, !.
trace_edges(_).

reverse_tree([], []) :- !.
reverse_tree(Children, Children1) :- 
        is_list(Children), !,
	map_reverse_tree(Children, [], Children1).
reverse_tree(Word, Word).

map_reverse_tree([], Children1, Children1) :- !.
map_reverse_tree([Tree|Rest], Children1, Children2) :-
	reverse_tree(Tree, Tree1),
	map_reverse_tree(Rest, [Tree1|Children1], Children2).

/*******************************************************/
/*              Input Routine for English              */
/*                                                     */ 
/*                  (28 December 1992)                 */
/*  by Yuji Matsumoto (matsu@pine.kuee.kyoto-u.ac.jp)  */
/*     Yasuharu Den   (den@forest.kuee.kyoto-u.ac.jp)  */
/*  Dept. of Electrical Engineering, Kyoto University  */
/*                                                     */ 
/* Modified to keep capitals (including first word)    */ 
/* Graham Wilcock  (wilcock@is.aist-nara.ac.jp)  96/01 */ 
/*******************************************************/

%   input_string(-List)

input_string(List) :-
	get(C),
	C \== -1,
	!, words(C, List).
input_string(end_of_file).

words(C, Tail) :- space(C), !,
	get0(C1),
	words(C1, Tail).
words(C, [S|Tail]) :- symbol(C), !,
	name(S, [C]),
	get0(C1),
	words(C1, Tail).
words(C, [Word|Tail]) :- letter(C, L), !,
	word(L, C1, Name),
	name(Word, Name),
	!, words(C1, Tail).
words(_, []).

word(L, C1, [L|Tail]) :-
	get0(C),
	(   letter(C, L1),
	    word(L1, C1, Tail)
	;   C1 = C, Tail = []
	).

%   Character Types
space(9).   %  9 = "\t"
space(32).  % 32 = " "

symbol(C) :- C >= 33, C =< 47.
symbol(C) :- C >= 58, C =< 64.
symbol(C) :- C >= 91, C =< 96.
symbol(C) :- C >= 123, C =< 126.

letter(C, C) :- C >= 48, C =< 57.
% letter(C, L) :- C >= 65, C =< 90, !, L is C + 32.
letter(C, C) :- C >= 65, C =< 90.   % Upper case (Capitals)
letter(C, C) :- C >= 97, C =< 122.  % Lower case
letter(C, C) :- C >= 128.
letter(0'', 0'').                   % apostrophe (isn't, hasn't...)