uconditionalparser.pas

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

 begin
  Token := NextToken;    //use the given first token (if not '')
  Value.kind := vkNone;  //no value so far
  Finished := False;     //parsing not finished

  //while expression not completely parsed and token is valid in expression
  while ((Token <> '') or Parser.GetToken(Token)) and (Token <> '') and
        ((Token[1] in (StartIdentifierChars +
                       ['(', ')', '=', '<', '>', '0'..'9', '.', '''']))) and
        not Finished do
   begin
    LC := LowerCase(Token);         //get lower case variant of token
    if LC = '(' then                //subexpression in braces?
     begin
      Token := '';
      if Value.kind <> vkNone then    //value/identifier given?
       begin                            //this means it is a function "call"
        WarningMessage(etPreCompiler,
                       'Found "(" after identifier in condition after "$IF" or "$ELSEIF"; internal functions are not supported at the moment!');

        ParseExpression(Token, pAll, Value);  //skip content of braces
        Value.kind := vkUnknownIdent;         //just ignore value
       end
      else
       ParseExpression(Token, pAll, Value);   //parse content of braces
      if Token <> ')' then            //has to end in with the closing brace
       WarningMessage(etPreCompiler,
                      'Missing ")" in condition after "$IF" or "$ELSEIF"!');
      Token := '';
     end
    else
     if LC = ')' then               //closing brace found?
      Finished := True                //just return the closing brace
     else
      if Token[1] in ['0'..'9', '.', '$'] then   //a number found?
       begin
        if Value.kind <> vkNone then
         ExceptionFmt(etPreCompiler,
                      'Number "%s" directly after another value without operator in condition after "$IF" or "$ELSEIF"!',
                      [Token]);

        Val(Token, Value.num, Compare);  //parse the number
        if Compare <> 0 then
         ExceptionFmt(etPreCompiler,
                      'Invalid number "%s" given in condition after "$IF" or "$ELSEIF"!',
                      [Token]);
        Value.kind := vkNumber;
        Token := '';
       end
      else
       if Token[1] = '''' then      //string constant found
        begin
         if Value.kind <> vkNone then
          ExceptionFmt(etPreCompiler,
                       'String %s directly after another value without operator in condition after "$IF" or "$ELSEIF"!',
                       [Token]);

         Value.str := Token;
         Value.kind := vkString;
         Token := '';
        end
       else                         //binary operator found?
        if (LC = 'or') or (LC = 'xor') or (LC = 'and') or
           not (Token[1] in StartIdentifierChars) then
         begin                        //priority if higher than given one?
          if TPriority(ord(pRelational) + ord(LC[1] in ['o', 'x', 'a']) +
                                          ord(LC[1] = 'a')) > Priority then
           begin
            if Value.kind = vkNone then
             ExceptionFmt(etPreCompiler,
                          'Found operator "%s" without first operand in condition after "$IF" or "$ELSEIF"!',
                          [Token]);

            Token := '';            //parse second operand
            ParseExpression(Token, TPriority(ord(pRelational) +
                                             ord(LC[1] in ['o', 'x', 'a']) +
                                             ord(LC[1] = 'a')), Second);


            if Second.kind = vkNone then
             ExceptionFmt(etPreCompiler,
                          'Found operator "%s" without second operand in condition after "$IF" or "$ELSEIF"!',
                          [LC]);

            if LC[1] in ['o', 'x', 'a'] then //boolean operand?
             begin
              if Second.kind <> vkUnknownIdent then //second operand known?
               begin
                if Value.kind = vkUnknownIdent then   //first not known?
                 Value := Second                        //use just second
                else
                 begin
                  if Value.kind <> Second.kind then
                   ExceptionFmt(etPreCompiler,
                                'Not matching types for operator "%s" (number <> boolean <> string) in condition after "$IF" or "$ELSEIF"!',
                                [LC]);

                  if Value.kind = vkString then
                   ExceptionFmt(etPreCompiler,
                                'Not matching type for operator "%s" (String) in condition after "$IF" or "$ELSEIF"!',
                                [LC]);

                  if Value.kind = vkBoolean then        //boolean operation
                   case LC[1] of
                     'o': Value.bool := Value.bool or Second.bool;
                     'x': Value.bool := Value.bool xor Second.bool;
                     'a': Value.bool := Value.bool and Second.bool;
                   end
                  else                                  //number operation
                   case LC[1] of
                     'o': Value.num := Round(Value.num) or Round(Second.num);
                     'x': Value.num := Round(Value.num) xor Round(Second.num);
                     'a': Value.num := Round(Value.num) and Round(Second.num);
                   end
                 end;
               end;
             end //or, xor, and
            else                             //relational operator!
             begin
              if (Value.kind = vkUnknownIdent) or
                 (Second.kind = vkUnknownIdent) then
               Value.kind := vkUnknownIdent
              else
               begin
                if Value.kind <> Second.kind then //both types have to be equal
                 ExceptionFmt(etPreCompiler,
                              'Not matching types for operator "%s" (number <> boolean <> string) in condition after "$IF" or "$ELSEIF"!',
                              [LC]);


                if Value.kind = vkNumber then     //compare the values
                 begin
                  Compare := 1;
                  if Value.num < Second.num then
                   Compare := -1
                  else
                   if Value.num = Second.num then
                    Compare := 0;
                 end
                else
                 if Value.kind = vkString then
                  begin
                   Compare := 1;
                   if Value.str < Second.str then
                    Compare := -1
                   else
                    if Value.str = Second.str then
                     Compare := 0;
                  end
                 else
                  begin
                   Compare := 1;
                   if Value.bool < Second.bool then
                    Compare := -1
                   else
                    if Value.bool = Second.bool then
                     Compare := 0;
                  end;

                Value.kind := vkBoolean;          //result type is boolean

                //set value depending on operator and result of comparison
                case Compare of
                  -1: Value.bool := LC[1] = '<';
                   0: Value.bool := (LC[1] = '=') or
                                    ((length(LC) > 1) and (LC[2] = '='));
                   1: Value.bool := (LC[1] = '>') or
                                    ((length(LC) > 1) and (LC[2] = '>'));
                end;
               end;
             end; // =, <>, <, <=, >, >=
           end // priority of operator higher that set?
          else
           Finished := True;        //just return the parsed expression
         end // if Token is an operator
        else
       if LC = 'defined' then       //special function DEFINED?
        begin
         if Value.kind <> vkNone then
          Exception(etPreCompiler,
                    '"DEFINED" directly after another value without operator in condition after "$IF" or "$ELSEIF"!');

         //read compiler symbol to test
         if not Parser.GetToken(LC) or (LC <> '(') or
            not Parser.GetToken(Token) or
            not Parser.GetToken(LC) or (LC <> ')') then
          Exception(etPreCompiler,
                    'Expected "(" + Compiler-Define + ")" after DEFINED in condition after "$IF" or "$ELSEIF"!');

         Value.kind := vkBoolean;     //set if symbol is defined
         Value.bool := TheDefines.Defines.IndexOf(Token) <> -1;
         Token := '';
        end
       else
        if LC = 'declared' then     //special function DECLARED
         begin
          if Value.kind <> vkNone then
           Exception(etPreCompiler,
                     '"DECLARED" directly after another value without operator in condition after "$IF" or "$ELSEIF"!');

          //read identifier to test
          if not Parser.GetToken(LC) or (LC <> '(') or
             not Parser.GetToken(Token) or
             not Parser.GetToken(LC) or (LC <> ')') then
           Exception(etPreCompiler,
                     'Expected "(" + Identifier + ")" after DECLARED in condition after "$IF" or "$ELSEIF"!');

          Value.kind := vkBoolean;    //set if identifier is declared
          Value.bool := assigned(FindIdentifier(Token));
          Token := '';
         end
        else
         begin                      //"not" or identifier
          if Value.kind <> vkNone then
           ExceptionFmt(etPreCompiler,
                        'Identifier "%s" directly after another value without operator in condition after "$IF" or "$ELSEIF"!',
                        [Token]);

          if LC = 'not' then          //is "not"?
           begin
            Token := '';                //parse factor after "not"
            ParseExpression(Token, pFactor, Value);
            assert(Value.kind <> vkNone);
            if Value.kind = vkUnknownIdent then //identifier unknown?
             begin
              Value.kind := vkBoolean;
              Value.bool := True;                 //assume false and negate it
             end
            else
             if Value.kind = vkBoolean then   //negate value
              Value.bool := not Value.bool
             else
              Value.num := not Round(Value.num);
           end
          else
           begin

            Ident := FindIdentifier(Token);   //search the identifier
            if not Assigned(Ident) then
             Ident := TheDefines.ConditionalCompilingConstants.
                                                         GetIdentByName(Token);
            Value.kind := vkUnknownIdent;     //assume identifier not found

            while Assigned(Ident) do          //while value not known
             begin
              if not (Ident.ClassType = TConstant) then
               ExceptionFmt(etPreCompiler,
                            'Identifier "%s" in condition after "$IF" or "$ELSEIF" is not a constant!',
                            [Token]);

              LC := Trim(TConstant(Ident).Value);    //parse value of constant

              if (LC <> '') and (LC[1] = '''') then  //is a string?
               begin
                Value.str := LC;
                Value.kind := vkString;
                Ident := nil;
               end
              else
               begin
                Compare := Length(LC);
                while (Compare > 0) and
                      (LC[Compare] in
                       (StartIdentifierChars + ['0'..'9', '.', '$'])) do
                 Dec(Compare);

                if Compare <> 0 then                 //value is just one token?
                 ExceptionFmt(etPreCompiler,
                              'Constant "%s" in condition after "$IF" or "$ELSEIF" has not a simple value!',
                              [Token]);

                if LC[1] in ['0'..'9', '.', '$'] then //value is a number?
                 begin
                  Val(LC, Value.num, Compare);
                  if Compare <> 0 then
                   ExceptionFmt(etPreCompiler,
                                'Invalid value/number "%s" is constant "%s" in condition after "$IF" or "$ELSEIF"!',
                                [LC, Token]);
                  Value.kind := vkNumber;
                  Ident := nil;
                 end
                else
                 begin
                  Ident := FindIdentifier(LC); //assume it's another identifier
                  if not Assigned(Ident) then
                   Ident := TheDefines.ConditionalCompilingConstants.
                                                            GetIdentByName(LC);
                 end;
               end;
             end;

            //identifier unknown => it may be "True" or "False"
            if not Assigned(Ident) and (Value.Kind = vkUnknownIdent) then
             if (LowerCase(LC) = 'true') or (LowerCase(LC) = 'false') then
              begin
               Value.kind := vkBoolean;               //set the boolean value
               Value.bool := LC[1] in ['T', 't'];
              end
             else
              WarningMessageFmt(etPreCompiler, 'Unknown identifier in conditional compiling expression: %s (%s)', [Token, LC]);
            Token := '';
           end;
         end;
  end;
  NextToken := Token;                   //return the last (unused) token
 end;






var       NextToken      :String;           //an erroneously following token
          Value          :TValue;           //the value of the expression
begin
 if Expression = '' then
  Exception(etPreCompiler,
            'Empty condition after "$IF" or "$ELSEIF"!');

 TheDefines := FDefinesIncluded;            //get defines of the current file