uidentparser.pas

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

       ExceptionFmt(etSyntax, 'Expected name of parameter after "%s", failed!',
                    [ParameterFormalAttributNames[Kind]]);


     //read all parameters of this type
     repeat
       CheckIdentifierName(Token, 'as a parameter'); //check the name

       Param := TParameter.Create;             //create the parameter
       try
         Param.Kind := Kind;
         Param.Name := Token;                  //the first parameter
         SetPosition(Param);                   //set the positions
         Param.Scope := sLocal;
         List.AddIdent(Param);                 //and add parameter
       except
         Param.Free;
         raise;
       end;
       ParamList.AddIdent(Param);              //add to list of current params

       GetToken(Token);                        //get the "," or ":"
     until (Token <> ',') or not GetToken(Token);

     if Token = '' then
      Exception(etSyntax, 'Unexpected end in parameter-declaration!');
     //follows the type or is it not a call by value?
     if (Token <> ':') and (Kind = pkNormal) then
      Exception(etSyntax,
                'Expected ":" after name(s) of parameter(s), failed!');


     TheType := nil;                //no type for the parameter so far
     if Token = ':' then            //type of parameter specified?
      begin
       TheType := ParseType(Token, [aedEqual], ptkParameter); //read the type
       try
         TParameter(ParamList[0]).ParamType := TheType;
       except
         TheType.Free;
         raise;
       end;
       if (Token = '') and not GetToken(Token) then
        Exception(etSyntax, 'Unexpected end in parameter list-declaration!');
      end;

     Init := '';
     if Token = '=' then            //does a default value follow?
      Token := ParseConstantExpression(Init);



     for i := 0 to ParamList.Count - 1 do //assign values to all parameters
      begin
       Param := TParameter(ParamList[i]);
       Param.DefaultValue := Init;               //assign the default value
       //type specified and not already assigned?
       if (i <> 0) and assigned(TheType) then
        Param.ParamType := TType(TheType.Clone);   //assign the type
      end;


     if Token = ';' then            //semicolon for next parameter
      begin
       if not GetToken(Token) then
        Exception(etSyntax, 'Unexpected end in parameter list-declaration!');
      end
     else
      //")" or "]" for end of parameter list
      if (not PropertyIndices and (Token <> ')')) or
         (PropertyIndices and (Token <> ']')) then
       Exception(etSyntax, 'Expected ";" or ")"/"]" after parameter, failed!');

    end; //while Token <> ')' / ']'


   if (not PropertyIndices and (Token <> ')')) or //list of parameters has to
      (PropertyIndices and (Token <> ']')) then   //end with ")" / "]"
    Exception(etSyntax,
              'Expected ")"/"]" at end of parameter-definition, failed!');

 finally
  ParamList.RemoveAll(False);
  ParamList.Free;                   //free list of together defined parameters
 end;
end;











{Parses and returns a type. By parsing the first token and distinguishing the
 different kinds of types in a case-like if-then-else-if-structure the exact
 type is discovered and the object for the type is created and returned.
 Several kinds of types will be parsed by calling other functions.

 WARNING:~[br]
 When an exception is raised after parsing an enumeration type and it is freed
 again, the items may hold an invalid reference to the type. This is also the
 case for anonymous enumeration types, like used as an index for an array or
 base type of a set or pointer.

~param NextToken     out: '' or the following token
~param EndDirectives the directives to be allowed (to end constant expressions)
~param TypeKind      whether a general type, the type of a parameter or the
                     index of an array should be parsed 
~result the new object of the parsed type }
function TIdentifierParser.ParseType(var NextToken: String;
                              EndDirectives: TAllowedExpressionDirectives = [];
                              TypeKind: TParseTypeKind = ptkGeneral): TType;
         //the two kinds of function types
const    FuncKind: array[Boolean] of TFunctionKind =
                   (fkProcedure, fkFunction);
var      Token, lc        :String;     //the token and the lower case token
         Expr             :String;     //a parsed expressions
         Index            :Integer;    //a general index
         IsPacked         :Boolean;    //is the type packed?
         ArrayIndex       :TType;      //the type of the index of the array
