ShaderFile/uengShaderFileExpression.pas

unit uengShaderFileExpression;

{$mode objfpc}{$H+}
{$I uengShaderFile.inc}

interface

uses
  Classes, SysUtils, variants,
  uengShaderFileParser;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TengExpressionItem = class(TObject)
  private
    fOwner: TObject;
    fLine: Integer;
    fCol: Integer;
    fFilename: String;
  public
    property Owner:    TObject read fOwner;
    property Line:     Integer read fLine;
    property Col:      Integer read fCol;
    property Filename: String  read fFilename;

    function GetText: String; virtual;
    function GetValue: Variant; virtual;
    constructor Create(const aOwner: TObject; const aLine, aCol: Integer; const aFilename: String);
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TengExpressionValue = class(TengExpressionItem)
  private
    fValue: Variant;
  public
    function GetText: String; override;
    function GetValue: Variant; override;
    constructor Create(const aValue: Variant; const aOwner: TObject; const aLine, aCol: Integer; const aFilename: String);
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TengExpressionVariable = class(TengExpressionItem)
  private
    fName: String;
  public
    function GetText: String; override;
    function GetValue: Variant; override;
    constructor Create(const aName: String; const aOwner: TObject; const aLine, aCol: Integer; const aFilename: String);
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TengExpressionGroup = class(TengExpressionItem)
  private
    fChild: TengExpressionItem;
  public
    property Child: TengExpressionItem read fChild write fChild;
    function GetText: String; override;
    function GetValue: Variant; override;
    constructor Create(const aChild: TengExpressionItem; const aOwner: TObject; const aLine, aCol: Integer; const aFilename: String);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TengExpressionUnaryOperator = (
    opBinaryNot,
    opLogicalNot,
    opDefined,
    opSet
  );
  TengExpressionUnaryOperation = class(TengExpressionItem)
  private
    fChild: TengExpressionItem;
    fUnaryOp: TengExpressionUnaryOperator;
  public
    property Child: TengExpressionItem read fChild write fChild;
    property UnaryOp: TengExpressionUnaryOperator read fUnaryOp;

    function GetText: String; override;
    function GetValue: Variant; override;

    constructor Create(const aUnaryOp: TengExpressionUnaryOperator; const aOwner: TObject; const aLine, aCol: Integer; const aFilename: String);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TengExpressionBinaryOperator = ( //order of elements in this enum is also the weight of the operators
    opBinaryOr, opBinaryAnd, opBinaryXor,                               // binary
    opMultiply, opDivide, opAdd, opSubtract,                            // arithmetic
    opLogicalOr, opLogicalAnd, opLogicalXor,                            // logical
    opEquals, opLesser, opGreater, opLEquals, opGEquals, opUnequals     // comparison
  );
  TengExpressionBinaryOperation = class(TengExpressionItem)
  private
    fFirst: TengExpressionItem;
    fSecond: TengExpressionItem;
    fBinaryOp: TengExpressionBinaryOperator;
  public
    property First:  TengExpressionItem read fFirst  write fFirst;
    property Second: TengExpressionItem read fSecond write fSecond;
    property BinaryOp: TengExpressionBinaryOperator read fBinaryOp;

    function GetText: String; override;
    function GetValue: Variant; override;

    constructor Create(const aOperator: TengExpressionBinaryOperator; const aOwner: TObject; const aLine, aCol: Integer; const aFilename: String);
    destructor Destroy; override;
  end;

  function ParseExpression(const aOwner: TObject; const aParam: TengTokenParameterList; aIndex: Integer): TengExpressionItem;

implementation

uses
  uengShaderFileConstants, uengShaderFileTypes, uengShaderFileHelper
  {$IFDEF USE_BITSPACE_UTILS}
    , uutlGenerics
  {$ELSE}
    , fgl
  {$ENDIF}
  ;

