Add getGlobalBinders accessor.

[matthijs/master-project/cλash.git] / CoreTools.hs

diff --git a/CoreTools.hs b/CoreTools.hs
index b8ebd85e1ef52935b77f6d85a86b58ceec39036d..444a4ba6c2ab7e469e164b030f77b5067c905459 100644 (file)
--- a/CoreTools.hs
+++ b/CoreTools.hs
@@ -3,7 +3,10 @@
 -- Core and Haskell (it uses HsTools for this), but only the functions that
 -- know about various libraries and know which functions to call.
 module CoreTools where
 -- Core and Haskell (it uses HsTools for this), but only the functions that
 -- know about various libraries and know which functions to call.
 module CoreTools where

-  
+
+--Standard modules
+import qualified Maybe
+

 -- GHC API
 import qualified GHC
 import qualified Type
 -- GHC API
 import qualified GHC
 import qualified Type


@@ -11,11 +14,16 @@ import qualified HsExpr
 import qualified HsTypes
 import qualified HsBinds
 import qualified RdrName
 import qualified HsTypes
 import qualified HsBinds
 import qualified RdrName

+import qualified Name

 import qualified OccName
 import qualified TysWiredIn
 import qualified Bag
 import qualified DynFlags
 import qualified SrcLoc
 import qualified OccName
 import qualified TysWiredIn
 import qualified Bag
 import qualified DynFlags
 import qualified SrcLoc

+import qualified CoreSyn
+import qualified Var
+import qualified Unique
+import qualified CoreUtils

 
 import GhcTools
 import HsTools
 
 import GhcTools
 import HsTools


@@ -42,10 +50,11 @@ eval_tfp_int ty =
           (HsBinds.HsValBinds $ (HsBinds.ValBindsIn binds) [])
           (SrcLoc.noLoc expr)
 
           (HsBinds.HsValBinds $ (HsBinds.ValBindsIn binds) [])
           (SrcLoc.noLoc expr)
 

-    core <- toCore expr
+    let modules = map GHC.mkModuleName ["Types.Data.Num"]
+    core <- toCore modules expr

     execCore core 
 
     execCore core 
 

--- | Get the length of a SizedWord type
+-- | Get the width of a SizedWord type

 sized_word_len :: Type.Type -> Int
 sized_word_len ty =
   eval_tfp_int len
 sized_word_len :: Type.Type -> Int
 sized_word_len ty =
   eval_tfp_int len


@@ -53,3 +62,58 @@ sized_word_len ty =
     (tycon, args) = Type.splitTyConApp ty
     [len] = args
 
     (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 
+
+-- | Get the length of a FSVec type
+tfvec_len :: Type.Type -> Int
+tfvec_len ty =
+  eval_tfp_int len
+  where 
+    (tycon, args) = Type.splitTyConApp 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
+is_lam _ = False
+
+-- Is the given core expression of a function type?
+is_fun :: CoreSyn.CoreExpr -> Bool
+-- Treat Type arguments differently, because exprType is not defined for them.
+is_fun (CoreSyn.Type _) = False
+is_fun expr = (Type.isFunTy . CoreUtils.exprType) expr
+
+-- Is the given core expression polymorphic (i.e., does it accept type
+-- arguments?).
+is_poly :: CoreSyn.CoreExpr -> Bool
+-- Treat Type arguments differently, because exprType is not defined for them.
+is_poly (CoreSyn.Type _) = False
+is_poly expr = (Maybe.isJust . Type.splitForAllTy_maybe . CoreUtils.exprType) expr
+
+-- Is the given core expression a variable reference?
+is_var :: CoreSyn.CoreExpr -> Bool
+is_var (CoreSyn.Var _) = True
+is_var _ = False
+