Ignore:
Timestamp:
Oct 22, 2010, 1:19:34 PM (14 years ago)
Author:
george
Message:
  • Modified: Moved Expect check of blocks inside check procedures.
File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r78 r79  
    3131    function ParseCommand(SourceCode: TCommonBlock): TCommand;
    3232    procedure ParseBeginEnd(SourceCode: TBeginEnd);
    33     procedure ParseFunctionList(SourceCode: TFunctionList; Exported: Boolean = False);
     33    function ParseFunctionList(SourceCode: TFunctionList; Exported: Boolean = False): Boolean;
    3434    procedure ParseFunctionParameters(SourceCode: TFunction);
    3535    procedure ParseIfThenElse(SourceCode: TIfThenElse);
    3636    procedure ParseForToDo(SourceCode: TForToDo);
    37     procedure ParseVariableList(SourceCode: TVariableList; Exported: Boolean = False);
    38     procedure ParseVariable(SourceCode: TVariable; Exported: Boolean = False);
    39     procedure ParseConstantList(SourceCode: TConstantList; Exported: Boolean = False);
    40     procedure ParseTypeList(SourceCode: TTypeList; Exported: Boolean = False;
    41       AssignSymbol: string = '=');
     37    function ParseVariableList(SourceCode: TVariableList; Exported: Boolean = False): Boolean;
     38    procedure ParseVariable(SourceCode: TVariableList; Exported: Boolean = False);
     39    function ParseConstantList(SourceCode: TConstantList; Exported: Boolean = False): Boolean;
     40    function ParseConstant(SourceCode: TConstantList; Exported: Boolean = False): Boolean;
     41    function ParseTypeList(SourceCode: TTypeList; Exported: Boolean = False;
     42      AssignSymbol: string = '='): Boolean;
    4243    function ParseType(TypeList: TTypeList; ExpectName: Boolean = True; AssignSymbol: string = '='): TType;
    4344    function ParseTypeSubType(TypeList: TTypeList; Name: string; ExpectName: Boolean): TType;
    … …  
    441442  with SourceCode do begin
    442443    while (NextToken <> EndSymbol) do begin
    443       if NextToken = 'var' then begin
    444         Expect('var');
    445         ParseVariableList(Variables)
    446       end else
    447       if NextToken = 'const' then begin
    448         Expect('const');
    449         ParseConstantList(Constants)
    450       end else
    451       if NextToken = 'type' then begin
    452         Expect('type');
    453         ParseTypeList(Types);
    454       end else
    455       if NextToken = 'procedure' then
    456         ParseFunctionList(Functions)
    457       else if NextToken = 'function' then
    458         ParseFunctionList(Functions)
    459       else begin
     444      if not ParseVariableList(Variables) then
     445      if not ParseConstantList(Constants) then
     446      if not ParseTypeList(Types) then
     447      if not ParseFunctionList(Functions) then begin
    460448        if WithBody then
    461449          ParseBeginEnd(Code);
    … …  
    471459  with SourceCode do begin
    472460    while (NextToken <> 'implementation') and (NextTokenType <> ttEndOfFile) do begin
    473       if NextToken = 'var' then begin
    474         Expect('var');
    475         ParseVariableList(Variables);
    476       end else
    477       if NextToken = 'const' then begin
    478         Expect('const');
    479         ParseConstantList(Constants, True);
    480       end else
    481       if NextToken = 'type' then begin
    482         Expect('type');
    483         ParseTypeList(Types, True);
    484       end else
    485       if NextToken = 'procedure' then
    486         ParseFunctionList(Functions, True)
    487       else if NextToken = 'function' then
    488         ParseFunctionList(Functions, True)
    489       else begin
     461      if not ParseVariableList(Variables, True) then
     462      if not ParseConstantList(Constants, True) then
     463      if not ParseTypeList(Types, True) then
     464      if not ParseFunctionList(Functions, True) then begin
    490465        ErrorMessage(SUnknownIdentifier, [NextToken], -1);
    491466        ReadToken;
    … …  
    520495{ TParserParseFunctionList }
    521496
    522 procedure TPascalParser.ParseFunctionList(SourceCode: TFunctionList;
    523   Exported: Boolean = False);
     497function TPascalParser.ParseFunctionList(SourceCode: TFunctionList;
     498  Exported: Boolean = False): Boolean;
    524499var
    525500  NewValueType: TType;
    … …  
    531506  FunctionType: TFunctionType;
    532507begin
     508  if (NextToken = 'procedure') or (NextToken = 'function') then begin
    533509  with SourceCode do begin
    534510    if NextToken = 'procedure' then begin
    … …  
    607583//    if UseFunction then UseFunction.Code ;
    608584  end;
     585    Result := True;
     586  end else Result := False;
    609587end;
    610588
    … …  
    704682{ TParserVariableList }
    705683
    706 procedure TPascalParser.ParseVariableList(SourceCode: TVariableList; Exported: Boolean = False);
    707 var
    708   Identifiers: TStringList;
     684function TPascalParser.ParseVariableList(SourceCode: TVariableList; Exported: Boolean = False): Boolean;
     685var
    709686  NewValueType: TType;
    710687  TypeName: string;
     688  I: integer;
     689begin
     690  if NextToken = 'var' then begin
     691    Expect('var');
     692    with SourceCode do begin
     693      while IsIdentificator(NextToken) and (NextTokenType <> ttEndOfFile) do begin
     694        ParseVariable(SourceCode, Exported);
     695      end;
     696    end;
     697    Result := True;
     698  end else Result := False;
     699end;
     700
     701{ TParserVariable }
     702
     703procedure TPascalParser.ParseVariable(SourceCode: TVariableList; Exported: Boolean = False);
     704var
    711705  VariableName: string;
    712706  Variable: TVariable;
    713   I: integer;
     707  TypeName: string;
     708  NewValueType: TType;
     709  Identifiers: TStringList;
     710  I: Integer;
    714711begin
    715712  try
    716   Identifiers := TStringList.Create;
     713    Identifiers := TStringList.Create;
    717714  with SourceCode do begin
    718     while IsIdentificator(NextToken) and (NextTokenType <> ttEndOfFile) do begin
    719715      Identifiers.Clear;
    720716      VariableName := ReadToken;
    … …  
    740736          end;
    741737      Expect(';');
    742     end;
    743738  end;
    744739  finally
    … …  
    747742end;
    748743
    749 { TParserVariable }
    750 
    751 procedure TPascalParser.ParseVariable(SourceCode: TVariable; Exported: Boolean = False);
    752 begin
    753   with SourceCode do begin
    754     Name := NextToken;
    755     Expect(':=');
    756 
    757   end;
    758 end;
    759 
    760744{ TParserConstantList }
    761745
    762 procedure TPascalParser.ParseConstantList(SourceCode: TConstantList; Exported: Boolean = False);
     746function TPascalParser.ParseConstantList(SourceCode: TConstantList; Exported: Boolean = False): Boolean;
     747begin
     748  if NextToken = 'const' then begin
     749    Expect('const');
     750    with SourceCode do begin
     751      while IsIdentificator(NextToken) do begin
     752        ParseConstant(SourceCode, Exported);
     753      end;
     754    end;
     755    Result := True;
     756  end else Result := False;
     757end;
     758
     759function TPascalParser.ParseConstant(SourceCode: TConstantList;
     760  Exported: Boolean): Boolean;
    763761var
    764762  Identifiers: TStringList;
    … …  
    770768  ConstantValue: string;
    771769begin
    772   Identifiers := TStringList.Create;
    773   with SourceCode do begin
    774     while IsIdentificator(NextToken) do begin
     770  with SourceCode do
     771  try
     772    Identifiers := TStringList.Create;
    775773      ConstantName := ReadToken;
    776774      Constant := Search(ConstantName);
    … …  
    802800            Value := ConstantValue;
    803801          end;
    804     end;
    805   end;
    806   Identifiers.Destroy;
     802  finally
     803    Identifiers.Free;
     804  end;
    807805end;
    808806
    809807{ TParserTypeList }
    810808
    811 procedure TPascalParser.ParseTypeList(SourceCode: TTypeList;
    812   Exported: Boolean = False; AssignSymbol: string = '=');
     809function TPascalParser.ParseTypeList(SourceCode: TTypeList;
     810  Exported: Boolean = False; AssignSymbol: string = '='): Boolean;
    813811var
    814812  NewType: TType;
    815813begin
    816   with SourceCode do
    817   begin
    818     while IsIdentificator(NextToken) do begin
    819       NewType := ParseType(SourceCode, True, AssignSymbol);
    820       if Assigned(NewType) then begin
    821         NewType.Parent := SourceCode;
    822         Add(NewType);
    823       end;
    824       Expect(';');
    825     end;
    826   end;
     814  if NextToken = 'type' then begin
     815    Expect('type');
     816    with SourceCode do begin
     817      while IsIdentificator(NextToken) do begin
     818        NewType := ParseType(SourceCode, True, AssignSymbol);
     819        if Assigned(NewType) then begin
     820          NewType.Parent := SourceCode;
     821          Add(NewType);
     822        end;
     823        Expect(';');
     824      end;
     825    end;
     826    Result := True;
     827  end else Result := False
    827828end;
    828829
    … …  
    859860  TypeName: string;
    860861begin
    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;
     862  // Use existed type
     863  if NextTokenType = ttIdentifier then begin
     864    TypeName := ReadToken;
     865    if ExpectName then begin
     866      Result := TType.Create;
     867      TType(Result).Parent := TypeList;
     868      TType(Result).Name := Name;
     869      TType(Result).UsedType := TypeList.Search(TypeName);
     870      if not Assigned(TType(Result).UsedType) then
     871        ErrorMessage(SUndefinedType, [TypeName], -1);
     872    end else begin
     873      TType(Result) := TypeList.Search(TypeName);
     874      if not Assigned(TType(Result)) then
     875        ErrorMessage(SUndefinedType, [TypeName], -1);
     876    end;
     877  end else Result := nil;
    877878end;
    878879
    … …  
    896897  ): TType;
    897898begin
    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;
     899  if NextToken = '^' then begin
     900    Expect('^');
     901    Result := TTypePointer.Create;
     902    TTypePointer(Result).Parent := TypeList;
     903    TTypePointer(Result).Name := Name;
     904    TTypePointer(Result).UsedType := ParseType(TypeList, False);
     905  end else Result := nil;
    905906end;
    906907
    … …  
    945946begin
    946947  if NextToken = 'record' then begin
    947   SectionType := stVar;
    948   Visibility := tvPublic;
    949   Expect('record');
    950   Result := TTypeRecord.Create;
    951   TTypeRecord(Result).Parent := TypeList;
    952   TTypeRecord(Result).CommonBlock.Parent := TypeList.Parent;
    953   TType(Result).Name := Name;
    954   while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do begin
    955     if NextToken = 'public' then begin
    956       Expect('public');
    957       Visibility := tvPublic;
    958     end else
    959     if NextToken = 'private' then begin
    960       Expect('private');
    961       Visibility := tvPrivate;
    962     end else
    963     if NextToken = 'published' then begin
    964       Expect('published');
    965       Visibility := tvPublished;
    966     end else
    967     if NextToken = 'protected' then begin
    968       Expect('protected');
    969       Visibility := tvProtected;
    970     end else
    971     if NextToken = 'var' then begin
    972       Expect('var');
    973       SectionType := stVar;
    974     end else
    975     if NextToken = 'const' then begin
    976       Expect('const');
    977       SectionType := stConst;
    978     end else
    979     if NextToken = 'type' then begin
    980       Expect('type');
    981       SectionType := stType;
    982     end else
    983     if NextToken = 'procedure' then
    984       ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
    985     else if NextToken = 'function' then
    986       ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
    987     else begin
    988       if SectionType = stVar then begin
     948    Expect('record');
     949    SectionType := stVar;
     950    Visibility := tvPublic;
     951    Result := TTypeRecord.Create;
     952    TTypeRecord(Result).Parent := TypeList;
     953    TTypeRecord(Result).CommonBlock.Parent := TypeList.Parent;
     954    TType(Result).Name := Name;
     955    while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do begin
     956      if NextToken = 'public' then begin
     957        Expect('public');
     958        Visibility := tvPublic;
     959      end else
     960      if NextToken = 'private' then begin
     961        Expect('private');
     962        Visibility := tvPrivate;
     963      end else
     964      if NextToken = 'published' then begin
     965        Expect('published');
     966        Visibility := tvPublished;
     967      end else
     968      if NextToken = 'protected' then begin
     969        Expect('protected');
     970        Visibility := tvProtected;
     971      end else
     972      if NextToken = 'var' then begin
     973        SectionType := stVar;
     974        ParseVariableList(TTypeRecord(Result).CommonBlock.Variables, True);
     975      end else
     976      if NextToken = 'const' then begin
     977        SectionType := stConst;
     978        ParseConstantList(TTypeRecord(Result).CommonBlock.Constants, True)
     979      end else
     980      if NextToken = 'type' then begin
     981        SectionType := stType;
     982        ParseTypeList(TTypeRecord(Result).CommonBlock.Types, True, '=');
     983      end else
     984      if NextToken = 'procedure' then
     985        ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
     986      else if NextToken = 'function' then
     987        ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
     988      else begin
     989        if SectionType = stVar then begin
    989990          if IsIdentificator(NextToken) then
    990             ParseVariableList(TTypeRecord(Result).CommonBlock.Variables, True)
    991             else ReadToken;
    992           //TTypeRecord(Result).CommonBlock.Types.Add(ParseType(TypeList, True, ':'));
    993           //TType(TTypeRecord(Result).CommonBlock.Types.Last).Visibility := Visibility;
    994       end
    995       else if SectionType = stConst then
    996         ParseConstantList(TTypeRecord(Result).CommonBlock.Constants, True)
    997       else if SectionType = stType then
    998         ParseTypeList(TTypeRecord(Result).CommonBlock.Types, True, '=');
    999     end;
    1000   end;
    1001   Expect('end');
     991            ParseVariable(TTypeRecord(Result).CommonBlock.Variables, True)
     992              else ReadToken;
     993            //TTypeRecord(Result).CommonBlock.Types.Add(ParseType(TypeList, True, ':'));
     994            //TType(TTypeRecord(Result).CommonBlock.Types.Last).Visibility := Visibility;
     995        end
     996        else if SectionType = stConst then
     997          ParseConstant(TTypeRecord(Result).CommonBlock.Constants, True)
     998        else if SectionType = stType then
     999          ParseType(TTypeRecord(Result).CommonBlock.Types, True, '=');
     1000      end;
     1001    end;
     1002    Expect('end');
    10021003  end else Result := nil;
    10031004end;
    … …  
    10291030begin
    10301031  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('[');
     1032    Expect('array');
     1033    Result := TTypeArray.Create;
     1034    TTypeArray(Result).Parent := TypeList;
     1035    TType(Result).Name := Name;
     1036    if NextToken = '[' then begin
     1037      Expect('[');
     1038      UseName := NextToken;
     1039      if NextTokenType = ttIdentifier then begin
     1040        UseType := TypeList.Parent.Types.Search(UseName);
     1041        if not Assigned(TTypeArray(Result).IndexType) then
     1042          ErrorMessage(SUndefinedType, [UseName], -1) else
     1043          TTypeArray(Result).IndexType := UseType;
     1044      end else
     1045      if NextTokenType = ttConstantNumber then begin
     1046        UseType := ParseTypeSubRange(TypeList, Name);
     1047        if not Assigned(UseType) then begin
     1048          ErrorMessage(SInvalidConstruction, [], -1);
     1049        end;
     1050      end;
     1051      Expect(']');
     1052    end;
     1053    Expect('of');
    10371054    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    TTypeArray(Result).ItemType := ParseType(TypeList, False);
     1056    if not Assigned(TTypeArray(Result).ItemType) then
     1057      ErrorMessage(SUndefinedType, [UseName], -1);
    10551058  end else Result := nil;
    10561059end;
Note: See TracChangeset for help on using the changeset viewer.