lazarus-ccr/components/fpspreadsheet/fpsexprparser.pas

{
    This file is part of the Free Component Library (FCL)
    Copyright (c) 2008 Michael Van Canneyt.

    Expression parser, supports variables, functions and
    float/integer/string/boolean/datetime operations.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

--------------------------------------------------------------------------------

    Modified for integration into fpspreadsheet by Werner Pamler:
    - Original file name: fpexprpars.pp
    - Rename identifiers to avoid naming conflicts with the original
    - TsExpressionParser and TsBuiltinExpressionManager are not components
      any more
    - TsExpressionParser is created with the worksheet as a parameter.
    - add new TExprNode classes:
      - TsCellExprNode for references to cells
      - TsCellRangeExprNode for references to cell ranges
      - TsPercentExprNode and token "%" to handle Excel's percent operation
      - TsParenthesisExprNode to handle the parenthesis token in RPN formulas
      - TsConcatExprNode and token "&" to handle string concatenation
      - TsUPlusExprNode for unary plus symbol
    - remove and modifiy built-in function such that the parser is compatible
      with Excel syntax (and Open/LibreOffice - which is the same).
    - use double quotes for strings (instead of single quotes)
    - add boolean constants "TRUE" and "FALSE".
    - add property RPNFormula to interface the parser to RPN formulas of xls files.
    - accept funtions with zero parameters

 ******************************************************************************}

// To do:
// Remove exceptions, use error message strings instead
// Cell reference not working (--> formula CELL!)
// Missing arguments
// Keep spaces in formula

{$mode objfpc}
{$h+}
unit fpsExprParser;

interface

uses
  Classes, SysUtils, contnrs, fpspreadsheet;

type
  { Tokens }

(*  { Basic operands }
  fekCell, fekCellRef, fekCellRange, fekCellOffset, fekNum, fekInteger,
  fekString, fekBool, fekErr, fekMissingArg,
  { Basic operations }
  fekAdd, fekSub, fekMul, fekDiv, fekPercent, fekPower, fekUMinus, fekUPlus,
  fekConcat,  // string concatenation
  fekEqual, fekGreater, fekGreaterEqual, fekLess, fekLessEqual, fekNotEqual,
  fekParen,
*)
  TsTokenType = (
    ttCell, ttCellRange, ttNumber, ttString, ttIdentifier,
    ttPlus, ttMinus, ttMul, ttDiv, ttConcat, ttPercent, ttPower, ttLeft, ttRight,
    ttLessThan, ttLargerThan, ttEqual, ttNotEqual, ttLessThanEqual, ttLargerThanEqual,
    ttComma, ttTrue, ttFalse, ttEOF
  );

  TsExprFloat = Double;
  TsExprFloatArray = array of TsExprFloat;

const
  ttDelimiters = [
    ttPlus, ttMinus, ttMul, ttDiv, ttLeft, ttRight, ttLessThan, ttLargerThan,
    ttEqual, ttNotEqual, ttLessThanEqual, ttLargerThanEqual
  ];

  ttComparisons = [
    ttLargerThan, ttLessThan, ttLargerThanEqual, ttLessThanEqual, ttEqual, ttNotEqual
  ];

