module Hint.Context (
      isModuleInterpreted,
      loadModules, getLoadedModules, setTopLevelModules,
      setImports, setImportsQ, setImportsF,
      reset,

      PhantomModule(..),
      cleanPhantomModules,

      supportString, supportShow
) where

import Prelude hiding (mod)

import Data.Char
import Data.Either (partitionEithers)
import Data.List

import Control.Arrow ((***))

import Control.Monad (filterM, unless, guard, foldM)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Catch

import Hint.Base
import Hint.Conversions
import qualified Hint.CompatPlatform as Compat

import qualified Hint.GHC as GHC

import System.Random
import System.FilePath
import System.Directory

import Data.Maybe (maybe)
import Hint.Configuration (setGhcOption)
import System.IO.Temp

type ModuleText = String

-- When creating a phantom module we have a situation similar to that of
-- @Hint.Util.safeBndFor@: we want to avoid picking a module name that is
-- already in-scope. Additionally, since this may be used with sandboxing in
-- mind we want to avoid easy-to-guess names. Thus, we do a trick similar
-- to the one in safeBndFor, but including a random number instead of an
-- additional digit. Finally, to avoid clashes between two processes
-- that are concurrently running with the same random seed (e.g., initialized
-- with the system time with not enough resolution), we also include the process id
newPhantomModule :: MonadInterpreter m => m PhantomModule
newPhantomModule :: forall (m :: * -> *). MonadInterpreter m => m PhantomModule
newPhantomModule =
    do Int
n <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
       Int
p <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Int
Compat.getPID
       ([ModuleName]
ls,[ModuleName]
is) <- forall (m :: * -> *).
MonadInterpreter m =>
m ([ModuleName], [ModuleName])
allModulesInContext
       let nums :: ModuleName
nums = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a. Show a => a -> ModuleName
show (forall a. Num a => a -> a
abs Int
n::Int), forall a. Show a => a -> ModuleName
show Int
p, forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([ModuleName]
ls forall a. [a] -> [a] -> [a]
++ [ModuleName]
is)]
       let mod_name :: ModuleName
mod_name = Char
'M'forall a. a -> [a] -> [a]
:ModuleName
nums
       --
       ModuleName
tmp_dir <- forall (m :: * -> *). MonadInterpreter m => m ModuleName
getPhantomDirectory
       --
       forall (m :: * -> *) a. Monad m => a -> m a
return PhantomModule{pmName :: ModuleName
pmName = ModuleName
mod_name, pmFile :: ModuleName
pmFile = ModuleName
tmp_dir ModuleName -> ModuleName -> ModuleName
</> ModuleName
mod_name ModuleName -> ModuleName -> ModuleName
<.> ModuleName
"hs"}

getPhantomDirectory :: MonadInterpreter m => m FilePath
getPhantomDirectory :: forall (m :: * -> *). MonadInterpreter m => m ModuleName
getPhantomDirectory =
    -- When a module is loaded by file name, ghc-8.4.1 loses track of the
    -- file location after the first time it has been loaded, so we create
    -- a directory for the phantom modules and add it to the search path.
    do Maybe ModuleName
mfp <- forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> Maybe ModuleName
phantomDirectory
       case Maybe ModuleName
mfp of
           Just ModuleName
fp -> forall (m :: * -> *) a. Monad m => a -> m a
return ModuleName
fp
           Maybe ModuleName
Nothing -> do ModuleName
tmp_dir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ModuleName
getTemporaryDirectory
                         ModuleName
fp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ModuleName -> ModuleName -> IO ModuleName
createTempDirectory ModuleName
tmp_dir ModuleName
"hint"
                         forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\InterpreterState
s -> InterpreterState
s{ phantomDirectory :: Maybe ModuleName
phantomDirectory = forall a. a -> Maybe a
Just ModuleName
fp })
                         forall (m :: * -> *). MonadInterpreter m => ModuleName -> m ()
setGhcOption forall a b. (a -> b) -> a -> b
$ ModuleName
"-i" forall a. [a] -> [a] -> [a]
++ ModuleName
fp
                         forall (m :: * -> *) a. Monad m => a -> m a
return ModuleName
fp

allModulesInContext :: MonadInterpreter m => m ([ModuleName], [ModuleName])
allModulesInContext :: forall (m :: * -> *).
MonadInterpreter m =>
m ([ModuleName], [ModuleName])
allModulesInContext = forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall (m :: * -> *). GhcMonad m => m ([ModuleName], [ModuleName])
getContextNames

getContext :: GHC.GhcMonad m => m ([GHC.Module], [GHC.ImportDecl GHC.GhcPs])
getContext :: forall (m :: * -> *).
GhcMonad m =>
m ([Module], [ImportDecl GhcPs])
getContext = do
    [InteractiveImport]
ctx <- forall (m :: * -> *). GhcMonad m => m [InteractiveImport]
GHC.getContext
    forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall (m :: * -> *).
