> module Haskore.General.LoopTreeTagged where
> import qualified Haskore.General.TagDictionary as Dict
> data T tag a =
> Branch a [T tag a]
> | Tag tag (T tag a)
> | Loop tag
> deriving (Eq, Show)
The tag for \code{Tag} must be unique,
but multiple use in \code{Loop} is allowed.
Vice versa tags for \code{Loop} must be defined by a \code{Tag} constructor.
> example0 :: T Int Char
> example0 = Tag 0 (Branch 'a' [Tag 1 (Branch 'b' [Loop 1]), Loop 0])
\begin{comment}
Eq and Show
instance (Eq tag, Eq a) => Eq (T tag a) where
Branch x xSub == Branch y ySub = x == y && xSub == ySub
Tag xTag xSub == Tag yTag ySub = xTag == yTag && xSub == ySub
Loop xTag == Loop yTag = xTag == yTag
_ == _ = False
instance (Show tag, Show a) => Show (T tag a) where
show (Const x) = "(Const " ++ show x ++ ")"
show (Add e1 e2) = "(Add " ++ show e1 ++ " " ++ show e2 ++ ")"
show (Tag i e) = "(Tag " ++ show i ++ " " ++ show e ++ ")"
show (Loop i) = "(Loop " ++ show i ++ ")"
\end{comment}
MapE:
> mapE :: (a -> b) -> T tag a -> T tag b
> mapE f =
> let aux branch =
> case branch of
> Branch x sub -> Branch (f x) (map aux sub)
> Tag tag sub -> Tag tag (aux sub)
> Loop tag -> Loop tag
> in aux
> instance Functor (T tag) where
> fmap = mapE
Replace all loops by the corresponding supertrees.
Internally the compiler should translate this into loops, again,
but this cannot be observed by the Haskell code anymore.
> unwind :: (Ord tag) => T tag a -> T tag a
> unwind =
> let aux tags branch =
> case branch of
> Branch x sub -> Branch x (map (aux tags) sub)
> Tag tag sub -> let e' = aux (Dict.insert tag e' tags) sub
> in e'
> Loop tag -> Dict.lookup tags tag
> in aux Dict.empty