/* 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.
syntax highlighted by Code2HTML, v. 0.9.1