GhcMonad m =>
([Module], [ImportDecl GhcPs])
-> InteractiveImport -> m ([Module], [ImportDecl GhcPs])
f ([], []) [InteractiveImport]
ctx
  where
    f :: (GHC.GhcMonad m) =>
         ([GHC.Module], [GHC.ImportDecl GHC.GhcPs]) ->
         GHC.InteractiveImport ->
         m ([GHC.Module], [GHC.ImportDecl GHC.GhcPs])
    f :: forall (m :: * -> *).
GhcMonad m =>
([Module], [ImportDecl GhcPs])
-> InteractiveImport -> m ([Module], [ImportDecl GhcPs])
f ([Module]
ns, [ImportDecl GhcPs]
ds) InteractiveImport
i = case InteractiveImport
i of
      (GHC.IIDecl ImportDecl GhcPs
d)     -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Module]
ns, ImportDecl GhcPs
d forall a. a -> [a] -> [a]
: [ImportDecl GhcPs]
ds)
      (GHC.IIModule ModuleName
m) -> do Module
n <- forall (m :: * -> *).
GhcMonad m =>
ModuleName -> Maybe FastString -> m Module
GHC.findModule ModuleName
m forall a. Maybe a
Nothing; forall (m :: * -> *) a. Monad m => a -> m a
return (Module
n forall a. a -> [a] -> [a]
: [Module]
ns, [ImportDecl GhcPs]
ds)

modToIIMod :: GHC.Module -> GHC.InteractiveImport
modToIIMod :: Module -> InteractiveImport
modToIIMod = ModuleName -> InteractiveImport
GHC.IIModule forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. GenModule unit -> ModuleName
GHC.moduleName

getContextNames :: GHC.GhcMonad m => m([String], [String])
getContextNames :: forall (m :: * -> *). GhcMonad m => m ([ModuleName], [ModuleName])
getContextNames = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall {unit}. GenModule unit -> ModuleName
name forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a b. (a -> b) -> [a] -> [b]
map ImportDecl GhcPs -> ModuleName
decl) forall (m :: * -> *).
GhcMonad m =>
m ([Module], [ImportDecl GhcPs])
getContext
    where name :: GenModule unit -> ModuleName
name = ModuleName -> ModuleName
GHC.moduleNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. GenModule unit -> ModuleName
GHC.moduleName
          decl :: ImportDecl GhcPs -> ModuleName
decl = ModuleName -> ModuleName
GHC.moduleNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
GHC.unLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. ImportDecl pass -> XRec pass ModuleName
GHC.ideclName

setContext :: GHC.GhcMonad m => [GHC.Module] -> [GHC.ImportDecl GHC.GhcPs] -> m ()
setContext :: forall (m :: * -> *).
GhcMonad m =>
[Module] -> [ImportDecl GhcPs] -> m ()
setContext [Module]
ms [ImportDecl GhcPs]
ds =
  let ms' :: [InteractiveImport]
ms' = forall a b. (a -> b) -> [a] -> [b]
map Module -> InteractiveImport
modToIIMod [Module]
ms
      ds' :: [InteractiveImport]
ds' = forall a b. (a -> b) -> [a] -> [b]
map ImportDecl GhcPs -> InteractiveImport
GHC.IIDecl [ImportDecl GhcPs]
ds
      is :: [InteractiveImport]
is = [InteractiveImport]
ms' forall a. [a] -> [a] -> [a]
++ [InteractiveImport]
ds'
  in forall (m :: * -> *). GhcMonad m => [InteractiveImport] -> m ()
GHC.setContext [InteractiveImport]
is

-- Explicitly-typed variants of getContext/setContext, for use where we modify
-- or override the context.
setContextModules :: GHC.GhcMonad m => [GHC.Module] -> [GHC.Module] -> m ()
setContextModules :: forall (m :: * -> *). GhcMonad m => [Module] -> [Module] -> m ()
setContextModules [Module]
as = forall (m :: * -> *).
GhcMonad m =>
[Module] -> [ImportDecl GhcPs] -> m ()
setContext [Module]
as forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (ModuleName -> ImportDecl GhcPs
GHC.simpleImportDecl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. GenModule unit -> ModuleName
GHC.moduleName)

addPhantomModule :: MonadInterpreter m
                 => (ModuleName -> ModuleText)
                 -> m PhantomModule
addPhantomModule :: forall (m :: * -> *).
MonadInterpreter m =>
(ModuleName -> ModuleName) -> m PhantomModule
addPhantomModule ModuleName -> ModuleName
mod_text =
    do PhantomModule
pm <- forall (m :: * -> *). MonadInterpreter m => m PhantomModule
newPhantomModule
       DynFlags
df <- forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
       let t :: Target
t = DynFlags -> ModuleName -> Target
GHC.fileTarget DynFlags
df (PhantomModule -> ModuleName
pmFile PhantomModule
pm)
           m :: ModuleName
m = ModuleName -> ModuleName
GHC.mkModuleName (PhantomModule -> ModuleName
pmName PhantomModule
pm)
       --
       forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ModuleName -> ModuleName -> IO ()
writeFile (PhantomModule -> ModuleName
pmFile PhantomModule
pm) (ModuleName -> ModuleName
mod_text forall a b. (a -> b) -> a -> b
$ PhantomModule -> ModuleName
pmName PhantomModule
pm)
       --
       forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\InterpreterState
