--- | Loads the given files and turns it into a core module
-loadModules ::
- FilePath -- ^ The GHC Library directory
- -> [String] -- ^ The files that need to be loaded
- -> (HscTypes.CoreModule -> Ghc (Maybe CoreBndr)) -- ^ The TopEntity finder
- -> (HscTypes.CoreModule -> Ghc (Maybe CoreBndr)) -- ^ The InitState finder
- -> (HscTypes.CoreModule -> Ghc (Maybe CoreExpr)) -- ^ The TestInput finder
- -> IO ( [HscTypes.CoreModule]
- , [Maybe CoreBndr]
- , [Maybe CoreBndr]
- , [Maybe CoreExpr]
- , HscTypes.HscEnv
- ) -- ^ (The loaded modules , The TopEntity , The InitState, The TestInput, The Environment corresponding ot the loaded modules)
-loadModules libdir filenames topEntLoc initSLoc testLoc =
- defaultErrorHandler defaultDynFlags $ do
- runGhc (Just libdir) $ do
- dflags <- getSessionDynFlags
- setSessionDynFlags dflags
- cores <- mapM GHC.compileToCoreModule filenames
- env <- GHC.getSession
- top_entity <- mapM topEntLoc cores
- init_state <- mapM initSLoc cores
- test_input <- mapM testLoc cores
- return (cores, top_entity, init_state, test_input, env)
-
--- | Find a binder in module according to a certain criteria
-findBind ::
- GhcMonad m =>
- (Var.Var -> m Bool) -- ^ The criteria to filter the binds on
- -> HscTypes.CoreModule -- ^ The module to be inspected
- -> m (Maybe CoreBndr) -- ^ The (first) bind to meet the criteria
-findBind annotation core = do
- let binds = CoreSyn.flattenBinds $ cm_binds core
- annbinds <- Monad.filterM (annotation . fst) binds
- let bndr = case annbinds of [] -> Nothing ; xs -> Just $ head $ fst (unzip annbinds)
- return bndr
-
--- | Find an expresion in module according to a certain criteria
-findExpr ::
- GhcMonad m =>
- (Var.Var -> m Bool) -- ^ The criteria to filter the binds on
- -> HscTypes.CoreModule -- ^ The module to be inspected
- -> m (Maybe CoreExpr) -- ^ The (first) expr to meet the criteria
-findExpr annotation core = do
- let binds = CoreSyn.flattenBinds $ cm_binds core
- annbinds <- Monad.filterM (annotation . fst) binds
- let exprs = case annbinds of [] -> Nothing ; xs -> Just $ head $ snd (unzip annbinds)
- return exprs
-
--- | Determine if a binder has an Annotation meeting a certain criteria
-hasCLasHAnnotation ::
- GhcMonad m =>
- (CLasHAnn -> Bool) -- ^ The criteria the Annotation has to meet
- -> Var.Var -- ^ The Binder
- -> m Bool -- ^ Indicates if binder has the Annotation
-hasCLasHAnnotation clashAnn var = do
- let deserializer = Serialized.deserializeWithData
- let target = Annotations.NamedTarget (Var.varName var)
- (anns :: [CLasHAnn]) <- GHC.findGlobalAnns deserializer target
- let annEnts = filter clashAnn anns
- case annEnts of
- [] -> return False
- xs -> return True
-
--- | Determine if a binder has a certain name
-hasVarName ::
- GhcMonad m =>
- String -- ^ The name the binder has to have
- -> Var.Var -- ^ The Binder
- -> m Bool -- ^ Indicate if the binder has the name
-hasVarName lookfor bind = return $ lookfor == (occNameString $ nameOccName $ getName bind)
-