Fix error message genNegation for non-SizedWord types
[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 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