s -> InterpreterState
s{activePhantoms :: [PhantomModule]
activePhantoms = PhantomModule
pmforall a. a -> [a] -> [a]
:InterpreterState -> [PhantomModule]
activePhantoms InterpreterState
s})
       forall (m :: * -> *) a. MonadInterpreter m => m (Maybe a) -> m a
mayFail (do -- GHC.load will remove all the modules from
                   -- scope, so first we save the context...
                   ([Module]
old_top, [ImportDecl GhcPs]
old_imps) <- forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall (m :: * -> *).
GhcMonad m =>
m ([Module], [ImportDecl GhcPs])
getContext
                   --
                   forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GhcMonad m => Target -> m ()
GHC.addTarget Target
t
                   SuccessFlag
res <- forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GhcMonad m => LoadHowMuch -> m SuccessFlag
GHC.load LoadHowMuch
GHC.LoadAllTargets
                   --
                   if SuccessFlag -> Bool
isSucceeded SuccessFlag
res
                     then do forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
GhcMonad m =>
[Module] -> [ImportDecl GhcPs] -> m ()
setContext [Module]
old_top [ImportDecl GhcPs]
old_imps
                             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ()
                     else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
        forall (m :: * -> *) a.
MonadInterpreter m =>
m a -> (InterpreterError -> m a) -> m a
`catchIE` (\InterpreterError
err -> case InterpreterError
err of
                             WontCompile [GhcError]
_ -> do forall (m :: * -> *). MonadInterpreter m => PhantomModule -> m ()
removePhantomModule PhantomModule
pm
                                                 forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM InterpreterError
err
                             InterpreterError
_             -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM InterpreterError
err)
       --
       forall (m :: * -> *) a. Monad m => a -> m a
return PhantomModule
pm

removePhantomModule :: forall m. MonadInterpreter m => PhantomModule -> m ()
removePhantomModule :: forall (m :: * -> *). MonadInterpreter m => PhantomModule -> m ()
removePhantomModule PhantomModule
pm =
    do -- We don't want to actually unload this module, because that
       -- would mean that all the real modules might get reloaded and the
       -- user didn't require that (they may be in a non-compiling state!).
       -- However, this means that we can't actually delete the file, because
       -- it is an active target. Therefore, we simply take it out of scope
       -- and mark it as "delete me when possible" (i.e., next time the
       -- @loadModules@ function is called).
       --
       Bool
isLoaded <- forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Bool
moduleIsLoaded forall a b. (a -> b) -> a -> b
$ PhantomModule -> ModuleName
pmName PhantomModule
pm
       Bool
safeToRemove <-
           if Bool
isLoaded
             then do -- take it out of scope
                     Module
mod <- forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Module
findModule (PhantomModule -> ModuleName
pmName PhantomModule
pm)
                     ([Module]
mods, [ImportDecl GhcPs]
imps) <- forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall (m :: * -> *).
GhcMonad m =>
m ([Module], [ImportDecl GhcPs])
getContext
                     let mods' :: [Module]
mods' = forall a. (a -> Bool) -> [a] -> [a]
filter (Module
mod forall a. Eq a => a -> a -> Bool
/=) [Module]
mods
                     forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
GhcMonad m =>
[Module] -> [ImportDecl GhcPs] -> m ()
setContext [Module]
mods' [ImportDecl GhcPs]
imps
                     --
                     let isNotPhantom :: GHC.Module -> m Bool
                         isNotPhantom :: Module -> m Bool
isNotPhantom Module
mod' = do
                           Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Bool
isPhantomModule (Module -> ModuleName
moduleToString Module
mod')
                     forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Module -> m Bool
isNotPhantom [Module]
mods'
             else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
       --
       let file_name :: ModuleName
file_name = PhantomModule -> ModuleName
pmFile PhantomModule
pm
       forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ do DynFlags
df <- forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
                   forall (m :: * -> *). GhcMonad m => TargetId -> m ()
GHC.removeTarget (Target -> TargetId
GHC.targetId forall a b. (a -> b) -> a -> b
$ DynFlags -> ModuleName -> Target
GHC.fileTarget DynFlags
df ModuleName
file_name)
       --
       forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\InterpreterState
s -> InterpreterState
s{activePhantoms :: [PhantomModule]
activePhantoms = forall a. (a -> Bool) -> [a] -> [a]
filter (PhantomModule
pm forall a. Eq a => a -> a -> Bool
/=) forall a b. (a -> b) -> a -> b
$ InterpreterState -> [PhantomModule]
activePhantoms InterpreterState
s})
       --
       if Bool
safeToRemove
         then forall (m :: * -> *) a. MonadInterpreter m => m (Maybe a) -> m a
mayFail forall a b. (a -> b) -> a -> b
$ do SuccessFlag
res <- forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GhcMonad m => LoadHowMuch -> m SuccessFlag
GHC.load LoadHowMuch
GHC.LoadAllTargets
                           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SuccessFlag -> Bool
isSucceeded SuccessFlag
res) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just ()
              forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`finally` do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ModuleName -> IO ()
removeFile (PhantomModule -> ModuleName
pmFile PhantomModule
pm)
         else forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\InterpreterState
