unit hwExprExt;

{ 本單元是對表達式單元hwExpr的擴展 }
{ 目前對符號表的設計不甚完善。主要采用了GlobalContextSet的形式，應該添加私有符
  號表和定制符號表，便于更靈活地使用表達式 }
{ DONE -oCharmer -c表達式解析與運算 : 注意，所有傳遞參數的過程中，都沒有比較對象類型參數的類是否一致。 }
{ DONE -oCharmer -c表達式解析與運算 :
現在有點糊涂了，有點搞不清楚如何在對象尚不存在的情況下
使用ClassType }
{ TODO -oCharmer -c表達式解析與運算 : 
需要添加：自定義表達式返回值若是對象的話，應規定選擇其返回的類，或通過測試來
得到返回的類 }
{ TODO -oCharmer -c表達式解析與運算 :
在表達式模板中通過測試檢查返回值類型是否和定義的相一致，若返回對象，檢查對象
的類是否是注冊類 }
interface
uses
        TypInfo,
        Classes,
        SysUtils,
        hwExpr,
        hwExprExtLiteral,
        Dialogs,
        { uRptUtils, }
        uExprUtils,
        hwStrHashMap;

const
        Err_FuncCanntInteger = '函數%s不能返回整數值';
        Err_FuncCanntFloat   = '函數%s不能返回浮點值';
        Err_FuncCanntBoolean = '函數%s不能返回邏輯值';
        Err_FuncCanntString  = '函數%s不能返回字符串';
        Err_FuncCanntObject  = '函數%s不能返回對象';
        Err_FuncCanntEnum    = '函數%s不能返回枚舉值';
