fs_iexpression.pas

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

{ TfsOperandNode }

constructor TfsOperandNode.Create(const AValue: Variant);
var
  t: TfsVarType;
begin
  inherited Create('', fvtInt, '');
  Value := AValue;

  t := fvtInt;
  if TVarData(AValue).VType = varBoolean then
    t := fvtBool
  else if TVarData(AValue).VType in [varSingle, varDouble, varCurrency] then
    t := fvtFloat
  else if (TVarData(AValue).VType = varOleStr) or
    (TVarData(AValue).VType = varString) then
    t := fvtString;

  Typ := t;
end;

function TfsOperandNode.Priority: Integer;
begin
  Result := 0;
end;


{ TfsOperatorNode }

constructor TfsOperatorNode.Create(Op: TfsOperatorType);
begin
  inherited Create('', fvtInt, '');
  FOp := Op;
end;

function TfsOperatorNode.Priority: Integer;
begin
  case FOp of
    opNone:
      Result := 7;
    opLeftBracket:
      Result := 6;
    opRightBracket:
      Result := 5;
    opGreat, opLess, opGreatEq, opLessEq, opNonEq, opEq, opIn, opIs:
      Result := 4;
    opPlus, opMinus, opOr, opXor:
      Result := 3;
    opMul, opDivFloat, opDivInt, opMod, opAnd, opShr, opShl:
      Result := 2;
    opNot, opUnMinus:
      Result := 1;
    else
      Result := 0;
  end;
end;


{ TfsDesignatorNode }

constructor TfsDesignatorNode.Create(ADesignator: TfsDesignator);
begin
  inherited Create(0);
  FDesignator := ADesignator;
  Typ := ADesignator.Typ;
  TypeName := ADesignator.TypeName;
  if FDesignator is TfsVariableDesignator then
    FVar := FDesignator.RefItem else
    FVar := FDesignator;
end;

destructor TfsDesignatorNode.Destroy;
begin
  FDesignator.Free;
  inherited;
end;

function TfsDesignatorNode.GetValue: Variant;
begin
  Result := FVar.Value;
end;


{ TfsSetNode }

constructor TfsSetNode.Create(ASet: TfsSetExpression);
begin
  inherited Create(0);
  FSetExpression := ASet;
  Typ := fvtVariant;
end;

destructor TfsSetNode.Destroy;
begin
  FSetExpression.Free;
  inherited;
end;

function TfsSetNode.GetValue: Variant;
begin
  Result := FSetExpression.Value;
end;


{ TfsExpression }

constructor TfsExpression.Create(Script: TfsScript);
begin
  inherited Create('', fvtInt, '');
  FNode := TNoneNode.Create(opNone);
  FCurNode := FNode;
  FScript := Script;
end;

destructor TfsExpression.Destroy;
begin
  FNode.Free;
  inherited;
end;

function TfsExpression.GetValue: Variant;
begin
  Result := FNode.Value;
end;

procedure TfsExpression.AddOperand(Node: TfsExpressionNode);
begin
  FCurNode.AddNode(Node);
  FCurNode := Node;
end;

procedure TfsExpression.AddOperator(const Op: String);
var
  Node: TfsExpressionNode;
  n, n1: TfsExpressionNode;

  function CreateOperatorNode(s: String): TfsOperatorNode;
  begin
    s := AnsiUpperCase(s);
    if s = ' ' then
      Result := TNoneNode.Create(opNone)
    else if s = '>' then
      Result := TGreatNode.Create(opGreat)
    else if s = '<' then
      Result := TLessNode.Create(opLess)
    else if s = '<=' then
      Result := TLessEqNode.Create(opLessEq)
    else if s = '>=' then
      Result := TGreatEqNode.Create(opGreatEq)
    else if s = '<>' then
      Result := TNonEqNode.Create(opNonEq)
    else if s = '=' then
      Result := TEqNode.Create(opEq)
    else if s = '+' then
      Result := TPlusNode.Create(opPlus)
    else if s = 'STRCAT' then
      Result := TStrCatNode.Create(opPlus)
    else if s = '-' then
      Result := TMinusNode.Create(opMinus)
    else if s = 'OR' then
      Result := TOrNode.Create(opOr)
    else if s = 'XOR' then
      Result := TXorNode.Create(opXor)
    else if s = '*' then
      Result := TMulNode.Create(opMul)
    else if s = '/' then
      Result := TDivFloatNode.Create(opDivFloat)
    else if s = 'DIV' then
      Result := TDivIntNode.Create(opDivInt)
    else if s = 'MOD' then
      Result := TModNode.Create(opMod)
    else if s = 'AND' then
      Result := TAndNode.Create(opAnd)
    else if s = 'SHL' then
      Result := TShlNode.Create(opShl)
    else if s = 'SHR' then
      Result := TShrNode.Create(opShr)
    else if s = '(' then
      Result := TLeftBracketNode.Create(opLeftBracket)
    else if s = ')' then
      Result := TRightBracketNode.Create(opRightBracket)
    else if s = 'NOT' then
      Result := TNotNode.Create(opNot)
    else if s = 'UNMINUS' then
      Result := TUnMinusNode.Create(opUnMinus)
    else if s = 'IN' then
      Result := TInNode.Create(opIn)
    else if s = 'IS' then
      Result := TIsNode.Create(opIs)
    else
      Result := nil;
  end;