s -> InterpreterState
s{zombiePhantoms :: [PhantomModule]
zombiePhantoms = PhantomModule
pmforall a. a -> [a] -> [a]
:InterpreterState -> [PhantomModule]
zombiePhantoms InterpreterState
s})

-- Returns a tuple with the active and zombie phantom modules respectively
getPhantomModules :: MonadInterpreter m => m ([PhantomModule], [PhantomModule])
getPhantomModules :: forall (m :: * -> *).
MonadInterpreter m =>
m ([PhantomModule], [PhantomModule])
getPhantomModules = do [PhantomModule]
active <- forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> [PhantomModule]
activePhantoms
                       [PhantomModule]
zombie <- forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> [PhantomModule]
zombiePhantoms
                       forall (m :: * -> *) a. Monad m => a -> m a
return ([PhantomModule]
active, [PhantomModule]
zombie)

isPhantomModule :: MonadInterpreter m => ModuleName -> m Bool
isPhantomModule :: forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Bool
isPhantomModule ModuleName
mn = do ([PhantomModule]
as,[PhantomModule]
zs) <- forall (m :: * -> *).
MonadInterpreter m =>
m ([PhantomModule], [PhantomModule])
getPhantomModules
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ModuleName
mn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map PhantomModule -> ModuleName
pmName ([PhantomModule]
as forall a. [a] -> [a] -> [a]
++ [PhantomModule]
zs)

-- | Tries to load all the requested modules from their source file.
--   Modules my be indicated by their ModuleName (e.g. \"My.Module\") or
--   by the full path to its source file. Note that in order to use code from
--   that module, you also need to call 'setImports' (to use the exported types
--   and definitions) or 'setTopLevelModules' (to also use the private types
--   and definitions).
--
-- The interpreter is 'reset' both before loading the modules and in the event
-- of an error.
--
-- /IMPORTANT/: Like in a ghci session, this will also load (and interpret)
--  any dependency that is not available via an installed package. Make
--  sure that you are not loading any module that is also being used to
--  compile your application.  In particular, you need to avoid modules
--  that define types that will later occur in an expression that you will
--  want to interpret.
--
-- The problem in doing this is that those types will have two incompatible
-- representations at runtime: 1) the one in the compiled code and 2) the
-- one in the interpreted code. When interpreting such an expression (bringing
-- it to program-code) you will likely get a segmentation fault, since the
-- latter representation will be used where the program assumes the former.
--
-- The rule of thumb is: never make the interpreter run on the directory
-- with the source code of your program! If you want your interpreted code to
-- use some type that is defined in your program, then put the defining module
-- on a library and make your program depend on that package.
loadModules :: MonadInterpreter m => [String] -> m ()
loadModules :: forall (m :: * -> *). MonadInterpreter m => [ModuleName] -> m ()
loadModules [ModuleName]
fs = do -- first, unload everything, and do some clean-up
                    forall (m :: * -> *). MonadInterpreter m => m ()
reset
                    forall (m :: * -> *). MonadInterpreter m => [ModuleName] -> m ()
doLoad [ModuleName]
fs forall (m :: * -> *) a.
MonadInterpreter m =>
m a -> (InterpreterError -> m a) -> m a
`catchIE` (\InterpreterError
e -> forall (m :: * -> *). MonadInterpreter m => m ()
reset forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM InterpreterError
e)

doLoad :: MonadInterpreter m => [String] -> m ()
doLoad :: forall (m :: * -> *). MonadInterpreter m => [ModuleName] -> m ()
doLoad [ModuleName]
fs = do [Target]
targets <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ModuleName
f->forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
GhcMonad m =>
ModuleName -> Maybe Phase -> m Target
GHC.guessTarget ModuleName
f forall a. Maybe a
Nothing) [ModuleName]
fs
               --
               forall (m :: * -> *). [Target] -> MonadInterpreter m => m ()
reinstallSupportModule [Target]
targets

-- | Returns True if the module was interpreted.
isModuleInterpreted :: MonadInterpreter m => ModuleName -> m Bool
isModuleInterpreted :: forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Bool
isModuleInterpreted ModuleName
moduleName = do
  Module
mod <- forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Module
findModule ModuleName
moduleName
  forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GhcMonad m => Module -> m Bool
GHC.moduleIsInterpreted Module
mod

-- | Returns the list of modules loaded with 'loadModules'.
getLoadedModules :: MonadInterpreter m => m [ModuleName]
getLoadedModules :: forall (m :: * -> *). MonadInterpreter m => m [ModuleName]
getLoadedModules = do ([PhantomModule]
active_pms, [PhantomModule]
zombie_pms) <- forall (m :: * -> *).
MonadInterpreter m =>
m ([PhantomModule], [PhantomModule])
getPhantomModules
                      [ModuleName]
ms <- forall a b. (a -> b) -> [a] -> [b]
map ModSummary -> ModuleName
modNameFromSummary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadInterpreter m => m [ModSummary]
getLoadedModSummaries
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ModuleName]
ms forall a. Eq a => [a] -> [a] -> [a]
\\ forall a b. (a -> b) -> [a] -> [b]
map PhantomModule -> ModuleName
pmName ([PhantomModule]
active_pms forall a. [a] -> [a] -> [a]
++ [PhantomModule]
zombie_pms)

