import TranslatorTypes
import VHDLTypes
+-- | A version of the default pPrintList method, which uses a custom function
+-- f instead of pPrint to print elements.
+printList :: (a -> Doc) -> [a] -> Doc
+printList f = brackets . fsep . punctuate comma . map f
+
instance Pretty HsFunction where
pPrint (HsFunction name args res) =
text name <> char ' ' <> parens (hsep $ punctuate comma args') <> text " -> " <> res'
pPrint (State n) = char 'C' <> int n
pPrint (HighOrder _ _) = text "Higher Order"
-instance Pretty id => Pretty (FlatFunction' id) where
- pPrint (FlatFunction args res apps conds sigs) =
+instance Pretty FlatFunction where
+ pPrint (FlatFunction args res defs 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)
+ $+$ (text "Defs: ") $$ nest 10 (pPrint defs)
+ $+$ text "Signals: " $$ nest 10 (printList ppsig sigs)
+ where
+ ppsig (id, info) = pPrint id <> pPrint info
-instance Pretty id => Pretty (FApp id) where
+instance Pretty SigDef where
pPrint (FApp func args res) =
pPrint func <> text " : " <> pPrint args <> text " -> " <> pPrint res
-
-instance Pretty id => Pretty (CondDef id) where
- pPrint _ = text "TODO"
+ pPrint (CondDef _ _ _ _) = text "TODO"
+ pPrint (UncondDef src dst) = text "TODO"
instance Pretty SignalInfo where
- pPrint (SignalInfo Nothing ty) = empty
- pPrint (SignalInfo (Just name) ty) = text ":" <> text name
+ pPrint (SignalInfo name use ty) =
+ text ":" <> (pPrint use) <> (ppname name)
+ where
+ ppname Nothing = empty
+ ppname (Just name) = text ":" <> text name
+
+instance Pretty SigUse where
+ pPrint SigPortIn = text "PI"
+ pPrint SigPortOut = text "PO"
+ pPrint SigInternal = text "I"
+ pPrint (SigStateOld n) = text "SO:" <> int n
+ pPrint (SigStateNew n) = text "SN:" <> int n
+ pPrint SigSubState = text "s"
instance Pretty VHDLSession where
pPrint (VHDLSession mod nameCount funcs) =
pparch (Just _) = text "VHDL architecture present"
instance Pretty Entity where
- pPrint (Entity args res decl) =
- text "Args: " $$ nest 10 (pPrint args)
+ pPrint (Entity id args res decl) =
+ text "Entity: " $$ nest 10 (pPrint id)
+ $+$ text "Args: " $$ nest 10 (pPrint args)
$+$ text "Result: " $$ nest 10 (pPrint res)
$+$ ppdecl decl
where