再帰関数のスタックオーバーフローを倒す話 その1





 1  

CPSCPS



 1.5

F#



 2

.NET



 2.5

F#



 3

while




(Continuation Passing StyleCPS) CPS F#


CPS








letx=f42 (* ここでブレークして、fから戻ってきた状態(fは実行済み) *)
printfn "%d"x


+---------+
| let x = | f 42
|         +------+
| printfn "%d" x |
+----------------+

=xlet x =




f42 |> (funx->
printfn "%d"x)



let
          +-----------+
  f 42 |> | (fun x -> |
+---------+           |
| printfn "%d"x)     |
+---------------------+

(|>使)
(* もはや値としての関数でしかない *)
let cont = (funx-> printfn "%d"x)


let


let let let


letx=f42
lety= g x
letz= h y
printfn "%A" (x, y, z)

let使
f42 |> (funx->
g x |> (funy->
h y |> (funz->
printfn "%A" (x, y, z) )))

f 42f 42x g xg xy h y

()使

(CPS)


fgh
let fx= x / 2    // int -> int (intを受け取ってintを返す関数)
let gx=x+ 10   // 同上
let hx= stringx// int -> string (intを受け取ってstringを返す関数)

cont*1
let fCont x cont = x / 2 |> cont    // int -> (int -> 'a) -> 'a (intと「intを受け取って何か('a)を返す関数」を受け取って何か('a)を返す関数)
                                    // 元の関数での戻り値は、第二引数で渡される関数の引数になっている
let gCont x cont =x+ 10 |> cont   // 同上
let hCont x cont = stringx|> cont // int -> (string -> 'a) -> 'a (intと「stringを受け取って何か('a)を返す関数」を受け取って何か('a)を返す関数)
                                    // 元の関数での戻り値は、第二引数で渡される関数の引数になっている



cont contcont使

fCont使 f使
let res =f10
...

fCont使
fCont 10 (fun res ->
...)

let let|>使使

使(CPS)
fCont 42 (funx->
gCont x (funy->
hCont y (funz->
printfn "%A" (x, y, z) )))



*2 f1, f2, f3
let example x =
  if f1 x then f2 x
          else 10 + f3 x

f2

f1f1thenelse

f2elsethenelsethenelse thenf2f2

f3使10f3 f3

(F#)


*3

*4

調

CPS


CPS(CPS)

使
let fCont x cont = x / 2 |> cont
let gCont x cont = x + 10 |> cont
let hCont x cont = stringx|> cont

let program () =
  fCont 42 (funx->
  gCont x (funy->
  hCont y (funz->
  printfn "%A" (x, y, z) )))

使
let program () =
  // fContの呼び出しは、program関数の末尾で行われている
  // gContなどの呼び出しは、関数でくるまれた中にいるその場では呼び出されない
  fCont 42 (funx->
    // gContの呼び出しは、fContの継続の末尾で行われている
    // hContなどの呼び出しは、関数でくるまれた中にいるのでその場では呼び出されない
    gCont x (funy->
      // hContの呼び出しは、gContの継続の末尾で行われている
      hCont y (funz->
        printfn "%A" (x, y, z)
      )
    )
  )

*5

CPS CPS CPS

CPS


fact
let rec fact = function
|nwhenn= 0I ->1I
|n->n* (fact (n - 1I))

bigint使when使 n 50000I

let使 let使CPSlet使
let rec fact n =
  ifn= 0I then1I
  else
    let pre = fact (n - 1I)n* pre

CPS cont
(* 変換途中 *)
let rec fact' n cont =
  ifn= 0I then1I
  else
    let pre = fact' (n - 1I)n* pre

contfact'fact'
(* 変換途中: elseがおかしい *)
let rec fact' n cont =
  ifn= 0I then1I |> cont
  else
    let pre = fact' (n - 1I)n* pre |> cont

fact'prefact' fact'(n * pre |> cont)fact'
(* 変換完了! *)
let rec fact' n cont =
  ifn= 0I then1I |> cont
  else
    fact' (n - 1I) (fun pre ->n* pre |> cont)

let CPS 使 CPS

CPSfact'


fact'cont fact'
val fact' :
  n:System.Numerics.BigInteger ->
    cont:(System.Numerics.BigInteger -> 'a) -> 'a

System.Numerics.BigIntgerbigint使
val fact' : n:bigint -> cont:(bigint -> 'a) -> 'a




(一)contfact'

(二)cont

(三)contfact'


123 ()printfn
fact' 5 (fun res ->
printfn "%d" res)

