X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=TranslatorTypes.hs;h=37e86190a63f36b1b38acf1c75b193cda7fbdb44;hb=1d2f36c370db9ef82667741cc9414f9896084af3;hp=e16c12ea3a6fa1678f76c7521c3d684dd84d5775;hpb=3ed479f405a79b401f3f1e88a7a4a735ce62d5d6;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/TranslatorTypes.hs b/TranslatorTypes.hs index e16c12e..37e8619 100644 --- a/TranslatorTypes.hs +++ b/TranslatorTypes.hs @@ -2,38 +2,36 @@ -- 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 Control.Monad.Trans.State as State +import qualified Data.Map as Map +import qualified Data.Accessor.Template +import Data.Accessor + import qualified HscTypes -import Flatten -type FuncMap = [(HsFunction, - (FlatFunction))] +import qualified ForSyDe.Backend.VHDL.AST as AST -data VHDLSession = VHDLSession { - coreMod :: HscTypes.CoreModule, -- The current module - nameCount :: Int, -- A counter that can be used to generate unique names - funcs :: FuncMap -- A map from HsFunction to FlatFunction, HWFunction, VHDL Entity and Architecture -} +import FlattenTypes +import VHDLTypes +import HsValueMap --- Add the function to the session -addFunc :: HsFunction -> FlatFunction -> VHDLState () -addFunc hsfunc flatfunc = do - fs <- State.gets funcs -- Get the funcs element from the session - State.modify (\x -> x {funcs = (hsfunc, flatfunc) : fs }) -- Prepend name and f -getModule :: VHDLState HscTypes.CoreModule -getModule = State.gets coreMod -- Get the coreMod element from the session +-- | A map from a HsFunction identifier to various stuff we collect about a +-- function along the way. +type FlatFuncMap = Map.Map HsFunction FlatFunction + +data TranslatorSession = TranslatorSession { + tsCoreModule_ :: HscTypes.CoreModule, -- ^ The current module + tsNameCount_ :: Int, -- ^ A counter that can be used to generate unique names + tsFlatFuncs_ :: FlatFuncMap -- ^ A map from HsFunction to FlatFunction +} -type VHDLState = State.State VHDLSession +-- Derive accessors +$( Data.Accessor.Template.deriveAccessors ''TranslatorSession ) --- Makes the given name unique by appending a unique number. --- This does not do any checking against existing names, so it only guarantees --- uniqueness with other names generated by uniqueName. -uniqueName :: String -> VHDLState String -uniqueName name = do - count <- State.gets nameCount -- Get the funcs element from the session - State.modify (\s -> s {nameCount = count + 1}) - return $ name ++ "_" ++ (show count) +type TranslatorState = State.State TranslatorSession +-- vim: set ts=8 sw=2 sts=2 expandtab: