X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=TranslatorTypes.hs;h=5d1ecf74343f98332901c974b069d805f858baa1;hb=4e69cb591dcca330d8f2a8c2e09fa2026c8fc7f2;hp=cad096bff8c692ec03437ff4e6fe4e7b6818d1b0;hpb=4fb701e41729143a897d43cd8a9c0217b8b3f68a;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/TranslatorTypes.hs b/TranslatorTypes.hs index cad096b..5d1ecf7 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 @@ -15,15 +20,11 @@ import HsValueMap -- function along the way. type FuncMap = Map.Map HsFunction FuncData --- | A signal that has been assigned a (unique) name -data NamedSignal = NamedSignal String - --- | A function in which all signals have been assigned unique names -type NamedFlatFunction = FlatFunction' NamedSignal - -- | Some stuff we collect about a function along the way. data FuncData = FuncData { - flatFunc :: Maybe (Either FlatFunction NamedFlatFunction) + flatFunc :: Maybe FlatFunction, + funcEntity :: Maybe Entity, + funcArch :: Maybe AST.ArchBody } data VHDLSession = VHDLSession { @@ -34,10 +35,8 @@ data VHDLSession = VHDLSession { -- | Add the function to the session 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 - State.modify (\x -> x {funcs = fs' }) +addFunc hsfunc = + modFuncMap (Map.insert hsfunc (FuncData Nothing Nothing Nothing)) -- | Find the given function in the current session getFunc :: HsFunction -> VHDLState (Maybe FuncData) @@ -45,13 +44,34 @@ 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 -> (Either FlatFunction NamedFlatFunction) -> VHDLState () -setFlatFunc hsfunc flatfunc = do +setFlatFunc :: HsFunction -> FlatFunction -> VHDLState () +setFlatFunc hsfunc flatfunc = + modFunc (\d -> d { flatFunc = Just flatfunc }) hsfunc + +-- | Modify a function in the map using the given function +modFunc :: (FuncData -> FuncData) -> HsFunction -> VHDLState () +modFunc f hsfunc = + modFuncMap (Map.adjust f hsfunc) + +-- | Modify the function map in the session using the given function +modFuncMap :: (FuncMap -> FuncMap) -> VHDLState () +modFuncMap f = do fs <- State.gets funcs -- Get the funcs element from the session - let fs'= Map.adjust (\d -> d { flatFunc = Just flatfunc }) hsfunc fs + let fs' = f fs State.modify (\x -> x {funcs = fs' }) +-- | Modify all functions in the map using the given function +modFuncs :: (HsFunction -> FuncData -> FuncData) -> VHDLState () +modFuncs f = + modFuncMap (Map.mapWithKey f) + getModule :: VHDLState HscTypes.CoreModule getModule = State.gets coreMod -- Get the coreMod element from the session