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

时间:2022-01-05 22:44:20
本文转载自 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);