type
  TsExpressionParser = class;
  TsBuiltInExpressionManager = class;

  TsResultType = (rtEmpty, rtBoolean, rtInteger, rtFloat, rtDateTime, rtString,
    rtCell, rtCellRange, rtError, rtAny);
  TsResultTypes = set of TsResultType;

  TsExpressionResult = record
    Worksheet       : TsWorksheet;
    ResString       : String;
    case ResultType : TsResultType of
      rtEmpty       : ();
      rtError       : (ResError       : TsErrorValue);
      rtBoolean     : (ResBoolean     : Boolean);
      rtInteger     : (ResInteger     : Int64);
      rtFloat       : (ResFloat       : TsExprFloat);
      rtDateTime    : (ResDateTime    : TDatetime);
      rtCell        : (ResRow, ResCol : Cardinal);
      rtCellRange   : (ResCellRange   : TsCellRange);
      rtString      : ();
  end;
  PsExpressionResult = ^TsExpressionResult;
  TsExprParameterArray = array of TsExpressionResult;

  { TsExprNode }
  TsExprNode = class(TObject)
  protected
    procedure CheckNodeType(ANode: TsExprNode; Allowed: TsResultTypes);
    // A procedure with var saves an implicit try/finally in each node
    // A marked difference in execution speed.
    procedure GetNodeValue(var Result: TsExpressionResult); virtual; abstract;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; virtual; abstract;
    function AsString: string; virtual; abstract;
    procedure Check; virtual; abstract;
    function NodeType: TsResultType; virtual; abstract;
    function NodeValue: TsExpressionResult;
  end;

  TsExprArgumentArray = array of TsExprNode;

  { TsBinaryOperationExprNode }
  TsBinaryOperationExprNode = class(TsExprNode)
  private
    FLeft: TsExprNode;
    FRight: TsExprNode;
  protected
    procedure CheckSameNodeTypes; virtual;
  public
    constructor Create(ALeft, ARight: TsExprNode);
    destructor Destroy; override;
    procedure Check; override;
    property Left: TsExprNode read FLeft;
    property Right: TsExprNode read FRight;
  end;
  TsBinaryOperationExprNodeClass = class of TsBinaryOperationExprNode;

  { TsBooleanOperationExprNode }
  TsBooleanOperationExprNode = class(TsBinaryOperationExprNode)
  public
    procedure Check; override;
    function NodeType: TsResultType; override;
  end;

  { TsBooleanResultExprNode }
  TsBooleanResultExprNode = class(TsBinaryOperationExprNode)
  protected
    procedure CheckSameNodeTypes; override;
  public
    procedure Check; override;
    function NodeType: TsResultType; override;
  end;
  TsBooleanResultExprNodeClass = class of TsBooleanResultExprNode;

  { TsEqualExprNode }
  TsEqualExprNode = class(TsBooleanResultExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: string; override;
  end;

  { TsNotEqualExprNode }
  TsNotEqualExprNode = class(TsEqualExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: string; override;
  end;

  { TsOrderingExprNode }
  TsOrderingExprNode = class(TsBooleanResultExprNode)
  protected
    procedure CheckSameNodeTypes; override;
  public
    procedure Check; override;
  end;

  { TsLessExprNode }
  TsLessExprNode = class(TsOrderingExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: string; override;
  end;

  { TsGreaterExprNode }
  TsGreaterExprNode = class(TsOrderingExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: string; override;
  end;

  { TsLessEqualExprNode }
  TsLessEqualExprNode = class(TsGreaterExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: string; override;
  end;

  { TsGreaterEqualExprNode }
  TsGreaterEqualExprNode = class(TsLessExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: string; override;
  end;

  { TsConcatExprNode }
  TsConcatExprNode = class(TsBinaryOperationExprNode)
  protected
    procedure CheckSameNodeTypes; override;
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: string ; override;
    procedure Check; override;
    function NodeType: TsResultType; override;
  end;

  { TsMathOperationExprNode }
  TsMathOperationExprNode = class(TsBinaryOperationExprNode)
  protected
    procedure CheckSameNodeTypes; override;
  public
    procedure Check; override;
    function NodeType: TsResultType; override;
  end;

  { TsAddExprNode }
  TsAddExprNode = class(TsMathOperationExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: string ; override;
  end;

  { TsSubtractExprNode }
  TsSubtractExprNode = class(TsMathOperationExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: string ; override;
  end;

  { TsMultiplyExprNode }
  TsMultiplyExprNode = class(TsMathOperationExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: string ; override;
  end;

  { TsDivideExprNode }
  TsDivideExprNode = class(TsMathOperationExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: string ; override;
    function NodeType: TsResultType; override;
  end;

  { TsPowerExprNode }
  TsPowerExprNode = class(TsMathOperationExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: string ; override;
    function NodeType: TsResultType; override;
  end;

  { TsUnaryOperationExprNode }
  TsUnaryOperationExprNode = class(TsExprNode)
  private
    FOperand: TsExprNode;
  protected
    procedure Check; override;
  public
    constructor Create(AOperand: TsExprNode);
    destructor Destroy; override;
    property Operand: TsExprNode read FOperand;
  end;

  { TsConvertExprNode }
  TsConvertExprNode = class(TsUnaryOperationExprNode)
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: String; override;
  end;

  { TsNotExprNode }
  TsNotExprNode = class(TsUnaryOperationExprNode)
  protected
    procedure Check; override;
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: String; override;
    function NodeType: TsResultType; override;
  end;

  { TsConvertToIntExprNode }
  TsConvertToIntExprNode = class(TsConvertExprNode)
  public
    procedure Check; override;
  end;

  { TsIntToFloatExprNode }
  TsIntToFloatExprNode = class(TsConvertToIntExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function NodeType: TsResultType; override;
  end;

  { TsIntToDateTimeExprNode }
  TsIntToDateTimeExprNode = class(TsConvertToIntExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function NodeType: TsResultType; override;
  end;

  { TsFloatToDateTimeExprNode }
  TsFloatToDateTimeExprNode = class(TsConvertExprNode)
  protected
    procedure Check; override;
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function NodeType: TsResultType; override;
  end;

  { TsUPlusExprNode }
  TsUPlusExprNode = class(TsUnaryOperationExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: String; override;
    procedure Check; override;
    function NodeType: TsResultType; override;
  end;

  { TsUMinusExprNode }
  TsUMinusExprNode = class(TsUnaryOperationExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: String; override;
    procedure Check; override;
    function NodeType: TsResultType; override;
  end;

  { TsPercentExprNode }
  TsPercentExprNode = class(TsUnaryOperationExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: String; override;
    procedure Check; override;
    function NodeType: TsResultType; override;
  end;

  { TsParenthesisExprNode }
  TsParenthesisExprNode = class(TsUnaryOperationExprNode)
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: String; override;
    function NodeType: TsResultType; override;
  end;

  { TsConstExprNode }
  TsConstExprNode = class(TsExprNode)
  private
    FValue: TsExpressionResult;
  protected
    procedure Check; override;
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    constructor CreateString(AValue: String);
    constructor CreateInteger(AValue: Int64);
    constructor CreateDateTime(AValue: TDateTime);
    constructor CreateFloat(AValue: TsExprFloat);
    constructor CreateBoolean(AValue: Boolean);
    constructor CreateError(AValue: TsErrorValue);
    function AsString: string; override;
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function NodeType : TsResultType; override;
    // For inspection
    property ConstValue: TsExpressionResult read FValue;
  end;

  TsExprIdentifierType = (itVariable, itFunctionCallBack, itFunctionHandler);

  TsExprFunctionCallBack = procedure (var Result: TsExpressionResult;
    const Args: TsExprParameterArray);

  TsExprFunctionEvent = procedure (var Result: TsExpressionResult;
    const Args: TsExprParameterArray) of object;

  { TsExprIdentifierDef }
  TsExprIdentifierDef = class(TCollectionItem)
  private
    FStringValue: String;
    FValue: TsExpressionResult;
    FArgumentTypes: String;
    FIDType: TsExprIdentifierType;
    FName: ShortString;
    FExcelCode: Integer;
    FVariableArgumentCount: Boolean;
    FOnGetValue: TsExprFunctionEvent;
    FOnGetValueCB: TsExprFunctionCallBack;
    function GetAsBoolean: Boolean;
    function GetAsDateTime: TDateTime;
    function GetAsFloat: TsExprFloat;
    function GetAsInteger: Int64;
    function GetAsString: String;
    function GetResultType: TsResultType;
    function GetValue: String;
    procedure SetArgumentTypes(const AValue: String);
    procedure SetAsBoolean(const AValue: Boolean);
    procedure SetAsDateTime(const AValue: TDateTime);
    procedure SetAsFloat(const AValue: TsExprFloat);
    procedure SetAsInteger(const AValue: Int64);
    procedure SetAsString(const AValue: String);
    procedure SetName(const AValue: ShortString);
    procedure SetResultType(const AValue: TsResultType);
    procedure SetValue(const AValue: String);
  protected
    procedure CheckResultType(const AType: TsResultType);
    procedure CheckVariable;
  public
    function ArgumentCount: Integer;
    procedure Assign(Source: TPersistent); override;
    property AsFloat: TsExprFloat Read GetAsFloat Write SetAsFloat;
    property AsInteger: Int64 Read GetAsInteger Write SetAsInteger;
    property AsString: String Read GetAsString Write SetAsString;
    property AsBoolean: Boolean Read GetAsBoolean Write SetAsBoolean;
    property AsDateTime: TDateTime Read GetAsDateTime Write SetAsDateTime;
    function HasFixedArgumentCount: Boolean;
    function IsOptionalArgument(AIndex: Integer): Boolean;
    property OnGetFunctionValueCallBack: TsExprFunctionCallBack read FOnGetValueCB write FOnGetValueCB;
  published
    property IdentifierType: TsExprIdentifierType read FIDType write FIDType;
    property Name: ShortString read FName write SetName;
    property Value: String read GetValue write SetValue;
    property ParameterTypes: String read FArgumentTypes write SetArgumentTypes;
    property ResultType: TsResultType read GetResultType write SetResultType;
    property ExcelCode: Integer read FExcelCode write FExcelCode;
    property VariableArgumentCount: Boolean read FVariableArgumentCount write FVariableArgumentCount;
    property OnGetFunctionValue: TsExprFunctionEvent read FOnGetValue write FOnGetValue;
  end;

  TsBuiltInExprCategory = (bcMath, bcStatistics, bcStrings, bcLogical, bcDateTime,
    bcLookup, bcInfo, bcUser);

  TsBuiltInExprCategories = set of TsBuiltInExprCategory;

  { TsBuiltInExprIdentifierDef }
  TsBuiltInExprIdentifierDef = class(TsExprIdentifierDef)
  private
    FCategory: TsBuiltInExprCategory;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property Category: TsBuiltInExprCategory read FCategory write FCategory;
  end;

  { TsExprIdentifierDefs }
  TsExprIdentifierDefs = class(TCollection)
  private
    FParser: TsExpressionParser;
    function GetI(AIndex: Integer): TsExprIdentifierDef;
    procedure SetI(AIndex: Integer; const AValue: TsExprIdentifierDef);
  protected
    procedure Update(Item: TCollectionItem); override;
    property Parser: TsExpressionParser read FParser;
  public
    function FindIdentifier(const AName: ShortString): TsExprIdentifierDef;
    function IdentifierByExcelCode(const AExcelCode: Integer): TsExprIdentifierDef;
    function IdentifierByName(const AName: ShortString): TsExprIdentifierDef;
    function IndexOfIdentifier(const AName: ShortString): Integer; overload;
    function IndexOfIdentifier(const AExcelCode: Integer): Integer; overload;
    function AddVariable(const AName: ShortString; AResultType: TsResultType;
      AValue: String): TsExprIdentifierDef;
    function AddBooleanVariable(const AName: ShortString;
      AValue: Boolean): TsExprIdentifierDef;
    function AddIntegerVariable(const AName: ShortString;
      AValue: Integer): TsExprIdentifierDef;
    function AddFloatVariable(const AName: ShortString;
      AValue: TsExprFloat): TsExprIdentifierDef;
    function AddStringVariable(const AName: ShortString;
      AValue: String): TsExprIdentifierDef;
    function AddDateTimeVariable(const AName: ShortString;
      AValue: TDateTime): TsExprIdentifierDef;
    function AddFunction(const AName: ShortString; const AResultType: Char;
      const AParamTypes: String; const AExcelCode: Integer;
      ACallBack: TsExprFunctionCallBack): TsExprIdentifierDef;
    function AddFunction(const AName: ShortString; const AResultType: Char;
      const AParamTypes: String; const AExcelCode: Integer;
      ACallBack: TsExprFunctionEvent): TsExprIdentifierDef;
    property Identifiers[AIndex: Integer]: TsExprIdentifierDef read GetI write SetI; default;
  end;

  { TsIdentifierExprNode }
  TsIdentifierExprNode = class(TsExprNode)
  private
    FID: TsExprIdentifierDef;
    PResult: PsExpressionResult;
    FResultType: TsResultType;
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    constructor CreateIdentifier(AID: TsExprIdentifierDef);
    function NodeType: TsResultType; override;
    property Identifier: TsExprIdentifierDef read FID;
  end;

  { TsVariableExprNode }
  TsVariableExprNode = class(TsIdentifierExprNode)
    procedure Check; override;
    function AsString: string; override;
    Function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
  end;

  { TsFunctionExprNode }
  TsFunctionExprNode = class(TsIdentifierExprNode)
  private
    FArgumentNodes: TsExprArgumentArray;
    FargumentParams: TsExprParameterArray;
  protected
    procedure CalcParams;
  public
    constructor CreateFunction(AID: TsExprIdentifierDef;
      const Args: TsExprArgumentArray); virtual;
    destructor Destroy; override;
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: String; override;
    procedure Check; override;
    property ArgumentNodes: TsExprArgumentArray read FArgumentNodes;
    property ArgumentParams: TsExprParameterArray read FArgumentParams;
  end;

  { TsFunctionCallBackExprNode }
  TsFunctionCallBackExprNode = class(TsFunctionExprNode)
  private
    FCallBack: TsExprFunctionCallBack;
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    constructor CreateFunction(AID: TsExprIdentifierDef;
      const Args: TsExprArgumentArray); override;
    property CallBack: TsExprFunctionCallBack read FCallBack;
  end;

  { TFPFunctionEventHandlerExprNode }
  TFPFunctionEventHandlerExprNode = class(TsFunctionExprNode)
  private
    FCallBack: TsExprFunctionEvent;
  protected
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    constructor CreateFunction(AID: TsExprIdentifierDef;
      const Args: TsExprArgumentArray); override;
    property CallBack: TsExprFunctionEvent read FCallBack;
  end;

  { TsCellExprNode }
  TsCellExprNode = class(TsExprNode)
  private
    FWorksheet: TsWorksheet;
    FRow, FCol: Cardinal;
    FFlags: TsRelFlags;
    FCell: PCell;
    FIsRef: Boolean;
  protected
    procedure Check; override;
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    constructor Create(AWorksheet: TsWorksheet; ACellString: String); overload;
    constructor Create(AWorksheet: TsWorksheet; ARow, ACol: Cardinal;
      AFlags: TsRelFlags); overload;
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: string; override;
    function NodeType: TsResultType; override;
    property Worksheet: TsWorksheet read FWorksheet;
  end;

  { TsCellRangeExprNode }
  TsCellRangeExprNode = class(TsExprNode)
  private
    FWorksheet: TsWorksheet;
    FRow1, FRow2: Cardinal;
    FCol1, FCol2: Cardinal;
    FFlags: TsRelFlags;
  protected
    procedure Check; override;
    procedure GetNodeValue(var Result: TsExpressionResult); override;
  public
    constructor Create(AWorksheet: TsWorksheet; ACellRangeString: String); overload;
    constructor Create(AWorksheet: TsWorksheet; ARow1,ACol1, ARow2,ACol2: Cardinal;
      AFlags: TsRelFlags); overload;
    function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
    function AsString: String; override;
    function NodeType: TsResultType; override;
    property Worksheet: TsWorksheet read FWorksheet;
  end;

  { TsExpressionScanner }
  TsExpressionScanner = class(TObject)
    FSource : String;
    LSource,
    FPos: Integer;
    FChar: PChar;
    FToken: String;
    FTokenType: TsTokenType;
  private
    function GetCurrentChar: Char;
    procedure ScanError(Msg: String);
  protected
    procedure SetSource(const AValue: String); virtual;
    function DoIdentifier: TsTokenType;
    function DoNumber: TsTokenType;
    function DoDelimiter: TsTokenType;
    function DoString: TsTokenType;
    function NextPos: Char; // inline;
    procedure SkipWhiteSpace; // inline;
    function IsWordDelim(C: Char): Boolean; // inline;
    function IsDelim(C: Char): Boolean; // inline;
    function IsDigit(C: Char): Boolean; // inline;
    function IsAlpha(C: Char): Boolean; // inline;
  public
    constructor Create;
    function GetToken: TsTokenType;
    property Token: String read FToken;
    property TokenType: TsTokenType read FTokenType;
    property Source: String read FSource write SetSource;
    property Pos: Integer read FPos;
    property CurrentChar: Char read GetCurrentChar;
  end;

  EExprScanner = class(Exception);

  { TsExpressionParser }
  TsExpressionParser = class
  private
    FBuiltIns: TsBuiltInExprCategories;
    FExpression: String;
    FScanner: TsExpressionScanner;
    FExprNode: TsExprNode;
    FIdentifiers: TsExprIdentifierDefs;
    FHashList: TFPHashObjectlist;
    FDirty: Boolean;
    FWorksheet: TsWorksheet;
    procedure CheckEOF;
    procedure CheckNodes(var ALeft, ARight: TsExprNode);
    function ConvertNode(Todo: TsExprNode; ToType: TsResultType): TsExprNode;
    function GetAsBoolean: Boolean;
    function GetAsDateTime: TDateTime;
    function GetAsFloat: TsExprFloat;
    function GetAsInteger: Int64;
    function GetAsString: String;
    function GetRPNFormula: TsRPNFormula;
    function MatchNodes(Todo, Match: TsExprNode): TsExprNode;
    procedure SetBuiltIns(const AValue: TsBuiltInExprCategories);
    procedure SetIdentifiers(const AValue: TsExprIdentifierDefs);
    procedure SetRPNFormula(const AFormula: TsRPNFormula);

  protected
    class function BuiltinExpressionManager: TsBuiltInExpressionManager;
    procedure ParserError(Msg: String);
    procedure SetExpression(const AValue: String); virtual;
    procedure CheckResultType(const Res: TsExpressionResult;
      AType: TsResultType); inline;
    function CurrentToken: String;
    function GetToken: TsTokenType;
    function Level1: TsExprNode;
    function Level2: TsExprNode;
    function Level3: TsExprNode;
    function Level4: TsExprNode;
    function Level5: TsExprNode;
    function Level6: TsExprNode;
    function Primitive: TsExprNode;
    function TokenType: TsTokenType;
    procedure CreateHashList;
    property Scanner: TsExpressionScanner read FScanner;
    property ExprNode: TsExprNode read FExprNode;
    property Dirty: Boolean read FDirty;

  public
    constructor Create(AWorksheet: TsWorksheet); virtual;
    destructor Destroy; override;
    function IdentifierByName(AName: ShortString): TsExprIdentifierDef; virtual;
    procedure Clear;
    function BuildStringFormula: String;
    function Evaluate: TsExpressionResult;
    procedure EvaluateExpression(var Result: TsExpressionResult);
    function ResultType: TsResultType;
    property AsFloat: TsExprFloat read GetAsFloat;
    property AsInteger: Int64 read GetAsInteger;
    property AsString: String read GetAsString;
    property AsBoolean: Boolean read GetAsBoolean;
    property AsDateTime: TDateTime read GetAsDateTime;
    // The expression to parse
    property Expression: String read FExpression write SetExpression;
    property RPNFormula: TsRPNFormula read GetRPNFormula write SetRPNFormula;
    property Identifiers: TsExprIdentifierDefs read FIdentifiers write SetIdentifiers;
    property BuiltIns: TsBuiltInExprCategories read FBuiltIns write SetBuiltIns;
    property Worksheet: TsWorksheet read FWorksheet;
  end;

  TsSpreadsheetParser = class(TsExpressionParser)
  public
    constructor Create(AWorksheet: TsWorksheet); override;
  end;


  { TsBuiltInExpressionManager }
  TsBuiltInExpressionManager = class(TComponent)
  private
    FDefs: TsExprIdentifierDefs;
    function GetCount: Integer;
    function GetI(AIndex: Integer): TsBuiltInExprIdentifierDef;
  protected
    property Defs: TsExprIdentifierDefs read FDefs;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function IndexOfIdentifier(const AName: ShortString): Integer;
    function FindIdentifier(const AName: ShortString): TsBuiltInExprIdentifierDef;
    function IdentifierByExcelCode(const AExcelCode: Integer): TsBuiltInExprIdentifierDef;
    function IdentifierByName(const AName: ShortString): TsBuiltInExprIdentifierDef;
    function AddVariable(const ACategory: TsBuiltInExprCategory; const AName: ShortString;
      AResultType: TsResultType; AValue: String): TsBuiltInExprIdentifierDef;
    function AddBooleanVariable(const ACategory: TsBuiltInExprCategory;
      const AName: ShortString; AValue: Boolean): TsBuiltInExprIdentifierDef;
    function AddIntegerVariable(const ACategory: TsBuiltInExprCategory;
      const AName: ShortString; AValue: Integer): TsBuiltInExprIdentifierDef;
    function AddFloatVariable(const ACategory: TsBuiltInExprCategory;
      const AName: ShortString; AValue: TsExprFloat): TsBuiltInExprIdentifierDef;
    function AddStringVariable(const ACategory: TsBuiltInExprCategory;
      const AName: ShortString; AValue: String): TsBuiltInExprIdentifierDef;
    function AddDateTimeVariable(const ACategory: TsBuiltInExprCategory;
      const AName: ShortString; AValue: TDateTime): TsBuiltInExprIdentifierDef;
    function AddFunction(const ACategory: TsBuiltInExprCategory;
      const AName: ShortString; const AResultType: Char; const AParamTypes: String;
      const AExcelCode: Integer; ACallBack: TsExprFunctionCallBack): TsBuiltInExprIdentifierDef;
    function AddFunction(const ACategory: TsBuiltInExprCategory;
      const AName: ShortString; const AResultType: Char; const AParamTypes: String;
      const AExcelCode: Integer; ACallBack: TsExprFunctionEvent): TsBuiltInExprIdentifierDef;
    property IdentifierCount: Integer read GetCount;
    property Identifiers[AIndex: Integer]: TsBuiltInExprIdentifierDef read GetI;
  end;

  EExprParser = class(Exception);

function TokenName(AToken: TsTokenType): String;
function ResultTypeName(AResult: TsResultType): String;
function CharToResultType(C: Char): TsResultType;
function BuiltinIdentifiers: TsBuiltInExpressionManager;
function ArgToBoolean(Arg: TsExpressionResult): Boolean;
function ArgToCell(Arg: TsExpressionResult): PCell;
function ArgToDateTime(Arg: TsExpressionResult): TDateTime;
function ArgToInt(Arg: TsExpressionResult): Integer;
function ArgToFloat(Arg: TsExpressionResult): TsExprFloat;
function ArgToString(Arg: TsExpressionResult): String;
procedure ArgsToFloatArray(const Args: TsExprParameterArray; out AData: TsExprFloatArray);
function BooleanResult(AValue: Boolean): TsExpressionResult;
function DateTimeResult(AValue: TDateTime): TsExpressionResult;
function EmptyResult: TsExpressionResult;
function ErrorResult(const AValue: TsErrorValue): TsExpressionResult;
function FloatResult(const AValue: TsExprFloat): TsExpressionResult;
function IntegerResult(const AValue: Integer): TsExpressionResult;
function StringResult(const AValue: String): TsExpressionResult;

procedure RegisterFunction(const AName: ShortString; const AResultType: Char;
  const AParamTypes: String; const AExcelCode: Integer; ACallBack: TsExprFunctionCallBack); overload;
procedure RegisterFunction(const AName: ShortString; const AResultType: Char;
  const AParamTypes: String; const AExcelCode: Integer; ACallBack: TsExprFunctionEvent); overload;

const
  AllBuiltIns = [bcMath, bcStatistics, bcStrings, bcLogical, bcDateTime, bcLookup,
    bcInfo, bcUser];

var
  ExprFormatSettings: TFormatSettings;

implementation

uses
  typinfo, math, lazutf8, dateutils, fpsutils, fpsfunc;

const
  cNull = #0;
  cDoubleQuote = '"';

  Digits         = ['0'..'9', '.'];
  WhiteSpace     = [' ', #13, #10, #9];
  Operators      = ['+', '-', '<', '>', '=', '/', '*', '&', '%', '^'];
  Delimiters     = Operators + [',', '(', ')'];
  Symbols        = Delimiters;
  WordDelimiters = WhiteSpace + Symbols;

resourcestring
  SBadQuotes = 'Unterminated string';
  SUnknownDelimiter = 'Unknown delimiter character: "%s"';
  SErrUnknownCharacter = 'Unknown character at pos %d: "%s"';
  SErrUnexpectedEndOfExpression = 'Unexpected end of expression';
  SErrUnknownComparison = 'Internal error: Unknown comparison';
  SErrUnknownBooleanOp = 'Internal error: Unknown boolean operation';
  SErrBracketExpected = 'Expected ) bracket at position %d, but got %s';
  SerrUnknownTokenAtPos = 'Unknown token at pos %d : %s';
  SErrLeftBracketExpected = 'Expected ( bracket at position %d, but got %s';
  SErrInvalidFloat = '%s is not a valid floating-point value';
  SErrUnknownIdentifier = 'Unknown identifier: %s';
  SErrInExpression = 'Cannot evaluate: error in expression';
  SErrInExpressionEmpty = 'Cannot evaluate: empty expression';
  SErrCommaExpected =  'Expected comma (,) at position %d, but got %s';
  SErrInvalidNumberChar = 'Unexpected character in number : %s';
  SErrInvalidNumber = 'Invalid numerical value : %s';
  SErrNoOperand = 'No operand for unary operation %s';
  SErrNoLeftOperand = 'No left operand for binary operation %s';
  SErrNoRightOperand = 'No left operand for binary operation %s';
  SErrNoNegation = 'Cannot negate expression of type %s: %s';
  SErrNoUPlus = 'Cannot perform unary plus operation on type %s: %s';
  SErrNoNOTOperation = 'Cannot perform NOT operation on expression of type %s: %s';
  SErrNoPercentOperation = 'Cannot perform percent operation on expression of type %s: %s';
  SErrTypesDoNotMatch = 'Type mismatch: %s<>%s for expressions "%s" and "%s".';
  SErrTypesIncompatible = 'Incompatible types: %s<>%s for expressions "%s" and "%s".';
  SErrNoNodeToCheck = 'Internal error: No node to check !';
  SInvalidNodeType = 'Node type (%s) not in allowed types (%s) for expression: %s';
  SErrUnterminatedExpression = 'Badly terminated expression. Found token at position %d : %s';
  SErrDuplicateIdentifier = 'An identifier with name "%s" already exists.';
  SErrInvalidResultCharacter = '"%s" is not a valid return type indicator';
  ErrInvalidArgumentCount = 'Invalid argument count for function %s';
  SErrInvalidArgumentType = 'Invalid type for argument %d: Expected %s, got %s';
  SErrInvalidResultType = 'Invalid result type: %s';
  SErrNotVariable = 'Identifier %s is not a variable';
  SErrInactive = 'Operation not allowed while an expression is active';
  SErrCircularReference = 'Circular reference found when calculating worksheet formulas';

{ ---------------------------------------------------------------------
  Auxiliary functions
  ---------------------------------------------------------------------}

procedure RaiseParserError(Msg: String);
begin
  raise EExprParser.Create(Msg);
end;

procedure RaiseParserError(Fmt: String; Args: Array of const);
begin
  raise EExprParser.CreateFmt(Fmt, Args);
end;

function TokenName(AToken: TsTokenType): String;
begin
  Result := GetEnumName(TypeInfo(TsTokenType), ord(AToken));
end;

function ResultTypeName(AResult: TsResultType): String;
begin
  Result := GetEnumName(TypeInfo(TsResultType), ord(AResult));
end;

function CharToResultType(C: Char): TsResultType;
begin
  case Upcase(C) of
    'S' : Result := rtString;
    'D' : Result := rtDateTime;
    'B' : Result := rtBoolean;
    'I' : Result := rtInteger;
    'F' : Result := rtFloat;
    'R' : Result := rtCellRange;
    'C' : Result := rtCell;
    '?' : Result := rtAny;
  else
    RaiseParserError(SErrInvalidResultCharacter, [C]);
  end;
end;

var
  BuiltIns: TsBuiltInExpressionManager = nil;

function BuiltinIdentifiers: TsBuiltInExpressionManager;
begin
  If (BuiltIns = nil) then
    BuiltIns := TsBuiltInExpressionManager.Create(nil);
  Result := BuiltIns;
end;

procedure FreeBuiltIns;
begin
  FreeAndNil(Builtins);
end;


{------------------------------------------------------------------------------}
{  TsExpressionScanner                                                        }
{------------------------------------------------------------------------------}

constructor TsExpressionScanner.Create;
begin
  Source := '';
end;

function TsExpressionScanner.DoDelimiter: TsTokenType;
var
  B : Boolean;
  C, D : Char;
begin
  C := FChar^;
  FToken := C;
  B := C in ['<', '>'];
  D := C;
  C := NextPos;

  if B and (C in ['=', '>']) then
  begin
    FToken := FToken + C;
    NextPos;
    If D = '>' then
      Result := ttLargerThanEqual
    else if C = '>' then
      Result := ttNotEqual
    else
      Result := ttLessThanEqual;
  end
  else
    case D of
      '+' : Result := ttPlus;
      '-' : Result := ttMinus;
      '*' : Result := ttMul;
      '/' : Result := ttDiv;
      '^' : Result := ttPower;
      '%' : Result := ttPercent;
      '&' : Result := ttConcat;
      '<' : Result := ttLessThan;
      '>' : Result := ttLargerThan;
      '=' : Result := ttEqual;
      '(' : Result := ttLeft;
      ')' : Result := ttRight;
      ',' : Result := ttComma;
    else
      ScanError(Format(SUnknownDelimiter, [D]));
    end;
end;

function TsExpressionScanner.DoIdentifier: TsTokenType;
var
  C: Char;
  S: String;
  row, row2: Cardinal;
  col, col2: Cardinal;
  flags: TsRelFlags;
begin
  C := CurrentChar;
  while (not IsWordDelim(C)) and (C <> cNull) do
  begin
    FToken := FToken + C;
    C := NextPos;
  end;
  S := LowerCase(Token);
  if ParseCellString(S, row, col, flags) and (C <> '(') then
    Result := ttCell
  else if ParseCellRangeString(S, row, col, row2, col2, flags) and (C <> '(') then
    Result := ttCellRange
  else if (S = 'true') and (C <> '(') then
    Result := ttTrue
  else if (S = 'false') and (C <> '(') then
    Result := ttFalse
  else
    Result := ttIdentifier;
end;

function TsExpressionScanner.DoNumber: TsTokenType;
var
  C: Char;
  X: TsExprFloat;
  prevC: Char;
begin
  C := CurrentChar;
  prevC := #0;
  while (not IsWordDelim(C) or (prevC = 'E')) and (C <> cNull) do
  begin
    if not ( IsDigit(C)
             or ((FToken <> '') and (Upcase(C) = 'E'))
             or ((FToken <> '') and (C in ['+', '-']) and (prevC = 'E'))
           )
    then
      ScanError(Format(SErrInvalidNumberChar, [C]));
    FToken := FToken+C;
    prevC := Upcase(C);
    C := NextPos;
  end;
  if not TryStrToFloat(FToken, X, ExprFormatSettings) then
    ScanError(Format(SErrInvalidNumber, [FToken]));
  Result := ttNumber;
end;

function TsExpressionScanner.DoString: TsTokenType;

  function TerminatingChar(C: Char): boolean;
  begin
    Result := (C = cNull)
          or ((C = cDoubleQuote) and
               not ((FPos < LSource) and (FSource[FPos+1] = cDoubleQuote)));
  end;

var
  C: Char;
begin
  FToken := '';
  C := NextPos;
  while not TerminatingChar(C) do
  begin
    FToken := FToken+C;
    if C = cDoubleQuote then
      NextPos;
    C := NextPos;
  end;
  if (C = cNull) then
    ScanError(SBadQuotes);
  Result := ttString;
  FTokenType := Result;
  NextPos;
end;

function TsExpressionScanner.GetCurrentChar: Char;
begin
  if FChar <> nil then
    Result := FChar^
  else
    Result := #0;
end;

function TsExpressionScanner.GetToken: TsTokenType;
var
  C: Char;
begin
  FToken := '';
  SkipWhiteSpace;
  C := FChar^;
  if c = cNull then
    Result := ttEOF
  else if IsDelim(C) then
    Result := DoDelimiter
  else if (C = cDoubleQuote) then
    Result := DoString
  else if IsDigit(C) then
    Result := DoNumber
  else if IsAlpha(C) or (C = '$') then
    Result := DoIdentifier
  else
    ScanError(Format(SErrUnknownCharacter, [FPos, C]));
  FTokenType := Result;
end;

function TsExpressionScanner.IsAlpha(C: Char): Boolean;
begin
  Result := C in ['A'..'Z', 'a'..'z'];
end;

function TsExpressionScanner.IsDelim(C: Char): Boolean;
begin
  Result := C in Delimiters;
end;

function TsExpressionScanner.IsDigit(C: Char): Boolean;
begin
  Result := C in Digits;
end;

function TsExpressionScanner.IsWordDelim(C: Char): Boolean;
begin
  Result := C in WordDelimiters;
end;

function TsExpressionScanner.NextPos: Char;
begin
  Inc(FPos);
  Inc(FChar);
  Result := FChar^;
end;

procedure TsExpressionScanner.ScanError(Msg: String);
begin
  raise EExprScanner.Create(Msg)
end;

procedure TsExpressionScanner.SetSource(const AValue: String);
begin
  FSource := AValue;
  LSource := Length(FSource);
  FTokenType := ttEOF;
  if LSource = 0 then
    FPos := 0
  else
    FPos := 1;
  FChar := PChar(FSource);
  FToken := '';
end;

procedure TsExpressionScanner.SkipWhiteSpace;
begin
  while (FChar^ in WhiteSpace) and (FPos <= LSource) do
    NextPos;
end;


{------------------------------------------------------------------------------}
{  TsExpressionParser                                                         }
{------------------------------------------------------------------------------}

constructor TsExpressionParser.Create(AWorksheet: TsWorksheet);
begin
  inherited Create;
  FWorksheet := AWorksheet;
  FIdentifiers := TsExprIdentifierDefs.Create(TsExprIdentifierDef);
  FIdentifiers.FParser := Self;
  FScanner := TsExpressionScanner.Create;
  FHashList := TFPHashObjectList.Create(False);
end;

destructor TsExpressionParser.Destroy;
begin
  FreeAndNil(FHashList);
  FreeAndNil(FExprNode);
  FreeAndNil(FIdentifiers);
  FreeAndNil(FScanner);
  inherited Destroy;
end;

function TsExpressionParser.BuildStringFormula: String;
begin
  if FExprNode = nil then
    Result := ''
  else
    Result := FExprNode.AsString;
end;

class function TsExpressionParser.BuiltinExpressionManager: TsBuiltInExpressionManager;
begin
  Result := BuiltinIdentifiers;
end;

procedure TsExpressionParser.CheckEOF;
begin
  if (TokenType = ttEOF) then
    ParserError(SErrUnexpectedEndOfExpression);
end;

{ If the result types differ, they are converted to a common type if possible. }
procedure TsExpressionParser.CheckNodes(var ALeft, ARight: TsExprNode);
begin
  ALeft := MatchNodes(ALeft, ARight);
  ARight := MatchNodes(ARight, ALeft);
end;

procedure TsExpressionParser.CheckResultType(const Res: TsExpressionResult;
  AType: TsResultType); inline;
begin
  if (Res.ResultType <> AType) then
    RaiseParserError(SErrInvalidResultType, [ResultTypeName(Res.ResultType)]);
end;

procedure TsExpressionParser.Clear;
begin
  FExpression := '';
  FHashList.Clear;
  FreeAndNil(FExprNode);
end;

function TsExpressionParser.ConvertNode(ToDo: TsExprNode;
  ToType: TsResultType): TsExprNode;
begin
  Result := ToDo;
  case ToDo.NodeType of
    rtInteger :
      case ToType of
        rtFloat    : Result := TsIntToFloatExprNode.Create(Result);
        rtDateTime : Result := TsIntToDateTimeExprNode.Create(Result);
      end;
    rtFloat :
      case ToType of
        rtDateTime : Result := TsFloatToDateTimeExprNode.Create(Result);
      end;
  end;
end;

procedure TsExpressionParser.CreateHashList;
var
  ID: TsExprIdentifierDef;
  BID: TsBuiltInExprIdentifierDef;
  i: Integer;
  M: TsBuiltInExpressionManager;
begin
  FHashList.Clear;
  // Builtins
  M := BuiltinExpressionManager;
  If (FBuiltins <> []) and Assigned(M) then
    for i:=0 to M.IdentifierCount-1 do
    begin
      BID := M.Identifiers[i];
      If BID.Category in FBuiltins then
        FHashList.Add(UpperCase(BID.Name), BID);
    end;
  // User
  for i:=0 to FIdentifiers.Count-1 do
  begin
    ID := FIdentifiers[i];
    FHashList.Add(UpperCase(ID.Name), ID);
  end;
  FDirty := False;
end;

function TsExpressionParser.CurrentToken: String;
begin
  Result := FScanner.Token;
end;

function TsExpressionParser.Evaluate: TsExpressionResult;
begin
  EvaluateExpression(Result);
end;

procedure TsExpressionParser.EvaluateExpression(var Result: TsExpressionResult);
begin
  if (FExpression = '') then
    ParserError(SErrInExpressionEmpty);
  if not Assigned(FExprNode) then
    ParserError(SErrInExpression);
  FExprNode.GetNodeValue(Result);
end;

function TsExpressionParser.GetAsBoolean: Boolean;
var
  Res: TsExpressionResult;
begin
  EvaluateExpression(Res);
  CheckResultType(Res, rtBoolean);
  Result := Res.ResBoolean;
end;

function TsExpressionParser.GetAsDateTime: TDateTime;
var
  Res: TsExpressionResult;
begin
  EvaluateExpression(Res);
  CheckResultType(Res, rtDateTime);
  Result := Res.ResDatetime;
end;

function TsExpressionParser.GetAsFloat: TsExprFloat;
var
  Res: TsExpressionResult;
begin
  EvaluateExpression(Res);
  CheckResultType(Res, rtFloat);
  Result := Res.ResFloat;
end;

function TsExpressionParser.GetAsInteger: Int64;
var
  Res: TsExpressionResult;
begin
  EvaluateExpression(Res);
  CheckResultType(Res, rtInteger);
  Result := Res.ResInteger;
end;

function TsExpressionParser.GetAsString: String;
var
  Res: TsExpressionResult;
begin
  EvaluateExpression(Res);
  CheckResultType(Res, rtString);
  Result := Res.ResString;
end;

function TsExpressionParser.GetRPNFormula: TsRPNFormula;
begin
  Result := CreateRPNFormula(FExprNode.AsRPNItem(nil), true);
end;

function TsExpressionParser.GetToken: TsTokenType;
begin
  Result := FScanner.GetToken;
end;

function TsExpressionParser.IdentifierByName(AName: ShortString): TsExprIdentifierDef;
var
  s: String;
begin
  if FDirty then
    CreateHashList;
  s := FHashList.NameOfIndex(0);
  s := FHashList.NameOfIndex(25);
  s := FHashList.NameOfIndex(36);
  Result := TsExprIdentifierDef(FHashList.Find(UpperCase(AName)));
end;

function TsExpressionParser.Level1: TsExprNode;
var
  tt: TsTokenType;
  Right: TsExprNode;
begin
{$ifdef debugexpr}Writeln('Level 1 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
{
  if TokenType = ttNot then
  begin
    GetToken;
    CheckEOF;
    Right := Level2;
    Result := TsNotExprNode.Create(Right);
  end
  else
  }
  Result := Level2;
   {
  try
    if TokenType = ttPower then
    begin
      tt := Tokentype;
      GetToken;
      CheckEOF;
      Right := Level2;
      Result := TsPowerExprNode.Create(Result, Right);
    end;
  except
    Result.Free;
    raise;
  end;
  }
{
  try

    while (TokenType in [ttAnd, ttOr, ttXor]) do
    begin
      tt := TokenType;
      GetToken;
      CheckEOF;
      Right := Level2;
      case tt of
        ttOr  : Result := TsBinaryOrExprNode.Create(Result, Right);
        ttAnd : Result := TsBinaryAndExprNode.Create(Result, Right);
        ttXor : Result := TsBinaryXorExprNode.Create(Result, Right);
      else
        ParserError(SErrUnknownBooleanOp)
      end;
    end;
  except
    Result.Free;
    raise;
  end;
}
end;

function TsExpressionParser.Level2: TsExprNode;
var
  right: TsExprNode;
  tt: TsTokenType;
  C: TsBinaryOperationExprNodeClass;
begin
{$ifdef debugexpr} Writeln('Level 2 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
  Result := Level3;
  try
    if (TokenType in ttComparisons) then
    begin
      tt := TokenType;
      GetToken;
      CheckEOF;
      Right := Level3;
      CheckNodes(Result, right);
      case tt of
        ttLessthan         : C := TsLessExprNode;
        ttLessthanEqual    : C := TsLessEqualExprNode;
        ttLargerThan       : C := TsGreaterExprNode;
        ttLargerThanEqual  : C := TsGreaterEqualExprNode;
        ttEqual            : C := TsEqualExprNode;
        ttNotEqual         : C := TsNotEqualExprNode;
      else
        ParserError(SErrUnknownComparison)
      end;
      Result := C.Create(Result, right);
    end;
  except
    Result.Free;
    raise;
  end;
end;

function TsExpressionParser.Level3: TsExprNode;
var
  tt: TsTokenType;
  right: TsExprNode;
begin
{$ifdef debugexpr} Writeln('Level 3 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
  Result := Level4;
  try
    while TokenType in [ttPlus, ttMinus, ttConcat] do begin
      tt := TokenType;
      GetToken;
      CheckEOF;
      right := Level4;
      CheckNodes(Result, right);
      case tt of
        ttPlus  : Result := TsAddExprNode.Create(Result, right);
        ttMinus : Result := TsSubtractExprNode.Create(Result, right);
        ttConcat: Result := TsConcatExprNode.Create(Result, right);
      end;
    end;
  except
    Result.Free;
    raise;
  end;
end;

function TsExpressionParser.Level4: TsExprNode;
var
  tt: TsTokenType;
  right: TsExprNode;
begin
{$ifdef debugexpr} Writeln('Level 4 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
  Result := Level5;
  try
    while (TokenType in [ttMul, ttDiv]) do
    begin
      tt := TokenType;
      GetToken;
      right := Level5;
      CheckNodes(Result, right);
      case tt of
        ttMul : Result := TsMultiplyExprNode.Create(Result, right);
        ttDiv : Result := TsDivideExprNode.Create(Result, right);
      end;
    end;
  except
    Result.Free;
    Raise;
  end;
end;

function TsExpressionParser.Level5: TsExprNode;
var
  isPlus, isMinus: Boolean;
  tt: TsTokenType;
begin
{$ifdef debugexpr} Writeln('Level 5 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
  isPlus := false;
  isMinus := false;
  if (TokenType in [ttPlus, ttMinus]) then
  begin
    isPlus := (TokenType = ttPlus);
    isMinus := (TokenType = ttMinus);
    GetToken;
  end;
  Result := Level6;
  if isPlus then
    Result := TsUPlusExprNode.Create(Result);
  if isMinus then
    Result := TsUMinusExprNode.Create(Result);
end;

function TsExpressionParser.Level6: TsExprNode;
var
  tt: TsTokenType;
  Right: TsExprNode;
begin
{$ifdef debugexpr} Writeln('Level 6 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
  if (TokenType = ttLeft) then
  begin
    GetToken;
    Result := TsParenthesisExprNode.Create(Level1);
    try
      if (TokenType <> ttRight) then
        ParserError(Format(SErrBracketExpected, [SCanner.Pos, CurrentToken]));
      GetToken;
    except
      Result.Free;
      raise;
    end;
  end
  else
    Result := Primitive;

  if TokenType = ttPower then
  begin
    try
      CheckEOF;
      tt := Tokentype;
      GetToken;
      Right := Primitive;
      CheckNodes(Result, right);
      Result := TsPowerExprNode.Create(Result, Right);
      //GetToken;
    except
      Result.Free;
      raise;
    end;
  end;
end;

{ Checks types of todo and match. If ToDO can be converted to it matches
  the type of match, then a node is inserted.
  For binary operations, this function is called for both operands. }
function TsExpressionParser.MatchNodes(ToDo, Match: TsExprNode): TsExprNode;
var
  TT, MT : TsResultType;
begin
  Result := ToDo;
  TT := ToDo.NodeType;
  MT := Match.NodeType;
  if TT <> MT then
  begin
    if TT = rtInteger then
    begin
      if (MT in [rtFloat, rtDateTime]) then
        Result := ConvertNode(ToDo, MT);
    end
    else if (TT = rtFloat) then
    begin
      if (MT = rtDateTime) then
        Result := ConvertNode(ToDo, rtDateTime);
    end;
  end;
end;

procedure TsExpressionParser.ParserError(Msg: String);
begin
  raise EExprParser.Create(Msg);
end;

function TsExpressionParser.Primitive: TsExprNode;
var
  I: Int64;
  X: TsExprFloat;
  lCount: Integer;
  ID: TsExprIdentifierDef;
  Args: TsExprArgumentArray;
  AI: Integer;
  cell: PCell;
  optional: Boolean;
  token: String;
begin
{$ifdef debugexpr} Writeln('Primitive : ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
  SetLength(Args, 0);
  if (TokenType = ttNumber) then
  begin
    if TryStrToInt64(CurrentToken, I) then
      Result := TsConstExprNode.CreateInteger(I)
    else
    begin
      if TryStrToFloat(CurrentToken, X, ExprFormatSettings) then
        Result := TsConstExprNode.CreateFloat(X)
      else
        ParserError(Format(SErrInvalidFloat, [CurrentToken]));
    end;
  end
  else if (TokenType = ttTrue) then
    Result := TsConstExprNode.CreateBoolean(true)
  else if (TokenType = ttFalse) then
    Result := TsConstExprNode.CreateBoolean(false)
  else if (TokenType = ttString) then
    Result := TsConstExprNode.CreateString(CurrentToken)
  else if (TokenType = ttCell) then
    Result := TsCellExprNode.Create(FWorksheet, CurrentToken)
  else if (TokenType = ttCellRange) then
    Result := TsCellRangeExprNode.Create(FWorksheet, CurrentToken)
  else if not (TokenType in [ttIdentifier{, ttIf}]) then
    ParserError(Format(SerrUnknownTokenAtPos, [Scanner.Pos, CurrentToken]))
  else
  begin
    token := Uppercase(CurrentToken);
    ID := self.IdentifierByName(token);
    if (ID = nil) then
      ParserError(Format(SErrUnknownIdentifier, [token]));
    if (ID.IdentifierType in [itFunctionCallBack, itFunctionHandler]) then
    begin
      lCount := ID.ArgumentCount;
      if lCount = 0 then  // we have to handle the () here, it will be skipped below.
      begin
        GetToken;
        if (TokenType <> ttLeft) then
          ParserError(Format(SErrLeftBracketExpected, [Scanner.Pos, CurrentToken]));
        GetToken;
        if (TokenType <> ttRight) then
          ParserError(Format(SErrBracketExpected, [Scanner.Pos, CurrentToken]));
        SetLength(Args, 0);
      end;
    end
    else
      lCount := 0;

    // Parse arguments.
    // Negative is for variable number of arguments, where Abs(value) is the minimum number of arguments
    if (lCount <> 0) then
    begin
      GetToken;
      if (TokenType <> ttLeft) then
        ParserError(Format(SErrLeftBracketExpected, [Scanner.Pos, CurrentToken]));
      SetLength(Args, abs(lCount));
      AI := 0;
      try
        repeat
          GetToken;
          // Check if we must enlarge the argument array
          if (lCount < 0) and (AI = Length(Args)) then
          begin
            SetLength(Args, AI+1);
            Args[AI] := nil;
          end;
          Args[AI] := Level1;
          inc(AI);
          optional := ID.IsOptionalArgument(AI+1);
          if not optional then
          begin
            if (TokenType <> ttComma) then
              if (AI < abs(lCount)) then
                ParserError(Format(SErrCommaExpected, [Scanner.Pos, CurrentToken]))
          end;
        until (AI = lCount) or (((lCount < 0) or optional) and (TokenType = ttRight));
        if TokenType <> ttRight then
          ParserError(Format(SErrBracketExpected, [Scanner.Pos, CurrentToken]));
        if AI < abs(lCount) then
          SetLength(Args, AI);
      except
        on E: Exception do
        begin
          dec(AI);
          while (AI >= 0) do
          begin
            FreeAndNil(Args[Ai]);
            dec(AI);
          end;
          raise;
        end;
      end;
    end;
    case ID.IdentifierType of
      itVariable         : Result := TsVariableExprNode.CreateIdentifier(ID);
      itFunctionCallBack : Result := TsFunctionCallBackExprNode.CreateFunction(ID, Args);
      itFunctionHandler  : Result := TFPFunctionEventHandlerExprNode.CreateFunction(ID, Args);
    end;
  end;
  GetToken;
  if TokenType = ttPercent then begin
    Result := TsPercentExprNode.Create(Result);
    GetToken;
  end;
end;

function TsExpressionParser.ResultType: TsResultType;
begin
  if not Assigned(FExprNode) then
    ParserError(SErrInExpression);
  Result := FExprNode.NodeType;;
end;

procedure TsExpressionParser.SetBuiltIns(const AValue: TsBuiltInExprCategories);
begin
  if FBuiltIns = AValue then
    exit;
  FBuiltIns := AValue;
  FDirty := true;
end;

procedure TsExpressionParser.SetExpression(const AValue: String);
begin
  if FExpression = AValue then
    exit;
  FExpression := AValue;
  if (AValue <> '') and (AValue[1] = '=') then
    FScanner.Source := Copy(AValue, 2, Length(AValue))
  else
    FScanner.Source := AValue;
  FreeAndNil(FExprNode);
  if (FExpression <> '') then
  begin
    GetToken;
    FExprNode := Level1;
    if (TokenType <> ttEOF) then
      ParserError(Format(SErrUnterminatedExpression, [Scanner.Pos, CurrentToken]));
    FExprNode.Check;
  end;
end;

procedure TsExpressionParser.SetIdentifiers(const AValue: TsExprIdentifierDefs);
begin
  FIdentifiers.Assign(AValue)
end;

procedure TsExpressionParser.SetRPNFormula(const AFormula: TsRPNFormula);

  procedure CreateNodeFromRPN(var ANode: TsExprNode; var AIndex: Integer);
  var
    node: TsExprNode;
    left: TsExprNode;
    right: TsExprNode;
    operand: TsExprNode;
    fek: TFEKind;
    r,c, r2,c2: Cardinal;
    flags: TsRelFlags;
    ID: TsExprIdentifierDef;
    i, n: Integer;
    args: TsExprArgumentArray;
  begin
    if AIndex < 0 then
      exit;

    fek := AFormula[AIndex].ElementKind;

    case fek of
      fekCell, fekCellRef:
        begin
          r := AFormula[AIndex].Row;
          c := AFormula[AIndex].Col;
          flags := AFormula[AIndex].RelFlags;
          ANode := TsCellExprNode.Create(FWorksheet, r, c, flags);
          dec(AIndex);
        end;
      fekCellRange:
        begin
          r := AFormula[AIndex].Row;
          c := AFormula[AIndex].Col;
          r2 := AFormula[AIndex].Row2;
          c2 := AFormula[AIndex].Col2;
          flags := AFormula[AIndex].RelFlags;
          ANode := TsCellRangeExprNode.Create(FWorksheet, r, c, r2, c2, flags);
          dec(AIndex);
        end;
      fekNum:
        begin
          ANode := TsConstExprNode.CreateFloat(AFormula[AIndex].DoubleValue);
          dec(AIndex);
        end;
      fekInteger:
        begin
          ANode := TsConstExprNode.CreateInteger(AFormula[AIndex].IntValue);
          dec(AIndex);
        end;
      fekString:
        begin
          ANode := TsConstExprNode.CreateString(AFormula[AIndex].StringValue);
          dec(AIndex);
        end;
      fekBool:
        begin
          ANode := TsConstExprNode.CreateBoolean(AFormula[AIndex].DoubleValue <> 0.0);
          dec(AIndex);
        end;
      fekErr:
        begin
          ANode := TsConstExprNode.CreateError(TsErrorValue(AFormula[AIndex].IntValue));
          dec(AIndex);
        end;

      // unary operations
      fekPercent, fekUMinus, fekUPlus, fekParen:
        begin
          dec(AIndex);
          CreateNodeFromRPN(operand, AIndex);
          case fek of
            fekPercent : ANode := TsPercentExprNode.Create(operand);
            fekUMinus  : ANode := TsUMinusExprNode.Create(operand);
            fekUPlus   : ANode := TsUPlusExprNode.Create(operand);
            fekParen   : ANode := TsParenthesisExprNode.Create(operand);
          end;
        end;

      // binary operations
      fekAdd, fekSub, fekMul, fekDiv,
      fekPower, fekConcat,
      fekEqual, fekNotEqual,
      fekGreater, fekGreaterEqual,
      fekLess, fekLessEqual:
        begin
          dec(AIndex);
          CreateNodeFromRPN(right, AIndex);
          CreateNodeFromRPN(left, AIndex);
          CheckNodes(left, right);
          case fek of
            fekAdd         : ANode := TsAddExprNode.Create(left, right);
            fekSub         : ANode := TsSubtractExprNode.Create(left, right);
            fekMul         : ANode := TsMultiplyExprNode.Create(left, right);
            fekDiv         : ANode := TsDivideExprNode.Create(left, right);
            fekPower       : ANode := TsPowerExprNode.Create(left, right);
            fekConcat      : ANode := tsConcatExprNode.Create(left, right);
            fekEqual       : ANode := TsEqualExprNode.Create(left, right);
            fekNotEqual    : ANode := TsNotEqualExprNode.Create(left, right);
            fekGreater     : ANode := TsGreaterExprNode.Create(left, right);
            fekGreaterEqual: ANode := TsGreaterEqualExprNode.Create(left, right);
            fekLess        : ANode := TsLessExprNode.Create(left, right);
            fekLessEqual   : ANode := tsLessEqualExprNode.Create(left, right);
          end;
        end;

      // functions
      fekFunc:
        begin
          ID := self.IdentifierByName(AFormula[AIndex].FuncName);
          if ID = nil then
          begin
            ParserError(Format(SErrUnknownIdentifier,[AFormula[AIndex].FuncName]));
            dec(AIndex);
          end else
          begin
            if ID.HasFixedArgumentCount then
              n := ID.ArgumentCount
            else
              n := AFormula[AIndex].ParamsNum;
            dec(AIndex);
            SetLength(args, n);
            for i:=n-1 downto 0 do
              CreateNodeFromRPN(args[i], AIndex);
            case ID.IdentifierType of
              itVariable         : ANode := TsVariableExprNode.CreateIdentifier(ID);
              itFunctionCallBack : ANode := TsFunctionCallBackExprNode.CreateFunction(ID, args);
              itFunctionHandler  : ANode := TFPFunctionEventHandlerExprNode.CreateFunction(ID, args);
            end;
          end;
        end;

    end;  //case
  end; //begin

var
  index: Integer;
  node: TsExprNode;
begin
  FExpression := '';
  FreeAndNil(FExprNode);
  index := Length(AFormula)-1;
  CreateNodeFromRPN(FExprNode, index);
  if Assigned(FExprNode) then FExprNode.Check;
end;

function TsExpressionParser.TokenType: TsTokenType;
begin
  Result := FScanner.TokenType;
end;


{------------------------------------------------------------------------------}
{  TsSpreadsheetParser                                                         }
{------------------------------------------------------------------------------}

constructor TsSpreadsheetParser.Create(AWorksheet: TsWorksheet);
begin
  inherited Create(AWorksheet);
  BuiltIns := AllBuiltIns;
end;


{------------------------------------------------------------------------------}
{  TsExprIdentifierDefs                                                        }
{------------------------------------------------------------------------------}

function TsExprIdentifierDefs.AddBooleanVariable(const AName: ShortString;
  AValue: Boolean): TsExprIdentifierDef;
begin
  Result := Add as TsExprIdentifierDef;
  Result.IdentifierType := itVariable;
  Result.Name := AName;
  Result.ResultType := rtBoolean;
  Result.FValue.ResBoolean := AValue;
end;

function TsExprIdentifierDefs.AddDateTimeVariable(const AName: ShortString;
  AValue: TDateTime): TsExprIdentifierDef;
begin
  Result := Add as TsExprIdentifierDef;
  Result.IdentifierType := itVariable;
  Result.Name := AName;
  Result.ResultType := rtDateTime;
  Result.FValue.ResDateTime := AValue;
end;

function TsExprIdentifierDefs.AddFloatVariable(const AName: ShortString;
  AValue: TsExprFloat): TsExprIdentifierDef;
begin
  Result := Add as TsExprIdentifierDef;
  Result.IdentifierType := itVariable;
  Result.Name := AName;
  Result.ResultType := rtFloat;
  Result.FValue.ResFloat := AValue;
end;

function TsExprIdentifierDefs.AddFunction(const AName: ShortString;
  const AResultType: Char; const AParamTypes: String; const AExcelCode: Integer;
  ACallBack: TsExprFunctionCallBack): TsExprIdentifierDef;
begin
  Result := Add as TsExprIdentifierDef;
  Result.Name := AName;
  Result.IdentifierType := itFunctionCallBack;
  Result.ResultType := CharToResultType(AResultType);
  Result.ExcelCode := AExcelCode;
  Result.FOnGetValueCB := ACallBack;
  if (Length(AParamTypes) > 0) and (AParamTypes[Length(AParamTypes)]='+') then
  begin
    Result.ParameterTypes := Copy(AParamTypes, 1, Length(AParamTypes)-1);
    Result.VariableArgumentCount := true;
  end else
    Result.ParameterTypes := AParamTypes;
end;

function TsExprIdentifierDefs.AddFunction(const AName: ShortString;
  const AResultType: Char; const AParamTypes: String; const AExcelCode: Integer;
  ACallBack: TsExprFunctionEvent): TsExprIdentifierDef;
begin
  Result := Add as TsExprIdentifierDef;
  Result.Name := AName;
  Result.IdentifierType := itFunctionHandler;
  Result.ResultType := CharToResultType(AResultType);
  Result.ExcelCode := AExcelCode;
  Result.FOnGetValue := ACallBack;
  if (Length(AParamTypes) > 0) and (AParamTypes[Length(AParamTypes)]='+') then
  begin
    Result.ParameterTypes := Copy(AParamTypes, 1, Length(AParamTypes)-1);
    Result.VariableArgumentCount := true;
  end else
    Result.ParameterTypes := AParamTypes;
end;

function TsExprIdentifierDefs.AddIntegerVariable(const AName: ShortString;
  AValue: Integer): TsExprIdentifierDef;
begin
  Result := Add as TsExprIdentifierDef;
  Result.IdentifierType := itVariable;
  Result.Name := AName;
  Result.ResultType := rtInteger;
  Result.FValue.ResInteger := AValue;
end;

function TsExprIdentifierDefs.AddStringVariable(const AName: ShortString;
  AValue: String): TsExprIdentifierDef;
begin
  Result := Add as TsExprIdentifierDef;
  Result.IdentifierType := itVariable;
  Result.Name := AName;
  Result.ResultType := rtString;
  Result.FValue.ResString := AValue;
end;

function TsExprIdentifierDefs.AddVariable(const AName: ShortString;
  AResultType: TsResultType; AValue: String): TsExprIdentifierDef;
begin
  Result := Add as TsExprIdentifierDef;
  Result.IdentifierType := itVariable;
  Result.Name := AName;
  Result.ResultType := AResultType;
  Result.Value := AValue;
end;

function TsExprIdentifierDefs.FindIdentifier(const AName: ShortString
  ): TsExprIdentifierDef;
var
  I: Integer;
begin
  I := IndexOfIdentifier(AName);
  if (I = -1) then
    Result := nil
  else
    Result := GetI(I);
end;

function TsExprIdentifierDefs.GetI(AIndex : Integer): TsExprIdentifierDef;
begin
  Result := TsExprIdentifierDef(Items[AIndex]);
end;

function TsExprIdentifierDefs.IdentifierByExcelCode(const AExcelCode: Integer
  ): TsExprIdentifierDef;
var
  I: Integer;
begin
  I := IndexOfIdentifier(AExcelCode);
  if I = -1 then
    Result := nil
  else
    Result := GetI(I);
end;

function TsExprIdentifierDefs.IdentifierByName(const AName: ShortString
  ): TsExprIdentifierDef;
begin
  Result := FindIdentifier(AName);
  if (Result = nil) then
    RaiseParserError(SErrUnknownIdentifier, [AName]);
end;

function TsExprIdentifierDefs.IndexOfIdentifier(const AName: ShortString): Integer;
begin
  Result := Count-1;
  while (Result >= 0) and (CompareText(GetI(Result).Name, AName) <> 0) do
    dec(Result);
end;

function TsExprIdentifierDefs.IndexOfIdentifier(const AExcelCode: Integer): Integer;
var
  ID: TsExprIdentifierDef;
begin
  Result := Count-1;
  while (Result >= 0) do begin
    ID := GetI(Result);
    if ID.ExcelCode = AExcelCode then exit;
    dec(Result);
  end;
  {
  while (Result >= 0) and (GetI(Result).ExcelCode = AExcelCode) do
    dec(Result);
    }
end;

procedure TsExprIdentifierDefs.SetI(AIndex: Integer;
  const AValue: TsExprIdentifierDef);
begin
  Items[AIndex] := AValue;
end;

procedure TsExprIdentifierDefs.Update(Item: TCollectionItem);
begin
  if Assigned(FParser) then
    FParser.FDirty := true;
end;


{------------------------------------------------------------------------------}
{  TsExprIdentifierDef                                                        }
{------------------------------------------------------------------------------}

function TsExprIdentifierDef.ArgumentCount: Integer;
begin
  if FVariableArgumentCount then
    Result := -Length(FArgumentTypes)
  else
    Result := Length(FArgumentTypes);
end;

procedure TsExprIdentifierDef.Assign(Source: TPersistent);
var
  EID: TsExprIdentifierDef;
begin
  if (Source is TsExprIdentifierDef) then
  begin
    EID := Source as TsExprIdentifierDef;
    FStringValue := EID.FStringValue;
    FValue := EID.FValue;
    FArgumentTypes := EID.FArgumentTypes;
    FVariableArgumentCount := EID.FVariableArgumentCount;
    FExcelCode := EID.ExcelCode;
    FIDType := EID.FIDType;
    FName := EID.FName;
    FOnGetValue := EID.FOnGetValue;
    FOnGetValueCB := EID.FOnGetValueCB;
  end
  else
    inherited Assign(Source);
end;

procedure TsExprIdentifierDef.CheckResultType(const AType: TsResultType);
begin
  if (FValue.ResultType <> AType) then
    RaiseParserError(SErrInvalidResultType, [ResultTypeName(AType)])
end;

procedure TsExprIdentifierDef.CheckVariable;
begin
  if Identifiertype <> itVariable then
    RaiseParserError(SErrNotVariable, [Name]);
end;

function TsExprIdentifierDef.GetAsBoolean: Boolean;
begin
  CheckResultType(rtBoolean);
  CheckVariable;
  Result := FValue.ResBoolean;
end;

function TsExprIdentifierDef.GetAsDateTime: TDateTime;
begin
  CheckResultType(rtDateTime);
  CheckVariable;
  Result := FValue.ResDateTime;
end;

function TsExprIdentifierDef.GetAsFloat: TsExprFloat;
begin
  CheckResultType(rtFloat);
  CheckVariable;
  Result := FValue.ResFloat;
end;

function TsExprIdentifierDef.GetAsInteger: Int64;
begin
  CheckResultType(rtInteger);
  CheckVariable;
  Result := FValue.ResInteger;
end;

function TsExprIdentifierDef.GetAsString: String;
begin
  CheckResultType(rtString);
  CheckVariable;
  Result := FValue.ResString;
end;

function TsExprIdentifierDef.GetResultType: TsResultType;
begin
  Result := FValue.ResultType;
end;

function TsExprIdentifierDef.GetValue: String;
begin
  case FValue.ResultType of
    rtBoolean  : if FValue.ResBoolean then
                   Result := 'True'
                 else
                   Result := 'False';
    rtInteger  : Result := IntToStr(FValue.ResInteger);
    rtFloat    : Result := FloatToStr(FValue.ResFloat, ExprFormatSettings);
    rtDateTime : Result := FormatDateTime('cccc', FValue.ResDateTime);
    rtString   : Result := FValue.ResString;
  end;
end;

{ Returns true if the epxression has a fixed number of arguments. }
function TsExprIdentifierDef.HasFixedArgumentCount: Boolean;
var
  i: Integer;
begin
  if FVariableArgumentCount then
    Result := false
  else
  begin
    for i:= 1 to Length(FArgumentTypes) do
      if IsOptionalArgument(i) then
      begin
        Result := false;
        exit;
      end;
    Result := true;
  end;
end;

{ Checks whether an argument is optional. Index number starts at 1.
  Optional arguments are lower-case characters in the argument list. }
function TsExprIdentifierDef.IsOptionalArgument(AIndex: Integer): Boolean;
begin
  Result := (AIndex <= Length(FArgumentTypes))
    and (UpCase(FArgumentTypes[AIndex]) <> FArgumentTypes[AIndex]);
end;

procedure TsExprIdentifierDef.SetArgumentTypes(const AValue: String);
var
  i: integer;
begin
  if FArgumentTypes = AValue then
    exit;
  for i:=1 to Length(AValue) do
    CharToResultType(AValue[i]);
  FArgumentTypes := AValue;
end;

procedure TsExprIdentifierDef.SetAsBoolean(const AValue: Boolean);
begin
  CheckVariable;
  CheckResultType(rtBoolean);
  FValue.ResBoolean := AValue;
end;

procedure TsExprIdentifierDef.SetAsDateTime(const AValue: TDateTime);
begin
  CheckVariable;
  CheckResultType(rtDateTime);
  FValue.ResDateTime := AValue;
end;

procedure TsExprIdentifierDef.SetAsFloat(const AValue: TsExprFloat);
begin
  CheckVariable;
  CheckResultType(rtFloat);
  FValue.ResFloat := AValue;
end;

procedure TsExprIdentifierDef.SetAsInteger(const AValue: Int64);
begin
  CheckVariable;
  CheckResultType(rtInteger);
  FValue.ResInteger := AValue;
end;

procedure TsExprIdentifierDef.SetAsString(const AValue: String);
begin
  CheckVariable;
  CheckResultType(rtString);
  FValue.resString := AValue;
end;

procedure TsExprIdentifierDef.SetName(const AValue: ShortString);
begin
  if FName = AValue then
    exit;
  if (AValue <> '') then
    if Assigned(Collection) and (TsExprIdentifierDefs(Collection).IndexOfIdentifier(AValue) <> -1) then
      RaiseParserError(SErrDuplicateIdentifier,[AValue]);
  FName := AValue;
end;

procedure TsExprIdentifierDef.SetResultType(const AValue: TsResultType);
begin
  if AValue <> FValue.ResultType then
  begin
    FValue.ResultType := AValue;
    SetValue(FStringValue);
  end;
end;

procedure TsExprIdentifierDef.SetValue(const AValue: String);
begin
  FStringValue := AValue;
  if (AValue <> '') then
    case FValue.ResultType of
      rtBoolean  : FValue.ResBoolean := FStringValue='True';
      rtInteger  : FValue.ResInteger := StrToInt(AValue);
      rtFloat    : FValue.ResFloat := StrToFloat(AValue);
      rtDateTime : FValue.ResDateTime := StrToDateTime(AValue);
      rtString   : FValue.ResString := AValue;
    end
  else
    case FValue.ResultType of
      rtBoolean  : FValue.ResBoolean := false;
      rtInteger  : FValue.ResInteger := 0;
      rtFloat    : FValue.ResFloat := 0.0;
      rtDateTime : FValue.ResDateTime := 0;
      rtString   : FValue.ResString := '';
    end
end;


{------------------------------------------------------------------------------}
{  TsBuiltInExpressionManager                                                         }
{------------------------------------------------------------------------------}

constructor TsBuiltInExpressionManager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDefs := TsExprIdentifierDefs.Create(TsBuiltInExprIdentifierDef)
end;

destructor TsBuiltInExpressionManager.Destroy;
begin
  FreeAndNil(FDefs);
  inherited Destroy;
end;

function TsBuiltInExpressionManager.AddVariable(const ACategory: TsBuiltInExprCategory;
  const AName: ShortString; AResultType: TsResultType; AValue: String
  ): TsBuiltInExprIdentifierDef;
begin
  Result := TsBuiltInExprIdentifierDef(FDefs.Addvariable(AName, AResultType, AValue));
  Result.Category := ACategory;
end;

function TsBuiltInExpressionManager.AddBooleanVariable(
  const ACategory: TsBuiltInExprCategory; const AName: ShortString; AValue: Boolean
  ): TsBuiltInExprIdentifierDef;
begin
  Result := TsBuiltInExprIdentifierDef(FDefs.AddBooleanvariable(AName, AValue));
  Result.Category := ACategory;
end;

function TsBuiltInExpressionManager.AddDateTimeVariable(
  const ACategory: TsBuiltInExprCategory; const AName: ShortString; AValue: TDateTime
  ): TsBuiltInExprIdentifierDef;
begin
  Result := TsBuiltInExprIdentifierDef(FDefs.AddDateTimeVariable(AName, AValue));
  Result.Category := ACategory;
end;

function TsBuiltInExpressionManager.AddFloatVariable(
  const ACategory: TsBuiltInExprCategory; const AName: ShortString;
  AValue: TsExprFloat): TsBuiltInExprIdentifierDef;
begin
  Result := TsBuiltInExprIdentifierDef(FDefs.AddFloatVariable(AName, AValue));
  Result.Category := ACategory;
end;

function TsBuiltInExpressionManager.AddFunction(const ACategory: TsBuiltInExprCategory;
  const AName: ShortString; const AResultType: Char; const AParamTypes: String;
  const AExcelCode: Integer; ACallBack: TsExprFunctionCallBack): TsBuiltInExprIdentifierDef;
begin
  Result := TsBuiltInExprIdentifierDef(FDefs.AddFunction(AName, AResultType,
    AParamTypes, AExcelCode, ACallBack));
  Result.Category := ACategory;
end;

function TsBuiltInExpressionManager.AddFunction(const ACategory: TsBuiltInExprCategory;
  const AName: ShortString; const AResultType: Char; const AParamTypes: String;
  const AExcelCode: Integer; ACallBack: TsExprFunctionEvent): TsBuiltInExprIdentifierDef;
begin
  Result := TsBuiltInExprIdentifierDef(FDefs.AddFunction(AName, AResultType,
    AParamTypes, AExcelCode, ACallBack));
  Result.Category := ACategory;
end;

function TsBuiltInExpressionManager.AddIntegerVariable(
  const ACategory: TsBuiltInExprCategory; const AName: ShortString; AValue: Integer
  ): TsBuiltInExprIdentifierDef;
begin
  Result := TsBuiltInExprIdentifierDef(FDefs.AddIntegerVariable(AName, AValue));
  Result.Category := ACategory;
end;

function TsBuiltInExpressionManager.AddStringVariable(
  const ACategory: TsBuiltInExprCategory; const AName: ShortString; AValue: String
  ): TsBuiltInExprIdentifierDef;
begin
  Result := TsBuiltInExprIdentifierDef(FDefs.AddStringVariable(AName, AValue));
  Result.Category := ACategory;
end;

function TsBuiltInExpressionManager.FindIdentifier(const AName: ShortString
  ): TsBuiltInExprIdentifierDef;
begin
  Result := TsBuiltInExprIdentifierDef(FDefs.FindIdentifier(AName));
end;

function TsBuiltInExpressionManager.GetCount: Integer;
begin
  Result := FDefs.Count;
end;

function TsBuiltInExpressionManager.GetI(AIndex: Integer): TsBuiltInExprIdentifierDef;
begin
  Result := TsBuiltInExprIdentifierDef(FDefs[Aindex])
end;

function TsBuiltInExpressionManager.IdentifierByExcelCode(const AExcelCode: Integer
  ): TsBuiltInExprIdentifierDef;
begin
  Result := TsBuiltInExprIdentifierDef(FDefs.IdentifierByExcelCode(AExcelCode));
end;

function TsBuiltInExpressionManager.IdentifierByName(const AName: ShortString
  ): TsBuiltInExprIdentifierDef;
begin
  Result := TsBuiltInExprIdentifierDef(FDefs.IdentifierByName(AName));
end;

function TsBuiltInExpressionManager.IndexOfIdentifier(const AName: ShortString): Integer;
begin
  Result := FDefs.IndexOfIdentifier(AName);
end;


{------------------------------------------------------------------------------}
{  Various Nodes                                                               }
{------------------------------------------------------------------------------}

{ TsExprNode }

procedure TsExprNode.CheckNodeType(ANode: TsExprNode; Allowed: TsResultTypes);
var
  S: String;
  A: TsResultType;
begin
  if (ANode = nil) then
    RaiseParserError(SErrNoNodeToCheck);
  if not (ANode.NodeType in Allowed) then
  begin
    S := '';
    for A := Low(TsResultType) to High(TsResultType) do
      if A in Allowed then
      begin
        if S <> '' then
          S := S + ',';
        S := S + ResultTypeName(A);
      end;
    RaiseParserError(SInvalidNodeType, [ResultTypeName(ANode.NodeType), S, ANode.AsString]);
  end;
end;

function TsExprNode.NodeValue: TsExpressionResult;
begin
  GetNodeValue(Result);
end;


{ TsUnaryOperationExprNode }

constructor TsUnaryOperationExprNode.Create(AOperand: TsExprNode);
begin
  FOperand := AOperand;
end;

destructor TsUnaryOperationExprNode.Destroy;
begin
  FreeAndNil(FOperand);
  inherited Destroy;
end;

procedure TsUnaryOperationExprNode.Check;
begin
  if not Assigned(Operand) then
    RaiseParserError(SErrNoOperand, [Self.ClassName]);
end;


{ TsBinaryOperationExprNode }

constructor TsBinaryOperationExprNode.Create(ALeft, ARight: TsExprNode);
begin
  FLeft := ALeft;
  FRight := ARight;
end;

destructor TsBinaryOperationExprNode.Destroy;
begin
  FreeAndNil(FLeft);
  FreeAndNil(FRight);
  inherited Destroy;
end;

procedure TsBinaryOperationExprNode.Check;
begin
  if not Assigned(Left) then
    RaiseParserError(SErrNoLeftOperand,[classname]);
  if not Assigned(Right) then
    RaiseParserError(SErrNoRightOperand,[classname]);
end;

procedure TsBinaryOperationExprNode.CheckSameNodeTypes;
var
  LT, RT: TsResultType;
begin
  LT := Left.NodeType;
  RT := Right.NodeType;
  if (RT <> LT) then
    RaiseParserError(SErrTypesDoNotMatch, [ResultTypeName(LT), ResultTypeName(RT), Left.AsString, Right.AsString])
end;


{ TsBooleanOperationExprNode }

procedure TsBooleanOperationExprNode.Check;
begin
  inherited Check;
  CheckNodeType(Left,  [rtBoolean, rtCell, rtError, rtEmpty]);
  CheckNodeType(Right, [rtBoolean, rtCell, rtError, rtEmpty]);
  CheckSameNodeTypes;
end;

function TsBooleanOperationExprNode.NodeType: TsResultType;
begin
  Result := Left.NodeType;
end;


{ TsConstExprNode }

constructor TsConstExprNode.CreateString(AValue: String);
begin
  FValue.ResultType := rtString;
  FValue.ResString := AValue;
end;

constructor TsConstExprNode.CreateInteger(AValue: Int64);
begin
  FValue.ResultType := rtInteger;
  FValue.ResInteger := AValue;
end;

constructor TsConstExprNode.CreateDateTime(AValue: TDateTime);
begin
  FValue.ResultType := rtDateTime;
  FValue.ResDateTime := AValue;
end;

constructor TsConstExprNode.CreateFloat(AValue: TsExprFloat);
begin
  Inherited Create;
  FValue.ResultType := rtFloat;
  FValue.ResFloat := AValue;
end;

constructor TsConstExprNode.CreateBoolean(AValue: Boolean);
begin
  FValue.ResultType := rtBoolean;
  FValue.ResBoolean := AValue;
end;

constructor TsConstExprNode.CreateError(AValue: TsErrorValue);
begin
  FValue.ResultType := rtError;
  FValue.ResError := AValue;
end;

procedure TsConstExprNode.Check;
begin
  // Nothing to check;
end;

function TsConstExprNode.NodeType: TsResultType;
begin
  Result := FValue.ResultType;
end;

procedure TsConstExprNode.GetNodeValue(var Result: TsExpressionResult);
begin
  Result := FValue;
end;

function TsConstExprNode.AsString: string;
begin
  case NodeType of
    rtString   : Result := cDoubleQuote + FValue.ResString + cDoubleQuote;
    rtInteger  : Result := IntToStr(FValue.ResInteger);
    rtDateTime : Result := '''' + FormatDateTime('cccc', FValue.ResDateTime) + '''';    // Probably wrong !!!
    rtBoolean  : if FValue.ResBoolean then Result := 'TRUE' else Result := 'FALSE';
    rtFloat    : Result := FloatToStr(FValue.ResFloat, ExprFormatSettings);
  end;
end;

function TsConstExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  case NodeType of
    rtString   : Result := RPNString(FValue.ResString, ANext);
    rtInteger  : Result := RPNInteger(FValue.ResInteger, ANext);
    rtDateTime : Result := RPNNumber(FValue.ResDateTime, ANext);
    rtBoolean  : Result := RPNBool(FValue.ResBoolean, ANext);
    rtFloat    : Result := RPNNumber(FValue.ResFloat, ANext);
  end;
end;


{ TsUPlusExprNode }

function TsUPlusExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc(fekUPlus,
    Operand.AsRPNItem(
    ANext
  ));
end;

function TsUPlusExprNode.AsString: String;
begin
  Result := '+' + TrimLeft(Operand.AsString);
end;

procedure TsUPlusExprNode.Check;
const
  AllowedTokens = [rtInteger, rtFloat, rtCell, rtEmpty, rtError];
begin
  inherited;
  if not (Operand.NodeType in AllowedTokens) then
    RaiseParserError(SErrNoUPlus, [ResultTypeName(Operand.NodeType), Operand.AsString])
end;

procedure TsUPlusExprNode.GetNodeValue(var Result: TsExpressionResult);
var
  res: TsExpressionresult;
  cell: PCell;
begin
  Operand.GetNodeValue(Result);
  case Result.ResultType of
    rtInteger, rtFloat, rtError:
      exit;
    rtCell:
      begin
        cell := ArgToCell(Result);
        if cell = nil then
          Result := FloatResult(0.0)
        else
        if cell^.ContentType = cctNumber then
        begin
          if frac(cell^.NumberValue) = 0.0 then
            Result := IntegerResult(trunc(cell^.NumberValue))
          else
            Result := FloatResult(cell^.NumberValue);
        end;
      end;
    rtEmpty:
      Result := FloatResult(0.0);
    else
      Result := ErrorResult(errWrongType);
  end;
end;

function TsUPlusExprNode.NodeType: TsResultType;
begin
  Result := Operand.NodeType;
end;


{ TsUMinusExprNode }

function TsUMinusExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc(fekUMinus,
    Operand.AsRPNItem(
    ANext
  ));
end;

function TsUMinusExprNode.AsString: String;
begin
  Result := '-' + TrimLeft(Operand.AsString);
end;

procedure TsUMinusExprNode.Check;
const
  AllowedTokens = [rtInteger, rtFloat, rtCell, rtEmpty, rtError];
begin
  inherited;
  if not (Operand.NodeType in AllowedTokens) then
    RaiseParserError(SErrNoNegation, [ResultTypeName(Operand.NodeType), Operand.AsString])
end;

procedure TsUMinusExprNode.GetNodeValue(var Result: TsExpressionResult);
var
  cell: PCell;
begin
  Operand.GetNodeValue(Result);
  case Result.ResultType of
    rtError:
      exit;
    rtFloat:
      Result := FloatResult(-Result.ResFloat);
    rtInteger:
      Result := IntegerResult(-Result.ResInteger);
    rtCell:
      begin
        cell := ArgToCell(Result);
        if (cell <> nil) and (cell^.ContentType = cctNumber) then
        begin
          if frac(cell^.NumberValue) = 0.0 then
            Result := IntegerResult(-trunc(cell^.NumberValue))
          else
            Result := FloatResult(cell^.NumberValue);
        end else
          Result := FloatResult(0.0);
      end;
    rtEmpty:
      Result := FloatResult(0.0);
    else
      Result := ErrorResult(errWrongType);
  end;
end;

function TsUMinusExprNode.NodeType: TsResultType;
begin
  Result := Operand.NodeType;
end;


{ TsPercentExprNode }

function TsPercentExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc(fekPercent,
    Operand.AsRPNItem(
    ANext
  ));
end;

function TsPercentExprNode.AsString: String;
begin
  Result := Operand.AsString + '%';
end;

procedure TsPercentExprNode.Check;
const
  AllowedTokens = [rtInteger, rtFloat, rtCell, rtEmpty, rtError];
begin
  inherited;
  if not (Operand.NodeType in AllowedTokens) then
    RaiseParserError(SErrNoPercentOperation, [ResultTypeName(Operand.NodeType), Operand.AsString])
end;

procedure TsPercentExprNode.GetNodeValue(var Result: TsExpressionResult);
begin
  Operand.GetNodeValue(Result);
  case Result.ResultType of
    rtError:
      exit;
    rtFloat, rtInteger, rtCell:
      Result := FloatResult(ArgToFloat(Result)*0.01);
    else
      Result := ErrorResult(errWrongType);
  end;
end;

function TsPercentExprNode.NodeType: TsResultType;
begin
  Result := rtFloat;
end;


{ TsParenthesisExprNode }

function TsParenthesisExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc(fekParen,
    Operand.AsRPNItem(
    ANext
  ));
end;

function TsParenthesisExprNode.AsString: String;
begin
  Result := '(' + Operand.AsString + ')';
end;

function TsParenthesisExprNode.NodeType: TsResultType;
begin
  Result := Operand.NodeType;
end;

procedure TsParenthesisExprNode.GetNodeValue(var Result: TsExpressionResult);
begin
  Result := Operand.NodeValue;
end;


{ TsNotExprNode }

function TsNotExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc('NOT',
    Operand.AsRPNItem(
    ANext
  ));
end;

function TsNotExprNode.AsString: String;
begin
  Result := 'not ' + Operand.AsString;
end;

procedure TsNotExprNode.Check;
const
  AllowedTokens = [rtBoolean, rtEmpty, rtError];
begin
  if not (Operand.NodeType in AllowedTokens) then
    RaiseParserError(SErrNoNotOperation, [ResultTypeName(Operand.NodeType), Operand.AsString])
end;

procedure TsNotExprNode.GetNodeValue(var Result: TsExpressionResult);
begin
  Operand.GetNodeValue(Result);
  case Result.ResultType of
    rtBoolean : Result.ResBoolean := not Result.ResBoolean;
    rtEmpty   : Result := BooleanResult(true);
  end
end;

function TsNotExprNode.NodeType: TsResultType;
begin
  Result := Operand.NodeType;
end;


{ TsBooleanResultExprNode }

procedure TsBooleanResultExprNode.Check;
begin
  inherited Check;
  CheckSameNodeTypes;
end;

procedure TsBooleanResultExprNode.CheckSameNodeTypes;
begin
  // Same node types are checked in GetNodevalue
end;

function TsBooleanResultExprNode.NodeType: TsResultType;
begin
  Result := rtBoolean;
end;


{ TsEqualExprNode }

function TsEqualExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc(fekEqual,
    Right.AsRPNItem(
    Left.AsRPNItem(
    ANext
  )));
end;

function TsEqualExprNode.AsString: string;
begin
  Result := Left.AsString + '=' + Right.AsString;
end;

procedure TsEqualExprNode.GetNodeValue(var Result: TsExpressionResult);
var
  RRes: TsExpressionResult;
begin
  Left.GetNodeValue(Result);
  Right.GetNodeValue(RRes);

  if (Result.ResultType in [rtInteger, rtFloat, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtInteger, rtFloat, rtCell, rtEmpty])
  then
    Result := BooleanResult(ArgToFloat(Result) = ArgToFloat(RRes))
  else
  if (Result.ResultType in [rtString, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtString, rtCell, rtEmpty])
  then
    Result := BooleanResult(ArgToString(Result) = ArgToString(RRes))
  else
  if (Result.ResultType in [rtDateTime, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtDateTime, rtCell, rtEmpty])
  then
    Result := BooleanResult(ArgToDateTime(Result) = ArgToDateTime(RRes))
  else
  if (Result.ResultType in [rtBoolean, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtBoolean, rtCell, rtEmpty])
  then
    Result := BooleanResult(ArgToBoolean(Result) = ArgToBoolean(RRes))
  else
  if (Result.ResultType = rtError)
    then Result := ErrorResult(Result.ResError)
  else
  if (RRes.ResultType = rtError)
    then Result := ErrorResult(RRes.ResError)
  else
    Result := BooleanResult(false);
end;


{ TsNotEqualExprNode }

function TsNotEqualExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc(fekNotEqual,
    Right.AsRPNItem(
    Left.AsRPNItem(
    ANext
  )));
end;

function TsNotEqualExprNode.AsString: string;
begin
  Result := Left.AsString + '<>' + Right.AsString;
end;

procedure TsNotEqualExprNode.GetNodeValue(var Result: TsExpressionResult);
begin
  inherited GetNodeValue(Result);
  Result.ResBoolean := not Result.ResBoolean;
end;


{ TsOrderingExprNode }

procedure TsOrderingExprNode.Check;
const
  AllowedTypes = [rtBoolean, rtInteger, rtFloat, rtDateTime, rtString, rtEmpty, rtError, rtCell];
begin
  CheckNodeType(Left, AllowedTypes);
  CheckNodeType(Right, AllowedTypes);
  inherited Check;
end;

procedure TsOrderingExprNode.CheckSameNodeTypes;
var
  LT, RT: TsResultType;
begin
  {
  LT := Left.NodeType;
  RT := Right.NodeType;
  case LT of
    rtFloat, rtInteger:
      if (RT in [rtFloat, rtInteger]) or
         ((Rt = rtCell) and (Right.Res
  if (RT <> LT) then
    RaiseParserError(SErrTypesDoNotMatch, [ResultTypeName(LT), ResultTypeName(RT), Left.AsString, Right.AsString])
    }
end;



{ TsLessExprNode }

function TsLessExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc(fekLess,
    Right.AsRPNItem(
    Left.AsRPNItem(
    ANext
  )));
end;

function TsLessExprNode.AsString: string;
begin
  Result := Left.AsString + '<' + Right.AsString;
end;

procedure TsLessExprNode.GetNodeValue(var Result: TsExpressionResult);
var
  RRes: TsExpressionResult;
begin
  Left.GetNodeValue(Result);
  Right.GetNodeValue(RRes);
  if (Result.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell, rtEmpty])
  then
    Result := BooleanResult(ArgToFloat(Result) < ArgToFloat(RRes))
  else
  if (Result.ResultType in [rtString, rtInteger, rtFloat, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtString, rtInteger, rtFloat, rtCell, rtEmpty])
  then
    Result := BooleanResult(ArgToString(Result) < ArgToString(RRes))
  else
  if (Result.ResultType in [rtBoolean, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtBoolean, rtCell, rtEmpty])
  then
    Result := BooleanResult(ord(ArgToBoolean(Result)) < ord(ArgToBoolean(RRes)))
  else
  if (Result.ResultType = rtError)
    then Result := ErrorResult(Result.ResError)
  else
  if (RRes.ResultType = rtError)
    then Result := ErrorResult(RRes.ResError)
  else
    Result := ErrorResult(errWrongType);
end;


{ TsGreaterExprNode }

function TsGreaterExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc(fekGreater,
    Right.AsRPNItem(
    Left.AsRPNItem(
    ANext
  )));
end;

function TsGreaterExprNode.AsString: string;
begin
  Result := Left.AsString + '>' + Right.AsString;
end;

procedure TsGreaterExprNode.GetNodeValue(var Result: TsExpressionResult);
var
  RRes: TsExpressionResult;
begin
  Left.GetNodeValue(Result);
  Right.GetNodeValue(RRes);
  if (Result.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell, rtEmpty])
  then
    Result := BooleanResult(ArgToFloat(Result) > ArgToFloat(RRes))
  else
  if (Result.ResultType in [rtString, rtInteger, rtFloat, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtString, rtInteger, rtFloat, rtCell, rtEmpty])
  then
    Result := BooleanResult(ArgToString(Result) > ArgToString(RRes))
  else
  if (Result.ResultType in [rtBoolean, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtBoolean, rtCell, rtEmpty])
  then
    Result := BooleanResult(ord(ArgToBoolean(Result)) > ord(ArgToBoolean(RRes)))
  else
  if (Result.ResultType = rtError)
    then Result := ErrorResult(Result.ResError)
  else
  if (RRes.ResultType = rtError)
    then Result := ErrorResult(RRes.ResError)
  else
    Result := ErrorResult(errWrongType);
end;


{ TsGreaterEqualExprNode }

function TsGreaterEqualExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc(fekGreaterEqual,
    Right.AsRPNItem(
    Left.AsRPNItem(
    ANext
  )));
end;

function TsGreaterEqualExprNode.AsString: string;
begin
  Result := Left.AsString + '>=' + Right.AsString;
end;

procedure TsGreaterEqualExprNode.GetNodeValue(var Result: TsExpressionResult);
begin
  inherited GetNodeValue(Result);
  Result.ResBoolean := not Result.ResBoolean;
end;


{ TsLessEqualExprNode }

function TsLessEqualExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc(fekLessEqual,
    Right.AsRPNItem(
    Left.AsRPNItem(
    ANext
  )));
end;

function TsLessEqualExprNode.AsString: string;
begin
  Result := Left.AsString + '<=' + Right.AsString;
end;

procedure TsLessEqualExprNode.GetNodeValue(var Result: TsExpressionResult);
begin
  inherited GetNodeValue(Result);
  Result.ResBoolean := not Result.ResBoolean;
end;


{ TsConcatExprNode }

function TsConcatExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc(fekConcat,
    Right.AsRPNItem(
    Left.AsRPNItem(
    nil)));
end;

function TsConcatExprNode.AsString: string;
begin
  Result := Left.AsString + '&' + Right.AsString;
end;

procedure TsConcatExprNode.Check;
begin
  inherited Check;
  CheckNodeType(Left, [rtString, rtCell, rtEmpty, rtError]);
  CheckNodeType(Right, [rtString, rtCell, rtEmpty, rtError]);
end;

procedure TsConcatExprNode.CheckSameNodeTypes;
begin
  // Same node types are checked in GetNodevalue
end;

procedure TsConcatExprNode.GetNodeValue(var Result: TsExpressionResult);
var
  RRes : TsExpressionResult;
begin
  Left.GetNodeValue(Result);
  if (Result.ResultType = rtError)
    then exit;
  Right.GetNodeValue(RRes);
  if (Result.ResultType in [rtString, rtCell]) and (RRes.ResultType in [rtString, rtCell])
    then Result := StringResult(ArgToString(Result) + ArgToString(RRes))
  else
  if (RRes.ResultType = rtError)
    then Result := ErrorResult(RRes.ResError)
  else
    Result := ErrorResult(errWrongType);
end;

function TsConcatExprNode.NodeType: TsResultType;
begin
  Result := rtString;
end;


{ TsMathOperationExprNode }

procedure TsMathOperationExprNode.Check;
const
  AllowedTypes  = [rtInteger, rtFloat, rtDateTime, rtCell, rtEmpty, rtError];
begin
  inherited Check;
  CheckNodeType(Left, AllowedTypes);
  CheckNodeType(Right, AllowedTypes);
  CheckSameNodeTypes;
end;

procedure TsMathOperationExprNode.CheckSameNodeTypes;
begin
  // Same node types are checked in GetNodevalue
end;

function TsMathOperationExprNode.NodeType: TsResultType;
begin
  Result := Left.NodeType;
end;


{ TsAddExprNode }

function TsAddExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc(fekAdd,
    Right.AsRPNItem(
    Left.AsRPNItem(
    ANext
  )));
end;

function TsAddExprNode.AsString: string;
begin
  Result := Left.AsString + '+' + Right.AsString;
end;

procedure TsAddExprNode.GetNodeValue(var Result: TsExpressionResult);
var
  RRes: TsExpressionResult;
begin
  Left.GetNodeValue(Result);
  if Result.ResultType = rtError then
    exit;

  Right.GetNodeValue(RRes);
  if RRes.ResultType = rtError then
  begin
    Result := ErrorResult(RRes.ResError);
    exit;
  end;

  if (Result.ResultType in [rtInteger, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtInteger, rtCell, rtEmpty])
  then
    Result := IntegerResult(ArgToInt(Result) + ArgToInt(RRes))
  else
  if (Result.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty])
  then
    Result := FloatResult(ArgToFloat(Result) + ArgToFloat(RRes));
end;


{ TsSubtractExprNode }

function TsSubtractExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc(fekSub,
    Right.AsRPNItem(
    Left.AsRPNItem(
    ANext
  )));
end;

function TsSubtractExprNode.AsString: string;
begin
  Result := Left.AsString + '-' + Right.asString;
end;

procedure TsSubtractExprNode.GetNodeValue(var Result: TsExpressionResult);
var
  RRes: TsExpressionResult;
begin
  Left.GetNodeValue(Result);
  if Result.ResultType = rtError then
    exit;

  Right.GetNodeValue(RRes);
  if RRes.ResultType = rtError then
  begin
    Result := ErrorResult(RRes.ResError);
    exit;
  end;

  if (Result.ResultType in [rtInteger, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtInteger, rtCell, rtEmpty])
  then
    Result := IntegerResult(ArgToInt(Result) - ArgToInt(RRes))
  else
  if (Result.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty])
  then
    Result := FloatResult(ArgToFloat(Result) - ArgToFloat(RRes));
end;


{ TsMultiplyExprNode }

function TsMultiplyExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc(fekMul,
    Right.AsRPNItem(
    Left.AsRPNItem(
    ANext
  )));
end;

function TsMultiplyExprNode.AsString: string;
begin
  Result := Left.AsString + '*' + Right.AsString;
end;

procedure TsMultiplyExprNode.GetNodeValue(var Result: TsExpressionResult);
var
  RRes: TsExpressionResult;
begin
  Left.GetNodeValue(Result);
  if Result.ResultType = rtError then
    exit;

  Right.GetNodeValue(RRes);
  if RRes.ResultType = rtError then
  begin
    Result := ErrorResult(RRes.ResError);
    exit;
  end;

  if (Result.ResultType in [rtInteger, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtInteger, rtCell, rtEmpty])
  then
    Result := IntegerResult(ArgToInt(Result) * ArgToInt(RRes))
  else
  if (Result.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty])
  then
    Result := FloatResult(ArgToFloat(Result) * ArgToFloat(RRes));
end;


{ TsDivideExprNode }

function TsDivideExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc(fekDiv,
    Right.AsRPNItem(
    Left.AsRPNItem(
    ANext
  )));
end;

function TsDivideExprNode.AsString: string;
begin
  Result := Left.AsString + '/' + Right.asString;
end;

procedure TsDivideExprNode.GetNodeValue(var Result: TsExpressionResult);
var
  RRes: TsExpressionResult;
  y: TsExprFloat;
begin
  Left.GetNodeValue(Result);
  if Result.ResultType = rtError then
    exit;

  Right.GetNodeValue(RRes);
  if RRes.ResultType = rtError then
  begin
    Result := ErrorResult(RRes.ResError);
    exit;
  end;

  if (Result.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty])
  then begin
    y := ArgToFloat(RRes);
    if y = 0.0 then
      Result := ErrorResult(errDivideByZero)
    else
      Result := FloatResult(ArgToFloat(Result) / y);
  end;
end;

function TsDivideExprNode.NodeType: TsResultType;
begin
  Result := rtFLoat;
end;


{ TsPowerExprNode }

function TsPowerExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := RPNFunc(fekPower,
    Right.AsRPNItem(
    Left.AsRPNItem(
    ANext
  )));
end;

function TsPowerExprNode.AsString: string;
begin
  Result := Left.AsString + '^' + Right.AsString;
end;

procedure TsPowerExprNode.GetNodeValue(var Result: TsExpressionResult);
var
  RRes: TsExpressionResult;
  ex: TsExprFloat;
begin
  Left.GetNodeValue(Result);
  if Result.ResultType = rtError then
    exit;

  Right.GetNodeValue(RRes);
  if RRes.ResultType = rtError then
  begin
    Result := ErrorResult(RRes.ResError);
    exit;
  end;

  if (Result.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty]) and
     (RRes.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty])
  then
    try
      Result := FloatResult(Power(ArgToFloat(Result), ArgToFloat(RRes)));
    except
      on E: EInvalidArgument do Result := ErrorResult(errOverflow);
    end;
end;

function TsPowerExprNode.NodeType: TsResultType;
begin
  Result := rtFloat;
end;


{ TsConvertExprNode }

function TsConvertExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  Result := Operand.AsRPNItem(ANext);
end;

function TsConvertExprNode.AsString: String;
begin
  Result := Operand.AsString;
end;


{ TsIntToFloatExprNode }

procedure TsConvertToIntExprNode.Check;
begin
  inherited Check;
  CheckNodeType(Operand, [rtInteger, rtCell])
end;

procedure TsIntToFloatExprNode.GetNodeValue(var Result: TsExpressionResult);
begin
  Operand.GetNodeValue(Result);
  if Result.ResultType in [rtInteger, rtCell] then
    Result := FloatResult(ArgToInt(Result));
end;

function TsIntToFloatExprNode.NodeType: TsResultType;
begin
  Result := rtFloat;
end;


{ TsIntToDateTimeExprNode }

function TsIntToDateTimeExprNode.NodeType: TsResultType;
begin
  Result := rtDatetime;
end;

procedure TsIntToDateTimeExprNode.GetNodeValue(var Result: TsExpressionResult);
begin
  Operand.GetnodeValue(Result);
  if Result.ResultType in [rtInteger, rtCell] then
    Result := DateTimeResult(ArgToInt(Result));
end;


{ TsFloatToDateTimeExprNode }

procedure TsFloatToDateTimeExprNode.Check;
begin
  inherited Check;
  CheckNodeType(Operand, [rtFloat, rtCell]);
end;

function TsFloatToDateTimeExprNode.NodeType: TsResultType;
begin
  Result := rtDateTime;
end;

procedure TsFloatToDateTimeExprNode.GetNodeValue(var Result: TsExpressionResult);
begin
  Operand.GetNodeValue(Result);
  if Result.ResultType in [rtFloat, rtCell] then
    Result := DateTimeResult(ArgToFloat(Result));
end;


{ TsIdentifierExprNode }

constructor TsIdentifierExprNode.CreateIdentifier(AID: TsExprIdentifierDef);
begin
  inherited Create;
  FID := AID;
  PResult := @FID.FValue;
  FResultType := FID.ResultType;
end;

function TsIdentifierExprNode.NodeType: TsResultType;
begin
  Result := FResultType;
end;

procedure TsIdentifierExprNode.GetNodeValue(var Result: TsExpressionResult);
begin
  Result := PResult^;
  Result.ResultType := FResultType;
end;


{ TsVariableExprNode }

procedure TsVariableExprNode.Check;
begin
  // Do nothing;
end;

function TsVariableExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  RaiseParserError('Cannot handle variables for RPN, so far.');
end;

function TsVariableExprNode.AsString: string;
begin
  Result := FID.Name;
end;


{ TsFunctionExprNode }

constructor TsFunctionExprNode.CreateFunction(AID: TsExprIdentifierDef;
  const Args: TsExprArgumentArray);
begin
  inherited CreateIdentifier(AID);
  FArgumentNodes := Args;
  SetLength(FArgumentParams, Length(Args));
end;

destructor TsFunctionExprNode.Destroy;
var
  i: Integer;
begin
  for i:=0 to Length(FArgumentNodes)-1 do
    FreeAndNil(FArgumentNodes[i]);
  inherited Destroy;
end;

function TsFunctionExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
var
  i, n: Integer;
begin
  if FID.HasFixedArgumentCount then
    n := FID.ArgumentCount
  else
    n := Length(FArgumentNodes);
  Result := ANext;
//  for i:=Length(FArgumentNodes)-1 downto 0 do
  for i:=0 to High(FArgumentNodes) do
    Result := FArgumentNodes[i].AsRPNItem(Result);
  Result := RPNFunc(FID.Name, n, Result);
end;

function TsFunctionExprNode.AsString: String;
var
  S : String;
  i : Integer;
begin
  S := '';
  for i := 0 to Length(FArgumentNodes)-1 do
  begin
    if (S <> '') then
      S := S + ',';
    S := S + FArgumentNodes[i].AsString;
  end;
  S := '(' + S + ')';
  Result := FID.Name + S;
end;

procedure TsFunctionExprNode.CalcParams;
var
  i : Integer;
begin
  for i := 0 to Length(FArgumentParams)-1 do
  {
    case FArgumentParams[i].ResultType of
      rtEmpty: FID.FValue.ResultType := rtEmpty;
      rtError: if FID.FValue.ResultType <> rtError then
               begin
                 FID.FValue.ResultType := rtError;
                 FID.FValue.ResError := FArgumentParams[i].ResError;
               end;
      else     FArgumentNodes[i].GetNodeValue(FArgumentParams[i]);
    end;
    }
    FArgumentNodes[i].GetNodeValue(FArgumentParams[i]);
end;

procedure TsFunctionExprNode.Check;
var
  i: Integer;
  rta,                  // parameter types passed to the function
  rtp: TsResultType;    // Parameter types expected from the parameter symbol
  lastrtp: TsResultType;
begin
  if Length(FArgumentNodes) <> FID.ArgumentCount then
  begin
    for i:=Length(FArgumentNodes)+1 to FID.ArgumentCount do
      if not FID.IsOptionalArgument(i) then
        RaiseParserError(ErrInvalidArgumentCount, [FID.Name]);
  end;

  for i := 0 to Length(FArgumentNodes)-1 do
  begin
    rta := FArgumentNodes[i].NodeType;

    // A "cell" can return any type --> no type conversion required here.
    if rta = rtCell then
      Continue;

    if i+1 <= Length(FID.ParameterTypes) then
    begin
      rtp := CharToResultType(FID.ParameterTypes[i+1]);
      lastrtp := rtp;
    end else
      rtp := lastrtp;
    if rtp = rtAny then
      Continue;
    if (rtp <> rta) and not (rta in [rtCellRange, rtError, rtEmpty]) then
    begin
      // Automatically convert integers to floats in functions that return a float
      if (rta = rtInteger) and (rtp = rtFloat) then
      begin
        FArgumentNodes[i] := TsIntToFloatExprNode(FArgumentNodes[i]);
        exit;
      end;
      // Floats are truncated automatically to integers - that's what Excel does.
      if (rta = rtFloat) and (rtp = rtInteger) then
        exit;
      RaiseParserError(SErrInvalidArgumentType, [i+1, ResultTypeName(rtp), ResultTypeName(rta)])
    end;
  end;
end;


{ TsFunctionCallBackExprNode }

constructor TsFunctionCallBackExprNode.CreateFunction(AID: TsExprIdentifierDef;
  const Args: TsExprArgumentArray);
begin
  inherited;
  FCallBack := AID.OnGetFunctionValueCallBack;
end;

procedure TsFunctionCallBackExprNode.GetNodeValue(var Result: TsExpressionResult);
begin
  Result.ResultType := NodeType;     // was at end!
  if Length(FArgumentParams) > 0 then
    CalcParams;
  FCallBack(Result, FArgumentParams);
end;


{ TFPFunctionEventHandlerExprNode }

constructor TFPFunctionEventHandlerExprNode.CreateFunction(AID: TsExprIdentifierDef;
  const Args: TsExprArgumentArray);
begin
  inherited;
  FCallBack := AID.OnGetFunctionValue;
end;

procedure TFPFunctionEventHandlerExprNode.GetNodeValue(var Result: TsExpressionResult);
begin
  Result.ResultType := NodeType;    // was at end
  if Length(FArgumentParams) > 0 then
    CalcParams;
  FCallBack(Result, FArgumentParams);
end;


{ TsCellExprNode }

constructor TsCellExprNode.Create(AWorksheet: TsWorksheet; ACellString: String);
var
  r, c: Cardinal;
  flags: TsRelFlags;
begin
  ParseCellString(ACellString, r, c, flags);
  Create(AWorksheet, r, c, flags);
end;

constructor TsCellExprNode.Create(AWorksheet: TsWorksheet; ARow,ACol: Cardinal;
  AFlags: TsRelFlags);
begin
  FWorksheet := AWorksheet;
  FRow := ARow;
  FCol := ACol;
  FFlags := AFlags;
  FCell := AWorksheet.FindCell(FRow, FCol);
end;

function TsCellExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  if FIsRef then
    Result := RPNCellRef(FRow, FCol, FFlags, ANext)
  else
    Result := RPNCellValue(FRow, FCol, FFlags, ANext);
end;

function TsCellExprNode.AsString: string;
begin
  Result := GetCellString(FRow, FCol, FFlags);
end;

procedure TsCellExprNode.GetNodeValue(var Result: TsExpressionResult);
begin
  if (FCell <> nil) and HasFormula(FCell) then
    case FCell^.CalcState of
      csNotCalculated:
        Worksheet.CalcFormula(FCell);
      csCalculating:
        raise Exception.Create(SErrCircularReference);
    end;

  Result.ResultType := rtCell;
  Result.ResRow := FRow;
  Result.ResCol := FCol;
  Result.Worksheet := FWorksheet;
end;

procedure TsCellExprNode.Check;
begin
  // Nothing to check;
end;

function TsCellExprNode.NodeType: TsResultType;
begin
  Result := rtCell;
  {
  if FIsRef then
    Result := rtCell
  else
  begin
    Result := rtEmpty;
    if FCell <> nil then
      case FCell^.ContentType of
        cctNumber:
          if frac(FCell^.NumberValue) = 0 then
            Result := rtInteger
          else
            Result := rtFloat;
        cctDateTime:
          Result := rtDateTime;
        cctUTF8String:
          Result := rtString;
        cctBool:
          Result := rtBoolean;
        cctError:
          Result := rtError;
      end;
  end;
  }
end;


{ TsCellRangeExprNode }

constructor TsCellRangeExprNode.Create(AWorksheet: TsWorksheet; ACellRangeString: String);
var
  r1, c1, r2, c2: Cardinal;
  flags: TsRelFlags;
begin
  if pos(':', ACellRangeString) = 0 then
  begin
    ParseCellString(ACellRangeString, r1, c1, flags);
    if rfRelRow in flags then Include(flags, rfRelRow2);
    if rfRelCol in flags then Include(flags, rfRelCol2);
    Create(AWorksheet, r1, c1, r1, c1, flags);
  end else
  begin
    ParseCellRangeString(ACellRangeString, r1, c1, r2, c2, flags);
    Create(AWorksheet, r1, c1, r2, c2, flags);
  end;
end;

constructor TsCellRangeExprNode.Create(AWorksheet: TsWorksheet;
  ARow1,ACol1,ARow2,ACol2: Cardinal; AFlags: TsRelFlags);
begin
  FWorksheet := AWorksheet;
  FRow1 := ARow1;
  FCol1 := ACol1;
  FRow2 := ARow2;
  FCol2 := ACol2;
  FFlags := AFlags;
end;

function TsCellRangeExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
  {
  if (FRow1 = FRow2) and (FCol1 = FCol2) then
    Result := RPNCellRef(FRow1, FCol1, FFlags, ANext)
  else
  }
    Result := RPNCellRange(FRow1, FCol1, FRow2, FCol2, FFlags, ANext);
end;

function TsCellRangeExprNode.AsString: string;
begin
  if (FRow1 = FRow2) and (FCol1 = FCol2) then
    Result := GetCellString(FRow1, FCol1, FFlags)
  else
    Result := GetCellRangeString(FRow1, FCol1, FRow2, FCol2, FFlags);
end;

procedure TsCellRangeExprNode.Check;
begin
  // Nothing to check;
end;

procedure TsCellRangeExprNode.GetNodeValue(var Result: TsExpressionResult);
var
  r,c: Cardinal;
  cell: PCell;
begin
  for r := FRow1 to FRow2 do
    for c := FCol1 to FCol2 do
    begin
      cell := FWorksheet.FindCell(r, c);
      if HasFormula(cell) then
        case cell^.CalcState of
          csNotCalculated: FWorksheet.CalcFormula(cell);
          csCalculating  : raise Exception.Create(SErrCircularReference);
        end;
    end;

  Result.ResultType := rtCellRange;
  Result.ResCellRange.Row1 := FRow1;
  Result.ResCellRange.Col1 := FCol1;
  Result.ResCellRange.Row2 := FRow2;
  Result.ResCellRange.Col2 := FCol2;
  Result.Worksheet := FWorksheet;
end;

function TsCellRangeExprNode.NodeType: TsResultType;
begin
  Result := rtCellRange;
end;


{------------------------------------------------------------------------------}
{   Conversion of arguments to simple data types                               }
{------------------------------------------------------------------------------}

function ArgToBoolean(Arg: TsExpressionResult): Boolean;
var
  cell: PCell;
begin
  Result := false;
  if Arg.ResultType = rtBoolean then
    Result := Arg.ResBoolean
  else
  if (Arg.ResultType = rtCell) then begin
    cell := ArgToCell(Arg);
    if (cell <> nil) and (cell^.ContentType = cctBool) then
      Result := cell^.BoolValue;
  end;
end;

function ArgToCell(Arg: TsExpressionResult): PCell;
begin
  if Arg.ResultType = rtCell then
    Result := Arg.Worksheet.FindCell(Arg.ResRow, Arg.ResCol)
  else
    Result := nil;
end;

function ArgToInt(Arg: TsExpressionResult): Integer;
var
  cell: PCell;
begin
  Result := 0;
  if Arg.ResultType = rtInteger then
    result := Arg.ResInteger
  else
  if Arg.ResultType = rtFloat then
    result := trunc(Arg.ResFloat)
  else
  if Arg.ResultType = rtDateTime then
    result := trunc(Arg.ResDateTime)
  else
  if (Arg.ResultType = rtCell) then
  begin
    cell := ArgToCell(Arg);
    if Assigned(cell) and (cell^.ContentType = cctNumber) then
      result := trunc(cell^.NumberValue);
  end;
end;

function ArgToFloat(Arg: TsExpressionResult): TsExprFloat;
// Utility function for the built-in math functions. Accepts also integers
// in place of the floating point arguments. To be called in builtins or
// user-defined callbacks having float results.
var
  cell: PCell;
begin
  Result := 0.0;
  if Arg.ResultType = rtInteger then
    result := Arg.ResInteger
  else
  if Arg.ResultType = rtDateTime then
    result := Arg.ResDateTime
  else
  if Arg.ResultType = rtFloat then
    result := Arg.ResFloat
  else
  if (Arg.ResultType = rtCell) then
  begin
    cell := ArgToCell(Arg);
    if Assigned(cell) then
      case cell^.ContentType of
        cctNumber   : Result := cell^.NumberValue;
        cctDateTime : Result := cell^.DateTimeValue;
      end;
  end;
end;

function ArgToDateTime(Arg: TsExpressionResult): TDateTime;
var
  cell: PCell;
begin
  Result := 0.0;
  if Arg.ResultType = rtDateTime then
    result := Arg.ResDateTime
  else
  if Arg.ResultType = rtInteger then
    Result := Arg.ResInteger
  else
  if Arg.ResultType = rtFloat then
    Result := Arg.ResFloat
  else
  if (Arg.ResultType = rtCell) then
  begin
    cell := ArgToCell(Arg);
    if Assigned(cell) and (cell^.ContentType = cctDateTime) then
      Result := cell^.DateTimeValue;
  end;
end;

function ArgToString(Arg: TsExpressionResult): String;
var
  cell: PCell;
begin
  Result := '';
  case Arg.ResultType of
    rtString  : result := Arg.ResString;
    rtInteger : Result := IntToStr(Arg.ResInteger);
    rtFloat   : Result := FloatToStr(Arg.ResFloat);
    rtCell    : begin
                  cell := ArgToCell(Arg);
                  if Assigned(cell) and (cell^.ContentType = cctUTF8String) then
                    Result := cell^.UTF8Stringvalue;
                end;
  end;
end;

procedure ArgsToFloatArray(const Args: TsExprParameterArray; out AData: TsExprFloatArray);
const
  BLOCKSIZE = 128;
var
  i, n: Integer;
  r, c: Cardinal;
  cell: PCell;
  arg: TsExpressionResult;
begin
  SetLength(AData, BLOCKSIZE);
  n := 0;
  for i:=0 to High(Args) do
  begin
    arg := Args[i];
    if arg.ResultType = rtCellRange then
      for r := arg.ResCellRange.Row1 to arg.ResCellRange.Row2 do
        for c := arg.ResCellRange.Col1 to arg.ResCellRange.Col2 do
        begin
          cell := arg.Worksheet.FindCell(r, c);
          if (cell <> nil) and (cell^.ContentType in [cctNumber, cctDateTime]) then
          begin
            case cell^.ContentType of
              cctNumber   : AData[n] := cell^.NumberValue;
              cctDateTime : AData[n] := cell^.DateTimeValue
            end;
            inc(n);
            if n = Length(AData) then SetLength(AData, length(AData) + BLOCKSIZE);
          end;
        end
    else
    if (arg.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell]) then
    begin
      AData[n] := ArgToFloat(arg);
      inc(n);
      if n = Length(AData) then SetLength(AData, Length(AData) + BLOCKSIZE);
    end;
  end;
  SetLength(AData, n);
end;


{------------------------------------------------------------------------------}
{   Conversion simple data types to ExpressionResults                          }
{------------------------------------------------------------------------------}

function BooleanResult(AValue: Boolean): TsExpressionResult;
begin
  Result.ResultType := rtBoolean;
  Result.ResBoolean := AValue;
end;

function DateTimeResult(AValue: TDateTime): TsExpressionResult;
begin
  Result.ResultType := rtDateTime;
  Result.ResDateTime := AValue;
end;

function EmptyResult: TsExpressionResult;
begin
  Result.ResultType := rtEmpty;
end;

function ErrorResult(const AValue: TsErrorValue): TsExpressionResult;
begin
  Result.ResultType := rtError;
  Result.ResError := AValue;
end;

function FloatResult(const AValue: TsExprFloat): TsExpressionResult;
begin
  Result.ResultType := rtFloat;
  Result.ResFloat := AValue;
end;

function IntegerResult(const AValue: Integer): TsExpressionResult;
begin
  Result.ResultType := rtInteger;
  Result.ResInteger := AValue;
end;

function StringResult(const AValue: string): TsExpressionResult;
begin
  Result.ResultType := rtString;
  Result.ResString := AValue;
end;

{------------------------------------------------------------------------------}
{@@
  Registers a non-built-in function:

  @param AName        Name of the function as used for calling it in the spreadsheet
  @param AResultType  A character classifying the data type of the function result:
                        'I' integer
                        'F' floating point number
                        'D' date/time value
                        'S' string
                        'B' boolean value (TRUE/FALSE)
                        'R' cell range, can also be used for functions requiring
                            a cell "reference", like "CELL(..)"
  @param AParamTypes A string with result type symbols for each parameter of the
                     function. Symbols as used for "ResultType" with these
                     additions:
                       - Use a lower-case character if a parameter is optional.
                         (must be at the end of the string)
                       - Add "+" if the last parameter type is valid for a variable
                         parameter count (Excel does pose a limit of 30, though).
                       - Use "?" if the data type should not be checked.
  @param AExcelCode  ID of the function needed in the xls biff file. Please see
                     the "OpenOffice Documentation of Microsoft Excel File Format"
                     section 3.11.
  @param ACallBack   Address of the procedure called when the formula is
                     calculated.
}
{------------------------------------------------------------------------------}
procedure RegisterFunction(const AName: ShortString; const AResultType: Char;
  const AParamTypes: String; const AExcelCode: Integer; ACallback: TsExprFunctionCallBack);
begin
  with BuiltinIdentifiers do
    AddFunction(bcUser, AName, AResultType, AParamTypes, AExcelCode, ACallBack);
end;

procedure RegisterFunction(const AName: ShortString; const AResultType: Char;
  const AParamTypes: String; const AExcelCode: Integer; ACallback: TsExprFunctionEvent);
begin
  with BuiltinIdentifiers do
    AddFunction(bcUser, AName, AResultType, AParamTypes, AExcelCode, ACallBack);
end;

{ TsBuiltInExprIdentifierDef }

procedure TsBuiltInExprIdentifierDef.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  if Source is TsBuiltInExprIdentifierDef then
    FCategory := (Source as TsBuiltInExprIdentifierDef).Category;
end;

initialization
  ExprFormatSettings := DefaultFormatSettings;
  ExprFormatSettings.DecimalSeparator := '.';
  ExprFormatSettings.ListSeparator := ',';

  RegisterStdBuiltins(BuiltinIdentifiers);

finalization
  FreeBuiltins;
end.