From: Matthijs Kooijman Date: Thu, 9 Apr 2009 16:17:01 +0000 (+0200) Subject: Move eval_type_level_int to CoreTools. X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=430a309686dbaf585844dc129cf7b6aa8568b652;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Move eval_type_level_int to CoreTools. --- diff --git a/CoreTools.hs b/CoreTools.hs index 1e65b0d..a911456 100644 --- a/CoreTools.hs +++ b/CoreTools.hs @@ -54,3 +54,18 @@ sized_word_len ty = (tycon, args) = Type.splitTyConApp 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 diff --git a/HsTools.hs b/HsTools.hs index 3e8672f..967db18 100644 --- a/HsTools.hs +++ b/HsTools.hs @@ -153,22 +153,6 @@ execCore expr = do let res = Unsafe.Coerce.unsafeCoerce hval :: Int return $ Unsafe.Coerce.unsafeCoerce hval --- | 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 - -- These functions build (parts of) a LHSExpr RdrName. -- | A reference to the Prelude.undefined function.