uidentparser.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

            end;
          end
         else                          //is a function type?
          if (lc = 'function') or (lc = 'procedure') then  //parse the function
           begin
            if TypeKind = ptkArrayIndex then
             Exception(etSyntax,
                       'Found procedural type as index type of an array!');

            Result := ParseFunctionType(FuncKind[lc = 'function'])    //type
           end
          else
           if lc = ';' then            //empty type?
            Exception(etSyntax, 'Expecting type, found just ";"!')
           else
            begin  //[Unit.]Type-Identifier or SubRange

             assert(Token <> '');
             include(EndDirectives, aedPortability);

             lc := Token;
             PushPosition;                        //parse (first) expression
             if ParseConstantExpression(lc,
                                        EndDirectives - [aedEqual]) = '..' then
              begin                               //it's a sub range?
               LosePosition;

               Token := '';                         //parse end of range
               NextToken := ParseConstantExpression(Token, EndDirectives);

               Result := TSubRangeType.Create;
               try
                 TSubRangeType(Result).FromDefText := lc;   //set lower range
                 TSubRangeType(Result).ToDefText := Token;  //set upper range
               except
                 Result.Free;
                 raise
               end;
              end  // if SubRange
             else
              begin
               PopPosition;                       //parse type again (with "=")
               NextToken := ParseConstantExpression(Token, EndDirectives);


               //replace all " . " with "."
               repeat
                 Index := pos(' . ', Token);        //search for " . "
                 if Index <> 0 then                 //another " . " found?
                  begin
                   Delete(Token, Index, 2);           //replace it
                   Token[Index] := '.';
                  end;
               //until all occurences replaced
               until Index = 0;

               if pos(' ', Token) <> 0 then       //multiple tokens?
                Exception(etSyntax,
                          'Expected simple type-identifier, but found multiple tokens!');

               Result := TIdentType.Create;
               try
                 //is an constant open array parameter?
                 if (TypeKind = ptkArrayOfParameter) and (Token = 'const') then
                  //set type of the constants
                  TIdentType(Result).DefIdent := 'System.TVarRec'
                 else
                  TIdentType(Result).DefIdent := Token; //set the identifier
               except
                 Result.Free;
                 raise
               end;
              end; // else SubRange (just a type identifier)
            end; // type identifier or sub range

      if IsPacked then                         //is a packed type?
       if Result is TPackableType then           //type can be packed?
        TPackableType(Result).IsPacked := True     //set it is packed
       else
        Exception(etSyntax, 'Found "packed" but type is not a packable type!');
     end;
   end;

 assert(assigned(Result));
 Result.InFile := FThisFile;
end;





{Parses and returns a simple type (identifier or string) used by return types
 of functions or the type of properties.
~result the new object of the parsed return type }
function TIdentifierParser.ParseFunctionReturnType: TType;
var      Token            :String;   //a token
begin
 PushPosition;
 if not GetToken(Token) or IsEndOfStmtToken(Token) then //get first token
  begin
   LosePosition;
   Exception(etSyntax, 'Unexpected end in return-type-declaration!');
  end;

 if LowerCase(Token) = 'string' then //it's a string?
  begin
   LosePosition;
   Result := TStringType.Create;       //return a string type-object
  end
 else
  begin                              //must be an identifier
   PopPosition;                        //restore save position

   if not GetIdentWithPointsToken(Token) then //read identifier
    Exception(etSyntax, 'Unexpected end in return-type-declaration!');

   Result := TIdentType.Create;
   try
     TIdentType(Result).DefIdent := Token; //return the identifier type-object
   except
     Result.Free;
     raise
   end;
  end;
end;

{Parses the list of items of an enumeration. For each item of the enumeration
 an object will be created and added to ~[link FActualScopeIdents].
~param EnumType the object for the type of the enumeration }
procedure TIdentifierParser.ParseEnumItemList(EnumType: TEnumType);
var       Token            :String;        //a token
          Init             :String;        //the value of the enumeration item
          Item             :TEnumTypeItem; //the item of the enumeration
          SinceLastInit    :Integer;       //items since last item with value
          LastEnum         :TEnumTypeItem; //the last item with a set value
begin
 SinceLastInit := 0;                       //no items parsed so far
 LastEnum := nil;                          //and also no with a set value
 repeat
   if not GetToken(Token) then             //get name of item
    Exception(etSyntax, 'Unexpected end in EnumType-declaration!');

   CheckIdentifierName(Token, 'enumeration item'); //check the name

   Item := TEnumTypeItem.Create;           //create an object for the item
   try
     Item.Name := Token;                   //set name
     Item.EnumType := EnumType;            //set enumeration type

     SetPosition(Item);                    //save position
     Item.Scope := FGlobalScope;           //use current file scope

     if not GetToken(Token) then           //get next token , or = or )
      Exception(etSyntax, 'Unexpected end in EnumType-declaration!');

     if (Token = '=') or                   //the value of the item is set?
        ((PascalDialect = pdFreePascal) and (Token = ':=')) then
      begin
       Init := '';                            //read value of the item
{       while GetBalancedToken(Token) and (Token <> ',') and (Token <> ')') do
        Init := Init + ' ' + Token;
//       Delete(Init, 1, 1);                    //delete first space
}
       Token := ParseConstantExpression(Init{, [aedPortability]});

       Item.Value := Init;                    //set value
       Item.ValueSet := True;
       SinceLastInit := 0;                    //this is the last item
       LastEnum := Item;                       //with a value set
      end
     else
      begin
       if assigned(LastEnum) then          //a value for an item was set?
        if SinceLastInit = 0 then             //the previous one?
         Item.Value := 'Succ(' + LastEnum.Name + ')'
        else
         Item.Value := Format('Ord(%s) + %d',
                              [LastEnum.Name, SinceLastInit + 1])
       else                                   //use the ordinal value
        Item.Value := Format('%d', [SinceLastInit]);
       inc(SinceLastInit);
      end;

     if (Token <> ',') and (Token <> ')') then    //valid token follows?
      Exception(etSyntax,
                'Failed to find "," or ")" in EnumType-declaration!');

     Item.InFile := FThisFile;
     FActualScopeIdents.AddIdent(Item);   //add identifier of the item
   except
     Item.Free;
     raise;
   end;
   EnumType.Items.AddIdent(Item);         //and to the enumeration type

 until Token = ')';   //end of the enumeration reached?
