unit hwExpr;

{ TODO -oCharmer -c表達式解析與運算 : 重寫Parser部分，以便于解析更復雜的表達式 }
{ 添加了DateTime類型，以及相關的類型轉換DateTime()和Delphi內置的日期時間型函數
  中的21個。 }

interface

uses
        TypInfo,
        Classes,
        SysUtils;

type
        TExprType = (ttObject, ttString, ttDateTime, ttFloat, ttInteger,
                     ttEnumerated, ttBoolean);

        EExpression = class (Exception)
        end;

        IValue = interface (IUnknown)
            function AsBoolean: boolean;
            function AsFloat: double;
            function AsInteger: integer;
            function AsObject: TObject;
            function AsString: string;
            function AsDateTime: TDateTime;
            function CanReadAs(aType : TExprType): boolean;
            function ExprType: TExprType;
            function TestParameters: boolean;
            function TypeInfo: PTypeInfo;
            function ClassRef: TClass;
            function TypeName: string;
        end;
  
        TExpression = class (TInterfacedObject, IValue)
        Protected
            function TestParameters: boolean; Virtual;
        Public
            constructor Create;
            destructor Destroy; Override;
            function AsBoolean: boolean; Virtual;
            function AsFloat: double; Virtual;
            function AsInteger: integer; Virtual;
            function AsObject: TObject; Virtual;
            function AsString: string; Virtual;
            function AsDateTime: TDateTime; Virtual;
            function CanReadAs(aType : TExprType): boolean;
            function ExprType: TExprType; Virtual; Abstract;
            function TypeInfo: PTypeInfo; Virtual;
            function TypeName: string; Virtual;
            function ClassRef: TClass; Virtual;
        end;
  
        TStringLiteral = class (TExpression)
        Private
            FAsString: string;
        Public
            constructor Create(aAsString : string);
            function AsString: string; Override;
            function ExprType: TExprType; Override;
        end;
  
        TFloatLiteral = class (TExpression)
        Private
            FAsFloat: double;
        Public
            constructor Create(aAsFloat : double);
            function AsFloat: double; Override;
            function ExprType: TExprType; Override;
        end;
  
        TIntegerLiteral = class (TExpression)
        Private
            FAsInteger: integer;
        Public
            constructor Create(aAsInteger : integer);
            function AsInteger: integer; Override;
            function ExprType: TExprType; Override;
        end;
  
        TEnumeratedLiteral = class (TIntegerLiteral)
        Private
            Rtti: Pointer;
        Public
            constructor Create(aRtti : Pointer; aAsInteger : integer);
            constructor StrCreate(aRtti : Pointer; const aVal : string);
            function TypeInfo: PTypeInfo; Override;
        end;
  
        TBooleanLiteral = class (TExpression)
        Private
            FAsBoolean: boolean;
        Public
            constructor Create(aAsBoolean : boolean);
            function AsBoolean: boolean; Override;
            function ExprType: TExprType; Override;
        end;

        TDateTimeLiteral = class(TFloatLiteral)
        Public
            constructor Create(aDateTimeValue: TDateTime);
            function AsDateTime: TDateTime; Override;
            function ExprType: TExprType; override;
        end;

        TObjectRef = class (TExpression)
        Private
            FObject: TObject;
            FClassRef: TClass;
        Public
            constructor Create(aObject : TObject; aClassRef: TClass = nil);
            function AsObject: TObject; Override;
            function ExprType: TExprType; Override;
            function TypeInfo: PTypeInfo; Override;
            function ClassRef: TClass; override;
        end;

        { TPersistent對象及其子類的Published屬性 }
        TObjectProperty = class(TExpression)
        Private
            Obj: TObject;
            PropInfo: PPropInfo;
            PropType: TExprType;
        Public
            constructor Create(aObj : IValue; const PropName : string);
            function AsBoolean: boolean; Override;
            function AsFloat: double; Override;
            function AsDateTime: TDateTime; Override;
            function AsInteger: integer; Override;
            function AsObject: TObject; Override;
            function AsString: string; Override;
            function ExprType: TExprType; Override;
            function TypeInfo: PTypeInfo; Override;
        end;

        TParameterList = class (TList)
        Private
            function GetAsBoolean(i : integer): boolean;
            function GetAsFloat(i : integer): double;
            function GetAsInteger(i : integer): integer;
            function GetAsObject(i : integer): TObject;
            function GetAsString(i : integer): string;
            function GetAsDateTime(i : Integer): TDateTime;
            function GetExprType(i : integer): TExprType;
            function GetParam(i : integer): IValue;
        Public
            destructor Destroy; Override;
            function AddExpression(e : IValue): integer;
            property AsBoolean[i: integer]: boolean Read GetAsBoolean;
            property AsFloat[i: integer]: double Read GetAsFloat;
            property AsInteger[i: integer]: integer Read GetAsInteger;
            property AsObject[i: integer]: TObject Read GetAsObject;
            property AsString[i: integer]: string Read GetAsString;
            property AsDateTime[i: Integer]: TDateTime read GetAsDateTime;
            property ExprType[i: integer]: TExprType Read GetExprType;
            property Param[i: integer]: IValue Read GetParam;
        end;
  
        TFunction = class (TExpression)
        Private
            FParameterList: TParameterList;
            function GetParam(n : integer): IValue;
        Protected
            property ParameterList: TParameterList read FParameterList write FParameterList;
        Public
            constructor Create(aParameterList : TParameterList);
            destructor Destroy; Override;
            function ParameterCount: integer;
            property Param[n: integer]: IValue Read GetParam;
        end;

        { 用來顯示內置函數的東西 }
        TIntFuncList = class
        Private
            FIntFuncList: TList;
            function GetFuncName(Index: integer): String;
            function GetFuncSyntax(Index: integer): String;
            function GetFuncDescription(Index: Integer): String;
            function GetFuncList: TStrings;
            function GetCount: integer;
            function GetTypeCastFuncs: TStrings;
            function GetMathFuncs: TStrings;
            function GetStringFuncs: TStrings;
            function GetDateTimeFuncs: TStrings;
        Protected
            procedure AddFunc(const AFuncName, AFuncSyntax, ADescription: string);
        Public
            constructor Create;
            destructor Destroy; override;
            property Count: Integer read GetCount;
            property FuncName[Index: integer]: string read GetFuncName;
            property Syntax[Index: Integer]: String read GetFuncSyntax;
            property Description[Index: integer]: String read GetFuncDescription;
            property FuncList: TStrings read GetFuncList;
            property TypeCastFuncs: TStrings read GetTypeCastFuncs;
            property MathFuncs: TStrings read GetMathFuncs;
            property StringFuncs: TStrings read GetStringFuncs;
            property DateTimeFuncs: TStrings read GetDateTimeFuncs;
        end;
        
        { 外部定義的方法，用于執行由標識符和參數表指定的功能 }
