Delphi : クロージャ : fix関数によるフィボナッチ関数の作成

以上、全てを使ってこういうことができますという例。
重要ポイントだけ抜き出し。

//固定点を求める関数
function fix(maker: IClosure): IClosure;

  procedure f(data: PI_I; _Maker: PClosure);
    var
      __f: IClosure;
    procedure _f(data: PI_I);
      begin
        ApplyC_C(_Maker._, __f)._(data);
      end;
    begin
      //返値としないので、通常のクロージャを選択
      __f := _(@_f); _f(data);
    end;

  begin
    //返値とするので、環境永続化クロージャを選択
    Result := _(@f, Init(maker), @Final);
  end;

//フィボナッチ関数を作る関数
procedure fib_maker(data: PC_C);

  procedure fib_maker2(data: PI_I; F: PClosure);
    begin
      if data.in0 = 0 then data.ret := 0
      else
      if data.in0 = 1 then data.ret := 1
      else begin
        data.ret := ApplyI_I(F._, data.in0 -1)
                  + ApplyI_I(F._, data.in0 -2);
      end;
    end;

  begin
    //返値とするので、環境永続化クロージャを選択
    data.ret := _(@fib_maker2, Init(data.in0), @Final);
  end;

以下、全文掲載。

program fib_fix;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  OptClosure in 'OptClosure.pas';

//IClosureを持つ環境レコード
type
  PClosure = ^TClosure;
  TClosure = record
    _: IClosure;
  end;
function Init(c: IClosure): PClosure; begin New(Result); Result._ := c; end;
procedure Final(e: PClosure); begin Dispose(e); end;

//IClosure引数用レコード
type
  PI_I = ^TI_I;
  TI_I = record
    in0, ret: Integer;
  end;
  PC_C = ^TC_C;
  TC_C = record
    in0, ret: IClosure;
  end;
function ApplyI_I(F: IClosure; in0: Integer): Integer;
  var
    call: TI_I;
  begin
    call.in0 := in0; F._(@call); Result := call.ret;
  end;
function ApplyC_C(F: IClosure; in0: IClosure): IClosure;
  var
    call: TC_C;
  begin
    call.in0 := in0; F._(@call); Result := call.ret;
  end;

//固定点を求める関数
function fix(maker: IClosure): IClosure;

  procedure f(data: PI_I; _Maker: PClosure);
    var
      __f: IClosure;
    procedure _f(data: PI_I);
      begin
        ApplyC_C(_Maker._, __f)._(data);
      end;
    begin
      //返値としないので、通常のクロージャを選択
      __f := _(@_f); _f(data);
    end;

  begin
    //返値とするので、環境永続化クロージャを選択
    Result := _(@f, Init(maker), @Final);
  end;

//フィボナッチ関数を作る関数
procedure fib_maker(data: PC_C);

  procedure fib_maker2(data: PI_I; F: PClosure);
    begin
      if data.in0 = 0 then data.ret := 0
      else
      if data.in0 = 1 then data.ret := 1
      else begin
        data.ret := ApplyI_I(F._, data.in0 -1)
                  + ApplyI_I(F._, data.in0 -2);
      end;
    end;

  begin
    //返値とするので、環境永続化クロージャを選択
    data.ret := _(@fib_maker2, Init(data.in0), @Final);
  end;

var
  fib: IClosure;
  I: Integer;
begin
  //フィボナッチ関数の作成
  fib := fix(_(@fib_maker));

  //テスト実行
  for I := 0 to 10 do begin
    Writeln(IntToStr(I) + ' -> ' + IntToStr(ApplyI_I(fib, I)));
  end;
end.