X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Pretty.hs;h=eb8378c6c1e1f03e640ac9ec575c5d89229851b0;hb=53b8d7183c05b1c1248875bf3a9394a0a7af5518;hp=cb1f9fc7c1256900cb0476f0c993f43c953fdc3d;hpb=6b3da07384004751bc64ef88429f452dfe1cee45;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/Pretty.hs b/Pretty.hs index cb1f9fc..eb8378c 100644 --- a/Pretty.hs +++ b/Pretty.hs @@ -1,12 +1,11 @@ module Pretty (prettyShow) where + 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 @@ -20,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. @@ -47,7 +47,7 @@ instance Pretty FlatFunction where (text "Args: ") $$ nest 10 (pPrint args) $+$ (text "Result: ") $$ nest 10 (pPrint res) $+$ (text "Defs: ") $$ nest 10 (ppdefs defs) - $+$ text "Signals: " $$ nest 10 (printList ppsig sigs) + $+$ text "Signals: " $$ nest 10 (ppsigs sigs) where ppsig (id, info) = pPrint id <> pPrint info ppdefs defs = vcat (map pPrint sorted) @@ -57,6 +57,9 @@ instance Pretty FlatFunction where 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 @@ -79,7 +82,7 @@ instance Pretty SignalExpr where 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 @@ -117,14 +120,17 @@ instance Pretty FuncData where pparch (Just _) = text "VHDL architecture present" instance Pretty Entity where - pPrint (Entity id args res decl) = + pPrint (Entity id args res decl pkg) = text "Entity: " $$ nest 10 (pPrint id) $+$ text "Args: " $$ nest 10 (pPrint args) $+$ text "Result: " $$ nest 10 (pPrint res) $+$ ppdecl decl + $+$ pppkg pkg where ppdecl Nothing = text "VHDL entity not present" ppdecl (Just _) = text "VHDL entity present" + pppkg Nothing = text "VHDL package not present" + pppkg (Just _) = text "VHDL package present" instance (OutputableBndr b, Show b) => Pretty (CoreSyn.Bind b) where pPrint (CoreSyn.NonRec b expr) = @@ -141,15 +147,3 @@ prettyBind (b, expr) = where 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) ++ ")"