modNameFromSummary :: GHC.ModSummary -> ModuleName
modNameFromSummary :: ModSummary -> ModuleName
modNameFromSummary = Module -> ModuleName
moduleToString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> Module
GHC.ms_mod

getLoadedModSummaries :: MonadInterpreter m => m [GHC.ModSummary]
getLoadedModSummaries :: forall (m :: * -> *). MonadInterpreter m => m [ModSummary]
getLoadedModSummaries = do
    ModuleGraph
modGraph <- forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall (m :: * -> *). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
    let modSummaries :: [ModSummary]
modSummaries = ModuleGraph -> [ModSummary]
GHC.mgModSummaries ModuleGraph
modGraph
    forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\ModSummary
modl -> forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GhcMonad m => ModuleName -> m Bool
GHC.isLoaded forall a b. (a -> b) -> a -> b
$ ModSummary -> ModuleName
GHC.ms_mod_name ModSummary
modl) [ModSummary]
modSummaries

-- | Sets the modules whose context is used during evaluation. All bindings
--   of these modules are in scope, not only those exported.
--
--   Modules must be interpreted to use this function.
setTopLevelModules :: MonadInterpreter m => [ModuleName] -> m ()
setTopLevelModules :: forall (m :: * -> *). MonadInterpreter m => [ModuleName] -> m ()
setTopLevelModules [ModuleName]
ms =
    do [ModSummary]
loaded_mods_ghc <- forall (m :: * -> *). MonadInterpreter m => m [ModSummary]
getLoadedModSummaries
       --
       let not_loaded :: [ModuleName]
not_loaded = [ModuleName]
ms forall a. Eq a => [a] -> [a] -> [a]
\\ forall a b. (a -> b) -> [a] -> [b]
map ModSummary -> ModuleName
modNameFromSummary [ModSummary]
loaded_mods_ghc
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
not_loaded) forall a b. (a -> b) -> a -> b
$
         forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ ModuleName -> InterpreterError
NotAllowed (ModuleName
"These modules have not been loaded:\n" forall a. [a] -> [a] -> [a]
++
                              [ModuleName] -> ModuleName
unlines [ModuleName]
not_loaded)
       --
       [PhantomModule]
active_pms <- forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> [PhantomModule]
activePhantoms
       [Module]
ms_mods <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Module
findModule (forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [ModuleName]
ms forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map PhantomModule -> ModuleName
pmName [PhantomModule]
active_pms)
       --
       let mod_is_interpr :: Module -> m Bool
mod_is_interpr Module
modl = forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GhcMonad m => Module -> m Bool
GHC.moduleIsInterpreted Module
modl
       [Module]
not_interpreted <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {m :: * -> *}. MonadInterpreter m => Module -> m Bool
mod_is_interpr) [Module]
ms_mods
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Module]
not_interpreted) forall a b. (a -> b) -> a -> b
$
         forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ ModuleName -> InterpreterError
NotAllowed (ModuleName
"These modules are not interpreted:\n" forall a. [a] -> [a] -> [a]
++
                              [ModuleName] -> ModuleName
unlines (forall a b. (a -> b) -> [a] -> [b]
map Module -> ModuleName
moduleToString [Module]
not_interpreted))
       --
       ([Module]
_, [ImportDecl GhcPs]
old_imports) <- forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall (m :: * -> *).
GhcMonad m =>
m ([Module], [ImportDecl GhcPs])
getContext
       forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
GhcMonad m =>
[Module] -> [ImportDecl GhcPs] -> m ()
setContext [Module]
ms_mods [ImportDecl GhcPs]
old_imports

-- | Sets the modules whose exports must be in context. These can be modules
-- previously loaded with 'loadModules', or modules from packages which hint is
-- aware of. This includes package databases specified to
-- 'unsafeRunInterpreterWithArgs' by the @-package-db=...@ parameter, and
-- packages specified by a ghc environment file created by @cabal build --write-ghc-environment-files=always@.
--
--   Warning: 'setImports', 'setImportsQ', and 'setImportsF' are mutually exclusive.
--   If you have a list of modules to be used qualified and another list
--   unqualified, then you need to do something like
--
--   >  setImportsQ ((zip unqualified $ repeat Nothing) ++ qualifieds)
setImports :: MonadInterpreter m => [ModuleName] -> m ()
setImports :: forall (m :: * -> *). MonadInterpreter m => [ModuleName] -> m ()
setImports [ModuleName]
ms = forall (m :: * -> *). MonadInterpreter m => [ModuleImport] -> m ()
setImportsF forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\ModuleName
m -> ModuleName -> ModuleQualification -> ImportList -> ModuleImport
ModuleImport ModuleName
m ModuleQualification
NotQualified ImportList
NoImportList) [ModuleName]
ms

