X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=CoreTools.hs;h=0c0e1fa7f60d88cd3914b9fcf1c3b20073c3a8ff;hb=b8c1e8554ba8aee73bc9d9a54bb3cb32f7930957;hp=bd6f329c537ea93842bf5b221998cf47fb69085c;hpb=57b95a135792cc76493402f716e33cbf9853b5c4;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/CoreTools.hs b/CoreTools.hs index bd6f329..0c0e1fa 100644 --- a/CoreTools.hs +++ b/CoreTools.hs @@ -38,9 +38,10 @@ import Pretty -- | Evaluate a core Type representing type level int from the tfp -- library to a real int. -eval_tfp_int :: Type.Type -> Int -eval_tfp_int ty = +eval_tfp_int :: HscTypes.HscEnv -> Type.Type -> Int +eval_tfp_int env ty = unsafeRunGhc $ do + GHC.setSession env -- Automatically import modules for any fully qualified identifiers setDynFlag DynFlags.Opt_ImplicitImportQualified @@ -50,15 +51,7 @@ eval_tfp_int ty = let app = SrcLoc.noLoc $ HsExpr.HsApp (from_int_t) (undef) let int_ty = SrcLoc.noLoc $ HsTypes.HsTyVar TysWiredIn.intTyCon_RDR let expr = HsExpr.ExprWithTySig app int_ty - let foo_name = mkRdrName "Types.Data.Num" "foo" - let foo_bind_name = RdrName.mkRdrUnqual $ OccName.mkVarOcc "foo" - let binds = Bag.listToBag [SrcLoc.noLoc $ HsBinds.VarBind foo_bind_name (SrcLoc.noLoc $ HsExpr.HsVar foo_name)] - let letexpr = HsExpr.HsLet - (HsBinds.HsValBinds $ (HsBinds.ValBindsIn binds) []) - (SrcLoc.noLoc expr) - - let modules = map GHC.mkModuleName ["Types.Data.Num"] - core <- toCore modules expr + core <- toCore expr execCore core normalise_tfp_int :: HscTypes.HscEnv -> Type.Type -> Type.Type @@ -140,14 +133,6 @@ tfvec_elem ty = el_ty 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