//        TIdentifierFunction = function (const Identifier : string;
//            ParameterList : TParameterList): IValue of object;
        { 為了能夠識別對象成員，將原TIdentifierFunction函數進行了修改，添加了一
          個Obj參數，用于向IDF提供對象以便于識別對象及其成員 }
        TIdentifierFunction = function(obj: IValue; const Identifier: string;
              ParameterList: TParameterList): IValue of Object;
              
        function CheckEnumeratedVal(Rtti : Pointer; const aVal : string): IValue;

        function CreateExpression( const S : string;
                IdentifierFunction : TIdentifierFunction): IValue;

        function FoldConstant( Value : IValue): IValue;

        { 測試使用Parser對象完成解析任務 }
var
        InstanceCount: integer = 0;
        ExprTypeName: array[TExprType] of string =('對象', '字符串', '日期時間',
                    '浮點值', '整數','枚舉', '邏輯值');
        ExprIntFuncList: TIntFuncList;
implementation

uses
  Dialogs;

type
        TOperator = ( opNot,
            opExp,
            opMult, opDivide, opDiv, opMod, opAnd, opShl, opShr,
            opPlus, opMinus, opOr, opXor,
            opEq, opNEq, opLT, opGT, opLTE, opGTE);

        TOperators = set of TOperator;

        TUnaryOp = class (TExpression)
        Private
            Operand: IValue;
            OperandType: TExprType;
            Operator: TOperator;
        Public
            constructor Create(aOperator : TOperator; aOperand : IValue);
            function AsBoolean: boolean; Override;
            function AsFloat: double; Override;
            function AsInteger: integer; Override;
            function ExprType: TExprType; Override;
        end;
  
        TBinaryOp = class (TExpression)
        Private
            Operand1: IValue;
            Operand2: IValue;
            OperandType: TExprType;
            Operator: TOperator;
        Public
            constructor Create(aOperator : TOperator; aOperand1, aOperand2 : IValue);
            function AsBoolean: boolean; Override;
            function AsFloat: double; Override;
            function AsInteger: integer; Override;
            function AsString: string; Override;
            function AsDateTime: TDateTime; override;
            function ExprType: TExprType; Override;
        end;

        TRelationalOp = class (TExpression)
        Private
            Operand1: IValue;
            Operand2: IValue;
            OperandType: TExprType;
            Operator: TOperator;
        Public
            constructor Create(aOperator : TOperator; aOperand1, aOperand2 : IValue);
            function AsBoolean: boolean; Override;
            function AsFloat: double; Override;
            function AsInteger: integer; Override;
            function AsString: string; Override;
            function AsDateTime: TDateTime; Override;
            function ExprType: TExprType; Override;
        end;

