X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FLoadIface.lhs;h=34026a6bf6e02267065fbc7a9cabc946533764eb;hb=58d0b1faf2ea388c695fdaf55d80af9b87482572;hp=1ebbd39b75b6c389df3b0941a81507eee71455e2;hpb=3c4a732b0b011cf356eed1ecd4fdc4d5f1aab193;p=ghc-hetmet.git diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 1ebbd39..34026a6 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -6,6 +6,13 @@ Loading interface files \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module LoadIface ( loadInterface, loadInterfaceForName, loadWiredInHomeIface, loadSrcInterface, loadSysInterface, loadOrphanModules, @@ -300,8 +307,8 @@ loadInterface doc_str mod from badDepMsg mod = hang (ptext SLIT("Interface file inconsistency:")) - 2 (sep [ptext SLIT("home-package module") <+> quotes (ppr mod) <+> ptext SLIT("is mentioned is needed,"), - ptext SLIT("but is not among the dependencies of interfaces directly imported by the module being compiled")]) + 2 (sep [ptext SLIT("home-package module") <+> quotes (ppr mod) <+> ptext SLIT("is needed,"), + ptext SLIT("but is not listed in the dependencies of the interfaces directly imported by the module being compiled")]) ----------------------------------------------------- -- Loading type/class/value decls @@ -336,9 +343,9 @@ loadDecl :: Bool -- Don't load pragmas into the decl pool loadDecl ignore_prags mod (_version, decl) = do { -- Populate the name cache with final versions of all -- the names associated with the decl - main_name <- mk_new_bndr mod (ifName decl) + main_name <- lookupOrig mod (ifName decl) -- ; traceIf (text "Loading decl for " <> ppr main_name) - ; implicit_names <- mapM (mk_new_bndr mod) (ifaceDeclSubBndrs decl) + ; implicit_names <- mapM (lookupOrig mod) (ifaceDeclSubBndrs decl) -- Typecheck the thing, lazily -- NB. Firstly, the laziness is there in case we never need the @@ -350,48 +357,73 @@ loadDecl ignore_prags mod (_version, decl) ; thing <- forkM doc $ do { bumpDeclStats main_name ; tcIfaceDecl ignore_prags decl } - -- Populate the type environment with the implicitTyThings too. - -- - -- Note [Tricky iface loop] - -- ~~~~~~~~~~~~~~~~~~~~~~~~ - -- The delicate point here is that 'mini-env' should be - -- buildable from 'thing' without demanding any of the things 'forkM'd - -- by tcIfaceDecl. For example - -- class C a where { data T a; op :: T a -> Int } - -- We return the bindings - -- [("C", ), ("T", lookup env "T"), ("op", lookup env "op")] - -- The call (lookup env "T") must return the tycon T without first demanding - -- op; because getting the latter will look up T, hence loop. - -- - -- Of course, there is no reason in principle why (lookup env "T") should demand - -- anything do to with op, but take care: - -- (a) implicitTyThings, and - -- (b) getOccName of all the things returned by implicitThings, - -- must not depend on any of the nested type-checks - -- - -- All a bit too finely-balanced for my liking. - + -- Populate the type environment with the implicitTyThings too. + -- + -- Note [Tricky iface loop] + -- ~~~~~~~~~~~~~~~~~~~~~~~~ + -- Summary: The delicate point here is that 'mini-env' must be + -- buildable from 'thing' without demanding any of the things + -- 'forkM'd by tcIfaceDecl. + -- + -- In more detail: Consider the example + -- data T a = MkT { x :: T a } + -- The implicitTyThings of T are: [ , ] + -- (plus their workers, wrappers, coercions etc etc) + -- + -- We want to return an environment + -- [ "MkT" -> , "x" -> , ... ] + -- (where the "MkT" is the *Name* associated with MkT, etc.) + -- + -- We do this by mapping the implict_names to the associated + -- TyThings. By the invariant on ifaceDeclSubBndrs and + -- implicitTyThings, we can use getOccName on the implicit + -- TyThings to make this association: each Name's OccName should + -- be the OccName of exactly one implictTyThing. So the key is + -- to define a "mini-env" + -- + -- [ 'MkT' -> , 'x' -> , ... ] + -- where the 'MkT' here is the *OccName* associated with MkT. + -- + -- However, there is a subtlety: due to how type checking needs + -- to be staged, we can't poke on the forkM'd thunks inside the + -- implictTyThings while building this mini-env. + -- If we poke these thunks too early, two problems could happen: + -- (1) When processing mutually recursive modules across + -- hs-boot boundaries, poking too early will do the + -- type-checking before the recursive knot has been tied, + -- so things will be type-checked in the wrong + -- environment, and necessary variables won't be in + -- scope. + -- + -- (2) Looking up one OccName in the mini_env will cause + -- others to be looked up, which might cause that + -- original one to be looked up again, and hence loop. + -- + -- The code below works because of the following invariant: + -- getOccName on a TyThing does not force the suspended type + -- checks in order to extract the name. For example, we don't + -- poke on the "T a" type of on the way to + -- extracting 's OccName. Of course, there is no + -- reason in principle why getting the OccName should force the + -- thunks, but this means we need to be careful in + -- implicitTyThings and its helper functions. + -- + -- All a bit too finely-balanced for my liking. + + -- This mini-env and lookup function mediates between the + -- *Name*s n and the map from *OccName*s to the implicit TyThings ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing] lookup n = case lookupOccEnv mini_env (getOccName n) of Just thing -> thing Nothing -> pprPanic "loadDecl" (ppr main_name <+> ppr n $$ ppr (decl)) - ; returnM $ (main_name, thing) : [(n, lookup n) | n <- implicit_names] + ; returnM $ (main_name, thing) : + -- uses the invariant that implicit_names and + -- implictTyThings are bijective + [(n, lookup n) | n <- implicit_names] } - -- We build a list from the *known* names, with (lookup n) thunks - -- as the TyThings. That way we can extend the PTE without poking the - -- thunks where - -- mk_new_bndr allocates in the name cache the final canonical - -- name for the thing, with the correct - -- * parent - -- * location - -- imported name, to fix the module correctly in the cache - mk_new_bndr mod occ - = newGlobalBinder mod occ (importedSrcSpan (moduleNameFS (moduleName mod))) - -- ToDo: qualify with the package name if necessary - doc = ptext SLIT("Declaration for") <+> ppr (ifName decl) bumpDeclStats :: Name -> IfL () -- Record that one more declaration has actually been used @@ -593,6 +625,7 @@ pprModIface iface <+> ppr (mi_mod_vers iface) <+> pp_sub_vers <+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty) <+> (if mi_finsts iface then ptext SLIT("[family instance module]") else empty) + <+> (if mi_hpc iface then ptext SLIT("[hpc]") else empty) <+> integer opt_HiVersion <+> ptext SLIT("where") , vcat (map pprExport (mi_exports iface)) @@ -605,7 +638,7 @@ pprModIface iface , vcat (map ppr (mi_rules iface)) , pprVectInfo (mi_vect_info iface) , pprDeprecs (mi_deprecs iface) - ] + ] where pp_boot | mi_boot iface = ptext SLIT("[boot]") | otherwise = empty @@ -677,14 +710,14 @@ pprFixities fixes = ptext SLIT("fixities") <+> pprWithCommas pprFix fixes pprFix (occ,fix) = ppr fix <+> ppr occ pprVectInfo :: IfaceVectInfo -> SDoc -pprVectInfo (IfaceVectInfo { ifaceVectInfoCCVar = vars - , ifaceVectInfoCCTyCon = tycons - , ifaceVectInfoCCTyConReuse = tyconsReuse +pprVectInfo (IfaceVectInfo { ifaceVectInfoVar = vars + , ifaceVectInfoTyCon = tycons + , ifaceVectInfoTyConReuse = tyconsReuse }) = vcat - [ ptext SLIT("CC'ed variables:") <+> hsep (map ppr vars) - , ptext SLIT("CC'ed tycons:") <+> hsep (map ppr tycons) - , ptext SLIT("CC reused tycons:") <+> hsep (map ppr tyconsReuse) + [ ptext SLIT("vectorised variables:") <+> hsep (map ppr vars) + , ptext SLIT("vectorised tycons:") <+> hsep (map ppr tycons) + , ptext SLIT("vectorised reused tycons:") <+> hsep (map ppr tyconsReuse) ] pprDeprecs NoDeprecs = empty