\subsection{Structure Analysis} This module contains a function which builds a hierarchical music object from a serial one. This is achieved by searching for long common infixes. A common infix is replaced by a single object at each occurence. This module proofs the sophistication of the separation between general arrangement of some objects as provided by the \module{Medium} and the special needs of music provided by the \module{Music}. It's possible to formulate these algorithms without the knowledge of Music and we can insert the type \code{Tag} to distinguish between media primitives and macro calls. The only drawback is that it is not possible to descend into controlled sub-structures, like Tempo and Trans. \begin{haskelllisting}
> module Medium.Controlled.ContextFreeGrammar
>    (T, Tag(..), TagMedium, fromMedium, toMedium) where
> import qualified Medium.Controlled.List as CtrlMediumList
> import qualified Medium.Controlled      as CtrlMedium
> import Medium.Plain.ContextFreeGrammar
>    (Tag(..), joinTag, replaceInfix,
>     whileM, smallestCycle, maximumCommonInfixMulti)
> import Medium (prim, serial1, parallel1)
> import Data.Maybe (fromJust)
> import qualified Haskore.General.Map as Map
> import Control.Monad.Trans.State (state, execState)
\end{haskelllisting} Condense all common infixes down to length 'thres'. The infixes are replaced by some marks using the constructor Left. They can be considered as macros or as non-terminals in a grammar. The normal primitives are preserved with constructor Right. We end up with a context-free grammar of the media. \begin{haskelllisting}
> type TagMedium key control prim = CtrlMediumList.T control (Tag key prim)
> type T key control prim = [(key, TagMedium key control prim)]
> fromMedium :: (Ord key, Ord control, Ord prim) =>
>    [key] -> Int -> CtrlMediumList.T control prim -> T key control prim
> fromMedium (key:keys) thres m =
>    let action = whileM (>= thres) (map (state . condense) keys)
>        -- action = sequence (take 1 (map (state . condense) keys))
>    in  reverse $ execState action [(key, fmap Prim m)]
> fromMedium _ _ _ =
>    error ("No key given."++
>       " Please provide an infinite or at least huge number of macro names.")
\end{haskelllisting} The inverse of \code{fromMedium}: Expand all macros. Cyclic macro references shouldn't be a problem if it is possible to resolve the dependencies. We manage the grammar in the dictionary \code{dict}. Now a naive way for expanding the macros is to recourse into each macro call manually using lookups to \code{dict}. This would imply that we need new memory for each expansion of the same macro. We have chosen a different approach: We map \code{dict} to a new dictionary \code{dict'} which contains the expanded versions of each Medium. For expansion we don't use repeated lookups to \code{dict} but we use only one lookup to \code{dict'} -- which contains the fully expanded version of the considered Medium. This method is rather the same as if you write Haskell values that invokes each other. The function \code{expand} computes the expansion for each key and the function \code{toMedium} computes the expansion of the first macro. Thus \code{toMedium} quite inverts \code{fromMedium}. \begin{haskelllisting}
> toMedium :: (Show key, Ord key, Ord prim) =>
>    T key control prim -> CtrlMediumList.T control prim
> toMedium = snd . head . expand
> expand :: (Show key, Ord key, Ord prim) =>
>    T key control prim -> [(key, CtrlMediumList.T control prim)]
> expand grammar =
>    let notFound key = error ("The non-terminal '" ++ show key ++ "' is unknown.")
>        dict  = Map.fromList grammar
>        dict' = Map.map (CtrlMedium.foldList expandSub serial1 parallel1
>                            CtrlMedium.control) dict
>        expandSub (Prim p) = prim p
>        expandSub (Call key) =
>           Map.findWithDefault dict' (notFound key) key
>        expandSub (CallMulti n key) =
>           serial1 (replicate n (Map.findWithDefault dict' (notFound key) key))
>    in  map (fromJust . Map.lookup (Map.mapWithKey (,) dict') . fst) grammar
\end{haskelllisting} Find the longest common infix over all parts of the music and replace it in all of them. \begin{haskelllisting}
> condense :: (Ord key, Ord control, Ord prim) =>
>       key
>    -> T key control prim
>    -> (Int, T key control prim)
> condense key x =
>    let getSerials = CtrlMedium.switchList
>           (const [])
>           (\xs -> xs : concatMap getSerials xs)
>           (\xs ->      concatMap getSerials xs)
>           (const getSerials)
>        infx = smallestCycle (maximumCommonInfixMulti length
>                   (concatMap (getSerials . snd) x))
>        absorbSingleton _ [m] = m
>        absorbSingleton collect ms = collect ms
>        replaceRec = CtrlMedium.foldList prim
>           (absorbSingleton serial1 . map joinTag . replaceInfix key infx)
>           (absorbSingleton parallel1)
>           (CtrlMedium.control)
>    in  (length infx, (key, serial1 infx) : map (\(k, ms) -> (k, replaceRec ms)) x)