/* File:      flrcomposer.P  -- Flora Composer
**
** Author(s): Guizhen Yang
**
** Contact:   flora-users@lists.sourceforge.net
**
** Copyright (C) The Research Foundation of SUNY, 1999-2001
** 
** FLORA-2 is free software; you can redistribute it and/or modify it under the
** terms of the GNU Library General Public License as published by the Free
** Software Foundation; either version 2 of the License, or (at your option)
** any later version.
** 
** FLORA-2 is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
** FOR A PARTICULAR PURPOSE.  See the GNU Library General Public License for
** more details.
** 
** You should have received a copy of the GNU Library General Public License
** along with FLORA-2; if not, write to the Free Software Foundation,
** Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
**
**
*/


:- compiler_options([xpp_on]).

#define PREOP		preop	/* PREOP(Op,Associativity,Precedence,Index) */
#define INFOP		infop	/* INFOP(Op,Left,Right,Precedence,Index) */
#define SUFOP		sufop	/* SUFOP(Op,Associativity,Precedence,Index) */
#define FUNCT		funct	/* FUNCT(Term) */
#define OPRND		oprnd	/* OPRND(Term) */
#define BRACE		brace	/* BRACE(Symbol,Index) */

#define TKCNT		tkcnt	/* index counter for tokens */
#define RLCNT		rlcnt	/* sequence number counter for rules */

#include "flora_characters.flh"
#include "flora_errors.flh"
#include "flora_terms.flh"


/***************************************************************************
  flora_nth_token(+IndexNumber,-Token)
***************************************************************************/
flora_nth_token(N,T) :-
	indexed_token(N,_,T).


/***************************************************************************
  flora_token_rulenum(+IndexNumber,-RuleNum)
***************************************************************************/
flora_token_rulenum(N,RuleNum) :-
	indexed_token(N,RuleNum,_).


/***************************************************************************
  index_tokens(+TokensList,+IndexNumber,+RuleNumber)
***************************************************************************/
index_tokens([],N,RuleNum) :-
	!,
	%% Store the sequence number for the next rule.
	X is RuleNum+1,
	flora_set_counter(RLCNT,X),
	%% Store the index sequence number after indexing all tokens.
	flora_set_counter(TKCNT,N).

index_tokens([T|Ts],N,RuleNum) :-
	assert(indexed_token(N,RuleNum,T)),
	M is N+1,
	index_tokens(Ts,M,RuleNum),
	!.


/***************************************************************************
  token_by_index(?Index,?Token)
***************************************************************************/
token_by_index(Index,Token) :-
	var(Index),
	!,
	indexed_token(Index,_,Token).

token_by_index(Index,Token) :-
	number(Index),
	!,
	indexed_token(Index,_,Token).

token_by_index(Index,Token) :-
	%% Index can be an arithmetic expression, so evaluate it
	%% Should use M is N, but some onscure bug in XSB prevents
	eval(Index,N),
	indexed_token(N,_,Token).


/***************************************************************************
  is_next_token(+Index,+Token)

  It checks if the token index by "Index" matches "Token". If it is a
  whitespace or comment, it will be skipped until a nonwhitespace.
***************************************************************************/
is_next_token(Index,Token) :-
	token_by_index(Index,T),
	( T=Token ->
	    !,
	    true

	; (T=WHITESPACE(_); T=COMMENT(_)) ->
	    N is Index+1,
	    is_next_token(N,Token)
	;
	  !,
	  fail
        ).


/**************************************************************************
  if_flora_gpp_markup(+Token)
**************************************************************************/
is_flora_gpp_markup(QUOTED_ATOM(FLORA_GPP_MARKUP,_)).


/**************************************************************************
  Symbol tokens are allowed to be operands. They are equal to quoted atoms.

  Special tokens are treated as if they were just operands.
**************************************************************************/
is_sole_operand(VARIABLE(_,_)) :- !.
is_sole_operand(NUMBER(_,_)) :- !.
is_sole_operand(ASCII_STRING(_,_)) :- !.
is_sole_operand(SPECIAL_TOKEN(_,_)) :- !.

/*********************************************************************
	support for numbered anon oids
**********************************************************************/
is_sole_operand(SPECIAL_TOKEN(_,_,_)) :- !.

is_sole_operand(IDENTIFIER(I,_)) :- \+ flora_opdef(_,_,I), !.
is_sole_operand(QUOTED_ATOM(QA,_)) :- \+ flora_opdef(_,_,QA), !.
is_sole_operand(SYMBOL_TOKEN(ST,_)) :- \+ flora_opdef(_,_,ST), !.


/***************************************************************************
  These symbol tokens are not allowed to be directly used as atoms.
***************************************************************************/
is_sole_operator(SYMBOL_TOKEN(FL_COMMA,_),FL_COMMA) :- !.
is_sole_operator(SYMBOL_TOKEN(FL_SEMICOLON,_),FL_SEMICOLON) :- !.
is_sole_operator(SYMBOL_TOKEN(FL_IMPLYOP,_),FL_IMPLYOP) :- !.
is_sole_operator(SYMBOL_TOKEN(FL_QUERYOP,_),FL_QUERYOP) :- !.
is_sole_operator(SYMBOL_TOKEN(FL_TRAN,_),FL_TRAN) :- !.


