Add a setFlatFunc function.

This function allows for associating a FlatFunction with a HsFunction in
the current session.

diff --git a/Pretty.hs b/Pretty.hs
index c4556a81b90980dcc8bcfd97457c901fb0568e58..4136adea2ab9b9450046351c96b5cac9906da2eb 100644 (file)
--- a/Pretty.hs
+++ b/Pretty.hs
@@ -51,7 +51,7 @@ instance Pretty VHDLSession where
     $+$ text "NameCount: " $$ nest 15 (int nameCount)
     $+$ text "Functions: " $$ nest 15 (vcat (map ppfunc (Map.toList funcs)))
     where
-      ppfunc (hsfunc, (flatfunc)) =
+      ppfunc (hsfunc, (FuncData flatfunc)) =
         pPrint hsfunc $+$ (text "Flattened: " $$ nest 15 (pPrint flatfunc))
       modname = showSDoc $ Module.pprModule (HscTypes.cm_module mod)
 

diff --git a/Translator.hs b/Translator.hs
index ec9334bdfe41e9463df1d684eb6b3c256054911c..142a8349dd8364021a8fd5d5c971b6123c91bd98 100644 (file)
--- a/Translator.hs
+++ b/Translator.hs
@@ -97,6 +97,7 @@ flattenBind bind@(NonRec var expr) = do
   --addFunc hsfunc hwfunc 
   let flatfunc = flattenFunction hsfunc bind
   addFunc hsfunc
+  setFlatFunc hsfunc flatfunc
   let used_hsfuncs = map appFunc (apps flatfunc)
   State.mapM resolvFunc used_hsfuncs
   return ()

diff --git a/TranslatorTypes.hs b/TranslatorTypes.hs
index 60d12ebb0c53fd387dd1772861dea48567918cb2..8e24541eb6317efa38d5756466bf6b393c3465bf 100644 (file)
--- a/TranslatorTypes.hs
+++ b/TranslatorTypes.hs
@@ -13,8 +13,11 @@ import Flatten
 -- | A map from a HsFunction identifier to various stuff we collect about a
 --   function along the way.
 type FuncMap  = Map.Map HsFunction FuncData
+
 -- | Some stuff we collect about a function along the way.
-type FuncData = (Maybe FlatFunction)
+data FuncData = FuncData {
+  flatFunc :: Maybe FlatFunction
+}
 
 data VHDLSession = VHDLSession {
   coreMod   :: HscTypes.CoreModule, -- The current module
@@ -26,7 +29,7 @@ data VHDLSession = VHDLSession {
 addFunc :: HsFunction -> VHDLState ()
 addFunc hsfunc = do
   fs <- State.gets funcs -- Get the funcs element from the session
-  let fs' = Map.insert hsfunc (Nothing) fs -- Insert function
+  let fs' = Map.insert hsfunc (FuncData Nothing) fs -- Insert function
   State.modify (\x -> x {funcs = fs' })
 
 -- | Find the given function in the current session
@@ -35,6 +38,13 @@ getFunc hsfunc = do
   fs <- State.gets funcs -- Get the funcs element from the session
   return $ Map.lookup hsfunc fs
 
+-- | Sets the FlatFunction for the given HsFunction in the given setting.
+setFlatFunc :: HsFunction -> FlatFunction -> VHDLState ()
+setFlatFunc hsfunc flatfunc = do
+  fs <- State.gets funcs -- Get the funcs element from the session
+  let fs'= Map.adjust (\d -> d { flatFunc = Just flatfunc }) hsfunc fs
+  State.modify (\x -> x {funcs = fs' })
+
 getModule :: VHDLState HscTypes.CoreModule
 getModule = State.gets coreMod -- Get the coreMod element from the session