Saturday, March 19, 2011

x86 disassembly in Haskell with hdis86

The first serious projects I coded in Haskell were compilers, code analyzers, and the like. I think it's a domain that really plays to the strengths of the language. So it makes sense that we'd want a top-notch disassembler library for Haskell.

udis86 is a fast, complete, flexible disassembler for x86 and x86-64 / AMD64. It provides a clean C API, which was no trouble to import using hsc2hs. But any C API is going to feel clunky next to high-level idiomatic Haskell code. So I built two additional layers of wrapping, to make something that will feel like a natural part of your next Haskell app.

You can download my library hdis86 from Hackage, or browse the source at GitHub. By default, a copy of udis86 is embedded in hdis86. If you already have udis86 installed as a shared library, you can link against that instead.

Getting started

Let's try it out. We'll feed in a ByteString of machine code, and pretty-print the result with groom.

$ ghci
λ> :m + Hdis86 Data.ByteString Text.Groom
λ> let code = pack [0xcc, 0xf0, 0xff, 0x44, 0x9e, 0x0f]
λ> Prelude.putStrLn . groom $ disassemble intel64 code
[Inst [] Iint3 [],
 Inst [Lock] Iinc
   [Mem
      (Memory{mSize = Bits32, mBase = Reg64 RSI, mIndex = Reg64 RBX,
              mScale = 4, mOffset = Immediate{iSize = Bits8, iValue = 15}})]]

If you're not familiar with x86, you might be surprised by the range of simple and complicated instructions. The first instruction is a humble int3, which executes a trap to a debugger. It takes no operands and has no prefixes.

The second instruction is an increment of a 32-bit memory region, whose address is computed by summing the value in register RSI, the value in register RBX times a scale factor of 4, and a fixed offset of 15. This instruction also has a lock prefix, which changes its concurrency semantics. Some prefixes have a direct meaning like this; others (like Rex) will change how the disassembler decodes operands.

We can also ask for Intel-style assembly syntax:

λ> let cfg = intel64 { cfgSyntax = SyntaxIntel }
λ> mapM_ (Prelude.putStrLn . mdAssembly) $ disassembleMetadata cfg code
int3 
lock inc dword [rsi+rbx*4+0xf]

Analyzing instructions

If we're just printing code, showing an Instruction is needlessly verbose. The real point of the Instruction type is machine-code analysis, with the help of Haskell's pattern matching capabilities.

Sometimes two fragments of code will differ only in which registers they use. Perhaps two compilers made different choices during register allocation. We'll write a program to detect this.

import Hdis86
import Text.Groom
import Control.Monad
import qualified Data.Map as M
import qualified Data.ByteString as B

When one code fragment uses register X the same way that another fragment uses register Y, we record a constraint X :-> Y:

data Constraint = Register :-> Register

We compare the two code fragments to produce a list of Constraints, or Nothing if they differ in ways beyond register selection. We'll use this helper function to check a list of Boolean conditions:

(==>) :: [Bool] -> a -> Maybe a
ps ==> x = guard (and ps) >> Just x

We compare operands pairwise. Register operands are easy:

operand :: Operand -> Operand -> Maybe [Constraint]
operand (Reg rx) (Reg ry) = Just [rx :-> ry]

For a memory operand, we need to check that the size, scale, and offset are equal:

-- size, base register, index register, scale, offset
operand (Mem (Memory sx bx ix kx ox)) (Mem (Memory sy by iy ky oy))
= [sx == sy, kx == ky, ox == oy] ==> [bx :-> by, ix :-> iy]

Immediate operands need a similar check for equality, but they don't produce any register constraints:

operand (Ptr   px) (Ptr   py) = [px == py] ==> []
operand (Imm ix) (Imm iy) = [ix == ix] ==> []
operand (Jump ix) (Jump iy) = [ix == iy] ==> []
operand (Const ix) (Const iy) = [ix == iy] ==> []

In all other cases, we have two different operand constructors, which means they don't match:

operand _ _ = Nothing

To check a pair of instructions, we check their prefixes and opcodes, then check operands pairwise:

inst :: Instruction -> Instruction -> Maybe [Constraint]
inst (Inst px ox rx) (Inst py oy ry) = do
guard $ and [px == py, ox == oy, length rx == length ry]
concat `fmap` zipWithM operand rx ry

Once we have a list of Constraints, we need to check it for consistency. If register X maps to Y in one place, it can't map to Z somewhere else:

unify :: [Constraint] -> Maybe (M.Map Register Register)
unify = foldM f M.empty where
f m (rx :-> ry) = case M.lookup rx m of
Nothing -> Just (M.insert rx ry m)
Just ry' -> [ry == ry'] ==> m

Now we put it all together, checking consistency in both directions:

regMap :: [Instruction] -> [Instruction] -> Maybe (M.Map Register Register)
regMap xs ys = do
cs <- concat `fmap` zipWithM inst xs ys
let swap (x :-> y) = (y :-> x)
_ <- unify $ map swap cs
unify cs

main :: IO ()
main = putStrLn . groom $ regMap (f prog_a) (f prog_b) where
f = disassemble intel64

We'll test these two code fragments:

prog_a, prog_b :: B.ByteString
prog_a = B.pack
[ 0x7e, 0x3a -- jle 0x3c
, 0x48, 0x89, 0xf5 -- mov rbp, rsi
, 0xbb, 1, 0, 0, 0 -- mov ebx, 0x1
, 0x48, 0x8b, 0x7d, 0x08 ] -- mov rdi, [rbp+0x8]
prog_b = B.pack
[ 0x7e, 0x3a -- jle 0x3c
, 0x48, 0x89, 0xf3 -- mov rbx, rsi
, 0xbd, 1, 0, 0, 0 -- mov ebp, 0x1
, 0x48, 0x8b, 0x7b, 0x08 ] -- mov rdi, [rbx+0x8]

And the result is:

$ runhaskell regmap.hs 
Just
  (fromList
     [(RegNone, RegNone), (Reg32 RBX, Reg32 RBP),
      (Reg64 RBP, Reg64 RBX), (Reg64 RSI, Reg64 RSI),
      (Reg64 RDI, Reg64 RDI)])

In reality, this analysis is grossly incomplete. Some instructions have implicit register operands, and some pairs of registers overlap, like EBX and RBX. And we have to understand contextual requirements. It's not okay to remap RAX to RBX if some calling code is expecting a return value in RAX.

The complexity of x86 (not to mention the halting problem) means that binary code analysis will never be easy. Hopefully hdis86 can be one of many useful tools in this domain. As always, suggestions or patches are welcome.

Sunday, January 9, 2011

Implementing breakpoints on x86 Linux

Debugger features such as breakpoints go well beyond the normal ways in which programs interact. How can one process force another process to pause at a particular line of code? We can bet that the debugger is using some special features of the CPU and/or operating system.

As I learned about implementing breakpoints, I was surprised to find that these interfaces, while arcane, are not actually very complex. In this article we'll implement a minimal but working breakpoints library in about 75 lines of C code. All of the code is shown here, and is also available on GitHub.

True, most of us will never write a debugger. But breakpoints are useful in many other tools: profilers, compatibility layers, security scanners, etc. If your program has to interact deeply with another process, without modifying its source code, breakpoints might just do the trick. And I think there's value in knowing what your debugger is really doing.

Our code will compile with gcc and will run on Linux machines with 32- or 64-bit x86 processors. I'll assume you're familiar with the basics of UNIX programming in C. We'll make heavy use of the ptrace system call, which I'll try to explain as we go. If you're looking for other reading about ptrace, I highly recommend this article and of course the manpage.

The API

Our little breakpoint library is named breakfast. Here's breakfast.h:

#ifndef _BREAKFAST_H
#define _BREAKFAST_H

#include <sys/types.h> /* for pid_t */

typedef void *target_addr_t;
struct breakpoint;

void breakfast_attach(pid_t pid);
target_addr_t breakfast_getip(pid_t pid);
struct breakpoint *breakfast_break(pid_t pid, target_addr_t addr);
int breakfast_run(pid_t pid, struct breakpoint *bp);

#endif

Before we dive into the implementation, we'll describe the API our library provides. breakfast is used by one process (the tracing process) to place breakpoints inside the code of another process (the target process). To establish this relationship, the tracing process calls breakfast_attach with the target's process ID. This also suspends execution of the target.

We use breakfast_getip to read the target's instruction pointer, which holds the address of the next instruction it will execute. Note that this is a pointer to machine code within the target's address space. Dereferencing the pointer within our tracing process would make little sense. The type alias target_addr_t reminds us of this fact.

We use breakfast_break to create a breakpoint at a specified address in the target's machine code. This function returns a pointer to a breakpoint structure, which has unspecified contents.