/**************************************************************************/
is_atom_operator(IDENTIFIER(I,_)) :- flora_opdef(_,_,I), !.
is_atom_operator(QUOTED_ATOM(QA,_)) :- flora_opdef(_,_,QA), !.


/**************************************************************************/
is_symobject_operator(SYMBOL_TOKEN(ST,_)) :- flora_opdef(_,_,ST), !.


/**************************************************************************/
is_infix(O,L,R,P) :-
	flora_opdef(P,S,O),
	atom_codes(S,[LChar,CH_f,RChar]),
	atom_codes(L,[LChar]),
	atom_codes(R,[RChar]).


/**************************************************************************/
is_prefix(O,A,P) :-
	flora_opdef(P,S,O),
	atom_codes(S,[CH_f,AChar]),
	atom_codes(A,[AChar]).


/**************************************************************************/
is_suffix(O,A,P) :-
	flora_opdef(P,S,O),
	atom_codes(S,[AChar,CH_f]),
	atom_codes(A,[AChar]).


/**************************************************************************/
is_left_brace(SYMBOL_TOKEN('(',_),FL_PARENTHESIS) :- !.
is_left_brace(SYMBOL_TOKEN('[',_),FL_BRACKET) :- !.
is_left_brace(SYMBOL_TOKEN('{',_),FL_BRACE) :- !.


/**************************************************************************/
is_right_brace(SYMBOL_TOKEN(')',_),FL_PARENTHESIS) :- !.
is_right_brace(SYMBOL_TOKEN(']',_),FL_BRACKET) :- !.
is_right_brace(SYMBOL_TOKEN('}',_),FL_BRACE) :- !.


/**************************************************************************/
infix_struct(S,L,R,I,INFIX(S,L,R,I)).

prefix_struct(S,O,I,PREFIX(S,O,I)).

suffix_struct(S,O,I,SUFFIX(S,O,I)).

argument_struct(S,O,I1,I2,ARGUMENT(S,O,I1,I2)).

argument_struct(S,I1,I2,ARGUMENT(S,I1,I2)).

function_struct(F,A,FUNCTION(F,A)).

object_struct(O,I,OBJECT(T,I)) :-
	%% Strip textual information.
	( O =.. [F,N,_], T =.. [F,N]
	; O =.. [F,N,Num,_], T =.. [F,N,Num]
	).


/**************************************************************************/
get_rightmost_index(OBJECT(_O,I),I) :- !.
get_rightmost_index(INFIX(_S,_L,R,_I),I) :- !, get_rightmost_index(R,I).
get_rightmost_index(PREFIX(_S,O,_I),I) :- !, get_rightmost_index(O,I).
get_rightmost_index(SUFFIX(_S,_O,I),I) :- !.
get_rightmost_index(ARGUMENT(_S,_O,_I1,I2),I2) :- !.
get_rightmost_index(ARGUMENT(_S,_I1,I2),I2) :- !.
get_rightmost_index(FUNCTION(_F,A),I) :- !, get_rightmost_index(A,I).


/**************************************************************************/
report_error(Indx,Msg) :- assert(composing_error(Indx,Msg)).
report_error(I1,I2,Msg) :- assert(composing_error(I1,I2,Msg)).


composing_warning(I1,I2,Msg,warning(I1,I2,Msg)).


/**************************************************************************/
retract_error :-
	retractall(composing_error(_,_)),
	retractall(composing_error(_,_,_)).


/**************************************************************************/
choose_error(error(I,UNEXP_ENDCLAUSE)) :-
	composing_error(I,UNEXP_ENDCLAUSE),
	!.

choose_error(E) :-
	findall(composing_error(I,Msg1),composing_error(I,Msg1),L1),
	findall(composing_error(I1,I2,Msg2),composing_error(I1,I2,Msg2),L2),
	max_error1(L1,E1),
	max_error2(L2,E2),
	( E1 == NULL, E2 == NULL ->
	    E=error(UNKNOWN_ERROR)

	; E1 == NULL ->
	    E2=composing_error(N21,N22,M2),
	    E=error(N21,N22,M2)

	; E2 == NULL ->
	    E1=composing_error(N1,M1),
	    E=error(N1,M1)
        ;
	  E1=composing_error(N1,M1),
	  E2=composing_error(N21,N22,M2),
	  (N22 >= N1 -> E=error(N21,N22,M2) ; E=error(N1,M1))
        ).

max_error1([],NULL).

max_error1([H|T],M) :- max_error1(H,T,M).

max_error1(X,[],X).

max_error1(composing_error(N1,M1),[composing_error(N2,M2)|T],X) :-
	( N1 >= N2 ->
	    max_error1(composing_error(N1,M1),T,X)
	;
	  max_error1(composing_error(N2,M2),T,X)
        ).

max_error2([],NULL).

max_error2([H|T],M) :- max_error2(H,T,M).

max_error2(X,[],X).

