import {-# SOURCE #-} RnExpr( rnLExpr )
import HsSyn
-import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv )
+import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv, globalRdrEnvElts,
+ GlobalRdrElt(..), isLocalGRE )
import RdrHsSyn ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
import RnHsSyn
import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
import Name ( Name, nameOccName )
import NameSet
import NameEnv
+import OccName ( occEnvElts )
import Outputable
import SrcLoc ( Located(..), unLoc, getLoc, noLoc )
import DynFlags ( DynFlag(..) )
-- Deal with top-level fixity decls
-- (returns the total new fixity env)
- fix_env <- rnSrcFixityDecls fix_decls ;
+ fix_env <- rnSrcFixityDeclsEnv fix_decls ;
+ rn_fix_decls <- rnSrcFixityDecls fix_decls ;
updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
$ do {
rn_group = HsGroup { hs_valds = rn_val_decls,
hs_tyclds = rn_tycl_decls,
hs_instds = rn_inst_decls,
- hs_fixds = [],
+ hs_fixds = rn_fix_decls,
hs_depds = [],
hs_fords = rn_foreign_decls,
hs_defds = rn_default_decls,
%*********************************************************
\begin{code}
-rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM FixityEnv
+rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
rnSrcFixityDecls fix_decls
+ = do fix_decls <- mapM rnFixityDecl fix_decls
+ return (concat fix_decls)
+
+rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
+rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
+ = do names <- lookupLocalDataTcNames rdr_name
+ return [ L loc (FixitySig (L nameLoc name) fixity)
+ | name <- names ]
+
+rnSrcFixityDeclsEnv :: [LFixitySig RdrName] -> RnM FixityEnv
+rnSrcFixityDeclsEnv fix_decls
= getGblEnv `thenM` \ gbl_env ->
- foldlM rnFixityDecl (tcg_fix_env gbl_env)
+ foldlM rnFixityDeclEnv (tcg_fix_env gbl_env)
fix_decls `thenM` \ fix_env ->
traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_`
returnM fix_env
-rnFixityDecl :: FixityEnv -> LFixitySig RdrName -> RnM FixityEnv
-rnFixityDecl fix_env (L loc (FixitySig rdr_name fixity))
+rnFixityDeclEnv :: FixityEnv -> LFixitySig RdrName -> RnM FixityEnv
+rnFixityDeclEnv fix_env (L loc (FixitySig rdr_name fixity))
= setSrcSpan loc $
-- GHC extension: look up both the tycon and data con
-- for con-like things
%*********************************************************
\begin{code}
-rnHsRuleDecl (HsRule rule_name act vars lhs rhs)
+rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
= bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
- rnLExpr lhs `thenM` \ (lhs', fv_lhs) ->
- rnLExpr rhs `thenM` \ (rhs', fv_rhs) ->
+ rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
+ rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
let
mb_bad = validRuleLhs ids lhs'
in
checkErr (isNothing mb_bad)
(badRuleLhsErr rule_name lhs' mb_bad) `thenM_`
let
- bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
+ bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
in
mappM (addErr . badRuleVar rule_name) bad_vars `thenM_`
- returnM (HsRule rule_name act vars' lhs' rhs',
- fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
+ returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
+ fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
where
doc = text "In the transformation rule" <+> ftext rule_name
-- Check the signatures
-- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
let
- sig_rdr_names_w_locs = [op | L _ (Sig op _) <- sigs]
+ sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
in
checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
-- Typechecker is responsible for checking that we only
%* *
%*********************************************************
+Note [Splices]
+~~~~~~~~~~~~~~
+Consider
+ f = ...
+ h = ...$(thing "f")...
+
+The splice can expand into literally anything, so when we do dependency
+analysis we must assume that it might mention 'f'. So we simply treat
+all locally-defined names as mentioned by any splice. This is terribly
+brutal, but I don't see what else to do. For example, it'll mean
+that every locally-defined thing will appear to be used, so no unused-binding
+warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
+and that will crash the type checker because 'f' isn't in scope.
+
+Currently, I'm not treating a splice as also mentioning every import,
+which is a bit inconsistent -- but there are a lot of them. We might
+thereby get some bogus unused-import warnings, but we won't crash the
+type checker. Not very satisfactory really.
+
\begin{code}
rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
rnSplice (HsSplice n expr)
- = checkTH expr "splice" `thenM_`
- getSrcSpanM `thenM` \ loc ->
- newLocalsRn [L loc n] `thenM` \ [n'] ->
- rnLExpr expr `thenM` \ (expr', fvs) ->
- returnM (HsSplice n' expr', fvs)
+ = do { checkTH expr "splice"
+ ; loc <- getSrcSpanM
+ ; [n'] <- newLocalsRn [L loc n]
+ ; (expr', fvs) <- rnLExpr expr
+
+ -- Ugh! See Note [Splices] above
+ ; lcl_rdr <- getLocalRdrEnv
+ ; gbl_rdr <- getGlobalRdrEnv
+ ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
+ isLocalGRE gre]
+ lcl_names = mkNameSet (occEnvElts lcl_rdr)
+
+ ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
#ifdef GHCI
checkTH e what = returnM () -- OK
projects / ghc-hetmet.git / blobdiff