+sized_word_len ty = eval_tfp_int (sized_word_len_ty ty)
+
+sized_word_len_ty :: Type.Type -> Type.Type
+sized_word_len_ty ty = len
+ where
+ args = case Type.splitTyConApp_maybe ty of
+ Just (tycon, args) -> args
+ Nothing -> error $ "\nCoreTools.sized_word_len_ty: Not a sized word type: " ++ (pprString ty)
+ [len] = args
+
+-- | Get the width of a SizedInt type
+sized_int_len :: Type.Type -> Int
+sized_int_len ty = eval_tfp_int (sized_int_len_ty ty)
+
+sized_int_len_ty :: Type.Type -> Type.Type
+sized_int_len_ty ty = len
+ where
+ args = case Type.splitTyConApp_maybe ty of
+ Just (tycon, args) -> args
+ Nothing -> error $ "\nCoreTools.sized_int_len_ty: Not a sized int type: " ++ (pprString ty)
+ [len] = args
+
+-- | Get the upperbound of a RangedWord type
+ranged_word_bound :: Type.Type -> Int
+ranged_word_bound ty = eval_tfp_int (ranged_word_bound_ty ty)
+
+ranged_word_bound_ty :: Type.Type -> Type.Type
+ranged_word_bound_ty ty = len
+ where
+ args = case Type.splitTyConApp_maybe ty of
+ Just (tycon, args) -> args
+ Nothing -> error $ "\nCoreTools.ranged_word_bound_ty: Not a sized word type: " ++ (pprString ty)
+ [len] = args
+
+-- | Evaluate a core Type representing type level int from the TypeLevel
+-- library to a real int.
+-- eval_type_level_int :: Type.Type -> Int
+-- eval_type_level_int ty =
+-- unsafeRunGhc $ do
+-- -- Automatically import modules for any fully qualified identifiers
+-- setDynFlag DynFlags.Opt_ImplicitImportQualified
+--
+-- let to_int_name = mkRdrName "Data.TypeLevel.Num.Sets" "toInt"
+-- let to_int = SrcLoc.noLoc $ HsExpr.HsVar to_int_name
+-- let undef = hsTypedUndef $ coreToHsType ty
+-- let app = HsExpr.HsApp (to_int) (undef)
+--
+-- core <- toCore [] app
+-- execCore core
+
+-- | Get the length of a FSVec type
+tfvec_len :: Type.Type -> Int
+tfvec_len ty = eval_tfp_int (tfvec_len_ty ty)
+
+tfvec_len_ty :: Type.Type -> Type.Type
+tfvec_len_ty ty = len
+ where
+ args = case Type.splitTyConApp_maybe ty of
+ Just (tycon, args) -> args
+ Nothing -> error $ "\nCoreTools.tfvec_len_ty: Not a vector type: " ++ (pprString ty)
+ [len, el_ty] = args
+
+-- | Get the element type of a TFVec type
+tfvec_elem :: Type.Type -> Type.Type
+tfvec_elem ty = el_ty
+ where
+ args = case Type.splitTyConApp_maybe ty of
+ Just (tycon, args) -> args
+ Nothing -> error $ "\nCoreTools.tfvec_len: Not a vector type: " ++ (pprString 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
+-- 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
+
+-- Is the given core expression a variable or an application?
+is_simple :: CoreSyn.CoreExpr -> Bool
+is_simple (CoreSyn.App _ _) = True
+is_simple (CoreSyn.Var _) = True
+is_simple (CoreSyn.Cast expr _) = is_simple expr
+is_simple _ = False
+
+-- 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)
+
+-- Does the given CoreExpr have any free local vars?
+has_free_vars :: CoreSyn.CoreExpr -> Bool
+has_free_vars = not . VarSet.isEmptyVarSet . CoreFVs.exprFreeVars
+
+-- Turns a Var CoreExpr into the Id inside it. Will of course only work for
+-- simple Var CoreExprs, not complexer ones.
+exprToVar :: CoreSyn.CoreExpr -> Var.Id
+exprToVar (CoreSyn.Var id) = id
+exprToVar expr = error $ "\nCoreTools.exprToVar: Not a var: " ++ show expr