/*****************************************************************************
			Prolog Inference Engine
			=======================

   Copyright (c) 1986, 88 by Borland International, Inc

   Module PIE.PAR: The operator precedence parser

   This module implements a operator precedence parser. The priority and
   associativity of the operators are stored in the database predicate "op".
*****************************************************************************/

PREDICATES
  s_term(TOKL,TOKL,STERM)
  s_lowerterm(TOKL,TOKL,STERM)
  s_lowerterm1(TOKL,TOKL,STERM,STERM)
  s_priorterm(PRIOR,ASSOC,TOKL,TOKL,STERM)
  s_basisterm(PRIOR,ASSOC,TOKL,TOKL,STERM)
  s_higher(PRIOR,ASSOC,TOKL,TOKL,STERM,STERM)
  s_higher_something(PRIOR,ASSOC,TOKL,TOKL,STERM,STERM)
  treat_prefix(PRIOR,XFY,TOKL,TOKL,STERM)
  treat_sufinfix(PRIOR,XFY,OP,TOKL,TOKL,STERM,STERM)
  s_list(TOKL,TOKL,STERM)
  s_list1(TOKL,TOKL,STERM)
  s_terml(TOKL,TOKL,STERML)
  s_terml1(TOKL,TOKL,STERML)
  s_term6(TOKL,TOKL,STRING,STERM)
  is_op(TOK,PRIOR,XFY,OP)
  ok_rightop(PRIOR,ASSOC,PRIOR)
  check_ok_rightop(CURSOR,PRIOR,ASSOC,PRIOR)
  is_prefix(XFY)
  prefix_op(PRIOR,XFY,OP)

