unit uLexer;

{**********************************************************************}
{*                                                                    *}
{*    M I N I C O M P - 1                                             *}
{*                                                                    *}
{*    Version 1 des Minicompiler-Projekts                             *}
{*                                                                    *}
{*    MODUL 1: Lexikalische Analyse                                   *}
{*                                                                    *}
{*    Das Programm stellt einen einfachen Lexer zur Verfuegung        *}
{*                                                                    *}
{*    Abhaengigkeiten:                                                *}
{*    ---------------                                                 *}
{*    Die Unit wird von uParser.Pas benoetigt.                        *}
{*                                                                    *}
{*    (C) U. Helmich 10.2.91                                          *}
{*                                                                    *}
{*    erste lauffähige Version   am 10.02.91                          *}
{*    grundlegend  ueberarbeitet am 12.08.92                          *}
{*    grundlegend  ueberarbeitet am 01.03.95                          *}
{*    zuletzt bearbeitet         am 13.03.95                          *}
{*    grundlegend  ueberarbeitet am 13.03.96                          *}
{*    nicht weiter veraendert    am 11.05.97                          *}
{*    nicht weiter veraendert    am 21.02.98                          *}
{*    Delphi-Version erstellt    am 24.05.03                          *}
{*                                                                    *}
{**********************************************************************}

interface
uses stdctrls;

{------------------------------------------------------------------------}
{ Ein einzelnes Token                                                    }
{------------------------------------------------------------------------}

type tTokentype = (ID, NUM, ADDOP, MULOP, ASSOP, SEMI, OPBR, CLBR, LEXERROR);

     tToken     = record
                    tokentype : tTokentype; {der jeweilige Tokentyp, z.B. NUM }
                    strattr   : string;     {das String-Attribut des Tokens   }
                    numattr   : real;       {das Zahlen-Attribut des Tokens   }
                  end;

{------------------------------------------------------------------------}
{ Eine Hilfsroutine für die Fehlerausgabe des Parsers                    }
{------------------------------------------------------------------------}

function  TokenToStr(t : tTokentype) : string;


{------------------------------------------------------------------------}
{ Die Klasse TLexer                                                      }
{------------------------------------------------------------------------}

type

TLexer = class
            constructor Init(str : string; m : TMemo);
            procedure GetNext(var l : tToken);

         private
            look    : tToken;
            s       : string;
            memo    : TMemo;

            procedure WriteError(s : string);
         end;


implementation

function TokenToStr(t : tTokentype) : string;
begin
   case t of
      ID      : result := 'id';
      NUM     : result := 'num';
      ADDOP   : result := 'addop';
      MULOP   : result := 'mulop';
      ASSOP   : result := ':=';
      SEMI    : result := ';';
      OPBR    : result := '(';
      CLBR    : result := ')';
      LEXERROR: result := 'error';
   end;
end;


constructor TLexer.Init(str : string; m : TMemo);
{  Initialisierung des Zeilenlexers;
   Aufbereitung der zu analysierenden Zeile
}
   begin
      s := str;

    { Leerzeichen beseitigen }
      while pos(' ',s) > 0 do delete(s,pos(' ',s),1);

      memo := m;
   end;

procedure TLexer.WriteError(s : string);
{  Hilfsprozedur, die den String s in die Memobox schreibt
   Fehlererkennung funktioniert leider noch nicht 100%ig!!!
}
   begin
      memo.Lines.Add(s);
   end;


