Ignore:
Timestamp:
Oct 22, 2010, 11:34:06 AM (14 years ago)
Author:
george
Message:
  • Modified: Parsing type restructured.
  • Added: Partial subrange typ parsing.
File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r77 r78  
    4141      AssignSymbol: string = '=');
    4242    function ParseType(TypeList: TTypeList; ExpectName: Boolean = True; AssignSymbol: string = '='): TType;
     43    function ParseTypeSubType(TypeList: TTypeList; Name: string; ExpectName: Boolean): TType;
     44    function ParseTypeBase(TypeList: TTypeList; Name: string): TType;
     45    function ParseTypePointer(TypeList: TTypeList; Name: string): TType;
    4346    function ParseTypeEnumeration(TypeList: TTypeList; Name: string): TType;
    4447    function ParseTypeRecord(TypeList: TTypeList; Name: string): TType;
     48    function ParseTypeClass(TypeList: TTypeList; Name: string): TType;
     49    function ParseTypeArray(TypeList: TTypeList; Name: string): TType;
     50    function ParseTypeSubRange(TypeList: TTypeList; Name: string): TType;
    4551    property OnGetSource: TGetSourceEvent read FOnGetSource
    4652      write FOnGetSource;
    … …  
    6167  SFunctionNotDeclared = 'Function "%s" not declared.';
    6268  SUnknownProcName = 'Unknown proc name "%s".';
    63 
     69  SUnknownModuleType = 'Unknown module name "%s".';
     70  SInvalidConstruction = 'Invalid construction.';
    6471
    6572implementation
    … …  
    8390        Parser.FileName := Name;
    8491        Parser.OnErrorMessage := OnErrorMessage;
    85         NewModule := Parser.ParseModule(ProgramCode);
    86         ProgramCode.Modules.Add(NewModule);
     92        //NewModule :=
     93        Parser.ParseModule(ProgramCode);
     94        //ProgramCode.Modules.Add(NewModule);
    8795        Result := True;
    8896      end else Result := False;
    … …  
    127135      (((NextToken = ')') or (NextToken = ']'))) and not (NextTokenType = ttEndOfFile) do begin
    128136      IdentifierType := NextTokenType;
    129       Identifier := ReadCode;
     137      Identifier := ReadToken;
    130138      if Identifier = '(' then begin
    131139        // Subexpression
    … …  
    305313        Result := TAssignment.Create;
    306314        TAssignment(Result).CommonBlock := SourceCode;
    307         IdentName := ReadCode;
     315        IdentName := ReadToken;
    308316        TAssignment(Result).Target := SourceCode.Variables.Search(IdentName);
    309317        Expect(':=');
    … …  
    314322      if Assigned(SourceCode.Functions.Search(NextToken)) then begin
    315323        // Function call
    316         FunctionName := ReadCode;
     324        FunctionName := ReadToken;
    317325        Result := TFunctionCall.Create;
    318326        TFunctionCall(Result).CommonBlock := SourceCode;
    … …  
    331339      end else begin
    332340        Result := nil;
    333         ErrorMessage(SUnknownIdentifier, [ReadCode], -1);
     341        ErrorMessage(SUnknownIdentifier, [ReadToken], -1);
    334342      end;
    335343    end else
    … …  
    338346    else begin
    339347      Result := nil;
    340       ErrorMessage(SIllegalExpression, [ReadCode], -1);
     348      ErrorMessage(SIllegalExpression, [ReadToken], -1);
    341349    end;
    342350  end;
    … …  
    352360    Result.ParentProgram := ProgramCode;
    353361    ParseUnit(TModuleUnit(Result));
    354   end else begin //if FNextToken = 'program' then begin
     362  end else
     363  if NextToken = 'program' then begin
    355364    Result := TModuleProgram.Create;
    356365    Result.ParentProgram := ProgramCode;
    357366    ParseProgram(TModuleProgram(Result));
    358   end;
     367  end else
     368    ErrorMessage(SUnknownModuleType, [NextToken]);
    359369end;
    360370
    … …  
    366376    if NextToken = 'program' then begin
    367377      Expect('program');
    368       Name := ReadCode;
     378      Name := ReadToken;
    369379      Expect(';');
    370380    end else Name := '';
    … …  
    385395  Expect('unit');
    386396  with Sourcecode do begin
    387     Name := ReadCode;
     397    Name := ReadToken;
    388398  end;
    389399  Expect(';');
    … …  
    479489      else begin
    480490        ErrorMessage(SUnknownIdentifier, [NextToken], -1);
    481         ReadCode;
     491        ReadToken;
    482492      end;
    483493    end;
    … …  
    502512      //ShowMessage(NextCode);
    503513      if NextToken = ';' then
    504         ReadCode;
     514        ReadToken;
    505515    end;
    506516    Expect('end');
    … …  
    540550
    541551    // Read function name
    542     UseName := ReadCode;
     552    UseName := ReadToken;
    543553    UseType := SourceCode.Parent.Types.Search(UseName);
    544554    if Assigned(UseType) and ((UseType is TTypeRecord) or
    545555    (UseType is TTypeClass)) then begin
    546556      Expect('.');
    547       UseName := ReadCode;
     557      UseName := ReadToken;
    548558      if UseType is TTypeRecord then begin
    549559        UseFunction := TTypeRecord(UseType).CommonBlock.Functions.Search(UseName);
    … …  
    569579      if FunctionType = ftFunction then begin
    570580        Expect(':');
    571         TypeName := ReadCode;
     581        TypeName := ReadToken;
    572582        NewValueType := Parent.Types.Search(TypeName);
    573583        if not Assigned(NewValueType) then
    … …  
    615625          // while IsIdentificator(NextCode) do begin
    616626          with TParameterList(Parameters) do begin
    617             VariableName := ReadCode;
     627            VariableName := ReadToken;
    618628            if VariableName = 'var' then begin
    619629            end else
    … …  
    625635                while NextToken = ',' do begin
    626636                  Expect(',');
    627                   Identifiers.Add(ReadCode);
     637                  Identifiers.Add(ReadToken);
    628638                end;
    629639              end else
    630640                ErrorMessage(SRedefineIdentifier, [VariableName], -1);
    631641              Expect(':');
    632               TypeName := ReadCode;
     642              TypeName := ReadToken;
    633643              UseType := Parent.Types.Search(TypeName);
    634644              if not Assigned(UseType) then
    … …  
    677687  begin
    678688    Expect('for');
    679     VariableName := ReadCode;
     689    VariableName := ReadToken;
    680690    ControlVariable := SourceCode.CommonBlock.Variables.Search(VariableName);
    681691    if not Assigned(ControlVariable) then
    … …  
    708718    while IsIdentificator(NextToken) and (NextTokenType <> ttEndOfFile) do begin
    709719      Identifiers.Clear;
    710       VariableName := ReadCode;
     720      VariableName := ReadToken;
    711721      Variable := Search(VariableName);
    712722      if not Assigned(Variable) then begin
    … …  
    714724        while NextToken = ',' do begin
    715725          Expect(',');
    716           Identifiers.Add(ReadCode);
     726          Identifiers.Add(ReadToken);
    717727        end;
    718728      end else
    719729        ErrorMessage(SRedefineIdentifier, [VariableName], -1);
    720730      Expect(':');
    721       TypeName := ReadCode;
     731      TypeName := ReadToken;
    722732      NewValueType := Parent.Types.Search(TypeName);
    723733      if NewValueType = nil then
    … …  
    763773  with SourceCode do begin
    764774    while IsIdentificator(NextToken) do begin
    765       ConstantName := ReadCode;
     775      ConstantName := ReadToken;
    766776      Constant := Search(ConstantName);
    767777      if not Assigned(Constant) then begin
    … …  
    769779        while NextToken = ',' do begin
    770780          Expect(',');
    771           Identifiers.Add(ReadCode);
     781          Identifiers.Add(ReadToken);
    772782        end;
    773783      end else
    … …  
    775785      if NextToken = ':' then begin
    776786        Expect(':');
    777         TypeName := ReadCode;
     787        TypeName := ReadToken;
    778788        NewValueType := Parent.Types.Search(TypeName);
    779789      end;
    780790      Expect('=');
    781       ConstantValue := ReadCode;
     791      ConstantValue := ReadToken;
    782792      Expect(';');
    783793
    … …  
    828838  begin
    829839    if ExpectName then begin
    830       Name := ReadCode;
     840      Name := ReadToken;
    831841      Expect(AssignSymbol);
    832842    end;
    833     if NextToken = '(' then begin
    834       // Enumeration
    835       Result := ParseTypeEnumeration(TypeList, Name);
    836     end else
    837     if NextToken = 'record' then begin
    838       Result := ParseTypeRecord(TypeList, Name);
    839     end else
    840     if NextToken = 'class' then begin
    841       Expect('class');
    842       Result := TTypeClass.Create;
    843       TTypeClass(Result).Parent := TypeList;
    844       TTypeClass(Result).Name := Name;
    845       if NextToken <> ';' then begin
    846         while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do
    847         begin
    848           TTypeClass(Result).Items.Add(ParseType(TypeList, True, ':'));
    849           Expect(';');
    850         end;
    851         Expect('end');
    852       end;
    853     end else
    854     if NextToken = 'array' then begin
    855       Expect('array');
    856       Result := TTypeArray.Create;
    857       TTypeArray(Result).Parent := TypeList;
    858       TType(Result).Name := Name;
    859       if NextToken = '[' then begin
    860         Expect('[');
    861         TypeName := NextToken;
    862         TTypeArray(Result).IndexType := ParseType(TypeList, False);
    863         if not Assigned(TTypeArray(Result).IndexType) then
    864           ErrorMessage(SUndefinedType, [TypeName], -1);
    865         Expect(']');
    866       end;
    867       Expect('of');
    868       TypeName := NextToken;
    869       TTypeArray(Result).ItemType := ParseType(TypeList, False);
    870       if not Assigned(TTypeArray(Result).ItemType) then
    871         ErrorMessage(SUndefinedType, [TypeName], -1);
    872     end else
    873     if NextToken = '^' then begin
    874       // Pointer
    875       Expect('^');
    876       Result := TTypePointer.Create;
    877       TTypePointer(Result).Parent := TypeList;
    878       TTypePointer(Result).Name := Name;
    879       TTypePointer(Result).UsedType := ParseType(TypeList, False);
    880     end else
    881     if NextToken = 'type' then begin
     843    Result := ParseTypeEnumeration(TypeList, Name);
     844    if not Assigned(Result) then Result := ParseTypeRecord(TypeList, Name);
     845    if not Assigned(Result) then Result := ParseTypeClass(TypeList, Name);
     846    if not Assigned(Result) then Result := ParseTypeArray(TypeList, Name);
     847    if not Assigned(Result) then Result := ParseTypePointer(TypeList, Name);
     848    if not Assigned(Result) then Result := ParseTypeBase(TypeList, Name);
     849    if not Assigned(Result) then Result := ParseTypeSubType(TypeList, Name, ExpectName);
     850    if not Assigned(Result) then Result := ParseTypeSubRange(TypeList, Name);
     851    if not Assigned(Result) then
     852      ErrorMessage(SInvalidConstruction, []);
     853  end;
     854end;
     855
     856function TPascalParser.ParseTypeSubType(TypeList: TTypeList; Name: string;
     857  ExpectName: Boolean): TType;
     858var
     859  TypeName: string;
     860begin
     861      // Use existed type
     862      if NextTokenType = ttIdentifier then begin
     863        TypeName := ReadToken;
     864        if ExpectName then begin
     865          Result := TType.Create;
     866          TType(Result).Parent := TypeList;
     867          TType(Result).Name := Name;
     868          TType(Result).UsedType := TypeList.Search(TypeName);
     869          if not Assigned(TType(Result).UsedType) then
     870            ErrorMessage(SUndefinedType, [TypeName], -1);
     871        end else begin
     872          TType(Result) := TypeList.Search(TypeName);
     873          if not Assigned(TType(Result)) then
     874            ErrorMessage(SUndefinedType, [TypeName], -1);
     875        end;
     876      end else Result := nil;
     877end;
     878
     879function TPascalParser.ParseTypeBase(TypeList: TTypeList; Name: string): TType;
     880begin
    882881      // Buildin base type construction
    883       Expect('type');
    884       Result := TTypeInherited.Create;
    885       TTypeInherited(Result).Parent := TypeList;
    886       TTypeInherited(Result).Name := Name;
    887       if NextToken = '(' then begin
    888         Expect('(');
    889         TTypeInherited(Result).UsedType := ParseType(TypeList, False);
    890         Expect(')');
    891       end else TTypeInherited(Result).UsedType := nil;
    892     end else begin
    893       // Use existed type
    894       TypeName := ReadCode;
    895       if ExpectName then begin
    896         Result := TType.Create;
    897         TType(Result).Parent := TypeList;
    898         TType(Result).Name := Name;
    899         TType(Result).UsedType := TypeList.Search(TypeName);
    900         if not Assigned(TType(Result).UsedType) then
    901           ErrorMessage(SUndefinedType, [TypeName], -1);
    902       end else begin
    903         TType(Result) := TypeList.Search(TypeName);
    904         if not Assigned(TType(Result)) then
    905           ErrorMessage(SUndefinedType, [TypeName], -1);
    906       end;
    907     end;
    908   end;
     882      if NextToken = 'type' then begin
     883        Expect('type');
     884        Result := TTypeInherited.Create;
     885        TTypeInherited(Result).Parent := TypeList;
     886        TTypeInherited(Result).Name := Name;
     887        if NextToken = '(' then begin
     888          Expect('(');
     889          TTypeInherited(Result).UsedType := ParseType(TypeList, False);
     890          Expect(')');
     891        end else TTypeInherited(Result).UsedType := nil;
     892      end else Result := nil;
     893end;
     894
     895function TPascalParser.ParseTypePointer(TypeList: TTypeList; Name: string
     896  ): TType;
     897begin
     898      if NextToken = '^' then begin
     899        Expect('^');
     900        Result := TTypePointer.Create;
     901        TTypePointer(Result).Parent := TypeList;
     902        TTypePointer(Result).Name := Name;
     903        TTypePointer(Result).UsedType := ParseType(TypeList, False);
     904      end else Result := nil;
    909905end;
    910906
    911907function TPascalParser.ParseTypeEnumeration(TypeList: TTypeList; Name: string): TType;
    912908begin
     909  if NextToken = '(' then begin
    913910      Expect('(');
    914911      Result := TTypeEnumeration.Create;
    … …  
    917914      with TTypeEnumeration(Result) do
    918915      with TEnumItem(Items[Items.Add(TEnumItem.Create)]) do begin
    919         Name := ReadCode;
     916        Name := ReadToken;
    920917        if (NextToken = '=') and (NextTokenType = ttConstantNumber) then begin
    921918          Expect('=');
    922           Index := StrToInt(ReadCode);
     919          Index := StrToInt(ReadToken);
    923920        end;
    924921      end;
    … …  
    928925        with TTypeEnumeration(Result) do
    929926        with TEnumItem(Items[Items.Add(TEnumItem.Create)]) do begin
    930           Name := ReadCode;
     927          Name := ReadToken;
    931928          if (NextToken = '=') and (NextTokenType = ttConstantNumber) then begin
    932929            Expect('=');
    933             Index := StrToInt(ReadCode);
     930            Index := StrToInt(ReadToken);
    934931          end;
    935932        end;
    936933      end;
    937934      Expect(')');
     935  end else Result := nil;
    938936end;
    939937
    … …  
    946944  SectionType: TSectionType;
    947945begin
     946  if NextToken = 'record' then begin
    948947  SectionType := stVar;
    949948  Visibility := tvPublic;
    … …  
    990989          if IsIdentificator(NextToken) then
    991990            ParseVariableList(TTypeRecord(Result).CommonBlock.Variables, True)
    992             else ReadCode;
     991            else ReadToken;
    993992          //TTypeRecord(Result).CommonBlock.Types.Add(ParseType(TypeList, True, ':'));
    994993          //TType(TTypeRecord(Result).CommonBlock.Types.Last).Visibility := Visibility;
    … …  
    10011000  end;
    10021001  Expect('end');
     1002  end else Result := nil;
     1003end;
     1004
     1005function TPascalParser.ParseTypeClass(TypeList: TTypeList; Name: string
     1006  ): TType;
     1007begin
     1008  if NextToken = 'class' then begin
     1009      Expect('class');
     1010      Result := TTypeClass.Create;
     1011      TTypeClass(Result).Parent := TypeList;
     1012      TTypeClass(Result).Name := Name;
     1013      if NextToken <> ';' then begin
     1014        while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do
     1015        begin
     1016          TTypeClass(Result).Items.Add(ParseType(TypeList, True, ':'));
     1017          Expect(';');
     1018        end;
     1019        Expect('end');
     1020      end;
     1021  end else Result := nil;
     1022end;
     1023
     1024function TPascalParser.ParseTypeArray(TypeList: TTypeList; Name: string
     1025  ): TType;
     1026var
     1027  UseName: string;
     1028  UseType: TType;
     1029begin
     1030  if NextToken = 'array' then begin
     1031  Expect('array');
     1032  Result := TTypeArray.Create;
     1033  TTypeArray(Result).Parent := TypeList;
     1034  TType(Result).Name := Name;
     1035  if NextToken = '[' then begin
     1036    Expect('[');
     1037    UseName := NextToken;
     1038    if NextTokenType = ttIdentifier then begin
     1039      UseType := TypeList.Parent.Types.Search(UseName);
     1040      if not Assigned(TTypeArray(Result).IndexType) then
     1041        ErrorMessage(SUndefinedType, [UseName], -1) else
     1042        TTypeArray(Result).IndexType := UseType;
     1043    end else
     1044    if NextTokenType = ttConstantNumber then begin
     1045
     1046
     1047    end;
     1048    Expect(']');
     1049  end;
     1050  Expect('of');
     1051  UseName := NextToken;
     1052  TTypeArray(Result).ItemType := ParseType(TypeList, False);
     1053  if not Assigned(TTypeArray(Result).ItemType) then
     1054    ErrorMessage(SUndefinedType, [UseName], -1);
     1055  end else Result := nil;
     1056end;
     1057
     1058function TPascalParser.ParseTypeSubRange(TypeList: TTypeList; Name: string
     1059  ): TType;
     1060var
     1061  UseName: string;
     1062begin
     1063  if NextTokenType = ttConstantString then begin
     1064    Result := TTypeSubRange.Create;
     1065    TTypeSubRange(Result).Bottom := ReadToken;
     1066    Expect('..');
     1067    TTypeSubRange(Result).Top := ReadToken;
     1068  end else
     1069  if NextTokenType = ttConstantNumber then begin
     1070    Result := TTypeSubRange.Create;
     1071    TTypeSubRange(Result).Bottom := ReadToken;
     1072    Expect('..');
     1073    TTypeSubRange(Result).Top := ReadToken;
     1074  end else Result := nil;
    10031075end;
    10041076
    … …  
    10221094  with TUsedModule(SourceCode.Items[SourceCode.Add(TUsedModule.Create)]) do
    10231095  begin
    1024     Name := ReadCode;
     1096    Name := ReadToken;
    10251097    if NextToken = 'in' then begin
    10261098      Expect('in');
    1027       Location := ReadCode;
     1099      Location := ReadToken;
    10281100    end else Location := Name + '.pas';
    10291101    Module := SourceCode.ParentModule.ParentProgram.Modules.Search(Name);
    … …  
    10421114    with TUsedModule(SourceCode.Items[SourceCode.Add(TUsedModule.Create)]) do
    10431115    begin
    1044       Name := ReadCode;
     1116      Name := ReadToken;
    10451117      if NextToken = 'in' then begin
    10461118        Expect('in');
    1047         Location := ReadCode;
     1119        Location := ReadToken;
    10481120      end else Location := Name + '.pas';
    10491121      Module := SourceCode.ParentModule.ParentProgram.Modules.Search(Name);
Note: See TracChangeset for help on using the changeset viewer.