Improve complex $IF and $IFELSE directives handling

[RomanYankovsky]

Partial support for $IF and $IFELSE compiler directives was introduced previously, this work was continued by @LaKraven in #20.

Current implementation is enough in many cases, but $IF and $IFELSE directive still do not support any expression other than "DEFINED" or "NOT DEFINED".

For instance:

{$IF SOME_CONSTANT >= SOME_INTEGER}
{$IF SOME_CONSTANT > SOME_INTEGER}
{$IF SOME_CONSTANT = SOME_INTEGER}
{$IF SOME_CONSTANT < SOME_INTEGER}
{$IF SOME_CONSTANT <= SOME_INTEGER}

Also brackets are not supported too:

{$IF DEFINED(A) AND (DEFINED(B) OR DEFINED(C))}

[LaKraven]

This is particularly difficult to implement as the parser (or rather, Lexer at this point) would need to be aware of the constant and its value. Since these constants can be defined in other units beyond the scope of what's being parsed, the evaluation would either have to result in an "Undeclared Identifier" or default to False.

[RomanYankovsky]

At least we could support some standard variables like CompilerVersion...

[LaKraven]

I was going to suggest perhaps some kind of predefined Constants list, and perhaps even inject constants and values from the unit being parsed as they're encountered. That way we would have something against which to compare.

[RomanYankovsky]

Yes, that's how it works now. When lexer meets {$DEFINE something}, it adds this define in FDefines list. We just need to extend this logic.

[LaKraven]

Okay, so the best bet would be to only assign constants to the internal list that exist within the unit, but to allow constants to be set in that list externally (through the AST layer). This way, when I'm done implementing the Symbol Tree, we can pass along (or, more appropriately, "resolve") constants defined within referenced units, and of course "custom" constants in the implementation that's consuming the AST.

So, by default (as in, using your demo project) {$IF SOME_CONSTANT = SOME_VALUE} and {$ELSEIF SOME_OTHER_CONSTANT = SOME_OTHER_VALUE} etc. will only resolve as True if the constant is defined within the unit being parsed and if its value evaluates affirmatively in the expression. Otherwise, they'll resolve as False.

This should be clearly documented as the intended behaviour so that everyone understands exactly how it works.