max_error2(composing_error(N11,N12,M1),[composing_error(N21,N22,M2)|T],X) :-
	( N12 >= N22 ->
	    max_error2(composing_error(N11,N12,M1),T,X)
	;
	  max_error2(composing_error(N21,N22,M2),T,X)
        ).


/***************************************************************************
  flora_reset_composer/0
***************************************************************************/
flora_reset_composer :-
	retractall(indexed_token(_,_,_)),
	flora_set_counter(RLCNT,LOW_INDEX),
	flora_set_counter(TKCNT,LOW_INDEX).


/***************************************************************************
  flora_compose(+Tokens,-Term,-Status)
  is the main function to compose high level intermediate tokens from a
  list of primitive tokens returned by the Flora Lexer.

  types of errors:
  (1) error(Index1,Index2,Message)
  (2) error(Index,Message)
  (3) error(Message) for unknown errors (or bug)

  In case of multiple known errors, one is arbitrarily chosen and returned.
  But type (1) is prefered over type (2). 
***************************************************************************/
flora_compose([],NULL,[]) :- !.

flora_compose(_,_,_) :-
	retract_error,
	fail.

flora_compose(Tokens,Term,Status) :-
	%% Get the rule sequence number.
	flora_get_counter(RLCNT,RuleNum),
	%% Get the index sequence number.
	flora_get_counter(TKCNT,N),
	index_tokens(Tokens,N,RuleNum),
	flora_compose(NULL,[],[],N,Term,Status),
	!.

flora_compose(_,_,[ErrorMsg]) :-
	choose_error(ErrorMsg),
	!.


/***************************************************************************
  flora_compose/6:
    flora_compose(+PrevToken,+TmStack,+OpStack,+N,-Term,-Status)

  flora_compose/7:
      flora_compose(+PrevToken,+TmStack,+OpStack,+N,+CurToken,-Term,-Status)

  parameters:
  (1)PrevToken: previous token read
  (2)TmStack: terms stack, growing leftwards
  (3)OpStack: operators stack, growing leftwards
  (4)N: index of the current token
  (5)CurToken: current token seen
  (6)Term: composed term
  (7)Status: status of composing (error(TkIndx,Msg), warning(TkIndx,Msg))
***************************************************************************/
flora_compose(PrevToken,TmStack,OpStack,N,Term,Status) :-
	%% N can be an arithmetic expression, so evaluate it
	%% Should use M is N, but some obscure XSB bug prevents
	eval(N,M),
	( token_by_index(M,CurToken) ->
	    flora_compose(PrevToken,TmStack,OpStack,M,CurToken,Term,Status)

	; PrevToken == NULL, TmStack == [], OpStack == [] ->
	    Term=NULL,
	    Status=[]

	; K is M-1,
	  report_error(K,UNEXP_EOR),
	  fail
        ).

flora_compose(PrevToken,TmStack,OpStack,N,WHITESPACE(_),Term,Status) :-
	!,
	see_whitespace(PrevToken,TmStack,OpStack,N,Term,Status).

flora_compose(PrevToken,TmStack,OpStack,N,CurToken,Term,Status) :-
	is_left_brace(CurToken,B),
	!,
	see_left(PrevToken,TmStack,OpStack,N,B,Term,Status).

flora_compose(PrevToken,TmStack,OpStack,N,CurToken,Term,Status) :-
	is_right_brace(CurToken,B),
	!,
	see_right(PrevToken,TmStack,OpStack,N,B,Term,Status).

flora_compose(PrevToken,TmStack,OpStack,N,CurToken,Term,Status) :-
	is_sole_operator(CurToken,Op),
	!,
	compose_sole_operator(PrevToken,TmStack,OpStack,N,Op,Term,Status).

flora_compose(PrevToken,TmStack,OpStack,N,CurToken,Term,Status) :-
	is_sole_operand(CurToken),
	!,
	see_operand(PrevToken,TmStack,OpStack,N,CurToken,Term,Status).

flora_compose(PrevToken,TmStack,OpStack,N,CurToken,Term,Status) :-
	is_symobject_operator(CurToken),
	!,
	compose_symobject_operator(PrevToken,TmStack,OpStack,N,CurToken,Term,Status).

flora_compose(PrevToken,TmStack,OpStack,N,CurToken,Term,Status) :-
	is_atom_operator(CurToken),
	!,
	compose_atom_operator(PrevToken,TmStack,OpStack,N,CurToken,Term,Status).

flora_compose(PrevToken,TmStack,OpStack,N,COMMENT(_),Term,Status) :-
	!,
	see_comment(PrevToken,TmStack,OpStack,N,Term,Status).

flora_compose(PrevToken,TmStack,OpStack,N,RULE_DELIMETER(_),Term,Status) :-
	!,
	see_end(PrevToken,TmStack,OpStack,N,Term,Status).


/***************************************************************************
  compose_sole_operator(+PrevToken,+TmStack,+OpStack,+N,+Op,-Term,-Status)
  is called when a symbol token is read.
***************************************************************************/
compose_sole_operator(PrevToken,TmStack,OpStack,N,Op,Term,Status) :-
	is_infix(Op,L,R,P),
	see_infix(PrevToken,TmStack,OpStack,N,Op,L,R,P,Term,Status).

