Add getFullString function to get a qualified name.

[matthijs/master-project/cλash.git] / cλash / CLasH / Utils / Core / BinderTools.hs

diff --git a/cλash/CLasH/Utils/Core/BinderTools.hs b/cλash/CLasH/Utils/Core/BinderTools.hs
index a072c45f2ee95389672704fce4a9f6e412145752..cd0167517236bc090357cde3ad46bfbb0927b7fe 100644 (file)
--- a/cλash/CLasH/Utils/Core/BinderTools.hs
+++ b/cλash/CLasH/Utils/Core/BinderTools.hs
@@ -4,34 +4,30 @@
 module CLasH.Utils.Core.BinderTools where
 
 -- Standard modules
 module CLasH.Utils.Core.BinderTools where
 
 -- Standard modules

-import Data.Accessor.MonadState as MonadState
+import qualified Data.Accessor.Monad.Trans.State as MonadState

 
 -- GHC API
 
 -- GHC API

-import CoreSyn
+import qualified CoreSyn

 import qualified Type
 import qualified UniqSupply
 import qualified Unique
 import qualified OccName
 import qualified Name
 import qualified Type
 import qualified UniqSupply
 import qualified Unique
 import qualified OccName
 import qualified Name

+import qualified Module

 import qualified Var
 import qualified SrcLoc
 import qualified IdInfo
 import qualified CoreUtils
 import qualified Var
 import qualified SrcLoc
 import qualified IdInfo
 import qualified CoreUtils

-import qualified CoreSubst
-import qualified VarSet
-import qualified HscTypes

 
 -- Local imports
 
 -- Local imports

-import Data.Accessor
-import Data.Accessor.MonadState as MonadState

 import CLasH.Translator.TranslatorTypes
 
 -- Create a new Unique
 mkUnique :: TranslatorSession Unique.Unique    
 mkUnique = do
 import CLasH.Translator.TranslatorTypes
 
 -- Create a new Unique
 mkUnique :: TranslatorSession Unique.Unique    
 mkUnique = do

-  us <- getA tsUniqSupply 
+  us <- MonadState.get tsUniqSupply 

   let (us', us'') = UniqSupply.splitUniqSupply us
   let (us', us'') = UniqSupply.splitUniqSupply us

-  putA tsUniqSupply us'
+  MonadState.set tsUniqSupply us'

   return $ UniqSupply.uniqFromSupply us''
 
 -- Create a new internal var with the given name and type. A Unique is
   return $ UniqSupply.uniqFromSupply us''
 
 -- Create a new internal var with the given name and type. A Unique is


@@ -59,15 +55,15 @@ mkTypeVar str kind = do
 -- Creates a binder for the given expression with the given name. This
 -- works for both value and type level expressions, so it can return a Var or
 -- TyVar (which is just an alias for Var).
 -- Creates a binder for the given expression with the given name. This
 -- works for both value and type level expressions, so it can return a Var or
 -- TyVar (which is just an alias for Var).

-mkBinderFor :: CoreExpr -> String -> TranslatorSession Var.Var
-mkBinderFor (Type ty) string = mkTypeVar string (Type.typeKind ty)
+mkBinderFor :: CoreSyn.CoreExpr -> String -> TranslatorSession Var.Var
+mkBinderFor (CoreSyn.Type ty) string = mkTypeVar string (Type.typeKind ty)

 mkBinderFor expr string = mkInternalVar string (CoreUtils.exprType expr)
 
 -- Creates a reference to the given variable. This works for both a normal
 -- variable as well as a type variable
 mkBinderFor expr string = mkInternalVar string (CoreUtils.exprType expr)
 
 -- Creates a reference to the given variable. This works for both a normal
 -- variable as well as a type variable

-mkReferenceTo :: Var.Var -> CoreExpr
-mkReferenceTo var | Var.isTyVar var = (Type $ Type.mkTyVarTy var)
-                  | otherwise       = (Var var)
+mkReferenceTo :: Var.Var -> CoreSyn.CoreExpr
+mkReferenceTo var | Var.isTyVar var = (CoreSyn.Type $ Type.mkTyVarTy var)
+                  | otherwise       = (CoreSyn.Var var)

 
 cloneVar :: Var.Var -> TranslatorSession Var.Var
 cloneVar v = do
 
 cloneVar :: Var.Var -> TranslatorSession Var.Var
 cloneVar v = do


@@ -79,10 +75,21 @@ cloneVar v = do
 -- Creates a new function with the same name as the given binder (but with a
 -- new unique) and with the given function body. Returns the new binder for
 -- this function.
 -- Creates a new function with the same name as the given binder (but with a
 -- new unique) and with the given function body. Returns the new binder for
 -- this function.

-mkFunction :: CoreBndr -> CoreExpr -> TranslatorSession CoreBndr
+mkFunction :: CoreSyn.CoreBndr -> CoreSyn.CoreExpr -> TranslatorSession CoreSyn.CoreBndr

 mkFunction bndr body = do
   let ty = CoreUtils.exprType body
   id <- cloneVar bndr
   let newid = Var.setVarType id ty
   addGlobalBind newid body
   return newid
 mkFunction bndr body = do
   let ty = CoreUtils.exprType body
   id <- cloneVar bndr
   let newid = Var.setVarType id ty
   addGlobalBind newid body
   return newid

+
+-- Returns the full name of a NamedThing, in the forum
+-- modulename.occname
+getFullString :: Name.NamedThing a => a -> String
+getFullString thing = modstr ++ occstr
+  where
+    name    = Name.getName thing
+    modstr  = case Name.nameModule_maybe name of
+      Nothing -> ""
+      Just mod -> Module.moduleNameString (Module.moduleName mod) ++ "."
+    occstr  = Name.getOccString name