TranslatorTypes.hs

   1 --
   2 -- Simple module providing some types used by Translator. These are in a
   3 -- separate module to prevent circular dependencies in Pretty for example.
   4 --
   5 {-# LANGUAGE TemplateHaskell #-}
   6 module TranslatorTypes where
   7
   8 import qualified Control.Monad.State as State
   9 import qualified Data.Map as Map
  10 import qualified Data.Accessor.Template
  11 import Data.Accessor
  12
  13 import qualified HscTypes
  14
  15 import qualified ForSyDe.Backend.VHDL.AST as AST
  16
  17 import FlattenTypes
  18 import VHDLTypes
  19 import HsValueMap
  20
  21
  22 -- | A map from a HsFunction identifier to various stuff we collect about a
  23 --   function along the way.
  24 type FuncMap  = Map.Map HsFunction FuncData
  25
  26 -- | Some stuff we collect about a function along the way.
  27 data FuncData = FuncData {
  28   fdFlatFunc_ :: Maybe FlatFunction,
  29   fdEntity_ :: Maybe Entity,
  30   fdArch_ :: Maybe AST.ArchBody
  31 } deriving (Show)
  32
  33 -- Derive accessors
  34 $( Data.Accessor.Template.deriveAccessors ''FuncData )
  35
  36 data TranslatorSession = VHDLSession {
  37   coreMod   :: HscTypes.CoreModule, -- The current module
  38   nameCount :: Int,             -- A counter that can be used to generate unique names
  39   funcs     :: FuncMap          -- A map from HsFunction to FlatFunction, HWFunction, VHDL Entity and Architecture
  40 }
  41
  42 type TranslatorState = State.State TranslatorSession
  43
  44 -- | Add the function to the session
  45 addFunc :: HsFunction -> TranslatorState ()
  46 addFunc hsfunc =
  47   modFuncMap (Map.insert hsfunc (FuncData Nothing Nothing Nothing))
  48
  49 -- | Find the given function in the current session
  50 getFunc :: HsFunction -> TranslatorState (Maybe FuncData)
  51 getFunc hsfunc = do
  52   fs <- State.gets funcs -- Get the funcs element from the session
  53   return $ Map.lookup hsfunc fs
  54
  55 -- | Gets all functions from the current session
  56 getFuncs :: TranslatorState [(HsFunction, FuncData)]
  57 getFuncs = do
  58   fs <- State.gets funcs -- Get the funcs element from the session
  59   return $ Map.toList fs
  60
  61 -- | Gets all the functions from the current session
  62 getHsFuncs :: TranslatorState [HsFunction]
  63 getHsFuncs = do
  64   fs <- State.gets funcs -- Get the funcs element from the session
  65   return $ Map.keys fs
  66
  67 -- | Sets the FlatFunction for the given HsFunction in the current session.
  68 setFlatFunc :: HsFunction -> FlatFunction -> TranslatorState ()
  69 setFlatFunc hsfunc flatfunc =
  70   modFunc (fdFlatFunc ^= Just flatfunc) hsfunc
  71
  72 -- | Sets the Entity for the given HsFunction in the current session.
  73 setEntity :: HsFunction -> Entity -> TranslatorState ()
  74 setEntity hsfunc entity =
  75   modFunc (fdEntity ^= Just entity) hsfunc
  76
  77 -- | Sets the Entity for the given HsFunction in the current session.
  78 setArchitecture :: HsFunction -> AST.ArchBody -> TranslatorState ()
  79 setArchitecture hsfunc arch =
  80   modFunc (fdArch ^= Just arch) hsfunc
  81
  82 -- | Modify a function in the map using the given function
  83 modFunc :: (FuncData -> FuncData) -> HsFunction -> TranslatorState ()
  84 modFunc f hsfunc =
  85   modFuncMap (Map.adjust f hsfunc)
  86
  87 -- | Get the map of functions in the session
  88 getFuncMap :: TranslatorState FuncMap
  89 getFuncMap = State.gets funcs
  90
  91 -- | Modify the function map in the session using the given function
  92 modFuncMap :: (FuncMap -> FuncMap) -> TranslatorState ()
  93 modFuncMap f = do
  94   fs <- State.gets funcs -- Get the funcs element from the session
  95   let fs' = f fs
  96   State.modify (\x -> x {funcs = fs' })
  97
  98 -- | Apply the given function to all functions in the map, and collect the
  99 --   results. The function is allowed to change the function map in the
 100 --   session, but any new functions added will not be mapped.
 101 modFuncs :: (HsFunction -> FuncData -> TranslatorState ()) -> TranslatorState ()
 102 modFuncs f = do
 103   hsfuncs <- getHsFuncs
 104   mapM doFunc hsfuncs
 105   return ()
 106   where
 107     doFunc hsfunc = do
 108       fdata_maybe <- getFunc hsfunc
 109       case fdata_maybe of
 110         Nothing -> do return ()
 111         Just fdata -> f hsfunc fdata
 112
 113 getModule :: TranslatorState HscTypes.CoreModule
 114 getModule = State.gets coreMod -- Get the coreMod element from the session
 115
 116 -- Makes the given name unique by appending a unique number.
 117 -- This does not do any checking against existing names, so it only guarantees
 118 -- uniqueness with other names generated by uniqueName.
 119 uniqueName :: String -> TranslatorState String
 120 uniqueName name = do
 121   count <- State.gets nameCount -- Get the funcs element from the session
 122   State.modify (\s -> s {nameCount = count + 1})
 123   return $ name ++ "_" ++ (show count)
 124
 125 -- vim: set ts=8 sw=2 sts=2 expandtab: