From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Wed, 11 Feb 2009 16:47:12 +0000 (+0100)
Subject: Replace printBind* by a Pretty instance.
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=2f1cf3a17e4d206c01031b3117779e99d21a4dce;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Replace printBind* by a Pretty instance.
---

diff --git a/Pretty.hs b/Pretty.hs
index 96f7f6e..ff84a56 100644
--- a/Pretty.hs
+++ b/Pretty.hs
@@ -1,6 +1,8 @@
 module Pretty (prettyShow) where
 
+import qualified CoreSyn
 import Text.PrettyPrint.HughesPJClass
+import Outputable ( showSDoc, ppr, Outputable, OutputableBndr)
 import Flatten
 import TranslatorTypes
 
@@ -47,3 +49,16 @@ instance Pretty VHDLSession where
     where
       ppfunc (hsfunc, (flatfunc)) =
         pPrint hsfunc $+$ (text "Flattened: " $$ nest 15 (pPrint flatfunc))
+
+instance (OutputableBndr b) => Pretty (CoreSyn.Bind b) where
+  pPrint (CoreSyn.NonRec b expr) =
+    text "NonRec: " $$ nest 10 (prettyBind (b, expr))
+  pPrint (CoreSyn.Rec binds) =
+    text "Rec: " $$ nest 10 (vcat $ map (prettyBind) binds)
+
+prettyBind :: (Outputable b, Outputable e) => (b, e) -> Doc
+prettyBind (b, expr) =
+  text b' <> text " = " <> text expr'
+  where
+    b' = showSDoc $ ppr b
+    expr' = showSDoc $ ppr expr
diff --git a/Translator.hs b/Translator.hs
index defa8ca..8d69ea2 100644
--- a/Translator.hs
+++ b/Translator.hs
@@ -51,7 +51,7 @@ main =
           core <- GHC.compileToCoreSimplified "Adders.hs"
           --liftIO $ printBinds (cm_binds core)
           let binds = Maybe.mapMaybe (findBind (cm_binds core)) ["sfull_adder"]
-          liftIO $ printBinds binds
+          liftIO $ putStr $ prettyShow binds
           -- Turn bind into VHDL
           let (vhdl, sess) = State.runState (mkVHDL binds) (VHDLSession 0 [])
           liftIO $ putStr $ render $ ForSyDe.Backend.Ppr.ppr vhdl
@@ -69,28 +69,6 @@ main =
         []
         []
 
-printTarget (Target (TargetFile file (Just x)) obj Nothing) =
-  print $ show file
-
-printBinds [] = putStr "done\n\n"
-printBinds (b:bs) = do
-  printBind b
-  putStr "\n"
-  printBinds bs
-
-printBind (NonRec b expr) = do
-  putStr "NonRec: "
-  printBind' (b, expr)
-
-printBind (Rec binds) = do
-  putStr "Rec: \n"  
-  foldl1 (>>) (map printBind' binds)
-
-printBind' (b, expr) = do
-  putStr $ getOccString b
-  putStr $ showSDoc $ ppr expr
-  putStr "\n"
-
 findBind :: [CoreBind] -> String -> Maybe CoreBind
 findBind binds lookfor =
   -- This ignores Recs and compares the name of the bind with lookfor,