NormalizeTypes.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2 module NormalizeTypes where
   3
   4
   5 -- Standard modules
   6 import qualified Control.Monad.Trans.Writer as Writer
   7 import qualified Control.Monad.Trans.State as State
   8 import qualified Data.Monoid as Monoid
   9 import qualified Data.Accessor.Template
  10 import Data.Accessor
  11 import qualified Data.Map as Map
  12 import Debug.Trace
  13
  14 -- GHC API
  15 import CoreSyn
  16 import qualified UniqSupply
  17 import qualified VarSet
  18 import Outputable ( Outputable, showSDoc, ppr )
  19
  20 -- Local imports
  21 import CoreShow
  22 import Pretty
  23 import VHDLTypes -- For TypeState
  24
  25 data TransformState = TransformState {
  26     tsUniqSupply_ :: UniqSupply.UniqSupply
  27   , tsBindings_ :: Map.Map CoreBndr CoreExpr
  28   , tsNormalized_ :: VarSet.VarSet -- ^ The binders that have been normalized
  29   , tsType_ :: TypeState
  30 }
  31 -- Create an (almost) empty TransformState, containing just a UniqSupply.
  32 emptyTransformState uniqSupply = TransformState uniqSupply Map.empty VarSet.emptyVarSet emptyTypeState
  33
  34 $( Data.Accessor.Template.deriveAccessors ''TransformState )
  35
  36 -- A session of multiple transformations over multiple expressions
  37 type TransformSession = (State.State TransformState)
  38 -- Wrap a writer around a TransformSession, to run a single transformation
  39 -- over a single expression and track if the expression was changed.
  40 type TransformMonad = Writer.WriterT Monoid.Any TransformSession
  41
  42 -- | Transforms a CoreExpr and keeps track if it has changed.
  43 type Transform = CoreExpr -> TransformMonad CoreExpr
  44
  45 -- Finds the value of a global binding, if available
  46 getGlobalBind :: CoreBndr -> TransformSession (Maybe CoreExpr)
  47 getGlobalBind bndr = do
  48   bindings <- getA tsBindings
  49   return $ Map.lookup bndr bindings
  50
  51 -- Adds a new global binding with the given value
  52 addGlobalBind :: CoreBndr -> CoreExpr -> TransformSession ()
  53 addGlobalBind bndr expr = modA tsBindings (Map.insert bndr expr)
  54
  55 -- Returns a list of all global binders
  56 getGlobalBinders :: TransformSession [CoreBndr]
  57 getGlobalBinders = do
  58   bindings <- getA tsBindings
  59   return $ Map.keys bindings