ucodeparser.pas

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

      Exception(etSyntax, '";" expected after declaration, failed');

     if DefType <> dtLabel then          //new real identifier?
      begin
       AfterLocalDefinition(BeforeStartIndex);
       BeforeStartIndex := FActualIdents.Count;
      end;
    end;
  end;

 //body of the function not found/unexpected end?
 if NoBegin then
  Exception(etSyntax, 'Unknown word "' + Token +
                      '" or identifier not in definition scope!');

 ChangeDefType(dtNone);            //end last block of declarations
 AfterLocalDefinition(BeforeStartIndex);

 Result := Index = 0;              //return if block started with "asm"
end;


{Handles a function after its declaration has been parsed, this means it reads
 all local declarations and its body. A namespace is created for the function,
 then all local identifiers (variables, types, etc.) are parsed and added, also
 local nested functions are recursively parsed and added. Then the body of the
 function is parsed by calling ~[link ParseFunctionBody] and all global
 identifiers are added to a list and finally to the identifier of the function.
~param FuncIdent the identifier of the function that should be parsed
~result if "finalization" has been found instead of "end" }
function TCodeParser.ParseDeclarationsAndBody(FuncIdent: TFunction): Boolean;
var      OldScope, OldGlobalScope   :TScope;    //old scope (of the function)
         OldList, OldScopeList :TIdentifierList;     //old lists of identifiers
         OwnNameSpace          :TLocalFuncNameSpace; //the function's namespace
         PreFuncNameSpace      :TLocalFuncNameSpace; //and the previous one's

         IsAsmBody             :Boolean;   //if the body is an assembler block
         BodyPos, EndPos       :TPosition; //position of begin and end of body
begin
 OldScope := FScope;                       //save old state
 OldGlobalScope := FGlobalScope;
 OldList := FActualIdents;
 OldScopeList := FActualScopeIdents;
 try
   FScope := sLocal;                       //new function-local declarations
   FGlobalScope := sLocal;

   if assigned(FuncIdent.MemberOf) then    //if it is a method
    FFunctionParseSelf := FuncIdent.MemberOf; //set the class/type of "Self"

   //create namespace of this function
   OwnNameSpace := TLocalFuncNameSpace.Create(FuncIdent);
   //add to the chain of namespaces
   OwnNameSpace.PreNameSpace := FCurrentNameSpace;
   FCurrentNameSpace := OwnNameSpace;      //and activate it


   FActualIdents := OwnNameSpace.LocalIdents; //set lists for new identifiers
   FActualScopeIdents := FActualIdents;


   if not assigned(FTopLevelFunctionNS) then //not a nested function?
    FTopLevelFunctionNS := OwnNameSpace;       //set this as top-level function
   try

     //save namespace of including function and set this namespace as the
     PreFuncNameSpace := FCurrentFunctionNS;                      //current one
     FCurrentFunctionNS := OwnNameSpace;
     try

       if not (FuncIdent is TProgramMainFunction) then
        //parse all local declarations up to the begin
        IsAsmBody := ParseFunctionLocalDeclarations
       else
        IsAsmBody := False;             //like started with "begin" (not "asm")


       BodyPos := GetLastTokenPositions.FEffectivePosition; //get begin of body

       //set if Result is allowed/known
       OwnNameSpace.ResultIdent := IsExtendedSyntaxEnabled;

       Result := ParseFunctionBody(IsAsmBody);  //parse the body


       EndPos := GetLastTokenPositions.FEffectivePosition;  //get end of body
       dec(EndPos.Row, BodyPos.Row - 1);        //calculate size of the body
       dec(EndPos.Column, BodyPos.Column);
       FuncIdent.BodySize := EndPos;            //and set it


       //restore old global settings
     finally
      FCurrentFunctionNS := PreFuncNameSpace;
     end;

     if FTopLevelFunctionNS = OwnNameSpace then //not a nested function?
      HandleTopLevelFunction                      //call the corresponding
     else                                         //handler
      HandleSubFunction(OwnNameSpace);

   finally
    if FTopLevelFunctionNS = OwnNameSpace then  //this is a top-level function?
     FTopLevelFunctionNS := nil;                  //finish parsing it

    FCurrentNameSpace := OwnNameSpace.PreNameSpace; //remove its namespace
    OwnNameSpace.Free;
    if assigned(FuncIdent.MemberOf) then        //not a nested function?
     FFunctionParseSelf := nil;                   //clear class/type of "Self"
   end;
 finally
  FActualScopeIdents := OldScopeList;           //restore previous state
  FActualIdents := OldList;
  FGlobalScope := OldGlobalScope;
  FScope := OldScope;
 end;

 FThisFile.Statistic.Increment(psfFunctionBodys); //increment statistic
end;
















































{Adds the identifier to the list of used identifiers for the current function.
~param Ident the used identifier }
procedure TCodeParser.AddToGlobalList(Ident: TIdentifier);
begin
 //add identifier to the list of the namespace of the current function
 FCurrentFunctionNS.AddUsedIdent(Ident);
end;

{Adds the function-identifier to the list of used identifiers for the current
 function.
~param FuncIdent the used/called function-identifier }
procedure TCodeParser.AddToCalledList(FuncIdent: TFunction);
begin
 //add function-identifier to the list of the namespace of the current function
 FCurrentFunctionNS.AddUsedIdent(FuncIdent);