Calling breakfast_run lets the target run until it hits a breakpoint or it exits; breakfast_run returns 1 or 0 respectively. On the first invocation, we'll pass NULL for the argument bp. On subsequent calls, we're resuming from a breakpoint, and we must pass the corresponding breakpoint struct pointer. The breakfast_getip function will tell us the breakpoint's address, but it's our responsibility to map this to the correct breakpoint structure.

The trap instruction

We will implement a breakpoint by inserting a new CPU instruction into the target's memory at the breakpoint address. This instruction should suspend execution of the target and give control back to the OS.

There are many ways to return control to the OS, but we'd like to minimize disruption to the code we're hot-patching. x86 provides an instruction for exactly this purpose. It's named int3 and is encoded as the single byte 0xCC. When the CPU executes int3, it will stop what it's doing and jump to the interrupt 3 service routine, which is a piece of code chosen by the OS. On Linux, this routine will send the signal SIGTRAP to the current process.

Since we're placing int3 in the target's code, the target will receive a SIGTRAP. Under normal circumstances this would invoke the target's SIGTRAP handler, which usually kills the process. Instead we'd like the tracing process to intercept this signal and interpret it as the target hitting a breakpoint. We'll accomplish this through the magic of ptrace.

Let's start off breakfast.c with some includes:

#include <sys/ptrace.h>
#include <sys/reg.h>
#include <sys/wait.h>
#include <stdlib.h>
#include "breakfast.h"

Then we'll define our trap instruction:

#if defined(__i386)
#define REGISTER_IP EIP
#define TRAP_LEN 1
#define TRAP_INST 0xCC
#define TRAP_MASK 0xFFFFFF00

#elif defined(__x86_64)
#define REGISTER_IP RIP
#define TRAP_LEN 1
#define TRAP_INST 0xCC
#define TRAP_MASK 0xFFFFFFFFFFFFFF00

#else
#error Unsupported architecture
#endif

We use some GCC pre-defined macros to discover the machine architecture, and we define a few constants accordingly. REGISTER_IP expands to a constant from sys/reg.h which identifies the machine register holding the instruction pointer.

The trap instruction is stored as an integer TRAP_INST and its length in bytes is TRAP_LEN. These are the same on 32- and 64-bit x86. The trap instruction is a single byte, but we'll read and write the target's memory in increments of one machine word, meaning 32 or 64 bits. So we'll read 4 or 8 bytes of machine code, clear out the first byte with TRAP_MASK, and substitute 0xCC. Since x86 is a little-endian architecture, the first byte in memory is the least-significant byte of an integer machine word.

Invoking ptrace

All of the various ptrace requests are made through a single system call named ptrace. The first argument specifies the type of request and the meaning of any remaining arguments. The second argument is almost always the process ID of the target.

Before we can mess with the target process, we need to attach to it:

void breakfast_attach(pid_t pid) {
int status;
ptrace(PTRACE_ATTACH, pid);
waitpid(pid, &status, 0);
ptrace(PTRACE_SETOPTIONS, pid, 0, PTRACE_O_TRACEEXIT);
}

The PTRACE_ATTACH request will stop the target with SIGSTOP. We wait for the target to receive this signal. We also request to receive a notification when the target exits, which I'll explain below.

Note that ptrace and waitpid could fail in various ways. In a real application you'd want to check the return value and/or errno. For brevity I've omitted those checks in this article.

We use another ptrace request to get the value of the target's instruction pointer:

target_addr_t breakfast_getip(pid_t pid) {
long v = ptrace(PTRACE_PEEKUSER, pid, sizeof(long)*REGISTER_IP);
return (target_addr_t) (v - TRAP_LEN);
}

Since the target process is suspended, it's not running on any CPU, and its instruction pointer is not stored in a real CPU register. Instead, it's saved to a "user area" in kernel memory. We use the PTRACE_PEEKUSER request to read a machine word from this area at a specified byte offset. The constants in sys/regs.h give the order in which registers appear, so we simply multiply by sizeof(long).

After we hit a breakpoint, the saved IP points to the instruction after the trap instruction. When we resume execution, we'll go back and execute the original instruction that we overwrote with the trap. So we subtract TRAP_LEN to give the true address of the next instruction.

Creating breakpoints

We need to remember two things about a breakpoint: the address of the code we replaced, and the code which originally lived there.

struct breakpoint {
target_addr_t addr;
long orig_code;
};

