program ArbreSyntaxiqueIncomplet;

	const
		CoinG = 50;
		CoinH = 50;
		CoinD = 500;
		CoinB = 350;

	type
		ChaineCourte = string[20];   {longueur maximale d'un identificateur}
		ChaineLongue = string;          {longueur maximale d'une expression ou d'un message d'erreur}
		TypeLexeme = (operateur, nombre, identificateur, parOuv, parFer, fin, inconnu);
		Lexeme = record
				case genre : TypeLexeme of
					operateur: (
							op: char
					);
					nombre: (
							valeur: integer
					);
					identificateur: (
							nom: ChaineCourte
					)
			end;
		Arbre = ^Noeud;
		Noeud = record
				case genre : TypeLexeme of
					operateur: (
							op: char;
							filsG, filsD: Arbre
					);
					nombre: (
							valeur: integer
					);
					identificateur: (
							nom: ChaineCourte
					)
			end;

	var
		pos, maxpos: integer;
		phrase, messageErreur: ChaineLongue;
		lex: Lexeme;
		expr: Arbre;
{-----------------------lecture du lexeme suivant----------------------------}
	procedure LireLexeme;
		var
			b: boolean;
			valeur: integer;
			nom: ChaineCourte;
	begin
		b := (pos <= maxpos);
		if b then
			b := (phrase[pos] in [' ']);
		while b do
			begin
				write(phrase[pos]);
				pos := pos + 1;
				b := (pos <= maxpos);
				if b then
					b := (phrase[pos] in [' ']);
			end;
		if pos > maxpos then
			begin
				write(' ');
				lex.genre := fin
			end
		else
			case phrase[pos] of
				'0'..'9': 
					begin
						valeur := 0;
						repeat
							valeur := valeur * 10 + ord(phrase[pos]) - ord('0');
							pos := pos + 1;
							write(' ');
							b := (pos <= maxpos);
							if b then
								b := (phrase[pos] in ['0'..'9']);
						until not b;
						lex.genre := nombre;
						lex.valeur := valeur
					end;
				'+', '-', '*', '/': 
					begin
						lex.genre := operateur;
						lex.op := phrase[pos];
						pos := pos + 1;
						write(' ')
					end;
				'A'..'Z', 'a'..'z': 
					begin
						nom := '';
						repeat
							nom := concat(nom, phrase[pos]); {sous PC mettre nom:=nom+phrase[pos]}
							pos := pos + 1;
							write(' ');
							b := (pos <= maxpos);
							if b then
								b := (phrase[pos] in ['0'..'9', 'A'..'Z', '_', 'a'..'z']);
						until not b;
						lex.genre := identificateur;
						lex.nom := nom
					end;
				'(': 
					begin
						lex.genre := parOuv;
						pos := pos + 1;
						write(' ')
					end;
				')': 
					begin
						lex.genre := parFer;
						pos := pos + 1;
						write(' ')
					end;
				otherwise
					begin
						lex.genre := inconnu;
						messageErreur := 'lexeme inconnu';
						write(' ')
					end
			end
	end;
{-----------------creation d'un noeud nombre ou identificateur------------------------}
	function ValeurUnaire (lex: Lexeme): Arbre;
		var
			e: Arbre;
	begin
		new(e);
		e^.genre := lex.genre;
		case lex.genre of
			nombre: 
				e^.valeur := lex.valeur;
			identificateur: 
				e^.nom := lex.nom
		end;
		ValeurUnaire := e
	end;
{---------------------------creation d'un noeud operateur----------------------------}
	function OperationBinaire (op: char; filsG, filsD: Arbre): Arbre;
		var
			e: Arbre;
	begin
		new(e);
		e^.genre := operateur;
		e^.op := op;
		e^.filsG := filsG;
		e^.filsD := filsD;
		OperationBinaire := e
	end;
{----------------creation d'un noeud nombre egal a zero-------------------}
	function ValeurNulle: Arbre;
		var
			lex: Lexeme;
	begin
		lex.genre := nombre;
		lex.valeur := 0;
		ValeurNulle := ValeurUnaire(lex)
	end;

{----------------------------------descente recursive-------------------}

	function Expression: Arbre;
	forward;

	function Facteur: Arbre;
{XXXXXXXXXXXXXXXXX a completer XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
	begin
		Facteur := nil;
	end;
{XXXXXXXXXXXX  fin de a completer XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}


	function Terme: Arbre;
{XXXXXXXXXXXXXXXXX a completer XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
	begin
		Terme := nil;
	end;
{XXXXXXXXXXXX  fin de a completer XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}

	function Expression: Arbre;
		var
			e, ed: Arbre;
			op: char;
	begin
		e := Terme;
		if (e <> nil) and (lex.genre = operateur) and ((lex.op = '+') or (lex.op = '-')) then
			begin
				op := lex.op;
				LireLexeme;
				ed := Expression;
				if ed <> nil then
					e := OperationBinaire(op, e, ed)
				else
					e := nil
			end;
		Expression := e
	end;

	function derive (e: Arbre; nom: ChaineCourte): Arbre;
{XXXXXXXXXXXXXXXXX a completer XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
	begin
		derive := nil;
	end;
{XXXXXXXXXXXX  fin de a completer XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
{-----------------------------------------------------------------------}
	procedure initialisation;
		var
			r: Rect;
	begin
		SetRect(r, CoinG, CoinH, CoinD, CoinB);
		SetTextRect(r);
		ShowText
	end;

	function LireExpression: boolean;
	begin
		writeln('Entrez une expression ou [return] :');
		write('> ');
		readln(phrase);
		if phrase <> '' then
			begin
				pos := 1;
				write(' ');
				maxpos := length(phrase);
				messageErreur := ''
			end;
		LireExpression := phrase <> ''
	end;

	procedure AfficherExpression (e: Arbre);
	begin
		if e <> nil then
			case e^.genre of
				operateur: 
					begin
						write('(');
						AfficherExpression(e^.filsG);
						write(e^.op : 2);
						AfficherExpression(e^.filsD);
						write(')');
					end;
				nombre: 
					write(e^.valeur : 2);
				identificateur: 
					write(e^.nom)
			end
	end;
{--------------------------------------------------------------------------}
	function Analyse: Arbre;
		var
			e: Arbre;
	begin
		LireLexeme;
		e := Expression;
		if (e <> nil) and (lex.genre = fin) then
			begin
				writeln;
				write('exp = ');
				AfficherExpression(e);
				writeln;
			end
		else
			begin
				if (e <> nil) and (lex.genre <> inconnu) then
					messageErreur := 'mauvaise syntaxe';
				writeln('^');
				writeln('Erreur : ', messageErreur)
			end;
		writeln;
		Analyse := e
	end;
{--------------------------------------------------------------------------}
	procedure DeriverExpression (e: Arbre);
		var
			nom: ChaineCourte;
	begin
		repeat
			writeln('-> dˇrivation : entrez le nom d''une variable ou [return] : ');
			write('> ');
			readln(nom);
			if nom <> '' then
				begin
					write('e''(', nom, ') = ');
					AfficherExpression(derive(e, nom));
					writeln
				end
		until nom = '';
		writeln;
	end;
{--------------------------------------------------------------------------}
begin
	initialisation;
	while LireExpression do
		begin
			expr := Analyse;
			if expr <> nil then
				DeriverExpression(expr)
		end
end.