ucodeparser.pas

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

   TheFile := FThisFile
  else
   begin                                   //search used units (interface)
    Index := FThisFile.UsedUnitList[fpInterface].IndexOf(FileName);
    if Index <> -1 then
     begin
      TheFile := TPascalFile(FThisFile.UsedUnitList[fpInterface].
                                                               Objects[Index]);
      Inc(FUnitUsage[fpInterface][Index]); //count reference to used unit
     end
    else
     begin                                 //search used units (implementation)
      Index := FThisFile.UsedUnitList[fpMain].IndexOf(FileName);
      if Index <> -1 then
       begin
        TheFile := TPascalFile(FThisFile.UsedUnitList[fpMain].Objects[Index]);
        Inc(FUnitUsage[fpMain][Index]);    //count reference to used unit
       end
      else
       TheFile := nil;
     end;
   end;

  if Assigned(TheFile) then              //file found?
   begin                                   //search in the file for the type
    TheType := TheFile.Idents.GetIdentByName(TypeName);
    //if it is a used unit, check if identifier is declared in interface
    if Assigned(TheType) and (TheFile <> FThisFile) and
       (TheType.Scope <> sInterface) then
     TheType := nil;

    if not assigned(TheType) then          //identifier found?
     ExceptionIdentFmt(Ident, etSyntax,
                       'Type-identifier in unit not found: "%s"!',
                       [Ident.DefIdent]);
    if not (TheType is TType) then         //identifier is a type?
     ExceptionIdentFmt(Ident, etSyntax,
                       'Found identifier in unit is not a type: "%s"!',
                       [Ident.DefIdent]);

    Ident.TheType := TType(TheType);       //save identifier of type
   end
  else                                     //add to list of unknown types
   AddToUnknownTypeIdents(TypeName, FileName);
 end;


var       Dot        :Integer;           //position of '.' in type-string
          TheFile    :TPascalFile;       //the file containing the type
begin
 Assert(not Assigned(Data));             //Data is not used; has to be nil
 if not Assigned(Ident.TheType) then     //not already linked?
  begin
   Dot := Pos('.', Ident.DefIdent);        //unit of type given?
   if Dot = 0 then                         //no unit of type given?
    begin                                    //search namespaces for identifier
     Parent := FCurrentNameSpace.FindIdent(Ident.DefIdent, TheFile);
     if Assigned(Parent) then                //identifier found?
      begin
       if not (Parent is TType) then           //identifier is a type?
        ExceptionIdentFmt(Ident, etSyntax,
                          'Found identifier is not a type: "%s"!',
                          [Ident.DefIdent]);

       Ident.TheType := TType(Parent);       //save identifier of type
      end;
    end //if Dot = 0
   else                                    //unit of type given
    SearchTypeInUnit(Copy(Ident.DefIdent, 1, Dot - 1),    //search the type in
                     Copy(Ident.DefIdent, Dot + 1,         //the unit
                          High(Length(Ident.DefIdent))));
  end; //if not assigned(Ident.TheType)
end;










{Will be called when a block of type definitions has been ended. For every
 new pointer and class reference will be checked it is a forward reference to
 an identifier in the same block. If that is the case the identifiers will be
 linked.
~param StartIndex the index of the first defined identifier in the just ended
                  block of type definitions }
procedure TCodeParser.LocalTypeBlockHasEnded(StartIndex: Integer);
var       i          :Integer;   //counter through all identifiers of the block
begin
 //for all identifiers of the block check for forward references
 for i := StartIndex to FActualIdents.Count - 1 do
  FActualIdents[i].ForEachIdentType(CallBackIdentLocalTypeBlockEnd, nil);
end;


{Will be called for every pointer and class reference type in the just ended
 block of type definitions and checks for forward references.
~param Ident  an identifier that names a named type
~param Parent the identifier that directly contains it
~param Data   this parameter is not used and must be nil }
procedure TCodeParser.CallBackIdentLocalTypeBlockEnd(Ident: TIdentType;
                                                     Parent: TIdentifier;
                                                     Data: TIdentifier);