end;






{Gets the type of the identifier.
~param Ident the identifier, whose type should be returned
~result the type of Ident, can be nil, if it is unknown }
function TCodeParser.GetType(Ident: TIdentifier): TType;
begin
 if not assigned(Ident) then  //no identifier given
  Result := nil                 //no type
 else
  if Ident is TType then        //identifier is already a type?
   begin
    if Ident is TIdentType then   //is an identifier of a type?
     begin
      if TIdentType(Ident).TheType = Ident then //for internal types
       Result := TType(Ident)       //return itself
      else
       //return the type of the type-identifier
       Result := GetType(TIdentType(Ident).TheType);
     end
    else
     if Ident is TClassReferenceType then
      //if it is a class-reference, return the referenced class
      Result := GetType(TClassReferenceType(Ident).BaseClass)
     else
      if Ident is TFunctionType then
       //if it is a function-type, return the return type of the function
       Result := GetType(TFunctionType(Ident).ReturnType)
      else
       Result := TType(Ident);      //return just the type itself
   end //if Ident is TType
  else
   begin
    if Ident is TVariable then             //if it is a variable
     Result := TVariable(Ident).VarType      //return its type
    else
     if Ident is TConstant then            //if it is a constant
      Result := TConstant(Ident).ConstType   //return its type
     else
      if Ident is TEnumTypeItem then       //if it is an item of an enumeration
       Result := TEnumTypeItem(Ident).EnumType  //return the enumeration type
      else
       if Ident is TFunction then          //if it is a function
        begin
         Result := TFunction(Ident).ReturnType; //return its return type
         if not assigned(Result) and            //if it is a constructor
            (TFunction(Ident).FuncKind = fkConstructor) then
          begin
           assert(assigned(TFunction(Ident).MemberOf));
           Result := TFunction(Ident).MemberOf;  //return the type of its class
          end;
        end
       else
        if Ident is TField then            //if it is a field
         Result := TField(Ident).FieldType    //return its type
        else
         if Ident is TProperty then        //if it is a property
          Result := TProperty(Ident).PropertyType //return its type
         else
          if Ident is TParameter then      //if it is a parameter
           Result := TParameter(Ident).ParamType  //return its type
          else
           Result := nil;                    //no type available

    if assigned(Result) then               //type found?
     Result := GetType(Result);              //return the type of the type
   end; //else Ident is TType
end;



{Parses a block of assembler-code; it is simply skipped, used identifiers are
 not handled. }
procedure TCodeParser.ParseAsmBlock;
var       Token      :String;            //a token
begin
 FThisFile.Statistic.Increment(psfAsmBlocks);   //increment statistic

 //skip all tokens until 'end' of the asm-block has been reached
 while GetToken(Token) and (LowerCase(Token) <> 'end') do
  if (Token = '@') and                     //if @label or @@label
     GetToken(Token) and (Token = '@') then  //skip jumplabel / test if @@
   GetToken(Token);                            //if @@ skip following jumplabel
end;


{Parses the code up to the next end, nesting of blocks is handled by parsing it
 statement by statement, making a recursive descend if necessary.
~param FinalizationAllowed if this is the initialization part and
                           "finalization" is allowed
~result if "finalization" has been found instead of "end" }
function TCodeParser.ParseToEnd(FinalizationAllowed: Boolean = False): Boolean;
var      Token      :String;        //a token
         LC         :String;        //lower case version of the token
begin
 Token := '';
 repeat                               //parse statements until "end" found
   Token := ParseStmt(Token);           //parse a statement/get next token
   if Token = ';' then                  //if it's just a separator
    Token := '';                          //ignore it for the next statement

   LC := LowerCase(Token);              //for comparison
 //parse statements until "end" or "finalization" found
 until (LC = 'end') or (LC = 'finalization');

 Result := LC <> 'end';
 if Result and not FinalizationAllowed then
  Exception(etSyntax,
            'While searching for "end" found "finalization" instead.');
end;

{Parses a try-finally/except-block. }
procedure TCodeParser.ParseTry;

 {Reads all "on"-clauses in the except part.
 ~param Token the first Token of the clause, i.e. "on"
 ~result if the else parts follows }
 function ParseOnClauses(Token: String): Boolean;
 var      ExcVarName    :String;      //name of the variable in on-clause
          ExcType       :TType;       //type of the Exception in on-clause
          OnNS          :TOnExceptNameSpace; //NameSpace for each on-clause
          LC            :String;      //the token in lower case
 begin
  repeat                              //parse all cases
    if LowerCase(Token) <> 'on' then    //each on-clause has to start with "on"
     Exception(etSyntax,
               '"on", "else" or "end" expected in "except"-block, failed!');

    PushPosition;                       //save position of variable/type
    if not GetToken(ExcVarName) or not GetToken(Token) then //get them
     Exception(etSyntax,
               'Unexpected end of file in "except"-block after "on"!');

    if Token <> ':' then                //no variable name given in block?
     begin
      ExcVarName := '';                   //no variable, i.e. no name
      PopPosition;                        //restore position of exception-type
     end
    else
     begin
      CheckIdentifierName(ExcVarName, 'except on'); //check the name
      LosePosition;                       //exception-type follows directly
     end;