const
  EXPRESSION_UNARY_OPERATIONS: array[TengExpressionUnaryOperator] of String = (
    TOKEN_OP_BINARY_NOT,  //opBinaryNot
    TOKEN_OP_LOGICAL_NOT, //opLogicalNot
    TOKEN_OP_DEFINED,     //opDefined
    TOKEN_OP_SET          //opSet
  );

  EXPRESSION_BINARY_OPERATIONS: array[TengExpressionBinaryOperator] of String = (
    TOKEN_OP_BINARY_OR,   //opBinaryOr
    TOKEN_OP_BINARY_AND,  //opBinaryAnd
    TOKEN_OP_BINARY_XOR,  //opBinaryXor

    TOKEN_OP_MULTIPLY,    //opMultiply
    TOKEN_OP_DIVIDE,      //opDivide
    TOKEN_OP_ADD,         //opAdd
    TOKEN_OP_SUBTRACT,    //opSubtract

    TOKEN_OP_LOGICAL_OR,  //opLogicalOr
    TOKEN_OP_LOGICAL_AND, //opLogicalAnd
    TOKEN_OP_LOGICAL_XOR, //opLogicalXor

    TOKEN_OP_EQUALS,      //opEquals
    TOKEN_OP_LESSER,      //opLesser
    TOKEN_OP_GREATER,     //opGreater
    TOKEN_OP_LEQUALS,     //opLEquals
    TOKEN_OP_GEQUALS,     //opGEquals
    TOKEN_OP_UNEQUALS     //opUnequals,
  );

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengExpressionItem////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengExpressionItem.GetText: String;
begin
  result := ''; // DUMMY
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengExpressionItem.GetValue: Variant;
begin
  result := Unassigned; // DUMMY
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengExpressionItem.Create(const aOwner: TObject; const aLine, aCol: Integer; const aFilename: String);
begin
  inherited Create;
  fOwner    := aOwner;
  fLine     := aLine;
  fCol      := aCol;
  fFilename := aFilename;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengExpressionValue///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengExpressionValue.GetText: String;
begin
  result := TOKEN_CHAR_QUOTE + fValue + TOKEN_CHAR_QUOTE;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengExpressionValue.GetValue: Variant;
begin
  result := fValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengExpressionValue.Create(const aValue: Variant; const aOwner: TObject; const aLine, aCol: Integer; const aFilename: String);
begin
  inherited Create(aOwner, aLine, aCol, aFilename);
  fValue := aValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengExpressionVariable////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengExpressionVariable.GetText: String;
begin
  result := fName;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengExpressionVariable.GetValue: Variant;
begin
  result := Unassigned; // TODO
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengExpressionVariable.Create(const aName: String; const aOwner: TObject; const aLine, aCol: Integer; const aFilename: String);
begin
  inherited Create(aOwner, aLine, aCol, aFilename);
  fName := aName;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///TengExpressionGroup//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengExpressionGroup.GetText: String;
begin
  if Assigned(fChild)
    then result := TOKEN_OP_GROUP_BEGIN + fChild.GetText + TOKEN_OP_GROUP_END
    else result := '';
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengExpressionGroup.GetValue: Variant;
begin
  if Assigned(fChild)
    then result := fChild.GetValue
    else result := Unassigned;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengExpressionGroup.Create(const aChild: TengExpressionItem; const aOwner: TObject; const aLine, aCol: Integer; const aFilename: String);
begin
  inherited Create(aOwner, aLine, aCol, aFilename);
  fChild := aChild;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TengExpressionGroup.Destroy;
begin
  FreeAndNil(fChild);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengExpressionUnaryOperation//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengExpressionUnaryOperation.GetText: String;
begin
  if not Assigned(fChild) then
    EengExpression.Create('no child assigned', self);
  result :=
    {$IFDEF EXPRESSION_ADD_BRACKET}TOKEN_OP_GROUP_BEGIN+{$ENDIF}
    EXPRESSION_UNARY_OPERATIONS[fUnaryOp] + ' ' + fChild.GetText
    {$IFDEF EXPRESSION_ADD_BRACKET}+TOKEN_OP_GROUP_END{$ENDIF};
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengExpressionUnaryOperation.GetValue: Variant;
var
  v: Variant;
