Ignore:
Timestamp:
Oct 21, 2010, 1:20:57 PM (14 years ago)
Author:
george
Message:
  • Enhanced: Tokenizerm, parsing of record type, generation C code for record type.
  • Added: Logging of debug information.
File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r75 r76  
    3737    procedure ParseVariable(SourceCode: TVariable; Exported: Boolean = False);
    3838    procedure ParseConstantList(SourceCode: TConstantList; Exported: Boolean = False);
    39     procedure ParseTypeList(SourceCode: TTypeList; Exported: Boolean = False);
     39    procedure ParseTypeList(SourceCode: TTypeList; Exported: Boolean = False;
     40      AssignSymbol: string = '=');
    4041    function ParseType(TypeList: TTypeList; ExpectName: Boolean = True; AssignSymbol: string = '='): TType;
    4142    function ParseTypeEnumeration(TypeList: TTypeList; Name: string): TType;
    … …  
    7172    Parser := TPascalParser.Create;
    7273    Parser.SourceCodeText := TStringList.Create;
     74    Parser.OnDebugLog := OnDebugLog;
    7375    Parser.ProgramCode := ProgramCode;
    7476    Parser.OnGetSource := OnGetSource;
    … …  
    224226            //  TExpression(SubItems[1]).Value[I - 1] := Byte(Identifier[I]);
    225227          end else begin
    226             TExpression(SubItems[1]).Value := StrToInt(Identifier);
     228            TExpression(SubItems[1]).Value := Identifier;
    227229          end;
    228230        end;
    … …  
    330332    end else
    331333    if NextToken = ';' then
     334      Result := nil
    332335    else begin
    333336      Result := nil;
    … …  
    565568
    566569        // Parse function result type
    567         if HaveResult then
    568         begin
     570        if HaveResult then begin
    569571          Expect(':');
    570572          TypeName := ReadCode;
    571573          NewValueType := Parent.Types.Search(TypeName);
    572574          if not Assigned(NewValueType) then
    573             ErrorMessage(SUndefinedType, [TypeName], -1)
    574           else
     575            ErrorMessage(SUndefinedType, [TypeName], -1);
     576(*          else
    575577          begin
    576578            ResultType := NewValueType;
    … …  
    581583              ValueType := NewValueType;
    582584            end;
    583           end;
     585          end;  *)
    584586        end;
    585587      end;
    … …  
    723725      end else
    724726        ErrorMessage(SRedefineIdentifier, [ConstantName], -1);
    725       Expect(':');
    726       TypeName := ReadCode;
    727       NewValueType := Parent.Types.Search(TypeName);
     727      if NextToken = ':' then begin
     728        Expect(':');
     729        TypeName := ReadCode;
     730        NewValueType := Parent.Types.Search(TypeName);
     731      end;
    728732      Expect('=');
    729733      ConstantValue := ReadCode;
    … …  
    747751{ TParserTypeList }
    748752
    749 procedure TPascalParser.ParseTypeList(SourceCode: TTypeList; Exported: Boolean = False);
     753procedure TPascalParser.ParseTypeList(SourceCode: TTypeList;
     754  Exported: Boolean = False; AssignSymbol: string = '=');
    750755var
    751756  NewType: TType;
    … …  
    754759  begin
    755760    while IsIdentificator(NextToken) do begin
    756       NewType := ParseType(SourceCode);
     761      NewType := ParseType(SourceCode, True, AssignSymbol);
    757762      if Assigned(NewType) then begin
    758763        NewType.Parent := SourceCode;
    … …  
    766771{ TParserType }
    767772
    768 function TPascalParser.ParseType(TypeList: TTypeList; ExpectName: Boolean = True; AssignSymbol: string = '='): TType;
     773function TPascalParser.ParseType(TypeList: TTypeList; ExpectName: Boolean = True;
     774  AssignSymbol: string = '='): TType;
    769775var
    770776  Name: string;
    … …  
    778784    end;
    779785    if NextToken = '(' then begin
     786      // Enumeration
    780787      Result := ParseTypeEnumeration(TypeList, Name);
    781788    end else
    … …  
    817824    end else
    818825    if NextToken = '^' then begin
     826      // Pointer
    819827      Expect('^');
    820828      Result := TTypePointer.Create;
    … …  
    824832    end else
    825833    if NextToken = 'type' then begin
     834      // Buildin base type construction
    826835      Expect('type');
    827836      Result := TTypeInherited.Create;
    … …  
    834843      end else TTypeInherited(Result).UsedType := nil;
    835844    end else begin
     845      // Use existed type
    836846      TypeName := ReadCode;
    837847      if ExpectName then begin
    … …  
    890900  SectionType := stVar;
    891901  Visibility := tvPublic;
    892       Expect('record');
    893       Result := TTypeRecord.Create;
    894       TTypeRecord(Result).Parent := TypeList;
    895       TTypeRecord(Result).CommonBlock.Parent := TypeList.Parent;
    896       TType(Result).Name := Name;
    897       while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do
    898       begin
    899         if NextToken = 'public' then begin
    900           Expect('public');
    901           Visibility := tvPublic;
    902         end else
    903         if NextToken = 'private' then begin
    904           Expect('private');
    905           Visibility := tvPrivate;
    906         end else
    907         if NextToken = 'published' then begin
    908           Expect('published');
    909           Visibility := tvPublished;
    910         end else
    911         if NextToken = 'protected' then begin
    912           Expect('protected');
    913           Visibility := tvProtected;
    914         end else
    915         if NextToken = 'var' then begin
    916           Expect('var');
    917           SectionType := stVar
    918         end else
    919         if NextToken = 'const' then begin
    920           Expect('const');
    921           SectionType := stConst
    922         end else
    923         if NextToken = 'type' then begin
    924           Expect('type');
    925           SectionType := stType;
    926         end;
    927 
    928         if SectionType = stVar then begin
    929           if NextToken = 'procedure' then
    930             ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
    931           else if NextToken = 'function' then
    932             ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
    933           else begin
     902  Expect('record');
     903  Result := TTypeRecord.Create;
     904  TTypeRecord(Result).Parent := TypeList;
     905  TTypeRecord(Result).CommonBlock.Parent := TypeList.Parent;
     906  TType(Result).Name := Name;
     907  while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do begin
     908    if NextToken = 'public' then begin
     909      Expect('public');
     910      Visibility := tvPublic;
     911    end else
     912    if NextToken = 'private' then begin
     913      Expect('private');
     914      Visibility := tvPrivate;
     915    end else
     916    if NextToken = 'published' then begin
     917      Expect('published');
     918      Visibility := tvPublished;
     919    end else
     920    if NextToken = 'protected' then begin
     921      Expect('protected');
     922      Visibility := tvProtected;
     923    end else
     924    if NextToken = 'var' then begin
     925      Expect('var');
     926      SectionType := stVar
     927    end else
     928    if NextToken = 'const' then begin
     929      Expect('const');
     930      SectionType := stConst
     931    end else
     932    if NextToken = 'type' then begin
     933      Expect('type');
     934      SectionType := stType;
     935    end else
     936    if NextToken = 'procedure' then
     937      ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
     938    else if NextToken = 'function' then
     939      ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
     940    else begin
     941      if SectionType = stVar then begin
     942          if IsIdentificator(NextToken) then
    934943            ParseVariableList(TTypeRecord(Result).CommonBlock.Variables, True)
    935             //TTypeRecord(Result).CommonBlock.Types.Add(ParseType(TypeList, True, ':'));
    936             //TType(TTypeRecord(Result).CommonBlock.Types.Last).Visibility := Visibility;
    937           end;                                                                          ParseVariableList(TTypeRecord(Result).CommonBlock.Variables)
    938         end
    939         else if SectionType = stConst then
    940           ParseConstantList(TTypeRecord(Result).CommonBlock.Constants, True)
    941         else if SectionType = stType then
    942           ParseTypeList(TTypeRecord(Result).CommonBlock.Types, True);
    943       end;
    944       Expect('end');
     944            else ReadCode;
     945          //TTypeRecord(Result).CommonBlock.Types.Add(ParseType(TypeList, True, ':'));
     946          //TType(TTypeRecord(Result).CommonBlock.Types.Last).Visibility := Visibility;
     947      end
     948      else if SectionType = stConst then
     949        ParseConstantList(TTypeRecord(Result).CommonBlock.Constants, True)
     950      else if SectionType = stType then
     951        ParseTypeList(TTypeRecord(Result).CommonBlock.Types, True, '=');
     952    end;
     953  end;
     954  Expect('end');
    945955end;
    946956
Note: See TracChangeset for help on using the changeset viewer.