3


(一)resfact'

(二)printfn "%d" resfact'unit

(三)fact'unitfact'unit


CPS id
let res = fact' 5 id
printfn "%d" res

factCPS
let fact n = fact' n id

fact'使
let fact n =
  let rec fact' n cont =
    ifn= 0I then1I |> cont
    else
      fact' (n - 1I) (fun pre ->n* pre |> cont)
  fact' n id

(Release) fsi 50000I CPS

CPS *6 CPS

2


CPS

sum

let rec sum = function
| [] -> 0
|x::xs-> x + (sum xs)

let

let rec sum xs =
  matchxswith
  | [] -> 0
  |x::xs->
      let pre = sum xs
      x + pre

CPS!

let rec sum xs cont =
  matchxswith
  | [] -> 0 |> cont
  |x::xs->
      sum xs (fun pre ->
      x + pre |> cont)

id

maxCPS

let rec max = function
| [x] ->x|x::xs->
    let pre = max xs
    if pre <xthenxelse pre

let


letfunctionmatch
let rec max xs =
  matchxswith
  | [x] ->x|x::xs->
      let pre = max xs
      if pre <xthenxelse pre

CPS!

let rec max xs cont =
  matchxswith
  | [x] ->x|> cont
  |x::xs->
      max xs (fun pre ->
      if pre <xthenx|> cont
                 else pre |> cont)

findCPS

let rec find pred = function
| [] -> failwith "not found."
|x::xs-> if pred x thenxelse find pred xs

let

let rec find pred xs =
  matchxswith
  | [] -> failwith "not found."
  |x::xs->
      if pred x thenxelse
                  let res = find pred xs
                  res

CPS!

let rec find pred xs cont =
  matchxswith
  | [] -> failwith "not found."
  |x::xs->
      if pred x thenx|> cont
                else find pred xs cont (* (fun res -> res |> cont)なので、単にcontを渡せばいい *)

mapCPS

let rec map f = function
| [] -> []
|x::xs-> (f x) :: (map f xs)

let

let rec map f xs =
  matchxswith
  | [] -> []
  |x::xs->
      lety= f x
      letys= map f xs
      y::ys

CPS!

let rec map f xs cont =
  matchxswith
  | [] -> [] |> cont
  |x::xs->
      lety= f x
      map f xs (funys->y::ys|> cont)

mapCPS fCPS
let rec map f xs cont =
  matchxswith
  | [] -> [] |> cont
  |x::xs->
      f x (funy->
      map f xs (funys->y::ys|> cont))


フィボナッチ関数をCPS変換

オリジナル

let rec fib = function
| 0 | 1 -> 1
| n -> fib (n - 1) + fib (n - 2)

letで書き換え

let rec fib n =
  match n with
  | 0 | 1 -> 1
  | n ->
      let pre1 = fib (n - 1)
      let pre2 = fib (n - 2)
      pre1 + pre2

CPS!

let rec fib n cont =
  match n with
  | 0 | 1 -> 1 |> cont
  | n ->
      fib (n - 1) (fun pre1 ->
      fib (n - 2) (fun pre2 ->
      pre1 + pre2 |> cont))

*1:contcontinuationk使

*2:

*3:

*4:Chain of Responsibilitychain

*5:

*6:使使