type
        TAbstractContextSet = class;
        TExprContextSet = class;
        
        TAbstractExtFunction = class
        Private
            FFuncName: string;
            FResultType: TExprType;
            { 附加的類型名，當類型為對象或枚舉時，用于記錄類名或枚舉名 }
            FAdditionType: String;
            FDescription: String;
            procedure SetFuncName(const AName: string); virtual;
            procedure SetResultType(const AType: TExprType); virtual;
            procedure SetAdditionType(const ATypeName: string);
            function GetParamsCount: integer; virtual; abstract;
            function GetParamsName(Index: integer): string; virtual; abstract;
            function GetParamsType(Index: integer): TExprType; virtual; abstract;
            function GetSyntax: string; virtual;
            function GetTypeName: string;
        Protected
            procedure SaveToStream(AStream: TExprStream); virtual;
            procedure LoadFromStream(AStream: TExprStream); virtual;
        Public
            property ParamsName[Index: integer]: String read GetParamsName;
            property ParamsType[Index: integer]: TExprType read GetParamsType;
        Published
            property ParamsCount: integer read GetParamsCount;
            property FunctionName: string read FFuncName;
            property Description: string read FDescription write FDescription;
            property ResultType: TExprType read FResultType;
            property TypeName: string read GetTypeName;
            property Syntax: string read GetSyntax;
        end;

        { 公式模板************************************************ }
        { 公式模板用于記錄用戶定義的函數，它包含該函數的表達式及參
          數表。還具有對用戶書寫的表達式進行語法檢查的功能。
          當該公式被引用時，UserFuncContext將根據該公式的模板信息
          創建公式對象供引用者使用。這就是說，該公式不是預編譯的，
          而是解釋運行的。如果要實現預編譯，要重新考慮IValue節點的
          賦值方式。預編譯方式事先創建算符、算子節點樹，隨后向各算
          子賦值就可以進行計算了，預編譯方式要快一些。
          參見
                TUserEvalFunction,
                TUserCompileFunction,
                TUCFImplementation (User Compile Function Implamentation)
        }
        TExprTemplate = class(TAbstractExtFunction)
        Private
            FExpression: String; //公式字符串
            FParamList: TList;
            FErrorString: TStrings;   //檢查出的錯誤信息
            FUnknowSymbols: TStrings;
            FNeedCheck: Boolean;
            FIdentContextSet: TAbstractContextSet; //全局ContextSet
            function GetParamsCount: integer; override;
            function GetParamsName(Index: Integer): String; override;
            function GetParamsType(Index: Integer): TExprType; override;
            //function GetSyntax: string; override;
            { 虛擬參數方法，有兩個目的：
              1、檢查表達式是否有語法錯誤；
              2、獲取未知的符號表 }
            function VirtualParams(Obj: IValue; const Identifier: string;
                ParameterList: TParameterList): IValue;
        Protected
            procedure SaveToStream(AStream: TExprStream); override;
            procedure LoadFromStream(AStream: TExprStream); override;
        Public
            constructor Create(const AFuncName: string;
                               const AResultType: TExprType;
                               const DetailType: String = '');
            destructor Destroy; override;
            { 添加一個參數 }
            function AddParam(const AParamName: string; const AParamType: TExprType): integer;
            function UnknowSymbols: TStrings;
            function UnknowSymbolsCount: integer;
            { 察看標識符是否是參數，若不是返回值為-1，是則返回參數的序號 }
            function IsParam(const Identifier: string): integer;
            procedure DeleteParam(Index: integer); overload;
            procedure DeleteParam(const AParamName: String); overload;
            procedure ClearParams;
            { 檢查表達式 }
            function CheckExpression: Boolean;
            function ErrorMessage: string;
            property ParamsName;
            property ParamsType;
        Published
            property FunctionName;
            property ResultType;
            property ParamsCount;
            property Description;
            property Syntax;
            property Expression: string read FExpression write FExpression;
            property IdentContextSet: TAbstractContextSet read FIdentContextSet write FIdentContextSet;
        end;

        { ******************************************************* }
        { 外部定義的函數，用于執行由標識符和參數表指定的功能
          例：定義了如下函數，假定有三個整型參數，返回值是字符串
              function MyFunc(ParameterList: TParameterList): IValue;
              var x,y,z: integer;
              begin
                x := ParameterList.Param[0].AsInteger;
                y := ParameterList.Param[1].AsInteger;
                z := ParameterList.Param[2].AsInteger;
                Result := TStringLiteral.Create(IntToStr(X + Y ^ Z));
              end;
          然后添加到ExtFunctionContext中：
              AddFunc('MyFunc', ttString, [ttInteger, ttInteger, ttInteger]);
          AddFunc的三個參數為函數名、返回值類型、各個參數類型。
        }
        TExtFuncImplementation = function(ParameterList: TParameterList): IValue;

        { 擴展函數定義 }
        TExtFunctionDeclare = class(TAbstractExtFunction)
        Private
            FParams: TList;
            FExtFuncAddr: TExtFuncImplementation;
            function GetParamsCount: integer; override;
            function GetParamsType(Index: integer): TExprType; override;
            function GetParamsName(Index: integer): string; override;
        Public
            constructor Create(const AFuncName: string;
                               const AResultType: TExprType;
                               DefineParams: array of TExprType;
                               ExtFunc: TExtFuncImplementation;
                               const ADescription: String); overload;
            constructor Create(const AFuncName: string;
                               const ParamNames: array of string;
                               const ParamTypes: array of TExprType;
                               const AResultType: TExprType;
                               ExtFunc: TExtFuncImplementation;
                               const ADescription: String); overload;
            destructor Destroy; override;
            property FuncAddress: TExtFuncImplementation read FExtFuncAddr;
            property ParamsType;
            property ParamsName;
        Published
            property FunctionName;
            property ResultType;
            property ParamsCount;
            property Description;
            property Syntax;
        end;

        { 上下文相關表，為提高查詢性能，使用了Hash表 }
        TExprContext = class
        Private
            FOwnerSet: TAbstractContextSet;
            FHashMap: TStringHashMap;
            function GetCount: Integer;
            function GetItem(Index: Cardinal):Pointer;
            function GetItemName(Index: Cardinal): String;
            function GetData(const AName: string): Pointer;
            procedure SetData(const AName: string; var P : Pointer);
            procedure AddHashNode(const AName: string; P : Pointer);
        protected
            function FindData(const p{: Pointer}; var s: string): Boolean;
            procedure Delete(Index: Cardinal); overload;virtual;abstract;
            procedure Delete(const AName: string); overload;virtual;abstract;
            procedure ClearPointers;
            procedure ClearObjects;
            function Remove(const AName: String): Pointer; virtual;
            procedure RemoveData(Data: Pointer); virtual;
            property Items[Index: Cardinal]: Pointer read GetItem;
            property ItemsName[Index: Cardinal]: string read GetItemName;
            property Data[const AName: string]: Pointer read GetData write SetData;
        Public
            constructor Create(AOwner: TAbstractContextSet; const HashSize: Cardinal);
            destructor  Destroy; override;
            //function Add() 不用類型的Context表有不同的add方法，此處不定義
            { 對于Delete方法，不同的Context的處理可能不同，有些需要釋放指針或
              對象，故此處設為Abstract }
            function Has(const AName: string): Boolean;
            function Find(const AName: string; var P): Boolean;
            procedure Clear; virtual;
            property Owner: TAbstractContextSet read FOwnerSet;
        Published
            property Count: Integer read GetCount;
        end;

        { ---------------------------------------------------------------------
          Class : TEnumerationContext
          可使用的枚舉類型表。目前對枚舉和類類型的應用還不充分，需要進一步擴展。
          一個可用的方式是通過TTypeKind代替TExprType，用TypeInfo和TypeData來返
          回實際的類型信息，如此可方便地擴充數據類型、檢查數據范圍。
          -------------------------------------------------------------------- }        
        TEnumerationContext = class(TExprContext)
        Private
            function GetItem(Index: Cardinal): PTypeInfo;
        Protected
            procedure Delete(Index: Cardinal); overload; override;
            procedure Delete(const AName: string); overload; override;
        Public
            constructor Create(AOwner: TAbstractContextSet);
            destructor Destroy; override;
            procedure Add(TypeInfo: PTypeInfo);
            { 是否是注冊過的枚舉類型的項？ }
            function IsEnumItem(const Identifier: String): Boolean;
            { 給項名，獲得該項的枚舉類型信息 }
            function ItemType(const Identifier: String): PTypeInfo;
            { 給項名，獲得該項的枚舉類型名 }
            function ItemTypeName(const Identifier: String): string;
            { 獲得類型的子項表 }
            function GetEnumItems(const EnumTypeName: string; var EnumItems: TStrings): Boolean;
            { 返回TEnumeratedLiteral }
            function GetIValue(const Identifier: string): IValue;
            property Items[Index: Cardinal]: PTypeInfo read GetItem;
            property ItemsName;
        Published
            property Count;
        end;
        { ---------------------------------------------------------------------
          Class : TConstantContext
          常量Context
          -------------------------------------------------------------------- }
        TConstantContext = class(TExprContext)
        Private
            function GetItem(Index: Cardinal): IValue;
            function GetData(const AName: string): IValue;
            function CheckIdentifier(const Ident: string): Boolean;
        Protected
            procedure SaveToStream(AStream: TExprStream);
            procedure LoadFromStream(AStream: TExprStream);
        Public
            constructor Create(AOwner: TAbstractContextSet);
            destructor Destroy; override;
            function Add(const Ident: string; Value: Integer): IValue; overload;
            function Add(const Ident: string; Value: Boolean): IValue; overload;
            function Add(const Ident: string; Value: Double): IValue; overload;
            function Add(const Ident: string; Value: String): IValue; overload;
            procedure Delete(Index: Cardinal); overload; override;
            procedure Delete(const AName: string); overload; override;
            procedure Clear; override;
            property Items[Index: Cardinal]: IValue read GetItem;
            property ItemsName;
            property ItemsByName[const AName: string]: IValue read GetData;
        end;

        { 擴展對象訪問方法，用于執行對象非Published方法和屬性的訪問。為每一個
          類需要訪問的方法和屬性編寫一個TExtObjectAccessFunc函數，通過對該函
          數的調用進行訪問 }
        TExtObjectAccessFunc = function(Obj: IValue; ParamList: TParameterList): IValue;
        TExtMemberType = (mtProperty, mtMethod);
        TExtMemberVisibleType = (mvPublished, mvPublic);

        PMemberInfo = ^TMemberInfo;
        TMemberInfo = record
            OwnerClass : string;
            MemberName : string;
            DataType   : TExprType;
            MemberType : TExtMemberType;
            VisibleType: TExtMemberVisibleType;
            AccessProc : TExtObjectAccessFunc;
            Params     : TList;
            ClassRef   : TClass; //當成員是對象的時候，設置成員的類類型
        end;

        { ---------------------------------------------------------------------
          Class : TObjectMemberLiteral
          用于對對象成員的訪問。對于對象的Published屬性，由ObjectProperty提供
          訪問，而其他成員如方法和非Published屬性，以及不是TPersistent子類的
          對象的成員，由本對象提供訪問。
          -------------------------------------------------------------------- }
        TObjectMemberLiteral = class(TFunction)
        Private
            FMemberInfo: PMemberInfo;
            FObject: IValue;
        Public
            constructor Create(Obj: IValue; const MemberInfo: PMemberInfo; PassParams: TParameterList);
            destructor Destroy; override;
            function AsBoolean: Boolean; override;
            function AsInteger: Integer; override;
            function AsFloat: Double; override;
            function AsString: string; override;
            function AsObject: TObject; override;
            function ExprType: TExprType; override;
            function TestParameters: Boolean; override;
            function ClassRef: TClass; override;
        end;
        { ---------------------------------------------------------------------
          Class : TClassElementsContext
          類成員Context，用于通過專門提供的函數訪問對象成員
          -------------------------------------------------------------------- }
        TClassMemberContext = class(TExprContext)
        Private
            FOwnerClassType: TClass;
            function GetClassName: string;
            function GetItem(Index: Cardinal): PMemberInfo;
            function GetMember(const AName: string): PMemberInfo;
            function GetMemberSyntax(const AMemberName: String): string;
        Protected
            procedure Delete(Index: Cardinal); overload; override;
            procedure Delete(const AName: string); overload; override;
        Public
            constructor Create(AOwner: TAbstractContextSet; const ClassRef: TClass);
            destructor Destroy; override;
            procedure AddMember(const MemberName: string;
                                const aType: TExprType;
                                const aMemberType: TExtMemberType;
                                const aVisibleType: TExtMemberVisibleType;
                                const aParamsName: array of string;
                                const aParams: array of TExprType;
                                const AccessProc: TExtObjectAccessFunc;
                                const ClassRef: TClass = nil);