%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% TAGLET.PL
%% Matthew Stone
%% March, 2002
%% Finger-exercises for xtag+spud-lite.
%%
%% File Structure.
%% 1. Definitions for specific prolog implementations.
%% 2. Knowledge base predicates.
%% 3. Tree structure definitions and conversions.
%% 4. Tree operations.
%% 5. Parsing.
%% 6. Generation.
%% 7. Verification & validation.
%% 8. Lexicon

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% 1. Definitions for specific prolog implementations.
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% Some extra list-manipulation and term-manipulation.

%% exact_delete(L, E, L2) is true if
%%     L contains an element identical (==) to E
%%     (including identity of variables at this point
%%     in the prolog state).  L2 is the list just like
%%     L but with E omitted.

exact_delete([E|R], M, R) :- E == M.
exact_delete([H|T], E, [H|R]) :- exact_delete(T, E, R).

%% zap(Removable, Removefrom, Result) is true if
%%     Result is a list containing all elements from
%%     the list Removefrom except elements of list
%%     Removable.

zap_aux([], _, []).
zap_aux([E|T], E, R) :- zap_aux(T, E, R).
zap_aux([H|T], E, [H|R]) :- zap_aux(T, E, R), \+(E=H).

zap([], R, R).
zap([H|T], L, R) :-
	zap_aux(L, H, M),
	zap(T, M, R).

%% exact_subvar(T1, V) 
%%      true if variable V is identical (==) 
%%      to a subterm of T1.

exact_subvar(T1, T2) :- 
	var(T1), T1 == T2.
exact_subvar(Term, Subterm) :-
	\+ var(Term),
	Term =.. [ _ | Args],
	member(Next, Args),
	exact_subvar(Next, Subterm).

%% flex_subvar(T1, V) 
%%      unifies variable V with a variable subterm of T1.

flex_subvar(T1, T1) :-
	var(T1).
flex_subvar(Term, Subterm) :-
	\+ var(Term),
	Term =.. [ _ | Args],
	member(Next, Args),
	flex_subvar(Next, Subterm).

%% overlap(T1,T2) 
%%      true if T1 and T2 contain the same variable
%%      as a subterm.

overlap(T1, T2) :-
	flex_subvar(T1, S),
	exact_subvar(T2, S).

%% counter for instantiating variables.

:- dynamic(variable_count/1).
variable_count(0).

%% Sicstus (v 3.7), use the definitions below:

%% member(E, L) is true if L contains E.
member(E, [E|_]).
member(E, [_|R]) :- member(E,R).

%% append(F, S, L) is true if L contains F followed by S.
append([], L, L).
append([H|T], S, [H|L]) :- append(T, S, L).

%% reverse(L, R) is true if R is the reverse of L.
reverse(L, R) :-
	raux(L, [], R).

raux([], L, L).
raux([H|T], L, R) :- raux(T, [H|L], R).

%% nv(X, Y, L) instantiates the free variables in X
nv(X) :-
	retract(variable_count(Y)),
	numbervars(X, Y, Z),
	assert(variable_count(Z)).

%% Print complete details of terms
:- prolog_flag(toplevel_print_options, _,
	       [quoted(true), 
	        numbervars(true),
                portrayed(true), 
                max_depth(0)]).

:- prolog_flag(debugger_print_options, _,
	       [quoted(true), 
	        numbervars(true),
                portrayed(true), 
                max_depth(0)]).

%% For SWI-Prolog, use the definitions below:

%% %% nv(X, Y, L) instantiates the free variables in X
%% nv(X) :-
%% 	retract(variable_count(Y)),
%% 	numbervars(X, dr, Y, Z),
%% 	assert(variable_count(Z)).

%% %% Print complete details of terms
%% :- set_prolog_flag(toplevel_print_options, 
%% 	           [quoted(true), 
%%                     portray(true), 
%%                     max_depth(0)]).

