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