compose_sole_operator(PrevToken,TmStack,OpStack,N,Op,Term,Status) :-
	is_prefix(Op,A,P),
	see_prefix(PrevToken,TmStack,OpStack,N,Op,A,P,Term,Status).

compose_sole_operator(PrevToken,TmStack,OpStack,N,Op,Term,Status) :-
	is_suffix(Op,A,P),
	see_suffix(PrevToken,TmStack,OpStack,N,Op,A,P,Term,Status).


/***************************************************************************
  compose_atom_operator(+PrevToken,+TmStack,+OpStack,+N,+Token,-Term,-Status)
  is called when an atom/operator is read. Ambiguity might arise.

  Potentially ambiguous use of atom operator can be avoided by a pair of
  parentheses.
***************************************************************************/
compose_atom_operator(BRACE(B,I),TmStack,OpStack,N,CurToken,Term,Status) :-
	%% Check if the next token is a matching right parenthesis.
	is_right_brace(X,B),
	M is N+1,
	is_next_token(M,X),
	!,
	see_operand(BRACE(B,I),TmStack,OpStack,N,CurToken,Term,Status).

compose_atom_operator(PrevToken,TmStack,OpStack,N,CurToken,Term,Status) :-
	( CurToken=IDENTIFIER(I,_) ->
	    compose_sole_operator(PrevToken,TmStack,OpStack,N,I,Term,Status)
	;
	  CurToken=QUOTED_ATOM(QA,_),
	  compose_sole_operator(PrevToken,TmStack,OpStack,N,QA,Term,Status)
        ).

compose_atom_operator(OPRND(_),_TmStack,_OpStack,_N,_CurToken,_Term,_Status) :-
	!,
	fail.

compose_atom_operator(PrevToken,TmStack,OpStack,N,CurToken,Term,Status) :-
	see_operand(PrevToken,TmStack,OpStack,N,CurToken,Term,Status).


/***************************************************************************
  compose_symobject_operator(+PrevToken,+TmStack,+OpStack,+N,+Token,-Term,-Status)
  is called when a/an symbol/operator is read. Ambiguity might arise.
***************************************************************************/
compose_symobject_operator(BRACE(B,I),TmStack,OpStack,N,CurToken,Term,Status) :-
	is_right_brace(X,B),
	M is N+1,
	is_next_token(M,X),
	!,
	see_operand(BRACE(B,I),TmStack,OpStack,N,CurToken,Term,Status).

compose_symobject_operator(PrevToken,TmStack,OpStack,N,SYMBOL_TOKEN(S,_),Term,Status) :-
	compose_sole_operator(PrevToken,TmStack,OpStack,N,S,Term,Status).

compose_symobject_operator(OPRND(_),_TmStack,_OpStack,_N,_CurToken,_Term,_Status) :-
	!,
	fail.

compose_symobject_operator(PrevToken,TmStack,OpStack,N,CurToken,Term,Status) :-
	see_operand(PrevToken,TmStack,OpStack,N,CurToken,Term,Status).


/***************************************************************************
  see_whitespace(+PrevToken,+TmStack,+OpStack,+N,-Term,-Status)
  is called when a whitespace is read.
***************************************************************************/
see_whitespace(P,TS,OS,N,Term,Status) :-
	flora_compose(P,TS,OS,N+1,Term,Status).


/***************************************************************************
  see_comment(+PrevToken,+TmStack,+OpStack,+N,-Term,-Status)
  is called when a whitespace is read.
***************************************************************************/
see_comment(P,TS,OS,N,Term,Status) :-
	flora_compose(P,TS,OS,N+1,Term,Status).


/***************************************************************************
  see_operand(+PrevToken,+TmStack,+OpStack,+N,+Operand,-Term,-Status)
  is called when a token interpreted as an operand is read.
***************************************************************************/
see_operand(NULL,[],[],N,O,Term,Status) :-
	!,
	object_struct(O,N,T),
	flora_compose(OPRND(T),[],[],N+1,Term,Status).

see_operand(INFOP(S,L,R,P,I),TS,OS,N,O,Term,Status) :-
	!,
	( is_flora_gpp_markup(O) ->
	    report_error(I,UNEXP_ENDCLAUSE),
	    fail
	;
	  object_struct(O,N,T),
	  flora_compose(OPRND(T),TS,[INFOP(S,L,R,P,I)|OS],N+1,Term,Status)
	).

see_operand(BRACE(B,I),TS,OS,N,O,Term,Status) :-
	!,
	( is_flora_gpp_markup(O) ->
	    report_error(I,UNEXP_ENDCLAUSE),
	    fail
	;
	  object_struct(O,N,T),
	  flora_compose(OPRND(T),[BRACE(B,I)|TS],[BRACE(B,I)|OS],N+1,Term,Status)
	).

see_operand(PREOP(S,A,P,I),TS,OS,N,O,Term,Status) :-
	!,
	( is_flora_gpp_markup(O) ->
	    report_error(I,UNEXP_ENDCLAUSE),
	    fail
	;
	  object_struct(O,N,T),
	  flora_compose(OPRND(T),TS,[PREOP(S,A,P,I)|OS],N+1,Term,Status)
	).