Also, this will need to be reconsidered alongside the existing IFDEF and IF/ELSEIF handling when this handling is logically relocated to the Parser rather than the Lexer (as per issue #30)

[uschuster]

What is also missing is support for DECLARED - for example

{$IF DECLARED(AnsiChar)}

This is similar to the constants, but with the difference that it can be almost any symbol.

type
  TFoo = TObject;

procedure Bar;
begin
end;

{$IF DECLARED(TFoo) AND DECLARED(Bar)}
  {$MESSAGE HINT 'TFoo and Bar do exist'}
{$IFEND}

[JBontes]

Here's the fix:

function TmwBasePasLex.EvaluateConditionalExpression(const AParams: string; StartResult: boolean = false): Boolean;
var
  LParams:string;
  BracketCount,i: integer;
  PartialResult: boolean;
  NextPart: string;

function ExtractNextPart(StartPos: integer; BracketCount: integer = 0): string;
var
  i: integer;
  BracketFound: boolean;
  TokenFound: boolean;
  InternalBracketCount: integer;
begin
  i:= 1;
  BracketFound:= false;
  TokenFound:= false;
  InternalBracketCount:= 0;//BracketCount;
  while i < Length(LParams) do begin
    case LParams[i] of
      '(': begin
        Inc(InternalBracketCount);
        BracketFound:= true;
      end;
      ')': begin
        Dec(InternalBracketCount);
      end;
      else TokenFound:= true;
    end;
    if (InternalBracketCount = 0) and BracketFound and TokenFound then begin
      break;
    end;
    Inc(i);
  end;
  Result:= MidStr(LParams, StartPos, i-((StartPos-1)*2));
end;

//Assumes the first char is part of a number
function ExtractNumber: string;
begin
  i:= 1;
  while i <= Length(LParams) do begin
    if (LParams[i] in ['0'..'9','-','.']) then Inc(i)
    else begin
      Dec(i);
      Break;
    end;
  end; {while}
  Result:= LeftStr(LParams, i);
end;

var
  LDefine: string;
  IsComVer, IsRTLVer: boolean;
  LOper: string;
  Value: Extended;
  MyFormatSettings: TFormatSettings;

begin
  IsComVer:= false;
  IsRTLVer:= false;
  LParams:= Trim(Uppercase(AParams));
  Result:= StartResult;
  while (Length(LParams) > 0) do begin
    case LParams[1] of
      '(': begin
        while Pos('(', LParams) = 1 do begin
          NextPart:= ExtractNextPart(2,1);
          Result:= EvaluateConditionalExpression(NextPart, Result);
          Delete(LParams, 1, Length(NextPart) + 2);
          LParams:= TrimLeft(LParams);
        end; {while}
      end; {'('}
      'O':if Pos('OR',LParams) = 1 then begin
        Delete(LParams,1,2);
        LParams:= TrimLeft(LParams);
        NextPart:= ExtractNextPart(1);
        if not(Result) then Result:= Result or EvaluateConditionalExpression(NextPart, Result);
        Delete(LParams, 1, Length(NextPart));
        LParams:= TrimLeft(LParams);
      end;
      'A':if Pos('AND ',LParams) = 1 then begin
        Delete(LParams,1,3);
        LParams:= TrimLeft(LParams);
        NextPart:= ExtractNextPart(1);
        if(Result) then Result:= Result and EvaluateConditionalExpression(NextPart, Result);
        Delete(LParams, 1, Length(NextPart));
        LParams:= TrimLeft(LParams);
      end;
      'X':if Pos('XOR',LParams) = 1 then begin
        Delete(LParams,1,3);
        LParams:= TrimLeft(LParams);
        NextPart:= ExtractNextPart(1);
        Result:= Result xor EvaluateConditionalExpression(NextPart, Result);
        Delete(LParams, 1, Length(NextPart));
        LParams:= TrimLeft(LParams);
      end;
      'D': if Pos('DEFINED(',LParams) = 1 then begin
        LDefine := Copy(LParams, 9, Pos(')', LParams) - 9);
        Result:= IsDefined(LDefine);
        Delete(LParams, 1, Length(LDefine)+9);
        LParams:= TrimLeft(LParams);
      end;
      'N': if (Pos('NOT',LParams) = 1) then begin
        Delete(LParams,1,3);
        LParams:= TrimLeft(LParams);
        NextPart:= ExtractNextPart(1);
        Result:= not EvaluateConditionalExpression(NextPart, Result);
        Delete(LParams, 1, Length(NextPart));
        LParams:= TrimLeft(LParams);
      end;
      'C': if (Pos('COMPILERVERSION',LParams) = 1) then begin
        IsComVer := true;
        Delete(LParams, 1, Length('COMPILERVERSION'));
        LParams:= TrimLeft(LParams);

      end;
      'R': if (Pos('RTLVERSION',LParams) = 1) then begin
        IsRTLVer:= true;
        Delete(LParams, 1, Length('RTLVERSION'));
        LParams:= TrimLeft(LParams);
      end;
      '<','=','>': begin
        if (Pos('>=',LParams) = 1) then LOper:= '>='
        else if (Pos('<=',LParams) = 1) then LOper:= '<='
        else if (Pos('<>',LParams) = 1) then LOper:= '<>'
        else LOper:= LParams[1];
        Delete(LParams, 1, Length(LOper));
        LParams:= TrimLeft(LParams);
        NextPart:= ExtractNumber;
        MyFormatSettings:= FormatSettings;
        MyFormatSettings.DecimalSeparator:= '.';
        if TryStrToFloat(NextPart, Value, MyFormatSettings) then begin
          if IsComVer then
            Result := EvaluateComparison(CompilerVersion, LOper, Value)
          else if IsRtlVer then
            Result := EvaluateComparison(RTLVersion, LOper, Value);
          Delete(LParams, 1, Length(NextPart));
          LParams:= Trim(LParams);
        end else Result:= false;
      end;
      else Exit(false);   //Should not happen.
    end; {case}
  end; {while}
end;