const
        MaxStringLength   = 255; { 最大字符串長度 }
        Digits            = ['0'..'9'];

        { 嘗試添加對中文的支持。采用判斷#127..#255的方式可能存在某些隱患。應當
          將字符串轉換成WideString或UnicodeString，然后判斷字符碼是否在指定的
          字符集區域內，由此判斷各個字符的實際內容。 }
        //PrimaryIdentChars = ['a'..'z', 'A'..'Z', '_'];
        PrimaryIdentChars = ['a'..'z', 'A'..'Z', '_', #127..#255];
        IdentChars        = PrimaryIdentChars + Digits;

        //表達式類型
        NExprType: array[TExprType] of string =
            ('Object', 'String', 'DateTime', 'Float', 'Integer',
             'Enumerated', 'Boolean');
        //操作符類型
        NOperator: array[TOperator] of string =
            ( 'opNot',
              'opExp',
              'opMult', 'opDivide', 'opDiv', 'opMod', 'opAnd', 'opShl', 'opShr',
              'opPlus', 'opMinus', 'opOr', 'opXor',
              'opEq', 'opNEq', 'opLT', 'opGT', 'opLTE', 'opGTE');

        UnaryOperators       = [opNot];
        ExpOperator          = [opExp];
        MultiplyingOperators = [opMult, opDivide, opDiv, opMod, opAnd, opShl, opShr];
        AddingOperators      = [opPlus, opMinus, opOr, opXor];
        RelationalOperators  = [opEq, opNEq, opLT, opGT, opLTE, opGTE];

        NBoolean: array[boolean] of string[5] = ('FALSE', 'TRUE');

{-----------------------------------------------------------------------------
     >>>>  ResultType   <<<<  Begin
-----------------------------------------------------------------------------}
function ResultType( Operator : TOperator; OperandType : TExprType): TExprType;
        procedure NotAppropriate;
        begin
            Result:= ttString;
            raise EExpression.CreateFmt( '算符 %s 與算子 %s 類型不兼容',
                [NOperator[Operator], NExprType[OperandType]])
        end;
begin
        case OperandType of
            ttString:
                case Operator of
                    opPlus: Result     := ttString;
                    opEq..opGTE: Result:= ttBoolean;
                    else
                        NotAppropriate;
                end;
            ttFloat:
                case Operator of
                    opExp, opMult, opDivide, opPlus, opMinus: Result:= ttFloat;
                    opEq..opGTE: Result                             := ttBoolean;
                    else
                        NotAppropriate;