Moved to new GHC API (6.11). Also use vhdl package for the VHDL AST

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

diff --git a/Pretty.hs b/Pretty.hs
index 75c73cc095e422f0b52456d75350853738cdfe18..d88846a1f2600e30cc8f9fa6efdf6cb31446f382 100644 (file)
--- a/Pretty.hs
+++ b/Pretty.hs
@@ -1,29 +1,25 @@
--- Needed for the Show deriving for Core types
-{-# LANGUAGE StandaloneDeriving #-}
-
-module Pretty (prettyShow) where
+module Pretty (prettyShow, pprString, pprStringDebug) where

 
 
 import qualified Data.Map as Map
 import qualified Data.Foldable as Foldable
 import qualified List
 
 
 
 import qualified Data.Map as Map
 import qualified Data.Foldable as Foldable
 import qualified List
 

-import qualified Var

 import qualified CoreSyn
 import qualified CoreSyn

-import qualified TypeRep

 import qualified Module
 import qualified HscTypes
 import Text.PrettyPrint.HughesPJClass
 import qualified Module
 import qualified HscTypes
 import Text.PrettyPrint.HughesPJClass

-import Outputable ( showSDoc, ppr, Outputable, OutputableBndr)
+import Outputable ( showSDoc, showSDocDebug, ppr, Outputable, OutputableBndr)

 
 

-import qualified ForSyDe.Backend.Ppr
-import qualified ForSyDe.Backend.VHDL.Ppr
-import qualified ForSyDe.Backend.VHDL.AST as AST
+import qualified Language.VHDL.Ppr as Ppr
+import qualified Language.VHDL.AST as AST
+import qualified Language.VHDL.AST.Ppr

 
 import HsValueMap
 import FlattenTypes
 import TranslatorTypes
 import VHDLTypes
 
 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.
 
 -- | A version of the default pPrintList method, which uses a custom function
 --   f instead of pPrint to print elements.


@@ -80,8 +76,8 @@ instance Pretty SigDef where
 instance Pretty SignalExpr where
   pPrint (EqLit id lit) =
     parens $ pPrint id <> text " = " <> text lit
 instance Pretty SignalExpr where
   pPrint (EqLit id lit) =
     parens $ pPrint id <> text " = " <> text lit

-  pPrint (Literal lit) =
-    text lit
+  pPrint (Literal lit ty) =
+    text "(" <> text (show ty) <> text ") " <> text lit

   pPrint (Eq a b) =
     parens $ pPrint a <> text " = " <> pPrint b
 
   pPrint (Eq a b) =
     parens $ pPrint a <> text " = " <> pPrint b
 


@@ -100,16 +96,16 @@ instance Pretty SigUse where
   pPrint (SigStateNew n) = text "SN:" <> int n
   pPrint SigSubState = text "s"
 
   pPrint (SigStateNew n) = text "SN:" <> int n
   pPrint SigSubState = text "s"
 

-instance Pretty VHDLSession where
-  pPrint (VHDLSession mod nameCount funcs) =
+instance Pretty TranslatorSession where
+  pPrint (TranslatorSession mod nameCount flatfuncs) =

     text "Module: " $$ nest 15 (text modname)
     $+$ text "NameCount: " $$ nest 15 (int nameCount)
     text "Module: " $$ nest 15 (text modname)
     $+$ text "NameCount: " $$ nest 15 (int nameCount)

-    $+$ text "Functions: " $$ nest 15 (vcat (map ppfunc (Map.toList funcs)))
+    $+$ text "Functions: " $$ nest 15 (vcat (map ppfunc (Map.toList flatfuncs)))

     where
     where

-      ppfunc (hsfunc, fdata) =
-        pPrint hsfunc $+$ nest 5 (pPrint fdata)
+      ppfunc (hsfunc, flatfunc) =
+        pPrint hsfunc $+$ nest 5 (pPrint flatfunc)

       modname = showSDoc $ Module.pprModule (HscTypes.cm_module mod)
       modname = showSDoc $ Module.pprModule (HscTypes.cm_module mod)

-
+{-

 instance Pretty FuncData where
   pPrint (FuncData flatfunc entity arch) =
     text "Flattened: " $$ nest 15 (ppffunc flatfunc)
 instance Pretty FuncData where
   pPrint (FuncData flatfunc entity arch) =
     text "Flattened: " $$ nest 15 (ppffunc flatfunc)


@@ -122,19 +118,13 @@ instance Pretty FuncData where
       ppent Nothing    = text "Nothing"
       pparch Nothing = text "VHDL architecture not present"
       pparch (Just _) = text "VHDL architecture present"
       ppent Nothing    = text "Nothing"
       pparch Nothing = text "VHDL architecture not present"
       pparch (Just _) = text "VHDL architecture present"

+-}

 
 instance Pretty Entity where
 
 instance Pretty Entity where

-  pPrint (Entity id args res decl pkg) =
+  pPrint (Entity id args res) =

     text "Entity: " $$ nest 10 (pPrint id)
     $+$ text "Args: " $$ nest 10 (pPrint args)
     $+$ text "Result: " $$ nest 10 (pPrint res)
     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) =
 
 instance (OutputableBndr b, Show b) => Pretty (CoreSyn.Bind b) where
   pPrint (CoreSyn.NonRec b expr) =


@@ -142,8 +132,14 @@ instance (OutputableBndr b, Show b) => Pretty (CoreSyn.Bind b) where
   pPrint (CoreSyn.Rec binds) =
     text "Rec: " $$ nest 10 (vcat $ map (prettyBind) binds)
 
   pPrint (CoreSyn.Rec binds) =
     text "Rec: " $$ nest 10 (vcat $ map (prettyBind) binds)
 

+instance (OutputableBndr b, Show b) => Pretty (CoreSyn.Expr b) where
+  pPrint = text . show
+

 instance Pretty AST.VHDLId where
 instance Pretty AST.VHDLId where

-  pPrint id = ForSyDe.Backend.Ppr.ppr id
+  pPrint id = Ppr.ppr id
+  
+instance Pretty AST.VHDLName where
+  pPrint name = Ppr.ppr name

 
 prettyBind :: (Show b, Show e) => (b, e) -> Doc
 prettyBind (b, expr) =
 
 prettyBind :: (Show b, Show e) => (b, e) -> Doc
 prettyBind (b, expr) =


@@ -152,14 +148,16 @@ prettyBind (b, expr) =
     b' = show b
     expr' = show expr
 
     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) ++ ")"
+instance (Pretty k, Pretty v) => Pretty (Map.Map k v) where
+  pPrint = 
+    vcat . map ppentry . Map.toList
+    where
+      ppentry (k, v) =
+        pPrint k <> text " : " $$ nest 15 (pPrint v)
+
+-- Convenience method for turning an Outputable into a string
+pprString :: (Outputable x) => x -> String
+pprString = showSDoc . ppr
+
+pprStringDebug :: (Outputable x) => x -> String
+pprStringDebug = showSDocDebug . ppr