import HscMain ( newHscEnv )
import DriverState ( v_Output_file, v_NoHsMain, v_MainModIs )
import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, isHaskellSrcFilename )
-import Finder ( findModule, findLinkable, addHomeModuleToFinder, flushFinderCache,
- mkHomeModLocation, FindResult(..), cantFindError )
+import Finder ( findModule, findLinkable, addHomeModuleToFinder,
+ flushFinderCache, mkHomeModLocation, FindResult(..), cantFindError )
import HscTypes ( ModSummary(..), HomeModInfo(..), ModIface(..), msHsFilePath,
HscEnv(..), GhciMode(..),
InteractiveContext(..), emptyInteractiveContext,
import DATA_IOREF ( readIORef )
#ifdef GHCI
+import Finder ( findPackageModule )
import HscMain ( hscGetInfo, GetInfoResult, hscStmt, hscTcExpr, hscKcType )
import HscTypes ( TyThing(..), icPrintUnqual, showModMsg )
import TcRnDriver ( mkExportEnv, getModuleContents )
import Name ( Name )
import NameEnv
import Id ( idType )
-import Type ( tidyType )
+import Type ( tidyType, dropForAlls )
import VarEnv ( emptyTidyEnv )
import Linker ( HValue, unload, extendLinkEnv )
import GHC.Exts ( unsafeCoerce# )
import Foreign
import Control.Exception as Exception ( Exception, try )
-import CmdLineOpts ( DynFlag(..), dopt_unset )
+import CmdLineOpts ( DynFlag(..), dopt_unset, dopt )
#endif
import EXCEPTION ( throwDyn )
hsc_env = cm_hsc cmstate
hpt = hsc_HPT hsc_env
- export_env <- mkExportEnv hsc_env (map mkModule exports)
+ let export_mods = map mkModule exports
+ mapM_ (checkModuleExists (hsc_dflags hsc_env) hpt) export_mods
+ export_env <- mkExportEnv hsc_env export_mods
toplev_envs <- mapM (mkTopLevEnv hpt) toplevs
let all_env = foldr plusGlobalRdrEnv export_env toplev_envs
ic_exports = exports,
ic_rn_gbl_env = all_env } }
+checkModuleExists :: DynFlags -> HomePackageTable -> Module -> IO ()
+checkModuleExists dflags hpt mod =
+ case lookupModuleEnv hpt mod of
+ Just mod_info -> return ()
+ _not_a_home_module -> do
+ res <- findPackageModule dflags mod True
+ case res of
+ Found _ _ -> return ()
+ err -> let msg = cantFindError dflags mod err in
+ throwDyn (CmdLineError (showSDoc msg))
+
mkTopLevEnv :: HomePackageTable -> String -> IO GlobalRdrEnv
mkTopLevEnv hpt mod
= case lookupModuleEnv hpt (mkModule mod) of
Nothing -> throwDyn (ProgramError ("mkTopLevEnv: not a home module " ++ mod))
- Just details -> case hm_globals details of
+ Just details -> case mi_globals (hm_iface details) of
Nothing -> throwDyn (ProgramError ("mkTopLevEnv: not interpreted " ++ mod))
Just env -> return env
cmModuleIsInterpreted :: CmState -> String -> IO Bool
cmModuleIsInterpreted cmstate str
= case lookupModuleEnv (cmHPT cmstate) (mkModule str) of
- Just details -> return (isJust (hm_globals details))
+ Just details -> return (isJust (mi_globals (hm_iface details)))
_not_a_home_module -> return False
-----------------------------------------------------------------------------
case maybe_stuff of
Nothing -> return Nothing
- Just ty -> return (Just res_str)
+ Just ty -> return (Just (showSDocForUser unqual doc))
where
- res_str = showSDocForUser unqual (text expr <+> dcolon <+> ppr tidy_ty)
+ doc = text expr <+> dcolon <+> ppr final_ty
unqual = icPrintUnqual (cm_ic cmstate)
tidy_ty = tidyType emptyTidyEnv ty
-
+ dflags = hsc_dflags (cm_hsc cmstate)
+ -- if -fglasgow-exts is on we show the foralls, otherwise
+ -- we don't.
+ final_ty
+ | dopt Opt_GlasgowExts dflags = tidy_ty
+ | otherwise = dropForAlls tidy_ty
-----------------------------------------------------------------------------
-- cmKindOfType: returns a string representing the kind of a type
-- Compilation "succeeded", and may or may not have returned a new
-- linkable (depending on whether compilation was actually performed
-- or not).
- CompOK new_details new_globals new_iface maybe_new_linkable
+ CompOK new_details new_iface maybe_new_linkable
-> do let
new_linkable = maybe_new_linkable `orElse` old_linkable
new_info = HomeModInfo { hm_iface = new_iface,
- hm_globals = new_globals,
hm_details = new_details,
hm_linkable = new_linkable }
return (Just new_info)