X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Pretty.hs;h=d23081e4f1ebcaec65ce960070d1579e8b477e35;hb=ee868ded42dccf7679190420e8d348aa8d727b98;hp=679d7ae4261c1b24ff3f4b61b9f92cab3af2ed8c;hpb=14367b6b9fd0770a78e02fad425daa369df4bec6;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/Pretty.hs b/Pretty.hs index 679d7ae..d23081e 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