1 module Pretty (prettyShow) where
3 import Text.PrettyPrint.HughesPJClass
7 instance Pretty HsFunction where
8 pPrint (HsFunction name args res) =
9 text name <> char ' ' <> parens (hsep $ punctuate comma args') <> text " -> " <> res'
11 args' = map pPrint args
14 instance Pretty x => Pretty (HsValueMap x) where
15 pPrint (Tuple maps) = parens (hsep $ punctuate comma (map pPrint maps))
16 pPrint (Single s) = pPrint s
18 instance Pretty HsValueUse where
19 pPrint Port = char 'P'
20 pPrint (State n) = char 'C' <> int n
21 pPrint (HighOrder _ _) = text "Higher Order"
23 instance Pretty FlatFunction where
24 pPrint (FlatFunction args res apps conds) =
25 (text "Args: ") $$ nest 10 (pPrint args)
26 $+$ (text "Result: ") $$ nest 10 (pPrint res)
27 $+$ (text "Apps: ") $$ nest 10 (vcat (map pPrint apps))
28 $+$ (text "Conds: ") $$ nest 10 (pPrint conds)
30 instance Pretty FApp where
31 pPrint (FApp func args res) =
32 pPrint func <> text " : " <> pPrint args <> text " -> " <> pPrint res
34 instance Pretty SignalDef where
35 pPrint (SignalDef id) = pPrint id
37 instance Pretty SignalUse where
38 pPrint (SignalUse id) = pPrint id
40 instance Pretty CondDef where
41 pPrint _ = text "TODO"
43 instance Pretty VHDLSession where
44 pPrint (VHDLSession nameCount funcs) =
45 text "NameCount: " $$ nest 15 (int nameCount)
46 $+$ text "Functions: " $$ nest 15 (vcat (map ppfunc funcs))
48 ppfunc (hsfunc, (flatfunc)) =
49 pPrint hsfunc $+$ (text "Flattened: " $$ nest 15 (pPrint flatfunc))