ShowHyloRep.hs

-- | Implementation of printing of the internal representation of hylomorphisms. 
-- Currently intended only for debugging.
module HFusion.Internal.ShowHyloRep(showHyloRep) where

import HFusion.Internal.Inline()
import HFusion.Internal.HyloFace
import HFusion.Internal.HsPretty
import Control.Arrow((***))
import Data.List(intersperse)

showHyloRep :: (ShowRep a, ShowRep ca, CHylo hylo) => hylo a ca -> String
showHyloRep = render . showHyloRepDoc

showHyloRepDoc :: (ShowRep a, ShowRep ca, CHylo hylo) => hylo a ca -> Doc
showHyloRepDoc h = vcat
                 [ text "Algebra:" <+> vcat (map showAcomponentRep (getAlgebra h))
                 , text "Nat. Trans.:" <+> vcat (map showDoc$ getEta h)
                 , text "Functor:" <+> vcat (map (text . show)$ getFunctor h)
                 , text "Coalgebra:" <+> showCoalgebraRep (getCoalgebra h)
                 , text "Context:" <+> (text$ show$ getContext h)
                 ]
                   

showAcomponentRep :: ShowRep a => Acomponent a -> Doc
showAcomponentRep a = (text$ show$ getVars a) <+> text "->" <+> showTermWrapperRep (unwrapA a)

showTermWrapperRep :: ShowRep a => TermWrapper a -> Doc
showTermWrapperRep (TWsimple a) = showRep a
showTermWrapperRep (TWacomp a) = showAcomponentRep a
showTermWrapperRep TWbottom = text "_|_"
showTermWrapperRep (TWeta tw e) = sep [ parens (showTermWrapperRep tw) , char '.' <+> showDoc e ]
showTermWrapperRep (TWcase t0 ps tws) = text "case" <+> showDoc t0 <+> text "of"
                                        $$ nest 2 (vcat [ showDoc p <+> text "->" <+> showTermWrapperRep tw | (p,tw)<-zip ps tws ])

showCoalgebraRep :: ShowRep ca => Coalgebra ca -> Doc
showCoalgebraRep (bvs,ts,ca) = text (show bvs) <+> text "->" 
                             <+> (text "case" <+> showDoc (ttuple ts) <+> text "of"
                                  $$ nest 2 (showRep ca))


class ShowRep a where
  showRep :: a -> Doc

instance ShowRep Term where
  showRep = showDoc

instance ShowRep InF where
  showRep (InF (c,ts)) = parens$ text c <> char  ',' <+> showDoc (ttuple ts)

instance ShowRep a => ShowRep (Acomponent a) where
  showRep = showAcomponentRep

instance ShowRep Tau where
  showRep (Tauphi tw) = showTermWrapperRep tw
  showRep (TauinF tw) = showTermWrapperRep tw
  showRep (Tautau tw) = showTermWrapperRep tw

instance ShowRep a => ShowRep (TauTerm a) where
  showRep (Tausimple t) = showRep t
  showRep (Taupair t tauterm) = parens$ showRep t <> char ',' <+> showRep tauterm
  showRep (Taucons c ts phi eta) = text ("Taucons_"++c)
                        <+> parens (parens (showRep phi) <> char '$' 
                                    <+> parens (showDoc eta) 
                                    <+> parens (cat (uncurry (++)$ (id *** map (char ','<+>))$ splitAt 1$ 
                                                map showRep ts)))
  showRep (Taucata ft tauterm) = showDoc (Tlamb (Bvar$ Vuserdef "@u")$ ft (Tvar$ Vuserdef "@u")) <+> char '.' <+> showRep tauterm

instance ShowRep OutF where
  showRep = showDoc

instance ShowRep Psi where
  showRep = showDoc

instance ShowRep Sigma where
  showRep (Sigma (csm,tts,pss,_sigma_args)) = 
           vcat$ [ parens (hcat$ intersperse (char ',')  ps) <+> text "->" <+> showTuple t 
                  | (t,ps)<-zip (concat$ zipWith replicate csm tts) (map (map (text . show)) pss) 
                 ]


{-
> -- | Representation for alternatives of coalgegbras in sigma(beta_1,...,beta_n) form
> -- where beta_1,...,beta_n are coalgebras of mutual hylomorphism. Each coalgebra 
> -- component i is applied only to the i^th argument of the transfomer result.

> newtype Sigma = Sigma ([Int],[[TupleTerm]],[[PatternS]],[Maybe (Int,[Acomponent InF],[Etai],WrappedCA,Int->Term->Term)])

> -- ^ In Sigma (casemap,ts,[ps_1,...,ps_n],[psi_1,...,psi_n]), 
> --     * ts are the terms returned by sigma.
> --     * ps_i are the patterns corresponding to each alternative of the hylomorphism,
> --       it contains one pattern for each recursive argument.
> --     * psi_i is the coalgebra given as argument to sigma in position i.
> --       Each coalgebra psi_i is really a mutual hylomorphism, that's why
> --       it is a list. When inlining, the coalgebra and the natural transformations of this
> --       mutual hylo are extracted. Each component of the mutual hylo has an algebra, a 
> --       natural transformation, a coalgebra and a function fapp returning an application 
> --       of the hylo to its input term. The algebra is stored, because it may contain part
> --       of the natural transformation, but it is also used during inlining to match cases
> --       of its hylo with patterns of sigma.
> --     * casemap tells how the alternatives of sigma connects with the alternatives of the
> --       hylomorphism. Each sigma tuple must be replicated the amount specified in the
> --       corresponding position of casemap.

-}