unit numeriques;
(* Analyseur syntaxique d'expressions num‚riques. *)

(* Grammaire des expressions num‚riques.
 *
 * La grammaire d‚crite ici est associative droite … gauche, par exemple si
 * on a 2 + 3 + 5, alors l'arbre syntaxique serait (2 + (3 + 5)), mais le
 * programme est en fait associatif gauche … droite, aussi on a 2 * 5 / 2
 * ‚gal … 5 et non … 4 (la division entiŠre tronque).  La description a cette
 * associativit‚ car elle est plus simple … comprendre, et on peut en tirer
 * directement une fonction d'analyse syntaxique r‚cursive, alors que l'
 * associativit‚ du programme est celle correspondant … l'usage de la plupart
 * des langages de programmation, mais est plus compliqu‚e.
 *
 * 	expression_num‚rique:
 *
 *		expression_additive
 *
 *	expression_additive:
 *
 *		expression_multiplicative + expression_additive
 *		expression_multiplicative - expression_additive
 *		expression_multiplicative
 *
 *	expression_multiplicative:
 *
 *		expression_basique * expression_multiplicative
 *		expression_basique / expression_multiplicative
 *              expression_basique mod expression_multiplicative
 *		expression_basique
 *
 *	expression_basique:
 *
 *		(expression_num‚rique)
 *		+ expression_basique
 *		- expression_basique
 *		valeur_num‚rique
 *
 *	valeur_numerique:
 *
 *		LITERAL_ENTIER
 *		LITERAL_REEL
 *		IDENTIFICATEUR_ENTIER
 *		IDENTIFICATEUR_REEL
 *)

interface

type    TYPE_NUMERIQUES =
	(
        	VALEUR_ENTIERE,
                VALEUR_REELLE
        );

	OPERATEUR_NUMERIQUE_BINAIRE =
	(
		MULTIPLICATION,
		DIVISION,
		MODULO,
		ADDITION,
		SOUSTRACTION
	);

	OPERATEUR_NUMERIQUE_UNAIRE =
	(
		PLUS,
		MOINS
	);

	TYPE_EXPRESSIONS_NUMERIQUES =
	(
		NUMERIQUE_ENTIERE,
		NUMERIQUE_REELLE,
		NUMERIQUE_VARIABLE,
		NUMERIQUE_BINAIRE,
		NUMERIQUE_UNAIRE
	);

	EXPRESSION_NUMERIQUE 	= ^RECORD_NUMERIQUE;

	RECORD_NUMERIQUE =
	record case type_expression : TYPE_EXPRESSIONS_NUMERIQUES of
		NUMERIQUE_ENTIERE :
		(
			entier 		: integer;
		);
		NUMERIQUE_REELLE :
		(
			reel 		: real;
		);
		NUMERIQUE_VARIABLE :
		(
			identificateur	: string;
			type_numerique	: TYPE_NUMERIQUES;
		);
		NUMERIQUE_BINAIRE :
		(
			binaire 	: OPERATEUR_NUMERIQUE_BINAIRE;
			gauche  	: EXPRESSION_NUMERIQUE;
			droite  	: EXPRESSION_NUMERIQUE;
		);
		NUMERIQUE_UNAIRE :
		(
			unaire 	: OPERATEUR_NUMERIQUE_UNAIRE;
			unique 	: EXPRESSION_NUMERIQUE;
		);
	end;

function	lit_valeur_numerique : EXPRESSION_NUMERIQUE;
function 	lit_expression_numerique : EXPRESSION_NUMERIQUE;
procedure 	detruit_expression_numerique (p : EXPRESSION_NUMERIQUE);

implementation

uses outils, lexical, syntaxe;

function lit_valeur_numerique : EXPRESSION_NUMERIQUE;
(* Lit une valeur num‚rique, … savoir un lit‚ral entier ou r‚el, ou un
 * identificateur entier ou r‚el, renvoie un pointeur sur une expression
 * num‚rique, ou nil en cas d'erreur, auquel cas erreur_syntaxique donnera
 * plus de d‚tail.
 *)

function cree_entier (entier : integer) : EXPRESSION_NUMERIQUE;
(* Cr‚e une expression num‚rique entiŠre et renvoie un pointeur, qui peut
 * ˆtre nil s'il n'y a pas assez de m‚moire, sur sa structure de controle.
 *)

var	p 	: EXPRESSION_NUMERIQUE;

begin
	if maxavail < sizeof(RECORD_NUMERIQUE) then begin
		erreur_syntaxique := MANQUE_MEMOIRE;
		cree_entier := nil;
	end else begin
		new(p);
		p^.type_expression := NUMERIQUE_ENTIERE;
		p^.entier := entier;
		cree_entier := p;
	end;
end;

function cree_reel (reel : real) : EXPRESSION_NUMERIQUE;
(* Cr‚e une expression num‚rique r‚elle et renvoie un pointeur, qui peut
 * ˆtre nil s'il n'y a pas assez de m‚moire, sur sa structure de controle.
 *)

var	p 	: EXPRESSION_NUMERIQUE;

begin
	if maxavail < sizeof(RECORD_NUMERIQUE) then begin
		erreur_syntaxique := MANQUE_MEMOIRE;
		cree_reel := nil;
	end else begin
		new(p);
		p^.type_expression := NUMERIQUE_REELLE;
		p^.reel := reel;
		cree_reel := p;
	end;
end;

function cree_variable (identificateur : string;
	type_numerique : TYPE_NUMERIQUES) : EXPRESSION_NUMERIQUE;
(* Cr‚e une expression num‚rique r‚f‚rencant une variable identifi‚ par
 * identificateur et de type type_numerique, renvoie un pointeur, qui peut
 * ˆtre nil s'il n'y a pas assez de m‚moire, sur sa structure de controle.
 *)

var	p 	: EXPRESSION_NUMERIQUE;

begin
	if maxavail < sizeof(RECORD_NUMERIQUE) then begin
		erreur_syntaxique := MANQUE_MEMOIRE;
		cree_variable := nil;
	end else begin
		new(p);
		p^.type_expression := NUMERIQUE_VARIABLE;
		p^.identificateur := identificateur;
		p^.type_numerique := type_numerique;
		cree_variable := p;
	end;
end;

var	t	: TYPE_LEXEMES;
	entier	: integer;
	reel	: real;
	p	: EXPRESSION_NUMERIQUE;

begin
	t := prend_lexeme;

	if t = ERREUR then begin

		erreur_syntaxique := ERREUR_ANALYSEUR_LEXICAL;
		lit_valeur_numerique := nil;

	end else if t = LITERAL_ENTIER then begin

		if chaine_a_entier(lexeme, entier) then
			lit_valeur_numerique := cree_entier(entier)
		else begin
			erreur_syntaxique := ENTIER_TROP_GRAND;
			lit_valeur_numerique := nil;
		end;

	end else if t = LITERAL_REEL then begin

		if chaine_a_reel(lexeme, reel) then
			lit_valeur_numerique := cree_reel(reel)
		else begin
			writeln('Erreur Interne: ',
				'Bienvenue dans la quatriŠme dimension!');
			halt;
		end;

	end else if (t = IDENTIFICATEUR_ENTIER)
	or (t = IDENTIFICATEUR_REEL) then begin

		if t = IDENTIFICATEUR_ENTIER then
			p := cree_variable(lexeme, VALEUR_ENTIERE)
		else
			p := cree_variable(lexeme, VALEUR_REELLE);
		lit_valeur_numerique := p;

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

		erreur_syntaxique := ATTEND_NUMERIQUE;
		lit_valeur_numerique := nil;

	end else begin

		erreur_syntaxique := ERREUR_DE_SYNTAXE;
		lit_valeur_numerique := nil;

	end;
end;

function lit_expression_numerique : EXPRESSION_NUMERIQUE;
(* Lit une expression num‚rique, renvoie un pointeur sur son arbre d'
 * expression, ou nil si une erreur est survenue, auquel cas la variable
 * erreur_syntaxique donnera plus de pr‚cision.  L'associativit‚ de l'arbre
 * d'expression obtenu est de gauche … droite.
 *)

function expression_additive : EXPRESSION_NUMERIQUE; forward;

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

function cree_operation_unaire (unaire : OPERATEUR_NUMERIQUE_UNAIRE;
	unique : EXPRESSION_NUMERIQUE) : EXPRESSION_NUMERIQUE;
(* Cr‚e une expression num‚rique unaire, renvoie un pointeur sur sa structure
 * de controle, ou bien nil s'il n'y a pas assez de m‚moire.  Si l'argument
 * unique est nil alors cree_operation_unaire renvoie nil.  L'op‚rande unique
 * doit imp‚rativement ˆtre un op‚rande valable (i.e. non nil).
 *)

var	p 	: EXPRESSION_NUMERIQUE;

begin
	if unique = nil then
		cree_operation_unaire := nil
	else if maxavail < sizeof(RECORD_NUMERIQUE) then begin
		erreur_syntaxique := MANQUE_MEMOIRE;
		cree_operation_unaire := nil;
	end else begin
		new(p);
		p^.type_expression := NUMERIQUE_UNAIRE;
		p^.unaire := unaire;
		p^.unique := unique;
		cree_operation_unaire := p;
	end;
end;

var	t 	: TYPE_LEXEMES;
	p	: EXPRESSION_NUMERIQUE;

begin
	t := prend_lexeme;

	if t = ERREUR then begin

		erreur_syntaxique := ERREUR_ANALYSEUR_LEXICAL;
		expression_basique := nil;

	end else if t = SEPARATEUR_PARENTHESE_GAUCHE then begin

		p := expression_additive;
		if p <> nil then begin
			t := prend_lexeme;
			if t <> SEPARATEUR_PARENTHESE_DROITE then begin
				detruit_expression_numerique(p);
				erreur_syntaxique :=
					ATTEND_PARENTHESE_DROITE;
				expression_basique := nil;
			end else
				expression_basique := p;
		end else
			expression_basique := nil;

	end else if t = OPERATEUR_ADDITION then begin

		p := expression_basique;
		expression_basique := cree_operation_unaire(PLUS, p);

	end else if t = OPERATEUR_SOUSTRACTION then begin

		p := expression_basique;
		expression_basique := cree_operation_unaire(MOINS, p);

	end else begin

		remet_lexeme;
		expression_basique := lit_valeur_numerique;

	end;
end;

function cree_operation_binaire (binaire : OPERATEUR_NUMERIQUE_BINAIRE;
	gauche, droite : EXPRESSION_NUMERIQUE) : EXPRESSION_NUMERIQUE;
(* Cr‚e une expression num‚rique binaire, renvoie un pointeur sur sa
 * structure de controle, ou bien nil s'il n'y a pas assez de m‚moire.  Si l'
 * un ou l'autre de gauche ou de droite est nil, alors cette fonction ne fait
 * rien si ce n'est renvoyer nil, en effet une op‚ration binaire ne peut se
 * faire qu'en pr‚sence de deux op‚randes valables.
 *)

var	p 	: EXPRESSION_NUMERIQUE;

begin
	if (gauche = nil) or (droite = nil) then
		cree_operation_binaire := nil
	else if maxavail < sizeof(RECORD_NUMERIQUE) then begin
		erreur_syntaxique := MANQUE_MEMOIRE;
		cree_operation_binaire := nil;
	end else begin
		new(p);
		p^.type_expression := NUMERIQUE_BINAIRE;
		p^.binaire := binaire;
		p^.gauche := gauche;
		p^.droite := droite;
		cree_operation_binaire := p;
	end;
end;

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

var	p, q	: EXPRESSION_NUMERIQUE;
	t	: TYPE_LEXEMES;

begin
	p := expression_basique;

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

				q := expression_basique;
				if q = nil then begin
					detruit_expression_numerique(p);
					p := nil
				end else
					p := cree_operation_binaire(
						MULTIPLICATION,	p, q);

			end else if t = OPERATEUR_DIVISION then begin

				q := expression_basique;
				if q = nil then begin
					detruit_expression_numerique(p);
					p := nil;
				end else
					p := cree_operation_binaire(
						DIVISION, p, q);

			end else if t = OPERATEUR_MODULO then begin

				q := expression_basique;
				if q = nil then begin
					detruit_expression_numerique(p);
					p := nil;
				end else
					p := cree_operation_binaire(
						MODULO, p, q);

			end;
		until (p = nil) or ((t <> OPERATEUR_MULTIPLICATION)
		and (t <> OPERATEUR_DIVISION) and (t <> OPERATEUR_MODULO));

		if p <> nil then
			remet_lexeme;
	end;

	expression_multiplicative := p;
end;

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

var	p, q	: EXPRESSION_NUMERIQUE;
	t	: TYPE_LEXEMES;

begin
	p := expression_multiplicative;

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

				q := expression_multiplicative;
				if q = nil then begin
					detruit_expression_numerique(p);
					p := nil;
				end else
					p := cree_operation_binaire(
						ADDITION, p, q);

			end else if t = OPERATEUR_SOUSTRACTION then begin

				q := expression_multiplicative;
				if q = nil then begin
					detruit_expression_numerique(p);
					p := nil;
				end else
					p := cree_operation_binaire(
						SOUSTRACTION, p, q);

			end;

		until (p = nil) or ((t <> OPERATEUR_ADDITION)
		and (t <> OPERATEUR_SOUSTRACTION));

		if p <> nil then
			remet_lexeme;
	end;

	expression_additive := p;
end;

begin
	lit_expression_numerique := expression_additive;
end;

procedure detruit_expression_numerique (p : EXPRESSION_NUMERIQUE);
(* D‚truit r‚cursivement l'arbre d'une expression num‚rique. *)

begin
	if p <> nil then
		case p^.type_expression of
			NUMERIQUE_ENTIERE : dispose(p);
			NUMERIQUE_REELLE : dispose(p);
			NUMERIQUE_VARIABLE : dispose(p);
			NUMERIQUE_BINAIRE : begin
				detruit_expression_numerique(p^.gauche);
				detruit_expression_numerique(p^.droite);
				dispose(p);
			end;
			NUMERIQUE_UNAIRE : begin
				detruit_expression_numerique(p^.unique);
				dispose(p);
			end;
		end;
end;

end.
