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