X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=CoreTools.hs;h=3dfaf5016cedb0ede442564d2e22452d9cc16e37;hb=a89f11ef881be9280586aa92abc91639fd8cb9c5;hp=a9114565c9aca9c732bc1c73848637b53a787f79;hpb=430a309686dbaf585844dc129cf7b6aa8568b652;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/CoreTools.hs b/CoreTools.hs index a911456..3dfaf50 100644 --- a/CoreTools.hs +++ b/CoreTools.hs @@ -11,11 +11,16 @@ import qualified HsExpr 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 CoreSyn +import qualified Var +import qualified Unique +import qualified CoreUtils import GhcTools import HsTools @@ -46,7 +51,7 @@ eval_tfp_int ty = core <- toCore modules expr execCore core --- | Get the length of a SizedWord type +-- | Get the width of a SizedWord type sized_word_len :: Type.Type -> Int sized_word_len ty = eval_tfp_int len @@ -69,3 +74,28 @@ eval_type_level_int ty = core <- toCore [] app execCore core + +-- | Get the length of a FSVec type +fsvec_len :: Type.Type -> Int +fsvec_len ty = + eval_type_level_int len + 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