fork download
copy 
  1. program LexicalAnalysis;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. uses
  6.   SysUtils;
  7.  
  8. var
  9.   Lines: array of string;
  10.   Row, Col: Integer;
  11.   ErrorFound: Boolean;
  12.  
  13.  
  14. procedure ShowError;
  15. begin
  16.   Writeln('ERROR: invalid word at line ',
  17.           Row, ', position ', Col);
  18.   ErrorFound := True;
  19. end;
  20.  
  21.  
  22. function CheckFirstWord(var S: string; var P: Integer): Boolean;
  23. var
  24.   StartPos: Integer;
  25. begin
  26.   Result := False;
  27.   StartPos := P;
  28.  
  29.   { (000)* }
  30.  
  31.   while (P + 2 <= Length(S)) and
  32.         (S[P] = '0') and
  33.         (S[P + 1] = '0') and
  34.         (S[P + 2] = '0') do
  35.   begin
  36.     P := P + 3;
  37.   end;
  38.  
  39.   { 001 }
  40.  
  41.   if (P + 2 > Length(S)) or
  42.      (S[P] <> '0') or
  43.      (S[P + 1] <> '0') or
  44.      (S[P + 2] <> '1') then
  45.   begin
  46.     P := StartPos;
  47.     Exit;
  48.   end;
  49.  
  50.   P := P + 3;
  51.  
  52.   { (010)* }
  53.  
  54.   while (P + 2 <= Length(S)) and
  55.         (S[P] = '0') and
  56.         (S[P + 1] = '1') and
  57.         (S[P + 2] = '0') do
  58.   begin
  59.     P := P + 3;
  60.   end;
  61.  
  62.   Result := True;
  63. end;
  64.  
  65.  
  66. function CheckSecondWord(var S: string; var P: Integer): Boolean;
  67. begin
  68.   Result := False;
  69.  
  70.   { First two symbols must be ab }
  71.  
  72.   if (P + 1 > Length(S)) or
  73.      (S[P] <> 'a') or
  74.      (S[P + 1] <> 'b') then
  75.     Exit;
  76.  
  77.   P := P + 2;
  78.  
  79.   { After ab: a,b,c,d }
  80.  
  81.   while (P <= Length(S)) and
  82.         (S[P] in ['a', 'b', 'c', 'd']) do
  83.   begin
  84.     P := P + 1;
  85.   end;
  86.  
  87.   Result := True;
  88. end;
  89.  
  90.  
  91. procedure SkipComment(var S: string; var P: Integer);
  92. begin
  93.   { Skip apostrophe }
  94.  
  95.   P := P + 1;
  96.  
  97.   { Skip comment to end of line }
  98.  
  99.   while P <= Length(S) do
  100.     P := P + 1;
  101. end;
  102.  
  103.  
  104. procedure AnalyzeLine(var S: string; LineNumber: Integer);
  105. var
  106.   P: Integer;
  107.   OldP: Integer;
  108.   TokenFound: Boolean;
  109. begin
  110.   P := 1;
  111.  
  112.   while P <= Length(S) do
  113.   begin
  114.  
  115.     { Skip spaces }
  116.  
  117.     while (P <= Length(S)) and
  118.           (S[P] = ' ') do
  119.       P := P + 1;
  120.  
  121.     if P > Length(S) then
  122.       Break;
  123.  
  124.  
  125.     { Comment }
  126.  
  127.     if S[P] = '''' then
  128.     begin
  129.       SkipComment(S, P);
  130.       Break;
  131.     end;
  132.  
  133.  
  134.     OldP := P;
  135.     TokenFound := False;
  136.  
  137.  
  138.     { First word }
  139.  
  140.     if S[P] = '0' then
  141.     begin
  142.       if CheckFirstWord(S, P) then
  143.         TokenFound := True;
  144.     end
  145.  
  146.  
  147.     { Second word }
  148.  
  149.     else if S[P] = 'a' then
  150.     begin
  151.       if CheckSecondWord(S, P) then
  152.         TokenFound := True;
  153.     end;
  154.  
  155.  
  156.     { Invalid word }
  157.  
  158.     if not TokenFound then
  159.     begin
  160.       Row := LineNumber;
  161.       Col := OldP;
  162.       ShowError;
  163.       Exit;
  164.     end;
  165.  
  166.  
  167.     { Check separator }
  168.  
  169.     if (P <= Length(S)) and
  170.        not (S[P] in [' ', '''']) then
  171.     begin
  172.       Row := LineNumber;
  173.       Col := P;
  174.       ShowError;
  175.       Exit;
  176.     end;
  177.  
  178.   end;
  179. end;
  180.  
  181.  
  182. var
  183.   N, I: Integer;
  184.  
  185. begin
  186.  
  187.   Writeln('==============================================');
  188.   Writeln('           LEXICAL ANALYZER');
  189.   Writeln('                 VARIANT 34');
  190.   Writeln('==============================================');
  191.   Writeln;
  192.  
  193.   Writeln('WORD 1: (000)*001(010)*');
  194.   Writeln('WORD 2: ab(a|b|c|d)*');
  195.   Writeln('COMMENT: apostrophe to end of line');
  196.   Writeln;
  197.  
  198.  
  199.   Write('Enter number of lines: ');
  200.   ReadLn(N);
  201.  
  202.   SetLength(Lines, N);
  203.  
  204.   Writeln;
  205.   Writeln('Enter text:');
  206.  
  207.   for I := 1 to N do
  208.     ReadLn(Lines[I - 1]);
  209.  
  210.  
  211.   ErrorFound := False;
  212.  
  213.  
  214.   for I := 1 to N do
  215.   begin
  216.     AnalyzeLine(Lines[I - 1], I);
  217.  
  218.     if ErrorFound then
  219.       Break;
  220.   end;
  221.  
  222.  
  223.   Writeln;
  224.  
  225.   if not ErrorFound then
  226.     Writeln('No errors found.');
  227.  
  228.  
  229.   Writeln;
  230.   Writeln('Press Enter to exit.');
  231.   ReadLn;
  232.  
  233. end.
Success #stdin #stdout 0s 5320KB
comments (?)
stdin
copy 
7 21
1 2 547152
1 3 509157
1 4 539282
1 5 541645         
1 6 458433
1 7 385173

2 3 131528
2 4 92735
2 5 150511
2 6 94440
2 7 194542
3 4 216600
3 5 272401
3 6 157176
3 7 124077
4 5 57785
4 6 97323
4 7 242232
5 6 136663
5 7 283862
6 7 147426
stdout
copy 
==============================================
           LEXICAL ANALYZER
                 VARIANT 34
==============================================

WORD 1: (000)*001(010)*
WORD 2: ab(a|b|c|d)*
COMMENT: apostrophe to end of line

Enter number of lines: 
Enter text:
ERROR: invalid word at line 1, position 1


Press Enter to exit.
https://ideone.com/isO0dx
language:
Pascal (fpc 3.0.4)
created:
2 hours ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!