ucodeparser.pas

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

    //parse type of exception of on-block
    Token := ParseExpression('', @ExcType);

    if ExcType is TPointerType then     //automatically dereference pointers
     ExcType := GetType(TPointerType(ExcType).BaseType);

    //check if type of exception is a class
    if assigned(ExcType) and (not (ExcType is TRecordType) or
                              (TRecordType(ExcType).Kind <> rkClass)) then
     Exception(etSyntax,
               'Expression in on-clause in except-block is not a class!');


    if LowerCase(Token) <> 'do' then    //"do" has to follow
     Exception(etSyntax,
               '":" or "do" in "except"-block after "on" expected, failed!');

    if ExcVarName <> '' then            //if name of variable has been given
     begin                                //create variable for the statement
      OnNS := TOnExceptNameSpace.Create(ExcVarName, FThisFile,
                                        'Unknown Exception',
                                        TRecordType(ExcType));
      OnNS.PreNameSpace := FCurrentNameSpace;
      FCurrentNameSpace := OnNS;          //register namespace for variable
     end
    else
     OnNS := nil;                         //no namespace needed


    Token := ParseStmt('');             //parse the one statement of on-clause


    if assigned(OnNS) then           //namespace for variable has been created?
     begin
      FCurrentNameSpace := OnNS.PreNameSpace; //unregister it
      OnNS.Free;                              //free it and the variable
     end;

    //check token after the statement of on-clause
    if ((Token = '') or (Token = ';')) and not GetToken(Token) then
     Exception(etSyntax,
               'Unexpected end of file in "except"-block after "on"-clause!');

   LC := LowerCase(Token);
   //list of cases ends, when "end" or "else" found (instead of "on")
  until (LC = 'else') or (LC = 'end');

  //return, if else part follows
  Result := LC = 'else';
 end;


var       Token      :String;         //a token
          LC         :String;         //the token in lower case
begin
 Token := '';
 repeat                               //parse statements until end of try-block
   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);
 //parse until "finally" or "except" to end try-block has been found
 until (LC = 'finally') or (LC = 'except');

 if LC = 'finally' then               //it's a finally-block
  ParseToEnd                            //just parse the statements up to "end"
 else                                 //it's an except-block
  begin
   PushPosition;

   if not GetToken(Token) then          //get first token in except-block
    Exception(etSyntax, 'Unexpected end of file in "except"-block!');

   LC := LowerCase(Token);
   if LC <> 'on' then                   //not a list of on-clauses?
    begin
     if LC = 'else' then                  //else-part of on-clauses?
      LosePosition                          //just skip this else
     else
      PopPosition;                          //put this first token back
     ParseToEnd;                          //parse the except-block to "end"
    end
   else                                 //block of on-clauses:
    begin
     LosePosition;                      //"on" has been read
     //read all on cases
     if ParseOnClauses(Token) then      //else-part in list of on-clauses?
      ParseToEnd;                         //parse else-part up to the "end"
    end; //else LC <> 'on'
  end; //else LC = 'finally'
end;