To enable a breakpoint, we save the original code and insert our trap instruction:

static void enable(pid_t pid, struct breakpoint *bp) {
long orig = ptrace(PTRACE_PEEKTEXT, pid, bp->addr);
ptrace(PTRACE_POKETEXT, pid, bp->addr, (orig & TRAP_MASK) | TRAP_INST);
bp->orig_code = orig;
}

The PTRACE_PEEKTEXT request reads a machine word from the target's code address space, which is named "text" for historical reasons. PTRACE_POKETEXT writes to that space. On x86 Linux there's actually no difference between code and data spaces, so PTRACE_PEEKDATA and PTRACE_POKEDATA would work just as well.

Creating a breakpoint is straightforward:

struct breakpoint *breakfast_break(pid_t pid, target_addr_t addr) {
struct breakpoint *bp = malloc(sizeof(*bp));
bp->addr = addr;
enable(pid, bp);
return bp;
}

To disable a breakpoint we just write back the saved word:

static void disable(pid_t pid, struct breakpoint *bp) {
ptrace(PTRACE_POKETEXT, pid, bp->addr, bp->orig_code);
}

Running and stepping

Once we attach to the target, its execution stops. Here's how to resume it:

static int run(pid_t pid, int cmd);  /* defined momentarily */

int breakfast_run(pid_t pid, struct breakpoint *bp) {
if (bp) {
ptrace(PTRACE_POKEUSER, pid, sizeof(long)*REGISTER_IP, bp->addr);

disable(pid, bp);
if (!run(pid, PTRACE_SINGLESTEP))
return 0;
enable(pid, bp);
}
return run(pid, PTRACE_CONT);
}

We ask ptrace to continue execution — but if we're resuming from a breakpoint, we have to do some cleanup first. We rewind the instruction pointer so that the next instruction to execute is at the breakpoint. Then we disable the breakpoint and make the target execute just one instruction. Once we're past the breakpoint, we can re-enable it for next time. run returns 0 if the target exits, which theoretically could happen during our single-step.

The last piece of the puzzle is run:

static int run(pid_t pid, int cmd) {
int status, last_sig = 0, event;
while (1) {
ptrace(cmd, pid, 0, last_sig);
waitpid(pid, &status, 0);

if (WIFEXITED(status))
return 0;

if (WIFSTOPPED(status)) {
last_sig = WSTOPSIG(status);
if (last_sig == SIGTRAP) {
event = (status >> 16) & 0xffff;
return (event == PTRACE_EVENT_EXIT) ? 0 : 1;
}
}
}
}

cmd is either PTRACE_CONT or PTRACE_SINGLESTEP. In the latter case, the OS will set a control bit to make the CPU raise interrupt 3 after one instruction has completed.

ptrace will let the target run until it exits or receives a signal. We use the wait macros to see what happened. If the target exited, we simply return 0. If it received a signal, we check which one. Anything other than SIGTRAP should be delivered through to the target, which we accomplish by passing the signal number to the next ptrace call.

In the case of SIGTRAP, we check bits 16-31 of status for the value PTRACE_EVENT_EXIT, which indicates that the target is about to exit. Recall that we requested this notification by setting the option PTRACE_O_TRACEEXIT. You'd think (at least, I did) that checking WIFEXITED should be enough. But I ran into a problem where delivering a fatal signal to the target would make the tracing process loop forever. I fixed it by adding this extra check. I'm certainly no ptrace expert and I'd be interested to hear more about what's going on here.

Testing it

That's all for breakfast.c! Now let's write a small test.c.

#include <sys/types.h>
#include <signal.h>
#include <unistd.h>
#include <stdio.h>
#include "breakfast.h"

void child();
void parent(pid_t);

int main() {
pid_t pid;
if ((pid = fork()) == 0)
child();
else
parent(pid);
return 0;
}

We fork two separate processes, a parent and a child. The child will do some computation we hope to observe. Let's make it compute the famous factorial function:

int fact(int n) {
if (n <= 1)
return 1;
return n * fact(n-1);
}

void child() {
kill(getpid(), SIGSTOP);
printf("fact(5) = %d\n", fact(5));
}

The parent is going to invoke PTRACE_ATTACH and send the child SIGSTOP, but the child might finish executing before the parent gets a chance to call ptrace. So we make the child preemptively stop itself. This isn't a problem when attaching to a long-running process.