procedure tLexer.GetNext(var l : tToken);
{  Hauptroutine des Objekts.
   Aus dem bei "Init" uebergebenen String wird das naechste Token
   herausgeholt.
   Das Ergebnis wird in der Objektvariable "look" gespeichert.
   Der zu analysierende String wird veraendert!
}

   procedure ReadId;
   {  Determinierter endlicher Automat zur Erkennung von Bezeichnern.
      Erkannt werden normale Pascal-Bezeichner.
   }
      var e,i   : integer;
          state : integer;
          c     : char;


      begin
         i              := 0;
         state          := 1;
         look.tokentype := ID;

         repeat
            inc(i);
            c := s[i];
            case state of
               1 : if c in ['A'..'Z','a'..'z']
                      then state := 2
                      else state := 99;
               2 : if c in ['0'..'9','A'..'Z','a'..'z']
                      then state := 2
                   else if c in ['+','-','*','/',')',' ',';']
                      then state := 3  // erweiterter Endzustand
                   else state := 99;   // Fehlerzustand
            end;
         until (state = 3) or (state = 99);

         if state = 3 then begin
         {  Endposition des Bezeichners suchen }
            e := i;

         {  Kopier- und Loeschaktion }
            look.strattr := copy(s,1,e-1);
            delete(s,1,e-1);
         end
         else if state = 99
            then begin
               look.tokentype := LexError;
               look.strattr   := 'Fehler in Bezeichner';
               WriteError('lex. Fehler beim Erkennen eines Bezeichners');
            end;
      end;



   procedure ReadNum;
   {  Determinierter endlicher Automat zur Erkennung von Real-Zahlen.
   }
      var i,state,contr : integer;
          c             : char;
          r             : real;

      begin
         i              := 0;
         state          := 0;

         repeat
            inc(i);
            c := s[i];
            case state of
               0 : if c in ['0'..'9']
                      then state := 1
                      else state := 99; // Fehlerzustand
               1 : if c in ['0'..'9']
                      then state := 1
                   else if c = '.'
                      then state := 2
                   else if c in ['+','-','*','/',')',' ',';']
                      then state := 4  // erweiterter Endzustand
                      else state := 99;
               2 : if c in ['0'..'9']
                      then state := 3
                      else state := 99;
               3 : if c in ['0'..'9']
                      then state := 3
                   else if c in ['+','-','*','/',')',' ',';']
                      then state := 4
                      else state := 99;
            end;
         until (state = 4) or (state = 99);

         if state = 99 then begin  // Fehler
            look.tokentype := LexError;
            look.strattr   := 'Fehler in Zahl';
            WriteError('lex. Fehler beim Erkennen einer Zahl');
         end else begin  // Endzustand
            look.tokentype := NUM;             // Tokentyp ermitteln
            val(copy(s,1,i-1),r,contr);        // Attribut ermitteln
            if contr = 0
               then begin
                  delete(s,1,i-1);
                  look.numattr := r;
               end
               else look.numattr := 0;
         end;
      end;



   procedure ReadNumOp;
   {  Kein Automat, einfache Erkennung des arithmetischen Operators
   }
      begin
         case s[1] of
            '+','-' : look.tokentype := AddOp;
            '*','/' : look.tokentype := MulOp;
         end;
         look.strattr := s[1];
         delete(s,1,1);
      end;

   procedure ReadMisc;
   {  Kein Automat, einfache Erkennung der anderen Zeichen
   }
      begin
         if s[1] = ';' then begin          // Semikolon
            look.tokentype := semi;
            delete(s,1,1);
         end else

         if s[1] = '(' then begin          // offene Klammer
            look.tokentype := opbr;
            delete(s,1,1);
         end else

         if s[1] = ')' then begin          // geschlossene Klammer
            look.tokentype := clbr;
            delete(s,1,1);
         end else

         if s[1] = ':' then begin          // Zusweisungsoperator
            if s[2] = '=' then begin
               look.tokentype := assop;
               delete(s,1,2);
            end
            else begin
               look.tokentype := Lexerror;
               look.strattr   := 'Fehler im Zuweisungsoperator';
               WriteError('lex. Fehler im Zuweisungsoperator');
            end;
         end

      end;

   // Haupterkennungsroutine; hier werden die einzelnen Automaten bzw.
   // Prozeduren aufgerufen

   begin
      look.tokentype := Lexerror;
      look.strattr   := '';
      look.numattr   := 0;
      case s[1] of
         'A'..'Z',
         'a'..'z' : ReadId;
         '0'..'9' : ReadNum;
         '+','-',
         '*','/'  : ReadNumOp;
         else       ReadMisc;
      end;
      l := look;
   end;


begin
end.