Suche Home Einstellungen Anmelden Hilfe

program parser; (*version 2 - MT *)   uses crt;
(* In diesem BruteForce-Ansatz wird vorausgesetzt,
dass die Grundterme als Integerzeichen
codiert in einer Datei vorliegen (ohne LineFeed):
1..9 sind codiert als 1..9
mono, di, .. sind codiert als 11,12,..
meth, et, .. sind codiert als 101,102,..
ane als 201, yl als 202, , als 500, - als 501 *)

var Token:integer;
    Tokenfolge:file of integer;
    FileKopf:integer;

(* Deklarationen *)
procedure Number; forward;
procedure X; forward;
procedure POS; forward;
procedure BNT; forward;
procedure Substituent; forward;
procedure SUAC_Radical; forward;
procedure SUAC; forward;
procedure Prefix; forward;
procedure MainChain; forward;
procedure Formula; forward;

procedure LiesFile; forward;
procedure OeffneDatei; forward;
procedure Syntaxfehler; forward;

(* Prozeduren *)
procedure Number;
begin
  write('Number');
  LiesFile;(* 1,2,... *)
  case Filekopf of
  1..6 : writeln(Filekopf);
  else Syntaxfehler; end;
end;

procedure X;
begin
  write('X');
  if Filekopf=500 then
  begin
    LiesFile; (* , *)
    Number;
    X;
  end else
  begin
    (* epsilon *)
  end;
end;

procedure POS;
begin
  write('Pos');
  Number;
  X;
end;

procedure BNT;
begin
  write('BNT');
  LiesFile; (* mono, di, *)
  case Filekopf of
  11..16:;
  else Syntaxfehler; end;
end;

procedure Substituent;
begin
  write('Substituent');
  BNT;
  SUAC_Radical;
end;

procedure SUAC_Radical;
begin
  write('SUAC_Radical');
  SUAC;
  LiesFile; (* yl *)
  if Filekopf<>202 then Syntaxfehler;
end;

procedure SUAC;
begin
  write('SUAC');
  LiesFile;(* meth bis hex *)
  case Filekopf of
  101..106: ;
  else Syntaxfehler; end;
end;

procedure Prefix;
begin
  write('Prefix');
  case Filekopf of
  1..6: begin Pos;
              LiesFile;  (* -  *)
              if Filekopf<>501 then Syntaxfehler;
              Substituent;
        end
  else Substituent; end;
end;

procedure MainChain;
begin
  write('MainChain');
  SUAC;
  LiesFile; (* ane *)
  if Filekopf<>201 then Syntaxfehler;
end;

procedure Formula;
begin
  write('Formula');
  case Filekopf of
   1..6,11..20: begin Prefix; MainChain; end;
   101..106 : MainChain;
   else Syntaxfehler; end;
end;

(* Hilfsoperationen *)
procedure LiesFile;
begin
  writeln(Filekopf);
  if eof(Tokenfolge) or (Filekopf = 0) then Syntaxfehler;
  Read(Tokenfolge,Filekopf);
end;

procedure oeffnedatei;
begin
  Assign(Tokenfolge, 'Tokenfolge.dat');
  Reset(Tokenfolge);
end;

procedure syntaxfehler;
begin
  writeln('Syntaxfehler um ',filepos(Tokenfolge),'. Token');
  close(Tokenfolge);
  readln;
  halt;
end;

(* Main *)
begin
  clrscr;
  oeffnedatei;
  Filekopf:=0;
  LiesFile;
  Formula;
  writeln(Filekopf);
  readln;
end.

Benutzer: Gast • Besitzer: mthomas • Zuletzt geändert am: