Pretty.hs

   1 module Pretty (prettyShow) where
   2
   3 import Text.PrettyPrint.HughesPJClass
   4 import Flatten
   5 import TranslatorTypes
   6
   7 instance Pretty HsFunction where
   8   pPrint (HsFunction name args res) =
   9     text name <> char ' ' <> parens (hsep $ punctuate comma args') <> text " -> " <> res'
  10     where
  11       args' = map pPrint args
  12       res'  = pPrint res
  13
  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
  17
  18 instance Pretty HsValueUse where
  19   pPrint Port            = char 'P'
  20   pPrint (State n)       = char 'C' <> int n
  21   pPrint (HighOrder _ _) = text "Higher Order"
  22
  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)
  29
  30 instance Pretty FApp where
  31   pPrint (FApp func args res) =
  32     pPrint func <> text " : " <> pPrint args <> text " -> " <> pPrint res
  33
  34 instance Pretty SignalDef where
  35   pPrint (SignalDef id) = pPrint id
  36
  37 instance Pretty SignalUse where
  38   pPrint (SignalUse id) = pPrint id
  39
  40 instance Pretty CondDef where
  41   pPrint _ = text "TODO"
  42
  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))
  47     where
  48       ppfunc (hsfunc, (flatfunc)) =
  49         pPrint hsfunc $+$ (text "Flattened: " $$ nest 15 (pPrint flatfunc))