see_operand(SUFOP(_S,_A,_P,I),_TS,_OS,N,O,_Term,_Status) :-
	!,
	( is_flora_gpp_markup(O) ->
	    report_error(I,UNEXP_ENDCLAUSE)
	;
	  report_error(N,UNEXP_OPERAND)
	),
	fail.

see_operand(OPRND(X),_TS,_OS,N,O,_Term,_Status) :-
	!,
	( is_flora_gpp_markup(O) ->
	    get_rightmost_index(X,I),
	    report_error(I,UNEXP_ENDCLAUSE)
	;
	  report_error(N,UNEXP_OPERAND)
	),
	fail.


/***************************************************************************
  see_infix(+PrevToken,+TmStack,+OpStack,+N,+Operator,+L,+R,+P,-Term,-Status)
  is called when a token interpreted as an infix operator is read. Passed
  as arguments are its left and right associativity, and precedence.
***************************************************************************/
see_infix(OPRND(O),TS,OS,N,S,L,R,P,Term,Status) :-
	!,
	solve_infix([OPRND(O)|TS],OS,N,S,L,R,P,Term,Status).

see_infix(SUFOP(_S1,_A,P1,N1),TS,OS,N2,S2,L,R,P2,Term,Status) :-
	!,
	( P1 > P2 ->
	    report_error(N1,N2,WRONG_PRECEDENCE),
	    fail

	; P1 == P2, L == x ->
	    report_error(N1,N2,WRONG_ASSOCIATE),
	    fail
	;
	  solve_infix(TS,OS,N2,S2,L,R,P2,Term,Status)
        ).

see_infix(BRACE(_B,_I),_TS,_OS,N,_O,_L,_R,_P,_Term,_Status) :-
	!,
	report_error(N,UNEXP_OPERATOR),
	fail.

see_infix(NULL,[],[],N,_O,_L,_R,_P,_Term,_Status) :-
	!,
	report_error(N,UNEXP_OPERATOR),
	fail.

see_infix(INFOP(_O1,_L1,_R1,_P1,_N1),_TS,_OS,N2,_O2,_L2,_R2,_P2,_Term,_Status) :-
	!,
	report_error(N2,UNEXP_OPERATOR),
	fail.

see_infix(PREOP(_O1,_A,_P1,_N1),_TS,_OS,N2,_O2,_L,_R,_P2,_Term,_Status) :-
	!,
	report_error(N2,UNEXP_OPERATOR),
	fail.


/***************************************************************************
  see_prefix(+PrevToken,+TmStack,+OpStack,+N,+Operator,+A,+P,-Term,-Status)
  is called when a token interpreted as an prefix operator is read. Passed
  as arguments are its associativity and precedence.
***************************************************************************/
see_prefix(BRACE(B,I),TS,OS,N,S,A,P,Term,Status) :-
	!,
	flora_compose(PREOP(S,A,P,N),[BRACE(B,I)|TS],[BRACE(B,I)|OS],N+1,Term,Status).

see_prefix(PREOP(S1,A1,P1,N1),TS,OS,N2,S2,A2,P2,Term,Status) :-
	!,
	( P1 < P2 ->
	    report_error(N1,N2,WRONG_PRECEDENCE),
	    fail

	; P1 == P2, A1 == x ->
	    report_error(N1,N2,WRONG_ASSOCIATE),
	    fail
	;
	  flora_compose(PREOP(S2,A2,P2,N2),TS,[PREOP(S1,A1,P1,N1)|OS],
                        N2+1,Term,Status)
        ).

see_prefix(INFOP(S1,L,R,P1,N1),TS,OS,N2,S2,A,P2,Term,Status) :-
	!,
	( P1 < P2 ->
	    report_error(N1,N2,WRONG_PRECEDENCE),
	    fail

	; P1 == P2, R == x ->
	    report_error(N1,N2,WRONG_ASSOCIATE),
	    fail
	;
	  flora_compose(PREOP(S2,A,P2,N2),TS,[INFOP(S1,L,R,P1,N1)|OS],
                        N2+1,Term,Status)
        ).

see_prefix(NULL,[],[],N,S,A,P,Term,Status) :-
	!,
	flora_compose(PREOP(S,A,P,N),[],[],N+1,Term,Status).

see_prefix(OPRND(_O),_TS,_OS,N,_S,_A,_P,_Term,_Status) :-
	!,
	report_error(N,UNEXP_OPERATOR),
	fail.

see_prefix(SUFOP(_S1,_A1,_P1,_N1),_TS,_OS,N2,_S2,_A2,_P2,_Term,_Status) :-
	!,
	report_error(N2,UNEXP_OPERATOR),
	fail.


/***************************************************************************
  see_suffix(+PrevToken,+TmStack,+OpStack,+N,+Operator,+A,+P,-Term,-Status)
  is called when a token interpreted as an suffix operator is read. Passed
  as arguments are its associativity and precedence.
***************************************************************************/
see_suffix(OPRND(O),TS,OS,N,S,A,P,Term,Status) :-
	!,
	solve_suffix([OPRND(O)|TS],OS,N,S,A,P,Term,Status).

