From 29ee33754fc52a1a46fd44aba98a4dce8c81ce58 Mon Sep 17 00:00:00 2001 From: Matthijs Kooijman Date: Mon, 9 Mar 2009 17:02:06 +0100 Subject: [PATCH] Rename VHDLState to TranslatorState. --- Pretty.hs | 2 +- Translator.hs | 8 ++++---- TranslatorTypes.hs | 32 ++++++++++++++++---------------- 3 files changed, 21 insertions(+), 21 deletions(-) diff --git a/Pretty.hs b/Pretty.hs index eb8378c..edfe05b 100644 --- a/Pretty.hs +++ b/Pretty.hs @@ -96,7 +96,7 @@ instance Pretty SigUse where pPrint (SigStateNew n) = text "SN:" <> int n pPrint SigSubState = text "s" -instance Pretty VHDLSession where +instance Pretty TranslatorSession where pPrint (VHDLSession mod nameCount funcs) = text "Module: " $$ nest 15 (text modname) $+$ text "NameCount: " $$ nest 15 (int nameCount) diff --git a/Translator.hs b/Translator.hs index eb4e59f..aa8d0d9 100644 --- a/Translator.hs +++ b/Translator.hs @@ -149,7 +149,7 @@ findBind binds lookfor = processBind :: Bool -- ^ Should this be stateful function? -> CoreBind -- ^ The bind to process - -> VHDLState () + -> TranslatorState () processBind _ (Rec _) = error "Recursive binders not supported" processBind stateful bind@(NonRec var expr) = do @@ -164,7 +164,7 @@ processBind stateful bind@(NonRec var expr) = do flattenBind :: HsFunction -- The signature to flatten into -> CoreBind -- The bind to flatten - -> VHDLState () + -> TranslatorState () flattenBind _ (Rec _) = error "Recursive binders not supported" @@ -273,7 +273,7 @@ getStateSignals hsfunc flatfunc = -- (recursively) do the same for any functions used. resolvFunc :: HsFunction -- | The function to look for - -> VHDLState () + -> TranslatorState () resolvFunc hsfunc = do -- See if the function is already known @@ -378,7 +378,7 @@ toVHDLSignalMap = fmap (\(name, ty) -> Just (VHDL.mkVHDLId name, ty)) -- | Translate a concise representation of a builtin function to something -- that can be put into FuncMap directly. -addBuiltIn :: BuiltIn -> VHDLState () +addBuiltIn :: BuiltIn -> TranslatorState () addBuiltIn (BuiltIn name args res) = do addFunc hsfunc setEntity hsfunc entity diff --git a/TranslatorTypes.hs b/TranslatorTypes.hs index 17a2b9c..fdd0e34 100644 --- a/TranslatorTypes.hs +++ b/TranslatorTypes.hs @@ -33,61 +33,63 @@ data FuncData = FuncData { -- Derive accessors $( Data.Accessor.Template.deriveAccessors ''FuncData ) -data VHDLSession = VHDLSession { +data TranslatorSession = 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 } +type TranslatorState = State.State TranslatorSession + -- | Add the function to the session -addFunc :: HsFunction -> VHDLState () +addFunc :: HsFunction -> TranslatorState () addFunc hsfunc = modFuncMap (Map.insert hsfunc (FuncData Nothing Nothing Nothing)) -- | Find the given function in the current session -getFunc :: HsFunction -> VHDLState (Maybe FuncData) +getFunc :: HsFunction -> TranslatorState (Maybe FuncData) 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 :: TranslatorState [(HsFunction, FuncData)] getFuncs = do fs <- State.gets funcs -- Get the funcs element from the session return $ Map.toList fs -- | Gets all the functions from the current session -getHsFuncs :: VHDLState [HsFunction] +getHsFuncs :: TranslatorState [HsFunction] getHsFuncs = do fs <- State.gets funcs -- Get the funcs element from the session return $ Map.keys fs -- | Sets the FlatFunction for the given HsFunction in the current session. -setFlatFunc :: HsFunction -> FlatFunction -> VHDLState () +setFlatFunc :: HsFunction -> FlatFunction -> TranslatorState () setFlatFunc hsfunc flatfunc = modFunc (fdFlatFunc ^= Just flatfunc) hsfunc -- | Sets the Entity for the given HsFunction in the current session. -setEntity :: HsFunction -> Entity -> VHDLState () +setEntity :: HsFunction -> Entity -> TranslatorState () setEntity hsfunc entity = modFunc (fdEntity ^= Just entity) hsfunc -- | Sets the Entity for the given HsFunction in the current session. -setArchitecture :: HsFunction -> AST.ArchBody -> VHDLState () +setArchitecture :: HsFunction -> AST.ArchBody -> TranslatorState () setArchitecture hsfunc arch = modFunc (fdArch ^= Just arch) hsfunc -- | Modify a function in the map using the given function -modFunc :: (FuncData -> FuncData) -> HsFunction -> VHDLState () +modFunc :: (FuncData -> FuncData) -> HsFunction -> TranslatorState () modFunc f hsfunc = modFuncMap (Map.adjust f hsfunc) -- | Get the map of functions in the session -getFuncMap :: VHDLState FuncMap +getFuncMap :: TranslatorState FuncMap getFuncMap = State.gets funcs -- | Modify the function map in the session using the given function -modFuncMap :: (FuncMap -> FuncMap) -> VHDLState () +modFuncMap :: (FuncMap -> FuncMap) -> TranslatorState () modFuncMap f = do fs <- State.gets funcs -- Get the funcs element from the session let fs' = f fs @@ -96,7 +98,7 @@ modFuncMap f = do -- | Apply the given function to all functions in the map, and collect the -- results. The function is allowed to change the function map in the -- session, but any new functions added will not be mapped. -modFuncs :: (HsFunction -> FuncData -> VHDLState ()) -> VHDLState () +modFuncs :: (HsFunction -> FuncData -> TranslatorState ()) -> TranslatorState () modFuncs f = do hsfuncs <- getHsFuncs mapM doFunc hsfuncs @@ -108,15 +110,13 @@ modFuncs f = do Nothing -> do return () Just fdata -> f hsfunc fdata -getModule :: VHDLState HscTypes.CoreModule +getModule :: TranslatorState HscTypes.CoreModule getModule = State.gets coreMod -- Get the coreMod element from the session -type VHDLState = State.State VHDLSession - -- 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 :: String -> TranslatorState String uniqueName name = do count <- State.gets nameCount -- Get the funcs element from the session State.modify (\s -> s {nameCount = count + 1}) -- 2.30.2