begin
  Node := CreateOperatorNode(Op);
  Node.SourcePos := SourcePos;

  if (Op = '(') or (Op = 'unminus') or (Op = 'not') then
    AddOperand(Node)
  else if Op = ')' then
  begin
    n := FCurNode;
    while n.Priority <= Node.Priority do
      n := n.FParent;

    n.FParent.RemoveNode(n);
    n.FParent.AddNode(n.FLeft);

    Node.Free;
    Node := n.FLeft;
    n.FLeft := nil;
    n.Free;
  end
  else if FCurNode = FNode then
    FNode.AddNode(Node)
  else
  begin
    n := FCurNode;
    n1 := nil;
    if FCurNode.Priority <> 6 then
    begin
      n := FCurNode.FParent;
      n1 := FCurNode;
    end;

    while n.Priority <= Node.Priority do
    begin
      n1 := n;
      n := n.FParent;
    end;

    n.RemoveNode(n1);
    n.AddNode(Node);
    Node.AddNode(n1);
  end;

  FCurNode := Node;
end;

procedure TfsExpression.AddConst(const AValue: Variant);
var
  Node: TfsOperandNode;
begin
  Node := TfsOperandNode.Create(AValue);
  Node.SourcePos := SourcePos;
  AddOperand(Node);
end;

procedure TfsExpression.AddDesignator(ADesignator: TfsDesignator);
var
  Node: TfsDesignatorNode;
begin
  Node := TfsDesignatorNode.Create(ADesignator);
  Node.SourcePos := SourcePos;
  AddOperand(Node);
end;

procedure TfsExpression.AddSet(ASet: TfsSetExpression);
var
  Node: TfsSetNode;
begin
  Node := TfsSetNode.Create(ASet);
  Node.SourcePos := SourcePos;
  AddOperand(Node);
end;

function TfsExpression.Finalize: String;
var
  ErrorPos: String;
  TypeRec: TfsTypeRec;

  function GetType(Item: TfsExpressionNode): TfsTypeRec;
  var
    Typ1, Typ2: TfsTypeRec;
    op: TfsOperatorType;
    Error: Boolean;
  begin
    if Item = nil then
      Result.Typ := fvtVariant
    else if Item is TfsOperandNode then
    begin
      Result.Typ := Item.Typ;
      Result.TypeName := Item.TypeName;
    end
    else
    begin
      Typ1 := GetType(Item.FLeft);
      Typ2 := GetType(Item.FRight);
      if (Typ1.Typ = fvtInt) and (Typ2.Typ = fvtInt) then
        TfsOperatorNode(Item).FOptimizeInt := True;
      if (Typ1.Typ = fvtBool) and (Typ2.Typ = fvtBool) then
        TfsOperatorNode(Item).FOptimizeBool := True;

      op := TfsOperatorNode(Item).FOp;

      if (op = opIs) and (Typ1.Typ = fvtClass) and (Typ2.Typ = fvtClass) then
        Error := False
      else
      begin
        { check types compatibility }
        Error := not TypesCompatible(Typ1, Typ2, FScript);
        { check operators applicability }
        if not Error then
          case Typ1.Typ of
            fvtBool:
              Error := not (op in [opNonEq, opEq, opOr, opXor, opAnd, opNot]);
            fvtChar, fvtString:
              Error := not (op in [opGreat, opLess, opLessEq, opGreatEq, opNonEq, opEq, opPlus, opIn]);
            fvtClass, fvtArray:
              Error := not (op in [opNonEq, opEq]);
          end;
      end;

      if not Error then
      begin
        Result := Typ1;
        { if one type is Float, resulting type is float too }
        if [Typ1.Typ] + [Typ2.Typ] = [fvtInt, fvtFloat] then
          Result.Typ := fvtFloat;
        { case int / int = float }  
        if (Typ1.Typ = fvtInt) and (Typ2.Typ = fvtInt) and (op = opDivFloat) then
          Result.Typ := fvtFloat;
        { result of comparing two types is always boolean }
        if op in [opGreat, opLess, opLessEq, opGreatEq, opNonEq, opEq, opIn, opIs] then
          Result.Typ := fvtBool;
      end
      else if ErrorPos = '' then
        ErrorPos := Item.SourcePos;

      Item.Typ := Result.Typ;
    end;
  end;

begin
  { remove the empty root node }
  FCurNode := FNode.FLeft;
  FNode.RemoveNode(FCurNode);
  FNode.Free;
  FNode := FCurNode;

  { check and get the expression type }
  ErrorPos := '';
  TypeRec := GetType(FNode);
  Typ := TypeRec.Typ;
  TypeName := TypeRec.TypeName;
  Result := ErrorPos;

  { expression is assignable if it has only one node of type "Variable" }
  if not ((FNode is TfsDesignatorNode) and not
    (TfsDesignatorNode(FNode).FDesignator.IsReadOnly)) then
    IsReadOnly := True;
end;

procedure TfsExpression.SetValue(const Value: Variant);
begin
  if not IsReadOnly then
    TfsDesignatorNode(FNode).FDesignator.Value := Value;
end;

function TfsExpression.Optimize(Designator: TfsDesignator): String;
var
  Op: TfsOperatorType;
begin
  Result := ' ';

  if not (Designator is TfsVariableDesignator) or
    not (FNode is TfsOperatorNode) then Exit;

  Op := TfsOperatorNode(FNode).FOp;
  if not (Op in [opPlus, opMinus, opDivFloat, opMul]) then Exit;

  { optimize a := a op b statement }
  if (FNode.FLeft is TfsDesignatorNode) and
    (TfsDesignatorNode(FNode.FLeft).FDesignator is TfsVariableDesignator) and
    (TfsDesignatorNode(FNode.FLeft).FDesignator.RefItem = Designator.RefItem) then
  begin
    FCurNode := FNode.FRight;
    FNode.RemoveNode(FCurNode);
    FNode.Free;
    FNode := FCurNode;

    if Op = opPlus then
      Result := '+'
    else if Op = opMinus then
      Result := '-'
    else if Op = opDivFloat then
      Result := '/'
    else if Op = opMul then
      Result := '*';
  end
  { optimize a := b op a statement }
  else if (FNode.FRight is TfsDesignatorNode) and
    (TfsDesignatorNode(FNode.FRight).FDesignator is TfsVariableDesignator) and
    (TfsDesignatorNode(FNode.FRight).FDesignator.RefItem = Designator.RefItem) and
    (Op in [opPlus, opMul]) and
    not (Designator.RefItem.Typ in [fvtString, fvtVariant]) then
  begin
    FCurNode := FNode.FLeft;
    FNode.RemoveNode(FCurNode);
    FNode.Free;
    FNode := FCurNode;

    if Op = opPlus then
      Result := '+'
    else if Op = opMul then
      Result := '*';
  end;
end;

function TfsExpression.SingleItem: TfsCustomVariable;
begin
  { if expression contains only one item, returns reference to it }
  Result := nil;

  if FNode is TfsDesignatorNode then
  begin
    if TfsDesignatorNode(FNode).FDesignator is TfsVariableDesignator then
      Result := TfsDesignatorNode(FNode).FDesignator.RefItem else
      Result := TfsDesignatorNode(FNode).FDesignator;
  end
  else if FNode is TfsOperandNode then
    Result := FNode;
end;

end.