clash/CLasH/Normalize/NormalizeTypes.hs

   1 module CLasH.Normalize.NormalizeTypes where
   2
   3 -- Standard modules
   4 import qualified Control.Monad.Trans.Writer as Writer
   5 import qualified Data.Monoid as Monoid
   6
   7 -- GHC API
   8 import qualified CoreSyn
   9
  10 -- Local imports
  11 import CLasH.Translator.TranslatorTypes
  12
  13 -- Wrap a writer around a TranslatorSession, to run a single transformation
  14 -- over a single expression and track if the expression was changed.
  15 type TransformMonad = Writer.WriterT Monoid.Any TranslatorSession
  16
  17 -- | In what context does a core expression occur?
  18 data CoreContext = AppFirst        -- ^ The expression is the first
  19                                    -- argument of an application (i.e.,
  20                                    -- it is applied)
  21                  | AppSecond       -- ^ The expression is the second
  22                                    --   argument of an application
  23                                    --   (i.e., something is applied to it)
  24                  | LetBinding [CoreSyn.CoreBndr]
  25                                    -- ^ The expression is bound in a
  26                                    --   (recursive or non-recursive) let
  27                                    --   expression.
  28                  | LetBody [CoreSyn.CoreBndr]
  29                                    -- ^ The expression is the body of a
  30                                    --   let expression
  31                  | LambdaBody CoreSyn.CoreBndr
  32                                    -- ^ The expression is the body of a
  33                                    --   lambda abstraction
  34                  | Other           -- ^ Another context
  35   deriving (Eq, Show)
  36 -- | Transforms a CoreExpr and keeps track if it has changed.
  37 type Transform = [CoreContext] -> CoreSyn.CoreExpr -> TransformMonad CoreSyn.CoreExpr
  38
  39 -- Predicates for each of the context types
  40 is_appfirst_ctx, is_appsecond_ctx, is_letbinding_ctx, is_letbody_ctx, is_lambdabody_ctx
  41  :: CoreContext -> Bool
  42
  43 is_appfirst_ctx AppFirst = True
  44 is_appfirst_ctx _ = False
  45
  46 is_appsecond_ctx AppSecond = True
  47 is_appsecond_ctx _ = False
  48
  49 is_letbinding_ctx (LetBinding _) = True
  50 is_letbinding_ctx _ = False
  51
  52 is_letbody_ctx (LetBody _) = True
  53 is_letbody_ctx _ = False
  54
  55 is_lambdabody_ctx (LambdaBody _) = True
  56 is_lambdabody_ctx _ = False