X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Pretty.hs;h=78876b30127b835e314dfcf4493edf77d69d6d01;hb=472a96af53dd624ba526ab86f250ac8f88a152ef;hp=3c6e9fcf5225025fd16a4d8ea00a9d4d73aac33f;hpb=4fb701e41729143a897d43cd8a9c0217b8b3f68a;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/Pretty.hs b/Pretty.hs index 3c6e9fc..78876b3 100644 --- a/Pretty.hs +++ b/Pretty.hs @@ -7,9 +7,13 @@ import qualified HscTypes import Text.PrettyPrint.HughesPJClass import Outputable ( showSDoc, ppr, Outputable, OutputableBndr) +import qualified ForSyDe.Backend.Ppr +import qualified ForSyDe.Backend.VHDL.AST as AST + import HsValueMap import FlattenTypes import TranslatorTypes +import VHDLTypes instance Pretty HsFunction where pPrint (HsFunction name args res) = @@ -42,11 +46,9 @@ instance Pretty id => Pretty (FApp id) where instance Pretty id => Pretty (CondDef id) where pPrint _ = text "TODO" -instance Pretty id => Pretty (Signal id) where - pPrint (Signal id) = pPrint id - -instance Pretty NamedSignal where - pPrint (NamedSignal name) = pPrint name +instance Pretty SignalInfo where + pPrint (SignalInfo Nothing ty) = empty + pPrint (SignalInfo (Just name) ty) = text ":" <> text name instance Pretty VHDLSession where pPrint (VHDLSession mod nameCount funcs) = @@ -54,19 +56,41 @@ instance Pretty VHDLSession where $+$ text "NameCount: " $$ nest 15 (int nameCount) $+$ text "Functions: " $$ nest 15 (vcat (map ppfunc (Map.toList funcs))) where - 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" + ppfunc (hsfunc, fdata) = + pPrint hsfunc $+$ nest 5 (pPrint fdata) modname = showSDoc $ Module.pprModule (HscTypes.cm_module mod) +instance Pretty FuncData where + pPrint (FuncData flatfunc entity arch) = + text "Flattened: " $$ nest 15 (ppffunc flatfunc) + $+$ text "Entity" $$ nest 15 (ppent entity) + $+$ pparch arch + where + ppffunc (Just f) = pPrint f + ppffunc Nothing = text "Nothing" + ppent (Just e) = pPrint e + ppent Nothing = text "Nothing" + pparch Nothing = text "VHDL architecture not present" + pparch (Just _) = text "VHDL architecture present" + +instance Pretty Entity where + pPrint (Entity args res decl) = + 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) => Pretty (CoreSyn.Bind b) where pPrint (CoreSyn.NonRec b expr) = text "NonRec: " $$ nest 10 (prettyBind (b, expr)) pPrint (CoreSyn.Rec binds) = text "Rec: " $$ nest 10 (vcat $ map (prettyBind) binds) +instance Pretty AST.VHDLId where + pPrint id = ForSyDe.Backend.Ppr.ppr id + prettyBind :: (Outputable b, Outputable e) => (b, e) -> Doc prettyBind (b, expr) = text b' <> text " = " <> text expr'