X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=TranslatorTypes.hs;h=72cd3981f97624175c816c50fd094fc330a4b9ae;hb=40ece4d80b50d59c781b9bc157f5379c3a3bb14a;hp=cad096bff8c692ec03437ff4e6fe4e7b6818d1b0;hpb=4fb701e41729143a897d43cd8a9c0217b8b3f68a;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/TranslatorTypes.hs b/TranslatorTypes.hs index cad096b..72cd398 100644 --- a/TranslatorTypes.hs +++ b/TranslatorTypes.hs @@ -15,15 +15,9 @@ 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 } data VHDLSession = VHDLSession { @@ -46,12 +40,18 @@ getFunc hsfunc = do return $ Map.lookup hsfunc 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' }) +modFunc :: HsFunction -> (HsFunction -> FuncData -> FuncData) -> VHDLState () +modFunc hsfunc f = do + fs <- State.gets funcs -- Get the funcs element from the session + let fs' = Map.adjustWithKey f hsfunc fs + State.modify (\x -> x {funcs = fs' }) + getModule :: VHDLState HscTypes.CoreModule getModule = State.gets coreMod -- Get the coreMod element from the session