X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Pretty.hs;h=cb1f9fc7c1256900cb0476f0c993f43c953fdc3d;hb=6b3da07384004751bc64ef88429f452dfe1cee45;hp=6d495694f8a7fc4dab1fbe14b9378d550f67a8f7;hpb=e1804fc0ff2824e3584383ad7553a8f265ab615b;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/Pretty.hs b/Pretty.hs index 6d49569..cb1f9fc 100644 --- a/Pretty.hs +++ b/Pretty.hs @@ -1,6 +1,9 @@ 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 @@ -36,23 +39,44 @@ instance Pretty x => Pretty (HsValueMap x) where instance Pretty HsValueUse where pPrint Port = char 'P' - pPrint (State n) = char 'C' <> int n + pPrint (State n) = char 'S' <> int n pPrint (HighOrder _ _) = text "Higher Order" 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 "Defs: ") $$ nest 10 (ppdefs defs) $+$ text "Signals: " $$ nest 10 (printList ppsig 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 + instance Pretty SigDef where pPrint (FApp func args res) = pPrint func <> text " : " <> pPrint args <> text " -> " <> pPrint res - pPrint (CondDef _ _ _ _) = text "TODO" - pPrint (UncondDef src dst) = text "TODO" + pPrint (CondDef cond true false res) = + pPrint cond <> text " ? " <> pPrint true <> text " : " <> pPrint false <> text " -> " <> pPrint res + pPrint (UncondDef src dst) = + ppsrc src <> text " -> " <> pPrint dst + where + ppsrc (Left id) = pPrint id + ppsrc (Right expr) = pPrint expr + +instance Pretty SignalExpr where + pPrint (EqLit id lit) = + parens $ pPrint id <> text " = " <> text lit + pPrint (Literal lit) = + text lit + pPrint (Eq a b) = + parens $ pPrint a <> text " = " <> pPrint b instance Pretty SignalInfo where pPrint (SignalInfo name use ty) =