Réaliser un interpréteur en Pascal

L'objectif de l'interpréteur est de partir d'une ligne écrite conformément aux règles du langage GVLOGO et d'exécuter les ordres qu'elle contient.

Il exige :

• un texte en entrée à découper en unités lexicales ;
• une boucle qui parcourt une à une ces unités pour exécuter le code en rapport avec elles ;

• une vérification de son état de sortie.

  Le cœur de l'interpréteur est par conséquent essentiellement une boucle.

  Les supports de son travail sont des piles et une queue :

• le texte à interpréter est placé sous forme d'unités lexicales dans la queue (Q1), autrement dit dans une file d'attente qui est lue jusqu'à épuisement ou jusqu'à la survenue d'une erreur ;

• une pile des données recueille les constantes (PD) ;

• une pile des commandes (PC) recueille les identificateurs des primitives et des procédures ;

• une pile des paramètres (PP) recueille le nombre de paramètres attendus pour chaque commande rencontrée ;

• une pile d'exécution (PE) recueille les données lorsqu'elles sont en nombre suffisant pour qu'une commande soit exécutée.

  C'est le premier caractère de chaque unité lexicale qui permet de savoir quel code doit être exécuté :

• " indique une constante de mot ;

• [ indique une liste ;

• : indique une variable ;

• + - 0..9 indiquent un nombre ;

• a..z A..Z indiquent une commande.

  Afin de faciliter la compréhension de l'interpréteur, on suppose qu'on ne doit interpréter que des primitives et des constantes numériques. On néglige le traitement des éventuelles erreurs.

  Soit donc la ligne de commande GVLOGO à interpréter :

  ECRIS SOMME 4 5

  L'interpréteur place tout d'abord cette ligne dans la file d'attente Q1 :

  Q1	PD	PC	PP	PE
  5
  4
  SOMME
  ECRIS

  La boucle d'interprétation commence alors.

  Le premier élément dans la queue est ECRIS.

  Traitement de ECRIS.

• ECRIScommence par une lettre.

• C'est donc une primitive.

• On cherche combien de paramètres elle attend (appel au noyau).

• La réponse est 1.

• On empile ECRISsur la pile PC.

• On empile 1 sur la pile PP.

• Comme le sommet de PP n'est pas nul, on en a fini avec cette unité.

  Q1	PD	PC	PP	PE
  5		ECRIS	1
  4
  SOMME

  L'élément suivant dans la queue est SOMME.

  Traitement de SOMME.

• SOMMEcommence par une lettre.

• C'est donc une primitive.

• On cherche combien de paramètres elle attend.

• La réponse est 2.

• On empile SOMMEsur la pile PC.

• On empile 2 sur la pile PP.

• Comme le sommet de PP n'est pas nul, on en a fini avec cette unité.

  Q1	PD	PC	PP	PE
  5		ECRIS	1
  4		SOMME	2

  L'élément suivant dans la queue est 4.

  Traitement de 4.

• 4commence par un chiffre.

• C'est donc un nombre.

• On empile 4sur la pile PD.

• Une donnée ayant été trouvée, on décrémente le sommet de la pile PP qui vaut à présent 1.

• Comme le sommet de PP n'est pas nul, on en a fini avec cette unité.

  Q1	PD	PC	PP	PE
  5	4	ECRIS	1
  		SOMME	1

  L'élément suivant dans la queue est 5.

  Traitement de 5.

• 5commence par un chiffre.

• C'est donc un nombre.

• On empile 5sur la pile PD.

• Une donnée ayant été trouvée, on décrémente le sommet de la pile PP qui vaut à présent 0.

  Q1	PD	PC	PP	PE
  	4	ECRIS	1
  	5	SOMME	0

• Comme le sommet de la pile vaut 0, on dépile ce 0 inutile. On sait à présent qu'on a assez de paramètres pour la primitive au sommet de PC : on transfère donc le nombre de paramètres attendus de PD vers PE, ce qui permet de les extraire dans l'ordre voulu. 4 et 5 sont sur PE.

  Q1	PD	PC	PP	PE
  		ECRIS	1	5
  		SOMME		4

• On dépile le sommet de PC et on récupère SOMME.

  Q1	PD	PC	PP	PE
  		ECRIS	1	5
  				4

• On exécute la méthode qui traite la commande SOMMEavec les paramètres 4 et 5qui sont dépilés.

  Q1	PD	PC	PP	PE
  		ECRIS	1

• La méthode appelée laisse le résultat 9 sur la pile PD.

  Q1	PD	PC	PP	PE
  	9	ECRIS	1

• Une donnée ayant été trouvée, on décrémente le sommet de la pile PP qui vaut à présent encore 0.

  Q1	PD	PC	PP	PE
  	9	ECRIS	0

• Comme le sommet de la pile vaut 0, on dépile ce 0 inutile. On sait par ailleurs qu'on a assez de paramètres pour la primitive au sommet de PC : on transfère donc le nombre de paramètres attendus de PD vers PE, ce qui permet de les extraire dans l'ordre voulu. 9 est donc sur PE.

  Q1	PD	PC	PP	PE
  		ECRIS		9

• On dépile le sommet de PC et récupère ECRIS.

• On exécute la méthode qui traite la commande ECRISavec le paramètre 9.

• La méthode ECRISaffiche 9 sans laisser de résultat sur la pile.

• Toutes les piles sont vides.

L'interpréteur est en situation d'attente.

On s'aperçoit qu'après le découpage du texte d'entrée en unités lexicales, le travail essentiel de l'interpréteur est de répartir, ajouter, transférer et supprimer correctement ces unités de plusieurs piles. Son mécanisme peut par conséquent être ramené à une série simple (et très répétitive !) d'actions sur le texte fourni en entrée. Les actions les plus complexes, celles qui renvoient au traitement à effectuer par une primitive, seront déléguées à des méthodes qui manipuleront elles-mêmes les piles d'exécution et de paramètres.

En ce qui concerne le découpage de la ligne d'entrée, les listes telles que définies dans l'unité GVLists sont à même de fournir les unités lexicales désirées.

Les piles sont disponibles dans l'unité GVStacks. La file d'attente sera prise en charge par une pile où les données seront stockées dans l'ordre inverse de la ligne fournie en entrée.

Le fichier inclus GVPrims.inc contiendra les méthodes en charge d'exécuter le code nécessaire au traitement des primitives.

L'unité GVAutomat contiendra les classes nécessaires à la mise en place de l'interpréteur. La plus importante est TGVAutomatqui constitue le cœur de l'interpréteur. Au cœur même de cette classe, on trouve la méthode Processqui boucle sur les éléments d'une ligne d'entrée.

Le schéma qui précède donne un aperçu du fonctionnement de l'interpréteur. L'interprétation est préparée par la méthode DoBegin, mise en œuvre par Processet terminée par DoEnd. Les 16 méthodes du processus sont décrites ci-après.

VI-B-1. Les structures utiles▲

  // *** description d'un espace d'interprétation ***
  TGVAutomatRec = record
    fNum: Integer; // élément en cours dans la ligne
    fItem: string; // donnée en cours
    fLine: string; // ligne en cours
    fPrim: string; // primitive en cours
    fProc: string; // procédure en cours
    fLevel: Integer; // niveau en cours
  end;

  // *** messages pour l'état de l'automate ***
  CStatesArray: array[TGVAutomatState] of string = 
   (MasWaiting, MasEnding, MasWorking, MasError, MasWord, MasList,
    MasVar,    MasNumber, MasEval, MasProc, MasPrim, MasPushing,
    MasStopped, MasExePrim,    MasExeProc, MasPreparing, MasProcDone,
    MasPrimDone, MasPrimStop, MasPrimValue,    MasFollowing,
    MasEndFollowing);

  // *** état de l'automate ***
  TGVAutomatState = (asWaiting, asEnding, asWorking, asError,
    asWord, asList, asVar, asNumber, asEval, asProc, asPrim,
    asPushing, asStopped, asExePrim, asExeProc, asPreparing,
    asProcDone, asPrimDone, asPrimStop, asPrimValue, asFollowing,
    asEndFollowing);

      fParamsStack: TGVIntegerStack; // pile des paramètres
      fDatasStack: TGVStringStack; // pile des données
      fCommandsStack: TGVStringStack; // pile des commandes
      fExeStack: TGVStringStack; // pile d'exécution
      fWkStack: TGVStringStack; // pile de travail

VI-B-2. DoBegin▲

function TGVAutomat.DoBegin(const St: string): Boolean;
// *** préparation de l'automate ***
var
  LL : TGVList;
  Li: Integer;
begin
  fWkRec.fItem := St; // élément analysé
  State := asPreparing; // état
  Result := False; // suppose une erreur
  if St = EmptyStr then // rien à traiter
    Exit; // on sort
  LL := TGVList.Create; // liste de travail créée
  try
    LL.Text := St; // affectation du texte à la liste
    if LL.IsValid then  // liste OK ?
    begin
      fWkStack.Push(CBreak); // marque de fin
      for Li := LL.Count downto 1 do // on empile à l'envers
        fWkStack.Push(LL[Li - 1]);
      fWkRec.fLine := St; // on conserve la ligne à analyser
      fWkRec.fNum := 0; // élément dans la ligne
      fElse := CDisabledState; // sinon désactivé
      fTest := CDisabledState; // test aussi
      Result := True; // tout est OK
    end
    else
      // [### Erreur: liste incorrecte ###]
      SetError(CE_BadList, St);
  finally
    LL.Free; // liste de travail libérée
  end;
end;

VI-B-3. Process▲

procedure TGVAutomat.Process(const St: string);
// *** lancement de l'automate d'interprétation ***
begin
  if DoBegin(St) then // préparation correcte ?
  begin
    State := asWorking; // état
    // on boucle si pile non vide, stop non demandé et pas d'erreur
    while not (fWkStack.IsEmpty or Stop or (not Error.Ok)) do
    begin
      fWkRec.fItem := fWkStack.Pop; // élément dépilé
      Inc(fWkRec.fNum); // numéro conservé
      case fWkRec.fItem[1] of // premier caractère déterminant
        CBreak: Break; // <========== fin de travail
        CQuote: DoWord; // <====== littéral
        CBeginList: DoList; // <====== liste
        CColon: DoVar; // <====== variable
        CPlus, CMinus, '0'..'9' : DoNumber; // <====== nombre
        'a'..'z','A'..'Z',CUnderline, CDot : DoCommand; // <====== commande
        CBeginPar: DoEval; // <====== valeur à évaluer
      end;
    end;
    DoEnd; // postparation
  end;
  State := asWaiting; // état
end;

VI-B-4. DoEnd▲

procedure TGVAutomat.DoEnd;
// *** postparation de l'automate ***
begin
  State := asEnding; // état
  // commandes en attente sans drapeau de valeur rendue, sans erreur et
  // sans arrêt ?
  if (not fReturnFlag) and (fCommandsStack.Count <> 0)
    and Error.Ok and (not Stop) then
  begin
    fWkRec.fItem := fCommandsStack.Pop; // on récupère la commande en suspens
    if fWkRec.fItem[1] = CLink then // une primitive ?
    begin
      fWkRec.fItem := Copy(fWkRec.fItem, 2, CMaxLengthPrim); // $ supprimé
      fWkRec.fPrim := fWkRec.fItem; // une primitive
    end
    else
      fWkRec.fProc := fWkRec.fItem; // une procédure
    // [### Erreur: pas assez de données ###]
    SetError(CE_NotEnoughDatas, fWkRec.fItem);
  end;
end;

VI-B-5. DoWord▲

procedure TGVAutomat.DoWord;
// *** traitement d'un mot ***
var
  LW: TGVWord;
begin
  State := asWord; // état
  LW := TGVWord.Create; // mot de travail créé
  try
    LW.Text := fWkRec.fItem; // normalisation du mot
    LW.Text := LW.WithoutQuote; // sans le "
    PushConst(LW.FmtText); // constante empilée
  finally
    LW.Free; // mot de travail libéré
  end;
end;

VI-B-6. DoList▲

procedure TGVAutomat.DoList;
// *** traitement d'une liste ***
begin
  State := asList; // état
  PushConst(fWkRec.fItem); // constante empilée
end;

VI-B-7. DoVar▲

procedure TGVAutomat.DoVar;
// *** traitement d'une variable ***
var
  LW: TGVWord;
begin
  State := asVar; // état
  LW := TGVWord.Create; // mot de travail créé
  try
    LW.Text := fWkRec.fItem; // nom analysé
    LW.Text := LW.WithoutColon; // : retiré
    if fLocVars.IsLocVar(LW.Text) then // variable locale ?
      PushConst(fLocVars.DirectValLocVar) // on empile sa valeur
    else
    if fKernel.IsVar(LW.Text) then // variable globale ?
      PushConst(fKernel.ValVar(LW.Text)) // on empile sa valeur
    else
      // [### Erreur: variable inconnue ###]
      SetError(CE_UnknownVar, LW.Text);
  finally
    LW.Free; // libération du mot de travail
  end;
end;

VI-B-8. DoNumber▲

procedure TGVAutomat.DoNumber;
// *** traitement d'un nombre ***
var
  LW: TGVWord;
begin
  State := asNumber; // état
  LW := TGVWord.Create; // mot de travail créé
  try
    LW.Text := fWkRec.fItem; // normalisation du mot
    if LW.IsNumber then // un nombre ?
      PushConst(LW.Text) // on empile la constante
    else
      // [### Erreur: nombre invalide ###]
      SetError(CE_BadNumber, LW.Text);
  finally
    LW.Free; // mot de travail libéré
  end;
end;

VI-B-9. DoEval▲

procedure TGVAutomat.DoEval;
// *** traitement d'une expression ***
begin
  State := asEval; // état
  fEval.Text := fWkRec.fItem; // on affecte à l'évaluateur
  fEVal.Scan; // on évalue
  if fEval.Error.Ok then  // pas d'erreur ?
    PushConst(FloatToStr(fEval.Res)); // valeur empilée
end;

VI-B-10. PushConst▲

procedure TGVAutomat.PushConst(const St: string);
// *** empilement d'une constante ***
begin
  fWkRec.fItem := St;
  State := asPushing; // état
  fDatasStack.Push(St); // on empile la constante
  if fReturnFlag then // si drapeau de valeur retournée
    Exit; // on sort
  // pas de paramètre ou pas de commande en attente ?
  if (fParamsStack.Count = 0) or
    ((fParamsStack.Peek > 0) and (fCommandsStack.Count = 0)) then
  begin
    fWkRec.fPrim := EmptyStr; // pas de primitive en cours
    // [### Erreur : que faire de ? ###]
    SetError(CE_WhatAbout, St);
  end
  else
  begin
    fParamsStack.Push(fParamsStack.Pop - 1); // un paramètre a été trouvé
    if (fParamsStack.Peek = 0) then // plus de paramètres en attente ?
      // on exécute la commande en attente
      ExeCommand;
  end;
end;

VI-B-11. DoCommand▲

procedure TGVAutomat.DoCommand;
// *** répartit les commandes ***
begin
  if fKernel.IsPrim(fWkRec.fItem) then // une primitive ?
    DoPrim // on la traite
  else
  if fKernel.IsProc(fWkRec.fItem) then // une procédure ?
    DoProc // on la traite
  else
    // [### Erreur: ni une primitive ni une procédure ###]
//     SetError(CE_NorPrimNorProc, fWkRec.fItem);
end;

VI-B-12. DoPrim▲

procedure TGVAutomat.DoPrim;
// *** traitement d'une primitive ***
var
  Li: Integer;
begin
  State := asPrim; // état
  // nombre de paramètres associés
  Li := fKernel.NumParamsPrim(fWkRec.fItem);
  fParamsStack.Push(Li); // on enregistre le nombre d'arguments attendus
  fParamsStack.Dup; // on double ce nombre
  // $ + nom de la primitive empilée
  fCommandsStack.Push(CLink + fWkRec.fItem);
  if Li = 0 then // pas de paramètres ?
    ExePrim; // exécute immédiatement la primitive
end;

VI-B-13. DoProc▲

procedure TGVAutomat.DoProc;
// *** traitement d'une procédure ***
var
  Li: Integer;
begin
  State := asProc; // état
  // nombre de paramètres associés
  Li := fKernel.ParamsCount(fWkRec.fItem);
  fParamsStack.Push(Li); // on enregistre le nombre d'arguments attendus
  fParamsStack.Dup; // on double ce nombre
  // nom de la procédure empilée
  fCommandsStack.Push(fWkRec.fItem);
  if Li = 0 then // pas de paramètres ?
    ExeProc; // exécute immédiatement la procédure
end;

VI-B-14. ExeCommand▲

procedure TGVAutomat.ExeCommand;
// *** exécution d'une commande ***
begin
  if fCommandsStack.Peek[1] = CLink then // $ ?
    ExePrim // c'est une primitive
  else
    ExeProc; // sinon une procédure
end;

VI-B-15. ExePrim▲

procedure TGVAutomat.ExePrim;
// *** exécution d'une primitive ***
var
  Li, LPrm: Integer;
  LW: TGVWord;
  LL: TGVList;
  LU: TGVListUtils;

  {$I Prims.inc}  // liste des méthodes pour les primitives

begin
  // nom de la primitive (sans le $)
  fWkRec.fPrim := Copy(fCommandsStack.Pop, 2, CMaxLengthPrim);
  State := asExePrim; // état
  try
    Li := fKernel.NumPrim(fWkRec.fPrim); // numéro retrouvé
    fParamsStack.Pop; // on libère les paramètres
    LPrm := fParamsStack.Pop; // nombre de paramètres de la primitive récupéré
    while LPrm <> 0 do // tant qu'il y a des paramètres
    begin
      // on empile les paramètres sur la pile d'exécution
      fExeStack.Push(fDatasStack.Pop);
      Dec(LPrm); // paramètre suivant
    end;
    LL := TGVList.Create; // liste de travail
    try
      LW := TGVWord.Create; // mot de travail
      try
        LU := TGVListUtils.Create; // utilitaire de travail
        try
          DoExePrim(Li); // exécution
        finally
          LU.Free; // libération de l'utilitaire de travail
        end;
      finally
        LW.Free; // libération du mot de travail
      end;
    finally
      LL.Free; // libération de la liste de travail
    end;
    Application.ProcessMessages; // permet l'affichage fluide
  finally
    State := asPrimDone; // état
  end;
end;

VI-B-16. DoExePrim▲

procedure DoExePrim(const N: Integer);
// *** exécution d'une primitive ***
begin
  // on exécute la primitive
  case N of
    1: DoPrimGVLogo; // GVLOGO
    2: DoPrimTopLevel; // NIVEAU.SUP
    3: DoPrimStop; // STOP
    4: DoPrimIf; // SI
    5: DoPrimReturn; // RENDS
    6: DoPrimWord; // MOT
    7: DoPrimRepeat; // REPETE
    9: DoPrimFor; // BOUCLE
    10: DoPrimAllProcsEdit; // EDITE.TOUT
    11: DoPrimLoadProcs; // CHARGE.PROCS
    12: DoPrimSaveProcs; // SAUVE.PROCS
    13, 243: DoPrimProcToEdit; // EDITE.PROC
    14: DoPrimParamLineProc;  // PARAMS.PROC
    15: DoPrimDefListProc; // DEF.PROC

VI-B-17. ExeProc▲

procedure TGVAutomat.ExeProc;
// *** exécution d'une procédure ***
var
  LPm, Li, Lj: Integer;
  LS: string;
  LL: TGVList;
  LOldProc: string;
begin
  LOldProc := fWkRec.fProc; // on conserve l'ancienne procédure
  Inc(fWkRec.fLevel); // niveau suivant
  fWkRec.fProc := fCommandsStack.Pop; // nom de la procédure en cours
  fWkRec.fItem := fWkRec.fProc; // élément en cours actualisé
  State := asExeProc; // état
  try
    fParamsStack.Pop; // on nettoie le sommet de la pile des paramètres
    LPm := fParamsStack.Pop; // nombre de paramètres récupéré
    fLocVars.AddLocNumber(LPm); // sauvegarde dans pile des variables locales
    // récupération des paramètres et création des variables locales
    if LPm <> 0 then // s'il y a des paramètres
      for Li := LPm downto 1 do // ordre inversé !
        with fKernel do
          // variables locales initialisées
          fLocVars.AddLocVar(ParamNum(fWkRec.fProc, Li), fDatasStack.Pop);

    // récupération des lignes de la procédure
    LL := TGVList.Create;
    try
      LS := EmptyStr; // définition vide
      // balayage des lignes de la procédure
      for Li := 1 to fKernel.ProcLinesCount(fWkRec.fProc) do
      begin
        if not Stop then
        begin
          // texte de la ligne en cours
          LL.Text := fKernel.ProcLine(fWkRec.fProc, Li);
          for Lj := 1 to LL.Count do // on balaie la ligne
            if Trim(LL[Lj - 1]) <> CComment then // commentaire ?
              LS := LS + CBlank + LL[Lj - 1]
            else
              Break; // on sort si commentaire
        end;
      end;
      // exécution de la procédure
      Process(CBeginList + LS + CEndList);
    finally
      LL.Free; // libération de la liste
    end;

    if fLocVars.LocVarsCount > 0 then // s'il y a des variables en suspens
      fLocVars.DelLastGroup; // variables locales supprimées
    if fReturnFlag then // valeur en attente ?
    begin
      fReturnFlag := False; // drapeau baissé
      PushConst(fReturnVal); // valeur empilée
    end;
  finally
    State := asProcDone; // état
    Dec(fWkRec.fLevel); // niveau précédent
    fWkRec.fProc := LOldProc; // récupération de l'ancienne procédure
  end;
end;

VI-C-1. Utilitaires▲

function IsList: Boolean;
// *** est-ce une liste ? ***
begin
  Result := (fWkRec.fItem <> EmptyStr) and (fWkRec.fItem[1] = CBeginList);
end;

procedure AData;
// *** dépile et normalise un mot ***
begin
  fWkRec.fItem := fExeStack.Pop; // donnée dépilée
  LW.Text := fWkRec.fItem; // mot normalisé
end;

function IsListPop: Boolean;
// *** dépilement et test si liste ***
begin
  AData; // donnée dépilée
  Result := IsList; // test
end;

VI-C-2. La classe TGVAutomatMessage▲

type
  // *** message de l'automate ***
  TGVAutomatMessage = class(TObject)
    strict private
      fCmd: TGVAutomatCmd; // commande en cours
      fMessage: string; // message associé
      fOnChange: TNotifyEvent;
      procedure SetCmd(AValue: TGVAutomatCmd);
      procedure SetMessage(AValue: string);
    protected
      procedure Change; // changement notifié
    public
      constructor Create; // création
      destructor Destroy; override; // destructeur
      procedure Clear; // nettoyage
      // données regroupées
      procedure SetMessageAll(const ACmd: TGVAutomatCmd; AMess: string);
      // message
      property Message: string read fMessage write SetMessage;
      //commande
      property Cmd: TGVAutomatCmd read fCmd write SetCmd default acNone;
      // gestionnaire de changement
      property OnMessageChange: TNotifyEvent read fOnChange write fOnChange;
  end;

  // *** commandes de l'interpréteur ***
  TGVAutomatCmd = (acNone, acClear, acWrite, acType, acReadList, acReadChar,
    acConfirm, acBold, acUnderline, acItalic, acNoBold, acNoUnderline,
    acNoItalic, acColor, acSetColor, acBackColor, acSetBackColor,
    acSetFontSize, acFontSize, acSetFont, acFont, acWriteEdit);

procedure DoPrimWrite;
// *** ECRIS ***
begin
  if IsListPop then // liste ?
    fWkRec.fItem := LU.ListToStr(fWkRec.fItem); // on enlève les crochets
  LW.Text := fWkRec.fItem; // mot normalisé
  fWkRec.fItem := LW.Text; // sans les caractères d'échappement
  if fTurtleOutput then  // écran de la tortue ?
    fTurtle.Text(fWkRec.fItem)
  else
    Message.SetMessageAll(acWrite, fWkRec.fItem);
end;

procedure TMainForm.GetMessage(Sender: TObject);
// gestionnaire des messages
begin
  case Automat.Message.Cmd of
    // écriture
    acWrite: mmoMain.Lines.Add(Automat.Message.Message);
    // nettoyage
    acClear: mmoMain.Lines.Clear;
    // lecture d'une liste
    acReadList: Automat.Message.Message := InputBox('TestGVAutomat',
    'Entrez la valeur demandée ici :', EmptyStr);
    // demande de confirmation
    acConfirm: if MessageDlg(Automat.Message.Message , mtConfirmation,
      mbYesNo, 0) = mrYes then
        Automat.Message.Message := CStTrue // vrai en retour
      else
        Automat.Message.Message := CStFalse; // faux en retour

VI-C-3. Deux primitives ordinaires… et une troisième un peu moins▲

procedure DoPrimForward;
// *** AVANCE AV ***
begin
  AData; // un mot attendu
  if LW.IsNumber then
   fTurtle.Move(LW.AsNumber)
  else
    // [### Erreur: nombre incorrect ###]
    SetError(CE_BadNumber, LW.Text);
end;

procedure DoPrimRandom;
// *** HASARD ***
begin
  if IsListPop then  // une liste ?
  begin
    LL.Text := fWkRec.fItem; // on l'analyse
    PushConst(LL.AtRandom); // on renvoie un élément au hasard
  end
  else
  begin
    LW.Text := fWkRec.fItem; // mot normalisé
    if LW.IsInt then
      PushConst(IntToStr(Random(LW.AsInt) + 1)) // nombre au hasard
    else
      PushConst(LW.Atrandom); // on renvoie un caractère au hasard
  end;
end;

procedure DoPrimExec;
// *** EXEC EXECUTE ***
var
  Li: Integer;
begin
  if IsListPop then // une liste ?
  begin
    if fWkRec.fItem <> CEmptyList then // liste vide ?
    begin
      LL.Text := fWkRec.fItem; // on l'analyse
      if LL.IsValid then // liste valide ?
      begin
        for Li := LL.Count downto 1 do // on balaie cette liste à rebours
          // on empile l'élément dans la liste de travail
          fWkStack.Push(LL[Li - 1]);
      end
      else
        // [### Erreur: liste incorrecte ###]
        SetError(CE_BadList, fWkRec.fItem);
    end
    else
      Exit; // on sort
  end
  else
    // [### Erreur: pas une liste ###]
    SetError(CE_UnknownList, fWkRec.fItem);
end;

VI-C-4. Le programme de test de l'unité GVAutomat▲

procedure TMainForm.FormCreate(Sender: TObject);
// création de la fiche
begin
  Automat := TGVAutomat.Create; // automate créé
  Automat.OnStateChange := @GetStateChange; // état changé
  Automat.Error.OnError := @GetError; // gestionnaire d'erreurs
  Automat.Message.OnMessageChange := @GetMessage; // gestionnaire de messages
  Automat.Follow := False; // pas de trace par défaut
  fDeepTrace := False;
  // on crée la tortue
  GVTurtle := TGVTurtle.Create(imgTurtle.Width, imgTurtle.Height);
  Automat.Turtle := GVTurtle; // tortue liée à l'automate
  GVTurtle.OnChange := @TurtleState;  // gestionnaire de changement
  GVTurtle.OnBeforeChange := @TurtleBeforePaint; // idem avant de dessiner
  GVTurtle.Error.OnError := @GetError; // gestionnaire d'erreurs
  GVTurtle.ReInit; // initialisation
  GVTurtle.Kind := tkPng; // tortue image
end;