clash/CLasH/Utils/Pretty.hs

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