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