var       Identifier       :TIdentifier;    //identifier of the type
begin
 assert(FCurrentNameSpace is TLocalFuncNameSpace);
 assert(not assigned(Data));
 //for every pointer and class reference-type that doesn't reference
 if not assigned(Ident.TheType) and         //not alread found and
    ((Parent is TPointerType) or (Parent is TClassReferenceType)) and
    (pos('.', Ident.DefIdent) = 0) then     //not an identifier in another unit
  begin
   //search identifier in the same scope (function)
   Identifier := TLocalFuncNameSpace(FCurrentNameSpace).LocalIdents.
                                                GetIdentByName(Ident.DefIdent);

   if assigned(Identifier) then                  //referenced identifier found?
    begin
     if not (Identifier is TType) then
      ExceptionIdentFmt(Ident, etSyntax,
                        'Defined pointer-type/class-reference not on a type-identifier, "%s"!',
                        [Ident.DefIdent]);
     if (Parent is TClassReferenceType) and
        not (Identifier is TIdentType) and
        (not (Identifier is TRecordType) or
         (TRecordType(Identifier).Kind <> rkClass)) then
      ExceptionIdentFmt(Ident, etSyntax,
                        'Class-reference not on a class, "%s"!',
                        [Ident.DefIdent]);

     Ident.TheType := TType(Identifier);         //save the found identifier
    end
   else
    AddToUnknownTypeIdents(Ident.DefIdent);      //add to  unknown types
  end;
end;














{Will be called after finishing parsing of a top-level function. Moves the list
 of used global identifiers to the identifier of the function. }
procedure TCodeParser.HandleTopLevelFunction;
begin         //move list of used global identifiers to the function identifier
 FTopLevelFunctionNS.MoveGlobalsToFunction;
end;

{Will be called after finishing parsing of a nested function. Moves the list of
 used global identifiers to the containing function's namespace.
~param NameSpace the namespace of the function this function was nested in }
procedure TCodeParser.HandleSubFunction(NameSpace: TLocalFuncNameSpace);
begin //move list of used global identifiers to containing function's namespace
 NameSpace.MoveGlobalIdentsTo(FCurrentFunctionNS);
end;



{Handles a warning by adding it to the messages of ~[link FThisFile].~[link
 TFileList FileList].~[link TParserManager ParserManager].
~param ExcpObj the exception object with the warning message/information to be
               handled }
procedure TCodeParser.HandleWarningMessage(ExcpObj: Exception);
var       Information   :TParseMessageInformation; //information of the message
begin
 try
   assert(assigned(FThisFile));
   //message-list for warning available?
   if assigned(FThisFile.FileList) and
      (FThisFile.FileList.ParserManager is TParserManager) then
    if ExcpObj is EParseException then     //known error/warning-message?
     begin
      EParseException(ExcpObj).CopyInformationTo(Information);
      Information.MessageKind := pmkWarning;
      //add a detailed warning message
      TParserManager(FThisFile.FileList.ParserManager).
                                              HandleMessage(Information, Self);
     end
    else                                     //add general message
     TParserManager(FThisFile.FileList.ParserManager).AddWarning(
                              ExcpObj.ClassName + ': ' + ExcpObj.Message, Self)
   else
    if IsDebuggerPresent then              //application is being debugged?
     asm int 3 end;                          //stop it (by a hard break point)
 finally
  ExcpObj.Free;
 end
end;











{Parses the declaration of labels, i.e. the label statement after the keyword
 label.
~param Token the name of the first label
~result the next token (ending the declaration, i.e. ";") }
function TCodeParser.ParseLabel(Token :String): String;
var      Ident      :TGoToLabel;   //identifier for the label
begin
 repeat                             //as long as labels are declared
  if Token <> '' then                 //tokens left?
   begin
    FThisFile.Statistic.Increment(psfLabel); //increment statistic

    if not (Token[1] in ['0'..'9']) then //label is not numeric
     begin
      CheckIdentifierName(Token, 'label'); //check the name

      Ident := TGoToLabel.Create;          //create an identifier for the label
      try
        Ident.Name := Token;               //set name, positon, scope
        Ident.Position := AbsoluteLastTokenStartPos;
        Ident.ForwardDefPos := Ident.Position;
        Ident.Scope := FScope;
        FActualIdents.AddIdent(Ident);     //add identifier
      except
        Ident.Free;
        raise;
      end;
     end;
   end;
 until not GetToken(Token) or (Token <> ',') or //read ',' and next label
       not GetToken(Token);
 if Token <> ';' then                 //end of statement without ';'?
  Exception(etSyntax, 'Unexpected end in "label"-statement!');
 Result := Token;
