-- | 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
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
getLiterals app@(CoreSyn.App _ _) = literals
where
(CoreSyn.Var f, args) = CoreSyn.collectArgs app
- literals = filter (is_lit) args
\ No newline at end of file
+ literals = filter (is_lit) args