Commit 3db75724 authored by Simon Marlow's avatar Simon Marlow

Add support for all top-level declarations to GHCi

  This is work mostly done by Daniel Winograd-Cort during his
  internship at MSR Cambridge, with some further refactoring by me.

This commit adds support to GHCi for most top-level declarations that
can be used in Haskell source files.  Class, data, newtype, type,
instance are all supported, as are Type Family-related declarations.

The current set of declarations are shown by :show bindings.  As with
variable bindings, entities bound by newer declarations shadow earlier
ones.

Tests are in testsuite/tests/ghci/scripts/ghci039--ghci054.
Documentation to follow.
parent 9de6f19e
......@@ -5,4 +5,6 @@ import Name( Name )
data DataCon
dataConName :: DataCon -> Name
isVanillaDataCon :: DataCon -> Bool
instance Eq DataCon
instance Ord DataCon
\end{code}
......@@ -435,17 +435,17 @@ instance OutputableBndr Name where
pprBndr _ name = pprName name
pprName :: Name -> SDoc
pprName (Name {n_sort = sort, n_uniq = u, n_occ = occ})
pprName n@(Name {n_sort = sort, n_uniq = u, n_occ = occ})
= getPprStyle $ \ sty ->
case sort of
WiredIn mod _ builtin -> pprExternal sty uniq mod occ True builtin
External mod -> pprExternal sty uniq mod occ False UserSyntax
WiredIn mod _ builtin -> pprExternal sty uniq mod occ n True builtin
External mod -> pprExternal sty uniq mod occ n False UserSyntax
System -> pprSystem sty uniq occ
Internal -> pprInternal sty uniq occ
where uniq = mkUniqueGrimily (iBox u)
pprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
pprExternal sty uniq mod occ is_wired is_builtin
pprExternal :: PprStyle -> Unique -> Module -> OccName -> Name -> Bool -> BuiltInSyntax -> SDoc
pprExternal sty uniq mod occ name is_wired is_builtin
| codeStyle sty = ppr mod <> char '_' <> ppr_z_occ_name occ
-- In code style, always qualify
-- ToDo: maybe we could print all wired-in things unqualified
......@@ -455,7 +455,7 @@ pprExternal sty uniq mod occ is_wired is_builtin
pprNameSpaceBrief (occNameSpace occ),
pprUnique uniq])
| BuiltInSyntax <- is_builtin = ppr_occ_name occ -- Never qualify builtin syntax
| otherwise = pprModulePrefix sty mod occ <> ppr_occ_name occ
| otherwise = pprModulePrefix sty mod name <> ppr_occ_name occ
where
pp_mod | opt_SuppressModulePrefixes = empty
| otherwise = ppr mod <> dot
......@@ -482,14 +482,14 @@ pprSystem sty uniq occ
-- so print the unique
pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc
pprModulePrefix :: PprStyle -> Module -> Name -> SDoc
-- Print the "M." part of a name, based on whether it's in scope or not
-- See Note [Printing original names] in HscTypes
pprModulePrefix sty mod occ
pprModulePrefix sty mod name
| opt_SuppressModulePrefixes = empty
| otherwise
= case qualName sty mod occ of -- See Outputable.QualifyName:
= case qualName sty name of -- See Outputable.QualifyName:
NameQual modname -> ppr modname <> dot -- Name is in scope
NameNotInScope1 -> ppr mod <> dot -- Not in scope
NameNotInScope2 -> ppr (modulePackageId mod) <> colon -- Module not in
......
\begin{code}
module Name where
import {-# SOURCE #-} Module
data Name
nameModule :: Name -> Module
\end{code}
......@@ -66,6 +66,7 @@ import Maybes
import SrcLoc
import FastString
import Outputable
import Unique
import Util
import StaticFlags( opt_PprStyle_Debug )
......@@ -247,7 +248,9 @@ instance Outputable RdrName where
ppr (Exact name) = ppr name
ppr (Unqual occ) = ppr occ
ppr (Qual mod occ) = ppr mod <> dot <> ppr occ
ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod occ <> ppr occ)
ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod name <> ppr occ)
where name = mkExternalName (mkUniqueGrimily 0) mod occ noSrcSpan
-- Note [Outputable Orig RdrName] in HscTypes
instance OutputableBndr RdrName where
pprBndr _ n
......
......@@ -56,24 +56,26 @@ deSugar :: HscEnv -> ModLocation -> TcGblEnv -> IO (Messages, Maybe ModGuts)
deSugar hsc_env
mod_loc
tcg_env@(TcGblEnv { tcg_mod = mod,
tcg_src = hsc_src,
tcg_type_env = type_env,
tcg_imports = imports,
tcg_exports = exports,
tcg_keep = keep_var,
tcg_src = hsc_src,
tcg_type_env = type_env,
tcg_imports = imports,
tcg_exports = exports,
tcg_keep = keep_var,
tcg_th_splice_used = tc_splice_used,
tcg_rdr_env = rdr_env,
tcg_fix_env = fix_env,
tcg_inst_env = inst_env,
tcg_fam_inst_env = fam_inst_env,
tcg_warns = warns,
tcg_anns = anns,
tcg_binds = binds,
tcg_imp_specs = imp_specs,
tcg_fix_env = fix_env,
tcg_inst_env = inst_env,
tcg_fam_inst_env = fam_inst_env,
tcg_warns = warns,
tcg_anns = anns,
tcg_binds = binds,
tcg_imp_specs = imp_specs,
tcg_ev_binds = ev_binds,
tcg_fords = fords,
tcg_rules = rules,
tcg_vects = vects,
tcg_tcs = tcs,
tcg_clss = clss,
tcg_insts = insts,
tcg_fam_insts = fam_insts,
tcg_hpc = other_hpc_info })
......@@ -96,8 +98,7 @@ deSugar hsc_env
<- if (opt_Hpc
|| target == HscInterpreted)
&& (not (isHsBoot hsc_src))
then addCoverageTicksToBinds dflags mod mod_loc
(typeEnvTyCons type_env) binds
then addCoverageTicksToBinds dflags mod mod_loc tcs binds
else return (binds, hpcInfo, emptyModBreaks)
initDs hsc_env mod rdr_env type_env $ do
do { ds_ev_binds <- dsEvBinds ev_binds
......@@ -151,26 +152,27 @@ deSugar hsc_env
; used_th <- readIORef tc_splice_used
; let mod_guts = ModGuts {
mg_module = mod,
mg_boot = isHsBoot hsc_src,
mg_exports = exports,
mg_deps = deps,
mg_used_names = used_names,
mg_module = mod,
mg_boot = isHsBoot hsc_src,
mg_exports = exports,
mg_deps = deps,
mg_used_names = used_names,
mg_used_th = used_th,
mg_dir_imps = imp_mods imports,
mg_rdr_env = rdr_env,
mg_fix_env = fix_env,
mg_warns = warns,
mg_anns = anns,
mg_types = type_env,
mg_insts = insts,
mg_fam_insts = fam_insts,
mg_inst_env = inst_env,
mg_fam_inst_env = fam_inst_env,
mg_rules = ds_rules_for_imps,
mg_binds = ds_binds,
mg_foreign = ds_fords,
mg_hpc_info = ds_hpc_info,
mg_rdr_env = rdr_env,
mg_fix_env = fix_env,
mg_warns = warns,
mg_anns = anns,
mg_tcs = tcs,
mg_clss = clss,
mg_insts = insts,
mg_fam_insts = fam_insts,
mg_inst_env = inst_env,
mg_fam_inst_env = fam_inst_env,
mg_rules = ds_rules_for_imps,
mg_binds = ds_binds,
mg_foreign = ds_fords,
mg_hpc_info = ds_hpc_info,
mg_modBreaks = modBreaks,
mg_vect_decls = ds_vects,
mg_vect_info = noVectInfo,
......
......@@ -254,7 +254,7 @@ lookupIE ie con_nm
linkFail :: String -> String -> IO a
linkFail who what
= ghcError (ProgramError $
unlines [ ""
unlines [ "",who
, "During interactive linking, GHCi couldn't find the following symbol:"
, ' ' : ' ' : what
, "This may be due to you not asking GHCi to load extra object files,"
......
......@@ -87,7 +87,7 @@ pprintClosureCommand bindThings force str = do
tidyTermTyVars :: GhcMonad m => Term -> m Term
tidyTermTyVars t =
withSession $ \hsc_env -> do
let env_tvs = tyVarsOfTypes (map idType (ic_tmp_ids (hsc_IC hsc_env)))
let env_tvs = tyThingsTyVars $ ic_tythings $ hsc_IC hsc_env
my_tvs = termTyVars t
tvs = env_tvs `minusVarSet` my_tvs
tyvarOccName = nameOccName . tyVarName
......@@ -110,7 +110,7 @@ bindSuspensions t = do
let (names, tys, hvals) = unzip3 stuff
let ids = [ mkVanillaGlobal name ty
| (name,ty) <- zip names tys]
new_ic = extendInteractiveContext ictxt ids
new_ic = extendInteractiveContext ictxt (map AnId ids)
liftIO $ extendLinkEnv (zip names hvals)
modifySession $ \_ -> hsc_env {hsc_IC = new_ic }
return t'
......@@ -187,10 +187,8 @@ showTerm term = do
bindToFreshName hsc_env ty userName = do
name <- newGrimName userName
let ictxt = hsc_IC hsc_env
tmp_ids = ic_tmp_ids ictxt
id = mkVanillaGlobal name ty
new_ic = ictxt { ic_tmp_ids = id : tmp_ids }
let id = AnId $ mkVanillaGlobal name ty
new_ic = extendInteractiveContext (hsc_IC hsc_env) [id]
return (hsc_env {hsc_IC = new_ic }, name)
-- Create new uniques and give them sequentially numbered names
......@@ -202,20 +200,19 @@ newGrimName userName = do
name = mkInternalName unique occname noSrcSpan
return name
pprTypeAndContents :: GhcMonad m => [Id] -> m SDoc
pprTypeAndContents ids = do
pprTypeAndContents :: GhcMonad m => Id -> m SDoc
pprTypeAndContents id = do
dflags <- GHC.getSessionDynFlags
let pefas = dopt Opt_PrintExplicitForalls dflags
pcontents = dopt Opt_PrintBindContents dflags
pprdId = (pprTyThing pefas . AnId) id
if pcontents
then do
let depthBound = 100
terms <- mapM (GHC.obtainTermFromId depthBound False) ids
docs_terms <- mapM showTerm terms
return $ vcat $ zipWith (\ty cts -> ty <+> equals <+> cts)
(map (pprTyThing pefas . AnId) ids)
docs_terms
else return $ vcat $ map (pprTyThing pefas . AnId) ids
term <- GHC.obtainTermFromId depthBound False id
docs_term <- showTerm term
return $ pprdId <+> equals <+> docs_term
else return pprdId
--------------------------------------------------------------
-- Utils
......
......@@ -12,7 +12,7 @@
-- -fno-cse is needed for GLOBAL_VAR's to behave properly
module Linker ( HValue, getHValue, showLinkerState,
linkExpr, unload, withExtendedLinkEnv,
linkExpr, linkDecls, unload, withExtendedLinkEnv,
extendLinkEnv, deleteFromLinkEnv,
extendLoadedPkgs,
linkPackages,initDynLinker,linkModule,
......@@ -52,6 +52,7 @@ import UniqSet
import FastString
import Config
import SysTools
import PrelNames
-- Standard libraries
import Control.Monad
......@@ -427,9 +428,9 @@ linkExpr hsc_env span root_ul_bco
needed_mods :: [Module]
needed_mods = [ nameModule n | n <- free_names,
isExternalName n, -- Names from other modules
not (isWiredInName n) -- Exclude wired-in names
] -- (see note below)
isExternalName n, -- Names from other modules
not (isWiredInName n) -- Exclude wired-in names
] -- (see note below)
-- Exclude wired-in names because we may not have read
-- their interface files, so getLinkDeps will fail
-- All wired-in names are in the base package, which we link
......@@ -476,7 +477,9 @@ getLinkDeps hsc_env hpt pls maybe_normal_osuf span mods
-- Find all the packages and linkables that a set of modules depends on
= do {
-- 1. Find the dependent home-pkg-modules/packages from each iface
(mods_s, pkgs_s) <- follow_deps mods emptyUniqSet emptyUniqSet;
-- (omitting iINTERACTIVE, which is already linked)
(mods_s, pkgs_s) <- follow_deps (filter ((/=) iNTERACTIVE) mods)
emptyUniqSet emptyUniqSet;
let {
-- 2. Exclude ones already linked
......@@ -488,7 +491,6 @@ getLinkDeps hsc_env hpt pls maybe_normal_osuf span mods
(objs_loaded pls ++ bcos_loaded pls)
} ;
-- putStrLn (showSDoc (ppr mods_s)) ;
-- 3. For each dependent module, find its linkable
-- This will either be in the HPT or (in the case of one-shot
-- compilation) we may need to use maybe_getFileLinkable
......@@ -594,6 +596,53 @@ getLinkDeps hsc_env hpt pls maybe_normal_osuf span mods
adjust_ul _ _ = panic "adjust_ul"
\end{code}
%************************************************************************
%* *
Loading a Decls statement
%* *
%************************************************************************
\begin{code}
linkDecls :: HscEnv -> SrcSpan -> CompiledByteCode -> IO () --[HValue]
linkDecls hsc_env span (ByteCode unlinkedBCOs itblEnv) = do
-- Initialise the linker (if it's not been done already)
let dflags = hsc_dflags hsc_env
initDynLinker dflags
-- Take lock for the actual work.
modifyPLS $ \pls0 -> do
-- Link the packages and modules required
(pls, ok) <- linkDependencies hsc_env pls0 span needed_mods
if failed ok
then ghcError (ProgramError "")
else do
-- Link the expression itself
let ie = plusNameEnv (itbl_env pls) itblEnv
ce = closure_env pls
-- Link the necessary packages and linkables
(final_gce, _) <- linkSomeBCOs False ie ce unlinkedBCOs
let pls2 = pls { closure_env = final_gce,
itbl_env = ie }
return (pls2, ()) --hvals)
where
free_names = concatMap (nameSetToList . bcoFreeNames) unlinkedBCOs
needed_mods :: [Module]
needed_mods = [ nameModule n | n <- free_names,
isExternalName n, -- Names from other modules
not (isWiredInName n) -- Exclude wired-in names
] -- (see note below)
-- Exclude wired-in names because we may not have read
-- their interface files, so getLinkDeps will fail
-- All wired-in names are in the base package, which we link
-- by default, so we can safely ignore them here.
\end{code}
%************************************************************************
%* *
Loading a single module
......
......@@ -71,39 +71,49 @@ allocateGlobalBinder
-> (NameCache, Name)
allocateGlobalBinder name_supply mod occ loc
= case lookupOrigNameCache (nsNames name_supply) mod occ of
-- A hit in the cache! We are at the binding site of the name.
-- This is the moment when we know the SrcLoc
-- of the Name, so we set this field in the Name we return.
--
-- Then (bogus) multiple bindings of the same Name
-- get different SrcLocs can can be reported as such.
--
-- Possible other reason: it might be in the cache because we
-- encountered an occurrence before the binding site for an
-- implicitly-imported Name. Perhaps the current SrcLoc is
-- better... but not really: it'll still just say 'imported'
--
-- IMPORTANT: Don't mess with wired-in names.
-- Their wired-in-ness is in their NameSort
-- and their Module is correct.
Just name | isWiredInName name -> (name_supply, name)
| otherwise -> (new_name_supply, name')
where
uniq = nameUnique name
name' = mkExternalName uniq mod occ loc
new_cache = extendNameCache (nsNames name_supply) mod occ name'
new_name_supply = name_supply {nsNames = new_cache}
-- Miss in the cache!
-- Build a completely new Name, and put it in the cache
Nothing -> (new_name_supply, name)
where
(uniq, us') = takeUniqFromSupply (nsUniqs name_supply)
name = mkExternalName uniq mod occ loc
new_cache = extendNameCache (nsNames name_supply) mod occ name
new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
-- A hit in the cache! We are at the binding site of the name.
-- This is the moment when we know the SrcLoc
-- of the Name, so we set this field in the Name we return.
--
-- Then (bogus) multiple bindings of the same Name
-- get different SrcLocs can can be reported as such.
--
-- Possible other reason: it might be in the cache because we
-- encountered an occurrence before the binding site for an
-- implicitly-imported Name. Perhaps the current SrcLoc is
-- better... but not really: it'll still just say 'imported'
--
-- IMPORTANT: Don't mess with wired-in names.
-- Their wired-in-ness is in their NameSort
-- and their Module is correct.
Just name | isWiredInName name -> (name_supply, name)
| mod /= iNTERACTIVE -> (new_name_supply, name')
-- Note [interactive name cache]
where
uniq = nameUnique name
name' = mkExternalName uniq mod occ loc
new_cache = extendNameCache (nsNames name_supply) mod occ name'
new_name_supply = name_supply {nsNames = new_cache}
-- Miss in the cache!
-- Build a completely new Name, and put it in the cache
_ -> (new_name_supply, name)
where
(uniq, us') = takeUniqFromSupply (nsUniqs name_supply)
name = mkExternalName uniq mod occ loc
new_cache = extendNameCache (nsNames name_supply) mod occ name
new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
{- Note [interactive name cache]
In GHCi we always create Names with the same Module, ":Interactive".
However, we want to be able to shadow older declarations with newer
ones, and we don't want the Name cache giving us back the same Unique
for the new Name as for the old, hence this special case.
See also Note [Outputable Orig RdrName] in HscTypes.
-}
newImplicitBinder :: Name -- Base name
-> (OccName -> OccName) -- Occurrence name modifier
......
......@@ -80,7 +80,7 @@ module GHC (
PrintUnqualified, alwaysQualify,
-- * Interactive evaluation
getBindings, getPrintUnqual,
getBindings, getInsts, getPrintUnqual,
findModule,
lookupModule,
#ifdef GHCI
......@@ -94,7 +94,7 @@ module GHC (
typeKind,
parseName,
RunResult(..),
runStmt, runStmtWithLocation,
runStmt, runStmtWithLocation, runDecls, runDeclsWithLocation,
parseImportDecl, SingleStep(..),
resume,
Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
......@@ -166,7 +166,9 @@ module GHC (
-- ** Instances
Instance,
instanceDFunId, pprInstance, pprInstanceHdr,
instanceDFunId,
pprInstance, pprInstanceHdr,
pprFamInst, pprFamInstHdr,
-- ** Types and Kinds
Type, splitForAllTys, funResultTy,
......@@ -264,8 +266,9 @@ import Class
import DataCon
import Name hiding ( varName )
import InstEnv
import FamInstEnv
import SrcLoc
import CoreSyn ( CoreBind )
import CoreSyn
import TidyPgm
import DriverPhases ( Phase(..), isHaskellSrcFilename )
import Finder
......@@ -864,11 +867,15 @@ compileCore simplify fn = do
-- we just have a ModGuts.
gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
gutsToCoreModule (Left (cg, md)) = CoreModule {
cm_module = cg_module cg, cm_types = md_types md,
cm_module = cg_module cg,
cm_types = md_types md,
cm_binds = cg_binds cg
}
gutsToCoreModule (Right mg) = CoreModule {
cm_module = mg_module mg, cm_types = mg_types mg,
cm_module = mg_module mg,
cm_types = typeEnvFromEntities (bindersOfBinds (mg_binds mg))
(mg_tcs mg) (mg_clss mg)
(mg_fam_insts mg),
cm_binds = mg_binds mg
}
......@@ -899,13 +906,12 @@ isLoaded m = withSession $ \hsc_env ->
-- | Return the bindings for the current interactive session.
getBindings :: GhcMonad m => m [TyThing]
getBindings = withSession $ \hsc_env ->
-- we have to implement the shadowing behaviour of ic_tmp_ids here
-- (see InteractiveContext) and the quickest way is to use an OccEnv.
let
occ_env = mkOccEnv [ (nameOccName (idName id), AnId id)
| id <- ic_tmp_ids (hsc_IC hsc_env) ]
in
return (occEnvElts occ_env)
return $ icInScopeTTs $ hsc_IC hsc_env
-- | Return the instances for the current interactive session.
getInsts :: GhcMonad m => m ([Instance], [FamInst])
getInsts = withSession $ \hsc_env ->
return $ ic_instances (hsc_IC hsc_env)
getPrintUnqual :: GhcMonad m => m PrintUnqualified
getPrintUnqual = withSession $ \hsc_env ->
......
......@@ -63,6 +63,7 @@ module HscMain
, hscRnImportDecls
, hscTcRnLookupRdrName
, hscStmt, hscStmtWithLocation
, hscDecls, hscDeclsWithLocation
, hscTcExpr, hscImport, hscKcType
, hscCompileCoreExpr
#endif
......@@ -71,13 +72,11 @@ module HscMain
#ifdef GHCI
import ByteCodeGen ( byteCodeGen, coreExprToBCOs )
import Linker ( HValue, linkExpr )
import Linker
import CoreTidy ( tidyExpr )
import Type ( Type )
import TcType ( tyVarsOfTypes )
import PrelNames ( iNTERACTIVE )
import PrelNames
import {- Kind parts of -} Type ( Kind )
import Id ( idType )
import CoreLint ( lintUnfolding )
import DsMeta ( templateHaskellNames )
import VarSet
......@@ -85,7 +84,7 @@ import VarEnv ( emptyTidyEnv )
import Panic
#endif
import Id ( Id )
import Id
import Module
import Packages
import RdrName
......@@ -100,7 +99,7 @@ import TcIface ( typecheckIface )
import TcRnMonad
import IfaceEnv ( initNameCache )
import LoadIface ( ifaceStats, initExternalPackageState )
import PrelInfo ( wiredInThings, basicKnownKeyNames )
import PrelInfo
import MkIface
import Desugar
import SimplCore
......@@ -111,8 +110,9 @@ import qualified StgCmm ( codeGen )
import StgSyn
import CostCentre
import ProfInit
import TyCon ( TyCon, isDataTyCon )
import Name ( Name, NamedThing(..) )
import TyCon
import Class
import Name
import SimplStg ( stg2stg )
import CodeGen ( codeGen )
import OldCmm as Old ( CmmGroup )
......@@ -127,7 +127,7 @@ import CodeOutput
import NameEnv ( emptyNameEnv )
import NameSet ( emptyNameSet )
import InstEnv
import FamInstEnv ( emptyFamInstEnv )
import FamInstEnv
import Fingerprint ( Fingerprint )
import DynFlags
......@@ -1287,8 +1287,8 @@ hscStmtWithLocation hsc_env stmt source linenumber = runHsc hsc_env $ do
tcRnStmt hsc_env icontext parsed_stmt
-- Desugar it
let rdr_env = ic_rn_gbl_env icontext
type_env = mkTypeEnv (map AnId (ic_tmp_ids icontext))
ds_expr <- ioMsgMaybe $
type_env = mkTypeEnvWithImplicits (ic_tythings icontext)
ds_expr <- ioMsgMaybe $
deSugarExpr hsc_env iNTERACTIVE rdr_env type_env tc_expr
handleWarnings
......@@ -1297,7 +1297,90 @@ hscStmtWithLocation hsc_env stmt source linenumber = runHsc hsc_env $ do
hsc_env <- getHscEnv
hval <- liftIO $ hscCompileCoreExpr hsc_env src_span ds_expr
return $ Just (ids, hval)
return $ Just (ids, hval)
hscDecls -- Compile a decls
:: HscEnv
-> String -- The statement
-> IO ([TyThing], InteractiveContext)
hscDecls hsc_env str = hscDeclsWithLocation hsc_env str "<interactive>" 1
hscDeclsWithLocation -- Compile a decls
:: HscEnv
-> String -- The statement
-> String -- the source
-> Int -- ^ starting line
-> IO ([TyThing], InteractiveContext)
hscDeclsWithLocation hsc_env str source linenumber = runHsc hsc_env $ do
L _ (HsModule{hsmodDecls=decls}) <-
hscParseThingWithLocation source linenumber parseModule str
-- Rename and typecheck it
let icontext = hsc_IC hsc_env
tc_gblenv <- ioMsgMaybe $ tcRnDeclsi hsc_env icontext decls
-- Grab the new instances
-- We grab the whole environment because of the overlapping that may have
-- been done. See the notes at the definition of InteractiveContext
-- (ic_instances) for more details.
let finsts = famInstEnvElts $ tcg_fam_inst_env tc_gblenv
insts = instEnvElts $ tcg_inst_env tc_gblenv
-- Desugar it
-- We use a basically null location for iNTERACTIVE
let iNTERACTIVELoc = ModLocation{ ml_hs_file = Nothing,
ml_hi_file = undefined,
ml_obj_file = undefined}
ds_result <- ioMsgMaybe $ deSugar hsc_env iNTERACTIVELoc tc_gblenv
handleWarnings
-- Simplify
simpl_mg <- liftIO $ hscSimplify hsc_env ds_result
-- Tidy
(tidy_cg, _mod_details) <- liftIO $ tidyProgram hsc_env simpl_mg
let dflags = hsc_dflags hsc_env
CgGuts{ cg_binds = core_binds,
cg_tycons = tycons,
cg_modBreaks = mod_breaks } = tidy_cg
data_tycons = filter isDataTyCon tycons
-------------------
-- PREPARE FOR CODE GENERATION
-- Do saturation and convert to A-normal form
prepd_binds <- {-# SCC "CorePrep" #-}
liftIO $ corePrepPgm dflags core_binds data_tycons
----------------- Generate byte code ------------------
cbc <- liftIO $ byteCodeGen dflags prepd_binds data_tycons mod_breaks
let src_span = srcLocSpan interactiveSrcLoc
hsc_env <- getHscEnv
liftIO $ linkDecls hsc_env src_span cbc
-- pprTrace "te" (ppr te) $ return ()
let
tcs = filter (not . isImplicitTyCon) $ mg_tcs simpl_mg
clss = mg_clss simpl_mg
tythings = map ATyCon tcs ++ map (ATyCon . classTyCon) clss
sys_vars = filter (isExternalName . idName) $
bindersOfBinds (cg_binds tidy_cg)
-- we only need to keep around the external bindings
-- (as decided by TidyPgm), since those are the only ones