Actually, for this fork-and-trace-child pattern, we should be using PTRACE_TRACEME. But we implemented a minimal library, so we work with what we have.

The parent uses breakfast to place breakpoints in the child:

void parent(pid_t pid) {
struct breakpoint *fact_break, *last_break = NULL;
void *fact_ip = fact, *last_ip;
breakfast_attach(pid);
fact_break = breakfast_break(pid, fact_ip);
while (breakfast_run(pid, last_break)) {
last_ip = breakfast_getip(pid);
if (last_ip == fact_ip) {
printf("Break at fact()\n");
last_break = fact_break;
} else {
printf("Unknown trap at %p\n", last_ip);
last_break = NULL;
}
}
}

In principle we can use breakfast to trace any running process we own, even if we don't have its source code. But we still need a way to find interesting breakpoint addresses. Here it's as easy as we could want: the child forked from our process, so we get the address of its fact function just by taking the address of our fact function.

Let's try it out:

$ gcc -Wall -o test test.c breakfast.c
$ ./test
Break at fact()
Break at fact()
Break at fact()
Break at fact()
Break at fact()
fact(5) = 120

We can see the five calls to fact.

Inspecting the target

The ability to count function calls is already useful for performance profiling. But we'll usually want to get more information out of the stopped target. Let's see if we can read the arguments passed to fact. This part will be specific to 64-bit x86, though the idea generalizes.

Each architecture defines a C calling convention, which specifies how function arguments are passed, often using a combination of registers and stack slots. On 64-bit x86, the first argument is passed in the RDI register. You can verify this by running objdump -d test and looking at the disassembled code for fact.

So we'll modify test.c to read this register:

#include <sys/ptrace.h>
#include <sys/reg.h>
...
if (last_ip == fact_ip) {
int arg = ptrace(PTRACE_PEEKUSER, pid, sizeof(long)*RDI);
printf("Break at fact(%d)\n", arg);
...

And we get:

$ gcc -Wall -o test test.c breakfast.c
$ ./test
Break at fact(5)
Break at fact(4)
Break at fact(3)
Break at fact(2)
Break at fact(1)
fact(5) = 120

Cool!

Notes

This is my first non-trivial project using ptrace, and it's likely I got some details wrong. Please reply with corrections or advice and I'll update the code if necessary.

This code is available for download at GitHub. It's released under a BSD license, which imposes few restrictions. It's definitely not suitable as-is for production use, but feel free to take the code and build something more with it.

The x86 architecture has dedicated registers for setting breakpoints, subject to various limitations. We ignored this feature in favor of the more flexible software breakpoints. Hardware breakpoints can do some things this technique can't, such as breaking on reads from a particular memory address.

Saturday, December 4, 2010

Type-level Fix and generic folds

This article describes a fixpoint combinator for Haskell types, with some justification of why such a thing would be useful. It's meant to be an accessible introduction to material which is already covered elsewhere.

You'll need some basic Haskell knowledge, such as how to define and use polymorphic data types. And you might want to first study the value-level fix function. An excellent introduction can be found here.

This code is standard Haskell 98, except in the "GHC tricks" section.

Recursive types

Many useful data types are recursive:

data Natural = Zero | Succ Natural     -- natural numbers
data List a = Nil | Cons a (List a) -- lists
data Tree a = Node a [Tree a] -- rose trees

In each case, the type declared on the left-hand side of "=" is mentioned on the right-hand side. This is fine, but just for fun let's see if there's another way.

We can imagine a language with a keyword "self", which refers to the type being defined:

data Natural = Zero | Succ self
data List a = Nil | Cons a self
data Tree a = Node a [self]

Haskell doesn't have this keyword, so we'll make self into a type parameter:

data NaturalF self = Zero | Succ self
data ListF a self = Nil | Cons a self
data TreeF a self = Node a [self]

We've changed the names because these aren't the types we wanted. They're non-recursive and each has an extra parameter.

To build the recursive type Natural using the non-recursive NaturalF, we need to "tie the knot":

type Natural = NaturalF (NaturalF (NaturalF (NaturalF ...)))

i.e.

type Natural = NaturalF Natural

But this is disallowed:

foo.hs:3:0:
    Cycle in type synonym declarations:
      foo.hs:3:0-30: type Natural = NaturalF Natural

Since type defines a transparent synonym, this would generate an infinitely-large type-expression. Haskell disallows those. We need to hide the recursion behind a data constructor:

newtype Natural = MkNat (NaturalF Natural)

When we use this type, the "wrapper" constructor MkNat alternates with the constructors of NaturalF:

toNatural :: Integer -> Natural
toNatural 0 = MkNat Zero
toNatural n = MkNat . Succ $ toNatural (n-1)

Type-level Fix

So far this is just pointless complexity. We've replaced one type:

data Natural = Zero | Succ Natural

with two types:

data    NaturalF self = Zero | Succ self
newtype Natural = MkNat (NaturalF Natural)

Notice that the definition of Natural doesn't depend on the structure of natural numbers. Let's rename Natural to Fix and MkNat to In:

newtype Fix   = In (NaturalF Fix)

Then we'll abstract out NaturalF as a type parameter f:

newtype Fix f = In (f (Fix f))

Now Natural is just a synonym:

type Natural = Fix NaturalF

When we create values of type Natural, we still have "wrapper" constructors:

toNatural :: Integer -> Natural
toNatural 0 = In Zero
toNatural n = In . Succ $ toNatural (n-1)

Properties of Fix

Recall that the value-level fix function can be defined as

fix f = f (fix f)

This looks a lot like our type

newtype Fix f = In (f (Fix f))

The similarity is reflected at the type and kind levels:

GHCi> :t fix
fix :: (a -> a) -> a
GHCi> :k Fix
Fix :: (* -> *) -> *

fix is a function which takes another function. Fix is a type constructor which takes another type constructor.

The types Fix f and f (Fix f) are isomorphic, and we'll want to convert between them. In one direction we'll use the data constructor

In :: f (Fix f) -> Fix f

and the other direction is easily defined as

out :: Fix f -> f (Fix f)
out (In x) = x

Folding lists

So why bother writing types this way? Well, we usually don't. But factoring the recursion out of our data type enables us to factor the recursion out of our functions.

Consider taking the sum of a list:

sumF :: (Num a) => List a -> a
sumF (In Nil) = 0
sumF (In (Cons x xs)) = x + sumF xs

We traverse the structure with the combining function (+), making a recursive call at each recursive position of the data type. How can we capture this pattern?

If we're reducing a value of type List T to get a result of type R, then a value of type ListF T R represents a list node with the recursive call's result already in place. So we might look for a function like

cata :: (ListF a b -> b) -> List a -> b

If we had this, we could write

sumF :: (Num a) => List a -> a
sumF = cata f where
f Nil = 0
f (Cons x xs) = x + xs

The function f specifies one step of reduction, and the magical function cata handles the rest.

The recursion pattern captured by cata is very similar to foldr on the built-in list type. In fact, we can implement foldr with cata:

foldrF :: (a -> b -> b) -> b -> List a -> b
foldrF f z = cata g where
g Nil = z
g (Cons x xs) = f x xs

If foldr is good enough, then what's so special about cata? The answer is that cata actually has this very general type:

cata :: (Functor f) => (f a -> a) -> Fix f -> a

I'll give the one-line definition of cata later. Writing it yourself is a fun puzzle.

We can see that we'll need this instance:

instance Functor (ListF a) where
fmap _ Nil = Nil
fmap f (Cons x xs) = Cons x (f xs)

This fmap just takes a function and applies it to the self-typed field, if any. It's not recursive and has no relation to the [] instance of Functor, for which fmap = map.

Folding natural numbers

Let's put our generic cata to good use on another type. Every natural number is either zero, or the successor of another natural number:

data NaturalF self = Zero | Succ self
type Natural = Fix NaturalF

Again, fmap applies a function to each self-typed field:

instance Functor NaturalF where
fmap _ Zero = Zero
fmap f (Succ v) = Succ (f v)

We can then use cata to define conversion to Integer:

fromNatural :: Natural -> Integer
fromNatural = cata f where
f Zero = 0
f (Succ n) = 1 + n

as well as addition and multiplication:

add :: Natural -> Natural -> Natural
add n = cata f where
f Zero = n
f (Succ m) = In $ Succ m

mul :: Natural -> Natural -> Natural
mul n = cata f where
f Zero = In Zero
f (Succ m) = add n m

Testing it:

GHCi> fromNatural (add (toNatural 2) (mul (toNatural 3) (toNatural 5)))
17

Folding rose trees

Let's try one more structure, namely rose trees:

data TreeF a self = Node a [self]
type Tree a = Fix (TreeF a)

instance Functor (TreeF a) where
fmap f (Node v xs) = Node v (map f xs)

As before, fmap applies a function to each self-typed field. Since we have a list of these, we use map.

We define some traversals:

valuesF :: Tree a -> [a]
valuesF = cata (\(Node x xs) -> x : concat xs)

depthF :: Tree a -> Integer
depthF = cata (\(Node _ xs) -> 1 + maximum (0:xs))

and test them:

GHCi> let n x = In . Node x
GHCi> let t1 = n 'a' []
GHCi> valuesF t1
"a"
GHCi> depthF t1
1
GHCi> let t2 = n 'a' [n 'b' [], n 'c' [n 'd' []], n 'e' []]
GHCi> valuesF t2
"abcde"
GHCi> depthF t2
3

The definition of cata

As promised:

cata :: (Functor f) => (f a -> a) -> Fix f -> a
cata g = g . fmap (cata g) . out

Generic programming

We usually manipulate data because we care about its meaning. But some operations only depend on the data's structure. If we have some complex nested data value, we might want to pretty-print it, or serialize it with binary, or collect all the Strings buried within. These are concepts which apply to any data type you like. Shouldn't our code be similarly adaptable?

This idea is called generic programming. Implementations in Haskell include syb, uniplate, multiplate, instant-generics, GHC's built-in support, and many other efforts.

Each of these libraries demands certain information about each data type, and in return provides some generic operations. In this view, our above development of Fix constitutes a really tiny generics library. We require

  • that you write recursive types as Fix F, where F is non-recursive, and
  • that you provide instance Functor F.

In return, you get the single generic operation cata, which reduces a recursive structure to a "summary" value, by replacing each constructor with an arbitrary computation.

Our toy generics library is simple, but it doesn't actually save much work. Using Fix adds noise to the code, and our Functor instances aren't much shorter than a custom fold function for each type. Conversely, our uses of cata aren't much simpler than explicit recursive traversals.

Practicality aside, I think it's cool to define folding "once and for all". I'm interested to learn (from you!) what else can be done with Fix'd data or similar techniques.

For a non-trivial generics library built around similar ideas, see multirec and the accompanying paper.

Odds and ends

Nomenclature

Fix is sometimes named Mu, because the Greek letter μ is used to represent least fixed points.

cata stands for catamorphism.

Some of this stuff shows up in "Evolution of a Haskell Programmer". They build a factorial function using not only catamorphisms but also zygomorphisms and paramorphisms. Tell your friends!

In TaPL there's a discussion of equirecursive versus isorecursive type systems. Haskell is in the latter category. Fix f is isomorphic to, but not equivalent to, f (Fix f). The functions In and out provide the isomorphism. If we defined Fix using data instead of newtype, the isomorphism would fail because of the extra value In ⊥.

Isomorphisms

NaturalF is isomorphic to Maybe:

data NaturalF self = Zero    | Succ self
data Maybe a = Nothing | Just a

The Functor instances are also the same.

NaturalF is also isomorphic to ListF (), ignoring undefined values.

GHC tricks

While the above is standard Haskell, we can pull a few more tricks by using a couple of GHC extensions.

GHC could help us reduce boilerplate by deriving Functor instances.

With some GHC extensions, we can write Show for Fix:

instance (Show (f (Fix f))) => Show (Fix f) where
showsPrec p (In x) = showParen (p >= 11) (showString "In " . showsPrec 11 x)

Testing it:

GHCi> toNatural 3
In (Succ (In (Succ (In (Succ (In Zero))))))

This requires -XFlexibleContexts -XUndecidableInstances. The latter is required because f (Fix f) is a syntactically larger type than Fix f, so GHC can't convince itself that instance resolution will definitely terminate. For well-behaved arguments to Fix, it works out. We'll have something like

-- from above
instance (Show (f (Fix f)))
=> Show (Fix f)

-- from 'deriving (Show)' on NaturalF
instance (Show self)
=> Show (NaturalF self)

which instantiates to

instance (Show (NaturalF (Fix NaturalF)))
=> Show (Fix NaturalF)

instance (Show (Fix NaturalF))
=> Show (NaturalF (Fix NaturalF))

and GHC is clever enough to resolve the mutual recursion.

Remarkably, GHC can derive this instance with -XStandaloneDeriving:

deriving instance (Show (f (Fix f))) => Show (Fix f)

That's how I got the precedence-correct code above, via -ddump-deriv.