Add the current CoreModule to the session.

diff --git a/Pretty.hs b/Pretty.hs
index ff84a56cc61c5f39bbedec587584f0f0755026da..bc72faa1c296167fbb197ee35cc5a549e9ed10ab 100644 (file)
--- a/Pretty.hs
+++ b/Pretty.hs
@@ -1,6 +1,8 @@
 module Pretty (prettyShow) where
 
 import qualified CoreSyn
+import qualified Module
+import qualified HscTypes
 import Text.PrettyPrint.HughesPJClass
 import Outputable ( showSDoc, ppr, Outputable, OutputableBndr)
 import Flatten
@@ -43,12 +45,14 @@ instance Pretty CondDef where
   pPrint _ = text "TODO"
 
 instance Pretty VHDLSession where
-  pPrint (VHDLSession nameCount funcs) =
-    text "NameCount: " $$ nest 15 (int nameCount)
+  pPrint (VHDLSession mod nameCount funcs) =
+    text "Module: " $$ nest 15 (text modname)
+    $+$ text "NameCount: " $$ nest 15 (int nameCount)
     $+$ text "Functions: " $$ nest 15 (vcat (map ppfunc funcs))
     where
       ppfunc (hsfunc, (flatfunc)) =
         pPrint hsfunc $+$ (text "Flattened: " $$ nest 15 (pPrint flatfunc))
+      modname = showSDoc $ Module.pprModule (HscTypes.cm_module mod)
 
 instance (OutputableBndr b) => Pretty (CoreSyn.Bind b) where
   pPrint (CoreSyn.NonRec b expr) =

diff --git a/Translator.hs b/Translator.hs
index 8d69ea2626396094202437afc6c7ca570c123c42..5b65fa600043eb7be9432c0db55588bc8355cfba 100644 (file)
--- a/Translator.hs
+++ b/Translator.hs
@@ -53,7 +53,7 @@ main =
           let binds = Maybe.mapMaybe (findBind (cm_binds core)) ["sfull_adder"]
           liftIO $ putStr $ prettyShow binds
           -- Turn bind into VHDL
-          let (vhdl, sess) = State.runState (mkVHDL binds) (VHDLSession 0 [])
+          let (vhdl, sess) = State.runState (mkVHDL binds) (VHDLSession core 0 [])
           liftIO $ putStr $ render $ ForSyDe.Backend.Ppr.ppr vhdl
           liftIO $ ForSyDe.Backend.VHDL.FileIO.writeDesignFile vhdl "../vhdl/vhdl/output.vhdl"
           liftIO $ putStr $ "\n\nFinal session:\n" ++ prettyShow sess ++ "\n\n"

diff --git a/TranslatorTypes.hs b/TranslatorTypes.hs
index 733e65938bf84c20470de758e657be345e0fd990..e16c12ea3a6fa1678f76c7521c3d684dd84d5775 100644 (file)
--- a/TranslatorTypes.hs
+++ b/TranslatorTypes.hs
@@ -5,15 +5,17 @@
 module TranslatorTypes where
 
 import qualified Control.Monad.State as State
+import qualified HscTypes
 import Flatten
 
 type FuncMap = [(HsFunction, 
     (FlatFunction))]
 
 data VHDLSession = VHDLSession {
+  coreMod   :: HscTypes.CoreModule, -- The current module
   nameCount :: Int,             -- A counter that can be used to generate unique names
   funcs     :: FuncMap          -- A map from HsFunction to FlatFunction, HWFunction, VHDL Entity and Architecture
-} deriving (Show)
+}
 
 -- Add the function to the session
 addFunc :: HsFunction -> FlatFunction -> VHDLState ()
@@ -21,6 +23,9 @@ addFunc hsfunc flatfunc = do
   fs <- State.gets funcs -- Get the funcs element from the session
   State.modify (\x -> x {funcs = (hsfunc, flatfunc) : fs }) -- Prepend name and f
 
+getModule :: VHDLState HscTypes.CoreModule
+getModule = State.gets coreMod -- Get the coreMod element from the session
+
 type VHDLState = State.State VHDLSession
 
 -- Makes the given name unique by appending a unique number.