cλash/CLasH/Utils/Pretty.hs

   1 module CLasH.Utils.Pretty (prettyShow, pprString, pprStringDebug) where
   2
   3
   4 import qualified Data.Map as Map
   5 import qualified Data.Foldable as Foldable
   6 import qualified List
   7
   8 import qualified CoreSyn
   9 import qualified Module
  10 import qualified HscTypes
  11 import Text.PrettyPrint.HughesPJClass
  12 import Outputable ( showSDoc, showSDocDebug, ppr, Outputable, OutputableBndr)
  13
  14 import qualified Language.VHDL.Ppr as Ppr
  15 import qualified Language.VHDL.AST as AST
  16 import qualified Language.VHDL.AST.Ppr
  17
  18 import CLasH.Translator.TranslatorTypes
  19 import CLasH.VHDL.VHDLTypes
  20 import CLasH.Utils.Core.CoreShow
  21
  22 -- | A version of the default pPrintList method, which uses a custom function
  23 --   f instead of pPrint to print elements.
  24 printList :: (a -> Doc) -> [a] -> Doc
  25 printList f = brackets . fsep . punctuate comma . map f
  26
  27 instance Pretty TranslatorSession where
  28   pPrint (TranslatorSession mod nameCount) =
  29     text "Module: " $$ nest 15 (text modname)
  30     $+$ text "NameCount: " $$ nest 15 (int nameCount)
  31     where
  32       ppfunc (hsfunc, flatfunc) =
  33         pPrint hsfunc $+$ nest 5 (pPrint flatfunc)
  34       modname = showSDoc $ Module.pprModule (HscTypes.cm_module mod)
  35 {-
  36 instance Pretty FuncData where
  37   pPrint (FuncData flatfunc entity arch) =
  38     text "Flattened: " $$ nest 15 (ppffunc flatfunc)
  39     $+$ text "Entity" $$ nest 15 (ppent entity)
  40     $+$ pparch arch
  41     where
  42       ppffunc (Just f) = pPrint f
  43       ppffunc Nothing  = text "Nothing"
  44       ppent (Just e)   = pPrint e
  45       ppent Nothing    = text "Nothing"
  46       pparch Nothing = text "VHDL architecture not present"
  47       pparch (Just _) = text "VHDL architecture present"
  48 -}
  49
  50 instance Pretty Entity where
  51   pPrint (Entity id args res) =
  52     text "Entity: " $$ nest 10 (pPrint id)
  53     $+$ text "Args: " $$ nest 10 (pPrint args)
  54     $+$ text "Result: " $$ nest 10 (pPrint res)
  55
  56 instance (OutputableBndr b, Show b) => Pretty (CoreSyn.Bind b) where
  57   pPrint (CoreSyn.NonRec b expr) =
  58     text "NonRec: " $$ nest 10 (prettyBind (b, expr))
  59   pPrint (CoreSyn.Rec binds) =
  60     text "Rec: " $$ nest 10 (vcat $ map (prettyBind) binds)
  61
  62 instance (OutputableBndr b, Show b) => Pretty (CoreSyn.Expr b) where
  63   pPrint = text . show
  64
  65 instance Pretty AST.VHDLId where
  66   pPrint id = Ppr.ppr id
  67
  68 instance Pretty AST.VHDLName where
  69   pPrint name = Ppr.ppr name
  70
  71 prettyBind :: (Show b, Show e) => (b, e) -> Doc
  72 prettyBind (b, expr) =
  73   text b' <> text " = " <> text expr'
  74   where
  75     b' = show b
  76     expr' = show expr
  77
  78 instance (Pretty k, Pretty v) => Pretty (Map.Map k v) where
  79   pPrint =
  80     vcat . map ppentry . Map.toList
  81     where
  82       ppentry (k, v) =
  83         pPrint k <> text " : " $$ nest 15 (pPrint v)
  84
  85 -- Convenience method for turning an Outputable into a string
  86 pprString :: (Outputable x) => x -> String
  87 pprString = showSDoc . ppr
  88
  89 pprStringDebug :: (Outputable x) => x -> String
  90 pprStringDebug = showSDocDebug . ppr