begin
  if not Assigned(fChild) then
    raise EengExpression.Create('no child assigned', self);
  try
    case fUnaryOp of

      opBinaryNot: begin
        v := fChild.GetValue;
        result := not Integer(v);
      end;

      opLogicalNot: begin
        v := fChild.GetValue;
        result := not Boolean(v);
      end;

      opDefined: begin
        // TODO
      end;

      opSet: begin
        // TODO
      end;

    else
      result := inherited GetValue;
    end;
  except
    on ex: Exception do
      raise EengInvalidParamter.Create(
        ex.Message + '("' + GetText + '" ==> ' +
        EXPRESSION_UNARY_OPERATIONS[fUnaryOp] + ' ' + v + '")',
        Line, Col, Filename, Owner);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengExpressionUnaryOperation.Create(const aUnaryOp: TengExpressionUnaryOperator; const aOwner: TObject; const aLine, aCol: Integer; const aFilename: String);
begin
  inherited Create(aOwner, aLine, aCol, aFilename);
  fChild   := nil;
  fUnaryOp := aUnaryOp;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TengExpressionUnaryOperation.Destroy;
begin
  FreeAndNil(fChild);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TengExpressionBinaryOperation/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengExpressionBinaryOperation.GetText: String;
begin
  if not Assigned(fFirst) or not Assigned(fSecond) then
    raise EengExpression.Create('first or second item not assigned');
  result :=
    {$IFDEF EXPRESSION_ADD_BRACKET}TOKEN_OP_GROUP_BEGIN +{$ENDIF}
    fFirst.GetText + ' ' + EXPRESSION_BINARY_OPERATIONS[fBinaryOp] + ' ' + fSecond.GetText
    {$IFDEF EXPRESSION_ADD_BRACKET} + TOKEN_OP_GROUP_END{$ENDIF};
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TengExpressionBinaryOperation.GetValue: Variant;
var
  v1: Variant;
  v2: Variant;
begin
  if not Assigned(fFirst) or not Assigned(fSecond) then
    raise EengExpression.Create('first or second item not assigned');
  v1 := fFirst.GetValue;
  v2 := fSecond.GetValue;
  try
    case fBinaryOp of
      opBinaryOr:   result := (Integer(v1)  or Integer(v2));
      opBinaryAnd:  result := (Integer(v1) and Integer(v2));
      opBinaryXor:  result := (Integer(v1) xor Integer(v2));

      opMultiply:   result := (v1 * v2);
      opDivide:     result := (v1 / v2);
      opAdd:        result := (v1 + v2);
      opSubtract:   result := (v1 - v2);

      opLogicalOr:  result := (Boolean(v1)  or Boolean(v2));
      opLogicalAnd: result := (Boolean(v1) and Boolean(v2));
      opLogicalXor: result := (Boolean(v1) xor Boolean(v2));

      opEquals:     result := (v1  = v2);
      opLesser:     result := (v1  < v2);
      opGreater:    result := (v1  > v2);
      opLEquals:    result := (v1 <= v2);
      opGEquals:    result := (v1 >= v2);
      opUnequals:   result := (v1 <> v2);
    else
      result := inherited GetValue;
    end;
  except
    on ex: Exception do
      raise EengInvalidParamter.Create(
        ex.Message + ' ("' + GetText + '" ==> "' + v1 + ' ' +
        EXPRESSION_BINARY_OPERATIONS[fBinaryOp] + ' ' + v2 + '")',
        fLine, fCol, fFilename, fOwner);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TengExpressionBinaryOperation.Create(const aOperator: TengExpressionBinaryOperator; const aOwner: TObject; const aLine, aCol: Integer; const aFilename: String);
begin
  inherited Create(aOwner, aLine, aCol, aFilename);
  fBinaryOp := aOperator;
  fFirst    := nil;
  fSecond   := nil;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TengExpressionBinaryOperation.Destroy;
begin
  FreeAndNil(fFirst);
  FreeAndNil(fSecond);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