-- | A variant of 'setImports' where modules them may be qualified. e.g.:
--
--   @setImportsQ [("Prelude", Nothing), ("Data.Map", Just "M")]@.
--
--   Here, "map" will refer to Prelude.map and "M.map" to Data.Map.map.
setImportsQ :: MonadInterpreter m => [(ModuleName, Maybe String)] -> m ()
setImportsQ :: forall (m :: * -> *).
MonadInterpreter m =>
[(ModuleName, Maybe ModuleName)] -> m ()
setImportsQ [(ModuleName, Maybe ModuleName)]
ms = forall (m :: * -> *). MonadInterpreter m => [ModuleImport] -> m ()
setImportsF forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(ModuleName
m,Maybe ModuleName
q) -> ModuleName -> ModuleQualification -> ImportList -> ModuleImport
ModuleImport ModuleName
m (forall b a. b -> (a -> b) -> Maybe a -> b
maybe ModuleQualification
NotQualified (Maybe ModuleName -> ModuleQualification
QualifiedAs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) Maybe ModuleName
q) ImportList
NoImportList) [(ModuleName, Maybe ModuleName)]
ms

-- | A variant of 'setImportsQ' where modules may have an explicit import list. e.g.:
--
--   @setImportsF [ModuleImport "Prelude" NotQualified NoImportList, ModuleImport "Data.Text" (QualifiedAs $ Just "Text") (HidingList ["pack"])]@

setImportsF :: MonadInterpreter m => [ModuleImport] -> m ()
setImportsF :: forall (m :: * -> *). MonadInterpreter m => [ModuleImport] -> m ()
setImportsF [ModuleImport]
moduleImports = do
       [Module]
regularMods <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Module
findModule forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleImport -> ModuleName
modName) [ModuleImport]
regularImports
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Module
findModule forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleImport -> ModuleName
modName) [ModuleImport]
phantomImports -- just to be sure they exist
       --
       Maybe PhantomModule
old_qual_hack_mod <- forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> Maybe PhantomModule
importQualHackMod
       forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (m :: * -> *). MonadInterpreter m => PhantomModule -> m ()
removePhantomModule Maybe PhantomModule
old_qual_hack_mod
       --
       Maybe PhantomModule
maybe_phantom_module <- do
         if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleImport]
phantomImports
           then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
           else do
             let moduleContents :: [ModuleName]
moduleContents = forall a b. (a -> b) -> [a] -> [b]
map ModuleImport -> ModuleName
newImportLine [ModuleImport]
phantomImports
             PhantomModule
new_phantom_module <- forall (m :: * -> *).
MonadInterpreter m =>
(ModuleName -> ModuleName) -> m PhantomModule
addPhantomModule forall a b. (a -> b) -> a -> b
$ \ModuleName
mod_name
               -> [ModuleName] -> ModuleName
unlines forall a b. (a -> b) -> a -> b
$ (ModuleName
"module " forall a. [a] -> [a] -> [a]
++ ModuleName
mod_name forall a. [a] -> [a] -> [a]
++ ModuleName
" where ")
                          forall a. a -> [a] -> [a]
: [ModuleName]
moduleContents
             forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\InterpreterState
s -> InterpreterState
s{importQualHackMod :: Maybe PhantomModule
importQualHackMod = forall a. a -> Maybe a
Just PhantomModule
new_phantom_module})
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just PhantomModule
new_phantom_module
       --
       [Module]
phantom_mods <- case Maybe PhantomModule
maybe_phantom_module of
         Maybe PhantomModule
Nothing -> do
           forall (f :: * -> *) a. Applicative f => a -> f a
pure []
         Just PhantomModule
phantom_module-> do
           Module
phantom_mod <- forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Module
findModule (PhantomModule -> ModuleName
pmName PhantomModule
phantom_module)
           forall (f :: * -> *) a. Applicative f => a -> f a
pure [Module
phantom_mod]
       ([Module]
old_top_level, [ImportDecl GhcPs]
_) <- forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall (m :: * -> *).
GhcMonad m =>
m ([Module], [ImportDecl GhcPs])
getContext
       let new_top_level :: [Module]
new_top_level = [Module]
phantom_mods forall a. [a] -> [a] -> [a]
++ [Module]
old_top_level
       forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GhcMonad m => [Module] -> [Module] -> m ()
setContextModules [Module]
new_top_level [Module]
regularMods
       --
       forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\InterpreterState
s ->InterpreterState
s{qualImports :: [ModuleImport]
qualImports = [ModuleImport]
phantomImports})
  where
    ([ModuleImport]
regularImports, [ModuleImport]
phantomImports) = forall a b. [Either a b] -> ([a], [b])
partitionEithers
                                     forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\ModuleImport
m -> if ModuleImport -> Bool
isQualified ModuleImport
m Bool -> Bool -> Bool
|| ModuleImport -> Bool
hasImportList ModuleImport
m
                                                  then forall a b. b -> Either a b
Right ModuleImport
m  -- phantom
                                                  else forall a b. a -> Either a b
Left ModuleImport
m)
                                           [ModuleImport]
moduleImports
    isQualified :: ModuleImport -> Bool
isQualified ModuleImport
m = ModuleImport -> ModuleQualification
modQual ModuleImport
m forall a. Eq a => a -> a -> Bool
/= ModuleQualification
NotQualified
    hasImportList :: ModuleImport -> Bool
