Ignore:
Timestamp:
Nov 10, 2010, 9:42:27 AM (13 years ago)
Author:
george
Message:
  • Added: Parsing type parameters.
  • Fixed: Saving edited files.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/Compiler/Analyze/UAnalyzerPascal.pas

    r21 r24  
    5050    function ParseType(TypeList: TTypeList; var NewType: TType; ExpectName: Boolean = True;
    5151      AssignSymbol: string = '='; ForwardDeclaration: Boolean = False): Boolean;
    52     function ParseTypeSubType(TypeList: TTypeList; var NewType: TType; Name: string;
     52    function ParseTypeParameters(var NewType: TType): Boolean;
     53    function ParseTypeSubType(var NewType: TType;
    5354      ExpectName: Boolean; ForwardDeclaration: Boolean): Boolean;
    54     function ParseTypeBase(TypeList: TTypeList; var NewType: TType; Name: string): Boolean;
    55     function ParseTypePointer(TypeList: TTypeList; var NewType: TType; Name: string): Boolean;
    56     function ParseTypeEnumeration(TypeList: TTypeList; var NewType: TType; Name: string): Boolean;
    57     function ParseTypeRecord(TypeList: TTypeList; var NewType: TType; Name: string): Boolean;
    58     function ParseTypeClass(TypeList: TTypeList; var NewType: TType; Name: string): Boolean;
    59     function ParseTypeArray(TypeList: TTypeList; var NewType: TType; Name: string): Boolean;
    60     function ParseTypeSubRange(TypeList: TTypeList; var NewType: TType; Name: string): Boolean;
     55    function ParseTypeBase(var NewType: TType): Boolean;
     56    function ParseTypePointer(var NewType: TType): Boolean;
     57    function ParseTypeEnumeration(var NewType: TType): Boolean;
     58    function ParseTypeRecord(var NewType: TType): Boolean;
     59    function ParseTypeClass(var NewType: TType): Boolean;
     60    function ParseTypeArray(var NewType: TType): Boolean;
     61    function ParseTypeSubRange(var NewType: TType): Boolean;
    6162    constructor Create;
    6263    destructor Destroy; override;
    … …  
    10241025function TAnalyzerPascal.ParseType(TypeList: TTypeList; var NewType: TType; ExpectName: Boolean = True;
    10251026  AssignSymbol: string = '='; ForwardDeclaration: Boolean = False): Boolean;
    1026 var
    1027   Name: string;
    1028   TypeName: string;
    1029 begin
    1030   NewType := nil;
     1027begin
     1028  NewType := TType.Create;
     1029  NewType.Parent := TypeList;
    10311030  //with SourceCode do
    10321031  begin
    10331032    if ExpectName then begin
    1034       Name := ReadToken;
     1033      NewType.Name := ReadToken;
     1034      if ParseTypeParameters(NewType) then ;
    10351035      Expect(AssignSymbol);
    10361036    end;
    10371037
    10381038    Result := True;
    1039     if not ParseTypeEnumeration(TypeList, NewType, Name) then
    1040     if not ParseTypeRecord(TypeList, NewType, Name) then
    1041     if not ParseTypeClass(TypeList, NewType, Name) then
    1042     if not ParseTypeArray(TypeList, NewType, Name) then
    1043     if not ParseTypePointer(TypeList, NewType, Name) then
    1044     if not ParseTypeBase(TypeList, NewType, Name) then
    1045     if not ParseTypeSubType(TypeList, NewType, Name, ExpectName, ForwardDeclaration) then
    1046     if not ParseTypeSubRange(TypeList, NewType, Name) then begin
     1039    if not ParseTypeEnumeration(NewType) then
     1040    if not ParseTypeRecord(NewType) then
     1041    if not ParseTypeClass(NewType) then
     1042    if not ParseTypeArray(NewType) then
     1043    if not ParseTypePointer(NewType) then
     1044    if not ParseTypeBase(NewType) then
     1045    if not ParseTypeSubType(NewType, ExpectName, ForwardDeclaration) then
     1046    if not ParseTypeSubRange(NewType) then begin
    10471047      ErrorMessage(SInvalidConstruction, [NextToken]);
     1048      NewType.Free;
    10481049      Result := False;
    10491050    end;
    … …  
    10511052end;
    10521053
    1053 function TAnalyzerPascal.ParseTypeSubType(TypeList: TTypeList; var NewType: TType; Name: string;
     1054function TAnalyzerPascal.ParseTypeParameters(var NewType: TType): Boolean;
     1055var
     1056  NewType2: TType;
     1057begin
     1058  if NextToken = '<' then begin
     1059    Expect('<');
     1060    while ((NextToken = ',') or (NewType.Parameters.Count = 0)) and (NextTokenType <> ttEndOfFile) do begin
     1061      if NewType.Parameters.Count > 0 then Expect(',');
     1062      NewType2 := TType.Create;
     1063      NewType2.Name := ReadToken;
     1064      NewType2.Parent := NewType.Parent;
     1065      NewType.Parameters.Add(NewType2);
     1066    end;
     1067    Expect('>');
     1068    Result := True;
     1069  end else Result := False;
     1070end;
     1071
     1072function TAnalyzerPascal.ParseTypeSubType(var NewType: TType;
    10541073  ExpectName: Boolean; ForwardDeclaration: Boolean): Boolean;
    10551074var
    10561075  TypeName: string;
     1076  TempType: TType;
    10571077begin
    10581078  Result := False;
    1059   NewType := nil;
    10601079  // Use existed type
    10611080  if NextTokenType = ttIdentifier then begin
    10621081    TypeName := ReadToken;
    10631082    if ExpectName then begin
    1064       NewType := TType.Create;
    1065       NewType.Parent := TypeList;
    1066       NewType.Name := Name;
    1067       NewType.UsedType := TypeList.Search(TypeName);
     1083      NewType.UsedType := NewType.Parent.Search(TypeName);
    10681084      Result := True;
    10691085      if not Assigned(NewType.UsedType) then
    10701086        ErrorMessage(SUndefinedType, [TypeName], -1);
    10711087    end else begin
    1072       NewType := TypeList.Search(TypeName);
     1088      NewType := NewType.Parent.Search(TypeName);
    10731089      if not Assigned(TType(NewType)) then begin
    10741090        if ForwardDeclaration then begin
    10751091          // ForwardDeclaration
    1076           NewType := TType.Create;
    1077           NewType.Parent := TypeList;
    10781092          NewType.Name := TypeName;
    10791093          NewType.UsedType := nil;
    … …  
    10861100end;
    10871101
    1088 function TAnalyzerPascal.ParseTypeBase(TypeList: TTypeList; var NewType: TType; Name: string): Boolean;
     1102function TAnalyzerPascal.ParseTypeBase(var NewType: TType): Boolean;
     1103var
     1104  TempType: TType;
    10891105begin
    10901106  // Buildin base type construction
    10911107  if NextToken = 'type' then begin
    10921108    Expect('type');
     1109    TempType := NewType;
    10931110    NewType := TTypeInherited.Create;
    1094     NewType.Parent := TypeList;
    1095     NewType.Name := Name;
     1111    NewType.Assign(TempType);
     1112    TempType.Free;
    10961113    if NextToken = '(' then begin
    10971114      Expect('(');
    1098       if ParseType(TypeList, NewType.UsedType, False) then ;
     1115      if ParseType(NewType.Parent, NewType.UsedType, False) then ;
    10991116      Expect(')');
    11001117    end else NewType.UsedType := nil;
    … …  
    11031120end;
    11041121
    1105 function TAnalyzerPascal.ParseTypePointer(TypeList: TTypeList; var NewType: TType; Name: string
    1106   ): Boolean;
     1122function TAnalyzerPascal.ParseTypePointer(var NewType: TType): Boolean;
     1123var
     1124  TempType: TType;
    11071125begin
    11081126  if NextToken = '^' then begin
    11091127    Expect('^');
     1128    TempType := NewType;
    11101129    NewType := TTypePointer.Create;
    1111     NewType.Parent := TypeList;
    1112     NewType.Name := Name;
    1113     Result := ParseType(TypeList, NewType.UsedType, False, '=', True);
    1114   end else Result := False;
    1115 end;
    1116 
    1117 function TAnalyzerPascal.ParseTypeEnumeration(TypeList: TTypeList; var NewType: TType;
    1118   Name: string): Boolean;
     1130    NewType.Assign(TempType);
     1131    TempType.Free;
     1132    Result := ParseType(NewType.Parent, NewType.UsedType, False, '=', True);
     1133  end else Result := False;
     1134end;
     1135
     1136function TAnalyzerPascal.ParseTypeEnumeration(var NewType: TType
     1137  ): Boolean;
     1138var
     1139  TempType: TType;
    11191140begin
    11201141  if NextToken = '(' then begin
    11211142      Expect('(');
     1143      TempType := NewType;
    11221144      NewType := TTypeEnumeration.Create;
    1123       NewType.Parent := TypeList;
    1124       NewType.Name := Name;
     1145      NewType.Assign(TempType);
     1146      TempType.Free;
    11251147      with TTypeEnumeration(NewType) do
    11261148      with TEnumItem(Items[Items.Add(TEnumItem.Create)]) do begin
    … …  
    11481170end;
    11491171
    1150 function TAnalyzerPascal.ParseTypeRecord(TypeList: TTypeList; var NewType: TType; Name: string
    1151   ): Boolean;
     1172function TAnalyzerPascal.ParseTypeRecord(var NewType: TType): Boolean;
    11521173var
    11531174  Visibility: TTypeVisibility;
    11541175  SectionType: TCommonBlockSection;
    11551176  NewType2: TType;
     1177  TempType: TType;
    11561178begin
    11571179  if NextToken = 'record' then begin
    … …  
    11591181    SectionType := cbsVariable;
    11601182    Visibility := tvPublic;
     1183    TempType := NewType;
    11611184    NewType := TTypeRecord.Create;
    1162     NewType.Parent := TypeList;
    1163     TTypeRecord(NewType).CommonBlock.Parent := TypeList.Parent;
    1164     NewType.Name := Name;
     1185    NewType.Assign(TempType);
     1186    TempType.Free;
     1187    TTypeRecord(NewType).CommonBlock.Parent := NewType.Parent.Parent;
    11651188    while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do begin
    11661189      // Visibility sections
    … …  
    12201243end;
    12211244
    1222 function TAnalyzerPascal.ParseTypeClass(TypeList: TTypeList; var NewType: TType; Name: string
     1245function TAnalyzerPascal.ParseTypeClass(var NewType: TType
    12231246  ): Boolean;
    12241247var
    12251248  NewType2: TType;
     1249  TempType: TType;
    12261250begin
    12271251  if NextToken = 'class' then begin
    12281252    Expect('class');
     1253    TempType := NewType;
    12291254    NewType := TTypeClass.Create;
    1230     NewType.Parent := TypeList;
    1231     NewType.Name := Name;
     1255    NewType.Assign(TempType);
     1256    TempType.Free;
    12321257    if NextToken <> ';' then begin
    12331258      while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do
    12341259      begin
    1235         if ParseType(TypeList, NewType2, True, ':') then begin
    1236           NewType2.Parent := TypeList;
     1260        if ParseType(NewType.Parent, NewType2, True, ':') then begin
     1261          NewType2.Parent := NewType.Parent;
    12371262          TTypeClass(NewType).Items.Add(NewType2);
    12381263        end;
    … …  
    12451270end;
    12461271
    1247 function TAnalyzerPascal.ParseTypeArray(TypeList: TTypeList; var NewType: TType; Name: string
    1248   ): Boolean;
     1272function TAnalyzerPascal.ParseTypeArray(var NewType: TType): Boolean;
    12491273var
    12501274  UseName: string;
    12511275  UseType: TType;
     1276  TempType: TType;
    12521277begin
    12531278  if NextToken = 'array' then begin
    12541279    Expect('array');
     1280    TempType := NewType;
    12551281    NewType := TTypeArray.Create;
    1256     NewType.Parent := TypeList;
    1257     NewType.Name := Name;
     1282    NewType.Assign(TempType);
     1283    TempType.Free;
    12581284    if NextToken = '[' then begin
    12591285      Expect('[');
    12601286      UseName := NextToken;
    12611287      if NextTokenType = ttIdentifier then begin
    1262         TTypeArray(NewType).IndexType := TypeList.Parent.Types.Search(UseName);
     1288        TTypeArray(NewType).IndexType := NewType.Parent.Parent.Types.Search(UseName);
    12631289        if not Assigned(TTypeArray(NewType).IndexType) then
    12641290          ErrorMessage(SUndefinedType, [UseName], -1);
    12651291      end else
    12661292      if NextTokenType = ttConstantNumber then begin
    1267         ParseTypeSubRange(TypeList, TTypeArray(NewType).IndexType, Name);
     1293        ParseTypeSubRange(TTypeArray(NewType).IndexType);
    12681294        if not Assigned(TTypeArray(NewType).IndexType) then begin
    12691295          ErrorMessage(SInvalidConstruction, [NextToken], -1);
    … …  
    12741300    Expect('of');
    12751301    UseName := NextToken;
    1276     Result := ParseType(TypeList, TTypeArray(NewType).ItemType, False);
     1302    Result := ParseType(NewType.Parent, TTypeArray(NewType).ItemType, False);
    12771303    if not Assigned(TTypeArray(NewType).ItemType) then
    12781304      ErrorMessage(SUndefinedType, [UseName], -1);
    … …  
    12801306end;
    12811307
    1282 function TAnalyzerPascal.ParseTypeSubRange(TypeList: TTypeList; var NewType: TType;
    1283   Name: string): Boolean;
     1308function TAnalyzerPascal.ParseTypeSubRange(var NewType: TType): Boolean;
    12841309var
    12851310  UseName: string;
     1311  TempType: TType;
    12861312begin
    12871313  if NextTokenType = ttConstantString then begin
     1314    TempType := NewType;
    12881315    NewType := TTypeSubRange.Create;
     1316    NewType.Assign(TempType);
     1317    TempType.Free;
    12891318    TTypeSubRange(NewType).Bottom := ReadToken;
    12901319    Expect('..');
    … …  
    12931322  end else
    12941323  if NextTokenType = ttConstantNumber then begin
     1324    TempType := NewType;
    12951325    NewType := TTypeSubRange.Create;
     1326    NewType.Assign(TempType);
     1327    TempType.Free;
    12961328    TTypeSubRange(NewType).Bottom := ReadToken;
    12971329    Expect('..');
Note: See TracChangeset for help on using the changeset viewer.