diff options
Diffstat (limited to 'compiler/GHC/Runtime')
| -rw-r--r-- | compiler/GHC/Runtime/Context.hs | 389 | ||||
| -rw-r--r-- | compiler/GHC/Runtime/Debugger.hs | 31 | ||||
| -rw-r--r-- | compiler/GHC/Runtime/Eval.hs | 68 | ||||
| -rw-r--r-- | compiler/GHC/Runtime/Eval/Types.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Runtime/Heap/Inspect.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Runtime/Interpreter.hs | 32 | ||||
| -rw-r--r-- | compiler/GHC/Runtime/Linker.hs | 61 | ||||
| -rw-r--r-- | compiler/GHC/Runtime/Linker/Types.hs | 71 | ||||
| -rw-r--r-- | compiler/GHC/Runtime/Loader.hs | 29 |
9 files changed, 584 insertions, 101 deletions
diff --git a/compiler/GHC/Runtime/Context.hs b/compiler/GHC/Runtime/Context.hs new file mode 100644 index 0000000000..7220dea503 --- /dev/null +++ b/compiler/GHC/Runtime/Context.hs @@ -0,0 +1,389 @@ +module GHC.Runtime.Context + ( InteractiveContext (..) + , InteractiveImport (..) + , emptyInteractiveContext + , extendInteractiveContext + , extendInteractiveContextWithIds + , setInteractivePrintName + , substInteractiveContext + , icExtendGblRdrEnv + , icInteractiveModule + , icInScopeTTs + , icPrintUnqual + ) +where + +import GHC.Prelude + +import GHC.Hs + +import GHC.Driver.Session + +import GHC.Runtime.Eval.Types ( Resume ) + +import GHC.Unit + +import GHC.Core.FamInstEnv +import GHC.Core.InstEnv ( ClsInst, identicalClsInstHead ) +import GHC.Core.Type + +import GHC.Types.Avail +import GHC.Types.Fixity.Env +import GHC.Types.Id.Info ( IdDetails(..) ) +import GHC.Types.Name +import GHC.Types.Name.Env +import GHC.Types.Name.Reader +import GHC.Types.Name.Ppr +import GHC.Types.TyThing +import GHC.Types.Var + +import GHC.Builtin.Names ( ioTyConName, printName, mkInteractiveModule ) + +import GHC.Utils.Outputable +import GHC.Utils.Misc + +{- +Note [The interactive package] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Type, class, and value declarations at the command prompt are treated +as if they were defined in modules + interactive:Ghci1 + interactive:Ghci2 + ...etc... +with each bunch of declarations using a new module, all sharing a +common package 'interactive' (see Module.interactiveUnitId, and +GHC.Builtin.Names.mkInteractiveModule). + +This scheme deals well with shadowing. For example: + + ghci> data T = A + ghci> data T = B + ghci> :i A + data Ghci1.T = A -- Defined at <interactive>:2:10 + +Here we must display info about constructor A, but its type T has been +shadowed by the second declaration. But it has a respectable +qualified name (Ghci1.T), and its source location says where it was +defined. + +So the main invariant continues to hold, that in any session an +original name M.T only refers to one unique thing. (In a previous +iteration both the T's above were called :Interactive.T, albeit with +different uniques, which gave rise to all sorts of trouble.) + +The details are a bit tricky though: + + * The field ic_mod_index counts which Ghci module we've got up to. + It is incremented when extending ic_tythings + + * ic_tythings contains only things from the 'interactive' package. + + * Module from the 'interactive' package (Ghci1, Ghci2 etc) never go + in the Home Package Table (HPT). When you say :load, that's when we + extend the HPT. + + * The 'homeUnitId' field of DynFlags is *not* set to 'interactive'. + It stays as 'main' (or whatever -this-unit-id says), and is the + package to which :load'ed modules are added to. + + * So how do we arrange that declarations at the command prompt get to + be in the 'interactive' package? Simply by setting the tcg_mod + field of the TcGblEnv to "interactive:Ghci1". This is done by the + call to initTc in initTcInteractive, which in turn get the module + from it 'icInteractiveModule' field of the interactive context. + + The 'homeUnitId' field stays as 'main' (or whatever -this-unit-id says. + + * The main trickiness is that the type environment (tcg_type_env) and + fixity envt (tcg_fix_env), now contain entities from all the + interactive-package modules (Ghci1, Ghci2, ...) together, rather + than just a single module as is usually the case. So you can't use + "nameIsLocalOrFrom" to decide whether to look in the TcGblEnv vs + the HPT/PTE. This is a change, but not a problem provided you + know. + +* However, the tcg_binds, tcg_sigs, tcg_insts, tcg_fam_insts, etc fields + of the TcGblEnv, which collect "things defined in this module", all + refer to stuff define in a single GHCi command, *not* all the commands + so far. + + In contrast, tcg_inst_env, tcg_fam_inst_env, have instances from + all GhciN modules, which makes sense -- they are all "home package" + modules. + + +Note [Interactively-bound Ids in GHCi] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The Ids bound by previous Stmts in GHCi are currently + a) GlobalIds, with + b) An External Name, like Ghci4.foo + See Note [The interactive package] above + c) A tidied type + + (a) They must be GlobalIds (not LocalIds) otherwise when we come to + compile an expression using these ids later, the byte code + generator will consider the occurrences to be free rather than + global. + + (b) Having an External Name is important because of Note + [GlobalRdrEnv shadowing] in GHC.Types.Names.RdrName + + (c) Their types are tidied. This is important, because :info may ask + to look at them, and :info expects the things it looks up to have + tidy types + +Where do interactively-bound Ids come from? + + - GHCi REPL Stmts e.g. + ghci> let foo x = x+1 + These start with an Internal Name because a Stmt is a local + construct, so the renamer naturally builds an Internal name for + each of its binders. Then in tcRnStmt they are externalised via + GHC.Tc.Module.externaliseAndTidyId, so they get Names like Ghic4.foo. + + - Ids bound by the debugger etc have Names constructed by + GHC.Iface.Env.newInteractiveBinder; at the call sites it is followed by + mkVanillaGlobal or mkVanillaGlobalWithInfo. So again, they are + all Global, External. + + - TyCons, Classes, and Ids bound by other top-level declarations in + GHCi (eg foreign import, record selectors) also get External + Names, with Ghci9 (or 8, or 7, etc) as the module name. + + +Note [ic_tythings] +~~~~~~~~~~~~~~~~~~ +The ic_tythings field contains + * The TyThings declared by the user at the command prompt + (eg Ids, TyCons, Classes) + + * The user-visible Ids that arise from such things, which + *don't* come from 'implicitTyThings', notably: + - record selectors + - class ops + The implicitTyThings are readily obtained from the TyThings + but record selectors etc are not + +It does *not* contain + * DFunIds (they can be gotten from ic_instances) + * CoAxioms (ditto) + +See also Note [Interactively-bound Ids in GHCi] + +Note [Override identical instances in GHCi] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If you declare a new instance in GHCi that is identical to a previous one, +we simply override the previous one; we don't regard it as overlapping. +e.g. Prelude> data T = A | B + Prelude> instance Eq T where ... + Prelude> instance Eq T where ... -- This one overrides + +It's exactly the same for type-family instances. See #7102 +-} + +-- | Interactive context, recording information about the state of the +-- context in which statements are executed in a GHCi session. +data InteractiveContext + = InteractiveContext { + ic_dflags :: DynFlags, + -- ^ The 'DynFlags' used to evaluate interactive expressions + -- and statements. + + ic_mod_index :: Int, + -- ^ Each GHCi stmt or declaration brings some new things into + -- scope. We give them names like interactive:Ghci9.T, + -- where the ic_index is the '9'. The ic_mod_index is + -- incremented whenever we add something to ic_tythings + -- See Note [The interactive package] + + ic_imports :: [InteractiveImport], + -- ^ The GHCi top-level scope (ic_rn_gbl_env) is extended with + -- these imports + -- + -- This field is only stored here so that the client + -- can retrieve it with GHC.getContext. GHC itself doesn't + -- use it, but does reset it to empty sometimes (such + -- as before a GHC.load). The context is set with GHC.setContext. + + ic_tythings :: [TyThing], + -- ^ TyThings defined by the user, in reverse order of + -- definition (ie most recent at the front) + -- See Note [ic_tythings] + + ic_rn_gbl_env :: GlobalRdrEnv, + -- ^ The cached 'GlobalRdrEnv', built by + -- 'GHC.Runtime.Eval.setContext' and updated regularly + -- It contains everything in scope at the command line, + -- including everything in ic_tythings + + ic_instances :: ([ClsInst], [FamInst]), + -- ^ All instances and family instances created during + -- this session. These are grabbed en masse after each + -- update to be sure that proper overlapping is retained. + -- That is, rather than re-check the overlapping each + -- time we update the context, we just take the results + -- from the instance code that already does that. + + ic_fix_env :: FixityEnv, + -- ^ Fixities declared in let statements + + ic_default :: Maybe [Type], + -- ^ The current default types, set by a 'default' declaration + + ic_resume :: [Resume], + -- ^ The stack of breakpoint contexts + + ic_monad :: Name, + -- ^ The monad that GHCi is executing in + + ic_int_print :: Name, + -- ^ The function that is used for printing results + -- of expressions in ghci and -e mode. + + ic_cwd :: Maybe FilePath + -- virtual CWD of the program + } + +data InteractiveImport + = IIDecl (ImportDecl GhcPs) + -- ^ Bring the exports of a particular module + -- (filtered by an import decl) into scope + + | IIModule ModuleName + -- ^ Bring into scope the entire top-level envt of + -- of this module, including the things imported + -- into it. + + +-- | Constructs an empty InteractiveContext. +emptyInteractiveContext :: DynFlags -> InteractiveContext +emptyInteractiveContext dflags + = InteractiveContext { + ic_dflags = dflags, + ic_imports = [], + ic_rn_gbl_env = emptyGlobalRdrEnv, + ic_mod_index = 1, + ic_tythings = [], + ic_instances = ([],[]), + ic_fix_env = emptyNameEnv, + ic_monad = ioTyConName, -- IO monad by default + ic_int_print = printName, -- System.IO.print by default + ic_default = Nothing, + ic_resume = [], + ic_cwd = Nothing } + +icInteractiveModule :: InteractiveContext -> Module +icInteractiveModule (InteractiveContext { ic_mod_index = index }) + = mkInteractiveModule index + +-- | This function returns the list of visible TyThings (useful for +-- e.g. showBindings) +icInScopeTTs :: InteractiveContext -> [TyThing] +icInScopeTTs = ic_tythings + +-- | Get the PrintUnqualified function based on the flags and this InteractiveContext +icPrintUnqual :: UnitState -> HomeUnit -> InteractiveContext -> PrintUnqualified +icPrintUnqual unit_state home_unit InteractiveContext{ ic_rn_gbl_env = grenv } = + mkPrintUnqualified unit_state home_unit grenv + +-- | extendInteractiveContext is called with new TyThings recently defined to update the +-- InteractiveContext to include them. Ids are easily removed when shadowed, +-- but Classes and TyCons are not. Some work could be done to determine +-- whether they are entirely shadowed, but as you could still have references +-- to them (e.g. instances for classes or values of the type for TyCons), it's +-- not clear whether removing them is even the appropriate behavior. +extendInteractiveContext :: InteractiveContext + -> [TyThing] + -> [ClsInst] -> [FamInst] + -> Maybe [Type] + -> FixityEnv + -> InteractiveContext +extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults fix_env + = ictxt { ic_mod_index = ic_mod_index ictxt + 1 + -- Always bump this; even instances should create + -- a new mod_index (#9426) + , ic_tythings = new_tythings ++ old_tythings + , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings + , ic_instances = ( new_cls_insts ++ old_cls_insts + , new_fam_insts ++ fam_insts ) + -- we don't shadow old family instances (#7102), + -- so don't need to remove them here + , ic_default = defaults + , ic_fix_env = fix_env -- See Note [Fixity declarations in GHCi] + } + where + new_ids = [id | AnId id <- new_tythings] + old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt) + + -- Discard old instances that have been fully overridden + -- See Note [Override identical instances in GHCi] + (cls_insts, fam_insts) = ic_instances ictxt + old_cls_insts = filterOut (\i -> any (identicalClsInstHead i) new_cls_insts) cls_insts + +extendInteractiveContextWithIds :: InteractiveContext -> [Id] -> InteractiveContext +-- Just a specialised version +extendInteractiveContextWithIds ictxt new_ids + | null new_ids = ictxt + | otherwise = ictxt { ic_mod_index = ic_mod_index ictxt + 1 + , ic_tythings = new_tythings ++ old_tythings + , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings } + where + new_tythings = map AnId new_ids + old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt) + +shadowed_by :: [Id] -> TyThing -> Bool +shadowed_by ids = shadowed + where + shadowed id = getOccName id `elemOccSet` new_occs + new_occs = mkOccSet (map getOccName ids) + +setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext +setInteractivePrintName ic n = ic{ic_int_print = n} + + -- ToDo: should not add Ids to the gbl env here + +-- | Add TyThings to the GlobalRdrEnv, earlier ones in the list shadowing +-- later ones, and shadowing existing entries in the GlobalRdrEnv. +icExtendGblRdrEnv :: GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv +icExtendGblRdrEnv env tythings + = foldr add env tythings -- Foldr makes things in the front of + -- the list shadow things at the back + where + -- One at a time, to ensure each shadows the previous ones + add thing env + | is_sub_bndr thing + = env + | otherwise + = foldl' extendGlobalRdrEnv env1 (concatMap localGREsFromAvail avail) + where + env1 = shadowNames env (concatMap availNames avail) + avail = tyThingAvailInfo thing + + -- Ugh! The new_tythings may include record selectors, since they + -- are not implicit-ids, and must appear in the TypeEnv. But they + -- will also be brought into scope by the corresponding (ATyCon + -- tc). And we want the latter, because that has the correct + -- parent (#10520) + is_sub_bndr (AnId f) = case idDetails f of + RecSelId {} -> True + ClassOpId {} -> True + _ -> False + is_sub_bndr _ = False + +substInteractiveContext :: InteractiveContext -> TCvSubst -> InteractiveContext +substInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst + | isEmptyTCvSubst subst = ictxt + | otherwise = ictxt { ic_tythings = map subst_ty tts } + where + subst_ty (AnId id) + = AnId $ updateIdTypeAndMult (substTyAddInScope subst) id + -- Variables in the interactive context *can* mention free type variables + -- because of the runtime debugger. Otherwise you'd expect all + -- variables bound in the interactive context to be closed. + subst_ty tt + = tt + +instance Outputable InteractiveImport where + ppr (IIModule m) = char '*' <> ppr m + ppr (IIDecl d) = ppr d + diff --git a/compiler/GHC/Runtime/Debugger.hs b/compiler/GHC/Runtime/Debugger.hs index 3def133bea..e86357a0ea 100644 --- a/compiler/GHC/Runtime/Debugger.hs +++ b/compiler/GHC/Runtime/Debugger.hs @@ -14,30 +14,35 @@ module GHC.Runtime.Debugger (pprintClosureCommand, showTerm, pprTypeAndContents) import GHC.Prelude +import GHC + +import GHC.Driver.Session +import GHC.Driver.Ppr +import GHC.Driver.Monad +import GHC.Driver.Env + import GHC.Runtime.Linker import GHC.Runtime.Heap.Inspect - import GHC.Runtime.Interpreter -import GHCi.RemoteTypes -import GHC.Driver.Monad -import GHC.Driver.Types -import GHC.Types.Id +import GHC.Runtime.Context + import GHC.Iface.Syntax ( showToHeader ) import GHC.Iface.Env ( newInteractiveBinder ) -import GHC.Types.Name -import GHC.Types.Var hiding ( varName ) -import GHC.Types.Var.Set -import GHC.Types.Unique.Set import GHC.Core.Type -import GHC + import GHC.Utils.Outputable -import GHC.Core.Ppr.TyThing import GHC.Utils.Error import GHC.Utils.Monad -import GHC.Driver.Session -import GHC.Driver.Ppr import GHC.Utils.Exception +import GHC.Types.Id +import GHC.Types.Name +import GHC.Types.Var hiding ( varName ) +import GHC.Types.Var.Set +import GHC.Types.Unique.Set +import GHC.Types.TyThing.Ppr +import GHC.Types.TyThing + import Control.Monad import Control.Monad.Catch as MC import Data.List ( (\\) ) diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs index 68d2908dbb..337cd24d80 100644 --- a/compiler/GHC/Runtime/Eval.hs +++ b/compiler/GHC/Runtime/Eval.hs @@ -48,28 +48,57 @@ module GHC.Runtime.Eval ( import GHC.Prelude -import GHC.Runtime.Eval.Types +import GHC.Driver.Monad +import GHC.Driver.Main +import GHC.Driver.Env +import GHC.Driver.Session +import GHC.Driver.Ppr +import GHC.Runtime.Eval.Types import GHC.Runtime.Interpreter as GHCi import GHC.Runtime.Interpreter.Types +import GHC.Runtime.Linker as Linker +import GHC.Runtime.Linker.Types +import GHC.Runtime.Heap.Inspect +import GHC.Runtime.Context import GHCi.Message import GHCi.RemoteTypes -import GHC.Driver.Monad -import GHC.Driver.Main +import GHC.ByteCode.Types + import GHC.Hs -import GHC.Driver.Types + +import GHC.Core.Predicate import GHC.Core.InstEnv -import GHC.Iface.Env ( newInteractiveBinder ) import GHC.Core.FamInstEnv ( FamInst ) import GHC.Core.FVs ( orphNamesOfFamInst ) import GHC.Core.TyCon import GHC.Core.Type hiding( typeKind ) import qualified GHC.Core.Type as Type -import GHC.Types.RepType + +import GHC.Iface.Env ( newInteractiveBinder ) import GHC.Tc.Utils.TcType import GHC.Tc.Types.Constraint import GHC.Tc.Types.Origin -import GHC.Core.Predicate + +import GHC.Builtin.Names ( toDynName, pretendNameIsInScope ) +import GHC.Builtin.Types ( isCTupleTyConName ) + +import GHC.Data.Maybe +import GHC.Data.FastString +import GHC.Data.Bag + +import GHC.Utils.Monad +import GHC.Utils.Panic +import GHC.Utils.Error +import GHC.Utils.Outputable +import GHC.Utils.Misc + +import qualified GHC.Parser.Lexer as Lexer (P (..), ParseResult(..), unP, initParserState) +import GHC.Parser.Lexer (ParserOpts) +import qualified GHC.Parser as Parser (parseStmt, parseModule, parseDeclaration, parseImport) + +import GHC.Types.RepType +import GHC.Types.Fixity.Env import GHC.Types.Var import GHC.Types.Id as Id import GHC.Types.Name hiding ( varName ) @@ -77,28 +106,15 @@ import GHC.Types.Name.Set import GHC.Types.Avail import GHC.Types.Name.Reader import GHC.Types.Var.Env -import GHC.ByteCode.Types -import GHC.Runtime.Linker as Linker -import GHC.Driver.Session -import GHC.Driver.Ppr +import GHC.Types.SrcLoc import GHC.Types.Unique import GHC.Types.Unique.Supply -import GHC.Utils.Monad +import GHC.Types.TyThing + import GHC.Unit -import GHC.Builtin.Names ( toDynName, pretendNameIsInScope ) -import GHC.Builtin.Types ( isCTupleTyConName ) -import GHC.Utils.Panic -import GHC.Data.Maybe -import GHC.Utils.Error -import GHC.Types.SrcLoc -import GHC.Runtime.Heap.Inspect -import GHC.Utils.Outputable -import GHC.Data.FastString -import GHC.Data.Bag -import GHC.Utils.Misc -import qualified GHC.Parser.Lexer as Lexer (P (..), ParseResult(..), unP, initParserState) -import GHC.Parser.Lexer (ParserOpts) -import qualified GHC.Parser as Parser (parseStmt, parseModule, parseDeclaration, parseImport) +import GHC.Unit.Module.ModIface +import GHC.Unit.Module.ModSummary +import GHC.Unit.Home.ModInfo import System.Directory import Data.Dynamic diff --git a/compiler/GHC/Runtime/Eval/Types.hs b/compiler/GHC/Runtime/Eval/Types.hs index 9586947742..c72c5c89ff 100644 --- a/compiler/GHC/Runtime/Eval/Types.hs +++ b/compiler/GHC/Runtime/Eval/Types.hs @@ -18,9 +18,9 @@ import GHCi.RemoteTypes import GHCi.Message (EvalExpr, ResumeContext) import GHC.Types.Id import GHC.Types.Name +import GHC.Types.TyThing import GHC.Unit.Module import GHC.Types.Name.Reader -import GHC.Core.Type import GHC.Types.SrcLoc import GHC.Utils.Exception diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs index 7bcb1a364c..34c55760ac 100644 --- a/compiler/GHC/Runtime/Heap/Inspect.hs +++ b/compiler/GHC/Runtime/Heap/Inspect.hs @@ -30,7 +30,7 @@ import GHC.Platform import GHC.Runtime.Interpreter as GHCi import GHCi.RemoteTypes -import GHC.Driver.Types +import GHC.Driver.Env import GHCi.Message ( fromSerializableException ) import GHC.Core.DataCon diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs index bcfd34ee15..b2df09f35f 100644 --- a/compiler/GHC/Runtime/Interpreter.hs +++ b/compiler/GHC/Runtime/Interpreter.hs @@ -55,28 +55,36 @@ module GHC.Runtime.Interpreter import GHC.Prelude +import GHC.Driver.Ppr (showSDoc) +import GHC.Driver.Env +import GHC.Driver.Session + import GHC.Runtime.Interpreter.Types import GHCi.Message import GHCi.RemoteTypes import GHCi.ResolvedBCO import GHCi.BreakArray (BreakArray) -import GHC.Utils.Fingerprint -import GHC.Driver.Types +import GHC.Runtime.Eval.Types(BreakInfo(..)) +import GHC.Runtime.Linker.Types +import GHC.ByteCode.Types + +import GHC.Data.Maybe +import GHC.Data.FastString + +import GHC.Types.Unique +import GHC.Types.SrcLoc import GHC.Types.Unique.FM +import GHC.Types.Basic + import GHC.Utils.Panic -import GHC.Driver.Session import GHC.Utils.Exception as Ex -import GHC.Types.Basic -import GHC.Data.FastString -import GHC.Utils.Misc -import GHC.Runtime.Eval.Types(BreakInfo(..)) import GHC.Utils.Outputable(brackets, ppr) -import GHC.Driver.Ppr (showSDoc) -import GHC.Types.SrcLoc -import GHC.Data.Maybe +import GHC.Utils.Fingerprint +import GHC.Utils.Misc + import GHC.Unit.Module -import GHC.ByteCode.Types -import GHC.Types.Unique +import GHC.Unit.Module.ModIface +import GHC.Unit.Home.ModInfo #if defined(HAVE_INTERNAL_INTERPRETER) import GHCi.Run diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs index 4477a0ad2f..4203f741c6 100644 --- a/compiler/GHC/Runtime/Linker.hs +++ b/compiler/GHC/Runtime/Linker.hs @@ -31,40 +31,53 @@ where import GHC.Prelude +import GHC.Platform +import GHC.Platform.Ways + +import GHC.Driver.Phases +import GHC.Driver.Env +import GHC.Driver.Session +import GHC.Driver.Ppr + +import GHC.Tc.Utils.Monad + import GHC.Runtime.Interpreter import GHC.Runtime.Interpreter.Types +import GHC.Runtime.Linker.Types import GHCi.RemoteTypes + import GHC.Iface.Load + import GHC.ByteCode.Linker import GHC.ByteCode.Asm import GHC.ByteCode.Types -import GHC.Tc.Utils.Monad -import GHC.Unit.State as Packages -import GHC.Driver.Phases -import GHC.Driver.Finder -import GHC.Driver.Types -import GHC.Platform.Ways + +import GHC.SysTools +import GHC.SysTools.FileCleanup + +import GHC.Types.Basic import GHC.Types.Name import GHC.Types.Name.Env -import GHC.Unit.Module -import GHC.Unit.Home -import GHC.Data.List.SetOps -import GHC.Runtime.Linker.Types (DynLinker(..), PersistentLinkerState(..)) -import GHC.Driver.Session -import GHC.Driver.Ppr -import GHC.Types.Basic +import GHC.Types.SrcLoc +import GHC.Types.Unique.DSet + import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc import GHC.Utils.Error -import GHC.Types.SrcLoc + +import GHC.Unit.Finder +import GHC.Unit.Module +import GHC.Unit.Module.ModIface +import GHC.Unit.Module.Deps +import GHC.Unit.Home +import GHC.Unit.Home.ModInfo +import GHC.Unit.State as Packages + +import qualified GHC.Data.ShortText as ST import qualified GHC.Data.Maybe as Maybes -import GHC.Types.Unique.DSet import GHC.Data.FastString -import qualified GHC.Data.ShortText as ST -import GHC.Platform -import GHC.SysTools -import GHC.SysTools.FileCleanup +import GHC.Data.List.SetOps -- Standard libraries import Control.Monad @@ -446,7 +459,7 @@ preloadLib hsc_env lib_paths framework_paths pls lib_spec = do return pls DLL dll_unadorned -> do - maybe_errstr <- loadDLL hsc_env (mkSOName platform dll_unadorned) + maybe_errstr <- loadDLL hsc_env (platformSOName platform dll_unadorned) case maybe_errstr of Nothing -> maybePutStrLn dflags "done" Just mm | platformOS platform /= OSDarwin -> @@ -918,7 +931,7 @@ dynLoadObjs hsc_env pls@PersistentLinkerState{..} objs = do let minus_ls = [ lib | Option ('-':'l':lib) <- ldInputs dflags ] let minus_big_ls = [ lib | Option ('-':'L':lib) <- ldInputs dflags ] (soFile, libPath , libName) <- - newTempLibName dflags TFL_CurrentModule (soExt platform) + newTempLibName dflags TFL_CurrentModule (platformSOExt platform) let dflags2 = dflags { -- We don't want the original ldInputs in @@ -1342,7 +1355,7 @@ linkPackage hsc_env pkg mapM_ (load_dyn hsc_env True) known_dlls -- For remaining `dlls` crash early only when there is surely -- no package's DLL around ... (not is_dyn) - mapM_ (load_dyn hsc_env (not is_dyn) . mkSOName platform) dlls + mapM_ (load_dyn hsc_env (not is_dyn) . platformSOName platform) dlls #endif -- After loading all the DLLs, we can load the static objects. -- Ordering isn't important here, because we do one final link @@ -1528,9 +1541,9 @@ locateLib hsc_env is_hs lib_dirs gcc_dirs lib ] hs_dyn_lib_name = lib ++ '-':programName dflags ++ projectVersion dflags - hs_dyn_lib_file = mkHsSOName platform hs_dyn_lib_name + hs_dyn_lib_file = platformHsSOName platform hs_dyn_lib_name - so_name = mkSOName platform lib + so_name = platformSOName platform lib lib_so_name = "lib" ++ so_name dyn_lib_file = case (arch, os) of (ArchX86_64, OSSolaris2) -> "64" </> so_name diff --git a/compiler/GHC/Runtime/Linker/Types.hs b/compiler/GHC/Runtime/Linker/Types.hs index 7899feae9e..e40de2b55e 100644 --- a/compiler/GHC/Runtime/Linker/Types.hs +++ b/compiler/GHC/Runtime/Linker/Types.hs @@ -6,26 +6,35 @@ -- ----------------------------------------------------------------------------- -module GHC.Runtime.Linker.Types ( - DynLinker(..), - PersistentLinkerState(..), - Linkable(..), - Unlinked(..), - SptEntry(..) - ) where - -import GHC.Prelude ( FilePath, String, show ) +module GHC.Runtime.Linker.Types + ( DynLinker(..) + , PersistentLinkerState(..) + , Linkable(..) + , Unlinked(..) + , SptEntry(..) + , isObjectLinkable + , linkableObjs + , isObject + , nameOfObject + , isInterpretable + , byteCodeOfObject + ) +where + +import GHC.Prelude import Data.Time ( UTCTime ) -import Data.Maybe ( Maybe ) import Control.Concurrent.MVar ( MVar ) import GHC.Unit ( UnitId, Module ) import GHC.ByteCode.Types ( ItblEnv, CompiledByteCode ) -import GHC.Utils.Outputable -import GHC.Types.Var ( Id ) import GHC.Fingerprint.Type ( Fingerprint ) +import GHCi.RemoteTypes ( ForeignHValue ) + +import GHC.Types.Var ( Id ) import GHC.Types.Name.Env ( NameEnv ) import GHC.Types.Name ( Name ) -import GHCi.RemoteTypes ( ForeignHValue ) + +import GHC.Utils.Outputable +import GHC.Utils.Panic type ClosureEnv = NameEnv (Name, ForeignHValue) @@ -106,3 +115,39 @@ data SptEntry = SptEntry Id Fingerprint instance Outputable SptEntry where ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr + +isObjectLinkable :: Linkable -> Bool +isObjectLinkable l = not (null unlinked) && all isObject unlinked + where unlinked = linkableUnlinked l + -- A linkable with no Unlinked's is treated as a BCO. We can + -- generate a linkable with no Unlinked's as a result of + -- compiling a module in NoBackend mode, and this choice + -- happens to work well with checkStability in module GHC. + +linkableObjs :: Linkable -> [FilePath] +linkableObjs l = [ f | DotO f <- linkableUnlinked l ] + +------------------------------------------- + +-- | Is this an actual file on disk we can link in somehow? +isObject :: Unlinked -> Bool +isObject (DotO _) = True +isObject (DotA _) = True +isObject (DotDLL _) = True +isObject _ = False + +-- | Is this a bytecode linkable with no file on disk? +isInterpretable :: Unlinked -> Bool +isInterpretable = not . isObject + +-- | Retrieve the filename of the linkable if possible. Panic if it is a byte-code object +nameOfObject :: Unlinked -> FilePath +nameOfObject (DotO fn) = fn +nameOfObject (DotA fn) = fn +nameOfObject (DotDLL fn) = fn +nameOfObject other = pprPanic "nameOfObject" (ppr other) + +-- | Retrieve the compiled byte-code if possible. Panic if it is a file-based linkable +byteCodeOfObject :: Unlinked -> CompiledByteCode +byteCodeOfObject (BCOs bc _) = bc +byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other) diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs index be89d86192..2a97e24edd 100644 --- a/compiler/GHC/Runtime/Loader.hs +++ b/compiler/GHC/Runtime/Loader.hs @@ -21,38 +21,45 @@ module GHC.Runtime.Loader ( ) where import GHC.Prelude + import GHC.Driver.Session import GHC.Driver.Ppr +import GHC.Driver.Hooks +import GHC.Driver.Plugins import GHC.Runtime.Linker ( linkModule, getHValue ) import GHC.Runtime.Interpreter ( wormhole, withInterp ) import GHC.Runtime.Interpreter.Types -import GHC.Types.SrcLoc ( noSrcSpan ) -import GHC.Driver.Finder ( findPluginModule, cannotFindModule ) + import GHC.Tc.Utils.Monad ( initTcInteractive, initIfaceTcRn ) import GHC.Iface.Load ( loadPluginInterface ) -import GHC.Types.Name.Reader ( RdrName, ImportSpec(..), ImpDeclSpec(..) - , ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName - , gre_name, mkRdrQual ) -import GHC.Types.Name.Occurrence ( OccName, mkVarOcc ) import GHC.Rename.Names ( gresFromAvails ) -import GHC.Driver.Plugins import GHC.Builtin.Names ( pluginTyConName, frontendPluginTyConName ) -import GHC.Driver.Types +import GHC.Driver.Env import GHCi.RemoteTypes ( HValue ) import GHC.Core.Type ( Type, eqType, mkTyConTy ) -import GHC.Core.TyCo.Ppr ( pprTyThingCategory ) import GHC.Core.TyCon ( TyCon ) + +import GHC.Types.SrcLoc ( noSrcSpan ) import GHC.Types.Name ( Name, nameModule_maybe ) import GHC.Types.Id ( idType ) +import GHC.Types.TyThing +import GHC.Types.Name.Occurrence ( OccName, mkVarOcc ) +import GHC.Types.Name.Reader ( RdrName, ImportSpec(..), ImpDeclSpec(..) + , ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName + , gre_name, mkRdrQual ) + +import GHC.Unit.Finder ( findPluginModule, cannotFindModule, FindResult(..) ) import GHC.Unit.Module ( Module, ModuleName ) +import GHC.Unit.Module.ModIface + import GHC.Utils.Panic -import GHC.Data.FastString import GHC.Utils.Error import GHC.Utils.Outputable import GHC.Utils.Exception -import GHC.Driver.Hooks + +import GHC.Data.FastString import Control.Monad ( unless ) import Data.Maybe ( mapMaybe ) |