end;



{Parses a function type.
~param FuncKind the kind of the function (function or procedure)
~result the new object of the parsed function type }
function TIdentifierParser.ParseFunctionType(FuncKind: TFunctionKind):
                                                                 TFunctionType;
var      Token            :String;    //a token
         Attributes       :String;    //the attributes
         Index            :Integer;   //the index in FuncAttributes
begin
 Result := TFunctionType.Create;      //create the object for the function type
 try
   Result.FuncKind := FuncKind;       //set the kind

   PushPosition;
   if not GetToken(Token) then        //get first token
    Exception(etSyntax, 'Unexpected end of function type-definition!');

   if Token = '(' then                //parameter list follows?
    begin
     LosePosition;
     ParseParams(Result.Params, False);   //parse parameter list
     PushPosition;
     if not GetToken(Token) then          //get next token
      Exception(etSyntax, 'Unexpected end of function type-definition!');
    end;

   if Token = ':' then                //return type follows?
    begin
     LosePosition;
     if FuncKind = fkFunction then      //is a function
      Result.ReturnType := ParseFunctionReturnType  //parse the return type
     else
      Exception(etSyntax,
                'Found ":" for return-type but this is not a function type!');
    end
   else
    begin
     PopPosition;
     if FuncKind = fkFunction then    //function without return type?
      Exception(etSyntax,
                'Unexpected end of function type-definition, no return-type!');
    end;


   Attributes := '';                    //no attributes found so far
   PushPosition;
   SkipSemicolon;
   try
     while GetToken(Token) and          //as long as attributes found
           IsWordIn(Token, FuncAttributes, Index) do
      begin
       if Index in ExtendedAttributes then   //attribute has parameters?
        Exception(etSyntax,
                  'Types of functions can''t have long attributes like: ' +
                  Token)
       else
        if Index = OfObjectAttribute then   //is a method?
         begin                                //read also the object
          if not GetToken(Token) or (LowerCase(Token) <> 'object') then
           Exception(etSyntax,
                     '"object" after "of" after function-type-definition expected, failed!');
          Result.IsMethod := True;            //is a method
         end
        else
         Attributes := Attributes + ' ' + Token;

       LosePosition;
       PushPosition;

       if GetToken(Token) and (Token <> ';') then  //get next token
        begin
         PopPosition;                          //restore position before ";"
         PushPosition;
        end;
      end;
   finally
    PopPosition;
   end;

   Result.CallConvs := Attributes;           //save the attributes
 except
   Result.Free;
   raise
 end;
end;


{Parses a record-like type. This means all records, classes with object and
 class, interfaces and dispatch-interfaces.
~param RecordKind  the kind of the record
~param ForwardDecl if a forward declaration exists, this is the identifier of
                   it
~result the object of the parsed record-like type }
function TIdentifierParser.ParseRecordType(RecordKind: TRecordKind;
                                        ForwardDecl: TRecordType): TRecordType;

 {Parses the field.
 ~param FieldName the name of the field
 ~result the following token after the declaration of the field }
 function ReadTheField(const FieldName: String): String;
 begin
  Result := ParseField(FieldName);
  if Result = ';' then               //skip semicolon
   begin
    if not GetToken(Result) then
     Exception(etSyntax,
               'Unexpected end in record-like declaration!');
   end
  else
   if LowerCase(Result) <> 'end' then
    Exception(etSyntax,
              'Expected ";" or "end" after field declaration, failed!');
 end;


         //alphabetical list of reserved words possible in a record-like types
const    TopLevelWordsRecord: array[0..12] of String =
           ('automated', 'case',      'class',     'constructor', 'destructor',
            'function',  'private',   'procedure', 'property',    'protected',
            'public',    'published', 'strict');

         //reserved words for the scope in a class etc. in TopLevelWordsRecord
         //automated, private protected, public, published, strict
         RecScopeWords = [0, 6, 9, 10, 11, 12];
         //reserved words for declaration of functions in TopLevelWordsRecord
         //constructor, destructor, function, procedure
         RecFuncWords = [3, 4, 5, 7];
         RecPropertyWord = 8;             //property  ~see TopLevelWordsRecord
         RecCaseWord = 1;                 //case      ~see TopLevelWordsRecord
         RecClassWord = 2;                //class     ~see TopLevelWordsRecord
         RecStrictWord = 12;              //strict    ~see TopLevelWordsRecord


var      Token            :String;        //a token
         Index            :Integer;       //index of the token in TopLevelWords
         FuncKind         :TFunctionKind; //what kind of method
         OldScope         :TScope;        //the original scope
         OldList          :TIdentifierList;  //the original list of identifiers
         OldCase          :TRecordCase;   //the variant case befor this record
         OldRec           :TRecordType;
         ScopeToken       :String;        //token of the scope after "strict"
begin
 if assigned(ForwardDecl) then    //forward declaration exists?
  Result := ForwardDecl
 else
  Result := TRecordType.Create;    //create the object for the record-like type
 try
   OldRec := FCurrentRecord;
   try
     FCurrentRecord := Result;
     Result.Kind := RecordKind;     //set