X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Pretty.hs;h=75c73cc095e422f0b52456d75350853738cdfe18;hb=0de275199ba2f3a98339eefb7784e061a451c5f7;hp=679d7ae4261c1b24ff3f4b61b9f92cab3af2ed8c;hpb=14367b6b9fd0770a78e02fad425daa369df4bec6;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/Pretty.hs b/Pretty.hs index 679d7ae..75c73cc 100644 --- a/Pretty.hs +++ b/Pretty.hs @@ -1,6 +1,13 @@ +-- Needed for the Show deriving for Core types +{-# LANGUAGE StandaloneDeriving #-} + 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 @@ -43,10 +50,21 @@ instance Pretty FlatFunction where 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) = @@ -68,7 +86,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 @@ -106,14 +124,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) =