hasImportList ModuleImport
m = ModuleImport -> ImportList
modImp ModuleImport
m forall a. Eq a => a -> a -> Bool
/= ImportList
NoImportList
    newImportLine :: ModuleImport -> ModuleName
newImportLine ModuleImport
m = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ModuleName
"import ", case ModuleImport -> ModuleQualification
modQual ModuleImport
m of
                                            ModuleQualification
NotQualified -> ModuleImport -> ModuleName
modName ModuleImport
m
                                            ImportAs ModuleName
q -> ModuleImport -> ModuleName
modName ModuleImport
m forall a. [a] -> [a] -> [a]
++ ModuleName
" as " forall a. [a] -> [a] -> [a]
++ ModuleName
q
                                            QualifiedAs Maybe ModuleName
Nothing -> ModuleName
"qualified " forall a. [a] -> [a] -> [a]
++ ModuleImport -> ModuleName
modName ModuleImport
m
                                            QualifiedAs (Just ModuleName
q) -> ModuleName
"qualified " forall a. [a] -> [a] -> [a]
++ ModuleImport -> ModuleName
modName ModuleImport
m forall a. [a] -> [a] -> [a]
++ ModuleName
" as " forall a. [a] -> [a] -> [a]
++ ModuleName
q
                             ,case ModuleImport -> ImportList
modImp ModuleImport
m of
                                 ImportList
NoImportList -> ModuleName
""
                                 ImportList [ModuleName]
l -> ModuleName
" (" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate ModuleName
"," [ModuleName]
l forall a. [a] -> [a] -> [a]
++ ModuleName
")"
                                 HidingList [ModuleName]
l -> ModuleName
" hiding (" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate ModuleName
"," [ModuleName]
l forall a. [a] -> [a] -> [a]
++ ModuleName
")"
                             ]

-- | 'cleanPhantomModules' works like 'reset', but skips the
--   loading of the support module that installs '_show'. Its purpose
--   is to clean up all temporary files generated for phantom modules.
cleanPhantomModules :: MonadInterpreter m => m ()
cleanPhantomModules :: forall (m :: * -> *). MonadInterpreter m => m ()
cleanPhantomModules =
    do -- Remove all modules from context
       forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
GhcMonad m =>
[Module] -> [ImportDecl GhcPs] -> m ()
setContext [] []
       --
       -- Unload all previously loaded modules
       forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GhcMonad m => [Target] -> m ()
GHC.setTargets []
       SuccessFlag
_ <- forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GhcMonad m => LoadHowMuch -> m SuccessFlag
GHC.load LoadHowMuch
GHC.LoadAllTargets
       --
       -- At this point, GHCi would call rts_revertCAFs and
       -- reset the buffering of stdin, stdout and stderr.
       -- Should we do any of these?
       --
       -- liftIO $ rts_revertCAFs
       --
       -- We now remove every phantom module and forget about qual imports
       [PhantomModule]
old_active <- forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> [PhantomModule]
activePhantoms
       [PhantomModule]
old_zombie <- forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> [PhantomModule]
zombiePhantoms
       forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\InterpreterState
s -> InterpreterState
s{activePhantoms :: [PhantomModule]
activePhantoms      = [],
                        zombiePhantoms :: [PhantomModule]
zombiePhantoms      = [],
                        importQualHackMod :: Maybe PhantomModule
importQualHackMod = forall a. Maybe a
Nothing,
                        qualImports :: [ModuleImport]
qualImports         = []})
       forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ModuleName -> IO ()
removeFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhantomModule -> ModuleName
pmFile) ([PhantomModule]
old_active forall a. [a] -> [a] -> [a]
++ [PhantomModule]
old_zombie)

       Maybe ModuleName
old_phantomdir <- forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> Maybe ModuleName
phantomDirectory
       forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\InterpreterState
s -> InterpreterState
s{phantomDirectory :: Maybe ModuleName
phantomDirectory    = forall a. Maybe a
Nothing})
       forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) ModuleName -> IO ()
removeDirectory Maybe ModuleName
old_phantomdir

-- | All imported modules are cleared from the context, and
--   loaded modules are unloaded. It is similar to a @:load@ in
--   GHCi, but observe that not even the Prelude will be in
--   context after a reset.
reset :: MonadInterpreter m => m ()
reset :: forall (m :: * -> *). MonadInterpreter m => m ()
reset = do -- clean up context
           forall (m :: * -> *). MonadInterpreter m => m ()
cleanPhantomModules
           --
           -- Now, install a support module
           forall (m :: * -> *). MonadInterpreter m => [Target] -> m ()
installSupportModule []

-- Load a phantom module with all the symbols from the prelude we need
installSupportModule :: MonadInterpreter m => [GHC.Target] -> m ()
installSupportModule :: forall (m :: * -> *). MonadInterpreter m => [Target] -> m ()
installSupportModule [Target]
ts = do forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GhcMonad m => [Target] -> m ()
GHC.setTargets [Target]
ts
                             PhantomModule
