X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=TranslatorTypes.hs;h=604ab2050ff377b6cb25205bc63d6b1cdb22d7eb;hb=472a96af53dd624ba526ab86f250ac8f88a152ef;hp=4ced7de59b5bd5c28a23ebb7a398f322b5251729;hpb=535eeae192a34920407f47626fea2534bb5c263b;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/TranslatorTypes.hs b/TranslatorTypes.hs index 4ced7de..604ab20 100644 --- a/TranslatorTypes.hs +++ b/TranslatorTypes.hs @@ -5,9 +5,14 @@ module TranslatorTypes where import qualified Control.Monad.State as State -import qualified HscTypes import qualified Data.Map as Map + +import qualified HscTypes + +import qualified ForSyDe.Backend.VHDL.AST as AST + import FlattenTypes +import VHDLTypes import HsValueMap @@ -17,7 +22,9 @@ type FuncMap = Map.Map HsFunction FuncData -- | Some stuff we collect about a function along the way. data FuncData = FuncData { - flatFunc :: Maybe FlatFunction + flatFunc :: Maybe FlatFunction, + funcEntity :: Maybe Entity, + funcArch :: Maybe AST.ArchBody } data VHDLSession = VHDLSession { @@ -30,7 +37,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 (FuncData Nothing) fs -- Insert function + let fs' = Map.insert hsfunc (FuncData Nothing Nothing Nothing) fs -- Insert function State.modify (\x -> x {funcs = fs' }) -- | Find the given function in the current session @@ -39,6 +46,12 @@ getFunc hsfunc = do fs <- State.gets funcs -- Get the funcs element from the session return $ Map.lookup hsfunc fs +-- | Gets all functions from the current session +getFuncs :: VHDLState [(HsFunction, FuncData)] +getFuncs = do + fs <- State.gets funcs -- Get the funcs element from the session + return $ Map.toList fs + -- | Sets the FlatFunction for the given HsFunction in the given setting. setFlatFunc :: HsFunction -> FlatFunction -> VHDLState () setFlatFunc hsfunc flatfunc = do @@ -46,6 +59,13 @@ setFlatFunc hsfunc flatfunc = do let fs'= Map.adjust (\d -> d { flatFunc = Just flatfunc }) hsfunc fs State.modify (\x -> x {funcs = fs' }) +-- | Modify all functions in the map using the given function +modFuncs :: (HsFunction -> FuncData -> FuncData) -> VHDLState () +modFuncs f = do + fs <- State.gets funcs -- Get the funcs element from the session + let fs' = Map.mapWithKey f fs + State.modify (\x -> x {funcs = fs' }) + getModule :: VHDLState HscTypes.CoreModule getModule = State.gets coreMod -- Get the coreMod element from the session