end;



{Parses the local declarations inside the function (before the "begin").
~result if the function is an assembler block }
function TCodeParser.ParseFunctionLocalDeclarations: Boolean;
         //the possible reserved word in the declarations in functions
const    DeclWords: array[0..8] of String =
                 ('asm',       'begin',          'const', 'function', 'label',
                  'procedure', 'resourcestring', 'type',  'var');
         //what kind of (nested) function is declared
         FuncKind: array[Boolean] of TFunctionKind =
                                     (fkProcedure, fkFunction);

         //what kind of declaration is currently made
type     TDefType = (dtNone, dtType, dtResString, dtConst, dtVar, dtLabel);

var      DefType              :TDefType;   //current kind of declaration
         //index of first new identifier since last call of
         TypeStartIndex       :Integer;    //~[link LocalTypeBlockHasEnded]

 {Changes the current kind of declaration. If a type-declaration-block ends, it
  calls ~[link TypeBlockHasEnded].
 ~param NewDefType the new kind of declaration }
 procedure ChangeDefType(NewDefType: TDefType);
 begin
  if DefType = dtType then                 //block of type-declaration ends?
   LocalTypeBlockHasEnded(TypeStartIndex);   //call LocalTypeBlockHasEnded
  DefType := NewDefType;                   //set new kind of declarations
  if DefType = dtType then                 //block of type-declaration begins?
   TypeStartIndex := FActualIdents.Count;    //save index of first declaration
 end;

var      BeforeStartIndex     :Integer;    //index of new identifiers
         NoBegin              :Boolean;    //body does not (yet) begin
         Token                :String;     //tokens
         Index                :Integer;    //index of the token
begin
 DefType := dtNone;                //no type of declaration set
 //get number of already defined identifiers
 BeforeStartIndex := FActualIdents.Count;
 assert(BeforeStartIndex = 0);

 //read declarations until the function-body begins
 NoBegin := True;
 while NoBegin and GetToken(Token) do
  begin
   if IsWordIn(Token, DeclWords, Index) then //is token a keyword?
    case Index of
      0, 1:  NoBegin := False;       //"begin" or "asm"
      2:     ChangeDefType(dtConst); //block of "const" declarations
      4:     ChangeDefType(dtLabel); //(block of) "label" declarations
      3, 5:  begin                   //nested "function" or "procedure"
              ChangeDefType(dtNone);     //end old declaration block

              //parse this nested function
              ParseFunction(FuncKind[Index = 3], False, False);

              //check new identifiers of the nested function
              AfterLocalDefinition(BeforeStartIndex);
              BeforeStartIndex := FActualIdents.Count;

              SkipSemicolon;
             end;
      6:     ChangeDefType(dtResString); //block of ressourcestriongs
      7:     ChangeDefType(dtType);      //block of "type" declarations
      8:     ChangeDefType(dtVar);       //block of "var" declarations
    else
     raise SysUtils.Exception.CreateFmt('Invalid Word-Index "%d" for "%s" change and recompile DelphiDoc!',
                                        [Index, Token]);
    end
   else
    begin
     case DefType of                     //parse declaration
       dtType:      Token := ParseTypeIdentifier(Token);
       dtResString: Token := ParseResourceString(Token);
       dtConst:     Token := ParseConstant(Token);
       dtVar:       Token := ParseVariable(Token, False);
       dtLabel:     Token := ParseLabel(Token);
     else
       Exception(etSyntax, 'Unknown word "' + Token +
                 '" or identifier not in declaration block!');
     end;

     if Token <> ';' then