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
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 "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) =
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) =
+ pPrint (SignalInfo name use ty hints) =
text ":" <> (pPrint use) <> (ppname name)
where
ppname Nothing = empty