> 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) -- mark a point where we want return to later
>    | Loop tag          -- return to a marked point
>        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 super-trees. 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