Честно спизженный из хранилища пример. Рассмотрим функцию, вычисляющую гипотенузу по двум катетам.
let pow2 a = a ** 2.0
let add a b = a +. b
let sqrt a = a ** 0.5
let hyp a b = sqrt (add (pow2 a) (pow2 b))
let () = print_float (hyp 1. 1.) (* 1.41421356237 *)
Теперь перепишем всё через CPS
(* Принимает a : float и k - продолжение,
вызывает k с аргументом a ** 2 *)
let pow2 a k = k (a ** 2.)
(* Аналогично pow2 *)
let add a b k = k (a +. b)
(* Аналогично pow2 *)
let sqrt a k = k (a ** 0.5)
let hyp a b k = pow2 a (fun a2 ->
pow2 b (fun b2 ->
add a2 b2 (fun c2 ->
sqrt c2 k)))
let () = print_float (hyp 1. 1. (fun x -> x))
Пояснение: hyp принимает 2 числа и k — “продолжение”, считает a ** 2 и в качестве продолжения передает функцию, которая считает b ** 2 и в качестве продолжения передает функцию, которая считает сумму a ** 2 и b ** 2 и в качестве продолжения передает функцию, которая считает корень из этой суммы с продолжением k, которое принимает функция hyp. Функция k применяется к результату sqrt, тогда чтобы получить гипотенузу, передадим в качестве k функцию id,или же (fun x -> x).
Пример факториала через CPS
(* Обычный факториал *)
let rec fact x = if x = 1 then 1 else x * fact (x - 1)
let () = print_int (fact 5); print_char '\\n' (* 120 *)
(* CPS факториал *)
let rec factCPS x k = if x = 1 then k 1 else factCPS (x - 1) (fun n → k (n*x))
let () = print_int (factCPS 5 (fun x -> x)); print_char '\\n' (* 120 *)
Пояснение: factCPS принимает 2 аргумента: число x и продолжение k. Если x = 1, то мы из определения CPS просто продолжаем вычислять при помощи k. В ином случае мы совершаем хвостовой вызов факториала. В качестве функции k передается fun n → k (n*x). Таким образом мы говорим, что при помощи текущего k и x продолжи вычисления, получи какой-то результат k x, а затем умножь на то, что у тебя получится при следующем вызове факториала.
Пример с деревьями с пары. Пусть есть тип дерева, функция, которая строит какое-то дерево (какое, в целом, неважно, но в нашем случае это дерево, которое каждые 100_000 глубины раздваивается), и функция, считающая количество узлов в дереве.
(* Тип дерева *)
type tree =
| Leaf
| Node of tree * tree
(* Создать дерево глубины depth *)
let rec make depth =
if depth <= 0 then Leaf
else
let r = make (depth - 1) in
let l = if depth mod 100000 = 0 then r else Leaf in
Node (l, r)
(* Количество узлов в дереве root *)
let size root =
let rec helper tree =
match tree with
| Leaf -> 0
| Node (l, r) -> 1 + helper l + helper r
in helper root
let () = print_int (size (make 200_000)) (* 599997 *)
let () = print_int (size (make 500_000)) (* Fatal error: exception Stack_overflow *)
Все описанные выше функции будут нещадно жрать стек, что не есть хорошо. Перепишем их под хвостовые вызовы.
(* В make можно обойтись аккумулятором *)
let make_tail depth =
let rec helper acc n =
if depth < n then acc
else
let l = if n mod 100000 = 0 then acc else Leaf in
helper (Node (l, acc)) (n + 1)
in
helper Leaf 1
(* В обычном size helper в одном месте вызывается для левого и правого поддерева
-- обычным аккумулятором не обойтись, перепишем под CPS *)
let size_tail root =
let rec helper tree k =
match tree with
| Leaf -> k 0
| Node (l, r) ->
helper l (fun sl ->
helper r (fun sr -> k (1 + sl + sr)))
in
helper root (fun n -> n)
let () = print_int (size_tail (make_tail 200_000)) (* 599997 *)
let () = print_int (size_tail (make_tail 500_000)) (* 6199969 *)
А теперь как до этого додуматься: в функции k мы предаем то, что нужно сделать с результатом вычислений. Так как Leaf раньше обозначал пустое место, то результатом вычислений в случае Leaf будет 0, его и передадим в k. Для Node мы считали размер левого поддерева, размер правого поддерева, и всё это складывали с единицей. Поступим также: вызовем helper от левого поддерева и передадим туда такое k, что оно получит этот размер, посчитает размер правого поддерева (имея в области видимости размер левого поддерева) и передаст уже туда k, которое получит этот размер правого поддерева и подсчитает 1 + sl + sr.
CPS для фактириала и фиббоначи
let rec fac n = if n = 0 then 1 else n * fac (n - 1)
let rec cps_fac n k = if n = 0 then k 1 else cps_fac(n-1) (fun x -> k (n * x))
let rec fib n = if n = 0 || n = 1 then 1 else fib(n-1) + fib(n-2)
let rec cps_fib n k = if n = 0 || n = 1 then k 1 else cps_fib(n-1) (fun x -> cps_fib(n-2) (fun y -> k(x+y)))
Дефункционализация
