diff options
Diffstat (limited to 'compiler/rename/RnEnv.lhs')
| -rw-r--r-- | compiler/rename/RnEnv.lhs | 127 |
1 files changed, 73 insertions, 54 deletions
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index ecd2cd3147..f1adba6bd3 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -14,13 +14,16 @@ module RnEnv ( newTopSrcBinder, lookupLocatedTopBndrRn, lookupTopBndrRn, - lookupLocatedOccRn, lookupOccRn, lookupLocalOccRn_maybe, lookupPromotedOccRn, + lookupLocatedOccRn, lookupOccRn, + lookupLocalOccRn_maybe, + lookupTypeOccRn, lookupKindOccRn, lookupGlobalOccRn, lookupGlobalOccRn_maybe, HsSigCtxt(..), lookupLocalDataTcNames, lookupSigOccRn, lookupFixityRn, lookupTyFixityRn, - lookupInstDeclBndr, lookupSubBndrOcc, greRdrName, + lookupInstDeclBndr, lookupSubBndrOcc, lookupTcdName, + greRdrName, lookupSubBndrGREs, lookupConstructorFields, lookupSyntaxName, lookupSyntaxTable, lookupIfThenElse, lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe, @@ -31,7 +34,6 @@ module RnEnv ( MiniFixityEnv, emptyFsEnv, extendFsEnv, lookupFsEnv, addLocalFixities, bindLocatedLocalsFV, bindLocatedLocalsRn, - bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV, extendTyVarEnvFVRn, checkDupRdrNames, checkDupAndShadowedRdrNames, @@ -40,7 +42,6 @@ module RnEnv ( warnUnusedMatches, warnUnusedTopBinds, warnUnusedLocalBinds, dataTcOccs, unknownNameErr, kindSigErr, dataKindsErr, perhapsForallMsg, - HsDocContext(..), docOfHsDocContext ) where @@ -49,7 +50,6 @@ module RnEnv ( import LoadIface ( loadInterfaceForName, loadSrcInterface ) import IfaceEnv import HsSyn -import RdrHsSyn ( extractHsTyRdrTyVars ) import RdrName import HscTypes import TcEnv ( tcLookupDataCon, tcLookupField, isBrackStage ) @@ -72,7 +72,6 @@ import ListSetOps ( removeDups ) import DynFlags import FastString import Control.Monad -import Data.List import qualified Data.Set as Set \end{code} @@ -271,6 +270,25 @@ lookupInstDeclBndr cls what rdr where doc = what <+> ptext (sLit "of class") <+> quotes (ppr cls) + +----------------------------------------------- +lookupTcdName :: Maybe Name -> TyClDecl RdrName -> RnM (Located Name) +-- Used for TyData and TySynonym only, +-- both ordinary ones and family instances +-- See Note [Family instance binders] +lookupTcdName mb_cls tc_decl + | not (isFamInstDecl tc_decl) -- The normal case + = ASSERT2( isNothing mb_cls, ppr tc_rdr ) -- Parser prevents this + lookupLocatedTopBndrRn tc_rdr + + | Just cls <- mb_cls -- Associated type; c.f RnBinds.rnMethodBind + = wrapLocM (lookupInstDeclBndr cls (ptext (sLit "associated type"))) tc_rdr + + | otherwise -- Family instance; tc_rdr is an *occurrence* + = lookupLocatedOccRn tc_rdr + where + tc_rdr = tcdLName tc_decl + ----------------------------------------------- lookupConstructorFields :: Name -> RnM [Name] -- Look up the fields of a given constructor @@ -374,6 +392,40 @@ lookupSubBndrGREs env parent rdr_name parent_is _ _ = False \end{code} +Note [Family instance binders] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + data family F a + data instance F T = X1 | X2 + +The 'data instance' decl has an *occurrence* of F (and T), and *binds* +X1 and X2. (This is unlike a normal data type declaration which would +bind F too.) So we want an AvailTC F [X1,X2]. + +Now consider a similar pair: + class C a where + data G a + instance C S where + data G S = Y1 | Y2 + +The 'data G S' *binds* Y1 and Y2, and has an *occurrence* of G. + +But there is a small complication: in an instance decl, we don't use +qualified names on the LHS; instead we use the class to disambiguate. +Thus: + module M where + import Blib( G ) + class C a where + data G a + instance C S where + data G S = Y1 | Y2 +Even though there are two G's in scope (M.G and Blib.G), the occurence +of 'G' in the 'instance C S' decl is unambiguous, becuase C has only +one associated type called G. This is exactly what happens for methods, +and it is only consistent to do the same thing for types. That's the +role of the function lookupTcdName; the (Maybe Name) give the class of +the encloseing instance decl, if any. + Note [Looking up Exact RdrNames] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Exact RdrNames are generated by Template Haskell. See Note [Binders @@ -452,10 +504,18 @@ lookupOccRn rdr_name = do opt_name <- lookupOccRn_maybe rdr_name maybe (unboundName WL_Any rdr_name) return opt_name +lookupKindOccRn :: RdrName -> RnM Name +-- Looking up a name occurring in a kind +lookupKindOccRn rdr_name + = do { mb_name <- lookupOccRn_maybe rdr_name + ; case mb_name of + Just name -> return name + Nothing -> unboundName WL_Any rdr_name } + -- lookupPromotedOccRn looks up an optionally promoted RdrName. -lookupPromotedOccRn :: RdrName -> RnM Name +lookupTypeOccRn :: RdrName -> RnM Name -- see Note [Demotion] -lookupPromotedOccRn rdr_name +lookupTypeOccRn rdr_name = do { mb_name <- lookupOccRn_maybe rdr_name ; case mb_name of { Just name -> return name ; @@ -1018,42 +1078,6 @@ bindLocatedLocalsFV rdr_names enclosed_scope return (thing, delFVs names fvs) ------------------------------------- -bindPatSigTyVars :: [LHsType RdrName] -> ([Name] -> RnM a) -> RnM a - -- Find the type variables in the pattern type - -- signatures that must be brought into scope -bindPatSigTyVars tys thing_inside - = do { scoped_tyvars <- xoptM Opt_ScopedTypeVariables - ; if not scoped_tyvars then - thing_inside [] - else - do { name_env <- getLocalRdrEnv - ; let locd_tvs = [ tv | ty <- tys - , tv <- extractHsTyRdrTyVars ty - , not (unLoc tv `elemLocalRdrEnv` name_env) ] - nubbed_tvs = nubBy eqLocated locd_tvs - -- The 'nub' is important. For example: - -- f (x :: t) (y :: t) = .... - -- We don't want to complain about binding t twice! - - ; bindLocatedLocalsRn nubbed_tvs thing_inside }} - -bindPatSigTyVarsFV :: [LHsType RdrName] - -> RnM (a, FreeVars) - -> RnM (a, FreeVars) -bindPatSigTyVarsFV tys thing_inside - = bindPatSigTyVars tys $ \ tvs -> - thing_inside `thenM` \ (result,fvs) -> - return (result, fvs `delListFromNameSet` tvs) - -bindSigTyVarsFV :: [Name] - -> RnM (a, FreeVars) - -> RnM (a, FreeVars) -bindSigTyVarsFV tvs thing_inside - = do { scoped_tyvars <- xoptM Opt_ScopedTypeVariables - ; if not scoped_tyvars then - thing_inside - else - bindLocalNamesFV tvs thing_inside } extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars) -- This function is used only in rnSourceDecl on InstDecl @@ -1148,24 +1172,19 @@ unboundName wl rdr = unboundNameX wl rdr empty unboundNameX :: WhereLooking -> RdrName -> SDoc -> RnM Name unboundNameX where_look rdr_name extra = do { show_helpful_errors <- doptM Opt_HelpfulErrors - ; let err = unknownNameErr rdr_name $$ extra + ; let what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name)) + err = unknownNameErr what rdr_name $$ extra ; if not show_helpful_errors then addErr err else do { suggestions <- unknownNameSuggestErr where_look rdr_name ; addErr (err $$ suggestions) } - ; env <- getGlobalRdrEnv; - ; traceRn (vcat [unknownNameErr rdr_name, - ptext (sLit "Global envt is:"), - nest 3 (pprGlobalRdrEnv env)]) - ; return (mkUnboundName rdr_name) } -unknownNameErr :: RdrName -> SDoc -unknownNameErr rdr_name +unknownNameErr :: SDoc -> RdrName -> SDoc +unknownNameErr what rdr_name = vcat [ hang (ptext (sLit "Not in scope:")) - 2 (pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name)) - <+> quotes (ppr rdr_name)) + 2 (what <+> quotes (ppr rdr_name)) , extra ] where extra | rdr_name == forall_tv_RDR = perhapsForallMsg |