unit chaines;
(* Analyseur syntaxique et ‚valuateur d'expressions chaines. *)

(* Grammaire des expressions chaines.
 *
 * L'associativit‚ est de gauche … droite, cela n'aurait toutefois pas eu une
 * grosse importance si ca avait ‚t‚ le contraire, sauf peut-ˆtre dans l'
 * ordre o— arriveront les concat‚nations trop longues.  Par exemple si on a
 * des chaines limit‚s … quatres caractŠres, avec l'expression:
 *			"a" + "bc" + "def",
 * on aurait une chaine trop longue … l'op‚ration "abc" + "def", alors que
 * dans le cas d'une associativit‚ de droite … gauche, on aurait l'erreur dŠs
 * la premiŠre: "bc" + "def".
 *
 * 	expression_chaine:
 *
 *		expression_concatenation
 *
 *	expression_concatenation:
 *
 *		valeur_chaine + expression_concatenation
 *		valeur_chaine
 *
 *	valeur_chaine:
 *
 *		LITERAL_CHAINE
 *		IDENTIFICATEUR_CHAINE
 *)

interface

type    TYPE_EXPRESSIONS_CHAINES =
	(
		CHAINE_LITERAL,
		CHAINE_VARIABLE,
		CHAINE_CONCATENATION
	);

	EXPRESSION_CHAINE 	= ^RECORD_CHAINE;

	RECORD_CHAINE =
	record case type_expression : TYPE_EXPRESSIONS_CHAINES of
		CHAINE_LITERAL : (
			chaine 		: string
		);
		CHAINE_VARIABLE : (
			identificateur 	: string
		);
		CHAINE_CONCATENATION :
		(
			gauche, droite 	: EXPRESSION_CHAINE
		);
	end;

function 	lit_valeur_chaine : EXPRESSION_CHAINE;
function 	lit_expression_chaine : EXPRESSION_CHAINE;
procedure 	detruit_expression_chaine (c : EXPRESSION_CHAINE);

implementation

uses lexical, syntaxe;

function lit_valeur_chaine : EXPRESSION_CHAINE;
(* Lit une valeur chaine, … savoir un lit‚ral chaine ou un identificateur
 * chaine, renvoie un pointeur sur une expression chaine, ou nil en cas d'
 * erreur, auquel cas erreur_syntaxique donnera plus de d‚tail.
 *)

function cree_literal (chaine : string) : EXPRESSION_CHAINE;
(* Cr‚e une expression lit‚ral et renvoie un pointeur, qui peut ˆtre nil s'
 * il n'y a pas assez de m‚moire, sur sa structure de controle.
 *)

var	c 	: EXPRESSION_CHAINE;

begin
	if maxavail < sizeof(RECORD_CHAINE) then begin
		erreur_syntaxique := MANQUE_MEMOIRE;
		cree_literal := nil;
	end else begin
		new(c);
		c^.type_expression := CHAINE_LITERAL;
		c^.chaine := chaine;
		cree_literal := c;
	end;
end;

function cree_variable (identificateur : string) : EXPRESSION_CHAINE;
(* Cr‚e une expression chaine variable identifi‚ par identificateur et
 * renvoie un pointeur, qui peut ˆtre nil s'il n'y a pas assez de m‚moire,
 * sur sa structure de controle.
 *)

var	c 	: EXPRESSION_CHAINE;

begin
	if maxavail < sizeof(RECORD_CHAINE) then begin
		erreur_syntaxique := MANQUE_MEMOIRE;
		cree_variable := nil;
	end else begin
		new(c);
		c^.type_expression := CHAINE_VARIABLE;
		c^.identificateur := identificateur;
		cree_variable := c;
	end;
end;

var	t	: TYPE_LEXEMES;
	c 	: EXPRESSION_CHAINE;

begin
	t := prend_lexeme;

	if t = ERREUR then begin

		erreur_syntaxique := ERREUR_ANALYSEUR_LEXICAL;
		lit_valeur_chaine := nil;

	end else if t = LITERAL_CHAINE then begin

		lit_valeur_chaine := cree_literal(lexeme);

	end else if t = IDENTIFICATEUR_CHAINE then begin

		lit_valeur_chaine := cree_variable(lexeme)

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

		erreur_syntaxique := ATTEND_CHAINE;
		lit_valeur_chaine := nil;

	end else begin

		erreur_syntaxique := ERREUR_DE_SYNTAXE;
		lit_valeur_chaine := nil;

	end;
end;

function lit_expression_chaine : EXPRESSION_CHAINE;
(* Lit une expression chaine, et 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.
 *)

function expression_concatenation : EXPRESSION_CHAINE; forward;

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

begin
	expression_basique := lit_valeur_chaine;
end;

function expression_concatenation : EXPRESSION_CHAINE;
(* Lit une expression de concatenation, renvoie nil en cas de problŠme. *)

function cree_concatenation (gauche, droite : EXPRESSION_CHAINE)
        : EXPRESSION_CHAINE;
(* Cr‚e une expression chaine concatenation, 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 concat‚nation ne peut se
 * faire qu'en pr‚sence de deux chaines.
 *)

var	c 	: EXPRESSION_CHAINE;

begin
	if (gauche = nil) or (droite = nil) then
		cree_concatenation := nil
	else if maxavail < sizeof(RECORD_CHAINE) then begin
		erreur_syntaxique := MANQUE_MEMOIRE;
		cree_concatenation := nil;
	end else begin
		new(c);
		c^.type_expression := CHAINE_CONCATENATION;
		c^.gauche := gauche;
		c^.droite := droite;
		cree_concatenation := c;
	end;
end;

var	c, d 	: EXPRESSION_CHAINE;
	t	: TYPE_LEXEMES;

begin
	c := expression_basique;

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

				d := expression_concatenation;
				if d = nil then begin
					detruit_expression_chaine(c);
					c := nil;
				end else
					c := cree_concatenation(c, d);

			end;
		until (c = nil) or (t <> OPERATEUR_ADDITION);

		if c <> nil then
			remet_lexeme;
	end;

	expression_concatenation := c;
end;

begin
	lit_expression_chaine := expression_concatenation;
end;

procedure detruit_expression_chaine (c : EXPRESSION_CHAINE);
(* D‚truit r‚cursivement l'arbre d'une expression chaine. *)

begin
	if c <> nil then
		case c^.type_expression of
			CHAINE_LITERAL : dispose(c);
			CHAINE_VARIABLE : dispose(c);
			CHAINE_CONCATENATION : begin
				detruit_expression_chaine(c^.gauche);
				detruit_expression_chaine(c^.droite);
				dispose(c);
			end;
		end;
end;

end.