Pretty.hs

   1 module Pretty (prettyShow) where
   2
   3 import Text.PrettyPrint.HughesPJClass
   4 import Flatten
   5
   6 instance Pretty HsFunction where
   7   pPrint (HsFunction name args res) =
   8     text name <> char ' ' <> parens (hsep $ punctuate comma args') <> text " -> " <> res'
   9     where
  10       args' = map pPrint args
  11       res'  = pPrint res
  12
  13 instance Pretty x => Pretty (HsValueMap x) where
  14   pPrint (Tuple maps) = parens (hsep $ punctuate comma (map pPrint maps))
  15   pPrint (Single s)   = pPrint s
  16
  17 instance Pretty HsValueUse where
  18   pPrint Port            = char 'P'
  19   pPrint (State n)       = char 'C' <> int n
  20   pPrint (HighOrder _ _) = text "Higher Order"
  21
  22 instance Pretty FlatFunction where
  23   pPrint (FlatFunction args res apps conds) =
  24     (text "Args: ") $$ nest 10 (pPrint args)
  25     $+$ (text "Result: ") $$ nest 10 (pPrint res)
  26     $+$ (text "Apps: ") $$ nest 10 (vcat (map pPrint apps))
  27     $+$ (text "Conds: ") $$ nest 10 (pPrint conds)
  28
  29 instance Pretty FApp where
  30   pPrint (FApp func args res) =
  31     pPrint func <> text " : " <> pPrint args <> text " -> " <> pPrint res
  32
  33 instance Pretty SignalDef where
  34   pPrint (SignalDef id) = pPrint id
  35
  36 instance Pretty SignalUse where
  37   pPrint (SignalUse id) = pPrint id
  38
  39 instance Pretty CondDef where
  40   pPrint _ = text "TODO"