Fix casesimpl and caseremove wrt scrutinee binders.
[matthijs/master-project/cλash.git] / 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