X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=TranslatorTypes.hs;h=99784409cc5bba03904df86098c719f4c81e5257;hb=30a05fb3678f430135654b3f5d6612b409b7cd39;hp=cad096bff8c692ec03437ff4e6fe4e7b6818d1b0;hpb=4fb701e41729143a897d43cd8a9c0217b8b3f68a;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/TranslatorTypes.hs b/TranslatorTypes.hs index cad096b..9978440 100644 --- a/TranslatorTypes.hs +++ b/TranslatorTypes.hs @@ -5,9 +5,12 @@ module TranslatorTypes where import qualified Control.Monad.State as State -import qualified HscTypes import qualified Data.Map as Map + +import qualified HscTypes + import FlattenTypes +import VHDLTypes import HsValueMap @@ -15,15 +18,10 @@ 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, + entity :: Maybe Entity } data VHDLSession = VHDLSession { @@ -36,7 +34,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) fs -- Insert function State.modify (\x -> x {funcs = fs' }) -- | Find the given function in the current session @@ -45,13 +43,26 @@ 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 :: 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' }) +-- | 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