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 {-
  28 instance Pretty FuncData where
  29   pPrint (FuncData flatfunc entity arch) =
  30     text "Flattened: " $$ nest 15 (ppffunc flatfunc)
  31     $+$ text "Entity" $$ nest 15 (ppent entity)
  32     $+$ pparch arch
  33     where
  34       ppffunc (Just f) = pPrint f
  35       ppffunc Nothing  = text "Nothing"
  36       ppent (Just e)   = pPrint e
  37       ppent Nothing    = text "Nothing"
  38       pparch Nothing = text "VHDL architecture not present"
  39       pparch (Just _) = text "VHDL architecture present"
  40 -}
  41
  42 instance Pretty Entity where
  43   pPrint (Entity id args res decl) =
  44     text "Entity: " $$ nest 10 (pPrint id)
  45     $+$ text "Args: " $$ nest 10 (pPrint args)
  46     $+$ text "Result: " $$ nest 10 (pPrint res)
  47     $+$ text "Declaration not shown"
  48
  49 instance (OutputableBndr b, Show b) => Pretty (CoreSyn.Bind b) where
  50   pPrint (CoreSyn.NonRec b expr) =
  51     text "NonRec: " $$ nest 10 (prettyBind (b, expr))
  52   pPrint (CoreSyn.Rec binds) =
  53     text "Rec: " $$ nest 10 (vcat $ map (prettyBind) binds)
  54
  55 instance (OutputableBndr b, Show b) => Pretty (CoreSyn.Expr b) where
  56   pPrint = text . show
  57
  58 instance Pretty AST.VHDLId where
  59   pPrint id = Ppr.ppr id
  60
  61 instance Pretty AST.VHDLName where
  62   pPrint name = Ppr.ppr name
  63
  64 prettyBind :: (Show b, Show e) => (b, e) -> Doc
  65 prettyBind (b, expr) =
  66   text b' <> text " = " <> text expr'
  67   where
  68     b' = show b
  69     expr' = show expr
  70
  71 instance (Pretty k, Pretty v) => Pretty (Map.Map k v) where
  72   pPrint =
  73     vcat . map ppentry . Map.toList
  74     where
  75       ppentry (k, v) =
  76         pPrint k <> text " : " $$ nest 15 (pPrint v)
  77
  78 -- Convenience method for turning an Outputable into a string
  79 pprString :: (Outputable x) => x -> String
  80 pprString = showSDoc . ppr
  81
  82 pprStringDebug :: (Outputable x) => x -> String
  83 pprStringDebug = showSDocDebug . ppr