From 3ed479f405a79b401f3f1e88a7a4a735ce62d5d6 Mon Sep 17 00:00:00 2001
From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Wed, 11 Feb 2009 17:56:13 +0100
Subject: [PATCH] Add the current CoreModule to the session.

---
 Pretty.hs          | 8 ++++++--
 Translator.hs      | 2 +-
 TranslatorTypes.hs | 7 ++++++-
 3 files changed, 13 insertions(+), 4 deletions(-)

diff --git a/Pretty.hs b/Pretty.hs
index ff84a56..bc72faa 100644
--- 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 8d69ea2..5b65fa6 100644
--- 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 733e659..e16c12e 100644
--- 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.
-- 
2.30.2