unit logiques;
(* Analyseur syntaxique d'expressions logiques. *)

(* Grammaire des expressions logiques.
 *
 * On considŠrera le ou et le ou exclusif comme des op‚rateurs additif et le
 * et comme un op‚rateur multiplicatif.  L'associativit‚ est de gauche …
 * droite, l'‚valuation se fait donc de gauche … droite, et se fait mˆme si
 * cela n'est pas n‚cessaire.  Par exemple si on fait le et d'une relation
 * fausse et d'une relation qui peut ˆtre vrai, il n'est pas n‚cessaire d'
 * ‚valuer la seconde pour conclure.  Les crochets [ et ], mˆme s'ils ne sont
 * pas inclus dans le langage Basic usuel, seront utiles pour forcer l'ordre
 * d'‚valuation.
 *
 * 	expression_logique:
 *
 *		expression_additive
 *
 *	expression_additive:
 *
 *		expression_multiplicative or expression_additive
 *		expression_multiplicative xor expression_additive
 *		expression_multiplicative
 *
 *	expression_multiplicative:
 *
 *		expression_basique and expression_multiplicative
 *		expression_basique
 *
 *	expression_basique:
 *
 *		[expression_logique]
 *		not expression_basique
 *		expression_relationnelle_num‚rique
 *		expression_relationnelle_chaine
 *
 * 	expression_relationnelle_num‚rique:
 *
 *		expression_num‚rique < expression_num‚rique
 *		expression_num‚rique <= expression_num‚rique
 *		expression_num‚rique > expression_num‚rique
 *		expression_num‚rique >= expression_num‚rique
 *		expression_num‚rique = expression_num‚rique
 *		expression_num‚rique <> expression_num‚rique
 *
 * 	expression_relationnelle_chaine:
 *
 *		expression_chaine < expression_chaine
 *		expression_chaine <= expression_chaine
 *		expression_chaine > expression_chaine
 *		expression_chaine >= expression_chaine
 *		expression_chaine = expression_chaine
 *		expression_chaine <> expression_chaine
 *)

interface

uses numeriques, chaines;

type    TYPE_RELATIONS =
	(
		RELATION_NUMERIQUE,
		RELATION_CHAINE
	);

	OPERATEUR_RELATIONNEL =
	(
		PLUS_PETIT,
		PLUS_PETIT_EGAL,
		PLUS_GRAND,
		PLUS_GRAND_EGAL,
		EGAL,
		DIFFERENT
	);

	OPERATEUR_LOGIQUE_BINAIRE =
	(
		ET,
		OU,
		OU_EXCLUSIF
	);

	OPERATEUR_LOGIQUE_UNAIRE = (
		NON
	);

	TYPE_EXPRESSIONS_LOGIQUES =
	(
		LOGIQUE_RELATIONNELLE,
		LOGIQUE_BINAIRE,
		LOGIQUE_UNAIRE
	);

	EXPRESSION_LOGIQUE	= ^RECORD_LOGIQUE;

	RECORD_LOGIQUE =
	record case type_expression : TYPE_EXPRESSIONS_LOGIQUES of
		LOGIQUE_RELATIONNELLE :
		(
			operateur : OPERATEUR_RELATIONNEL;
			case type_relation : TYPE_RELATIONS of
				RELATION_NUMERIQUE : (
					a, b	: EXPRESSION_NUMERIQUE;
				);
				RELATION_CHAINE : (
					c, d	: EXPRESSION_CHAINE;
				);
		);
		LOGIQUE_BINAIRE :
		(
			binaire : OPERATEUR_LOGIQUE_BINAIRE;
			gauche 	: EXPRESSION_LOGIQUE;
			droite 	: EXPRESSION_LOGIQUE;
		);
		LOGIQUE_UNAIRE :
		(
			unaire	: OPERATEUR_LOGIQUE_UNAIRE;
			unique 	: EXPRESSION_LOGIQUE
		);
	end;

function 	lit_relation : EXPRESSION_LOGIQUE;
function 	lit_expression_logique : EXPRESSION_LOGIQUE;
procedure 	detruit_expression_logique (l : EXPRESSION_LOGIQUE);

implementation

uses lexical, syntaxe;

function lit_relation : EXPRESSION_LOGIQUE;
(* Lit une relation num‚rique ou chaine, renvoie nil en cas de problŠme. *)

function est_operateur_relationnel (t : TYPE_LEXEMES) : boolean;
(* Renvoie true si t est un op‚rateur relationnel. *)

begin
	est_operateur_relationnel := (t >= OPERATEUR_PLUS_PETIT)
		and (t <= OPERATEUR_DIFFERENT);
end;

function cree_relation_numerique (t : TYPE_LEXEMES;
	a, b : EXPRESSION_NUMERIQUE) : EXPRESSION_LOGIQUE;
(* Cr‚e une expression relationnelle num‚rique en fonction de t, renvoie nil
 * en cas de problŠme.
 *)

function cree_numerique (operateur : OPERATEUR_RELATIONNEL;
	a, b : EXPRESSION_NUMERIQUE) : EXPRESSION_LOGIQUE;
(* Cr‚e une expression relationnelle num‚rique et renvoie un pointeur, qui
 * peut ˆtre nil s'il n'y a pas assez de m‚moire, sur sa structure de
 * controle.
 *)

var	l	: EXPRESSION_LOGIQUE;

begin
	if maxavail < sizeof(RECORD_LOGIQUE) then begin
		erreur_syntaxique := MANQUE_MEMOIRE;
		cree_numerique := nil;
	end else begin
		new(l);
		l^.type_expression := LOGIQUE_RELATIONNELLE;
		l^.type_relation := RELATION_NUMERIQUE;
		l^.operateur := operateur;
		l^.a := a;
		l^.b := b;
		cree_numerique := l;
	end;
end;

var 	l	: EXPRESSION_LOGIQUE;

begin
	case t of
		OPERATEUR_PLUS_PETIT :
			l := cree_numerique(PLUS_PETIT, a, b);
		OPERATEUR_PLUS_PETIT_EGAL :
			l := cree_numerique(PLUS_PETIT_EGAL, a, b);
		OPERATEUR_PLUS_GRAND :
			l := cree_numerique(PLUS_GRAND, a, b);
		OPERATEUR_PLUS_GRAND_EGAL :
			l := cree_numerique(PLUS_GRAND_EGAL, a, b);
		OPERATEUR_EGAL :
			l := cree_numerique(EGAL, a, b);
		OPERATEUR_DIFFERENT :
			l := cree_numerique(DIFFERENT, a, b);
	end;
	cree_relation_numerique := l;
end;

function cree_relation_chaine (t : TYPE_LEXEMES;
	c, d : EXPRESSION_CHAINE) : EXPRESSION_LOGIQUE;
(* Cr‚e une expression relationnelle chaine en fonction de t, renvoie nil
 * en cas de problŠme.
 *)

function cree_chaine (operateur : OPERATEUR_RELATIONNEL;
	 c, d : EXPRESSION_CHAINE) : EXPRESSION_LOGIQUE;
(* Cr‚e une expression relationnelle chaine et renvoie un pointeur, qui peut
 * ˆtre nil s'il n'y a pas assez de m‚moire, sur sa structure de controle.
 *)

var	l	: EXPRESSION_LOGIQUE;

begin
	if maxavail < sizeof(RECORD_LOGIQUE) then begin
		erreur_syntaxique := MANQUE_MEMOIRE;
		cree_chaine := nil;
	end else begin
		new(l);
		l^.type_expression := LOGIQUE_RELATIONNELLE;
		l^.type_relation := RELATION_CHAINE;
		l^.operateur := operateur;
		l^.c := c;
		l^.d := d;
		cree_chaine := l;
	end;
end;

var 	l	: EXPRESSION_LOGIQUE;

begin
	case t of
		OPERATEUR_PLUS_PETIT :
			l := cree_chaine(PLUS_PETIT, c, d);
		OPERATEUR_PLUS_PETIT_EGAL :
			l := cree_chaine(PLUS_PETIT_EGAL, c, d);
		OPERATEUR_PLUS_GRAND :
			l := cree_chaine(PLUS_GRAND, c, d);
		OPERATEUR_PLUS_GRAND_EGAL :
			l := cree_chaine(PLUS_GRAND_EGAL, c, d);
		OPERATEUR_EGAL :
			l := cree_chaine(EGAL, c, d);
		OPERATEUR_DIFFERENT :
			l := cree_chaine(DIFFERENT, c, d);
	end;
	cree_relation_chaine := l;
end;

var	t	: TYPE_LEXEMES;
	a, b	: EXPRESSION_NUMERIQUE;
	c, d	: EXPRESSION_CHAINE;

begin
	t := prend_lexeme;

	if t = ERREUR then begin

		erreur_syntaxique := ERREUR_ANALYSEUR_LEXICAL;
		lit_relation := nil;

	end else if (t = OPERATEUR_ADDITION) or (t = OPERATEUR_SOUSTRACTION)
	or (t = LITERAL_ENTIER) or (t = LITERAL_REEL)
	or (t = IDENTIFICATEUR_ENTIER) or (t = IDENTIFICATEUR_REEL)
	or (t = SEPARATEUR_PARENTHESE_GAUCHE) then begin

		remet_lexeme;
		a := lit_expression_numerique;
		if a = nil then
			lit_relation := nil
		else begin
			t := prend_lexeme;
			if not est_operateur_relationnel(t) then begin
				detruit_expression_numerique(a);
				erreur_syntaxique
					:= ATTEND_OPERATEUR_RELATIONNEL;
				lit_relation := nil;
			end else begin
				b := lit_expression_numerique;
				if b = nil then begin
					detruit_expression_numerique(a);
					lit_relation := nil;
				end else
					lit_relation :=
						cree_relation_numerique(
							t, a, b);
			end;
		end;

	end else if (t = LITERAL_CHAINE) or (t = IDENTIFICATEUR_CHAINE) then
	begin

		remet_lexeme;
		c := lit_expression_chaine;
		if c = nil then
			lit_relation := nil
		else begin
			t := prend_lexeme;
			if not est_operateur_relationnel(t) then begin
				detruit_expression_chaine(c);
				erreur_syntaxique
					:= ATTEND_OPERATEUR_RELATIONNEL;
				lit_relation := nil;
			end else begin
				d := lit_expression_chaine;
				if d = nil then begin
					detruit_expression_chaine(d);
					lit_relation := nil;
				end else
					lit_relation :=
						cree_relation_chaine(
							t, c, d);
			end;
		end;

	end else begin

		erreur_syntaxique := ERREUR_DE_SYNTAXE;
		lit_relation := nil;

	end;
end;

function lit_expression_logique : EXPRESSION_LOGIQUE;
(* Lit une expression logique, renvoie un pointeur sur l'arbre d'expression,
 * ou nil en cas d'erreur, auquel cas la variable erreur_syntaxique donnera
 * plus de pr‚cision.
 *)

function expression_additive : EXPRESSION_LOGIQUE; forward;

function expression_basique : EXPRESSION_LOGIQUE;
(* Lit une expression basique, renvoie nil en cas de problŠme. *)

function cree_unaire (unaire : OPERATEUR_LOGIQUE_UNAIRE;
	unique : EXPRESSION_LOGIQUE) : EXPRESSION_LOGIQUE;
(* Cr‚e une expression logique unaire et renvoie un pointeur, qui peut ˆtre
 * nil s'il n'y a pas assez de m‚moire, sur sa structure de controle.  Si l'
 * unique op‚rande est nil, alors cette fonction renvoie nil, on a en effet
 * besoin d'une op‚rande.
 *)

var	l 	: EXPRESSION_LOGIQUE;

begin
	if unique = nil then
		cree_unaire := nil
	else if maxavail < sizeof(RECORD_LOGIQUE) then begin
		erreur_syntaxique := MANQUE_MEMOIRE;
		cree_unaire := nil;
	end else begin
		new(l);
		l^.type_expression := LOGIQUE_UNAIRE;
		l^.unaire := unaire;
		l^.unique := unique;
		cree_unaire := l;
	end;
end;

var	t 	: TYPE_LEXEMES;
	l	: EXPRESSION_LOGIQUE;

begin
	t := prend_lexeme;

	if t = ERREUR then begin

		erreur_syntaxique := ERREUR_ANALYSEUR_LEXICAL;
		expression_basique := nil;

	end else if t = SEPARATEUR_CROCHET_GAUCHE then begin

		l := expression_additive;
		if l <> nil then begin
			t := prend_lexeme;
			if t <> SEPARATEUR_CROCHET_DROIT then begin
				detruit_expression_logique(l);
				erreur_syntaxique := ATTEND_CROCHET_DROIT;
				expression_basique := nil;
			end else
				expression_basique := l;
		end else
			expression_basique := nil;

	end else if t = OPERATEUR_NON then begin

		l := expression_basique;
		expression_basique := cree_unaire(NON, l);

	end else begin

		remet_lexeme;
		expression_basique := lit_relation;

	end;
end;

function cree_binaire (binaire : OPERATEUR_LOGIQUE_BINAIRE;
	gauche, droite : EXPRESSION_LOGIQUE) : EXPRESSION_LOGIQUE;
(* Cr‚e une expression logique binaire et renvoie un pointeur, qui peut ˆtre
 * nil s'il n'y a pas assez de m‚moire, sur sa structure de controle.  Si l'
 * un ou l'autre de gauche ou de droite est nil, alors cette fonction renvoie
 * nil, une op‚ration logique binaire a besoin de deux op‚randes.
 *)

var	l 	: EXPRESSION_LOGIQUE;

begin
	if (gauche = nil) or (droite = nil) then
		cree_binaire := nil
	else if maxavail < sizeof(RECORD_LOGIQUE) then begin
		erreur_syntaxique := MANQUE_MEMOIRE;
		cree_binaire := nil;
	end else begin
		new(l);
		l^.type_expression := LOGIQUE_BINAIRE;
		l^.binaire := binaire;
		l^.gauche := gauche;
		l^.droite := droite;
		cree_binaire := l;
	end;
end;

function expression_multiplicative : EXPRESSION_LOGIQUE;
(* Lit une expression multiplicative, renvoie nil en cas de problŠme. *)

var	l, m	: EXPRESSION_LOGIQUE;
	t	: TYPE_LEXEMES;

begin
	l := expression_basique;

	if l <> nil then begin
		repeat
			t := prend_lexeme;

			if t = OPERATEUR_ET then begin
				m := expression_multiplicative;
				if m = nil then begin
					detruit_expression_logique(l);
					l := nil;
				end else
					l := cree_binaire(ET, l, m);
			end;
		until (l = nil) or (t <> OPERATEUR_ET);

		if l <> nil then
			remet_lexeme;
	end;

	expression_multiplicative := l;
end;

function expression_additive : EXPRESSION_LOGIQUE;
(* Lit une expression additive, renvoie nil en cas de problŠme. *)

var	l, m	: EXPRESSION_LOGIQUE;
	t	: TYPE_LEXEMES;

begin
	l := expression_multiplicative;

	if l <> nil then begin
		repeat
			t := prend_lexeme;

			if t = OPERATEUR_OU then begin

				m := expression_additive;
				if m = nil then begin
					detruit_expression_logique(l);
					l := nil;
				end else
					l := cree_binaire(OU, l, m);

			end else if t = OPERATEUR_OU_EXCLUSIF then begin

				m := expression_additive;
				if m = nil then begin
					detruit_expression_logique(l);
					l := nil;
				end else
					l := cree_binaire(OU_EXCLUSIF, l, m);

			end;
		until (l = nil)
		or ((t <> OPERATEUR_OU) and (t <> OPERATEUR_OU_EXCLUSIF));

		if l <> nil then
			remet_lexeme;
	end;

	expression_additive := l;
end;

begin
	lit_expression_logique := expression_additive;
end;

procedure detruit_expression_logique (l : EXPRESSION_LOGIQUE);
(* D‚truit r‚cursivement l'arbre d'une expression logique. *)

begin
	if l <> nil then
		case l^.type_expression of
			LOGIQUE_RELATIONNELLE : begin
				dispose(l);
			end;
			LOGIQUE_BINAIRE : begin
				detruit_expression_logique(l^.gauche);
				detruit_expression_logique(l^.droite);
				dispose(l);
			end;
			LOGIQUE_UNAIRE : begin
				detruit_expression_logique(l^.unique);
				dispose(l);
			end;
		end;
end;

end.