(* 15-150, Spring 2024 *)
(* Michael Erdmann & Dilsun Kaynar *)
(* With thanks to Frank Pfenning for introducing us to this paradigm. *)
(* *)
(* Example of CPS code in which the success continuation *)
(* takes a failure continuation as argument. *)
(************************************************************************)
datatype 'a tree = Empty | Node of 'a tree * 'a * 'a tree
val t1 = Node(Node(Node(Empty, 1, Empty), 2, Node(Empty, 3, Empty)),
4,
Node(Empty, 5, Empty))
(* 4
/ \
2 5
/ \
1 3
*)
(************************************************************************)
(* The following code can be generalized in the manner of the search *)
(* function from lecture 12, to arbitrary trees and predicates on *)
(* tree elements. See function findp below. *)
(* find : int tree -> (int -> (unit -> 'a) -> 'a) -> (unit -> 'a) -> 'a
REQUIRES: true
{sc x fc', with x the first even integer
{ found in a pre-order traversal of T,
ENSURES: find T sc fc == { and fc' a failure continuation that
{ mimics what function find would have
{ done if x had been an odd integer;
{fc(), if T contains no even integer.
*)
fun find Empty _ fc = fc()
| find (Node(left, x, right)) sc fc =
let
(* fcnew is the fc' mentioned in the specs above. *)
fun fcnew () = find left sc (fn () => find right sc fc)
in
if x mod 2 = 0 then sc x fcnew
else fcnew()
end
(* We can now find the first even integer in a tree, *)
(* or find all even integers in a tree, *)
(* or merely count the number of even integers in a tree, *)
(* without rewriting the tree-traversal function, merely changing *)
(* the continuations. *)
fun findfirst T = find T (fn x => fn fc => SOME(x)) (fn () => NONE)
fun findall T = find T (fn x => fn fc => x :: fc ()) (fn () => [])
fun count T = find T (fn x => fn fc => 1 + fc ()) (fn () => 0)
val SOME 4 = findfirst t1
val [4,2] = findall t1
val 2 = count t1
(************************************************************************)
(* Here is a different implementation in which we have merged the
success and failure continuations into a single continuation that
takes an option as argument.
The advantage of the previous version is that the success
continuation does not change, meaning quick exit is possible
on success. The version below requires unraveling nested
continuations on success.
find : int tree -> ((int * (unit -> 'a)) option -> 'a) -> 'a
*)
fun find Empty k = k NONE
| find (Node(left, x, right)) k =
let
fun searchbelow () = find left (fn NONE => find right k
| success => k success)
in
if x mod 2 = 0 then k (SOME(x, searchbelow))
else searchbelow()
end
fun findfirst T = find T (fn NONE => NONE | SOME(x, _) => SOME x)
fun findall T = find T (fn NONE => [] | SOME(x, f) => x::f())
fun count T = find T (fn NONE => 0 | SOME(x, f) => 1 + f())
val SOME 4 = findfirst t1
val [4,2] = findall t1
val 2 = count t1
(************************************************************************)
(* findp : ('a -> bool) -> 'a tree
-> ('a -> (unit -> 'b) -> 'b) -> (unit -> 'b) -> 'b
REQUIRES: p is total.
{sc x fc', with x the first element found in
{ a pre-order traversal of T such
{ that p(x) == true and with fc' a
ENSURES: findp p T sc fc == { failure continuation that mimics
{ what function findp would have
{ done if p(x) == false.
{fc(), if T contains no element satisfying p.
*)
fun findp _ Empty _ fc = fc()
| findp p (Node(left, x, right)) sc fc =
let
(* fcnew is the fc' mentioned in the specs above. *)
fun fcnew () = findp p left sc (fn () => findp p right sc fc)
in
if p x then sc x fcnew else fcnew()
end
(* And here again are the functions for finding even integers in a tree: *)
fun even x = x mod 2 = 0
fun findfirst T = findp even T (fn x => fn fc => SOME(x)) (fn () => NONE)
fun findall T = findp even T (fn x => fn fc => x :: fc ()) (fn () => [])
fun count T = findp even T (fn x => fn fc => 1 + fc ()) (fn () => 0)
val SOME 4 = findfirst t1
val [4,2] = findall t1
val 2 = count t1
(************************************************************************)