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      -- ^ The expression is bound in a
  25                                    --   (recursive or non-recursive) let
  26                                    --   expression.
  27                  | LetBody         -- ^ The expression is the body of a
  28                                    --   let expression
  29                  | LambdaBody      -- ^ The expression is the body of a
  30                                    --   lambda abstraction
  31                  | Other           -- ^ Another context
  32   deriving (Eq, Show)
  33 -- | Transforms a CoreExpr and keeps track if it has changed.
  34 type Transform = [CoreContext] -> CoreSyn.CoreExpr -> TransformMonad CoreSyn.CoreExpr
  35
  36 -- Predicates for each of the context types
  37 is_appfirst_ctx, is_appsecond_ctx, is_letbinding_ctx, is_letbody_ctx, is_lambdabody_ctx
  38  :: CoreContext -> Bool
  39
  40 is_appfirst_ctx AppFirst = True
  41 is_appfirst_ctx _ = False
  42
  43 is_appsecond_ctx AppSecond = True
  44 is_appsecond_ctx _ = False
  45
  46 is_letbinding_ctx LetBinding = True
  47 is_letbinding_ctx _ = False
  48
  49 is_letbody_ctx LetBody = True
  50 is_letbody_ctx _ = False
  51
  52 is_lambdabody_ctx LambdaBody = True
  53 is_lambdabody_ctx _ = False