CLAUSES
  s_term(IL,OL,TERM):-s_lowerterm(IL,OL,TERM),!.
  s_term(_,_,_):-write("\nSyntax error"),fail.

  s_basisterm(_,_,[t(atom("-"),_),t(int(X),_)|LL],LL,int(I)):-!,I=-X.
  s_basisterm(PRIOR,ASSOC,[t(atom(ID),CURSOR)|LL1],LL2,cmp(FID,[TERM])):-
	FID=ID, OP=FID,
	prefix_op(NEWPRIOR,XFY,OP),!,
	check_ok_rightop(CURSOR,PRIOR,ASSOC,NEWPRIOR),
	treat_prefix(NEWPRIOR,XFY,LL1,LL2,TERM).
  s_basisterm(_,_,[t(var(STRING),_)|LL],LL,var(STRING)):-!.
  s_basisterm(_,_,[t(atom(STRING),_)|LL1],LL0,TERM_):-!,
	s_term6(LL1,LL0,STRING,TERM_).
  s_basisterm(_,_,[t(int(X),_)|LL],LL,int(X)):-!.
  s_basisterm(_,_,[t(char(X),_)|LL],LL,char(X)):-!.
  s_basisterm(_,_,[t(str(X),_)|LL],LL,str(X)):-!.
  s_basisterm(_,_,[t(lbrack,_)|LL1],LL0,TERM):-!,
	s_list(LL1,LL0,TERM).
  s_basisterm(_,_,[t(lpar,_)|LL1],LL0,TERM):-!,
	s_priorterm(1201,y,LL1,LL2,TERM),
	LL2=[t(rpar,_)|LL0].

  s_list([t(rbrack,_)|IL],IL,nill):-!.
  s_list(IL,OL,list(TERM,REST)):-
	s_priorterm(1000,x,IL,OL1,TERM),
	s_list1(OL1,OL,REST).

  s_list1([t(rbrack,_)|IL],IL,nill):-!.
  s_list1([t(comma,_)|IL],OL,list(TERM,REST)):-
	s_priorterm(1000,x,IL,OL1,TERM),
	s_list1(OL1,OL,REST).
  s_list1([t(bar,_)|IL],OL,TERM):-
	s_priorterm(1000,x,IL,OL1,TERM),
	OL1=[t(rbrack,_)|OL].

  s_term6([t(lpar,_)|LL1],LL0,ID,cmp(FID,TERML)):-!,
	FID=ID,
	s_terml(LL1,LL2,TERML),
	LL2=[t(rpar,_)|LL0].
  s_term6(LL,LL,STRING,atom(STRING)):-!.

  s_terml(LL1,LL0,[TERM|TERML]):-
	s_priorterm(999,y,LL1,LL2,TERM),!,
	s_terml1(LL2,LL0,TERML).
  s_terml(LL,LL,[]).

  s_terml1([t(comma,_)|LL1],LL2,TERML):-!,
	s_terml(LL1,LL2,TERML).
  s_terml1(LL,LL,[]).

  treat_prefix(PRIOR,fx,LL1,LL2,TERM):-
	s_priorterm(PRIOR,x,LL1,LL2,TERM).
  treat_prefix(PRIOR,fy,LL1,LL2,TERM):-
	s_priorterm(PRIOR,y,LL1,LL2,TERM).

  s_lowerterm(LL1,LL0,TERM_):-
	PRIOR=1201,
	s_basisterm(PRIOR,y,LL1,LL2,TERM1),
	s_higher(PRIOR,y,LL2,LL3,TERM1,TERM2),
	s_lowerterm1(LL3,LL0,TERM2,TERM_).

  s_lowerterm1([],[],TERM,TERM):-!.
  s_lowerterm1([t(dot,_)|LL],LL,TERM,TERM):-!.
  s_lowerterm1(LL2,LL0,TERM1,TERM_):-
	PRIOR=1201,
	s_higher_something(PRIOR,y,LL2,LL3,TERM1,TERM2),
	s_lowerterm1(LL3,LL0,TERM2,TERM_).

  s_priorterm(PRIOR,ASSOC,LL1,LL0,TERM_):-
	s_basisterm(PRIOR,ASSOC,LL1,LL2,TERM),
	s_higher(PRIOR,ASSOC,LL2,LL0,TERM,TERM_).

  prefix_op(NEWPRIOR,XFY,FID):-
	op(NEWPRIOR,XFY,FID),
	is_prefix(XFY),!.

  is_prefix(fx).
  is_prefix(fy).

  ok_rightop(PRIOR,_,NEWPRIOR):-
	NEWPRIOR<PRIOR,!.
  ok_rightop(PRIOR,y,PRIOR).

  check_ok_rightop(_,PRIOR,ASSOC,NEWPRIOR):-
	ok_rightop(PRIOR,ASSOC,NEWPRIOR),!.
  check_ok_rightop(_,_,_,_):-write("Priority error"),nl,fail.

  is_op(comma,PRIOR,XFY,OP):-
	OP=",",	op(PRIOR,XFY,OP),!.
  is_op(dot,PRIOR,XFY,OP):-
	OP=".",	op(PRIOR,XFY,OP),!.
  is_op(atom(ID),PRIOR,XFY,OP):-
	ID=OP, op(PRIOR,XFY,OP),!.

  s_higher_something(PRIOR,ASSOC,[t(TOK,_)|LL1],LL0,TERM,TERM_):-
	is_op(TOK,NEWPRIOR,XFY,OP),
	ok_rightop(PRIOR,ASSOC,NEWPRIOR),
	treat_sufinfix(NEWPRIOR,XFY,OP,LL1,LL2,TERM,TERM1),
	s_higher(PRIOR,ASSOC,LL2,LL0,TERM1,TERM_).

  s_higher(PRIOR,ASSOC,[t(TOK,_)|LL1],LL0,TERM,TERM_):-
	is_op(TOK,NEWPRIOR,XFY,OP),
	ok_rightop(PRIOR,ASSOC,NEWPRIOR),!,
	treat_sufinfix(NEWPRIOR,XFY,OP,LL1,LL2,TERM,TERM1),
	s_higher(PRIOR,ASSOC,LL2,LL0,TERM1,TERM_).
  s_higher(_,_,LL,LL,TERM,TERM).

  treat_sufinfix(PRIOR,yfx,OP,LL1,LL2,TERM1,cmp(FID,[TERM1,TERM2])):-
	OP=FID,	s_priorterm(PRIOR,x,LL1,LL2,TERM2).
  treat_sufinfix(PRIOR,xfx,OP,LL1,LL2,TERM1,cmp(FID,[TERM1,TERM2])):-
	OP=FID,	s_priorterm(PRIOR,x,LL1,LL2,TERM2).
  treat_sufinfix(PRIOR,xfy,OP,LL1,LL2,TERM1,cmp(FID,[TERM1,TERM2])):-
	OP=FID,	s_priorterm(PRIOR,y,LL1,LL2,TERM2).
  treat_sufinfix(_,xf,OP,LL,LL,TERM,cmp(FID,[TERM])):-OP=FID.
  treat_sufinfix(_,yf,OP,LL,LL,TERM,cmp(FID,[TERM])):-OP=FID.