begin
 assert(not (aedIndexName in EndDirectives));

 NextToken := '';

 if not GetToken(Token) or IsEndOfStmtToken(Token) then  //get first token
  Exception(etSyntax, 'Unexpected end in type-declaration!');

 //not possible, but compiler doesn't know, that Exception raises one
 Result := nil;

 if Token = '(' then                   //enumeration?
  begin
   Result := TEnumType.Create;
   try
     ParseEnumItemList(TEnumType(Result)); //parse enumerations items

     //end of statement not been reached?
     if GetToken(NextToken) and not IsEndOfStmtToken(NextToken) and
        ((TypeKind <> ptkArrayIndex) or (Length(NextToken) <> 1) or
         not (NextToken[1] in [',', ']'])) then
      Exception(etSyntax, 'Expecting end of statement after (...) for enumeration type, failed!');
   except
     Result.Free;
     raise;
   end;
  end
 else
  if Token = '^' then                  //pointer type?
   begin
    if TypeKind = ptkArrayIndex then
     Exception(etSyntax, 'Found a pointer type as index type of an array!');

    Result := TPointerType.Create;
    try                                          //parse base type
      TPointerType(Result).BaseType := ParseType(NextToken, EndDirectives);
    except
      Result.Free;
      raise;
    end;
   end
  else
   begin
    lc := LowerCase(Token);            //get lower case of the token
    if lc = 'string' then              //is a string?
     begin
      if TypeKind = ptkArrayIndex then
       Exception(etSyntax, 'Found a string type as index type of an array!');

      Result := TStringType.Create;
      try                                //getting size of short string
        PushPosition;
        if GetToken(Token) and (Token = '[') then
         begin
          LosePosition;

          //will contain the expression for the capacity of the string
          Expr := '';
          if ParseConstantExpression(Expr) <> ']' then  //parse capacity
           Exception(etSyntax, 'Expected "]" after "string[...", failed!');

          //save the capacity of the short string
          TStringType(Result).Size := Expr;
         end
        else
         PopPosition;
      except
        Result.Free;
        raise
      end;
     end
    else
     begin

      IsPacked := lc = 'packed';       //is a packed type?
      if IsPacked then
       begin
        if TypeKind = ptkArrayIndex then
         Exception(etSyntax,
                   'Found keyword "packed" in index type of an array!');

        if not GetToken(Token) then       //get next token
         Exception(etSyntax,
                   'Unexpected end in type-declaration after "packed"!')
        else
         lc := LowerCase(Token);          //get lower case of token
       end;

      if lc = 'file' then              //is a file type?
       begin
        if TypeKind = ptkArrayIndex then
         Exception(etSyntax, 'Found file type as index type of an array!');

        Result := TFileType.Create;
        try
          if GetToken(NextToken) and
             not IsEndOfStmtToken(NextToken, [iseOf]) then  //typed file?
           begin                           //read "of"
            if LowerCase(NextToken) <> 'of' then
             Exception(etSyntax, 'Expected "of" after "file", failed!');

                                        //parse type of the file
            TFileType(Result).FileType := ParseType(NextToken, EndDirectives);
           end;
        except
          Result.Free;
          raise
        end;
       end
      else
       if lc = 'set' then              //is a set?
        begin
         if TypeKind = ptkArrayIndex then
          Exception(etSyntax, 'Found set type as index type of an array!');

         //read of
         if not GetToken(Token) or (LowerCase(Token) <> 'of') then
          Exception(etSyntax,
                    'Unexpected end while searching for "of" after "set"!');

         Result := TSetType.Create;
         try                             //parse type of the set
           TSetType(Result).SetType := ParseType(NextToken, EndDirectives);
         except
           Result.Free;
           raise
         end;
        end
       else
        if lc = 'array' then           //is an array?
         begin
          if TypeKind = ptkArrayIndex then
           Exception(etSyntax, 'Found array type as index type of an array!');

          Result := TArrayType.Create;    //create the array type
          try
            //read indices of the array
            if GetToken(Token) and (Token = '[') then
             begin

              repeat                          //read all indices
                lc := Token;                    //save opening bracket or comma

                //read the index type
                ArrayIndex := ParseType(Token, [], ptkArrayIndex);
                try
                  if not (ArrayIndex is TIdentType) and
                     not (ArrayIndex is TSubRangeType) and
                     not (ArrayIndex is TEnumType) then
                   ExceptionFmt(etSyntax,
                                'Index type of an array is not an ordinal type (%s)!',
                                [ArrayIndex.ClassName]);

                  //add the index type to the array
                  TArrayType(Result).AddIndexType(ArrayIndex, lc = '[');
                except
                  ArrayIndex.Free;
                  raise;
                end;

                if Token = ']' then             //index-bracket closed?
                 GetToken(Token);               //get next token

              //until no further indices follow
              until (Token <> ',') and (Token <> '[');
             end;

            if LowerCase(Token) <> 'of' then  //read "of"?
             Exception(etSyntax,
                       'Expected "of" after "array" and indices, failed!');

            //is an open array parameter?
            if (TypeKind = ptkParameter) and (lc = '') then
             TypeKind := ptkArrayOfParameter    //may be an array of constants
            else
             TypeKind := ptkGeneral;            //normal type

            //read the base type of the array
            TArrayType(Result).BaseType := ParseType(NextToken, EndDirectives,
                                                     TypeKind);
          except
            Result.Free;
            raise
          end;
         end
        else                             //is a class/record-like type?
         if IsWordIn(lc, RecordTypWords, Index) then
          begin
           if TypeKind = ptkArrayIndex then
            Exception(etSyntax,
                      'Found record-like type as index type of an array!');

           PushPosition;                   //save current position
           if not GetToken(NextToken) or   //statement ends?
              IsEndOfStmtToken(NextToken, [iseEnd, iseOf]) then
            begin                           //forward-declaration of the class
             LosePosition;                   //drop saved position
             Result := TRecordType.Create;   //create the identifier
             try                             //set its kind
               TRecordType(Result).Kind := RecordTypWordKinds[Index];
             except
               Result.Free;
               raise
             end
            end
           else
            begin
             if NextToken = '' then
              Exception(etSyntax, 'Unexpected end in type-declaration!');

             if LowerCase(NextToken) = 'of' then //is class reference type?
              begin
               LosePosition;                       //drop saved position
               Result := TClassReferenceType.Create;
               try                                 //parse referenced type
                 TClassReferenceType(Result).BaseClass := ParseType(NextToken,
                                                                EndDirectives);
               except
                 Result.Free;
                 raise
               end;
              end
             else
              begin
               PopPosition;                       //restore save position
               NextToken := '';                   //and un-read the token
               //parse record-like type
               Result := ParseRecordType(RecordTypWordKinds[Index], nil);
              end;