Zippers

In an imperative language, we might see something like:

1abstract class Iterator[A]  {
2  def next(): A
3  def hasNext(): Boolean
4}

This iterator[A] is not a persistent interface (i.e. next() irreversibly loses information at the original point). Also, we can't go backwards.

A zipper is a functional, immutable equivalent of an iterator, which is unique for every datastructure. A zipper for a list would be:

1type LiztZ a = ([a], [a])
2
3toListZ :: [a] -> LiztZ a -- O(1)
4toLiztZ xs = ([], xs)
5
6fromListz :: ListZ a -> [a] -- O(n)
7fromListZ (sx, xs) = foldl (flip (:)) xs sx
8
9rightList :: ListZ a -> Maybe (ListZ a) -- O(1)
10rightList (_, []) = Nothing
11rightList (sx, x:xs) = Just (x:sx, xs)
12
13leftList :: ListZ a -> Maybe (ListZ a) -- O(1)
14leftList ([], _) = Nothing
15leftList (x:sx, xs) = Just (sx, x:xs)

Let's define a simple instruction set. On it, we can do peephole optimizations:

1type Reg = Int
2data Instr = Mov Reg Reg | Push Reg | Pop Reg deriving (Eq)
3
4peephole :: [Instr] -> [Instr] -- O(n^2 + mn)
5peephole is
6  | is == is' = is'
7  | otherwise = peephole is'
8  where peep :: [Instr] -> [Instr]
9        peep (Push r1 : Pop r2 : is) = peep (Mov r2 r1 : is)
10        peep (Mov r1 r2 : is) | r1 == r2 = peep is
11        peep (i : is) = i : peep is
12        peep [] = []
13
14        is' = peep is

The peephole function can be optimization with a zipper:

1peephole' :: [Instr] -> [Instr] -- O(n)
2peephole' = peep' []
3  where peep' :: [Instr] -> [Instr] -> [Instr]
4        peep' si (Push r1 : Pop r2 : is) = -- O(1) as length is' <= 1
5          let (is', si') = slideback 1 si in peep' si' (is' ++ Mov r2 r1 : is)
6        peep' si (Mov r1 r2 : is)
7          | r1 == r2 = let (is', si') = slideback 1 si in peep' si' (is' ++ is)
8        peep' si (i : is) = peep' (i : si) is
9        peep' si [] = reverse si
10
11        slideback :: Int -> [Instr] -> ([Instr], [Instr])
12        slideback n si = let (si1, si2) = splitAt n si in (reverse si1, si2)

We got a much better complexity. Let's try using zippers with bushes:

1data Bush a = Leaf a | Fork (Bush a) (Bush a)
2type BushZ = a (Bush a, [Either (Bush a) (Bush a)])
3
4toBushZ :: Bush a -> BushZ a
5toBushZ t = (t, [])
6
7downLeft :: BushZ a -> Maybe (BushZ a)
8downLeft (Leaf _, _) = Nothing
9downLeft (fork lt rt, ts) = (lt, Right rt : ts)
10
11downRight :: BushZ a -> Maybe (BushZ a)
12downRight (Leaf _, _) = Nothing
13downRight (fork lt rt, ts) = (rt, Left lt : ts)
14
15right :: BushZ a -> Maybe (BushZ a)
16right (lt, RIght rt : ts) = Kist (rt, Left lt L ts)
17right _ = Nothing
18
19left :: BushZ a -> Maybe (BushZ a)
20left (rt, Left lt : ts) = Just (lt, Right rt : ts)
21left _ = Nothing
22
23up :: BushZ a -> Maybe (BushZ a)
24up (rt, Left lt : ts) = Just (Fork lt rt, ts)
25up (lt, Right rt : ts) = Just (Fork lt rt, ts)
26up _ = Nothing
27
28fromBushZ :: BushZ a -> Bush a
29fromBushZ z@(t, _) = case up z of
30  Nothing -> t
31  Just z' -> fromBushZ z'

Back to Home

Table of Contents

Zippers