% Extensible trees
% [Public domain]
\input birdstyle
\birdleftrule=1pt
\emergencystretch=1em
\def\hugebreak{\penalty-600\vskip 30pt plus 8pt minus 4pt\relax}
\newcount\chapno
\def\: #1.{\advance\chapno by 1\relax\hugebreak{\bf\S\the\chapno. #1. }}
\: Introduction. This module implements extensible compile-time trees.
Each node has a key, and the key of each node is of a different type. All
nodes have the same type for the value of the nodes, however. In addition,
the values of the nodes can depend on the value of the key.
>
>
> module Data.Extensible.Tree (
> ExtTreeData(..), ExtTree(..), traceExtTree, normalParent, makeExtRoot,
> ExtTreeNode(..), extAncestor, extAncestorAny
> ) where {
> import Control.Applicative;
> import Control.Monad;
> import Data.Typeable;
> import Language.Haskell.TH;
\: Utility Function.
> bool :: x -> x -> Bool -> x;
> bool x _ False = x;
> bool _ x True = x;
\: Implementation. The first thing is a datatype used for the class which
is defined below. Due to the GADT, it requires that the parent of a node
also has a parent; if it is the root node you set it to its own parent.
> data ExtTreeData v p c where {
> ExtRoot :: ExtTree v p p => ExtTreeData v p p;
> ExtNode :: ExtTree v pp p => (c -> (v, p)) -> ExtTreeData v p c;
> };
In this class, {\tt v} is the type of values in the tree, {\tt p} is the
parent of this node, and {\tt c} (for ``child'') is the current node. The
first method is used for traversing the tree from child to parent, and the
second method is used for traversing the tree from parent to child.
> class Typeable c => ExtTree v p c | c -> p, p -> v where {
> treeData :: ExtTreeData v p c;
> normalChild :: p -> c;
> };
For the root node, the instance should always be:
>
The next section contains a Template Haskell code to automatically create
the instance for the root node.
There is then a datatype which holds any key for a single node of a tree.
> data ExtTreeNode v where {
> ExtTreeNode :: ExtTree v p c => c -> ExtTreeNode v;
> };
But, notice that there can be multiple roots, and a root does not even
have to be exposed from a module which defines it, as long as there is
some node which eventually leads to it.
\: Functions.
{\tt traceExtTree}: Make a list of values from a single node to the root.
> traceExtTree :: ExtTree v p c => c -> [v];
> traceExtTree c = case treeData of {
> ExtRoot -> [];
> ExtNode f -> (\(v, p) -> v : traceExtTree p) $ f c;
> };
{\tt normalParent}: Given a value of a key for one node of the tree, get
the corresponding value of the type of key for the parent node.
> normalParent :: ExtTree v p c => c -> p;
> normalParent c = case treeData of {
> ExtRoot -> c;
> ExtNode f -> snd (f c);
> };
{\tt extAncestor}: Find the key of an ancestor of a specified node.
> extAncestor :: (Typeable p, ExtTree v pp c) => c -> Maybe p;
> extAncestor c = cast c <|> case treeData of {
> ExtRoot -> Nothing;
> ExtNode f -> extAncestor $ snd (f c);
> };
{\tt extAncestorAny}: Like the above function, but in a container storing
a key of any node.
> extAncestorAny :: Typeable p => ExtTreeNode v -> Maybe p;
> extAncestorAny (ExtTreeNode c) = extAncestor c;
Here is a Template Haskell macro to create the instance for the root node.
Due to some fault with parsing of Template Haskell quotations, this won't
compile unless both {\tt FlexibleInstances} and {\tt UndecidableInstances}
extensions are enabled in this module. (You do not need to enable those
extensions in the module using this function.)
> makeExtRoot :: Q Type -> Q Type -> Q [Dec];
> makeExtRoot = liftM2 $ \v p -> [InstanceD [] (
> AppT (AppT (AppT (ConT ''ExtTree) v) p) p
> ) [
> ValD (VarP 'treeData) (NormalB $ ConE 'ExtRoot) [],
> ValD (VarP 'normalChild) (NormalB $ VarE 'id) []
> ]];
% End of document (final "}" is suppressed from printout)
\medskip\centerline{The End}
\toks0={{
> }