mod <- forall (m :: * -> *).
MonadInterpreter m =>
(ModuleName -> ModuleName) -> m PhantomModule
addPhantomModule ModuleName -> ModuleName
support_module
                             forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\InterpreterState
st -> InterpreterState
st{hintSupportModule :: PhantomModule
hintSupportModule = PhantomModule
mod})
                             Module
mod' <- forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Module
findModule (PhantomModule -> ModuleName
pmName PhantomModule
mod)
                             forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
GhcMonad m =>
[Module] -> [ImportDecl GhcPs] -> m ()
setContext [Module
mod'] []
    --
    where support_module :: ModuleName -> ModuleName
support_module ModuleName
m = [ModuleName] -> ModuleName
unlines [
                               ModuleName
"module " forall a. [a] -> [a] -> [a]
++ ModuleName
m forall a. [a] -> [a] -> [a]
++ ModuleName
"( ",
                               ModuleName
"    " forall a. [a] -> [a] -> [a]
++ ModuleName
_String forall a. [a] -> [a] -> [a]
++ ModuleName
",",
                               ModuleName
"    " forall a. [a] -> [a] -> [a]
++ ModuleName
_show   forall a. [a] -> [a] -> [a]
++ ModuleName
")",
                               ModuleName
"where",
                               ModuleName
"",
                               ModuleName
"import qualified Prelude as " forall a. [a] -> [a] -> [a]
++ ModuleName
_P forall a. [a] -> [a] -> [a]
++ ModuleName
" (String, Show(show))",
                               ModuleName
"",
                               ModuleName
"type " forall a. [a] -> [a] -> [a]
++ ModuleName
_String forall a. [a] -> [a] -> [a]
++ ModuleName
" = " forall a. [a] -> [a] -> [a]
++ ModuleName
_P forall a. [a] -> [a] -> [a]
++ ModuleName
".String",
                               ModuleName
"",
                               ModuleName
_show forall a. [a] -> [a] -> [a]
++ ModuleName
" :: " forall a. [a] -> [a] -> [a]
++ ModuleName
_P forall a. [a] -> [a] -> [a]
++ ModuleName
".Show a => a -> " forall a. [a] -> [a] -> [a]
++ ModuleName
_P forall a. [a] -> [a] -> [a]
++ ModuleName
".String",
                               ModuleName
_show forall a. [a] -> [a] -> [a]
++ ModuleName
" = " forall a. [a] -> [a] -> [a]
++ ModuleName
_P forall a. [a] -> [a] -> [a]
++ ModuleName
".show"
                             ]
            where _String :: ModuleName
_String = ModuleName -> ModuleName
altStringName ModuleName
m
                  _show :: ModuleName
_show   = ModuleName -> ModuleName
altShowName ModuleName
m
                  _P :: ModuleName
_P      = ModuleName -> ModuleName
altPreludeName ModuleName
m

-- Call it when the support module is an active phantom module but has been
-- unloaded as a side effect by GHC (e.g. by calling GHC.loadTargets)
reinstallSupportModule :: [GHC.Target] -> MonadInterpreter m => m ()
reinstallSupportModule :: forall (m :: * -> *). [Target] -> MonadInterpreter m => m ()
reinstallSupportModule [Target]
ts = do PhantomModule
pm <- forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> PhantomModule
hintSupportModule
                               forall (m :: * -> *). MonadInterpreter m => PhantomModule -> m ()
removePhantomModule PhantomModule
pm
                               forall (m :: * -> *). MonadInterpreter m => [Target] -> m ()
installSupportModule [Target]
ts

altStringName :: ModuleName -> String
altStringName :: ModuleName -> ModuleName
altStringName ModuleName
mod_name = ModuleName
"String_" forall a. [a] -> [a] -> [a]
++ ModuleName
mod_name

altShowName :: ModuleName -> String
altShowName :: ModuleName -> ModuleName
altShowName ModuleName
mod_name = ModuleName
"show_" forall a. [a] -> [a] -> [a]
++ ModuleName
mod_name

altPreludeName :: ModuleName -> String
altPreludeName :: ModuleName -> ModuleName
altPreludeName ModuleName
mod_name = ModuleName
"Prelude_" forall a. [a] -> [a] -> [a]
++ ModuleName
mod_name

supportString :: MonadInterpreter m => m String
supportString :: forall (m :: * -> *). MonadInterpreter m => m ModuleName
supportString = do ModuleName
mod_name <- forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState (PhantomModule -> ModuleName
pmName forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpreterState -> PhantomModule
hintSupportModule)
                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ModuleName
mod_name, ModuleName
".", ModuleName -> ModuleName
altStringName ModuleName
mod_name]

supportShow :: MonadInterpreter m => m String
supportShow :: forall (m :: * -> *). MonadInterpreter m => m ModuleName
supportShow = do ModuleName
mod_name <- forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState (PhantomModule -> ModuleName
pmName forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpreterState -> PhantomModule
hintSupportModule)
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ModuleName
mod_name, ModuleName
".", ModuleName -> ModuleName
altShowName ModuleName
mod_name]

-- SHOULD WE CALL THIS WHEN MODULES ARE LOADED / UNLOADED?
-- foreign import ccall "revertCAFs" rts_revertCAFs :: IO ()