fs_iexpression.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

{******************************************}
{                                          }
{             FastScript v1.8              }
{            Expression parser             }
{                                          }
{  (c) 2003-2005 by Alexander Tzyganenko,  }
{             Fast Reports Inc             }
{                                          }
{******************************************}

unit fs_iexpression;

interface

{$i fs.inc}

uses
  SysUtils, Classes, fs_iinterpreter
{$IFDEF Delphi6}
, Variants
{$ENDIF};


type
  { List of operators }

  TfsOperatorType = (opNone, opGreat, opLess, opLessEq, opGreatEq, opNonEq, opEq,
    opPlus, opMinus, opOr, opXor, opMul, opDivFloat, opDivInt, opMod, opAnd,
    opShl, opShr, opLeftBracket, opRightBracket, opNot, opUnMinus, opIn, opIs);

{ TfsExpression class holds a list of operands and operators.
  List is represented in the tree form.
  Call to methods AddXXX puts an expression element to the list.
  Call to function Value calculates and returns the expression value }

  TfsExpressionNode = class(TfsCustomVariable)
  private
    FLeft, FRight, FParent: TfsExpressionNode;
    procedure AddNode(Node: TfsExpressionNode);
    procedure RemoveNode(Node: TfsExpressionNode);
  public
    destructor Destroy; override;
    function Priority: Integer; virtual; abstract;
  end;

  TfsOperandNode = class(TfsExpressionNode)
  public
    constructor Create(const AValue: Variant);
    function Priority: Integer; override;
  end;

  TfsOperatorNode = class(TfsExpressionNode)
  private
    FOp: TfsOperatorType;
    FOptimizeInt: Boolean;
    FOptimizeBool: Boolean;
  public
    constructor Create(Op: TfsOperatorType);
    function Priority: Integer; override;
  end;

  TfsDesignatorNode = class(TfsOperandNode)
  private
    FDesignator: TfsDesignator;
    FVar: TfsCustomVariable;
  protected
    function GetValue: Variant; override;
  public
    constructor Create(ADesignator: TfsDesignator);
    destructor Destroy; override;
  end;

  TfsSetNode = class(TfsOperandNode)
  private
    FSetExpression: TfsSetExpression;
  protected
    function GetValue: Variant; override;
  public
    constructor Create(ASet: TfsSetExpression);
    destructor Destroy; override;
  end;

  TfsExpression = class(TfsCustomExpression)
  private
    FCurNode: TfsExpressionNode;
    FNode: TfsExpressionNode;
    FScript: TfsScript;
    FSource: String;
    procedure AddOperand(Node: TfsExpressionNode);
  protected
    function GetValue: Variant; override;
    procedure SetValue(const Value: Variant); override;
  public
    constructor Create(Script: TfsScript);
    destructor Destroy; override;
    procedure AddConst(const AValue: Variant);
    procedure AddDesignator(ADesignator: TfsDesignator);
    procedure AddOperator(const Op: String);
    procedure AddSet(ASet: TfsSetExpression);

    function Finalize: String;
    function Optimize(Designator: TfsDesignator): String;
    function SingleItem: TfsCustomVariable;

    property Source: String read FSource write FSource;
  end;


implementation

uses fs_itools;

type
  TNoneNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TGreatNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TLessNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TLessEqNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TGreatEqNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TNonEqNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TEqNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TPlusNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TStrCatNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TMinusNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TOrNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TXorNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TMulNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TDivFloatNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TDivIntNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TModNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TAndNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TShlNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TShrNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TLeftBracketNode = class(TfsOperatorNode);

  TRightBracketNode = class(TfsOperatorNode);

  TNotNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TUnMinusNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TInNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;

  TIsNode = class(TfsOperatorNode)
  protected
    function GetValue: Variant; override;
  end;


function TNoneNode.GetValue: Variant;
begin
  Result := FLeft.Value;
end;

function TGreatNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  Result := Result > FRight.Value;
end;

function TLessNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  Result := Result < FRight.Value;
end;

function TLessEqNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  Result := Result <= FRight.Value;
end;

function TGreatEqNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  Result := Result >= FRight.Value;
end;

function TNonEqNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  Result := Result <> FRight.Value;
end;

function TEqNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  Result := Result = FRight.Value;
end;

function TPlusNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  if FOptimizeInt then
    Result := Integer(Result) + Integer(FRight.Value)
  else
    Result := Result + FRight.Value;
end;

function TStrCatNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  if TVarData(Result).VType = varString then
    Result := VarToStr(Result) + VarToStr(FRight.Value) else
    Result := Result + FRight.Value;
end;

function TMinusNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  if FOptimizeInt then
    Result := Integer(Result) - Integer(FRight.Value)
  else
    Result := Result - FRight.Value;
end;

function TOrNode.GetValue: Variant;
begin
  Result := FLeft.Value;

  if FOptimizeBool then
  begin
    if Boolean(Result) = False then
      Result := FRight.Value;
  end
  else
    Result := Result or FRight.Value;
end;

function TXorNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  Result := Result xor FRight.Value;
end;

function TMulNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  if FOptimizeInt then
    Result := Integer(Result) * Integer(FRight.Value)
  else
    Result := Result * FRight.Value;
end;

function TDivFloatNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  Result := Result / FRight.Value;
end;

function TDivIntNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  if FOptimizeInt then
    Result := Integer(Result) div Integer(FRight.Value)
  else
    Result := Result div FRight.Value;
end;

function TModNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  if FOptimizeInt then
    Result := Integer(Result) mod Integer(FRight.Value)
  else
    Result := Result mod FRight.Value;
end;

function TAndNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  if FOptimizeBool then
  begin
    if Boolean(Result) = True then
      Result := FRight.Value;
  end
  else
    Result := Result and FRight.Value;
end;

function TShlNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  Result := Result shl FRight.Value;
end;

function TShrNode.GetValue: Variant;
begin
  Result := FLeft.Value;
  Result := Result shr FRight.Value;
end;

function TNotNode.GetValue: Variant;
begin
  Result := not FLeft.Value;
end;

function TUnMinusNode.GetValue: Variant;
begin
  Result := -FLeft.Value;
end;

function TInNode.GetValue: Variant;
begin
  Result := TfsSetNode(FRight).FSetExpression.Check(FLeft.Value);
end;

function TIsNode.GetValue: Variant;
begin
  Result := TObject(Integer(FLeft.Value)) is
    TfsClassVariable(TfsDesignatorNode(FRight).FDesignator[0].Ref).ClassRef;
end;


{ TfsExpressionNode }

destructor TfsExpressionNode.Destroy;
begin
  FLeft.Free;
  FRight.Free;
  inherited;
end;

procedure TfsExpressionNode.AddNode(Node: TfsExpressionNode);
begin
  if FLeft = nil then
    FLeft := Node
  else if FRight = nil then
    FRight := Node;
  if Node <> nil then
    Node.FParent := Self;
end;

procedure TfsExpressionNode.RemoveNode(Node: TfsExpressionNode);
begin
  if FLeft = Node then
    FLeft := nil
  else if FRight = Node then
    FRight := nil;
end;