\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)

\end{haskelllisting}