ucodeparser.pas

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

{  JADD - Just Another DelphiDoc: Documentation from Delphi Source Code

Copyright (C) 2003-2008   Gerold Veith

This file is part of JADD - Just Another DelphiDoc.

DelphiDoc is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License version 3 as
published by the Free Software Foundation.

DelphiDoc is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
}


unit UCodeParser;

{Contains the class ~[linkClass TCodeParser] to parse pascal data and also
 parse the bodys of functions to extract all used global identifiers.

 The most parsing is in parsing the identifiers and expressions, in order to
 add all global identifiers to the list of the used identifiers. It does not
 parse the usage, for example it can't be distinguished between a call to a
 function and using it as a parameter (because you don't need to use an @, for
 this reason even the usage of the @ is not specially handled).~[br]
 Blocks of assembler-code is skipped, used identifiers not handled.
}

interface

uses SysUtils,
     UBaseIdents, UExtIdents, UFileParser,
     UNameSpaces;


type

  { * * *  ***  * * *  ***   TCodeParser   ***  * * *  ***  * * *  }


  //pointer on an identifier of a type   ~see TCodeParser.ParseExpression
  PType = ^TType;



  {Extends its base class to parse the bodys of functions to extract all used
   global identifiers.~[br]
   The most parsing is in parsing the identifiers and expressions, in order to
   add all global identifiers to the list of the used identifiers. It does not
   parse the usage, for example it can't be distinguished between a call to a
   function and using it as a parameter (because you don't need to use an @,
   for this reason even the usage of the @ is not specially handled).~[br]
   Blocks of assembler-code is skipped, used identifiers not handled. }
  TCodeParser = class(TFileParser)
  private
    //namespace of this file
    FOwnNameSpace: TThisFileNameSpace;
    //the current namespace while parsing
    FCurrentNameSpace: TNameSpace;

    //namespace of this function (everything under this will be deleted when
    //leaving the function when parsing)
    FCurrentFunctionNS: TLocalFuncNameSpace;

    //the namespace of the top-level function, the identifier of it saves the
    //list of used global identifiers
    FTopLevelFunctionNS: TLocalFuncNameSpace;
    //the record-like type (class) of this method (used for Self etc.)
    FFunctionParseSelf: TRecordType;


    //Frees all namespaces.
    procedure FreeNameSpaces;
  protected

    //Checks if the Extended Syntax is enabled at the moment.
    function IsExtendedSyntaxEnabled: Boolean; virtual;



    //Searches the identifier just by its name.
    function FindIdentifier(const IdentName: String): TIdentifier;



    //Will be called for all ~[linkClass TIdentType] besides the in the
    //interface-section of units.
    procedure CallBackAfterLocalDefinition(Ident: TIdentType;
                                           Parent: TIdentifier;
                                           Data: TIdentifier); override;


    //Will be called when a block of type definitions has been ended and checks
    //for forward references.
    procedure LocalTypeBlockHasEnded(StartIndex: Integer);
    //Will be called for every pointer and class reference type in the just
    //ended block of type definitions and checks for forward references.
    procedure CallBackIdentLocalTypeBlockEnd(Ident: TIdentType;
                                             Parent: TIdentifier;
                                             Data: TIdentifier);


    //Parses the declaration of labels.
    function ParseLabel(Token :String): String;
    //Parses the local declarations inside the function (before the "begin").
    function ParseFunctionLocalDeclarations: Boolean;
    //Parses a function with all local declarations (i.e. after the head)
    function ParseDeclarationsAndBody(FuncIdent: TFunction): Boolean; override;



    //Adds the identifier to the list of used identifiers.
    procedure AddToGlobalList(Ident: TIdentifier);
    //Adds the function-identifier to the list of used identifiers.
    procedure AddToCalledList(FuncIdent: TFunction);

    //Gets the type of the identifier.
    function GetType(Ident: TIdentifier): TType;

    //Parses a block of assembler-code; it is simply skipped, used identifiers
    //are not handled.
    procedure ParseAsmBlock;
    //Parses the code up to the next end, nesting of blocks is handled.
    function ParseToEnd(FinalizationAllowed: Boolean = False): Boolean;
    //Parses a try-finally/except-block.
    procedure ParseTry;
    //Parses a statement.
    function ParseStmt(const Token: String): String;
    //Parses a simple statement: assignment or call (or label)
    function ParseSimpleStmt(const Token: String): String;

    //Parses an expression.
    function ParseExpression(Token: String; WithRec: PType = nil;
                             StopAtIn: Boolean = False): String;
    //Parses the list of a with-statement and creates a namespace for each
    //(known) entry.
    procedure ParseWithList;
    //Parses the body of a function.
    function ParseFunctionBody(IsAsm: Boolean): Boolean;


    //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 HandleTopLevelFunction;
    //Will be called after finishing parsing of a nested function. Moves the
    //list of used global identifiers to the top-level function-namespace.
    procedure HandleSubFunction(NameSpace: TLocalFuncNameSpace);


    //Handles a warning by adding it to the messages of ~[link FFileList].
    procedure HandleWarningMessage(ExcpObj: Exception); override;

  public
    //Creates the parser object and the namespace for the file.
    constructor Create(TheFile: TPascalFile); override;
    //Frees all namespaces and the parser object.
    destructor Destroy; override;


    //Parses the implementation section of units and the contents of program or
    //library files.
    procedure ParseImplementations; override;

  end;







