1 module CLasH.Utils.Pretty (prettyShow, pprString, pprStringDebug) where
4 import qualified Data.Map as Map
5 import Text.PrettyPrint.HughesPJClass
8 import qualified CoreSyn
9 import Outputable ( showSDoc, showSDocDebug, ppr, Outputable, OutputableBndr)
12 import qualified Language.VHDL.Ppr as Ppr
13 import qualified Language.VHDL.AST as AST
14 import qualified Language.VHDL.AST.Ppr
17 import CLasH.VHDL.VHDLTypes
18 import CLasH.Utils.Core.CoreShow
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
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)
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"
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"
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)
53 instance (OutputableBndr b, Show b) => Pretty (CoreSyn.Expr b) where
56 instance Pretty AST.VHDLId where
57 pPrint id = Ppr.ppr id
59 instance Pretty AST.VHDLName where
60 pPrint name = Ppr.ppr name
62 prettyBind :: (Show b, Show e) => (b, e) -> Doc
63 prettyBind (b, expr) =
64 text b' <> text " = " <> text expr'
69 instance (Pretty k, Pretty v) => Pretty (Map.Map k v) where
71 vcat . map ppentry . Map.toList
74 pPrint k <> text " : " $$ nest 15 (pPrint v)
76 -- Convenience method for turning an Outputable into a string
77 pprString :: (Outputable x) => x -> String
78 pprString = showSDoc . ppr
80 pprStringDebug :: (Outputable x) => x -> String
81 pprStringDebug = showSDocDebug . ppr