diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs index c017a7cc0191d44f457ab579c8b216d44d50af94..1c707c4afcd3d60011888b686c91fe86e510eaa2 100644 --- a/compiler/deSugar/DsMonad.lhs +++ b/compiler/deSugar/DsMonad.lhs @@ -221,7 +221,7 @@ initDs hsc_env mod rdr_env type_env fam_inst_env thing_inside } where -- Extend the global environment with a 'GlobalRdrEnv' containing the exported entities of - -- * 'Data.Array.Parallel' iff '-XParallalArrays' specified (see also 'checkLoadDAP'). + -- * 'Data.Array.Parallel' iff '-XParallelArrays' specified (see also 'checkLoadDAP'). -- * 'Data.Array.Parallel.Prim' iff '-fvectorise' specified. loadDAP thing_inside = do { dapEnv <- loadOneModule dATA_ARRAY_PARALLEL_NAME checkLoadDAP paErr diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index faaea6c456be024aa5d5e8075bd722937f1c2201..3b2f7f25c97ae67c04d3d9ed5a9f323b7f20a480 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -92,7 +92,7 @@ loadSrcInterface doc mod want_boot maybe_pkg Failed err -> failWithTc err Succeeded iface -> return iface } --- | Like loadSrcInterface, but returns a MaybeErr +-- | Like 'loadSrcInterface', but returns a 'MaybeErr'. loadSrcInterface_maybe :: SDoc -> ModuleName -> IsBootInterface -- {-# SOURCE #-} ? @@ -111,7 +111,10 @@ loadSrcInterface_maybe doc mod want_boot maybe_pkg Found _ mod -> initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot) err -> return (Failed (cannotFindInterface (hsc_dflags hsc_env) mod err)) } --- | Load interface for a module. +-- | Load interface directly for a fully qualified 'Module'. (This is a fairly +-- rare operation, but in particular it is used to load orphan modules +-- in order to pull their instances into the global package table and to +-- handle some operations in GHCi). loadModuleInterface :: SDoc -> Module -> TcM ModIface loadModuleInterface doc mod = initIfaceTcRn (loadSysInterface doc mod) diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index cabf31138214a6f7aba6ac0b8f503d462ed5588e..85ea0f94ccf6595ebeceb6f8fe0cd2a985196bd8 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -184,9 +184,9 @@ We need to make sure that we have at least *read* the interface files for any module with an instance decl or RULE that we might want. * If the instance decl is an orphan, we have a whole separate mechanism - (loadOprhanModules) + (loadOrphanModules) -* If the instance decl not an orphan, then the act of looking at the +* If the instance decl is not an orphan, then the act of looking at the TyCon or Class will force in the defining module for the TyCon/Class, and hence the instance decl diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index cd414999af40015d2777a9e1e6d1bbe0ed7c6410..1088c84d0407c7a4a1c1c5229cfce2242541a507 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -1250,6 +1250,9 @@ mkIfLclEnv mod loc = IfLclEnv { if_mod = mod, if_tv_env = emptyUFM, if_id_env = emptyUFM } +-- | Run an 'IfG' (top-level interface monad) computation inside an existing +-- 'TcRn' (typecheck-renaming monad) computation by initializing an 'IfGblEnv' +-- based on 'TcGblEnv'. initIfaceTcRn :: IfG a -> TcRn a initIfaceTcRn thing_inside = do { tcg_env <- getGblEnv diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index e1762a8f7312de91c1c725f55c2e0314c9b2b8ad..2634aa852f10fb239ce7d3e5c16a93c2734b5408 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -143,7 +143,11 @@ import qualified Language.Haskell.TH as TH The monad itself has to be defined here, because it is mentioned by ErrCtxt \begin{code} +-- | Type alias for 'IORef'; the convention is we'll use this for mutable +-- bits of data in 'TcGblEnv' which are updated during typechecking and +-- returned at the end. type TcRef a = IORef a +-- ToDo: when should I refer to it as a 'TcId' instead of an 'Id'? type TcId = Id type TcIdSet = IdSet @@ -153,9 +157,19 @@ type IfM lcl = TcRnIf IfGblEnv lcl -- Iface stuff type IfG = IfM () -- Top level type IfL = IfM IfLclEnv -- Nested + +-- | Type-checking and renaming monad: the main monad that most type-checking +-- takes place in. The global environment is 'TcGblEnv', which tracks +-- all of the top-level type-checking information we've accumulated while +-- checking a module, while the local environment is 'TcLclEnv', which +-- tracks local information as we move inside expressions. type TcRn = TcRnIf TcGblEnv TcLclEnv -type RnM = TcRn -- Historical -type TcM = TcRn -- Historical + +-- | Historical "renaming monad" (now it's just 'TcRn'). +type RnM = TcRn + +-- | Historical "type-checking monad" (now it's just 'TcRn'). +type TcM = TcRn \end{code} Representation of type bindings to uninstantiated meta variables used during @@ -203,12 +217,11 @@ instance ContainsDynFlags (Env gbl lcl) where instance ContainsModule gbl => ContainsModule (Env gbl lcl) where extractModule env = extractModule (env_gbl env) --- TcGblEnv describes the top-level of the module at the +-- | 'TcGblEnv' describes the top-level of the module at the -- point at which the typechecker is finished work. -- It is this structure that is handed on to the desugarer -- For state that needs to be updated during the typechecking --- phase and returned at end, use a TcRef (= IORef). - +-- phase and returned at end, use a 'TcRef' (= 'IORef'). data TcGblEnv = TcGblEnv { tcg_mod :: Module, -- ^ Module being compiled @@ -494,8 +507,8 @@ data IfLclEnv %* * %************************************************************************ -The Global-Env/Local-Env story -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [The Global-Env/Local-Env story] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During type checking, we keep in the tcg_type_env * All types and classes * All Ids derived from types and classes (constructors, selectors)