1 module CLasH.Utils.Pretty (prettyShow, pprString, pprStringDebug) where
4 import qualified Data.Map as Map
5 import qualified Data.Foldable as Foldable
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)
14 import qualified Language.VHDL.Ppr as Ppr
15 import qualified Language.VHDL.AST as AST
16 import qualified Language.VHDL.AST.Ppr
18 import CLasH.Translator.TranslatorTypes
19 import CLasH.VHDL.VHDLTypes
20 import CLasH.Utils.Core.CoreShow
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
27 instance Pretty TranslatorSession where
28 pPrint (TranslatorSession mod nameCount) =
29 text "Module: " $$ nest 15 (text modname)
30 $+$ text "NameCount: " $$ nest 15 (int nameCount)
32 ppfunc (hsfunc, flatfunc) =
33 pPrint hsfunc $+$ nest 5 (pPrint flatfunc)
34 modname = showSDoc $ Module.pprModule (HscTypes.cm_module mod)
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)
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"
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)
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)
62 instance (OutputableBndr b, Show b) => Pretty (CoreSyn.Expr b) where
65 instance Pretty AST.VHDLId where
66 pPrint id = Ppr.ppr id
68 instance Pretty AST.VHDLName where
69 pPrint name = Ppr.ppr name
71 prettyBind :: (Show b, Show e) => (b, e) -> Doc
72 prettyBind (b, expr) =
73 text b' <> text " = " <> text expr'
78 instance (Pretty k, Pretty v) => Pretty (Map.Map k v) where
80 vcat . map ppentry . Map.toList
83 pPrint k <> text " : " $$ nest 15 (pPrint v)
85 -- Convenience method for turning an Outputable into a string
86 pprString :: (Outputable x) => x -> String
87 pprString = showSDoc . ppr
89 pprStringDebug :: (Outputable x) => x -> String
90 pprStringDebug = showSDocDebug . ppr