see_suffix(SUFOP(_S1,_A1,P1,N1),TS,OS,N2,S2,A2,P2,Term,Status) :-
	!,
	( P1 > P2 ->
	    report_error(N1,N2,WRONG_PRECEDENCE),
	    fail

	; P1 == P2, A2 == x ->
	    report_error(N1,N2,WRONG_ASSOCIATE),
	    fail
	;
	  solve_suffix(TS,OS,N2,S2,A2,P2,Term,Status)
        ).

see_suffix(BRACE(_B,_I),_TS,_OS,N,_S,_A,_P,_Term,_Status) :-
	!,
	report_error(N,UNEXP_OPERATOR),
	fail.

see_suffix(PREOP(_S1,_A1,_P1,_N1),_TS,_OS,N2,_S2,_A2,_P2,_Term,_Status) :-
	!,
	report_error(N2,UNEXP_OPERATOR),
	fail.

see_suffix(INFOP(_S1,_L,_R,_P1,_N1),_TS,_OS,N2,_S2,_A,_P2,_Term,_Status) :-
	!,
	report_error(N2,UNEXP_OPERATOR),
	fail.

see_suffix(NULL,[],[],N,_S,_A,_P,_Term,_Status) :-
	!,
	report_error(N,UNEXP_OPERATOR),
	fail.


/***************************************************************************
  see_left(+PrevToken,+TmStack,+OpStack,+N,+Brace,-Term,-Status)
  is called when a token interpreted as a left brace is read.
***************************************************************************/
see_left(OPRND(O),TS,OS,N,B,Term,Status) :-
	!,
	flora_compose(BRACE(B,N),[FUNCT(O)|TS],OS,N+1,Term,Status).

see_left(INFOP(S,L,R,P,I),TS,OS,N,B,Term,Status) :-
	!,
	flora_compose(BRACE(B,N),TS,[INFOP(S,L,R,P,I)|OS],N+1,Term,Status).

see_left(BRACE(B1,N1),TS,OS,N2,B2,Term,Status) :-
	!,
	flora_compose(BRACE(B2,N2),[BRACE(B1,N1)|TS],[BRACE(B1,N1)|OS],
	              N2+1,Term,Status).

see_left(PREOP(S,A,P,I),TS,OS,N,B,Term,Status) :-
	!,
	flora_compose(BRACE(B,N),TS,[PREOP(S,A,P,I)|OS],N+1,Term,Status).

see_left(NULL,[],[],N,B,Term,Status) :-
	!,
	flora_compose(BRACE(B,N),[],[],N+1,Term,Status).

see_left(SUFOP(_S,_A,_P,_I),_TS,_OS,N,_B,_Term,_Status) :-
	!,
	report_error(N,UNEXP_LEFT),
	fail.


/***************************************************************************
  see_right(+PrevToken,+TmStack,+OpStack,+N,+Brace,-Term,-Status)
  is called when a token interpreted as a right brace is read. It normally
  solves the stacks.
***************************************************************************/
see_right(OPRND(O),TS,OS,N,B,Term,Status) :-
	!,
	solve_right([OPRND(O)|TS],OS,N,B,Term,Status).

see_right(BRACE(B1,N1),TS,OS,N2,B2,Term,Status) :-
	!,
	solve_right([BRACE(B1,N1)|TS],[BRACE(B1,N1)|OS],N2,B2,Term,Status).

see_right(SUFOP(_O,_A,_P,_I),TS,OS,N,B,Term,Status) :-
	!,
	solve_right(TS,OS,N,B,Term,Status).

see_right(INFOP(_S,_L,_R,_P,_I),_TS,_OS,N,_B,_Term,_Status) :-
	!,
	report_error(N,UNEXP_RIGHT),
	fail.

see_right(PREOP(_S,_A,_P,_I),_TS,_OS,N,_B,_Term,_Status) :-
	!,
	report_error(N,UNEXP_RIGHT),
	fail.

see_right(NULL,[],[],N,_B,_Term,_Status) :-
	!,
	report_error(N,UNEXP_RIGHT),
	fail.


/***************************************************************************
  see_end(+PrevToken,+TmStack,+OpStack,+N,-Term,-Status)
  is called when a rule delimeter is read.
***************************************************************************/
see_end(OPRND(O),TS,OS,N,Term,Status) :-
	!,
	solve_end([OPRND(O)|TS],OS,N,Term,Status).

see_end(SUFOP(_S,_A,_P,_I),TS,OS,N,Term,Status) :-
	!,
	solve_end(TS,OS,N,Term,Status).

see_end(BRACE(_B,_I),_TS,_OS,N,_Term,_Status) :-
	!,
	report_error(N,UNEXP_END),
	fail.

see_end(INFOP(_S,_L,_R,_P,_I),_TS,_OS,N,_Term,_Status) :-
	!,
	report_error(N,UNEXP_END),
	fail.

see_end(PREOP(_S,_A,_P,_I),_TS,_OS,N,_Term,_Status) :-
	!,
	report_error(N,UNEXP_END),
	fail.

see_end(NULL,[],[],N,_Term,_Status) :-
	!,
	report_error(N,UNEXP_END),
	fail.


