X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=CoreTools.hs;h=85c398ab7c2777bb920c749033f28caa2594d6c4;hb=77d347006ced194e77aee0f66da98a2028cb259e;hp=0bfe58fa8fd4657149cf171e5295da54eb001559;hpb=2ca7af8f94b990f13d9ef299a889e2ad591759a2;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/CoreTools.hs b/CoreTools.hs index 0bfe58f..85c398a 100644 --- a/CoreTools.hs +++ b/CoreTools.hs @@ -3,7 +3,10 @@ -- Core and Haskell (it uses HsTools for this), but only the functions that -- know about various libraries and know which functions to call. module CoreTools where - + +--Standard modules +import qualified Maybe + -- GHC API import qualified GHC import qualified Type @@ -19,8 +22,10 @@ import qualified DynFlags import qualified SrcLoc import qualified CoreSyn import qualified Var +import qualified VarSet import qualified Unique import qualified CoreUtils +import qualified CoreFVs import GhcTools import HsTools @@ -58,6 +63,14 @@ sized_word_len ty = 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. @@ -101,3 +114,24 @@ is_fun :: CoreSyn.CoreExpr -> Bool -- Treat Type arguments differently, because exprType is not defined for them. is_fun (CoreSyn.Type _) = False is_fun expr = (Type.isFunTy . CoreUtils.exprType) expr + +-- Is the given core expression polymorphic (i.e., does it accept type +-- arguments?). +is_poly :: CoreSyn.CoreExpr -> Bool +-- Treat Type arguments differently, because exprType is not defined for them. +is_poly (CoreSyn.Type _) = False +is_poly expr = (Maybe.isJust . Type.splitForAllTy_maybe . CoreUtils.exprType) expr + +-- Is the given core expression a variable reference? +is_var :: CoreSyn.CoreExpr -> Bool +is_var (CoreSyn.Var _) = True +is_var _ = False + +-- Can the given core expression be applied to something? This is true for +-- applying to a value as well as a type. +is_applicable :: CoreSyn.CoreExpr -> Bool +is_applicable expr = is_fun expr || is_poly expr + +-- Does the given CoreExpr have any free type vars? +has_free_tyvars :: CoreSyn.CoreExpr -> Bool +has_free_tyvars = not . VarSet.isEmptyVarSet . (CoreFVs.exprSomeFreeVars Var.isTyVar)