Ignore:
Timestamp:
Feb 2, 2017, 7:49:02 AM (8 years ago)
Author:
chronos
Message:
  • Modified: Improved parsing of delphi code.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/interpreter/project3.lpr

    r95 r96  
    11program project3;
    22
    3 type
    4   TTokenType = (ttNormal, ttSpecialSymbol, ttString, ttConstant);
    5 var
    6   InputText: string;
    7   InputTextPos: Integer;
    8   LastTokenType: TTokenType;
     3{$mode delphi}
    94
    10 function IsWhiteSpace(C: Char): Boolean;
    11 begin
    12   Result := (C = ' ') or (C = #13) or (C = #10) or (C = #9);
    13 end;
    14 
    15 function IsSpecialSymbol(C: Char): Boolean;
    16 begin
    17   Result := (C = ';') or (C = '(') or (C = ')') or (C = ':') or (C = '=') or
    18     (C = '+') or (C = '-');
    19 end;
    20 
    21 function IsSpecialSymbolLong(Text: string): Boolean;
    22 begin
    23   Result := (Text = ':=') or (Text = '<>') or (Text = '>=') or (Text = '<=');
    24 end;
    25 
    26 procedure ShowError(Text: string);
    27 begin
    28   WriteLn(Text);
    29   Halt;
    30 end;
    31 
    32 procedure ReadInputAll;
    33 var
    34   C: Char;
    35 begin
    36   InputTextPos := 1;
    37   InputText := '';
    38   while not Eof do begin
    39     Read(C);
    40     InputText := InputText + C;
    41   end;
    42 end;
    43 
    44 function ReadChar: Char;
    45 begin
    46   if InputTextPos >= Length(InputText) then ShowError('Premature end of source');
    47   Result := InputText[InputTextPos];
    48   InputTextPos := InputTextPos + 1;
    49 end;
    50 
    51 function ReadNext: string;
    52 var
    53   C: Char;
    54   IsString: Boolean;
    55 begin
    56   Result := '';
    57   IsString := False;
    58   LastTokenType := ttNormal;
    59   repeat
    60     C := ReadChar;
    61     if IsString then begin
    62       if C = '''' then begin
    63         Break;
    64       end else Result := Result + C;
    65     end else begin
    66       if IsWhiteSpace(C) then begin
    67         if Result = '' then Continue
    68           else begin
    69             Break;
    70           end;
    71       end else
    72       if IsSpecialSymbol(C) then begin
    73         if Result = '' then begin
    74           LastTokenType := ttSpecialSymbol;
    75           Result := Result + C;
    76           C := ReadChar;
    77           if IsSpecialSymbolLong(Result + C) then begin
    78             Result := Result + C;
    79             Break;
    80           end else InputTextPos := InputTextPos - 1;
    81           Break;
    82         end else begin
    83           InputTextPos := InputTextPos - 1;
    84           Break;
    85         end;
    86       end else
    87       if C = '''' then begin
    88         LastTokenType := ttString;
    89         IsString := True;
    90       end else begin
    91         Result := Result + C;
    92       end;
    93     end;
    94   until False;
    95 end;
    96 
    97 function CheckNext(Text: string): Boolean;
    98 var
    99   Next: string;
    100   OldPos: Integer;
    101 begin
    102   OldPos := InputTextPos;
    103   Next := ReadNext;
    104   Result := Next = Text;
    105   InputTextPos := OldPos;
    106 end;
    107 
    108 procedure Expect(Text: string);
    109 var
    110   Next: string;
    111 begin
    112   Next := ReadNext;
    113   if Next <> Text then
    114     ShowError('Expected ' + Text + ' but found ' + Next);
    115 end;
    116 
    117 function IsVariable(Text: string): Boolean;
    118 begin
    119   Result := (Text = 'Result') or (Text = 'Text') or (Text = 'C');
    120 end;
    121 
    122 function IsLogicOperator(Text: string): Boolean;
    123 begin
    124   Result := (Text = 'or') or (Text = 'and');
    125 end;
    126 
    127 function IsOperator(Text: string): Boolean;
    128 begin
    129   Result := (Text = '=') or (Text = '<>') or (Text = '>') or (Text = '<') or
    130     (Text = '<=') or (Text = '>=');
    131 end;
    132 
    133 function ParseExpression: Boolean;
    134 var
    135   Next: string;
    136   OldPos: Integer;
    137   R: Boolean;
    138 begin
    139   Result := True;
    140   Next := ReadNext;
    141   if Next = '(' then begin
    142     R := ParseExpression;
    143     Expect(')');
    144   end else
    145   if IsVariable(Next) then begin
    146     Next := ReadNext;
    147     if IsOperator(Next) then begin
    148       Next := ReadNext;
    149       //if IsVariable(Next) then begin
    150 
    151       //end else ShowError('Expected variable');
    152     end else ShowError('Exprected operator but found ' + ReadNext);
    153   end else
    154   ShowError('Expected variable but found ' + ReadNext);
    155 
    156   OldPos := InputTextPos;
    157   Next := ReadNext;
    158   if IsLogicOperator(Next) then begin
    159     R := ParseExpression;
    160   end else InputTextPos := OldPos;
    161 end;
    162 
    163 function ParseAssignment: Boolean;
    164 var
    165   Next: string;
    166   OldPos: Integer;
    167 begin
    168   Result := True;
    169   OldPos := InputTextPos;
    170   Next := ReadNext;
    171   if IsVariable(Next) then begin
    172     Expect(':=');
    173     ParseExpression;
    174     Expect(';');
    175   end else begin
    176     InputTextPos := OldPos;
    177     Result := False;
    178   end;
    179 end;
    180 
    181 function ParseBeginEnd(Top: Boolean = False): Boolean;
    182 begin
    183   if CheckNext('begin') then begin
    184     Result := True;
    185     Expect('begin');
    186     repeat
    187       if ParseAssignment then begin
    188       end else
    189       if CheckNext('end') then begin
    190         Expect('end');
    191         Break;
    192       end else ShowError('Expected command but found ' + ReadNext);
    193     until False;
    194     if Top then Expect('.')
    195       else Expect(';');
    196   end else Result := False;
    197 end;
    198 
    199 function ParseFunction: Boolean;
    200 var
    201   Name: string;
    202   ParamName: string;
    203   ParamType: string;
    204   ReturnType: string;
    205 begin
    206   if CheckNext('function') then begin
    207     Result := True;
    208     Expect('function');
    209     Name := ReadNext;
    210     if CheckNext('(') then begin
    211       Expect('(');
    212       ParamName := ReadNext;
    213       Expect(':');
    214       ParamType := ReadNext;
    215       Expect(')');
    216     end;
    217     Expect(':');
    218     ReturnType := ReadNext;
    219     Expect(';');
    220     ParseBeginEnd;
    221   end else Result := False;
    222 end;
    223 
    224 function ParseProcedure: Boolean;
    225 var
    226   Name: string;
    227   ParamName: string;
    228   ParamType: string;
    229 begin
    230   if CheckNext('procedure') then begin
    231     Result := True;
    232     Expect('procedure');
    233     Name := ReadNext;
    234     if CheckNext('(') then begin
    235       Expect('(');
    236       ParamName := ReadNext;
    237       Expect(':');
    238       ParamType := ReadNext;
    239       Expect(')');
    240     end;
    241     Expect(';');
    242     ParseBeginEnd;
    243   end else Result := False;
    244 end;
     5uses
     6  Execute3, Source3, Parser3;
    2457
    2468var
    247   ProgramName: string;
     9  ProgramCode: TProgramCode;
    24810begin
    249   WriteLn('Start');
    250 
    251   ReadInputAll;
    252   if CheckNext('program') then begin
    253     Expect('program');
    254     ProgramName := ReadNext;
    255     Expect(';');
    256   end;
    257   repeat
    258     if not ParseFunction then
    259     else if not ParseProcedure then
    260     else Break;
    261   until False;
    262 
    263   WriteLn('Finished');
     11  ParseProgram(@ProgramCode);
     12  ExecuteProgram(@ProgramCode);
    26413end.
    26514
Note: See TracChangeset for help on using the changeset viewer.