X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Pretty.hs;h=ef92c4dc955aeffe47dfb0877ad1b08f80abbae3;hb=8ebcc3ed9b394000ccd07ffeb541f791444dfbc2;hp=d23081e4f1ebcaec65ce960070d1579e8b477e35;hpb=700f7c01ff7a4f9b4fa1e5950ff0b30d62143516;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/Pretty.hs b/Pretty.hs index d23081e..ef92c4d 100644 --- a/Pretty.hs +++ b/Pretty.hs @@ -1,6 +1,3 @@ --- Needed for the Show deriving for Core types -{-# LANGUAGE StandaloneDeriving #-} - module Pretty (prettyShow) where @@ -8,9 +5,7 @@ import qualified Data.Map as Map import qualified Data.Foldable as Foldable import qualified List -import qualified Var import qualified CoreSyn -import qualified TypeRep import qualified Module import qualified HscTypes import Text.PrettyPrint.HughesPJClass @@ -24,6 +19,7 @@ import HsValueMap 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. @@ -100,16 +96,16 @@ instance Pretty SigUse where 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) @@ -122,16 +118,13 @@ instance Pretty FuncData where 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) = @@ -149,14 +142,9 @@ prettyBind (b, expr) = 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 = "" -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)