CnPack Forum


 
Subject: [D2009]泛型+闭包能带来什么?
shenloqi
灌水处处长
Rank: 4



UID 34
Digest Posts 1
Credits 287
Posts 179
点点分 287
Reading Access 10
Registered 2003-3-15
Status Offline
Post at 2008-9-27 09:45  Profile | P.M. 
[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.
Top
Passion (LiuXiao)
管理员
Rank: 9Rank: 9Rank: 9


UID 359
Digest Posts 19
Credits 6776
Posts 3563
点点分 6776
Reading Access 102
Registered 2004-3-28
Status Offline
Post at 2008-9-27 11:25  Profile | Blog | P.M. 
闭包与本地函数指针的关键区别在于前者有对当时环境上下文的记录而后者没有。
Top
jokeli
新警察
Rank: 1



UID 42893
Digest Posts 0
Credits 2
Posts 1
点点分 2
Reading Access 10
Registered 2009-7-24
Status Offline
Post at 2009-7-24 11:50  Profile | Blog | P.M. 
Top
 




All times are GMT++8, the time now is 2024-6-22 17:05

    本论坛支付平台由支付宝提供
携手打造安全诚信的交易社区 Powered by Discuz! 5.0.0  © 2001-2006 Comsenz Inc.
Processed in 0.014649 second(s), 8 queries , Gzip enabled

Clear Cookies - Contact Us - CnPack Website - Archiver - WAP