Ignore:
Timestamp:
Oct 22, 2010, 3:39:58 PM (14 years ago)
Author:
george
Message:
  • Modified: Better parse righ assignment side with expression.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/Transpascal/Compiler/Analyze/UPascalParser.pas

    r79 r80  
    2020    procedure ParseWhileDo(SourceCode: TWhileDo);
    2121    procedure ParseExpression(SourceCode: TExpression);
     22    function ParseRightValue(SourceCode: TExpression): TObject;
     23    function ParseFunctionCall(SourceCode: TExpression): TObject;
    2224    procedure ParseUses(SourceCode: TUsedModuleList; AExported: Boolean);
    2325    function ParseModule(ProgramCode: TProgram): TModule;
    … …  
    3234    procedure ParseBeginEnd(SourceCode: TBeginEnd);
    3335    function ParseFunctionList(SourceCode: TFunctionList; Exported: Boolean = False): Boolean;
    34     procedure ParseFunctionParameters(SourceCode: TFunction);
     36    procedure ParseFunctionParameters(SourceCode: TFunction; ValidateParams: Boolean = False);
    3537    procedure ParseIfThenElse(SourceCode: TIfThenElse);
    3638    procedure ParseForToDo(SourceCode: TForToDo);
    … …  
    7072  SUnknownModuleType = 'Unknown module name "%s".';
    7173  SInvalidConstruction = 'Invalid construction.';
     74  SInvalidAssignmentValue = 'Invalid assignment "%s".';
     75  SParamDiffers = 'Declaration of parametr "%s" differs.';
    7276
    7377implementation
    … …  
    125129  NewMethod: TFunction;
    126130  Constant: TConstant;
     131  UseType: TType;
    127132  //  Brackets: Integer;
    128133  Expressions: TExpressionList;
    129134  I: integer;
    130135  II: integer;
     136  RightValue: TObject;
    131137begin
    132138  Expressions := TExpressionList.Create;
    … …  
    136142      (((NextToken = ')') or (NextToken = ']'))) and not (NextTokenType = ttEndOfFile) do begin
    137143      IdentifierType := NextTokenType;
    138       Identifier := ReadToken;
    139       if Identifier = '(' then begin
     144      if NextToken = '(' then begin
     145        Expect('(');
    140146        // Subexpression
    141147        with TExpression(Expressions.Last) do begin
    … …  
    151157        Expect(')');
    152158      end else
    153       if IsOperator(Identifier) then begin
     159      if IsOperator(NextToken) then begin
    154160        // Operator
    155         TExpression(Expressions.Last).OperatorName := Identifier;
     161        TExpression(Expressions.Last).OperatorName := ReadToken;
    156162        TExpression(Expressions.Last).NodeType := ntOperator;
    157       end else
    158       if IsIdentificator(Identifier) then begin
    159         // Reference to identificator
    160         NewVariable := CommonBlock.Variables.Search(Identifier);
    161         if Assigned(NewVariable) then begin
    162           // Referenced variable
     163      end else begin
     164        RightValue := ParseRightValue(SourceCode);
     165        if Assigned(RightValue) then begin
    163166          with TExpression(Expressions.Last) do begin
    164167            SubItems[1] := TExpression.Create;
    165168            TExpression(SubItems[1]).CommonBlock := SourceCode.CommonBlock;
    166             TExpression(SubItems[1]).NodeType := ntVariable;
    167             TExpression(SubItems[1]).Variable := NewVariable;
     169            if RightValue is TVariable then begin
     170              TExpression(SubItems[1]).NodeType := ntVariable;
     171              TExpression(SubItems[1]).Variable := TVariable(RightValue);
     172            end;
     173            if RightValue is TConstant then begin
     174              TExpression(SubItems[1]).NodeType := ntConstant;
     175              TExpression(SubItems[1]).Constant := TConstant(RightValue);
     176            end;
     177            if RightValue is TFunctionCall then begin
     178              TExpression(SubItems[1]).NodeType := ntFunction;
     179              TExpression(SubItems[1]).FunctionCall := TFunction(RightValue);
     180            end;
    168181          end;
    169182          with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do
    … …  
    173186          end;
    174187        end else begin
    175           NewMethod := CommonBlock.Functions.Search(Identifier);
    176           if Assigned(NewMethod) then begin
    177             // Referenced method
    178             with TExpression(Expressions.Last) do begin
    179               SubItems[1] := TExpression.Create;
    180               TExpression(SubItems[1]).CommonBlock := SourceCode.CommonBlock;
    181               if NextToken = '(' then               // Method with parameters
    182                 with TExpression(SubItems[1]) do begin
    183                   Expect('(');
    184                   NewExpression := TExpression.Create;
    185                   NewExpression.CommonBlock := CommonBlock;
    186                   ParseExpression(NewExpression);
    187                   SubItems.Add(NewExpression);
    188                   while NextToken = ',' do begin
    189                     Expect(',');
    190                     NewExpression := TExpression.Create;
    191                     NewExpression.CommonBlock := CommonBlock;
    192                     ParseExpression(NewExpression);
    193                     SubItems.Add(NewExpression);
    194                   end;
    195                   Expect(')');
    196                 end;
    197               TExpression(SubItems[1]).NodeType := ntFunction;
    198               TExpression(SubItems[1]).Method := NewMethod;
    199             end;
    200             with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do
    201             begin
    202               CommonBlock := SourceCode.CommonBlock;
    203               SubItems[0] :=
    204                 TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    205             end;
    206           end else begin
    207             Constant := CommonBlock.Constants.Search(Identifier);
    208             if Assigned(Constant) then begin
    209               // Referenced constant
    210               with TExpression(Expressions.Last) do begin
    211                 SubItems[1] := TExpression.Create;
    212                 TExpression(SubItems[1]).CommonBlock := SourceCode.CommonBlock;
    213                 TExpression(SubItems[1]).NodeType := ntConstant;
    214                 TExpression(SubItems[1]).Value := Constant.Value;
    215               end;
    216               with TExpression(Expressions.Items[Expressions.Add(
    217                   TExpression.Create)]) do begin
    218                 CommonBlock := SourceCode.CommonBlock;
    219                 SubItems[0] :=
    220                   TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
    221               end;
    222             end else begin
    223               ErrorMessage(SUnknownIdentifier, [Identifier], -1);
    224             end;
    225           end;
    226         end;
    227       end else begin
    228         // Constant value
    229         with TExpression(Expressions.Last) do begin
    230           SubItems[1] := TExpression.Create;
    231           TExpression(SubItems[1]).CommonBlock := SourceCode.CommonBlock;
    232           TExpression(SubItems[1]).NodeType := ntConstant;
    233 
    234           if IdentifierType = ttConstantString then begin
    235             TExpression(SubItems[1]).Value := Identifier;
    236             //SetLength(TExpression(SubItems[1]).Value, Length(Identifier));
    237             //for I := 1 to Length(Identifier) do
    238             //  TExpression(SubItems[1]).Value[I - 1] := Byte(Identifier[I]);
    239           end else begin
    240             TExpression(SubItems[1]).Value := Identifier;
    241           end;
    242         end;
    243         //ShowMessage(IntToStr(Expressions.Count));
    244         with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do
    245         begin
    246           CommonBlock := SourceCode.CommonBlock;
    247           SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
     188          ErrorMessage(SInvalidAssignmentValue, [NextToken]);
     189          ReadToken;
    248190        end;
    249191      end;
    … …  
    271213      TExpression(Expressions[1]).SubItems[0] := nil;
    272214    Expressions.Free;
     215  end;
     216end;
     217
     218function TPascalParser.ParseRightValue(SourceCode: TExpression): TObject;
     219var
     220  UseType: TType;
     221  UseVariable: TVariable;
     222  UseConstant: TConstant;
     223  UseFunction: TFunction;
     224  Identifier: string;
     225begin
     226  Result := nil;
     227  with SourceCode do
     228  if IsIdentificator(NextToken) then begin
     229    // Start with type
     230    UseType := CommonBlock.Types.Search(NextToken);
     231    if Assigned(UseType) then begin
     232      ReadToken;
     233      if (UseType is TTypeRecord) or (UseType is TTypeClass) then begin
     234        Expect('.');
     235        Identifier := ReadToken;
     236        UseVariable := TTypeRecord(UseType).CommonBlock.Variables.Search(Identifier);
     237        if Assigned(UseVariable) then begin
     238          Result := UseVariable;
     239        end;
     240        if not Assigned(Result) then begin
     241          UseFunction := TTypeRecord(UseType).CommonBlock.Functions.Search(Identifier);
     242          if Assigned(UseFunction) then begin
     243            Result := UseFunction;
     244          end;
     245        end;
     246        if not Assigned(Result) then
     247          ErrorMessage(SUndefinedVariable, [Identifier]);
     248      end else ErrorMessage(SIllegalExpression, [Identifier]);
     249    end;
     250    if not Assigned(Result) then begin
     251      UseVariable := CommonBlock.Variables.Search(Identifier);
     252      if Assigned(UseVariable) then begin
     253        // Referenced variable
     254        ReadToken;
     255        Result := UseVariable;
     256      end;
     257    end;
     258    if not Assigned(Result) then begin
     259      Result := ParseFunctionCall(SourceCode);
     260    end;
     261    if not Assigned(Result) then begin
     262      UseConstant := CommonBlock.Constants.Search(NextToken);
     263      if Assigned(UseConstant) then begin
     264        ReadToken;
     265        Result := UseConstant;
     266      end;
     267    end;
     268    if not Assigned(Result) then begin
     269      // Constant value
     270      Result := TConstant.Create;
     271      TConstant(Result).Value := ReadToken;
     272    end;
     273    if not Assigned(Result) then begin
     274      ErrorMessage(SUnknownIdentifier, [ReadToken]);
     275    end;
     276  end else Result := nil;
     277end;
     278
     279function TPascalParser.ParseFunctionCall(SourceCode: TExpression): TObject;
     280var
     281  UseFunction: TFunction;
     282begin
     283  Result := nil;
     284  with SourceCode do begin
     285    UseFunction := CommonBlock.Functions.Search(NextToken);
     286    if Assigned(UseFunction) then begin
     287      ReadToken;
     288      Result := UseFunction;
     289      if NextToken = '(' then begin
     290        Expect('(');
     291        while NextToken = ',' do begin
     292          Expect(',');
     293          Expect(')');
     294        end;
     295      end;
     296    end;
    273297  end;
    274298end;
    … …  
    505529  UseFunction: TFunction;
    506530  FunctionType: TFunctionType;
     531  ValidParams: Boolean;
    507532begin
    508533  if (NextToken = 'procedure') or (NextToken = 'function') then begin
    … …  
    531556    (UseType is TTypeClass)) then begin
    532557      Expect('.');
     558      ValidParams := True;
    533559      UseName := ReadToken;
    534560      if UseType is TTypeRecord then begin
    … …  
    546572      UseFunction.FunctionType := FunctionType;
    547573      Add(UseFunction);
     574      ValidParams := False;
    548575    end;
    549576    with UseFunction do begin
    550577      // Parse parameters
    551578      if NextToken = '(' then
    552         ParseFunctionParameters(UseFunction);
     579        ParseFunctionParameters(UseFunction, ValidParams);
    553580
    554581      // Parse function result type
    … …  
    587614end;
    588615
    589 procedure TPascalParser.ParseFunctionParameters(SourceCode: TFunction);
     616procedure TPascalParser.ParseFunctionParameters(SourceCode: TFunction;
     617  ValidateParams: Boolean = False);
    590618var
    591619  Identifiers: TStringList;
    … …  
    600628    Identifiers := TStringList.Create;
    601629        Expect('(');
    602         while NextToken <> ')' do begin
     630        while (NextToken <> ')') and (NextTokenType <> ttEndOfFile) do begin
    603631          // while IsIdentificator(NextCode) do begin
    604632          with TParameterList(Parameters) do begin
    … …  
    616644                end;
    617645              end else
    618                 ErrorMessage(SRedefineIdentifier, [VariableName], -1);
     646                if not ValidateParams then
     647                  ErrorMessage(SRedefineIdentifier, [VariableName], -1);
    619648              Expect(':');
    620649              TypeName := ReadToken;
    … …  
    623652                ErrorMessage(SUndefinedType, [TypeName], -1)
    624653              else
    625                 for I := 0 to Identifiers.Count - 1 do
    626                   with TParameter(Items[Add(TParameter.Create)]) do
    627                   begin
    628                     Name := Identifiers[I];
    629                     ValueType := UseType;
     654                if ValidateParams then begin
     655                  for I := 0 to Identifiers.Count - 1 do begin
     656                    UseVariable := Parameters.Search(Identifiers[I]);
     657                    if Assigned(UseVariable) then
     658                      if UseVariable.ValueType <> UseType then ;
     659                        ErrorMessage(SParamDiffers, [Identifiers[I]]);
    630660                  end;
     661                end else begin
     662                  for I := 0 to Identifiers.Count - 1 do
     663                    with TParameter(Items[Add(TParameter.Create)]) do
     664                    begin
     665                      Name := Identifiers[I];
     666                     ValueType := UseType;
     667                    end;
     668
     669                end;
    631670            end;
    632671          end;
    … …  
    643682procedure TPascalParser.ParseIfThenElse(SourceCode: TIfThenElse);
    644683begin
    645   with Sourcecode do
    646   begin
     684  with SourceCode do begin
    647685    Expect('if');
    648686    Condition.CommonBlock := CommonBlock;
Note: See TracChangeset for help on using the changeset viewer.