-module Pretty (prettyShow) where
+module Pretty (prettyShow, pprString) where
+
import qualified Data.Map as Map
-import qualified Var
+import qualified Data.Foldable as Foldable
+import qualified List
+
import qualified CoreSyn
-import qualified TypeRep
import qualified Module
import qualified HscTypes
import Text.PrettyPrint.HughesPJClass
import FlattenTypes
import TranslatorTypes
import VHDLTypes
+import CoreShow
-- | A version of the default pPrintList method, which uses a custom function
-- f instead of pPrint to print elements.
pPrint (FlatFunction args res defs sigs) =
(text "Args: ") $$ nest 10 (pPrint args)
$+$ (text "Result: ") $$ nest 10 (pPrint res)
- $+$ (text "Defs: ") $$ nest 10 (pPrint defs)
- $+$ text "Signals: " $$ nest 10 (printList ppsig sigs)
+ $+$ (text "Defs: ") $$ nest 10 (ppdefs defs)
+ $+$ text "Signals: " $$ nest 10 (ppsigs sigs)
where
ppsig (id, info) = pPrint id <> pPrint info
+ ppdefs defs = vcat (map pPrint sorted)
+ where
+ -- Roughly sort the entries (inaccurate for Fapps)
+ sorted = List.sortBy (\a b -> compare (sigDefDst a) (sigDefDst b)) defs
+ sigDefDst (FApp _ _ dst) = head $ Foldable.toList dst
+ sigDefDst (CondDef _ _ _ dst) = dst
+ sigDefDst (UncondDef _ dst) = dst
+ ppsigs sigs = vcat (map pPrint sorted)
+ where
+ sorted = List.sortBy (\a b -> compare (fst a) (fst b)) sigs
+
instance Pretty SigDef where
pPrint (FApp func args res) =
instance Pretty SignalExpr where
pPrint (EqLit id lit) =
parens $ pPrint id <> text " = " <> text lit
- pPrint (Literal lit) =
- text lit
+ pPrint (Literal lit ty) =
+ text "(" <> text (show ty) <> text ") " <> text lit
pPrint (Eq a b) =
parens $ pPrint a <> text " = " <> pPrint b
instance Pretty SignalInfo where
- pPrint (SignalInfo name use ty) =
+ pPrint (SignalInfo name use ty hints) =
text ":" <> (pPrint use) <> (ppname name)
where
ppname Nothing = empty
pPrint (SigStateNew n) = text "SN:" <> int n
pPrint SigSubState = text "s"
-instance Pretty VHDLSession where
- pPrint (VHDLSession mod nameCount funcs) =
+instance Pretty TranslatorSession where
+ pPrint (TranslatorSession mod nameCount flatfuncs) =
text "Module: " $$ nest 15 (text modname)
$+$ text "NameCount: " $$ nest 15 (int nameCount)
- $+$ text "Functions: " $$ nest 15 (vcat (map ppfunc (Map.toList funcs)))
+ $+$ text "Functions: " $$ nest 15 (vcat (map ppfunc (Map.toList flatfuncs)))
where
- ppfunc (hsfunc, fdata) =
- pPrint hsfunc $+$ nest 5 (pPrint fdata)
+ ppfunc (hsfunc, flatfunc) =
+ pPrint hsfunc $+$ nest 5 (pPrint flatfunc)
modname = showSDoc $ Module.pprModule (HscTypes.cm_module mod)
-
+{-
instance Pretty FuncData where
pPrint (FuncData flatfunc entity arch) =
text "Flattened: " $$ nest 15 (ppffunc flatfunc)
ppent Nothing = text "Nothing"
pparch Nothing = text "VHDL architecture not present"
pparch (Just _) = text "VHDL architecture present"
+-}
instance Pretty Entity where
- pPrint (Entity id args res decl) =
+ pPrint (Entity id args res) =
text "Entity: " $$ nest 10 (pPrint id)
$+$ text "Args: " $$ nest 10 (pPrint args)
$+$ text "Result: " $$ nest 10 (pPrint res)
- $+$ ppdecl decl
- where
- ppdecl Nothing = text "VHDL entity not present"
- ppdecl (Just _) = text "VHDL entity present"
instance (OutputableBndr b, Show b) => Pretty (CoreSyn.Bind b) where
pPrint (CoreSyn.NonRec b expr) =
pPrint (CoreSyn.Rec binds) =
text "Rec: " $$ nest 10 (vcat $ map (prettyBind) binds)
+instance (OutputableBndr b, Show b) => Pretty (CoreSyn.Expr b) where
+ pPrint = text . show
+
instance Pretty AST.VHDLId where
pPrint id = ForSyDe.Backend.Ppr.ppr id
b' = show b
expr' = show expr
--- Derive Show for core expressions and binders, so we can see the actual
--- structure.
-deriving instance (Show b) => Show (CoreSyn.Expr b)
-deriving instance (Show b) => Show (CoreSyn.Bind b)
-
--- Implement dummy shows for Note and Type, so we can at least use show on
--- expressions.
-instance Show CoreSyn.Note where
- show n = "<note>"
-instance Show TypeRep.Type where
- show t = "_type:(" ++ (showSDoc $ ppr t) ++ ")"
+instance (Pretty k, Pretty v) => Pretty (Map.Map k v) where
+ pPrint =
+ vcat . map ppentry . Map.toList
+ where
+ ppentry (k, v) =
+ pPrint k <> text " : " $$ nest 15 (pPrint v)
+
+-- Convenience method for turning an Outputable into a string
+pprString :: (Outputable x) => x -> String
+pprString = showSDoc . ppr