Added support for RangedWords

[matthijs/master-project/cλash.git] / CoreTools.hs

diff --git a/CoreTools.hs b/CoreTools.hs
index 5fbe8716e9f5ceb2321e6769eec65c585c28de0e..0dee4715f7ed55e5f58ba7ae3527799f60166feb 100644 (file)
--- a/CoreTools.hs
+++ b/CoreTools.hs
@@ -11,11 +11,16 @@ import qualified HsExpr
 import qualified HsTypes
 import qualified HsBinds
 import qualified RdrName
 import qualified HsTypes
 import qualified HsBinds
 import qualified RdrName

+import qualified Name

 import qualified OccName
 import qualified TysWiredIn
 import qualified Bag
 import qualified DynFlags
 import qualified SrcLoc
 import qualified OccName
 import qualified TysWiredIn
 import qualified Bag
 import qualified DynFlags
 import qualified SrcLoc

+import qualified CoreSyn
+import qualified Var
+import qualified Unique
+import qualified CoreUtils

 
 import GhcTools
 import HsTools
 
 import GhcTools
 import HsTools


@@ -53,6 +58,14 @@ sized_word_len ty =
   where 
     (tycon, args) = Type.splitTyConApp ty
     [len] = args
   where 
     (tycon, args) = Type.splitTyConApp ty
     [len] = args

+    
+-- | Get the upperbound of a RangedWord type
+ranged_word_bound :: Type.Type -> Int
+ranged_word_bound ty =
+  eval_tfp_int len
+  where
+    (tycon, args) = Type.splitTyConApp ty
+    [len]         = args

 
 -- | Evaluate a core Type representing type level int from the TypeLevel
 -- library to a real int.
 
 -- | Evaluate a core Type representing type level int from the TypeLevel
 -- library to a real int.


@@ -77,3 +90,20 @@ tfvec_len ty =
   where 
     (tycon, args) = Type.splitTyConApp ty
     [len, el_ty] = args
   where 
     (tycon, args) = Type.splitTyConApp ty
     [len, el_ty] = args

+
+-- Is this a wild binder?
+is_wild :: CoreSyn.CoreBndr -> Bool
+-- wild binders have a particular unique, that we copied from MkCore.lhs to
+-- here. However, this comparison didn't work, so we'll just check the
+-- occstring for now... TODO
+--(Var.varUnique bndr) == (Unique.mkBuiltinUnique 1)
+is_wild bndr = "wild" == (OccName.occNameString . Name.nameOccName . Var.varName) bndr
+
+-- Is the given core expression a lambda abstraction?
+is_lam :: CoreSyn.CoreExpr -> Bool
+is_lam (CoreSyn.Lam _ _) = True
+is_lam _ = False
+
+-- Is the given core expression of a function type?
+is_fun :: CoreSyn.CoreExpr -> Bool
+is_fun = Type.isFunTy . CoreUtils.exprType