• [转载][转]Delphi 2009 泛型+闭包能带来什么?


    本文转载自 CnPack 论坛:http://bbs.cnpack.org/viewthread.php?tid=2338&extra=page%3D1
    作者为 CnPack 核心组成员:shenloqi

        D2009中引入了Unicode,泛型和闭包。(D2009.Net还没有发布,据说会把所有.Net的东西都加上,包括 LINQ,WPF,SilverLight,甚至包括Linux平台的Mono运行)泛型和闭包虽然.Net中早就有了,但是还有不少人理解不是很深。我前段时间也经常看到有些老外在博客上就D2009给出的闭包等提出讨论,说闭包没有什么用,闭包可以做的我们用本地函数或者函数指针应该也能做到等等。

        泛型一般情况下的用途是用于强类型的集合和容器,闭包一般可以用于简化API(尤其是回调)定义和使用。

        但是作为程序员,就要能够最大程度的利用工具的能力,泛型和闭包这些功能除了一些常规用途之外,我们还能用它们做什么呢?

        我已经曾经利用接口的引用计数做过ScopeGuard并给大家演示过,也有过其他的很多其他的用途,但是用起来都有些繁琐。在有了泛型之后,CodeGear编译器组的Barry写了一个博客介绍了他的TSmartPointer<T>,可以实现自动释放创建的对象,用法如下:

    var
      tmpObj: TSmartPointer<TObject>;
    begin
      tmpObj := TObject.Create('Test');
      Memo1.Lines.Add(tmpObj.Value.ToString);
    end;

        可以看到该类的使用还是比较简单的,并可以通过Value这个字段来访问原对象,tmpObj对象无需显示释放,当超过其生命周期时自己会释放。

        此后CodeGear的首席架构师Allen也写出一篇博文,介绍了如何组合泛型+闭包实现.Net的Lock和Using关键字的功能,可算是相当精彩(可惜没有解决闭包中无法退出函数主体的问题,不过这应该不算问题),用法如下:

    Lock的例子:(Allen的例子没有这么简洁,我用class helper辅助了一下,个人感觉这样一来真的是不需要.NET的Lock关键字了)

      Self.Lock(Self, procedure
        begin
          Memo1.Lines.Add('Hello world!');
        end);

    Using的例子:(我同样稍微修改了一下)

      TStringList.Create.Using<TStringList>(procedure (List: TStringList)
        begin
          List.Add('Test 1');
          Memo1.Lines.AddStrings(List);
        end);

        可以看到Lock用法是相当简洁有效的,而Using虽然要带入类型,但是也不繁琐,而且还无需给临时生成的这个TStringList赋一个变量。

        我昨晚想了一下,首先我们应该可以给闭包增加额外的Break,Continue和Exit的支持,其次,我们还能够通过泛型和闭包做很多别的以前比较难做到的事情,大家知道闭包是函数式语言的基础,有了闭包之后,函数式语言无需流程操作和变量赋值就可以做到图灵完备,所以只要有泛型+闭包,我们就应该可以做到无需流程。

        当然,由于在Delphi,C系列甚至是最新的C#中,函数都不是First Class的,所以要想做到跟函数式语言那样简便是有难度的,而且目前Delphi还不支持Lambda表达式,所以写起来就更繁琐了,但是这也是一个有意思的尝试。我是拿Case语句作为第一个实验品的,我们知道Delphi,Java,C系列等语言都有类似Case的语句,但是这些语句都只能针对整形操作,不支持字符串和对象等,所以我的这个尝试就是实现支持所有的类型的Case语句模拟,当前的版本使用的效果如下:

      Flow._Case(Memo1.Lines[0])._Of('Test 1', procedure (s: string)
        begin
          Memo1.Lines.Add('Proc1: ' + s);
        end)._Of('Test 2', procedure (s: string)
        begin
          Memo1.Lines.Add('Proc2: ' + s);
        end)._Else(procedure (s: string)
        begin
          Memo1.Lines.Add('Not Matched: ' + s);
        end);

        代码中繁琐的地方就是Delphi的闭包没有Lambda那么简单。该段代码支持Delphi的代码提示,_Case之后可以有任意多的_Of条件,而 _Else则只能出现一次,并只能在最后出现。除了Case之外,还有各种循环和异常处理等都可以通过这种方式处理。我验证了概念之后除非实际需要一般不会写全,所以估计不太可能把所有想到的都试验一下了,但是希望这篇文章能让大家对如何发挥工具的能力再多一些理解(希望大家能够改写成.Net版本或者在.Net中实现更好的主意)。

    附上文中提及的代码:

    unit DelphiUtils;

    interface

    uses
      SysUtils, Classes;

    type
      ObjHelper = class helper for TObject
        procedure Lock(Proc: TProc); overload;
        class procedure Lock(O: TObject; Proc: TProc); overload; static;
        procedure Using<T: class>(Proc: TProc<T>); overload;
        class procedure Using<T: class>(O: T; Proc: TProc<T>); overload; static;
      end;

      TLifetimeWatcher = class(TInterfacedObject)
      private
        FWhenDone: TProc;
      public
        constructor Create(const AWhenDone: TProc);
        destructor Destroy; override;
      end;

      TSmartPointer<T: class> = record
      strict private
        FValue: T;
        FLifetime: IInterface;
      public
        constructor Create(const AValue: T); overload;
        class operator Implicit(const AValue: T): TSmartPointer<T>;
        property Value: T read FValue;
      end;

      TBlockResult = (brNormal, brBreak, brContinue, brExit);

      IBlockResult = interface
        ['{17DF93D7-88D5-4B37-B6A4-15C29141BAA4}']
        function GetBlockResult: TBlockResult;
        procedure SetBlockResult(Value: TBlockResult);
        property BlockResult: TBlockResult read GetBlockResult write SetBlockResult;
      end;

      TBlockResultImpl = class(TInterfacedObject, IBlockResult)
      private
        FBlockResult: TBlockResult;
      public
        function GetBlockResult: TBlockResult;
        procedure SetBlockResult(Value: TBlockResult);
        property BlockResult: TBlockResult read GetBlockResult write SetBlockResult;
      end;

      ICaseOf<T> = interface
        ['{66546C18-162C-4B11-B385-07C35C9D5CAB}']
        function _Of(AValue: T; Proc: TProc<T>): ICaseOf<T>;
        procedure _Else(Proc: TProc<T>);
      end;

      TCaseOf<T> = class(TInterfacedObject, ICaseOf<T>)
      private
        FValue: T;
        FMatched: Boolean;
      public
        function _Of(AValue: T; Proc: TProc<T>): ICaseOf<T>;
        procedure _Else(Proc: TProc<T>);
        constructor Create(AValue: T);
      end;

      Flow = record
      public
        class function _Case<T>(AValue: T): ICaseOf<T>; static;
        class function _CaseEx<T>(Func: TFunc<T>): ICaseOf<T>; static;
      end;

    implementation

    uses
      Generics.Defaults;

    procedure ObjHelper.Lock(Proc: TProc);
    begin
      Lock(Self, Proc);
    end;

    class procedure ObjHelper.Lock(O: TObject; Proc: TProc);
    begin
      TMonitor.Enter(O);
      try
        Proc();
      finally
        TMonitor.Exit(O);
      end;
    end;

    procedure ObjHelper.Using<T>(Proc: TProc<T>);
    begin
      Using<T>(Self, Proc);
    end;

    class procedure ObjHelper.Using<T>(O: T; Proc: TProc<T>);
    begin
      try
        Proc(O);
      finally
        O.Free;
      end;
    end;

    { TLifetimeWatcher }

    constructor TLifetimeWatcher.Create(const AWhenDone: TProc);
    begin
      FWhenDone := AWhenDone;
    end;

    destructor TLifetimeWatcher.Destroy;
    begin
      if Assigned(FWhenDone) then
        FWhenDone;
      inherited;
    end;

    { TSmartPointer<T> }

    constructor TSmartPointer<T>.Create(const AValue: T);
    begin
      FValue := AValue;
      FLifetime := TLifetimeWatcher.Create(procedure
      begin
        AValue.Free;
      end);
    end;

    class operator TSmartPointer<T>.Implicit(const AValue: T): TSmartPointer<T>;
    begin
      Result := TSmartPointer<T>.Create(AValue);
    end;

    { TBlockResultImpl }

    function TBlockResultImpl.GetBlockResult: TBlockResult;
    begin
      Result := FBlockResult;
    end;

    procedure TBlockResultImpl.SetBlockResult(Value: TBlockResult);
    begin
      FBlockResult := Value;
    end;

    { Flow }

    class function Flow._Case<T>(AValue: T): ICaseOf<T>;
    begin
      Result := TCaseOf<T>.Create(AValue);
    end;

    class function Flow._CaseEx<T>(Func: TFunc<T>): ICaseOf<T>;
    var
      AValue: T;
    begin
      if Assigned(Func) then
        AValue := Func()
      else
        AValue := Default(T);
      Result := TCaseOf<T>.Create(AValue);
    end;

    { TCaseOf<T> }

    constructor TCaseOf<T>.Create(AValue: T);
    begin
      FValue := AValue;
      FMatched := False;
    end;

    procedure TCaseOf<T>._Else(Proc: TProc<T>);
    begin
      if (not FMatched) and Assigned(Proc) then
      begin
        FMatched := True;
        Proc(FValue);
      end;
    end;

    function TCaseOf<T>._Of(AValue: T; Proc: TProc<T>): ICaseOf<T>;
    begin
      Result := Self;
      if (not FMatched) and Assigned(Proc) and
        (TComparer<T>.Default.Compare(AValue, FValue) = 0) then
      begin
        FMatched := True;
        Proc(FValue);
      end;
    end;

    end.
  • 相关阅读:
    Longest Mountain in Array 数组中的最长山脉
    css 解决 图片 底部 3像素问题
    获取当前年月日2020-09-30格式
    vue + elememt ui table 实现滚屏效果
    滚动字
    layui 之监听 select 的变化
    正则匹配非汉字
    layui form里的select元素动态赋值无效
    layui 之 弹框重新打开 upload无效
    GPS坐标转百度坐标
  • 原文地址:https://www.cnblogs.com/luckForever/p/7255322.html
Copyright © 2020-2023  润新知