lookupFixityRn,
- getTyClDeclBinders,
- removeContext -- removeContext probably belongs somewhere else
+ getTyClDeclBinders
) where
#include "HsVersions.h"
AvailInfo, GenAvailInfo(..), Avails, Deprecations(..)
)
import HsSyn ( TyClDecl(..), InstDecl(..),
- HsType(..), FixitySig(..), RuleDecl(..),
- tyClDeclNames, tyClDeclSysNames
- )
-import RdrHsSyn ( RdrNameTyClDecl, RdrNameInstDecl, RdrNameRuleDecl,
- extractHsTyRdrNames
+ HsType(..), HsPred(..), FixitySig(..), RuleDecl(..),
+ 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 )
import SrcLoc ( mkSrcLoc )
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)
-----------------------------------------------------
-- instance Foo a => Baz (T a) where ...
--
-- Here the gates are Baz and T, but *not* Foo.
+ --
+ -- HOWEVER: functional dependencies make things more complicated
+ -- class C a b | a->b where ...
+ -- instance C Foo Baz where ...
+ -- Here, the gates are really only C and Foo, *not* Baz.
+ -- That is, if C and Foo are visible, even if Baz isn't, we must
+ -- slurp the decl.
+ --
+ -- Rather than take fundeps into account "properly", we just slurp
+ -- 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
- munged_inst_ty = removeContext inst_ty
- free_names = extractHsTyRdrNames munged_inst_ty
- in
- mapRn lookupIfaceName free_names `thenRn` \ gate_names ->
- returnRn ((gate_names, (mod, decl)) `consBag` insts)
+ (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)
-removeContext (HsForAllTy tvs cxt ty) = HsForAllTy tvs [] (removeFuns ty)
-removeContext ty = removeFuns ty
-
-removeFuns (HsFunTy _ ty) = removeFuns ty
-removeFuns ty = ty
-----------------------------------------------------
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 ([var_name], (mod, decl))
+ 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