From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Wed, 11 Feb 2009 17:39:50 +0000 (+0100)
Subject: Add a setFlatFunc function.
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=fe0898cdc1f53172c3897354ef6d0b16d24736de;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

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 c4556a8..4136ade 100644
--- 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 ec9334b..142a834 100644
--- 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 60d12eb..8e24541 100644
--- 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