Ignore:
Timestamp:
Aug 9, 2010, 3:05:26 PM (14 years ago)
Author:
george
Message:

Added support for loop for-to-do.
System types and functions are not generated to output code.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/DelphiToC/Analyze/UPascalParser.pas

    r49 r50  
    1010
    1111type
    12   TOnErrorMessage = procedure (Text: string; Position: TPoint) of object;
     12  TOnErrorMessage = procedure(Text: string; Position: TPoint) of object;
    1313
    1414  TTokenType = (ttNone, ttIdentifier, ttConstantNumber, ttConstantString,
    … …  
    2424    FNextToken: string;
    2525    FNextTokenType: TTokenType;
    26     PreviousChar: Char;
    27     CurrentChar: Char;
     26    PreviousChar: char;
     27    CurrentChar: char;
    2828    procedure ErrorMessage(const Text: string; const Arguments: array of const);
    2929  public
    30     CodeStreamPosition: Integer;
     30    CodeStreamPosition: integer;
    3131    CodePosition: TPoint;
    3232    SourceCodeText: TStringList;
    33     function IsAlphanumeric(Character: Char): Boolean;
     33    function IsAlphanumeric(Character: char): boolean;
    3434    procedure GetNextToken;
    3535    function ReadCode: string;
    3636    procedure Expect(Code: string);
    37     function IsWhiteSpace(Character: Char): Boolean;
    38     function IsAlphabetic(Character: Char): Boolean;
    39     function IsIdentificator(Text: string): Boolean;
    40     function IsKeyword(Text: string): Boolean;
    41     function IsOperator(Text: string): Boolean;
     37    function IsWhiteSpace(Character: char): boolean;
     38    function IsAlphabetic(Character: char): boolean;
     39    function IsIdentificator(Text: string): boolean;
     40    function IsKeyword(Text: string): boolean;
     41    function IsOperator(Text: string): boolean;
    4242    procedure Log(Text: string);
    4343    property OnErrorMessage: TOnErrorMessage read FOnErrorMessage write FOnErrorMessage;
    … …  
    5555    procedure ParseProgram(SourceCode: TModule);
    5656    procedure ParseAll(SourceCode: TProgram);
    57     procedure ParseCommonBlock(SourceCode: TCommonBlock; EndSymbol: Char = ';');
     57    procedure ParseCommonBlock(SourceCode: TCommonBlock; EndSymbol: char = ';');
    5858    function ParseCommand(SourceCode: TCommonBlock): TCommand;
    5959    procedure ParseBeginEnd(SourceCode: TBeginEnd);
    6060    procedure ParseFunctionList(SourceCode: TFunctionList);
    6161    procedure ParseIfThenElse(SourceCode: TIfThenElse);
     62    procedure ParseForToDo(SourceCode: TForToDo);
    6263    procedure ParseVariableList(SourceCode: TVariableList);
    6364    procedure ParseVariable(SourceCode: TVariable);
    … …  
    7879  STypeNotDefined = 'Type "%s" not defined.';
    7980  SEndOfDataReached = 'Parser reached to end of input data.';
     81  SUndefinedVariable = 'Undefined variable.';
    8082
    8183
    … …  
    9193begin
    9294  Log('Expected: ' + Code + '  Readed: ' + FNextToken);
    93   if FNextToken <> Code then begin
     95  if FNextToken <> Code then
     96  begin
    9497    ErrorMessage(SExpectedButFound, [Code, FNextToken]);
    9598
    … …  
    101104end;
    102105
    103 function TBaseParser.IsAlphabetic(Character: Char): Boolean;
     106function TBaseParser.IsAlphabetic(Character: char): boolean;
    104107begin
    105108  Result := (Character in ['a'..'z']) or (Character in ['A'..'Z']);
    106109end;
    107110
    108 function TBaseParser.IsAlphanumeric(Character: Char): Boolean;
     111function TBaseParser.IsAlphanumeric(Character: char): boolean;
    109112begin
    110113  Result := IsAlphabetic(Character) or (Character in ['0'..'9']);
    111114end;
    112115
    113 function TBaseParser.IsKeyword(Text: string): Boolean;
    114 var
    115   I: Integer;
     116function TBaseParser.IsKeyword(Text: string): boolean;
     117var
     118  I: integer;
    116119begin
    117120  Result := False;
    … …  
    121124end;
    122125
    123 function TBaseParser.IsOperator(Text: string): Boolean;
    124 var
    125   I: Integer;
     126function TBaseParser.IsOperator(Text: string): boolean;
     127var
     128  I: integer;
    126129begin
    127130  Result := False;
    … …  
    131134end;
    132135
    133 function TBaseParser.IsIdentificator(Text: string): Boolean;
    134 var
    135   I: Integer;
     136function TBaseParser.IsIdentificator(Text: string): boolean;
     137var
     138  I: integer;
    136139begin
    137140  Result := True;
    138   if Length(Text) = 0 then Result := False;
    139   if IsKeyWord(Text) then Result := False;
     141  if Length(Text) = 0 then
     142    Result := False;
     143  if IsKeyWord(Text) then
     144    Result := False;
    140145  if Length(Text) > 0 then
    141146    if not (Text[1] in ['a'..'z', 'A'..'Z', '%', '_']) then
    … …  
    146151end;
    147152
    148 function TBaseParser.IsWhiteSpace(Character: Char): Boolean;
     153function TBaseParser.IsWhiteSpace(Character: char): boolean;
    149154begin
    150155  Result := (Character = ' ') or (Character = #13) or (Character = #10);
    … …  
    160165    if FileExistsUTF8(LogFileName) { *Converted from FileExists*  } then
    161166      LogFile := TFileStream.Create(LogFileName, fmOpenWrite)
    162       else LogFile := TFileStream.Create(LogFileName, fmCreate);
    163     if Length(Text) > 0 then begin
     167    else
     168      LogFile := TFileStream.Create(LogFileName, fmCreate);
     169    if Length(Text) > 0 then
     170    begin
    164171      LogFile.Write(Text[1], Length(Text));
    165172      LogFile.Write(#13#10, 2);
    … …  
    183190procedure TBaseParser.GetNextToken;
    184191var
    185   I: Integer;
    186   II: Integer;
    187   J: Integer;
     192  I: integer;
     193  II: integer;
     194  J: integer;
    188195const
    189   SpecChar: set of char = [';', '.', ',', ':', '(', ')', '[', ']', '+', '-', '/', '*',
    190     '^', '=', '<' , '>' , '@'];
    191   DoubleSpecChar : array[0..6] of string = (':=', '..', '<=', '>=', '<>', '+=', '-=');
    192 begin
    193     FNextToken := '';
    194     FNextTokenType := ttNone;
    195     with SourceCodeText do
    196     while True do begin
    197       if CodeStreamPosition < Length(Text) then begin
     196  SpecChar: set of char = [';', '.', ',', ':', '(', ')', '[', ']',
     197    '+', '-', '/', '*', '^', '=', '<', '>', '@'];
     198  DoubleSpecChar: array[0..6] of string = (':=', '..', '<=', '>=', '<>', '+=', '-=');
     199begin
     200  FNextToken := '';
     201  FNextTokenType := ttNone;
     202  with SourceCodeText do
     203    while True do
     204    begin
     205      if CodeStreamPosition < Length(Text) then
     206      begin
    198207        CurrentChar := Text[CodeStreamPosition];
    199       end else begin
     208      end
     209      else
     210      begin
    200211        FNextToken := '';
    201212        FNextTokenType := ttEndOfFile;
    … …  
    203214      end;
    204215
    205       if FNextTokenType = ttNone then begin
    206         if IsWhiteSpace(CurrentChar) then FNextTokenType := ttWhiteSpace
    207         else
    208         if CurrentChar = '{' then begin
     216      if FNextTokenType = ttNone then
     217      begin
     218        if IsWhiteSpace(CurrentChar) then
     219          FNextTokenType := ttWhiteSpace
     220        else
     221        if CurrentChar = '{' then
     222        begin
    209223          FNextTokenType := ttBlockComment1;
    210         end else
    211         if CurrentChar = '''' then begin
     224        end
     225        else
     226        if CurrentChar = '''' then
     227        begin
    212228          FNextTokenType := ttConstantString;
    213         end else
    214         if CurrentChar in SpecChar then begin
     229        end
     230        else
     231        if CurrentChar in SpecChar then
     232        begin
    215233          FNextTokenType := ttOperator;
    216234          FNextToken := FNextToken + CurrentChar;
    217         end else
    218         if IsAlphanumeric(CurrentChar) then begin
     235        end
     236        else
     237        if IsAlphanumeric(CurrentChar) then
     238        begin
    219239          FNextTokenType := ttIdentifier;
    220240          FNextToken := FNextToken + CurrentChar;
    221         end else FNextTokenType := ttUnknown;
    222       end else
    223       if FNextTokenType = ttLineComment then begin
     241        end
     242        else
     243          FNextTokenType := ttUnknown;
     244      end
     245      else
     246      if FNextTokenType = ttLineComment then
     247      begin
    224248        if (CurrentChar = #13) or (CurrentChar = #10) then
    225249          FNextTokenType := ttNone;
    226       end else
    227       if FNextTokenType = ttBlockComment1 then begin
     250      end
     251      else
     252      if FNextTokenType = ttBlockComment1 then
     253      begin
    228254        if (CurrentChar = '}') then
    229255          FNextTokenType := ttNone;
    230       end else
    231       if FNextTokenType = ttBlockComment2 then begin
     256      end
     257      else
     258      if FNextTokenType = ttBlockComment2 then
     259      begin
    232260        if (PreviousChar = '*') and (CurrentChar = ')') then
    233261          FNextTokenType := ttNone;
    234       end else
    235       if FNextTokenType = ttConstantString then begin
     262      end
     263      else
     264      if FNextTokenType = ttConstantString then
     265      begin
    236266        if (CurrentChar = '''') and (PreviousChar = '''') then
    237           Break else
     267          Break
     268        else
    238269          FNextToken := FNextToken + CurrentChar;
    239       end else
    240       if FNextTokenType = ttOperator then begin
    241         if (CurrentChar = '*') and (PreviousChar = '(') then begin
     270      end
     271      else
     272      if FNextTokenType = ttOperator then
     273      begin
     274        if (CurrentChar = '*') and (PreviousChar = '(') then
     275        begin
    242276          FNextToken := '';
    243277          FNextTokenType := ttBlockComment2;
    244         end else
    245         if (CurrentChar = '/') and (PreviousChar = '/') then begin
     278        end
     279        else
     280        if (CurrentChar = '/') and (PreviousChar = '/') then
     281        begin
    246282          FNextToken := '';
    247283          FNextTokenType := ttLineComment;
    248         end else
     284        end
     285        else
    249286        if not (CurrentChar in SpecChar) then
    250           Break else begin
    251             J := 0;
    252             while (J < Length(DoubleSpecChar)) and ((PreviousChar + CurrentChar) <> DoubleSpecChar[J]) do Inc(J);
    253             if J < Length(DoubleSpecChar) then
    254               FNextToken := FNextToken + CurrentChar else Break;
    255           end;
    256       end else
    257       if FNextTokenType = ttIdentifier then begin
     287          Break
     288        else
     289        begin
     290          J := 0;
     291          while (J < Length(DoubleSpecChar)) and
     292            ((PreviousChar + CurrentChar) <> DoubleSpecChar[J]) do
     293            Inc(J);
     294          if J < Length(DoubleSpecChar) then
     295            FNextToken := FNextToken + CurrentChar
     296          else
     297            Break;
     298        end;
     299      end
     300      else
     301      if FNextTokenType = ttIdentifier then
     302      begin
    258303        if not IsAlphanumeric(CurrentChar) then
    259           Break else
     304          Break
     305        else
    260306          FNextToken := FNextToken + CurrentChar;
    261307      end
    … …  
    263309        FNextTokenType := ttNone;
    264310
    265       if FNextTokenType <> ttNone then begin
     311      if FNextTokenType <> ttNone then
     312      begin
    266313        // Update cursor position
    267314        Inc(CodePosition.X);
    268         if (CurrentChar = #13) then begin
     315        if (CurrentChar = #13) then
     316        begin
    269317          CodePosition.X := 1;
    270318          Inc(CodePosition.Y);
    … …  
    288336procedure TPascalParser.ParseWhileDo(SourceCode: TWhileDo);
    289337begin
    290   with SourceCode do begin
     338  with SourceCode do
     339  begin
    291340    Expect('while');
    292341    Condition.CommonBlock := CommonBlock;
    … …  
    306355  Method: TFunction;
    307356  Constant: TConstant;
    308 //  Brackets: Integer;
     357  //  Brackets: Integer;
    309358  Expressions: TExpressionList;
    310   I: Integer;
    311   II: Integer;
     359  I: integer;
     360  II: integer;
    312361begin
    313362  Expressions := TExpressionList.Create;
    314363  Expressions.Add(TExpression.Create);
    315   with SourceCode do begin
    316     while ((FNextToken <> ';') and (FNextToken <> ',') and (not IsKeyWord(FNextToken))) and
    317       not (((FNextToken = ')') or (FNextToken = ']'))) do begin
    318         Identifier := ReadCode;
    319         if Identifier = '(' then begin
    320           // Subexpression
    321           with TExpression(Expressions.Last) do begin
     364  with SourceCode do
     365  begin
     366    while ((FNextToken <> ';') and (FNextToken <> ',') and
     367        (not IsKeyWord(FNextToken))) and not
     368      (((FNextToken = ')') or (FNextToken = ']'))) do
     369    begin
     370      Identifier := ReadCode;
     371      if Identifier = '(' then
     372      begin
     373        // Subexpression
     374        with TExpression(Expressions.Last) do
     375        begin
     376          SubItems[1] := TExpression.Create;
     377          ParseExpression(TExpression(SubItems[1]));
     378        end;
     379        with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do
     380        begin
     381          CommonBlock := SourceCode.CommonBlock;
     382          SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
     383        end;
     384        Expect(')');
     385      end
     386      else
     387      if IsOperator(Identifier) then
     388      begin
     389        // Operator
     390        TExpression(Expressions.Last).OperatorName := Identifier;
     391        TExpression(Expressions.Last).NodeType := ntOperator;
     392      end
     393      else
     394      if IsIdentificator(Identifier) then
     395      begin
     396        // Reference to identificator
     397        NewVariable := CommonBlock.Variables.Search(Identifier);
     398        if Assigned(NewVariable) then
     399        begin
     400          // Referenced variable
     401          with TExpression(Expressions.Last) do
     402          begin
    322403            SubItems[1] := TExpression.Create;
    323             ParseExpression(TExpression(SubItems[1]));
     404            TExpression(SubItems[1]).NodeType := ntVariable;
     405            TExpression(SubItems[1]).Variable := NewVariable;
    324406          end;
    325           with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
     407          with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do
     408          begin
    326409            CommonBlock := SourceCode.CommonBlock;
    327410            SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    328411          end;
    329           Expect(')');
    330         end else
    331         if IsOperator(Identifier) then begin
    332           // Operator
    333           TExpression(Expressions.Last).OperatorName := Identifier;
    334           TExpression(Expressions.Last).NodeType := ntOperator;
    335         end else
    336         if IsIdentificator(Identifier) then begin
    337           // Reference to identificator
    338           NewVariable := CommonBlock.Variables.Search(Identifier);
    339           if Assigned(NewVariable) then begin
    340             // Referenced variable
    341             with TExpression(Expressions.Last) do begin
     412        end
     413        else
     414        begin
     415          Method := CommonBlock.Functions.Search(Identifier);
     416          if Assigned(Method) then
     417          begin
     418            // Referenced method
     419            with TExpression(Expressions.Last) do
     420            begin
    342421              SubItems[1] := TExpression.Create;
    343               TExpression(SubItems[1]).NodeType := ntVariable;
    344               TExpression(SubItems[1]).Variable := NewVariable;
    345             end;
    346             with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
    347               CommonBlock := SourceCode.CommonBlock;
    348               SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    349             end;
    350           end else begin
    351             Method := CommonBlock.Functions.Search(Identifier);
    352             if Assigned(Method) then begin
    353               // Referenced method
    354               with TExpression(Expressions.Last) do begin
    355                 SubItems[1] := TExpression.Create;
    356                 if FNextToken  = '(' then               // Method with parameters
    357                 with TExpression(SubItems[1]) do begin
     422              if FNextToken = '(' then               // Method with parameters
     423                with TExpression(SubItems[1]) do
     424                begin
    358425                  Expect('(');
    359426                  NewExpression := TExpression.Create;
    … …  
    361428                  ParseExpression(NewExpression);
    362429                  SubItems.Add(NewExpression);
    363                   while FNextToken = ',' do begin
     430                  while FNextToken = ',' do
     431                  begin
    364432                    Expect(',');
    365433                    NewExpression := TExpression.Create;
    … …  
    370438                  Expect(')');
    371439                end;
    372                 TExpression(SubItems[1]).NodeType := ntFunction;
    373                 TExpression(SubItems[1]).Method := Method;
     440              TExpression(SubItems[1]).NodeType := ntFunction;
     441              TExpression(SubItems[1]).Method := Method;
     442            end;
     443            with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do
     444            begin
     445              CommonBlock := SourceCode.CommonBlock;
     446              SubItems[0] :=
     447                TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
     448            end;
     449          end
     450          else
     451          begin
     452            Constant := CommonBlock.Constants.Search(Identifier);
     453            if Assigned(Constant) then
     454            begin
     455              // Referenced constant
     456              with TExpression(Expressions.Last) do
     457              begin
     458                SubItems[1] := TExpression.Create;
     459                TExpression(SubItems[1]).NodeType := ntConstant;
     460                TExpression(SubItems[1]).Value := Constant.Value;
    374461              end;
    375               with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
     462              with TExpression(Expressions.Items[Expressions.Add(
     463                  TExpression.Create)]) do
     464              begin
    376465                CommonBlock := SourceCode.CommonBlock;
    377                 SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
     466                SubItems[0] :=
     467                  TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    378468              end;
    379             end else begin
    380               Constant := CommonBlock.Constants.Search(Identifier);
    381               if Assigned(Constant) then begin
    382                 // Referenced constant
    383                 with TExpression(Expressions.Last) do begin
    384                   SubItems[1] := TExpression.Create;
    385                   TExpression(SubItems[1]).NodeType := ntConstant;
    386                   TExpression(SubItems[1]).Value := Constant.Value;
    387                 end;
    388                 with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
    389                   CommonBlock := SourceCode.CommonBlock;
    390                   SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    391                 end;
    392               end else begin
    393                 ErrorMessage(SUnknownIdentifier, [Identifier]);
    394               end;
     469            end
     470            else
     471            begin
     472              ErrorMessage(SUnknownIdentifier, [Identifier]);
    395473            end;
    396474          end;
    397         end else
    398         begin
    399           // Constant value
    400           with TExpression(Expressions.Last) do begin
    401             SubItems[1] := TExpression.Create;
    402             TExpression(SubItems[1]).CommonBlock := SourceCode.CommonBlock;
    403             TExpression(SubItems[1]).NodeType := ntConstant;
    404 
    405             if Identifier[1] = '''' then begin
    406               TExpression(SubItems[1]).Value := Identifier;
    407               //SetLength(TExpression(SubItems[1]).Value, Length(Identifier));
    408               //for I := 1 to Length(Identifier) do
    409               //  TExpression(SubItems[1]).Value[I - 1] := Byte(Identifier[I]);
    410             end else begin
    411               TExpression(SubItems[1]).Value := Identifier;
    412             end;
     475        end;
     476      end
     477      else
     478      begin
     479        // Constant value
     480        with TExpression(Expressions.Last) do
     481        begin
     482          SubItems[1] := TExpression.Create;
     483          TExpression(SubItems[1]).CommonBlock := SourceCode.CommonBlock;
     484          TExpression(SubItems[1]).NodeType := ntConstant;
     485
     486          if Identifier[1] = '''' then
     487          begin
     488            TExpression(SubItems[1]).Value := Identifier;
     489            //SetLength(TExpression(SubItems[1]).Value, Length(Identifier));
     490            //for I := 1 to Length(Identifier) do
     491            //  TExpression(SubItems[1]).Value[I - 1] := Byte(Identifier[I]);
     492          end
     493          else
     494          begin
     495            TExpression(SubItems[1]).Value := Identifier;
    413496          end;
    414           //ShowMessage(IntToStr(Expressions.Count));
    415           with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin
    416             CommonBlock := SourceCode.CommonBlock;
    417             SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    418           end;
    419         end;
     497        end;
     498        //ShowMessage(IntToStr(Expressions.Count));
     499        with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do
     500        begin
     501          CommonBlock := SourceCode.CommonBlock;
     502          SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
     503        end;
     504      end;
    420505    end;
    421506
    422507    // Build expression tree
    423     for II := 0 to High(Operators) do begin
     508    for II := 0 to High(Operators) do
     509    begin
    424510      I := 1;
    425       while (I < Expressions.Count - 1) do begin
     511      while (I < Expressions.Count - 1) do
     512      begin
    426513        if not TExpression(Expressions[I]).Associated and
    427           (TExpression(Expressions[I]).OperatorName = Operators[II]) then begin
    428             TExpression(Expressions[I]).Associated := True;
    429             TExpression(Expressions[I - 1]).SubItems[1] := Expressions[I];
    430             TExpression(Expressions[I + 1]).SubItems[0] := Expressions[I];
    431             //Expressions.Delete(I);
    432           end else Inc(I);
     514          (TExpression(Expressions[I]).OperatorName = Operators[II]) then
     515        begin
     516          TExpression(Expressions[I]).Associated := True;
     517          TExpression(Expressions[I - 1]).SubItems[1] := Expressions[I];
     518          TExpression(Expressions[I + 1]).SubItems[0] := Expressions[I];
     519          //Expressions.Delete(I);
     520        end
     521        else
     522          Inc(I);
    433523      end;
    434524    end;
    … …  
    450540  First: TOperation;
    451541  Second: TOperation;
    452   StartIndex: Integer;
     542  StartIndex: integer;
    453543  LoopVariable: TVariable;
    454544  IdentName: string;
    … …  
    456546begin
    457547  begin
    458     if FNextToken = 'begin' then begin
     548    if FNextToken = 'begin' then
     549    begin
    459550      Result := TBeginEnd.Create;
    460551      TBeginEnd(Result).CommonBlock := SourceCode;
    … …  
    462553      // + ' ' + IntToStr(Integer(Result)));
    463554      ParseBeginEnd(TBeginEnd(Result));
    464     end else
    465     if FNextToken = 'if' then begin
     555    end
     556    else
     557    if FNextToken = 'if' then
     558    begin
    466559      Result := TIfThenElse.Create;
    467560      TIfThenElse(Result).CommonBlock := SourceCode;
    468561      ParseIfThenElse(TIfThenElse(Result));
    469     end else
    470     if FNextToken = 'while' then begin
     562    end
     563    else
     564    if FNextToken = 'while' then
     565    begin
    471566      Result := TWhileDo.Create;
    472567      TWhileDo(Result).CommonBlock := SourceCode;
    473568      ParseWhileDo(TWhileDo(Result));
    474     end else
    475     if IsIdentificator(FNextToken) then begin
    476       if Assigned(SourceCode.Variables.Search(FNextToken)) then begin
     569    end
     570    else
     571    if FNextToken = 'for' then
     572    begin
     573      Result := TForToDo.Create;
     574      TForToDo(Result).CommonBlock := SourceCode;
     575      ParseForToDo(TForToDo(Result));
     576    end
     577    else
     578    if IsIdentificator(FNextToken) then
     579    begin
     580      if Assigned(SourceCode.Variables.Search(FNextToken)) then
     581      begin
    477582        // Variable assignment
    478583        Result := TAssignment.Create;
    … …  
    484589        TAssignment(Result).Source.CommonBlock := SourceCode;
    485590        ParseExpression(TAssignment(Result).Source);
    486       end else
    487       if Assigned(SourceCode.Functions.Search(FNextToken)) then begin
     591      end
     592      else
     593      if Assigned(SourceCode.Functions.Search(FNextToken)) then
     594      begin
    488595        // Function call
    489596        FunctionName := ReadCode;
    … …  
    491598        TFunctionCall(Result).CommonBlock := SourceCode;
    492599        TFunctionCall(Result).FunctionRef := SourceCode.Functions.Search(FunctionName);
    493         if FNextToken = '(' then begin
     600        if FNextToken = '(' then
     601        begin
    494602          Expect('(');
    495           with TFunctionCall(Result) do begin
     603          with TFunctionCall(Result) do
     604          begin
    496605            ParameterExpression.Add(TExpression.Create);
    497606            TExpression(ParameterExpression.Last).CommonBlock := SourceCode;
    … …  
    500609          Expect(')');
    501610        end;
    502       end else begin
     611      end
     612      else
     613      begin
    503614        Result := nil;
    504615        ErrorMessage(SUnknownIdentifier, [ReadCode]);
    505616      end;
    506     end else
     617    end
     618    else
    507619    if FNextToken = ';' then
    508     else begin
     620    else
     621    begin
    509622      Result := nil;
    510623      ErrorMessage(SIllegalExpression, [ReadCode]);
    … …  
    521634  else if FNextToken = 'unit' then
    522635    ParseUnit(SourceCode)
    523   else ParseProgram(SourceCode);
     636  else
     637    ParseProgram(SourceCode);
    524638end;
    525639
    … …  
    528642  Identifier: string;
    529643begin
    530   with SourceCode do begin
    531     if FNextToken = 'program' then begin
     644  with SourceCode do
     645  begin
     646    if FNextToken = 'program' then
     647    begin
    532648      Expect('program');
    533649      Name := ReadCode;
    534650      ModuleType := mdProgram;
    535651      Expect(';');
    536     end else Name := '';
     652    end
     653    else
     654      Name := '';
    537655
    538656    // Uses section
    … …  
    547665begin
    548666  Expect('unit');
    549   with TModule(ProgramCode.Modules[0]) do begin
     667  with TModule(ProgramCode.Modules[0]) do
     668  begin
    550669    Name := ReadCode;
    551670    ModuleType := mdUnit;
    … …  
    560679procedure TPascalParser.ParseAll(SourceCode: TProgram);
    561680var
    562   I: Integer;
    563 begin
    564   with SourceCode do begin
     681  I: integer;
     682begin
     683  with SourceCode do
     684  begin
    565685    for I := 0 to Modules.Count - 1 do
    566686      ParseModule(TModule(Modules[I]));
    … …  
    570690{ TParserCommonBlock }
    571691
    572 procedure TPascalParser.ParseCommonBlock(SourceCode: TCommonBlock; EndSymbol: Char = ';');
    573 begin
    574   with SourceCode do begin
    575     while FNextToken <> EndSymbol do begin
     692procedure TPascalParser.ParseCommonBlock(SourceCode: TCommonBlock;
     693  EndSymbol: char = ';');
     694begin
     695  with SourceCode do
     696  begin
     697    while FNextToken <> EndSymbol do
     698    begin
    576699      if FNextToken = 'var' then
    577700        ParseVariableList(Variables)
    … …  
    584707      else if FNextToken = 'function' then
    585708        ParseFunctionList(Functions)
    586       else begin
     709      else
     710      begin
    587711        ParseBeginEnd(Code);
    588712        Break;
    … …  
    600724begin
    601725  //ShowMessage(IntToStr(Integer(SourceCode)) + ' ' + IntToStr(Integer(SourceCode.CommonBlock)));
    602   with SourceCode do begin
     726  with SourceCode do
     727  begin
    603728    Expect('begin');
    604     while (FNextToken <> 'end') and (FNextTokenType <> ttEndOfFile) do begin
     729    while (FNextToken <> 'end') and (FNextTokenType <> ttEndOfFile) do
     730    begin
    605731      NewCommand := ParseCommand(CommonBlock);
    606       if Assigned(NewCommand) then Commands.Add(NewCommand);
     732      if Assigned(NewCommand) then
     733        Commands.Add(NewCommand);
    607734      //ShowMessage(NextCode);
    608       if FNextToken = ';' then ReadCode;
     735      if FNextToken = ';' then
     736        ReadCode;
    609737    end;
    610738    Expect('end');
    … …  
    621749  VariableName: string;
    622750  Variable: TParameter;
    623   I: Integer;
     751  I: integer;
    624752begin
    625753  Identifiers := TStringList.Create;
    626   with SourceCode do begin
    627     with TFunction(Items[Add(TFunction.Create)]) do begin
     754  with SourceCode do
     755  begin
     756    with TFunction(Items[Add(TFunction.Create)]) do
     757    begin
    628758      Parent := SourceCode.Parent;
    629       if FNextToken = 'procedure' then begin
     759      if FNextToken = 'procedure' then
     760      begin
    630761        Expect('procedure');
    631762        HaveResult := False;
    632       end else begin
     763      end
     764      else
     765      begin
    633766        Expect('function');
    634767        HaveResult := True;
    … …  
    636769      Name := ReadCode;
    637770
    638       if FNextToken = '(' then begin
     771      if FNextToken = '(' then
     772      begin
    639773        Expect('(');
    640         while FNextToken <> ')' do begin
    641 //    while IsIdentificator(NextCode) do begin
    642           with TParameterList(Parameters) do begin
     774        while FNextToken <> ')' do
     775        begin
     776          //    while IsIdentificator(NextCode) do begin
     777          with TParameterList(Parameters) do
     778          begin
    643779            VariableName := ReadCode;
    644780            Variable := Search(VariableName);
    645             if not Assigned(Variable) then begin
     781            if not Assigned(Variable) then
     782            begin
    646783              Identifiers.Add(VariableName);
    647               while FNextToken = ',' do begin
     784              while FNextToken = ',' do
     785              begin
    648786                Expect(',');
    649787                Identifiers.Add(ReadCode);
    650788              end;
    651             end else ErrorMessage(SRedefineIdentifier, [VariableName]);
     789            end
     790            else
     791              ErrorMessage(SRedefineIdentifier, [VariableName]);
    652792            Expect(':');
    653793            TypeName := ReadCode;
    654794            NewValueType := Parent.Types.Search(TypeName);
    655             if not Assigned(NewValueType) then ErrorMessage(STypeNotDefined, [TypeName])
    656               else for I := 0 to Identifiers.Count - 1 do
    657                 with TParameter(Items[Add(TParameter.Create)]) do begin
     795            if not Assigned(NewValueType) then
     796              ErrorMessage(STypeNotDefined, [TypeName])
     797            else
     798              for I := 0 to Identifiers.Count - 1 do
     799                with TParameter(Items[Add(TParameter.Create)]) do
     800                begin
    658801                  Name := Identifiers[I];
    659802                  ValueType := NewValueType;
    … …  
    664807
    665808        // Parse function result type
    666         if HaveResult then begin
     809        if HaveResult then
     810        begin
    667811          Expect(':');
    668812          TypeName := ReadCode;
    669813          NewValueType := Parent.Types.Search(TypeName);
    670           if not Assigned(NewValueType) then ErrorMessage(STypeNotDefined, [TypeName])
    671             else begin
    672               ResultType := NewValueType;
    673               with TVariable(Parent.Variables.Items[Parent.Variables.Add(TVariable.Create)]) do begin
    674                 Name := 'Result';
    675                 ValueType := NewValueType;
    676               end;
     814          if not Assigned(NewValueType) then
     815            ErrorMessage(STypeNotDefined, [TypeName])
     816          else
     817          begin
     818            ResultType := NewValueType;
     819            with TVariable(Parent.Variables.Items[Parent.Variables.Add(
     820                TVariable.Create)]) do
     821            begin
     822              Name := 'Result';
     823              ValueType := NewValueType;
    677824            end;
     825          end;
    678826        end;
    679827      end;
    … …  
    689837procedure TPascalParser.ParseIfThenElse(SourceCode: TIfThenElse);
    690838begin
    691   with Sourcecode do begin
     839  with Sourcecode do
     840  begin
    692841    Expect('if');
    693842    Condition.CommonBlock := CommonBlock;
    … …  
    695844    Expect('then');
    696845    Command := ParseCommand(CommonBlock);
    697     if FNextToken = 'else' then begin
     846    if FNextToken = 'else' then
     847    begin
    698848      Expect('else');
    699849      ElseCommand := ParseCommand(CommonBlock);
    700850    end;
     851  end;
     852end;
     853
     854procedure TPascalParser.ParseForToDo(SourceCode: TForToDo);
     855var
     856  VariableName: string;
     857begin
     858  with SourceCode do
     859  begin
     860    Expect('for');
     861    VariableName := ReadCode;
     862    ControlVariable := SourceCode.CommonBlock.Variables.Search(VariableName);
     863    if not Assigned(ControlVariable) then
     864      ErrorMessage(SUndefinedVariable, [VariableName]);
     865    Expect(':=');
     866    Start.CommonBlock := CommonBlock;
     867    ParseExpression(Start);
     868    Expect('to');
     869    Stop.CommonBlock := CommonBlock;
     870    ParseExpression(Stop);
     871    Expect('do');
     872    Command := ParseCommand(CommonBlock);
    701873  end;
    702874end;
    … …  
    711883  VariableName: string;
    712884  Variable: TVariable;
    713   I: Integer;
     885  I: integer;
    714886begin
    715887  Identifiers := TStringList.Create;
    716   with SourceCode do begin
     888  with SourceCode do
     889  begin
    717890    Expect('var');
    718     while IsIdentificator(FNextToken) do begin
     891    while IsIdentificator(FNextToken) do
     892    begin
    719893      Identifiers.Clear;
    720894      VariableName := ReadCode;
    721895      Variable := Search(VariableName);
    722       if not Assigned(Variable) then begin
     896      if not Assigned(Variable) then
     897      begin
    723898        Identifiers.Add(VariableName);
    724         while FNextToken = ',' do begin
     899        while FNextToken = ',' do
     900        begin
    725901          Expect(',');
    726902          Identifiers.Add(ReadCode);
    727903        end;
    728       end else ErrorMessage(SRedefineIdentifier, [VariableName]);
     904      end
     905      else
     906        ErrorMessage(SRedefineIdentifier, [VariableName]);
    729907      Expect(':');
    730908      TypeName := ReadCode;
    731909      NewValueType := Parent.Types.Search(TypeName);
    732       if NewValueType = nil then ErrorMessage(STypeNotDefined, [TypeName])
    733         else for I := 0 to Identifiers.Count - 1 do
    734           with TVariable(Items[Add(TVariable.Create)]) do begin
     910      if NewValueType = nil then
     911        ErrorMessage(STypeNotDefined, [TypeName])
     912      else
     913        for I := 0 to Identifiers.Count - 1 do
     914          with TVariable(Items[Add(TVariable.Create)]) do
     915          begin
    735916            Name := Identifiers[I];
    736917            ValueType := NewValueType;
    … …  
    746927procedure TPascalParser.ParseVariable(SourceCode: TVariable);
    747928begin
    748   with SourceCode do begin
     929  with SourceCode do
     930  begin
    749931    Name := FNextToken;
    750932    Expect(':=');
    … …  
    762944  ConstantName: string;
    763945  Constant: TConstant;
    764   I: Integer;
     946  I: integer;
    765947  ConstantValue: string;
    766948begin
    767949  Identifiers := TStringList.Create;
    768   with SourceCode do begin
     950  with SourceCode do
     951  begin
    769952    Expect('const');
    770     while IsIdentificator(FNextToken) do begin
     953    while IsIdentificator(FNextToken) do
     954    begin
    771955      ConstantName := ReadCode;
    772956      Constant := Search(ConstantName);
    773       if not Assigned(Constant) then begin
     957      if not Assigned(Constant) then
     958      begin
    774959        Identifiers.Add(ConstantName);
    775         while FNextToken = ',' do begin
     960        while FNextToken = ',' do
     961        begin
    776962          Expect(',');
    777963          Identifiers.Add(ReadCode);
    778964        end;
    779       end else ErrorMessage(SRedefineIdentifier, [ConstantName]);
     965      end
     966      else
     967        ErrorMessage(SRedefineIdentifier, [ConstantName]);
    780968      Expect(':');
    781969      TypeName := ReadCode;
    … …  
    785973      Expect(';');
    786974
    787       if NewValueType = nil then ErrorMessage(STypeNotDefined, [TypeName])
    788         else for I := 0 to Identifiers.Count - 1 do
    789           with TConstant(Items[Add(TConstant.Create)]) do begin
     975      if NewValueType = nil then
     976        ErrorMessage(STypeNotDefined, [TypeName])
     977      else
     978        for I := 0 to Identifiers.Count - 1 do
     979          with TConstant(Items[Add(TConstant.Create)]) do
     980          begin
    790981            Name := Identifiers[I];
    791982            ValueType := NewValueType;
    … …  
    801992procedure TPascalParser.ParseTypeList(SourceCode: TTypeList);
    802993begin
    803   with SourceCode do begin
     994  with SourceCode do
     995  begin
    804996    Expect('type');
    805997    while IsIdentificator(FNextToken) do
    806       with TType(Items[Add(TType.Create)]) do begin
     998      with TType(Items[Add(TType.Create)]) do
     999      begin
    8071000        Parent := SourceCode;
    8081001        ParseType(TType(Items[Count - 1]));
    … …  
    8151008procedure TPascalParser.ParseType(SourceCode: TType);
    8161009begin
    817   with SourceCode do begin
     1010  with SourceCode do
     1011  begin
    8181012    Name := FNextToken;
    8191013    Expect('=');
    … …  
    8291023begin
    8301024  Expect('uses');
    831   with TUsedModule(SourceCode.Items[SourceCode.Add(TUsedModule.Create)]) do begin
     1025  with TUsedModule(SourceCode.Items[SourceCode.Add(TUsedModule.Create)]) do
     1026  begin
    8321027    Name := ReadCode;
    8331028  end;
    834   while FNextToken = ',' do begin
     1029  while FNextToken = ',' do
     1030  begin
    8351031    Expect(',');
    836     with TUsedModule(SourceCode.Items[SourceCode.Add(TUsedModule.Create)]) do begin
     1032    with TUsedModule(SourceCode.Items[SourceCode.Add(TUsedModule.Create)]) do
     1033    begin
    8371034      Name := ReadCode;
    8381035    end;
    … …  
    8421039
    8431040end.
     1041
Note: See TracChangeset for help on using the changeset viewer.