unit instructions;
(* Analyseur syntaxique d'instructions. *)

(* Grammaire des instructions possibles.
 *
 *	instruction_if_then_else:
 *
 *		if expression_logique then instruction | LITERAL_ENTIER
 *		[else instruction | LITERAL_ENTIER]
 *
 *	instruction_gosub:
 *
 *		gosub LITERAL_ENTIER
 *
 *	instruction_return:
 *
 *		return [LITERAL_ENTIER]
 *
 *	instruction_while:
 *
 *		while expression_logique
 *
 *	instruction_wend:
 *
 *		wend
 *
 *	instruction_for_to:
 *
 *		for valeur_num‚rique = expression_num‚rique
 *		to expression_num‚rique
 *
 *	instruction_next:
 *
 *		next lvaleur_num‚rique
 *
 *	instruction_goto:
 *
 *		goto LITERAL_ENTIER
 *
 *	instruction_let:
 *
 *		let valeur_num‚rique = expression_num‚rique
 *		let valeur_chaine = expression_chaine
 *		valeur_num‚rique = expression_num‚rique
 *		valeur_chaine = expression_chaine
 *
 *	instruction_end:
 *
 *		end
 *
 *	instruction_rem:
 *
 *		rem {ignore tout jusqu'… la fin de la ligne}
 *		COMMENTAIRE_APOSTROPHE {idem}
 *
 *	instruction_input:
 *
 *		input IDENTIFICATEUR_ENTIER | IDENTIFICATEUR_REEL
 *		| IDENTIFICATEUR_CHAINE
 *
 *	instruction_print:
 *
 *		print expression_num‚rique | expression_chaine
 *)

interface

uses numeriques, chaines, logiques;

type    TYPE_DONNEES =
	(
		TYPE_ENTIER,
		TYPE_REEL,
		TYPE_CHAINE,
		TYPE_NUMERIQUE	(* type entier ou r‚el *)
	);

	TYPE_INSTRUCTIONS =
	(
		INSTRUCTION_IF_THEN_ELSE,
		INSTRUCTION_GOSUB,
		INSTRUCTION_RETURN,
		INSTRUCTION_WHILE,
		INSTRUCTION_WEND,
		INSTRUCTION_FOR_TO,
		INSTRUCTION_NEXT,
		INSTRUCTION_GOTO,
		INSTRUCTION_LET,
		INSTRUCTION_END,
		INSTRUCTION_REM,
		INSTRUCTION_INPUT,
		INSTRUCTION_PRINT
	);

	INSTRUCTION = ^RECORD_INSTRUCTION;

	RECORD_INSTRUCTION =
	record case type_instruction : TYPE_INSTRUCTIONS of
		INSTRUCTION_IF_THEN_ELSE : (
			condition_if  		: EXPRESSION_LOGIQUE;
			instruction_then	: INSTRUCTION;
			instruction_else        : INSTRUCTION;
		);
		INSTRUCTION_GOSUB : (
			numero_gosub		: word;
		);
		INSTRUCTION_WHILE : (
			condition_while		: EXPRESSION_LOGIQUE;
		);
		INSTRUCTION_FOR_TO : (
			identificateur_for	: string;
			type_donnee		: TYPE_DONNEES;
			expression_for		: EXPRESSION_NUMERIQUE;
			expression_to		: EXPRESSION_NUMERIQUE;
		);
		INSTRUCTION_GOTO : (
			numero_goto		: word;
		);
		INSTRUCTION_LET : (
			identificateur_let	: string;
			case type_affectation : TYPE_DONNEES of
				TYPE_ENTIER :
					(entier	: EXPRESSION_NUMERIQUE);
				TYPE_REEL :
					(reel 	: EXPRESSION_NUMERIQUE);
				TYPE_CHAINE :
					(chaine : EXPRESSION_CHAINE);
		);
		INSTRUCTION_INPUT : (
			identificateur_input	: string;
			type_input		: TYPE_DONNEES;
		);
		INSTRUCTION_PRINT : (
			case type_print : TYPE_DONNEES of
				TYPE_NUMERIQUE :
					(numerique_print
						: EXPRESSION_NUMERIQUE);
				TYPE_CHAINE :
					(chaine_print	: EXPRESSION_CHAINE);
		);
	end;

function 	lit_instruction : INSTRUCTION;
procedure 	detruit_instruction (p : INSTRUCTION);

implementation

uses outils, lexical, syntaxe;

function lit_instruction : INSTRUCTION;
(* Lit une instruction, renvoie un pointeur sur sa structure INSTRUCTION, ou
 * nil si une erreur est survenue, auquel cas la variable erreur_syntaxique
 * donnera plus de pr‚cision.
 *)

function prend_instruction : INSTRUCTION;
(* Prend une instruction, renvoie nil en cas d'erreur, peut ˆtre appel‚
 * r‚cursivement.
 *)

function alloue_instruction : INSTRUCTION;
(* Alloue de la m‚moire pour une structure d'instruction et renvoie un
 * pointeur sur ce dernier, ce pointeur est nil s'il n'y a pas assez de
 * m‚moire.
 *)

var 	p 	: INSTRUCTION;

begin
	if maxavail < sizeof(RECORD_INSTRUCTION) then begin
		erreur_syntaxique := MANQUE_MEMOIRE;
		alloue_instruction := nil;
	end else begin
		new(p);
		alloue_instruction := p;
	end;
end;

function lit_if_then_else : INSTRUCTION;
(* Lit une instruction de type if then else, renvoie nil en cas de problŠme.
 *)

function if_then_else_instruction : INSTRUCTION;
(* Lit une instruction … l'interieur d'une construction if then else.  Cette
 * instruction peut ˆtre soit une instruction, ou un num‚ro de ligne, ce qui
 * ‚quivaut … un goto … cette ligne.  Renvoie nil en cas d'erreur.
 *)

var	t 		: TYPE_LEXEMES;
	numero_ligne	: word;
	p		: INSTRUCTION;

begin
	t := prend_lexeme;
	if t = LITERAL_ENTIER then begin
		if chaine_a_numero(lexeme, numero_ligne) then begin
			p := alloue_instruction;
			if p = nil then
				if_then_else_instruction := nil
			else begin
				p^.type_instruction := INSTRUCTION_GOTO;
				p^.numero_goto := numero_ligne;
				if_then_else_instruction := p;
			end;
		end else begin
			erreur_syntaxique := NUMERO_LIGNE_INCORRECT;
			if_then_else_instruction := nil;
		end;
	end else
		if_then_else_instruction := prend_instruction;
end;

var	l	: EXPRESSION_LOGIQUE;
	t	: TYPE_LEXEMES;
	p, q 	: INSTRUCTION;
	temp	: INSTRUCTION;

begin
	l := lit_expression_logique;
	if l = nil then begin
		lit_if_then_else := nil;
		exit;
	end;

	t := prend_lexeme;
	if t = MOT_CLE_THEN then
		p := if_then_else_instruction
	else begin
		detruit_expression_logique(l);
		erreur_syntaxique := ATTEND_THEN;
		lit_if_then_else := nil;
		exit;
	end;

	if p = nil then begin
		detruit_expression_logique(l);
		lit_if_then_else := nil;
		exit;
	end;

	t := prend_lexeme;
	if t <> MOT_CLE_ELSE then
		q := nil
	else begin
		q := if_then_else_instruction;
		if q = nil then begin
			detruit_expression_logique(l);
			detruit_instruction(p);
			lit_if_then_else := nil;
			exit;
		end;
	end;

	temp := alloue_instruction;
	if temp = nil then begin
		detruit_expression_logique(l);
		detruit_instruction(p);
		if q <> nil then
			detruit_instruction(q);
		lit_if_then_else := nil;
	end else begin
		temp^.type_instruction := INSTRUCTION_IF_THEN_ELSE;
		temp^.condition_if := l;
		temp^.instruction_then := p;
		temp^.instruction_else := q;
		lit_if_then_else := temp;
	end;
end;

function lit_gosub : INSTRUCTION;
(* Lit une instruction de type gosub, renvoie nil en cas de problŠme. *)

var 	t		: TYPE_LEXEMES;
	numero_ligne	: word;
	p		: INSTRUCTION;

begin
	t := prend_lexeme;
	if t = LITERAL_ENTIER then begin
		if chaine_a_numero(lexeme, numero_ligne) then begin
			p := alloue_instruction;
			if p = nil then
				lit_gosub := nil
			else begin
				p^.type_instruction := INSTRUCTION_GOSUB;
				p^.numero_gosub := numero_ligne;
				lit_gosub := p;
			end;
		end else begin
			erreur_syntaxique := NUMERO_LIGNE_INCORRECT;
			lit_gosub := nil;
		end;
	end else begin
		erreur_syntaxique := ATTEND_NUMERO_LIGNE;
		lit_gosub := nil;
	end;
end;

function lit_return : INSTRUCTION;
(* Lit une instruction de type return, renvoie nil en cas de problŠme.  Le
 * num‚ro de ligne de retour est ignor‚ mais l'analyseur syntaxique v‚rifie
 * quand mˆme qu'il est correct.
 *)

var	t		: TYPE_LEXEMES;
	numero_ligne	: word;
	p		: INSTRUCTION;

begin
	t := prend_lexeme;
	if (t = FIN_DE_LIGNE) or (t = COMMENTAIRE_APOSTROPHE) then
		remet_lexeme
	else if t = LITERAL_ENTIER then begin
		if not chaine_a_numero(lexeme, numero_ligne) then begin
			erreur_syntaxique := NUMERO_LIGNE_INCORRECT;
			lit_return := nil;
			exit;
		end;
	end else begin
		erreur_syntaxique := NUMERO_LIGNE_INCORRECT;
		lit_return := nil;
		exit;
	end;

	p := alloue_instruction;
	if p = nil then
		lit_return := nil
	else begin
		p^.type_instruction := INSTRUCTION_RETURN;
		lit_return := p;
	end;
end;

function lit_while : INSTRUCTION;
(* Lit une instruction de type while, renvoie nil en cas de problŠme. *)

var	l	: EXPRESSION_LOGIQUE;
	p	: INSTRUCTION;

begin
	l := lit_expression_logique;
	if l = nil then
		lit_while := nil
	else begin
		p := alloue_instruction;
		if p = nil then begin
			detruit_expression_logique(l);
			lit_while := nil;
		end else begin
			p^.type_instruction := INSTRUCTION_WHILE;
			p^.condition_while := l;
			lit_while := p;
		end;
	end;
end;

function lit_wend : INSTRUCTION;
(* Lit une instruction de type wend, renvoie nil en cas de problŠme. *)

var	p	: INSTRUCTION;

begin
	p := alloue_instruction;
	if p = nil then
		lit_wend := nil
	else begin
		p^.type_instruction := INSTRUCTION_WEND;
		lit_wend := p;
	end;
end;

function lit_for_to : INSTRUCTION;
(* Lit une instruction de type for to, renvoie nil en cas de problŠme.
 *)

var	t		: TYPE_LEXEMES;
	identificateur 	: string;
	type_donnee	: TYPE_DONNEES;
	a, b		: EXPRESSION_NUMERIQUE;
	p		: INSTRUCTION;

begin
	t := prend_lexeme;
	if (t <> IDENTIFICATEUR_ENTIER) and (t <> IDENTIFICATEUR_REEL) then
	begin
		erreur_syntaxique := ATTEND_VARIABLE_NUMERIQUE;
		lit_for_to := nil;
		exit;
	end;

	identificateur := lexeme;
	if t = IDENTIFICATEUR_ENTIER then
		type_donnee := TYPE_ENTIER
	else
		type_donnee := TYPE_REEL;

	t := prend_lexeme;
	if t <> OPERATEUR_EGAL then begin
		erreur_syntaxique := ATTEND_EGAL;
		lit_for_to := nil;
		exit;
	end;

	a := lit_expression_numerique;
	if a = nil then begin
		lit_for_to := nil;
		exit;
	end;

	t := prend_lexeme;
	if t <> MOT_CLE_TO then begin
		detruit_expression_numerique(a);
		erreur_syntaxique := ATTEND_TO;
		lit_for_to := nil;
		exit;
	end;

	b := lit_expression_numerique;
	if b = nil then begin
		detruit_expression_numerique(a);
		lit_for_to := nil;
		exit;
	end;

	p := alloue_instruction;
	if p = nil then begin
		detruit_expression_numerique(a);
		detruit_expression_numerique(b);
		lit_for_to := nil;
	end else begin
		p^.type_instruction := INSTRUCTION_FOR_TO;
		p^.identificateur_for := identificateur;
		p^.type_donnee := type_donnee;
		p^.expression_for := a;
		p^.expression_to := b;
		lit_for_to := p;
	end;
end;

function lit_next : INSTRUCTION;
(* Lit une instruction de type next, renvoie nil en cas de problŠme, la
 * variable de boucle est ignor‚, mais l'analyseur syntaxique fait toutefois
 * une v‚rification de grammaire.
 *)

var	t		: TYPE_LEXEMES;
	p		: INSTRUCTION;

begin
	t := prend_lexeme;
	if (t = FIN_DE_LIGNE) or (t = COMMENTAIRE_APOSTROPHE) then
		remet_lexeme
	else if (t <> IDENTIFICATEUR_ENTIER)
	and (t <> IDENTIFICATEUR_REEL) then begin
		erreur_syntaxique := ERREUR_DE_SYNTAXE;
		lit_next := nil;
		exit;
	end;

	p := alloue_instruction;
	if p = nil then
		lit_next := nil
	else begin
		p^.type_instruction := INSTRUCTION_NEXT;
		lit_next := p;
	end;
end;

function lit_goto : INSTRUCTION;
(* Lit une instruction de type goto, renvoie nil en cas de problŠme. *)

var 	t		: TYPE_LEXEMES;
	numero_ligne	: word;
	p		: INSTRUCTION;

begin
	t := prend_lexeme;
	if t = LITERAL_ENTIER then begin
		if chaine_a_numero(lexeme, numero_ligne) then begin
			p := alloue_instruction;
			if p = nil then
				lit_goto := nil
			else begin
				p^.type_instruction := INSTRUCTION_GOTO;
				p^.numero_goto := numero_ligne;
				lit_goto := p;
			end;
		end else begin
			erreur_syntaxique := NUMERO_LIGNE_INCORRECT;
			lit_goto := nil;
		end;
	end else begin
		erreur_syntaxique := ATTEND_NUMERO_LIGNE;
		lit_goto := nil;
	end;
end;

function lit_let : INSTRUCTION;
(* Lit une instruction de type let, renvoie nil en cas de problŠme. *)

var	t 			: TYPE_LEXEMES;
	identificateur		: string;
	type_affectation 	: TYPE_DONNEES;
	a			: EXPRESSION_NUMERIQUE;
	s			: EXPRESSION_CHAINE;
	p			: INSTRUCTION;

begin
	t := prend_lexeme;
	if (t <> IDENTIFICATEUR_ENTIER) and (t <> IDENTIFICATEUR_REEL)
	and (t <> IDENTIFICATEUR_CHAINE) then begin
		erreur_syntaxique := ATTEND_VARIABLE;
		lit_let := nil;
		exit;
	end;

	identificateur := lexeme;
	if t = IDENTIFICATEUR_ENTIER then
		type_affectation := TYPE_ENTIER
	else if t = IDENTIFICATEUR_REEL then
		type_affectation := TYPE_REEL
	else
		type_affectation := TYPE_CHAINE;

	t := prend_lexeme;
	if t <> OPERATEUR_EGAL then begin
		erreur_syntaxique := ATTEND_EGAL;
		lit_let := nil;
		exit;
	end;

	if type_affectation = TYPE_CHAINE then begin
		s := lit_expression_chaine;
		if s = nil then
			lit_let := nil
		else begin
			p := alloue_instruction;
			if p = nil then begin
				detruit_expression_chaine(s);
				lit_let := nil;
			end else begin
				p^.type_instruction := INSTRUCTION_LET;
				p^.identificateur_let := identificateur;
				p^.type_affectation := type_affectation;
				p^.chaine := s;
				lit_let := p;
			end;
		end;
	end else begin
		a := lit_expression_numerique;
		if a = nil then
			lit_let := nil
		else begin
			p := alloue_instruction;
			if p = nil then begin
				detruit_expression_numerique(a);
				lit_let := nil;
			end else begin
				p^.type_instruction := INSTRUCTION_LET;
				p^.identificateur_let := identificateur;
				p^.type_affectation := type_affectation;
				if type_affectation = TYPE_ENTIER then
					p^.entier := a
				else
					p^.reel := a;
				lit_let := p;
			end;
		end;
	end;
end;

function lit_end : INSTRUCTION;
(* Lit une instruction de type end, renvoie nil en cas de problŠme. *)

var	p 	: INSTRUCTION;

begin
	p := alloue_instruction;
	if p = nil then
		lit_end := nil
	else begin
		p^.type_instruction := INSTRUCTION_END;
		lit_end := p;
	end;
end;

function lit_rem : INSTRUCTION;
(* Lit une instruction de type rem, renvoie nil en cas de problŠme. *)

var	t	: TYPE_LEXEMES;
	p 	: INSTRUCTION;

begin
	repeat
		t := prend_lexeme;
	until (t = FIN_DE_LIGNE) or (t = ERREUR);

	if t = ERREUR then begin
		erreur_syntaxique := ERREUR_ANALYSEUR_LEXICAL;
		lit_rem := nil;
	end else begin
		p := alloue_instruction;
		if p = nil then
			lit_rem := nil
		else begin
			p^.type_instruction := INSTRUCTION_REM;
			lit_rem := p;
		end;
	end;
end;

function lit_input : INSTRUCTION;
(* Lit une instruction de type input, renvoie nil en cas de problŠme. *)

var     p	: INSTRUCTION;
	t	: TYPE_LEXEMES;

begin
	p := alloue_instruction;
	if p = nil then
		lit_input := nil
	else begin
		p^.type_instruction := INSTRUCTION_INPUT;
		t := prend_lexeme;
		case t of
			IDENTIFICATEUR_ENTIER : begin
				p^.identificateur_input := lexeme;
				p^.type_input := TYPE_ENTIER;
				lit_input := p;
			end;
			IDENTIFICATEUR_REEL : begin
				p^.identificateur_input := lexeme;
				p^.type_input := TYPE_REEL;
				lit_input := p;
			end;
			IDENTIFICATEUR_CHAINE : begin
				p^.identificateur_input := lexeme;
				p^.type_input := TYPE_CHAINE;
				lit_input := p;
			end;
		else
			detruit_instruction(p);
			erreur_syntaxique := ATTEND_VARIABLE;
			lit_input := nil;
		end;
	end;
end;

function lit_print : INSTRUCTION;
(* Lit une instruction de type print, renvoie nil en cas de problŠme, si
 * le paramŠtre donn‚ par le programme n'est pas de type chaine alors il est
 * consid‚r‚ num‚rique.
 *)

var	t	: TYPE_LEXEMES;
	a	: EXPRESSION_NUMERIQUE;
	s	: EXPRESSION_CHAINE;
	p	: INSTRUCTION;

begin
	t := prend_lexeme;
	if (t = LITERAL_CHAINE) or (t = IDENTIFICATEUR_CHAINE) then begin
		remet_lexeme;
		s := lit_expression_chaine;
		if s = nil then
			lit_print := nil
		else begin
			p := alloue_instruction;
			if p = nil then begin
				detruit_expression_numerique(a);
				lit_print := nil;
			end else begin
				p^.type_instruction := INSTRUCTION_PRINT;
				p^.type_print := TYPE_CHAINE;
				p^.chaine_print := s;
				lit_print := p;
			end;
		end;
	end else begin
		remet_lexeme;
		a := lit_expression_numerique;
		if a = nil then
			lit_print := nil
		else begin
			p := alloue_instruction;
			if p = nil then begin
				detruit_expression_numerique(a);
				lit_print := nil;
			end else begin
				p^.type_instruction := INSTRUCTION_PRINT;
				p^.type_print := TYPE_NUMERIQUE;
				p^.numerique_print := a;
				lit_print := p;
			end;
		end;
	end;
end;

var	t	: TYPE_LEXEMES;
	p	: INSTRUCTION;

begin
	t := prend_lexeme;
	if t = ERREUR then begin
		erreur_syntaxique := ERREUR_ANALYSEUR_LEXICAL;
		p := nil;
	end else if t = FIN_DE_LIGNE then begin
		erreur_syntaxique := INSTRUCTION_NUL;
		p := nil;
	end else begin
		case t of
			MOT_CLE_IF 		: p := lit_if_then_else;
			MOT_CLE_GOSUB 		: p := lit_gosub;
			MOT_CLE_RETURN  	: p := lit_return;
			MOT_CLE_WHILE 		: p := lit_while;
			MOT_CLE_WEND 		: p := lit_wend;
			MOT_CLE_FOR 		: p := lit_for_to;
			MOT_CLE_NEXT 		: p := lit_next;
			MOT_CLE_GOTO 		: p := lit_goto;
			MOT_CLE_LET 		: p := lit_let;
			IDENTIFICATEUR_ENTIER : begin
				remet_lexeme;
				p := lit_let;
			end;
			IDENTIFICATEUR_REEL : begin
				remet_lexeme;
				p := lit_let;
			end;
			IDENTIFICATEUR_CHAINE : begin
				remet_lexeme;
				p := lit_let;
			end;
			MOT_CLE_END 		: p := lit_end;
			MOT_CLE_REM 		: p := lit_rem;
			COMMENTAIRE_APOSTROPHE	: p := lit_rem;
			MOT_CLE_INPUT		: p := lit_input;
			MOT_CLE_PRINT		: p := lit_print;
		else
			erreur_syntaxique := ERREUR_DE_SYNTAXE;
			p := nil;
		end;
	end;
	prend_instruction := p;
end;

var	p 	: INSTRUCTION;
	t 	: TYPE_LEXEMES;

begin
	erreur_syntaxique := ANALYSEUR_SYNTAXIQUE_OKAY;

	t := prend_lexeme;	(* saute le num‚ro de ligne si n‚cessaire *)
	if t <> LITERAL_ENTIER then
		remet_lexeme;

	p := prend_instruction;
	if p = nil then
		lit_instruction := nil
	else begin
		t := prend_lexeme;
		if (t = FIN_DE_LIGNE) or (t = COMMENTAIRE_APOSTROPHE) then
			lit_instruction := p
		else begin
			erreur_syntaxique := CARACTERE_EN_TROP;
			detruit_instruction(p);
			lit_instruction := nil;
		end;
	end;
end;

procedure detruit_instruction (p : INSTRUCTION);
(* D‚truit, r‚cursivement si n‚cessaire, une instruction. *)

begin
	if p <> nil then begin
		case p^.type_instruction of
			INSTRUCTION_IF_THEN_ELSE : begin
				detruit_expression_logique(p^.condition_if);
				detruit_instruction(p^.instruction_then);
				detruit_instruction(p^.instruction_else);
			end;
			INSTRUCTION_WHILE :
				detruit_expression_logique(
					p^.condition_while);
			INSTRUCTION_FOR_TO : begin
				detruit_expression_numerique(
					p^.expression_for);
				detruit_expression_numerique(
					p^.expression_to);
			end;
			INSTRUCTION_LET :
				case p^.type_affectation of
					TYPE_ENTIER :
						detruit_expression_numerique(
							p^.entier);
					TYPE_REEL :
						detruit_expression_numerique(
							p^.reel);
					TYPE_CHAINE :
						detruit_expression_chaine(
							p^.chaine);
				end;
			INSTRUCTION_PRINT :
				case p^.type_print of
					TYPE_REEL :
						detruit_expression_numerique(
							p^.numerique_print);
					TYPE_CHAINE :
						detruit_expression_chaine(
							p^.chaine_print);
				end;
		end;
		dispose(p);
	end;
end;

end.