/***************************************************************************
  solve_infix(+TmStack,+OpStack,+N,+Operator,+L,+R,+P,-Term,-Status)
  is called when an infix operator that is just read results in solving
  the stacks.
***************************************************************************/
solve_infix(TS,[],N,O,L,R,P,Term,Status) :-
	!,
	flora_compose(INFOP(O,L,R,P,N),TS,[],N+1,Term,Status).

solve_infix(TS,[BRACE(B,I)|OS],N,O,L,R,P,Term,Status) :-
	!,
	flora_compose(INFOP(O,L,R,P,N),TS,[BRACE(B,I)|OS],N+1,Term,Status).

solve_infix(TS,[INFOP(S1,L1,R1,P1,N1)|OS],N2,S2,L2,R2,P2,Term,Status) :-
	!,
	TS=[OPRND(O2),OPRND(O1)|Opnds],
	( P1 < P2 ->
	    infix_struct(S1,O1,O2,N1,T),
	    solve_infix([OPRND(T)|Opnds],OS,N2,S2,L2,R2,P2,Term,Status)

        ; P1 == P2 ->
	    ( L2 == y ->
		( R1 == y ->
		    composing_warning(N1,N2,OP_AMBIGUITY,Warn),
		    Status=[Warn|NewStatus]
		;
		  NewStatus=Status
	        ),
		infix_struct(S1,O1,O2,N1,T),
		solve_infix([OPRND(T)|Opnds],OS,N2,S2,L2,R2,P2,Term,NewStatus)

	    ; R1 == x ->
	        report_error(N1,N2,WRONG_ASSOCIATE),
		fail
	    ;
	      flora_compose(INFOP(S2,L2,R2,P2,N2),TS,[INFOP(S1,L1,R1,P1,N1)|OS],
			    N2+1,Term,Status)
	    )
        ;
	  flora_compose(INFOP(S2,L2,R2,P2,N2),TS,[INFOP(S1,L1,R1,P1,N1)|OS],
		        N2+1,Term,Status)
        ).

solve_infix(TS,[PREOP(S1,A,P1,N1)|OS],N2,S2,L,R,P2,Term,Status) :-
	!,
	TS=[OPRND(O)|Opnds],
	( P1 < P2 ->
	    prefix_struct(S1,O,N1,T),
	    solve_infix([OPRND(T)|Opnds],OS,N2,S2,L,R,P2,Term,Status)

        ; P1 == P2 ->
	    ( L == y ->
		( A == y ->
		    composing_warning(N1,N2,OP_AMBIGUITY,Warn),
		    Status=[Warn|NewStatus]
		;
		  NewStatus=Status
	        ),
		prefix_struct(S1,O,N1,T),
		solve_infix([OPRND(T)|Opnds],OS,N2,S2,L,R,P2,Term,NewStatus)

	    ; A == x ->
	        report_error(N1,N2,WRONG_ASSOCIATE),
		fail
	    ;
	      flora_compose(INFOP(S2,L,R,P2,N2),TS,[PREOP(S1,A,P1,N1)|OS],
	                    N2+1,Term,Status)
	    )
        ;
	  flora_compose(INFOP(S2,L,R,P2,N2),TS,[PREOP(S1,A,P1,N1)|OS],
		        N2+1,Term,Status)
        ).


/***************************************************************************
  solve_suffix(+TmStack,+OpStack,+N,+Operator,+A,+P,-Term,-Status)
  is called when a suffix operator that is just read results in solving
  the stacks.
***************************************************************************/
solve_suffix([OPRND(O)|TS],[],N,S,A,P,Term,Status) :-
	!,
	suffix_struct(S,O,N,T),
	flora_compose(SUFOP(S,A,P,N),[OPRND(T)|TS],[],N+1,Term,Status).

solve_suffix([OPRND(O)|TS],[BRACE(B,I)|OS],N,S,A,P,Term,Status) :-
	!,
	suffix_struct(S,O,N,T),
	flora_compose(SUFOP(S,A,P,N),[OPRND(T)|TS],[BRACE(B,I)|OS],N+1,Term,Status).

solve_suffix(TS,[INFOP(S1,L,R,P1,N1)|OS],N2,S2,A,P2,Term,Status) :-
	!,
	TS=[OPRND(O2),OPRND(O1)|Opnds],
	( P1 < P2 ->
	    infix_struct(S1,O1,O2,N1,T),
	    solve_suffix([OPRND(T)|Opnds],OS,N2,S2,A,P2,Term,Status)

        ; P1 == P2 ->
	    ( A == y ->
		( R == y ->
		    composing_warning(N1,N2,OP_AMBIGUITY,Warn),
		    Status=[Warn|NewStatus]
		;
		  NewStatus=Status
	        ),
		infix_struct(S1,O1,O2,N1,T),
		solve_suffix([OPRND(T)|Opnds],OS,N2,S2,A,P2,Term,NewStatus)

	    ; R == x ->
	        report_error(N1,N2,WRONG_ASSOCIATE),
		fail
	    ;
	      suffix_struct(S2,O2,N2,T),
              flora_compose(SUFOP(S2,A,P2,N2),[OPRND(T),OPRND(O1)|Opnds],
 		            [INFOP(S1,L,R,P1,N1)|OS],N2+1,Term,Status)
	    )
        ;
	  suffix_struct(S2,O2,N2,T),
          flora_compose(SUFOP(S2,A,P2,N2),[OPRND(T),OPRND(O1)|Opnds],
 		        [INFOP(S1,L,R,P1,N1)|OS],N2+1,Term,Status)
        ).

