cλash/CLasH/Utils/Core/BinderTools.hs

   1 --
   2 -- This module contains functions that manipulate binders in various ways.
   3 --
   4 module CLasH.Utils.Core.BinderTools where
   5
   6 -- Standard modules
   7 import Data.Accessor.Monad.Trans.State as MonadState
   8
   9 -- GHC API
  10 import CoreSyn
  11 import qualified Type
  12 import qualified UniqSupply
  13 import qualified Unique
  14 import qualified OccName
  15 import qualified Name
  16 import qualified Var
  17 import qualified SrcLoc
  18 import qualified IdInfo
  19 import qualified CoreUtils
  20 import qualified CoreSubst
  21 import qualified VarSet
  22 import qualified HscTypes
  23
  24 -- Local imports
  25 import CLasH.Translator.TranslatorTypes
  26
  27 -- Create a new Unique
  28 mkUnique :: TranslatorSession Unique.Unique
  29 mkUnique = do
  30   us <- MonadState.get tsUniqSupply
  31   let (us', us'') = UniqSupply.splitUniqSupply us
  32   MonadState.set tsUniqSupply us'
  33   return $ UniqSupply.uniqFromSupply us''
  34
  35 -- Create a new internal var with the given name and type. A Unique is
  36 -- appended to the given name, to ensure uniqueness (not strictly neccesary,
  37 -- since the Unique is also stored in the name, but this ensures variable
  38 -- names are unique in the output).
  39 mkInternalVar :: String -> Type.Type -> TranslatorSession Var.Var
  40 mkInternalVar str ty = do
  41   uniq <- mkUnique
  42   let occname = OccName.mkVarOcc (str ++ show uniq)
  43   let name = Name.mkInternalName uniq occname SrcLoc.noSrcSpan
  44   return $ Var.mkLocalVar IdInfo.VanillaId name ty IdInfo.vanillaIdInfo
  45
  46 -- Create a new type variable with the given name and kind. A Unique is
  47 -- appended to the given name, to ensure uniqueness (not strictly neccesary,
  48 -- since the Unique is also stored in the name, but this ensures variable
  49 -- names are unique in the output).
  50 mkTypeVar :: String -> Type.Kind -> TranslatorSession Var.Var
  51 mkTypeVar str kind = do
  52   uniq <- mkUnique
  53   let occname = OccName.mkVarOcc (str ++ show uniq)
  54   let name = Name.mkInternalName uniq occname SrcLoc.noSrcSpan
  55   return $ Var.mkTyVar name kind
  56
  57 -- Creates a binder for the given expression with the given name. This
  58 -- works for both value and type level expressions, so it can return a Var or
  59 -- TyVar (which is just an alias for Var).
  60 mkBinderFor :: CoreExpr -> String -> TranslatorSession Var.Var
  61 mkBinderFor (Type ty) string = mkTypeVar string (Type.typeKind ty)
  62 mkBinderFor expr string = mkInternalVar string (CoreUtils.exprType expr)
  63
  64 -- Creates a reference to the given variable. This works for both a normal
  65 -- variable as well as a type variable
  66 mkReferenceTo :: Var.Var -> CoreExpr
  67 mkReferenceTo var | Var.isTyVar var = (Type $ Type.mkTyVarTy var)
  68                   | otherwise       = (Var var)
  69
  70 cloneVar :: Var.Var -> TranslatorSession Var.Var
  71 cloneVar v = do
  72   uniq <- mkUnique
  73   -- Swap out the unique, and reset the IdInfo (I'm not 100% sure what it
  74   -- contains, but vannillaIdInfo is always correct, since it means "no info").
  75   return $ Var.lazySetIdInfo (Var.setVarUnique v uniq) IdInfo.vanillaIdInfo
  76
  77 -- Creates a new function with the same name as the given binder (but with a
  78 -- new unique) and with the given function body. Returns the new binder for
  79 -- this function.
  80 mkFunction :: CoreBndr -> CoreExpr -> TranslatorSession CoreBndr
  81 mkFunction bndr body = do
  82   let ty = CoreUtils.exprType body
  83   id <- cloneVar bndr
  84   let newid = Var.setVarType id ty
  85   addGlobalBind newid body
  86   return newid