type
  TExpectedParam = (exVariable, exValue, exGroupBegin, exGroupEnd, exUnaryOperation, exBinaryOperation);
  TExpectedParams = set of TExpectedParam;
{$IFDEF USE_BITSPACE_UTILS}
  TExpressionItemStack = specialize TutlSimpleList<TengExpressionItem>;
{$ELSE}
  TExpressionItemStack = class(specialize TFPList<TengExpressionItem>)
  public

  end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ParseExpression(const aOwner: TObject; const aParam: TengTokenParameterList; aIndex: Integer): TengExpressionItem;
var
  p: TengTokenParameter;

  procedure RaiseEx(const aMsg: String);
  begin
    raise EengExpression.Create(aMsg, p.Line, p.Col, aParam.Filename, aOwner);
  end;

  function NextParam: Boolean;
  begin
    inc(aIndex);
    result := (aIndex < aParam.Count);
    if result then
      p := aParam[aIndex];
  end;

  function IsUnaryOperation(const aParam: String; out aOperator: TengExpressionUnaryOperator): Boolean;
  begin
    result := true;
    for aOperator in TengExpressionUnaryOperator do
      if (aParam = EXPRESSION_UNARY_OPERATIONS[aOperator]) then
        exit;
    result := false;
  end;

  function IsBinaryOperation(const aParam: String; out aOperator: TengExpressionBinaryOperator): Boolean;
  begin
    result := true;
    for aOperator in TengExpressionBinaryOperator do
      if (aParam = EXPRESSION_BINARY_OPERATIONS[aOperator]) then
        exit;
    result := false;
  end;

  procedure MergeItems(const aStack: TExpressionItemStack; var aNew: TengExpressionItem);
  var
    item: TengExpressionItem;
  begin
    try
      if (aStack.Count = 0) then begin
        aStack.PushLast(aNew);
        aNew := nil;
        exit;
      end;

      item := aStack.Last;
      if (item is TengExpressionBinaryOperation) then begin
        if (aNew is TengExpressionBinaryOperation) then begin
          //both are binary operators, new is weaker then existing
          if ((aNew as TengExpressionBinaryOperation).BinaryOp <
              (item as TengExpressionBinaryOperation).BinaryOp) then
          begin
            (aNew as TengExpressionBinaryOperation).First := item;
            aStack.PopLast;
            aStack.PushLast(aNew);
            aNew := nil;

          //both are binary operators, new is stronger than existing
          end else begin
            if not Assigned((item as TengExpressionBinaryOperation).Second) then
              RaiseEx('inconsistent state');
            (aNew as TengExpressionBinaryOperation).First  := (item as TengExpressionBinaryOperation).Second;
            (item as TengExpressionBinaryOperation).Second := aNew;
            aStack.PushLast(aNew);
            aNew := nil;
          end;

        //existing is binary operator, new is normal
        end else begin
          if Assigned((item as TengExpressionBinaryOperation).Second) then
            RaiseEx('inconsistent state');
          (item as TengExpressionBinaryOperation).Second := aNew;
          aNew := nil;
          while (aStack.Count > 1) do
            aStack.PopLast; //remove all but first
        end;
      end else begin
        //existing is normal item, new is binary operation
        if (aNew is TengExpressionBinaryOperation) then begin
          aStack.PopLast;
          (aNew as TengExpressionBinaryOperation).First := item;
          aStack.PushLast(aNew);
          aNew := nil;

        //existing is unary operation, new is normal item or unary operation
        end else if (item is TengExpressionUnaryOperation) then begin
          if Assigned((item as TengExpressionUnaryOperation).Child) then
            RaiseEx('inconsistent state');
          (item as TengExpressionUnaryOperation).Child := aNew;
          if not (aNew is TengExpressionUnaryOperation) then begin
            while (aStack.Count > 1) do
              aStack.PopLast; //remove all but first
          end else
            aStack.PushLast(aNew);
          aNew := nil;

        //existing and new are both normal items
        end else
          RaiseEx('inconsistent state');
      end;
    except
      FreeAndNil(aNew);
      raise;
    end;
  end;

  function BuildTree(const aDepth: Integer = 0): TengExpressionItem;
  var
    uOp: TengExpressionUnaryOperator;
    bOp: TengExpressionBinaryOperator;
    expected: TExpectedParams;
    stack: TExpressionItemStack;
    l, c: Integer;
    ei, tmp: TengExpressionItem;
  begin
    expected := [exVariable, exValue, exGroupBegin, exUnaryOperation];
    result := nil;
    stack := TExpressionItemStack.Create(false);
    try try
      repeat
        // GroupBegin
        if (p.Name = TOKEN_OP_GROUP_BEGIN) then begin
          if not (exGroupBegin in expected) then
            RaiseEx('unexpected ''' + p.Name + '''');
          l := p.Line;
          c := p.Col;
          if not NextParam then
            RaiseEx('unexpected end');
          tmp := BuildTree(aDepth + 1);
          ei  := TengExpressionGroup.Create(tmp, aOwner, l, c, aParam.Filename);
          try
            MergeItems(stack, ei);
            if (p.Name <> TOKEN_OP_GROUP_END) then
              RaiseEx('missing ''' + TOKEN_OP_GROUP_END + '''');
            expected := [exBinaryOperation, exGroupEnd];
          except
            FreeAndNil(ei);
            raise;
          end;

        // GroupEnd
        end else if (p.Name = TOKEN_OP_GROUP_END) then begin
          if not (exGroupEnd in expected) or (aDepth = 0) then
            RaiseEx('unexpected ''' + TOKEN_OP_GROUP_END + '''');
          exit;

        // UnaryOperation
        end else if IsUnaryOperation(p.Name, uOp) then begin
          if not (exUnaryOperation in expected) then
            RaiseEx('unexpected operator: ' + p.Name);
          ei := TengExpressionUnaryOperation.Create(uOp, aOwner, p.Line, p.Col, aParam.Filename);
          try
            MergeItems(stack, ei);
            expected := [exVariable];
            if (uOp <> opDefined) then
              expected := expected + [exValue, exGroupBegin, exUnaryOperation]
          except
            FreeAndNil(ei);
            raise;
          end;

        // BinaryOperation
        end else if IsBinaryOperation(p.Name, bOp) then begin
          if not (exBinaryOperation in expected) then
            RaiseEx('unexpected operator: ' + p.Name);
          ei := TengExpressionBinaryOperation.Create(bOp, aOwner, p.Line, p.Col, aParam.Filename);
          try
            MergeItems(stack, ei);
            expected := [exVariable, exValue, exGroupBegin, exUnaryOperation];
          except
            FreeAndNil(ei);
            raise;
          end;

        // Value
        end else if p.Quoted and IsValidIdentifier(p.Name) then begin
          if not (exValue in expected) then
            RaiseEx('unexpected value: ' + p.Name);
          ei := TengExpressionValue.Create(p.Name, aOwner,p.Line, p.Col, aParam.Filename);
          try
            MergeItems(stack, ei);
            expected := [exGroupEnd, exBinaryOperation];
          except
            FreeAndNil(ei);
            raise;
          end;

        // Variable
        end else if IsValidIdentifier(p.Name) then begin
          if not (exVariable in expected) then
            RaiseEx('unexpected variable: ' + p.Name);
          ei := TengExpressionVariable.Create(p.Name, aOwner, p.Line, p.Col, aParam.Filename);
          try
            MergeItems(stack, ei);
            expected := [exGroupEnd, exBinaryOperation];
          except
            FreeAndNil(ei);
            raise
          end;

        // Unknown
        end else
          RaiseEx('invalid parameter: ' + p.Name);
      until not NextParam;
    except
      if (stack.Count > 0) then begin
        stack[0].Free;
        stack[0] := nil;
      end;
      raise;
    end;
    finally
      if (stack.Count > 0) then
        result := stack[0];
      FreeAndNil(stack);
    end;
  end;

begin
  dec(aIndex);
  if not NextParam then with aParam[0] do
    raise EengShaderPartInternal.Create('invalid parameter count in expression', Line, Col, aParam.Filename, aOwner);
  result := BuildTree;
end;

end.