solve_suffix(TS,[PREOP(S1,A1,P1,N1)|OS],N2,S2,A2,P2,Term,Status) :-
	!,
	TS=[OPRND(O)|Opnds],
	( P1 < P2 ->
	    prefix_struct(S1,O,N1,T),
	    solve_suffix([OPRND(T)|Opnds],OS,N2,S2,A2,P2,Term,Status)

        ; P1 == P2 ->
	    ( A2 == y ->
		( A1 == y ->
		    composing_warning(N1,N2,OP_AMBIGUITY,Warn),
		    Status=[Warn|NewStatus]
		;
		  NewStatus=Status
	        ),
		prefix_struct(S1,O,N1,T),
		solve_suffix([OPRND(T)|Opnds],OS,N2,S2,A2,P2,Term,NewStatus)

	    ; A1 == x ->
	        report_error(N1,N2,WRONG_ASSOCIATE),
		fail
	    ;
	      suffix_struct(S2,O,N2,T),
              flora_compose(SUFOP(S2,A2,P2,N2),[OPRND(T)|Opnds],
 		            [PREOP(S1,A1,P1,N1)|OS],N2+1,Term,Status)
	    )
        ;
  	  suffix_struct(S2,O,N2,T),
	  flora_compose(SUFOP(S2,A2,P2,N2),[OPRND(T)|Opnds],
	                [PREOP(S1,A1,P1,N1)|OS],N2+1,Term,Status)
        ).


/***************************************************************************
  solve_right(+TmStack,+OpStack,+N,+Brace,-Term,-Status)
  is called when a right brace is just read.
***************************************************************************/
solve_right(TS,[INFOP(S,_L,_R,_P,I)|OS],N,B,Term,Status) :-
	!,
	TS=[OPRND(O2),OPRND(O1)|Opnds],
	infix_struct(S,O1,O2,I,T),
	solve_right([OPRND(T)|Opnds],OS,N,B,Term,Status).

solve_right(TS,[PREOP(S,_A,_P,I)|OS],N,B,Term,Status) :-
	!,
	TS=[OPRND(O)|Opnds],
	prefix_struct(S,O,I,T),
	solve_right([OPRND(T)|Opnds],OS,N,B,Term,Status).

solve_right(TS,[BRACE(B1,N1)|OS],N2,B2,Term,Status) :-
	!,
	( B1 \== B2 ->
	    report_error(N1,N2,UNMATCHED_RIGHT),
	    fail

	; TS=[OPRND(O),BRACE(B1,N1),FUNCT(F)|Opnds] ->
	    argument_struct(B2,O,N1,N2,AT),
	    function_struct(F,AT,FT),
	    flora_compose(OPRND(FT),Opnds,OS,N2+1,Term,Status)

	; TS=[OPRND(O),BRACE(B1,N1)|Opnds] ->
	    argument_struct(B2,O,N1,N2,AT),
	    flora_compose(OPRND(AT),Opnds,OS,N2+1,Term,Status)

	; TS=[BRACE(B1,N1),FUNCT(F)|Opnds] ->
	    argument_struct(B2,N1,N2,AT),
	    function_struct(F,AT,FT),
	    flora_compose(OPRND(FT),Opnds,OS,N2+1,Term,Status)

	; TS=[BRACE(B1,N1)|Opnds] ->
	    ( B1 == FL_PARENTHESIS ->
		report_error(N2,UNEXP_RIGHT),
		fail
	    ;
	      argument_struct(B2,N1,N2,AT),
	      flora_compose(OPRND(AT),Opnds,OS,N2+1,Term,Status)
	    )
        ).

solve_right(_TS,[],N2,_B2,_Term,_Status) :-
	!,
	report_error(N2,UNMATCHED_RIGHT),
	fail.


/***************************************************************************
  solve_end(+TmStack,+OpStack,+N,-Term,-Status)
  is called when a rule delimeter is just read.
***************************************************************************/
solve_end(TS,[INFOP(S,_L,_R,_P,I)|OS],N,Term,Status) :-
	!,
	TS=[OPRND(O2),OPRND(O1)|Opnds],
	infix_struct(S,O1,O2,I,T),
	solve_end([OPRND(T)|Opnds],OS,N,Term,Status).

solve_end(TS,[PREOP(S,_A,_P,I)|OS],N,Term,Status) :-
	!,
	TS=[OPRND(O)|Opnds],
	prefix_struct(S,O,I,T),
	solve_end([OPRND(T)|Opnds],OS,N,Term,Status).

solve_end([OPRND(Term)],[],_N,Term,[]) :- !.

solve_end(_TS,[BRACE(_B,I)|_OS],N,_Term,_Status) :-
	!,
	report_error(I,N,UNMATCHED_LEFT),
	fail.