%% :- set_prolog_flag(debugger_print_options, 
%% 	           [quoted(true), 
%%                     portray(true), 
%%                     max_depth(0)]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% 2. Knowledge base predicates
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% shared(F) should be true 
%%   if F is part of the common ground of the conversation.  
:- dynamic(shared/1).

%% private(F) should be true 
%%   if F is part of the system's private information.  
:- dynamic(private/1).

%% all_shared(L)
%%   true if all facts in L are part of the common ground.
all_shared([]).
all_shared([F|R]) :-
	shared(F),
	all_shared(R).

%% all_private(L)
%%   true if all facts in L are part of system's private info.
all_private([]).
all_private([F|R]) :-
	private(F),
	all_private(R).

%% make_all_shared(L)
%%   always true
%%   as a side-effect, add facts in L to the common ground.
make_all_shared([]).
make_all_shared([F|R]) :-
	assert(shared(F)),
	make_all_shared(R).

%% make_all_private(L)
%%   always true
%%   as a side-effect, add facts in L to system's private info.
make_all_private([]).
make_all_private([F|R]) :-
	assert(private(F)),
	make_all_private(R).

%% clear
%%    always true
%%    as a side-effect, resets the knowledge base.
clear :-
	retractall(shared(_)),
	retractall(private(_)).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% 3. Tree structure definitions and operations.
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% Structures
%% TAGLET is a tree-rewriting formalism with two operations:
%% - substitution: replacing a leaf by a new subtree
%%   corresponding to obligatory syntactic complementation.
%% - sister-adjunction: adding a subtree as a new child
%%   corresponding to optional syntactic modification
%%
%% The program represents TAGLET trees with four alternative
%% structures:
%%   n/t-structures: for elementary trees in the lexicon.
%%      n/t-structures are completely unsaturated.
%%   na/ta-structures: for derived trees in analysis.
%%      na/ta-structures are saturated across a single
%%      uninterrupted span of text, otherwise unsatureted.
%%   ng/tg-structures: for derived trees in generation.
%%      ng/tg-structures are freely saturated
%%      (though complements at each node
%%      are provided in order) and freely unsaturated.
%%   nx-structures: for completed derivations
%%      nx-structures are completely saturated.
%% All structures share substructure:
%%   category terms for syntactic categories.
%%   w(word) structures for overt lexical material.
%%   comp/premod(category?)/postmod(category?)
%%          specifying a TAGLET operation.
%%   children are labeled c- or m- or h-, giving - structures
%%
%% N/T STRUCTURES.
%%
%% n(cat: category, 
%%   head: n-structure, 
%%   unsat_left: category list (R to L order), 
%%   unsat_right: category list (L to R order))
%%
%% t(node: n-structure,
%%   op: TAGLET operation)
%%
%% NA/TA STRUCTURES.
%%
%% na(category: cat, 
%%      head: node,
%%      unsat_left: cat list (R to L order),
%%      sat_left: -na-structure list (L to R order),
%%      left_comp_below: yes or no,
%%      unsat_right: cat list (L to R order),
%%      sat_right: -na-structure list (R to L order),
%%      right_comp_below: yes or no)
%%
%% ta(node: na-structure, 
%%    root: category,
%%    unfinished_left: yes or no,
%%    unfinished_right: yes or no,
%%    right_op_done: yes or no,
%%    op: TAGLET operation)
%% 
%% NG/TG STRUCTURES.
%%
%% ng(cat: category, 
%%    head: ng-structure,
%%    unsat_left: category list (R to L order),
%%    sat_left: -ng-structure list (L to R order),
%%    unsat_right: category list (L to R order),
%%    sat_right: -ng-structure list (R to L order))
%%
%% tg(node: ng-structure,
%%    root: category,
%%    op: TAGLET operation)
%%
%% NX STRUCTURES
%%
%% nx(cat: category,
%%    children: -nx-structure list (L to R order))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

nx_root(nx(C, _), C).
nx_root(w(_), word).

nx_leaves(w(W), [W|R], R).
nx_leaves(nx(_, L), S, E) :-
	nx_leaves_list(L, S, E).

nx_leaves_list([], R, R).
nx_leaves_list([ _K-H | T], S, E) :-
	nx_leaves(H, S, M),
	nx_leaves_list(T, M, E).
 
nx_leaves(T, S) :-
	nx_leaves(T, S, []).

n_info(w(W), W, P, P, A, A).

n_info(n(C, H, UL, UR), W, P, _HP, ArgListIn, ArgListOut) :-
	n_info_list(UL, ArgListIn, ArgListN1),
	n_info_list(UR, ArgListN1, ArgListN2),
	arg(1, C, E),
	((nonvar(E); exact_subvar(ArgListN2, E)) ->
	    n_info(H, W, P, C, ArgListN2, ArgListOut) ;
	    n_info(H, W, P, C, [E | ArgListN2], ArgListOut) 
	).

n_info_list([], L, L).
n_info_list([C|R], L, F) :-
	arg(1, C, E),
	((nonvar(E); exact_subvar(L, E)) ->
	    n_info_list(R, L, F);
	    n_info_list(R, [E|L], F)
	).

t_info(t(N, _), W, P, A) :-
	n_info(N, W, P, w, [], A).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% TRANSFORMATIONS BETWEEN STRUCTURES
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%---------------------------------
%%
%% n/t to na/ta

n_to_na_structure(w(Word), w(Word), no, no, word).

n_to_na_structure(
	n(C, H, UL, UR), 
	na(C, H2, UL, [], LB, UR, [], RB), 
	LBN, 
	RBN,
	C
    ) :-
	n_to_na_structure(H, H2, LB, RB, _),
	(UL = [] -> LBN = LB ; LBN = yes),
	(UR = [] -> RBN = RB ; RBN = yes).

t_to_ta_structure(
	t(Node, comp), 
	ta(Exp, Root, LB, RB, no, comp)
    ) :-
	n_to_na_structure(Node, Exp, LB, RB, Root).

t_to_ta_structure(
	t(Node, premod(Root)), 
	ta(Exp, Root, LB, RB, no, premod)
    ) :-
	n_to_na_structure(Node, Exp, LB, RB, _).

t_to_ta_structure(
	t(Node, postmod(Root)), 
	ta(Exp, Root, LB, RB, no, postmod)
    ) :-
	n_to_na_structure(Node, Exp, LB, RB, _).

%%---------------------------------
%%
%% na/ta to nx

na_to_nx_structure(w(Word), w(Word)).

na_to_nx_structure(
	na(C, H, _, LS, _, _, RS, _),
	nx(C, L)
    ) :-
	reverse(RS, X),
	na_to_nx_list(X, [], CX),
	na_to_nx_structure(H, H2),
	na_to_nx_list(LS, [ h-H2 | CX], L).

na_to_nx_list([], L, L).
na_to_nx_list([ K-H | T], L, [ K-HC | R]) :-
	na_to_nx_structure(H, HC),
	na_to_nx_list(T, L, R).

ta_to_nx_structure(ta(Node, _, _, _, _, _), NX) :-
	na_to_nx_structure(Node, NX).

%%---------------------------------
%%
%% n/t to ng/tg

n_to_ng_structure(w(Word), w(Word), word).

n_to_ng_structure(
	n(C, H, UL, UR), 
	ng(C, H2, UL, [], UR, []), 
	C
    ) :-
	n_to_ng_structure(H, H2, _).

t_to_tg_structure(
	t(Node, comp), 
	tg(Exp, Root, comp)
    ) :-
	n_to_ng_structure(Node, Exp, Root).

t_to_tg_structure(
	t(Node, premod(Root)), 
	tg(Exp, Root, premod)
    ) :-
	n_to_ng_structure(Node, Exp, _).

t_to_tg_structure(
	t(Node, postmod(Root)), 
	tg(Exp, Root, postmod)
    ) :-
	n_to_ng_structure(Node, Exp, _).

t_for_tg_template(
	tg(_, N, comp),
	t(n(N,_,_,_), comp)
    ).

t_for_tg_template(
	tg(_, N, postmod),
	t(_, postmod(N))
    ).

t_for_tg_template(
	tg(_, N, premod),
	t(_, premod(N))
    ).

%%---------------------------------
%%
%% ng/tg to nx

ng_to_nx_structure(w(Word), w(Word)).

ng_to_nx_structure(
	ng(C, H, _, LS, _, RS),
	nx(C, L)
    ) :-
	reverse(RS, X),
	ng_to_nx_list(X, [], CX),
	ng_to_nx_structure(H, H2),
	ng_to_nx_list(LS, [ h-H2 | CX], L).

ng_to_nx_list([], L, L).
ng_to_nx_list([ K-H | T], L, [ K-HC | R]) :-
	ng_to_nx_structure(H, HC),
	ng_to_nx_list(T, L, R).

tg_to_nx_structure(tg(Node, _, _), NX) :-
	ng_to_nx_structure(Node, NX).

%%------------------------------------
%%
%% nx to n/t

nx_elements(
	w(Word),
	w(Word),
	SubElements,
	SubElements
    ).

nx_elements(
	nx(C, Kids), 
	n(C, Head, UnsatLeft, UnsatRight),
	SubElementsStart,
	SubElementsEnd
    ) :-
	nx_elements_left(C, Kids, Head, [], UnsatLeft, UnsatRight, 
	                 SubElementsStart, SubElementsEnd).

nx_elements_left(
	C, [ h-H | R ], Head, Left, Left, Right, 
	SubElementsStart, SubElementsEnd
    ) :-
	nx_elements(H, Head, SubElementsStart, SubElementsNext),
	nx_elements_right(C, R, [], Right, SubElementsNext, SubElementsEnd).

nx_elements_left(
	C, [ m-M | T ], Head, Sofar, Left, Right,
	SubElementsStart, SubElementsEnd
    ) :-
	nx_t_elements(premod(C), M, SubElementsStart, SubElementsNext),
	nx_elements_left(C, T, Head, Sofar, Left, Right,
	                 SubElementsNext, SubElementsEnd).

nx_elements_left(
	C, [ c-M | T ], Head, Sofar, Left, Right,
	SubElementsStart, SubElementsEnd
    ) :-
	nx_t_elements(comp, M, SubElementsStart, SubElementsNext),
	nx_root(M, MC),
	nx_elements_left(C, T, Head, [MC | Sofar], Left, Right,
	                 SubElementsNext, SubElementsEnd).

nx_elements_right(
	_C, [], Sofar, Right, SubElements, SubElements
    ) :-
	reverse(Sofar, Right).

nx_elements_right(
	C, [ m-M | T], Sofar, Right, SubElementsStart, SubElementsEnd
    ) :-
	nx_t_elements(postmod(C), M, SubElementsStart, SubElementsNext),
	nx_elements_right(C, T, Sofar, Right, 
	                  SubElementsNext, SubElementsEnd).

nx_elements_right(
	C, [ c-M | T], Sofar, Right, SubElementsStart, SubElementsEnd
    ) :-
	nx_t_elements(comp, M, SubElementsStart, SubElementsNext),
	nx_root(M, MC),
	nx_elements_right(C, T, [ MC | Sofar ], Right,
                          SubElementsNext, SubElementsEnd).

nx_t_elements(
	Op, NX,
	[ t(N, Op) | SubElementsStart ],
	SubElementsEnd
    ) :-
	nx_elements(NX, N, SubElementsStart, SubElementsEnd).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% 4. Tree Operations
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 
%% 4a. Combinatory operations for parsing:
%%  -  substitute completed tree on spine & right frontier
%%  -  postmodify by completed tree on spine & right frontier
%%  -  substitute completed tree on spine & left frontier
%%  -  premodify by completed tree on spine & left frontier
%% Keeping track of what the constituent needs where
%% in order to be fully saturatied.

na_compute_unfinished(
	na(_,_,UL,_,LB,UR,_,RB), 
	AB
    ) :-
	((UL = [], UR = []) ->
	    compute_unfinished(LB, RB, AB);
	    AB = yes
	).

combine_parse(
	ta(Major, Root, no, yes, _, Op),
	ta(Minor, R, no, no, X, comp),
	ta(Result, Root, no, U, yes, Op)
    ) :-
	subst_on_right_frontier(Major, ta(Minor, R, no, no, X, comp), Result, U).

combine_parse(
	ta(Major, Root, no, RB, _, Op),
	ta(Minor, R, no, no, X, postmod),
	ta(Result, Root, no, RB, yes, Op)
    ) :-
	postmod_on_right_frontier(Major, ta(Minor, R, no, no, X, postmod), Result).

combine_parse(
	ta(Minor, R, no, no, X, comp),
	ta(Major, Root, yes, RB, no, Op),
	ta(Result, Root, U, RB, no, Op)
    ) :-
	subst_on_left_frontier(Major, ta(Minor, R, no, no, X, comp), Result, U).

combine_parse(
	ta(Minor, R, no, no, X, premod),
	ta(Major, Root, LB, RB, no, Op),
	ta(Result, Root, LB, RB, no, Op)
    ) :-
	premod_on_left_frontier(Major, ta(Minor, R, no, no, X, premod), Result).

%%---------------------------------
%%
%% subst_on_right_frontier(SubstInto, Subst, Result)

subst_on_right_frontier(
	na(C, H, UL, SL, LCB, [R|URs], SR, no),
	ta(N, R, no, no, _, comp),
	na(C, H, UL, SL, LCB, URs, [ c-N | SR], no),
	B
    ) :-
	(URs = [] -> B = no ; B = yes).

subst_on_right_frontier(
	na(C, H, UL, SL, LCB, URs, SR, yes), 
	ta(N, R, no, no, X, comp),
	na(C, H2, UL, SL, LCB, URs, SR, B),
	B2
    ) :-
	subst_on_right_frontier(H, ta(N, R, no, no, X, comp), H2, B),
	(URs = [] -> B2 = B ; B2 = yes).

%%---------------------------------
%%
%% postmod_on_right_frontier(Into, Mod, Result)

postmod_on_right_frontier(
	na(C, H, UL, SL, LCB, UR, SR, no),
	ta(N, C, no, no, _, postmod),
	na(C, H, UL, SL, LCB, UR, [ m-N | SR], no)
    ).

postmod_on_right_frontier(
	na(C, H, UL, SL, LCB, UR, SR, yes),
	ta(N, R, no, no, X, postmod),
	na(C, H2, UL, SL, LCB, UR, SR, yes)
    ) :-
	postmod_on_right_frontier(H, ta(N, R, no, no, X, postmod), H2).

postmod_on_right_frontier(
	na(C, H, UL, SL, LCB, UR, [], no),
	ta(N, R, no, no, X, postmod),
	na(C, H2, UL, SL, LCB, UR, [], no)
    ) :-
	postmod_on_right_frontier(H, ta(N, R, no, no, X, postmod), H2).

%%---------------------------------
%%
%% subst_on_left_frontier(Into, Mod, Result)

subst_on_left_frontier(
	na(C, H, [L|UL], SL, no, URs, SR, RCB),
	ta(N, L, no, no, _, comp),
	na(C, H, UL, [ c-N |SL], no, URs, SR, RCB),
	B
    ) :-
	(UL = [] -> B = no ; B = yes).

subst_on_left_frontier(
	na(C, H, UL, SL, yes, UR, SR, RCB), 
	ta(N, R, no, no, X, comp),
	na(C, H2, UL, SL, B, UR, SR, RCB),
	B2
    ) :-
	subst_on_left_frontier(H, ta(N, R, no, no, X, comp), H2, B),
	(UL = [] -> B2 = B ; B2 = yes).

%%---------------------------------
%%
%% premod_on_left_frontier(Into, Mod, Result)

premod_on_left_frontier(
	na(C, H, UL, SL, no, UR, SR, RCB),
	ta(N, C, no, no, _, premod),
	na(C, H, UL, [ m-N | SL], no, UR, SR, RCB)
    ).

premod_on_left_frontier(
	na(C, H, UL, SL, yes, UR, SR, RCB),
	ta(N, R, no, no, X, premod),
	na(C, H2, UL, SL, yes, UR, SR, RCB)
    ) :-
	premod_on_left_frontier(H, ta(N, R, no, no, X, premod), H2).

premod_on_left_frontier(
	na(C, H, UL, [], no, UR, SR, RCB),
	ta(N, R, no, no, X, premod),
	na(C, H2, UL, [], no, UR, SR, RCB)
    ) :-
	premod_on_left_frontier(H, ta(N, R, no, no, X, premod), H2).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 
%% 4b. Combinatory operations for generation:
%%  -  substitute, premodify or postmodify anywhere 
%% Keep track of the tree address of the operation,
%% to distinguish combinatory operations.

combine_gen(
	tg(N, C, Op),
	T,
	tg(N2, C, Op),
	Addr
    ) :-
	gen_op_tree(N, T, N2, Addr).

gen_op_list([ K-N | R ], T, Inc, [ K-N2 | R ], [ Index | Addr]) :-
	length(R, Ct),
	Index is Inc * Ct,
	gen_op_tree(N, T, N2, Addr).

gen_op_list([ N | R ], T, Inc, [ N | R2 ], Addr) :-
	gen_op_list(R, T, Inc, R2, Addr).

gen_op_tree(
	ng(C, H, UL, SL, UR, SR),
	T,
	ng(C, H2, UL, SL, UR, SR),
	[ 0 | Addr ]
    ) :-
	gen_op_tree(H, T, H2, Addr).

gen_op_tree(
	ng(C, H, UL, SL, UR, SR),
	T,
	ng(C, H, UL, SL2, UR, SR),
	Addr
    ) :-
	gen_op_list(SL, T, -1, SL2, Addr).

gen_op_tree(
	ng(C, H, UL, SL, UR, SR),
	T,
	ng(C, H, UL, SL, UR, SR2),
	Addr
    ) :-
	gen_op_list(SR, T, 1, SR2, Addr).
	
gen_op_tree(
	ng(C, H, [L|UL], SL, UR, SR),
	tg(N, L, comp),
	ng(C, H, UL, [ c-N | SL], UR, SR),
	[Ct]
    ) :-
	length(SL, CtP),
	Ct is - CtP.

gen_op_tree(
	ng(C, H, UL, SL, UR, SR),
	tg(N, C, premod),
	ng(C, H, UL, [ m-N | SL], UR, SR),
	[Ct]
    ) :-
	length(SL, CtP),
	Ct is - CtP.

gen_op_tree(
	ng(C, H, UL, SL, [R|UR], SR),
	tg(N, R, comp),
	ng(C, H, UL, SL, UR, [ c-N | SR]),
	[Ct]
    ) :-
	length(SR, Ct).
	
gen_op_tree(
	ng(C, H, UL, SL, UR, SR),
	tg(N, C, postmod),
	ng(C, H, UL, SL, UR, [ m-N | SR]),
	[Ct]
    ) :-
	length(SR, Ct).

generalize_addr([], []).
generalize_addr([_], [_]) :- !.
generalize_addr([A|T], [A|R]) :- 
	generalize_addr(T, R).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% 5. Parsing.
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 
%% 5a. CKY Parser with semantics.
%%
%% Edges are stored in the form of chart entries:
%% 
%% s_chart(start: index of first word in constituent, 
%%         end: index of first word after constituent, 
%%         tree: syntax of constituent, 
%%         comp-presup: presuppositions of complements, 
%%         mod-presup: presuppositions of modifiers,
%%         comp-assert: assertion of complements,
%%         mod-assert: assertion of modifiers).

:- dynamic(s_chart/6).

%% add_s_edges(Start, End)
%%      determine all possible constituents that
%%      could start at index Start and continue
%%      to span the words before End, based on
%%      the current state of the chart.

add_s_edges(Start, End) :-
	s_chart(Start, Middle, Tree1, P1c, P1m, A1c, A1m),
	s_chart(Middle, End, Tree2, P2c, P2m, A2c, A2m),
	combine_parse(Tree1, Tree2, Tree3),
        append(A1c, A2c, A3c),
        append(A1m, A2m, A3m),
	append(P1c, P2c, P3c),
	append(P1m, P2m, P3m),
	assert(s_chart(Start, End, Tree3, P3c, P3m, A3c, A3m)),
	fail.

add_s_edges(_, _).

%% extend_s_chart(Start, End)
%%      determine all possible constituents
%%      that could start at index Start and
%%      continue to span the words before End,
%%      but first add all shorter constituents
%%      with the same endpoint to the chart.

extend_s_chart(EndLessOne, End) :-
	EndLessOne is End - 1, !.

extend_s_chart(Start, End) :-
	Next is Start + 1,
	Next < End,
	extend_s_chart(Next, End),
	add_s_edges(Start, End).

%% build_s_chart(Start, End)
%%      determine all possible constituents
%%      starting at Start or later and ending
%%      up to End or earlier, by combining
%%      the words in the chart already into
%%      a bottom-up table.

build_s_chart(X, Y) :- 
	Y is X + 1, !.

build_s_chart(Start, End) :-
	Prev is End - 1,
	Prev > Start,
	build_s_chart(Start, Prev),
	extend_s_chart(Start, End).

%% word_s_edges(Item, Start, End)
%%      access the lexicon to insert all possible
%%      structures for the given item which is
%%      assumed to start at Start, with End the
%%      start of the first item afterwards.

word_s_edges(Word, Start, Next) :-
	initial_tree(Word, Ltree, Presup, Assert),
	t_to_ta_structure(Ltree, Tree),
	(Ltree = t(_,comp) -> 
	    (Pc = Presup, Pm = [], Ac = Assert, Am = []);
	    (Pc = [], Pm = Presup, Ac = [], Am = Assert)),
	assert(s_chart(Start, Next, Tree, Pc, Pm, Ac, Am)),
	fail.

word_s_edges(_, _, _).

%% setup_s_chart(Items, Start, End)
%%      Given the list Items of all words in the
%%      input remaining at index Start, add edges
%%      for these words to the chart, and return
%%      in End the index of the end of the sentence.

setup_s_chart([], N, N).

setup_s_chart([Word | More], Start, End) :-
	Next is Start + 1,
	word_s_edges(Word, Start, Next),
	setup_s_chart(More, Next, End).

%% cky_s_parse(Words, Tree, Pc, Pm, Assert)
%%      Uses CKY chart parsing to find 
%%      a parse tree Tree that provides an
%%      analysis of Words, under which
%%      Pc is the presupposition of complements,
%%      Pm is the presupposition of modifiers, and
%%      Assert is the assertion of the items.

cky_s_parse(Words, Tree, Pc, Pm, Ac, Am) :-
	retractall(s_chart(_,_,_,_,_,_,_)),
	setup_s_chart(Words, 0, End),
	build_s_chart(0, End),
	s_chart(0, End, BigTree, Pc, Pm, Ac, Am),
	ta_to_nx_structure(BigTree, Tree).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 
%% 5b. CKY Parser with semantics and interpretation.
%%
%% Edges are stored in the form of chart entries:
%% 
%% i_chart(start: index of first word in constituent, 
%%         end: index of first word after constituent, 
%%         tree: syntax of constituent, 
%%         all-presup: presuppositions of consituent,
%%         assert: assertion of constituent,
%%         interps: matches for interpretations in context).
%%
%% Control flow and predicate semantics isomorphic to
%% the semantic interpreter.

:- dynamic(i_chart/6).

add_i_edges(Start, End) :-
	i_chart(Start, Middle, Tree1, P1, A1, I1),
	i_chart(Middle, End, Tree2, P2, A2, I2),
	combine_parse(Tree1, Tree2, Tree3),
        append(A1, A2, A3),
	append(P1, P2, P3),
	findall(P3, (member(P1, I1), member(P2, I2)), I3),
	\+ (I3 = []),
	assert(i_chart(Start, End, Tree3, P3, A3, I3)),
	fail.

add_i_edges(_, _).

extend_i_chart(EndLessOne, End) :-
	EndLessOne is End - 1, !.

extend_i_chart(Start, End) :-
	Next is Start + 1,
	Next < End,
	extend_i_chart(Next, End),
	add_i_edges(Start, End).

build_i_chart(X, Y) :- 
	Y is X + 1, !.

build_i_chart(Start, End) :-
	Prev is End - 1,
	Prev > Start,
	build_i_chart(Start, Prev),
	extend_i_chart(Start, End).

word_i_edges(Word, Start, Next) :-
	initial_tree(Word, Ltree, Presup, Assert),
	t_to_ta_structure(Ltree, Tree),
	findall(Presup, all_shared(Presup), Interp),
	\+ (Interp = []),
	assert(i_chart(Start, Next, Tree, Presup, Assert, Interp)),
	fail.

word_i_edges(_, _, _).

setup_i_chart([], N, N).

setup_i_chart([Word | More], Start, End) :-
	Next is Start + 1,
	word_i_edges(Word, Start, Next),
	setup_i_chart(More, Next, End).

cky_i_parse(Words, Tree, Presup, Assert, Interp) :-
	retractall(i_chart(_,_,_,_,_,_)),
	setup_i_chart(Words, 0, End),
	build_i_chart(0, End),
	i_chart(0, End, BigTree, Presup, Assert, Interp),
	ta_to_nx_structure(BigTree, Tree).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% 6. Generation.
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% Generation is driven by SPUD-style greedy search.
%% The data structure for an abstract point in the
%% search space is a STATE:
%%
%% state(tree_gen: tg derived structure 
%%                 with free vars & coreference constraints (WFV&CC)
%%       tree_inst: tg derived structure
%%                  instantiated to intended referents (IIR),
%%       presup_gen: presupposition of structure (WFV&CC)
%%       presup_inst: presupposition of structure (IIR),
%%       assert_gen: assertion of structure (WFV&CC)
%%       assert_inst: assertion of structure (IIR),
%%       interp: matches for presup_gen in shared knowledge,
%%       left2express: communicative goals,
%%       last_op: last operation performed,
%%       antimatch: operations to avoid because searched elsewhere)

%%---------------------------------
%%
%% STATE OPERATIONS

%% state_final(State)
%%   True if the utterance is finished --
%%   - there are no unfilled substitution sites.
%%   - the presupposition identifies its referent uniquely
%%   - the assertion establishes all the needed facts.

state_final(
	state(_T, Ti, _P, Pi, _A, _Ai, [Pi], [], _Op, _Nm)
    ) :-
	\+ combine_gen(Ti, tg(_, _, comp), _, _).

%% state_cost(State, C)
%%    C is the score or cost of the state 
%%    approximating the amount of work that remains,
%%    in terms of the number of holes in the tree,
%%    the number of missing facts, and the ambiguity 
%%    of the presupposition.

state_cost(state(_,Ti,_,_,_,_,I,CG,_,_), C) :-
	length(I, C1),
	length(CG, C2),
	findall(T2, combine_gen(Ti, tg(_, _, comp), T2, _), L),
	length(L, C3),
	C is C1 + C2 + C3.

%% state_tree(State, Tree)
%%      accessor relation for the tree T.

state_tree(state(_,T,_,_,_,_,_,_,_,_), T).

%% state_history(State, History)
%%      accessor relation for the state search info.

state_history(state(_,_,_,_,_,_,_,_,_,H), H).

%% state_dont_repeat_search(State, Alts, NewState
%%      go through a list of alternatives Alts you've already
%%      considered, and update State to NewState so that
%%      you won't try those alternatives again in 

aux_state_dont_repeat_search(
	[ state(_, _, _, _, _, _, _, _, Op, _) | L ],
	[ Op | Rest ],
	Tail
    ) :-
	aux_state_dont_repeat_search(L, Rest, Tail).
	
aux_state_dont_repeat_search([], Nm, Nm).

state_dont_repeat_search(	
	state(T, Ti, P, Pi, A, Ai, I, CG, Op, Nm),
	Done,
	state(T, Ti, P, Pi, A, Ai, I, CG, Op, Nm2)
    ) :-
	aux_state_dont_repeat_search(Done, Nm2, Nm).

%%---------------------------------
%%
%% SEARCH

%% extend_by_one(State, NewState)
%%      Add a word to State to get NewState,
%%      updating trees, semantics, interpretation,
%%      and making sure that the word hasn't 
%%      already been tried.

spud_options(
	S1,
	L
    ) :-
	findall(S2, extend_by_one(S1, S2), L).

extend_by_one(
	state(T, Ti, P, Pi, A, Ai, I, CG, _Op, Nm),
	state(T2, T2i, P2, P2i, A2, A2i, I2, CG2,
	      step(Item,Addr,LPi,LAi),
	      [step(Item,GenAddr,LPi,LAi) | Nm ])
    ) :-
	combine_gen(T, LTG, T2, Addr),
	generalize_addr(Addr, GenAddr),
	t_for_tg_template(LTG, LT),
	initial_tree(Item, LT, LP, LA),
	t_to_tg_structure(LT, LTG),
	append(LP, P, P2),
	append(LA, A, A2),
	findall((T2, LP, P2, LA, A2), 
	        (T=Ti, P=Pi, A=Ai), 
		[(T2i, LPi, P2i, LAi, A2i)]),
        all_shared(LPi),
	all_private(LAi),
	\+ member(step(Item,Addr,LPi,LAi), Nm),
	zap(LAi, CG, CG2),
	findall(P2, (member(P, I), all_shared(LP)), I2).

extend_by_one(
	initial_state(N, Ni, CG),
	state(T, Ti, P, Pi, A, Ai, I, CG2, 
	      step(Item,[],Pi,Ai),
	      [step(Item,[],Pi, Ai)] )
    ) :-
	t_for_tg_template(tg(_, N, comp), LT),
	initial_tree(Item, LT, P, A),
	t_to_tg_structure(LT, T),
	findall((T, N, P, A),
	        (N = Ni),
		[(Ti, Ni, Pi, Ai)]),
	all_shared(Pi),
	all_private(Ai),
	zap(Ai, CG, CG2),
	findall(P, all_shared(P), I).

%% best_state(List, Top)
%%     true if Top is equivalent to a state with minimum cost
%%     in List, and if Top is so constituted 
%%     to avoid any search generated by previous
%%     matches to best_state.

best_state(
	[ State | States ],
	Best
    ) :-
	state_cost(State, C),
	find_best(State, C, States, [State], Best).

find_best(State, _, [], _Tried, State).

find_best(State, C, [ Next | States], Tried, Best) :-
	state_cost(Next, C2),
	(C < C2 ->
	    find_best(State, C, States, Tried, Best);
	    (C2 < C ->
		find_best(Next, C2, States, [Next], Best);
		(find_best(State, C, States, [Next | Tried], Best) ;
		 (is_best(Next, C2, States), 
		  state_dont_repeat_search(Next, Tried, Best))))).

is_best(_, _, []).

is_best(State, C, [ Next | States]) :-
	state_cost(Next, C2),
	C =< C2,
	is_best(State, C, States).

%% spud_search(start, end)
%%      true if end is a final state that
%%      can be obtained by greedy search from end.

spud_search(Start, Start) :-
	state_final(Start), !.

spud_search(Start, End) :-
	spud_options(Start, Choices),
	best_state(Choices, Next),
	spud_search(Next, End).

%% spud_ref(Object, Tree) 
%%      shortcut to use spud search to construct Tree
%%      as a referring expression for Object.

spud_ref(Object, Tree) :-
	spud_search(initial_state(n3(_,sing), n3(Object,sing), []), End),
	state_tree(End, TG),
	tg_to_nx_structure(TG, Tree).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% 7. Verification and validation.
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% cluster(Facts, Sofar, Result)
%%      A CLUSTER of facts describes an overlapping
%%      situation (you can move from any fact to any
%%      other fact in the cluster by repeatedly linking
%%      facts with shared variables).
%%  Sofar is a set of clusters,
%%  Result is the set of clusters that results by
%%     adding Facts to Sofar.

cluster_one(_Term, New, Not, [], [New | Not]).
cluster_one(Term, New, Not, [C | R], Result) :-
	overlap(Term, C), !,
	append(C, New, Next),
	cluster_one(Term, Next, Not, R, Result).
cluster_one(Term, New, Not, [C | R], Result) :-
	cluster_one(Term, New, [C | Not], R, Result).

cluster([], Clusters, Clusters).
cluster([Term | Rest], Sofar, Result) :-
	cluster_one(Term, [Term], [], Sofar, Next), 
	cluster(Rest, Next, Result).

%% justify_modifiers(Modifier Semantics,
%%                   Sentence info,
%%                   DbIn, CtIn,
%%                   DbOut, CtOut)
%% Create a database DbOut that extends DbIn with
%% distractors to explain all the modifying meaning
%% listed in Modifiier Semantics.
%% CtIn and CtOut allow you to create new numbered
%% constants with the descriptions.
%% Sentence info tells you what information about
%% the distractors is necessary.

justify_modifiers([], _, Db, Db).

justify_modifiers([M|R], Clusters, DbIn, DbOut) :-
	member(F, Clusters),
	exact_delete(F, M, X),
	findall(X, nv(X), [NX]),
        append(NX, DbIn, DbMid),
	justify_modifiers(R, Clusters, DbMid, DbOut).

%% pc(Words, TreeG, TreeI, Shared, Private)
%%    Parse words as TreeG,
%%    Create intended reference TreeI,
%%    And database <Shared, Private>
%%    which will convince SPUD search to 
%%    generate TreeI/Words back.

pc(Words, TreeG, TreeI, Shared, PAc, PAm, Private) :-
	cky_s_parse(Words, TreeG, Pc, Pm, Ac, Am),
	append(Pc, Pm, Presup),
	append(Ac, Am, Assert),
	findall((Presup, TreeG, Ac, Am, Assert), 
	        nv(Presup),
		[(SDB1, TreeI, PAc, PAm, Private)]),
	cluster(Presup, [], Clusters),
        justify_modifiers(Pm, Clusters, SDB1, Shared),
        nv(Private).

%% roundtrip(Input, State, Tree, Output)
%%      Parse sentence INPUT and create SPUD input 
%%      that would result in INPUT, including
%%      Spud initial state State.
%%      Then call spud, and report the Tree and Sentence
%%      spud gives.

roundtrip(Words, initial_state(OpG, OpI, PrivateM), Tree, Subtrees, W2) :-
	pc(Words, TreeG, TreeI, Shared, _PrivateC, PrivateM, Private),
	make_all_shared(Shared),
	make_all_private(Private),
	nx_root(TreeG, OpG),
	nx_root(TreeI, OpI),
	spud_search(initial_state(OpG, OpI, PrivateM), End),
	state_tree(End, TG),
	tg_to_nx_structure(TG, Tree),
	nx_leaves(Tree, W2),
	nx_t_elements(comp, Tree, Subtrees, []).

doublecheck(Words, Tree, Assert) :-
	cky_i_parse(Words, Tree, Presup, Assert, [Presup]),
	nv(Assert).

make_assertion_and_presupposition(_, _, [], [], []) :- !.

make_assertion_and_presupposition([97, 95 | PL], Word, Args, [], [A]) :-
	!,
	name(Pred, PL),
	A =.. [Pred, Word | Args].

make_assertion_and_presupposition([112, 95 | PL], Word, Args, [P], []) :-
	!,
	name(Pred, PL),
	P =.. [Pred, Word | Args].

make_assertion_and_presupposition(PL, Word, Args, [P], [A]) :-
	name(P_Pred, [112, 95 | PL]),
	P =.. [P_Pred, Word | Args],
	name(A_Pred, [97, 95 | PL]),
	A =.. [A_Pred, Word | Args].

make_entry(Tree) :-
	t_info(Tree, Word, Preterminal, Args),
	functor(Preterminal, Pred, _),
	name(Pred, PL),
	make_assertion_and_presupposition(PL, Word, Args, P, A),
	assert(initial_tree(Word, Tree, P, A)).

make_entry_list([]).
make_entry_list([T|R]) :-
	make_entry(T),
	make_entry_list(R).

test(T, W, S, W2) :-
	sample_sentence(T),
	nx_t_elements(comp, T, Subtrees, []),
	make_entry_list(Subtrees),
	nx_leaves(T, W),
	clear,
	roundtrip(W, S, _, _, W2).
	
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% 8. Lexicon.
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% For language learning experiments.

:- dynamic(initial_tree/4).

clear_grammar :-
	retractall(initial_tree(_,_,_,_)).

%% Presupposed definite singular NPs.

initial_tree(
	NounSing, 
	t(n(n3(I,sing), 
  	    n(n2size(I,def), 
	      n(n2color(I,def), 
	        n(n2quality(I,def), 
                  n(n2origin(I,def), 
                    n(n1(I), w(NounSing), [], Comps), 
		    [], []), 
                  [], []), 
                [], []), 
              [], []), 
            [det(I,sing,def)], []),
	   comp),
	Content,
	[]
      ) :-
	member((NounSing, Comps, Content), 
	       [(dog, [], [type(I,dog)]), 
	        (cat, [], [type(I,cat)])]).

%% Asserted indefinite singular NPs.

initial_tree(
	NounSing, 
	t(n(n3(I,sing), 
  	    n(n2size(I,indef), 
	      n(n2color(I,indef), 
	        n(n2quality(I,indef), 
                  n(n2origin(I,indef), 
                    n(n1(I), w(NounSing), [], Comps), 
		    [], []), 
                  [], []), 
                [], []), 
              [], []), 
            [det(I,sing,indef)], []),
	   comp),
	[],
	Content
      ) :-
	member((NounSing, Comps, Content), 
	       [(dog, [], [type(I,dog)]), 
	        (cat, [], [type(I,cat)])]).

%% Presupposed color adjectives in definite NPs.

initial_tree(
	ColorAdj,
	t(n(a3(S,I,def),
	    n(a2(S,I,def),
	      n(a1(S,I,def),
	        w(ColorAdj), [], []),
	      [], []),
	    [], []),
	  premod(n2color(I,def))),
        [color(S,I,ColorAdj)],
	[]
       ) :-
	member(ColorAdj,
	       [white, black, red, green, blue, 
	        yellow, orange, purple, brown, gray, tan]).

%% Asserted color adjectives in indefinite NPs.

initial_tree(
	ColorAdj,
	t(n(a3(S,I,indef),
	    n(a2(S,I,indef),
	      n(a1(S,I,indef),
	        w(ColorAdj), [], []),
	      [], []),
	    [], []),
	  premod(n2color(I,indef))),
	[],
        [color(S,I,ColorAdj)]
       ) :-
	member(ColorAdj,
	       [white, black, red, green, blue, 
	        yellow, orange, purple, brown, gray, tan]).

%% Presupposed size adjectives in definite NPs.

initial_tree(
	SizeAdj,
	t(n(a3(S,I,def),
	    n(a2(S,I,def),
	      n(a1(S,I,def),
	        w(SizeAdj), [], []),
	      [], []),
	    [], []),
	   premod(n2size(I,def))),
	[size(S,I,SizeAdj)],
	[]
       ) :-
	member(SizeAdj,
	       [huge, big, little,
	        enormous, large, small, tiny]).

%% Asserted size adjectives in indefinite NPs.

initial_tree(
	SizeAdj,
	t(n(a3(S,I,indef),
	    n(a2(S,I,indef),
	      n(a1(S,I,indef),
	        w(SizeAdj), [], []),
	      [], []),
	    [], []),
	   premod(n2size(I,indef))),
	[],
	[size(S,I,SizeAdj)]
       ) :-
	member(SizeAdj,
	       [huge, big, little,
	        enormous, large, small, tiny]).

%% Presupposed general descriptive adjectives in definite NPs.

initial_tree(
	QualAdj,
	t(n(a3(S,I,def),
	    n(a2(S,I,def),
	      n(a1(S,I,def),
	        w(QualAdj), [], []),
	      [], []),
	    [], []),
	   premod(n2quality(I,def))),
         [prop(S,I,QualAdj)],
	 []
       ) :-
	member(QualAdj,
	       [fuzzy, furry, hairy, friendly, mean, shaggy]).

%% Asserted general descriptive adjectives in indefinite NPs.

initial_tree(
	QualAdj,
	t(n(a3(S,I,indef),
	    n(a2(S,I,indef),
	      n(a1(S,I,indef),
	        w(QualAdj), [], []),
	      [], []),
	    [], []),
	   premod(n2quality(I,indef))),
	 [],
         [prop(S,I,QualAdj)]
       ) :-
	member(QualAdj,
	       [fuzzy, furry, hairy, friendly, mean, shaggy]).

%% Adverbs that modify presupposed adjectives.

initial_tree(
	AdjAdv,
	t(n(adv,
	    w(AdjAdv),
	    [], []),
	  premod(a3(S,_,def))),
	[degree(S,AdjAdv)],
	[]
      ) :-
	member(AdjAdv,
	       [very, rather, quite, somewhat, slightly]).

%% Adverbs that modify asserted adjectives.

initial_tree(
	AdjAdv,
	t(n(adv,
	    w(AdjAdv),
	    [], []),
	  premod(a3(S,_,indef))),
	[],
	[degree(S,AdjAdv)]
      ) :-
	member(AdjAdv,
	       [very, rather, quite, somewhat, slightly]).

%% Singular definite determiners.

initial_tree(
	DetSing,
	t(n(det(I,sing,def),
	    w(DetSing),
	    [], []),
	  comp),
        [ status(I,DetSing) ],
	[]
      ) :-
	member(DetSing, [the, this, that]).

%% Singular indefinite determiners.

initial_tree(
	DetSing,
	t(n(det(I,sing,indef),
	    w(DetSing),
	    [], []),
	  comp),
        [ status(I,DetSing) ],
	[]
      ) :-
	member(DetSing, [a, some]).

%% Main verbs, asserted.

initial_tree(
        VerbSing,
        t(n(s(E),
            n(v2epistemic(E),
              n(v2discourse(E),
                n(v2time(E),
                  n(v2manner(E),
                    n(v1(E),
                      w(VerbSing),
                      [], Comps),
                    [], []),
                  [], []),
                [], []),
               [], []),
             [n3(A,sing)], []),
           comp),
         Presup,
	 Assert
       )  :-
        member((VerbSing, Comps, Presup, Assert),
               [(sleeps, [], [], [sleeping(E), sleeper(E,A)]), 
                (likes, [n3(B,_)], [], [liking(E), liker(E,A), liked(E,B)])]).

%% Epistemic premodifiers of main verbs, asserted.

initial_tree(
	Emod,
	t(n(adv3(E),
	    n(adv(E),
	      w(Emod),
	      [], []),
	    [],[]),
	  premod(v2epistemic(E))),
	[],
	[status(E,Emod)]
      ) :-
	member(Emod, 
	       [probably, certainly, definitely, possibly]).

%% Discourse premodifiers of main verbs, asserted.

initial_tree(
	Dmod,
	t(n(adv3(E),
	    n(adv(E),
	      w(Dmod),
	      [], []),
	    [],[]),
	  premod(v2discourse(E))),
	Presup,
	Assert
      ) :-
	member((Dmod, Presup, Assert), 
	       [(even, [unlikely_a(E)] , []),
	        (also, [parallel(E,A)],  []),
		(only, [alts(E,A)], [unreal(A)]),
		(just, [alts_on_scale(E,A)], [unreal(A)])]).

%% Temporal premodifiers of main verbs, asserted.

initial_tree(
	Tmod,
	t(n(adv3(E),
	    n(adv(E),
	      w(Tmod),
	      [], []),
	    [],[]),
	  premod(v2time(E))),
	[],
	[time(E, Tmod)]
      ) :-
	member(Tmod, 
	       [already, eventually]).

%% Manner premodifiers of main verbs, asserted.

initial_tree(
	Tmod,
	t(n(adv3(E),
	    n(adv(E),
	      w(Tmod),
	      [], []),
	    [],[]),
	  premod(v2manner(E))),
       [],
       [manner(E, Tmod)]
      ) :-
	member(Tmod, 
	       [deeply, madly]).

