1 -- | This module provides a number of functions to find out things about Core
2 -- programs. This module does not provide the actual plumbing to work with
3 -- Core and Haskell (it uses HsTools for this), but only the functions that
4 -- know about various libraries and know which functions to call.
10 import qualified HsExpr
11 import qualified HsTypes
12 import qualified HsBinds
13 import qualified RdrName
14 import qualified OccName
15 import qualified TysWiredIn
17 import qualified DynFlags
18 import qualified SrcLoc
23 -- | Evaluate a core Type representing type level int from the tfp
24 -- library to a real int.
25 eval_tfp_int :: Type.Type -> Int
28 -- Automatically import modules for any fully qualified identifiers
29 setDynFlag DynFlags.Opt_ImplicitImportQualified
30 --setDynFlag DynFlags.Opt_D_dump_if_trace
32 let from_int_t_name = mkRdrName "Types.Data.Num" "fromIntegerT"
33 let from_int_t = SrcLoc.noLoc $ HsExpr.HsVar from_int_t_name
34 let undef = hsTypedUndef $ coreToHsType ty
35 let app = SrcLoc.noLoc $ HsExpr.HsApp (from_int_t) (undef)
36 let int_ty = SrcLoc.noLoc $ HsTypes.HsTyVar TysWiredIn.intTyCon_RDR
37 let expr = HsExpr.ExprWithTySig app int_ty
38 let foo_name = mkRdrName "Types.Data.Num" "foo"
39 let foo_bind_name = RdrName.mkRdrUnqual $ OccName.mkVarOcc "foo"
40 let binds = Bag.listToBag [SrcLoc.noLoc $ HsBinds.VarBind foo_bind_name (SrcLoc.noLoc $ HsExpr.HsVar foo_name)]
41 let letexpr = HsExpr.HsLet
42 (HsBinds.HsValBinds $ (HsBinds.ValBindsIn binds) [])
45 let modules = map GHC.mkModuleName ["Types.Data.Num"]
46 core <- toCore modules expr
49 -- | Get the width of a SizedWord type
50 sized_word_len :: Type.Type -> Int
54 (tycon, args) = Type.splitTyConApp ty
57 -- | Evaluate a core Type representing type level int from the TypeLevel
58 -- library to a real int.
59 eval_type_level_int :: Type.Type -> Int
60 eval_type_level_int ty =
62 -- Automatically import modules for any fully qualified identifiers
63 setDynFlag DynFlags.Opt_ImplicitImportQualified
65 let to_int_name = mkRdrName "Data.TypeLevel.Num.Sets" "toInt"
66 let to_int = SrcLoc.noLoc $ HsExpr.HsVar to_int_name
67 let undef = hsTypedUndef $ coreToHsType ty
68 let app = HsExpr.HsApp (to_int) (undef)
73 -- | Get the length of a FSVec type
74 fsvec_len :: Type.Type -> Int
76 eval_type_level_int len
78 (tycon, args) = Type.splitTyConApp ty