{Parses a statement. Compound-Statements and statements with keywords are
 distinguished and handled.
~param Token the first token of the statement or ''
~result '' or the next token after the statement (i.e. possibly the ';') }
function TCodeParser.ParseStmt(const Token: String): String;

 {Parses the "case" statement. }
 procedure ParseCase;
 var       Token    :String;        //a token
 begin
  //parse the expression and read the "of"
  if LowerCase(ParseExpression('')) <> 'of' then
   Exception(etSyntax, 'Found no "of" in case-Statement!');

  Token := '';                      //no case-expression read, yet
  repeat                            //read all cases
    repeat                            //read/skip case-expression
      if Token = ',' then               //several expressions may be given
       Token := '';                      //separated by ","
      Token := ParseExpression(Token);  //parse one expression
    until Token <> ',';               //until the ":" has been reached
    if Token <> ':' then
     Exception(etSyntax,
               'Expected ":" after expression of the case-selection, failed!');

    Token := ParseStmt('');           //parse the statement of the case

    if Token = ';' then               //if separator ";" follows
     GetToken(Token)                    //skip it
    else
     //if not ";", keyword "else" or "end" must follow
     if (LowerCase(Token) <> 'end') and (LowerCase(Token) <> 'else') then
      Exception(etSyntax,
                '";" or "else" or "end" after statement of the case-selection expected, failed!');

    //cases end, when "end" or "else" is encountered
  until (LowerCase(Token) = 'end') or (LowerCase(Token) = 'else');

  if LowerCase(Token) = 'else' then //if else-part is given
   ParseToEnd;                        //parse the else-part
 end;


 {Parses the "for" statement.
 ~result the next token }
 function ParseFor: String;
 var      Collection      :Boolean;         //loop through collection?
 begin   //"for"
  Result := ParseExpression('', nil, True); //parse counter-variable
  Collection := Result <> ':=';             //loop through collection?
  if Collection and (LowerCase(Result) <> 'in') then //skip ":=" or "in"
   Exception(etSyntax, '":=" or "in" expected in for-Statement, failed!');

  if not Collection then                    //not a collection to loop through?
   begin
    //parse initialization of the counter
    Result := LowerCase(ParseExpression(''));
    if (Result <> 'to') and (Result <> 'downto') then //skip "to"/"downto"
     Exception(etSyntax,
               '"to" or "downto" expected in for-Statement, failed!');
   end;

  //parse destination value/collection to loop through
  Result := ParseExpression('');
  if LowerCase(Result) <> 'do' then  //skip "do"
   Exception(etSyntax, '"do" expected in for-Statement, failed!');

  Result := ParseStmt('');                  //parse the body of the for-loop
 end;


         //the keyword with which special statements begin
const    StmtStarts: array[0..12] of String =
                     ('asm', 'begin', 'case', 'end',   'finalization',
                      'for', 'goto',  'if',   'raise', 'repeat',
                      'try', 'while', 'with');
var      Index      :Integer;    //index of keyword in StmtStarts
         OldNS      :TNameSpace; //current namespace before 'with'
         TempNS     :TNameSpace; //runner to delete all 'with'-namespaces
begin
 if Token <> '' then             //first token already read?
  Result := Token                  //use that token
 else
  if not GetToken(Result) then   //get the first token
   Exception(etSyntax, 'No statement before end of file!');

 //does the statement start with a keyword?
 if IsWordIn(Result, StmtStarts, Index) then
  case Index of
    0:  begin   //"asm"
         ParseAsmBlock;            //parse (skip) the assembler-block
         GetToken(Result);         //get and return the next token
        end;
    1:  begin   //"begin"
         ParseToEnd;               //parse this block
         GetToken(Result);         //get and return next token
        end;
    2:  begin   //"case"
         ParseCase;                //parse the case statement and all cases
         GetToken(Result);         //get and return next token
        end;
    3:  ;       //"end"            //do nothing return the "end"
    4:  ;       //"finalization"   //do nothing return the "finalization"
    5:          //"for"
        Result := ParseFor;        //parse the for-statement
    6:  begin   //"goto"
         if not GetToken(Result) then       //just skip jump-label
          Exception(etSyntax,
                    'Expected Label-Identifier/-Number in goto-Statement, failed!');
         FThisFile.Statistic.Increment(psfGoTo); //increment statistic
         GetToken(Result);                  //get and return next token
        end;
    7:  begin   //"if"
         Result := ParseExpression('');      //parse expression of the "if"
         if LowerCase(Result) <> 'then' then //skip "then"
          Exception(etSyntax, '"then" expected in if-Statement, failed!');
         Result := ParseStmt('');            //parse the statement
         if LowerCase(Result) = 'else' then  //does "else"-part follow?
          Result := ParseStmt('');             //parse the else-statement
        end;
    8:  Result := ParseExpression('') {at Address}; //"raise" //parse exception
    9:  begin   //"repeat"
         Result := '';                       //new statement follows
         repeat                              //parse statements until "until"
           Result := ParseStmt(Result);        //parse a statement
           if Result = ';' then                //separator ";" follows
            Result := '';                        //skip it
         until LowerCase(Result) = 'until';  //until "until" found
         Result := ParseExpression('');      //parse expression of "until"
        end;
    10: begin   //"try"
         ParseTry;           //parse try-block, including finally-/except-block
         GetToken(Result);   //get and return next token
        end;
    11: begin   //"while"
         Result := ParseExpression('');      //parse while-expression
         if LowerCase(Result) <> 'do' then   //skip "do"
          Exception(etSyntax, '"do" expected in while-Statement, failed!');
         Result := ParseStmt('');            //parse the body of the loop
        end;
    12: begin   //"with"
         OldNS := FCurrentNameSpace;         //save current namespace
         //parse with-expressions and create namespaces for each
         ParseWithList;
         Result := ParseStmt('');            //parse the statement

         //delete all new created namespaces
         while FCurrentNameSpace <> OldNS do
          begin
           TempNS := FCurrentNameSpace;
           FCurrentNameSpace := TempNS.PreNameSpace; //remove out of list
           TempNS.Free;                              //free the namespace
          end;
        end;
  else
   raise SysUtils.Exception.CreateFmt('ParseStmt: Invalid Word-Index %d, change and recompile DelphiDoc!',
                                      [Index]);
  end
 else
  if Result <> ';' then          //not an empty statement?
   //handle simple statement (assignment, call or label-declaration)
   Result := ParseSimpleStmt(Result)
