Fwd: [Haskell-cafe] Data.Tree.Zipper in the standard libraries
Don Stewart
dons at galois.com
Wed Jun 4 16:26:55 EDT 2008
igloo:
> On Wed, Jun 04, 2008 at 10:14:59AM -0700, Iavor Diatchki wrote:
> >
> > extra functionality? Especially, if---like in the case of
> > Zipper---the implementation can be more or less computed from an
> > existing definition in the package (I am referring to the fact that
> > the zipper is the derivative of Tree, for details you can look at
> > Conor's paper).
>
> I've just skimmed http://citeseer.ist.psu.edu/472190.html
> The Derivative of a Regular Type is its Type of One-Hole Contexts
> (Extended Abstract) (2001)
> Conor McBride
>
> Given the way people had been appealing to it, I has assumed that
> datastructure derivatives were some general thing, but it looks like
> they are actually just a way of describing a particular concrete
> implementation of zippers. I'm not even sure how well the theoretical
> connection applies to the variable branching degree of Data.Tree.
>
> Also, it's actually the derivative of Forest, not Tree, right? Which is
> why toTree can lose information, here the b and c trees:
> Data.Tree.Zipper> toTree (Loc (Node 'a' []) [Node 'b' []] [Node 'c' []] [])
> Node {rootLabel = 'a', subForest = []}
> This feels a little scary to me.
>
> Also, I think that technically it doesn't follow the paper, in that it
> stores the parents in the reverse order.
>
> That aside, the fact the datastructure is a derivative doesn't tell us
> that it is efficient (in fact, it is more efficient because it /isn't/ a
> straightforward derivative, but reverses the parent order as above),
> that we have implemented the "right" methods to operate on it, that we
> have chosen the "best" names for those methods, etc.
Quite so, the list derivative xmonad uses, for example, taken straight
from the Huet paper,
data Stack a = Stack { focus :: !a -- focused thing in this set
, up :: [a] -- clowns to the left
, down :: [a] } -- jokers to the right
deriving (Show, Read, Eq)
has an integration function,
integrate :: Stack a -> [a]
integrate (Stack x l r) = reverse l ++ x : r
and, e.g. moving around the structure,
focusUp (Stack t (l:ls) rs) = Stack l ls (t:rs)
focusUp (Stack t [] rs) = Stack x xs [] where (x:xs) = reverse (t:rs)
The structure of the type is derived, the implementation of the API
is able to make further decisions appropriate to the representation.
-- Don
More information about the Libraries
mailing list