)
import HsSyn ( TyClDecl(..), InstDecl(..),
HsType(..), HsPred(..), FixitySig(..), RuleDecl(..),
- tyClDeclNames, tyClDeclSysNames
- )
-import RdrHsSyn ( RdrNameTyClDecl, RdrNameInstDecl, RdrNameRuleDecl,
- extractSomeHsTysRdrNames
+ tyClDeclNames, tyClDeclSysNames, hsTyVarNames, getHsInstHead,
)
+import RdrHsSyn ( RdrNameTyClDecl, RdrNameInstDecl, RdrNameRuleDecl )
+import RnHsSyn ( extractHsTyNames_s )
import BasicTypes ( Version, defaultFixity )
+import RnTypes ( rnHsType )
import RnEnv
import RnMonad
import ParseIface ( parseIface )
nameModule, isLocalName, nameIsLocalOrFrom
)
import NameEnv
+import NameSet
import Module
-import RdrName ( rdrNameOcc, isRdrTc )
+import RdrName ( rdrNameOcc )
import SrcLoc ( mkSrcLoc )
import Maybes ( maybeToBool, orElse )
import StringBuffer ( hGetStringBuffer )
import Finder ( findModule, findPackageModule )
import Lex
import FiniteMap
+import ListSetOps ( minusList )
import Outputable
import Bag
import Config
new_version_map = extendNameEnv version_map main_name version
in
+ traceRn (text "Loading" <+> ppr full_avail) `thenRn_`
returnRn (new_version_map, new_decls_map)
-----------------------------------------------------
-- if C is visible and *any one* of the Names in the types
-- This is a slightly brutal approximation, but most instance decls
-- are regular H98 ones and it's perfect for them.
+ --
+ -- NOTICE that we rename the type before extracting its free
+ -- variables. The free-variable finder for a renamed HsType
+ -- does the Right Thing for built-in syntax like [] and (,).
+ initIfaceRnMS mod (
+ rnHsType (text "In an interface instance decl") inst_ty
+ ) `thenRn` \ inst_ty' ->
let
- (cls_name,tys) = get_head inst_ty
- free_ty_names = extractSomeHsTysRdrNames isRdrTc tys
- in
- lookupIfaceName cls_name `thenRn` \ cls_name' ->
- mapRn lookupIfaceName free_ty_names `thenRn` \ free_ty_names' ->
- let
- gate_fn vis_fn = vis_fn cls_name' && any vis_fn free_ty_names'
+ (tvs,(cls,tys)) = getHsInstHead inst_ty'
+ free_tcs = nameSetToList (extractHsTyNames_s tys) `minusList` hsTyVarNames tvs
+
+ gate_fn vis_fn = vis_fn cls && (null free_tcs || any vis_fn free_tcs)
-- Here is the implementation of HOWEVER above
+ -- (Note that we do let the inst decl in if it mentions
+ -- no tycons at all. Hence the null free_ty_names.)
in
returnRn ((gate_fn, (mod, decl)) `consBag` insts)
--- In interface files, the instance decls now look like
--- forall a. Foo a -> Baz (T a)
--- so we have to strip off function argument types as well
--- as the bit before the '=>' (which is always empty in interface files)
---
--- The parser ensures the type will have the right shape.
--- (e.g. see ParseUtil.checkInstType)
-
-get_head (HsForAllTy tvs cxt ty) = get_head ty
-get_head (HsFunTy _ ty) = get_head ty
-get_head (HsPredTy (HsClassP cls tys)) = (cls,tys)
-
-
-----------------------------------------------------
-- Loading Rules
loadRule :: Module -> RdrNameRuleDecl -> RnM d (GatedDecl RdrNameRuleDecl)
-- "Gate" the rule simply by whether the rule variable is
-- needed. We can refine this later.
-loadRule mod decl@(IfaceRule _ _ var _ _ src_loc)
+loadRule mod decl@(IfaceRule _ _ _ var _ _ src_loc)
= lookupIfaceName var `thenRn` \ var_name ->
returnRn (\vis_fn -> vis_fn var_name, (mod, decl))
(hiModuleNameMismatchWarn wanted_mod read_mod)
`thenRn_`
-- check that the package names agree
- checkRn
+ warnCheckRn
(modulePackage wanted_mod == modulePackage read_mod)
(packageNameMismatchWarn wanted_mod read_mod)
`thenRn_`
bale_out err = returnRn (Left (badIfaceFile file_path err))
\end{code}
-
%*********************************************************
%* *
\subsection{Looking up fixities}
%* *
%*********************************************************
-@lookupFixityRn@ has to be in RnIfaces (or RnHiFiles) because
-it calls @loadHomeInterface@.
+@lookupFixityRn@ has to be in RnIfaces (or RnHiFiles), instead of
+its obvious home in RnEnv, because it calls @loadHomeInterface@.
lookupFixity is a bit strange.
-- loadHomeInterface, and consulting the Ifaces that comes back
-- from that, because the interface file for the Name might not
-- have been loaded yet. Why not? Suppose you import module A,
- -- which exports a function 'f', which is defined in module B.
+ -- which exports a function 'f', thus;
+ -- module CurrentModule where
+ -- import A( f )
+ -- module A( f ) where
+ -- import B( f )
-- Then B isn't loaded right away (after all, it's possible that
-- nothing from B will be used). When we come across a use of
-- 'f', we need to know its fixity, and it's then, and only
= ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
<+> quotes (ppr mod_name)
-notLoaded mod
- = ptext SLIT("Module") <+> quotes (ppr mod) <+> ptext SLIT("is not loaded")
-
warnSelfImport mod
= ptext SLIT("Importing my own interface: module") <+> ppr mod
\end{code}
-
projects / ghc-hetmet.git / blobdiff