X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=TranslatorTypes.hs;h=17a2b9cccafbc47dfd6314d0a5d21159a8e9a665;hb=6917dbf733c6c9d7ecfe1796133664be26b6b1dc;hp=9a521b840057cbf114611731b17c03a784fb6a11;hpb=5f9b7f3e0c999e765f75b0c48b0f675d99842cea;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/TranslatorTypes.hs b/TranslatorTypes.hs
index 9a521b8..17a2b9c 100644
--- a/TranslatorTypes.hs
+++ b/TranslatorTypes.hs
@@ -2,10 +2,13 @@
 -- Simple module providing some types used by Translator. These are in a
 -- separate module to prevent circular dependencies in Pretty for example.
 --
+{-# LANGUAGE TemplateHaskell #-}
 module TranslatorTypes where
 
 import qualified Control.Monad.State as State
 import qualified Data.Map as Map
+import qualified Data.Accessor.Template
+import Data.Accessor
 
 import qualified HscTypes
 
@@ -22,10 +25,13 @@ type FuncMap  = Map.Map HsFunction FuncData
 
 -- | Some stuff we collect about a function along the way.
 data FuncData = FuncData {
-  flatFunc     :: Maybe FlatFunction,
-  funcEntity   :: Maybe Entity,
-  funcArch     :: Maybe AST.ArchBody
-}
+  fdFlatFunc_ :: Maybe FlatFunction,
+  fdEntity_ :: Maybe Entity,
+  fdArch_ :: Maybe AST.ArchBody
+} deriving (Show)
+
+-- Derive accessors
+$( Data.Accessor.Template.deriveAccessors ''FuncData )
 
 data VHDLSession = VHDLSession {
   coreMod   :: HscTypes.CoreModule, -- The current module
@@ -59,23 +65,27 @@ getHsFuncs = do
 -- | Sets the FlatFunction for the given HsFunction in the current session.
 setFlatFunc :: HsFunction -> FlatFunction -> VHDLState ()
 setFlatFunc hsfunc flatfunc =
-  modFunc (\d -> d { flatFunc = Just flatfunc }) hsfunc
+  modFunc (fdFlatFunc ^= Just flatfunc) hsfunc
 
 -- | Sets the Entity for the given HsFunction in the current session.
 setEntity :: HsFunction -> Entity -> VHDLState ()
 setEntity hsfunc entity =
-  modFunc (\d -> d { funcEntity = Just entity }) hsfunc
+  modFunc (fdEntity ^= Just entity) hsfunc
 
 -- | Sets the Entity for the given HsFunction in the current session.
 setArchitecture :: HsFunction -> AST.ArchBody -> VHDLState ()
 setArchitecture hsfunc arch =
-  modFunc (\d -> d { funcArch = Just arch }) hsfunc
+  modFunc (fdArch ^= Just arch) hsfunc
 
 -- | Modify a function in the map using the given function
 modFunc :: (FuncData -> FuncData) -> HsFunction -> VHDLState ()
 modFunc f hsfunc =
   modFuncMap (Map.adjust f hsfunc)
 
+-- | Get the map of functions in the session
+getFuncMap :: VHDLState FuncMap
+getFuncMap = State.gets funcs
+
 -- | Modify the function map in the session using the given function
 modFuncMap :: (FuncMap -> FuncMap) -> VHDLState ()
 modFuncMap f = do