--Standard modules
import qualified Maybe
+import System.IO.Unsafe
-- GHC API
import qualified GHC
import qualified HsExpr
import qualified HsTypes
import qualified HsBinds
+import qualified HscTypes
import qualified RdrName
import qualified Name
import qualified OccName
-- | 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
- --setDynFlag DynFlags.Opt_D_dump_if_trace
let from_int_t_name = mkRdrName "Types.Data.Num" "fromIntegerT"
let from_int_t = SrcLoc.noLoc $ HsExpr.HsVar from_int_t_name
core <- toCore modules expr
execCore core
+normalise_tfp_int :: HscTypes.HscEnv -> Type.Type -> Type.Type
+normalise_tfp_int env ty =
+ unsafePerformIO $ do
+ nty <- normaliseType env ty
+ return nty
+
-- | Get the width of a SizedWord type
-sized_word_len :: Type.Type -> Int
-sized_word_len ty = eval_tfp_int (sized_word_len_ty ty)
+-- sized_word_len :: HscTypes.HscEnv -> Type.Type -> Int
+-- sized_word_len env ty = eval_tfp_int env (sized_word_len_ty ty)
sized_word_len_ty :: Type.Type -> Type.Type
sized_word_len_ty ty = len
[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 :: HscTypes.HscEnv -> Type.Type -> Int
+-- sized_int_len env ty = eval_tfp_int env (sized_int_len_ty ty)
sized_int_len_ty :: Type.Type -> Type.Type
sized_int_len_ty ty = len
[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 :: HscTypes.HscEnv -> Type.Type -> Int
+-- ranged_word_bound env ty = eval_tfp_int env (ranged_word_bound_ty ty)
ranged_word_bound_ty :: Type.Type -> Type.Type
ranged_word_bound_ty ty = len
-- 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 :: HscTypes.HscEnv -> Type.Type -> Int
+-- tfvec_len env ty = eval_tfp_int env (tfvec_len_ty ty)
tfvec_len_ty :: Type.Type -> Type.Type
tfvec_len_ty ty = len
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