implementation

uses UPascalConsts,
     UParse,
     UTokenParser;




         //keywords (identifiers) ending expressions
const    EndOfStatements: array[0..6] of String =
                 ('else',           'end', 'except', 'finalization', 'finally',
                  'initialization', 'until');
                         // ';',


         //keywords (identifiers) ending expressions(/statements)
         EndOfExpressions: array[0..11] of String =
                          ('do',           'downto',  'else', 'end',  'except',
                           'finalization', 'finally', 'in',   'of',   'then',
                           'to',           'until');
                        // ';',       ',',      {'..', }  ':',    ':=',
                        // ')',       ']'

         //the index of the keyword "in" in the array ~[link EndOfExpressions]
         EndOfExpressionsIn = 7;




   { * * *  ***  * * *  ***   TCodeParser   ***  * * *  ***  * * *  }



{Creates the parser object and the file-namespace.
~param TheFile the file to parse and save the parsed data to }
constructor TCodeParser.Create(TheFile: TPascalFile);
begin
 inherited Create(TheFile);             //create the parser object

 //create the namespace of the file
 FOwnNameSpace := TThisFileNameSpace.Create(FThisFile, Self);
end;

{Frees all namespaces and the parser object.}
destructor TCodeParser.Destroy;
begin
 FreeNameSpaces;                        //free all namespaces

 inherited Destroy;                     //free the object
end;







{Parses the implementation section of units and the contents of program or
 library files. }
procedure TCodeParser.ParseImplementations;
begin
 FCurrentNameSpace := FOwnNameSpace;  //set this-file-namespace
 inherited ParseImplementations;      //parse code
 FreeNameSpaces;                      //free all namespaces
end;









{Frees all namespaces. }
procedure TCodeParser.FreeNameSpaces;
var       Runner, Pre    :TNameSpace; //runner through the namespaces
begin
 Runner := FCurrentNameSpace;         //start with the current namespace
 if not Assigned(Runner) then         //none given (not parsed)?
  Runner := FOwnNameSpace               //free the own file-namespace
 else
  FCurrentNameSpace := nil;             //unset current namespace
 FOwnNameSpace := nil;                //unset the own file-namespace

 while Assigned(Runner) do            //for each namespace
  begin
   Pre := Runner.PreNameSpace;
   Runner.Free;                         //free it
   Runner := Pre;                       //and resume with next
  end;
end;






{Checks if the Extended Syntax is enabled at the moment.
~result if the Extended Syntax is enabled at the moment }
function TCodeParser.IsExtendedSyntaxEnabled: Boolean;
begin
 Result := FThisFile.Defines.Options['X'];    //return Extended Syntax-setting
end;




{Searches the identifier just by its name.
~param IdentName the name of the searched identifier
~result the idneitifer or nil }
function TCodeParser.FindIdentifier(const IdentName: String): TIdentifier;
var      NS         :TNameSpace;         //the current namespace
         DummyFile  :TPascalFile;        //the file of the identifier
begin
 if Assigned(FCurrentNameSpace) then     //get current name space
  NS := FCurrentNameSpace
 else
  NS := FOwnNameSpace;

 //search the identifier in the current name space
 Result := NS.FindIdent(IdentName, DummyFile);
end;












{Will be called for all ~[linkClass TIdentType] besides the ones in the
 interface-section of units. The type of the identifier is searched and saved.
~param Ident  each of the identifiers from the class TIdentType
~param Parent the identifier that directly contains Ident
~param Data   application data; unused, will be nil }
procedure TCodeParser.CallBackAfterLocalDefinition(Ident: TIdentType;
                                                   Parent: TIdentifier;
                                                   Data: TIdentifier);

 {Searches the type in the specified file.
 ~param UnitName the name of the file in which the type in declared
 ~param TypeName the name of the type }
 procedure SearchTypeInUnit(const FileName, TypeName: String);
 var       TheFile         :TPascalFile; //the file containing the type
           Index           :Integer;     //index of file of type-string
           TheType         :TIdentifier; //the searched type
 begin
  //in this/the same file?
  if LowerCase(FileName) = LowerCase(FThisFile.InternalFileName) then