CnPack Forum - Powered by Discuz! Board

Subject: [D2009]泛型+闭包能带来什么？ [Print This Page]

Author: shenloqi Time: 2008-9-27 09:45 Subject: [D2009]泛型+闭包能带来什么？

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.

Author: Passion Time: 2008-9-27 11:25

闭包与本地函数指针的关键区别在于前者有对当时环境上下文的记录而后者没有。

Author: jokeli Time: 2009-7-24 11:50

thanks for!great job!

....................................................................................................

Welcome to CnPack Forum (http://bbs.cnpack.org/)