I was trying to use GHC API to load .hs
files on the fly. I wrote two .hs
files, test.hs
and Module.hs
, and put them into the /tmp
folder. These two files are very simple. Module.hs
defines a module called Module
containing an Int
value, and test.hs
defines the module Test
which imports Module
and copies the Int
value to itself. Their contents are shown below.
Module.hs
:
module Module (
value_in_module
) where
value_in_module = 1234 :: Int
test.hs
:
module Test (
value
) where
import Module
value = value_in_module
Then in another file, I wrote the following code to invoke GHC API and load those two files.
import Control.Applicative
import DynFlags
import GHC
import GHC.Paths
import MonadUtils (liftIO)
import Unsafe.Coerce
import SimplCore (core2core)
main = defaultErrorHandler defaultFatalMessager defaultFlushOut $
runGhc (Just libdir) $ do
env <- getSession
dflags <- getSessionDynFlags
setSessionDynFlags $ dflags { hscTarget = HscInterpreted, ghcLink = LinkInMemory }
setTargets =<< sequence [guessTarget "/tmp/Module.hs" Nothing, guessTarget "/tmp/test.hs" Nothing]
load LoadAllTargets
setContext [ IIModule $ mkModuleName "Test" ]
-- The following six lines are just for reproducing the warning.
modSum <- getModSummary $ mkModuleName "Test"
pmod <- parseModule modSum
tmod <- typecheckModule pmod
dmod <- desugarModule tmod
let core = coreModule dmod
core' <- liftIO $ core2core env core -- Warning happens here.
-- end
act <- unsafeCoerce <$> compileExpr "print value"
liftIO act
The program runs, but with the following output.
WARNING in hptSomeThingsBelowUs
missing module Module
Probable cause: out-of-date interface files
1234
We can notice that the program successfully evaluates the expression print value
, and outputs 1234
, but the function core2core
emits the warning message above. The six lines between a pair of comments seem to have nothing to do with the rest of the program, because this is just a minimal reproducible example I extracted from another much larger project. Also the warning message does not hurt here, but it causes much more serious problems in that project. The GHC API seems not well documented, so I could not solve the problem after doing a lot of search. Could anyone explain the cause of the warning message, and help me deal with multiple files using GHC APIs? Thanks in advance.