end;


{Parses a simple statement: assignment, call or label-declaration.
~param Token the first token of the statement or ''
~result '' or the next token after the statement (i.e. possibly the ';') }
function TCodeParser.ParseSimpleStmt(const Token: String): String;
var      Dummy      :Integer;
begin
 Result := ParseExpression(Token); //parse call, lvalue or label
 if Result = ':' then              //is it a label?
  Result := ParseStmt('')            //parse statement after label
 else
  if Result = ':=' then            //is it an assignment?
   Result := ParseExpression('')     //parse expression of value to assign
  else
   if (Result <> '') and (Result <> ';') and
      not IsWordIn(Result, EndOfStatements, Dummy) then
    ExceptionFmt(etSyntax,
                 'Invalid token "%s" at end of statement!', [Result]);
end;









{Parses an expression.
~param Token    the first token of the expression or ''
~param WithRec  if this pointer is not nil it points to a variable that will
                get the type of the expression; this is used in
                ~[link ParseWithList] to get the types in a with-statement
~param StopAtIn whether the operator "in" should not be part of the expression
~result the token ending the statement (the first after it) or '' }
function TCodeParser.ParseExpression(Token: String; WithRec: PType = nil;
                                     StopAtIn: Boolean = False): String;

         //keywords (identifiers) that are operators
const    Operators: array[0..11] of String =
                           ('and', 'as',  'at',  'div', 'in',
                            'is',  'mod', 'not', 'or',  'shl',
                            'shr', 'xor');
         OperatorAt = 2;   //can also be an identifier (only used after raise)


         //index of the operator
var      Index             :Integer;

         //an identifier in the expression
         Ident             :TIdentifier;
         //current type of the expression
         TypeIdent         :TType;
         //if the last identifier specified explicitly a type identifier
         TypeCast          :Boolean;
         //file, if it is not an identifier
         TheFile           :TPascalFile;


         //original record-like type of function, in case it is a
         //constructor
         //
         //let's say, there is a simple form designed in Delphi to ask a value
         //(returned by property MyDlgResult) and the default-constructor isn't
         //overidden. In another unit a function exists to show the dialog and
         //return the value:~[preformatted
         //with TMyForm.Create(Application) do try     ShowModal;
         //                                            Result := MyDlgResult;
         //                                    finally Free; end; ]
         //Here Create won't be found in TMyForm, but in TCustomForm, but it