X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Pretty.hs;h=3c6e9fcf5225025fd16a4d8ea00a9d4d73aac33f;hb=4fb701e41729143a897d43cd8a9c0217b8b3f68a;hp=ff84a56cc61c5f39bbedec587584f0f0755026da;hpb=2f1cf3a17e4d206c01031b3117779e99d21a4dce;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/Pretty.hs b/Pretty.hs index ff84a56..3c6e9fc 100644 --- a/Pretty.hs +++ b/Pretty.hs @@ -1,9 +1,14 @@ module Pretty (prettyShow) where +import qualified Data.Map as Map import qualified CoreSyn +import qualified Module +import qualified HscTypes import Text.PrettyPrint.HughesPJClass import Outputable ( showSDoc, ppr, Outputable, OutputableBndr) -import Flatten + +import HsValueMap +import FlattenTypes import TranslatorTypes instance Pretty HsFunction where @@ -22,33 +27,39 @@ instance Pretty HsValueUse where pPrint (State n) = char 'C' <> int n pPrint (HighOrder _ _) = text "Higher Order" -instance Pretty FlatFunction where - pPrint (FlatFunction args res apps conds) = +instance Pretty id => Pretty (FlatFunction' id) where + pPrint (FlatFunction args res apps conds sigs) = (text "Args: ") $$ nest 10 (pPrint args) $+$ (text "Result: ") $$ nest 10 (pPrint res) $+$ (text "Apps: ") $$ nest 10 (vcat (map pPrint apps)) $+$ (text "Conds: ") $$ nest 10 (pPrint conds) + $+$ text "Signals: " $$ nest 10 (pPrint sigs) -instance Pretty FApp where +instance Pretty id => Pretty (FApp id) where pPrint (FApp func args res) = pPrint func <> text " : " <> pPrint args <> text " -> " <> pPrint res -instance Pretty SignalDef where - pPrint (SignalDef id) = pPrint id +instance Pretty id => Pretty (CondDef id) where + pPrint _ = text "TODO" -instance Pretty SignalUse where - pPrint (SignalUse id) = pPrint id +instance Pretty id => Pretty (Signal id) where + pPrint (Signal id) = pPrint id -instance Pretty CondDef where - pPrint _ = text "TODO" +instance Pretty NamedSignal where + pPrint (NamedSignal name) = pPrint name instance Pretty VHDLSession where - pPrint (VHDLSession nameCount funcs) = - text "NameCount: " $$ nest 15 (int nameCount) - $+$ text "Functions: " $$ nest 15 (vcat (map ppfunc funcs)) + pPrint (VHDLSession mod nameCount funcs) = + text "Module: " $$ nest 15 (text modname) + $+$ text "NameCount: " $$ nest 15 (int nameCount) + $+$ text "Functions: " $$ nest 15 (vcat (map ppfunc (Map.toList funcs))) where - ppfunc (hsfunc, (flatfunc)) = - pPrint hsfunc $+$ (text "Flattened: " $$ nest 15 (pPrint flatfunc)) + ppfunc (hsfunc, (FuncData flatfunc)) = + pPrint hsfunc $+$ (text "Flattened: " $$ nest 15 (ppffunc flatfunc)) + ppffunc (Just (Left f)) = pPrint f + ppffunc (Just (Right f)) = pPrint f + ppffunc Nothing = text "Nothing" + modname = showSDoc $ Module.pprModule (HscTypes.cm_module mod) instance (OutputableBndr b) => Pretty (CoreSyn.Bind b) where pPrint (CoreSyn.NonRec b expr) =