Remove createArchitecture from the VHDLState Monad.

[matthijs/master-project/cλash.git] / Pretty.hs

diff --git a/Pretty.hs b/Pretty.hs
index 679d7ae4261c1b24ff3f4b61b9f92cab3af2ed8c..eb8378c6c1e1f03e640ac9ec575c5d89229851b0 100644 (file)
--- a/Pretty.hs
+++ b/Pretty.hs
@@ -1,9 +1,11 @@
 module Pretty (prettyShow) where
 
+
 import qualified Data.Map as Map
-import qualified Var
+import qualified Data.Foldable as Foldable
+import qualified List
+
 import qualified CoreSyn
-import qualified TypeRep
 import qualified Module
 import qualified HscTypes
 import Text.PrettyPrint.HughesPJClass
@@ -17,6 +19,7 @@ import HsValueMap
 import FlattenTypes
 import TranslatorTypes
 import VHDLTypes
+import CoreShow
 
 -- | A version of the default pPrintList method, which uses a custom function
 --   f instead of pPrint to print elements.
@@ -43,10 +46,21 @@ 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) =
@@ -68,7 +82,7 @@ instance Pretty SignalExpr where
     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
@@ -106,14 +120,17 @@ instance Pretty FuncData where
       pparch (Just _) = text "VHDL architecture present"
 
 instance Pretty Entity where
-  pPrint (Entity id args res decl) =
+  pPrint (Entity id args res decl pkg) =
     text "Entity: " $$ nest 10 (pPrint id)
     $+$ text "Args: " $$ nest 10 (pPrint args)
     $+$ text "Result: " $$ nest 10 (pPrint res)
     $+$ ppdecl decl
+    $+$ pppkg pkg
     where
       ppdecl Nothing = text "VHDL entity not present"
       ppdecl (Just _) = text "VHDL entity present"
+      pppkg Nothing = text "VHDL package not present"
+      pppkg (Just _) = text "VHDL package present"
 
 instance (OutputableBndr b, Show b) => Pretty (CoreSyn.Bind b) where
   pPrint (CoreSyn.NonRec b expr) =
@@ -130,15 +147,3 @@ prettyBind (b, expr) =
   where
     b' = show b
     expr' = show expr
-
--- Derive Show for core expressions and binders, so we can see the actual
--- structure.
-deriving instance (Show b) => Show (CoreSyn.Expr b)
-deriving instance (Show b) => Show (CoreSyn.Bind b)
-
--- Implement dummy shows for Note and Type, so we can at least use show on
--- expressions.
-instance Show CoreSyn.Note where
-  show n = "<note>"
-instance Show TypeRep.Type where
-  show t = "_type:(" ++ (showSDoc $ ppr t) ++ ")"