[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.
|
