Yield, Continue

Roshan P. James and Amr Sabry show in "Yield: Mainstream Delimited Continuations" the interdefinability of yield-style generators and delimited continuations. Their encoding is at the same time simple and general, and even if the examples given in the paper are in Haskell, their translation into OCaml is straightforward. So much so that the result is essentially equivalent to ASAI Kenichi's OchaCaml (Edit: this claim of mine is certainly unsubstantiated and quite possibly wrong. See Zerny's comment).

James and Sabry generalize the mechanics of yield to a three-ported construct represented by the type (ι, ο, ρ) Yield:

This type encapsulates the communication between an iterator and its calling context, where the iterator yields values of type ο, receives inputs of type ι and terminates (or returns) with a final result of type ρ. This communication is mediated by a delimited context that can be activated with run which … marks the boundary of an iterator and delimits the action of yield. This communication is effected by a reified continuation given by a concrete data type with which the calling context can interact:

type ('i, 'o, 'r) iterator =
| Result of 'r
| Susp of 'o * ('i -> ('i, 'o, 'r) iterator)

In effect, run converts a monadic producer that uses yield into a CPS-transformed consumer that invokes the continuation given by an iterator. These patterns of interaction can be abstracted somewhat. The most general consumer is given by foreach:

let rec foreach (m : ('i, 'o, 'r) iterator) (f : 'o -> 'i) : 'r = match m with
| Susp (v, k) -> foreach (k (f v)) f
| Result r    -> r

It applies f to each value yielded by the iterator, feeding the result back to it. If the consumer is interested just in the yielded values and not in the result of the iteration, it can fold over them:

let rec fold (m : ('i, 'i, 'r) iterator) (f : 'i -> 'j -> 'j) (e : 'j) : 'j = match m with
| Susp (v, k) -> f v (fold (k v) f e)
| Result _    -> e

The essence of the iterator is given by an abstract signature:

module type YIELD = sig
  type ('i, 'o, 'r) yield
  val return : 'r -> ('i, 'o, 'r) yield
  val (>>=) : ('i, 'o, 'r) yield -> ('r -> ('i, 'o, 's) yield) -> ('i, 'o, 's) yield
  val yield : 'o -> ('i, 'o, 'i) yield
  val run : ('i, 'o, 'r) yield -> ('i, 'o, 'r) iterator
end

which gives a multi-parameter monad together with a pair of operations: yield, that returns a computation returning the yielded value (note the difference with return); and run, that captures the computation's context and reifies it into an iterator. The paper gives two possible implementations. The first "grabs" each invocation frame turning it directly into an iterator:

module FrameGrabbingYield : YIELD = struct
  type ('i, 'o, 'r) yield = ('i, 'o, 'r) iterator

  let return e = Result e

  let rec (>>=) m f = match m with
  | Result v    -> f v
  | Susp (v, k) -> Susp (v, fun x -> k x >>= f)

  let yield v = Susp (v, return)

  let run e = e
end

The seconds uses the CPS-encoded delimited continuation monad directly:

module CPSYield : YIELD = struct
  type ('i, 'o, 'r) yield =
    { cont : 'b . ('r -> ('i, 'o, 'b) iterator) -> ('i, 'o, 'b) iterator }

  let return x = { cont = fun k -> k x }

  let (>>=) m f = { cont = fun k -> m.cont (fun x -> (f x).cont k) }

  let yield v = { cont = fun k -> Susp (v, k) }

  let run e = e.cont (fun r -> Result r)
end

This is the standard CPS monad with answer type polymorphism, as given by Kiselyov. Now yield e is shift $ return . Susp e, and run e is equivalent to reset $ e >>= return . Result). This is sufficient but a bit bare-bones. Let's build from here:

module YieldT (Y : YIELD) = struct
  include Y

In the simplest case, generators simply yield successive values. The result of the computation is the value itself, that can be updated for the next cycle:

let rec repeat x = yield x >>= repeat
  let rec from i = yield i >>= fun j -> from (succ j)

Transformers are a bit more involved in that they must consume the iterator and yield new values, in effect delimiting the control of the iterator they consume. The simplest transformer is obviously map:

let rec map f y =
    let rec go = function
    | Result r    -> return r
    | Susp (v, k) -> yield (f v) >>= fun _ -> go (k v)
    in go (run y)

(Note that the monadic fmap would only act on the result and not on the generated values.) In this case, the result of the computation is the mapped value of the original iterator, that must be continued with the original value. Truncating an iterator is straightforward:

let rec take n y =
    let rec go n = function
    | Result r -> return (Some r)
    | Susp (_, _) when n = 0 -> return None
    | Susp (v, k) -> yield v >>= fun x -> go (n - 1) (k x)
    in go n (run y)

Combining two generators is also straightforward:

let zip y1 y2 =
    let rec go = function
    | Result r1, Result r2 -> return (r1, r2)
    | Susp (v1, k1), Susp (v2, k2) ->
      yield (v1, v2) >>= fun (x1, x2) -> go (k1 x1, k2 x2)
    | _ -> failwith "zip"
    in go (run y1, run y2)
end

(Iterators that return early must be dealt with in a somewhat arbitrary way.) With this it is relatively straightforward to use iterators:

let ex1 y =
  let module Y = YieldT( (val y : YIELD) ) in
  foreach Y.(run (take 10 (map succ (from 0)))) (Printf.printf "%d ")

And both implementations give equivalent results:

# let _ = ex1 (module FrameGrabbingYield : YIELD) ;;
1 2 3 4 5 6 7 8 9 10 - : 'a option = None
# let _ = ex1 (module CPSYield : YIELD) ;;
1 2 3 4 5 6 7 8 9 10 - : 'a option = None

Furthermore, Asai's examples (as given in this Reddit thread) can be easily duplicated as well:

module Tree (Y : YIELD) = struct
  type 'a tree = E | N of 'a tree * 'a * 'a tree

  open Y

  let rec depth_walk : 'a tree -> ('b, 'a, 'b tree) yield = function
  | N (l, n, r) ->
    depth_walk l >>= fun l' ->
    yield n      >>= fun n' ->
    depth_walk r >>= fun r' ->
    return (N (l', n', r'))
  | E -> return E

  let to_list t = fold (run (depth_walk t)) (fun x xs -> x :: xs) []

  let map f t = foreach (run (depth_walk t)) f

  let samefringe l r =
    let rec visit l r = match l, r with
    | Result _, Result _ -> true
    | Susp (a, ka), Susp (b, kb)
      when a = b ->
      visit (ka a) (kb b)
    | _ -> false
    in visit (run (depth_walk l)) (run (depth_walk r))

  let swap l r =
    let rec visit l r = match l, r with
    | Susp (a, ka), Susp (b, kb) -> visit (ka b) (kb a)
    | Result t1, Result t2 -> (t1, t2)
    | _ -> failwith "Unequal number of leaves"
    in visit (run (depth_walk l)) (run (depth_walk r))
end

Note that, except for the return type polymorphism, these versions are exactly the same. To prove that all works properly, here are a number of tests:

# module T = Tree(CPSYield) ;;
# open T ;;

# let t1 = N (N (E, 10, E), 20, N (E, 30, N (E, 40, E)))
and t2 = N (N (E, 10, N (E, 20, E)), 30, N (E, 40, E))
and t3 = N (N (E, 'a', N (E, 'b', E)), 'c', N (E, 'd', E))
;;

(I omit the output of these for clarity.)

# let _ = map succ t1 ;;
- : int T.tree = N (N (E, 11, E), 21, N (E, 31, N (E, 41, E)))
# let _ = to_list t1 ;;
- : int list = [10; 20; 30; 40]
# let _ = samefringe t1 t2 ;;
- : bool = true
# let _ = swap t1 t3 ;;
- : char T.tree * int T.tree =
(N (N (E, 'a', E), 'b', N (E, 'c', N (E, 'd', E))),
 N (N (E, 10, N (E, 20, E)), 30, N (E, 40, E)))

Note that in the last example the trees retain their respective shapes but interchange the values of their leaves.

Higher Order Fun

(the serious title of this post is "First-Class Modules Encode Type-Safe Reification of Types" or some such) After reading Kiselyov and Yallop's "First-class modules: hidden power and tantalizing promises", I wanted to understand how first-class modules relate to higher order types. They state that [f]irst-class modules — first-class functors — permit type constructor abstraction and polymorphism. They show one such use of constructor parametricity; I wanted to try another by encoding Haskell's canonical type class. Yes, I'm talking about Monad! Here it is:

module type MONAD = sig
  type 'a t
  val return : 'a -> 'a t
  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
  val fail : 'a t
end

The idea Oleg and Jeremy outline in "Generics for the OCaml masses" is to reify a type constructor α t as a module that wraps it together with its type parameter. Since a type constructor bound in a module type (in this case α MONAD.t) "cannot escape" for soundness' sake, it must be packed and unpacked. In effect this constitutes a higher-order existential type:

module type Monad = sig
  type a
  module Repr (M : MONAD) : sig
    val extract : a M.t
  end
end

Here it is crucial to see that the extraction is entirely dependent on the actual "interpretation" (the term originally used by Oleg and Jeremy) of the type given by its definition in the module parameterizing it. Uses of these packed representations of first-class constructors must ensure that the interpretation is consistent (something that in Haskell is assured by the use of a type class parameter, as in Monad m ⇒ …). The use of a type synonym restores polymorphism:

type 'a monad = (module Monad with type a = 'a)

In order to enable concrete instances of MONAD to "display their wares" so to speak, it is convenient to let them unpack these representations by themselves:

module Make (M : MONAD) = struct
  include M
  let run (type s) (mx : s monad) : s t =
    let module MX = (val mx : Monad with type a = s) in
    let module RX = MX.Repr(M) in
    RX.extract
end

Given a concrete constructor M.t, the σ monad is let-bound as a module, its representation under M is obtained and the corresponding value extracted. The same pattern recurs in the following genuinely higher-kinded functions, of which return is the simplest:

let return : 'a . 'a -> 'a monad =
  fun (type s) x ->
  (module struct
    type a = s
    module Repr (M : MONAD) = struct
      let extract = M.return x
    end
  end : Monad with type a = s)

Note that the result type is α monad, that is, a bona-fide module. Note also that the representation of value x under the monad M is exactly M.return x. So far, no complications. Now for something completely different:

let (>>=) : 'a . 'a monad -> ('a -> 'b monad) -> 'b monad =
  fun (type s) (type t) mx f ->
  (module struct
    type a = t
    type res = t
    module Repr (M : MONAD) = struct
      let extract =
        let module MX = (val mx : Monad with type a = s) in
        let module RX = MX.Repr(M) in
        M.(RX.extract >>= fun x ->
          let my = f x in
          let module MY = (val my : Monad with type a = res) in
          let module RY = MY.Repr(M) in
          RY.extract
        )
    end
  end : Monad with type a = t)

Given mx of module type Monad with type a = σ, its representation under M is extracted and monadically bound to f, which produces a value my of module type Monad with type a = τ, under exactly the same monadic interpretation given by M. A technicality: since the modules are abstract, they are generative (every name is fresh); hence to force the sharing of type τ between my and the result value I need to rebind it with a unique name res that can be shared across scopes. Now the next thing is a bit disturbing:

let fail : 'a . 'a monad =
  fun (type s) ->
  (module struct
    type a = s
    module Repr (M : MONAD) = struct
      let extract = M.fail
    end
  end : Monad with type a = s)

Really, is that a type-level function‽ Actually no, the syntax fun (type σ) → … binds the type σ locally in the body of the function (I'd find it clearer if the syntax were let type s = … in …, provided that no constructor escapes. Maybe in OCaml 3.14?) That's it! All that remains is to write monadic functions as if they were given the necessary type class:

let liftM f mx = mx >>= fun x -> return (f x)

let (>>) mx my = mx >>= fun _ -> my

let guard p = if p then return () else fail

(exercise: define the obvious join and verify that it really has type α monad monad → α monad. Bonus points: expand its definition). The usage with concrete instances of MONAD is surprisingly straightforward. For instance, given the standard:

module OptionM = Make(struct
  type 'a t = 'a option
  let return x = Some x
  let (>>=) mx f = match mx with None -> None | Some x -> f x
  let fail = None
end)

module ListM = Make(struct
  type 'a t = 'a list
  let return x = [x]
  let (>>=) mx f = List.(concat (map f mx))
  let fail = []
end)

The following deceptively simple code just works:

# let v = liftM succ (return 3) >>= fun x -> return (succ x);;
val v : int monad = <module>
# OptionM.run v ;;
- : int OptionM.t = Some 5
# ListM.run v ;;
- : int ListM.t = [5]

The monadic computation v exists completely independently of the computational interpretation under which it is evaluated! Note that this interpretation is selected at runtime, not at compile-time; if it weren't for the differing types, the relevant run could be a higher-order parameter to a generic function.

A Note on Geomancy

The Wikipedia article on Geomancy discusses the mathematical structure of the process. A passing mention to the fact that [d]ue to the mathematics of the chart, only figures that have an even number of points total can become Judges piqued my curiosity. I verified it by computer in an instant, but my curiosity was not satisfied: how can this fact be mathematically proven? It is rather simple, actually: the Judge has the parity of both Witnesses combined. The Witnesses in turn have the overall parity of the four Nieces. The Nieces have themselves the parity of the Mothers and the Daughters combined. But the Daughters have the overall parity of the Mothers, as the former are a rearrangement of the latter. Hence the parity of the Judge is twice the parity of the four Mothers combined, and thus even.

4×4-Bit Matrix Transposition

This is just a quick note to document a concrete variation of the technique for transposing a bit matrix via parallel bit operations in Hacker's Delight 7–3. In this case I needed to specialize it to 4×4 matrices represented by 16-bit integers. The underlying method is to recursively transpose each of the four 2x2-bit submatrices, and then block-transpose the 2x2-block matrix. Numbering the bits from 0 to A from LSB to MSB, the procedure looks like this:

3 2 1 0 7 6 5 4 B A 9 8 F E D C

→

6 2 4 0 7 3 5 1 E A C 8 F B D 9

→

C 8 4 0 D 9 5 1 E A 6 2 F B 7 3

In terms of 16-bit words, each step looks like this:

F E D C	B A 9 8	7 6 5 4	3 2 1 0
↓
F B D 9	E A C 8	7 3 5 1	6 2 4 0
↓
F B 7 3	E A 6 2	D 9 5 1	C 8 4 0

where I have highlighted the bits that remain fixed at each step. The technique amounts to swapping by xor-ing, as in x ^= y ^= x ^= y but bit by bit. The bits that remain fixed are masked out in order to avoid being swapped. In what follows, I use - for the zero bit and x for the one bit, and reserve hexadecimal digits as variable names for each bit position. I denote xor-ing bits i and j by juxtaposition as ij. Suppose the matrix to be transposed is stored in the 16-bit variable m. Using t as a temporary, the following operations carry out the transposition as shown:

m	F	E	D	C	B	A	9	8	7	6	5	4	3	2	1	0
m>>3	-	-	-	F	E	D	C	B	A	9	8	7	6	5	4	3
m^(m>>3)	F	E	D	FC	EB	DA	C9	B8	A7	96	85	74	63	52	41	30
0x0A0A	-	-	-	-	x	-	x	-	-	-	-	-	x	-	x	-
t=(m^(m>>3))&0x0A0A	-	-	-	-	EB	-	C9	-	-	-	-	-	63	-	41	-
t<<3	-	EB	-	C9	-	-	-	-	-	63	-	41	-	-	-	-
t^(t<<3)	-	EB	-	C9	EB	-	C9	-	-	63	-	41	63	-	41	-
m^=t^(t<<3)	F	B	D	9	E	A	C	8	7	3	5	1	6	2	4	0
m>>6	-	-	-	-	-	-	F	B	D	9	E	A	C	8	7	3
m^(m>>6)	F	B	D	9	E	A	FC	B8	D7	93	E5	A1	C6	82	74	30
0x00CC	-	-	-	-	-	-	-	-	x	x	-	-	x	x	-	-
t=(m^(m>>6))&0x00CC	-	-	-	-	-	-	-	-	D7	93	-	-	C6	82	-	-
t<<6	-	-	D7	93	-	-	C6	82	-	-	-	-	-	-	-	-
t^(t<<6)	-	-	D7	93	-	-	C6	82	D7	93	-	-	C6	82	-	-
m^=t^(t<<6)	F	B	7	3	E	A	6	2	D	9	5	1	C	8	4	0

Each xor-assignment to m completes the corresponding recursive step as outlined above. OCaml code for this is straightforward:

let btrans4x4 m =
  let t = (m lxor (m lsr 3)) land 0x0a0a in
  let m = m lxor t lxor (t lsl 3) in
  let t = (m lxor (m lsr 6)) land 0x00cc in
  m lxor t lxor (t lsl 6)