module GhcPlugins.Extras
( module FamInstEnv
, module GhcPlugins
, module GhcPlugins.Extras
, module TyCoRep
) where
import Control.Monad.Writer hiding ((<>))
import Data.Data (Data)
import Data.Maybe (mapMaybe)
import Data.IORef (readIORef)
import ErrUtils (ghcExit)
import FamInstEnv (normaliseType)
import GhcPlugins
import GHC.ThToHs (thRdrNameGuesses)
import IfaceEnv (lookupOrigNameCache)
import qualified Language.Haskell.TH as TH
import NameCache (nsNames)
import TyCoRep
findTHName :: TH.Name -> CoreM (Maybe Name)
findTHName :: Name -> CoreM (Maybe Name)
findTHName Name
th_name =
case Name -> [RdrName]
thRdrNameGuesses Name
th_name of
Orig Module
m OccName
occ : [RdrName]
_ -> do
HscEnv
hsc_env <- CoreM HscEnv
getHscEnv
NameCache
nc <- IO NameCache -> CoreM NameCache
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NameCache -> CoreM NameCache)
-> IO NameCache -> CoreM NameCache
forall a b. (a -> b) -> a -> b
$ IORef NameCache -> IO NameCache
forall a. IORef a -> IO a
readIORef (HscEnv -> IORef NameCache
hsc_NC HscEnv
hsc_env)
Maybe Name -> CoreM (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Name -> CoreM (Maybe Name))
-> Maybe Name -> CoreM (Maybe Name)
forall a b. (a -> b) -> a -> b
$ OrigNameCache -> Module -> OccName -> Maybe Name
lookupOrigNameCache (NameCache -> OrigNameCache
nsNames NameCache
nc) Module
m OccName
occ
[RdrName]
_ -> Maybe Name -> CoreM (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
forall a. Maybe a
Nothing
getModuleAnnotations :: Data a => ModGuts -> [a]
getModuleAnnotations :: ModGuts -> [a]
getModuleAnnotations ModGuts
guts =
(Serialized -> Maybe a) -> [Serialized] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (([Word8] -> a) -> Serialized -> Maybe a
forall a. Typeable a => ([Word8] -> a) -> Serialized -> Maybe a
fromSerialized [Word8] -> a
forall a. Data a => [Word8] -> a
deserializeWithData)
[ Serialized
v | Annotation (ModuleTarget Module
_) Serialized
v <- ModGuts -> [Annotation]
mg_anns ModGuts
guts ]
failWith :: SDoc -> CoreM a
failWith :: SDoc -> CoreM a
failWith SDoc
m = do
SDoc -> CoreM ()
errorMsg SDoc
m
DynFlags
dflags <- CoreM DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
IO () -> CoreM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CoreM ()) -> IO () -> CoreM ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Int -> IO ()
ghcExit DynFlags
dflags Int
1
a -> CoreM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"ghcExit returned!?")