Commit a883f6ba authored by David Himmelstrup's avatar David Himmelstrup
Browse files

Fix bug shown in the mod77 test.

parent 25f1d5c5
...@@ -80,8 +80,8 @@ rnSrcDecls (HsGroup { hs_valds = val_decls, ...@@ -80,8 +80,8 @@ rnSrcDecls (HsGroup { hs_valds = val_decls,
-- Deal with top-level fixity decls -- Deal with top-level fixity decls
-- (returns the total new fixity env) -- (returns the total new fixity env)
fix_env <- rnSrcFixityDeclsEnv fix_decls ;
rn_fix_decls <- rnSrcFixityDecls fix_decls ; rn_fix_decls <- rnSrcFixityDecls fix_decls ;
fix_env <- rnSrcFixityDeclsEnv rn_fix_decls ;
updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env }) updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
$ do { $ do {
...@@ -157,11 +157,16 @@ rnSrcFixityDecls fix_decls ...@@ -157,11 +157,16 @@ rnSrcFixityDecls fix_decls
rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name] rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity)) rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
= do names <- lookupLocalDataTcNames rdr_name = setSrcSpan nameLoc $
-- GHC extension: look up both the tycon and data con
-- for con-like things
-- If neither are in scope, report an error; otherwise
-- add both to the fixity env
do names <- lookupLocalDataTcNames rdr_name
return [ L loc (FixitySig (L nameLoc name) fixity) return [ L loc (FixitySig (L nameLoc name) fixity)
| name <- names ] | name <- names ]
rnSrcFixityDeclsEnv :: [LFixitySig RdrName] -> RnM FixityEnv rnSrcFixityDeclsEnv :: [LFixitySig Name] -> RnM FixityEnv
rnSrcFixityDeclsEnv fix_decls rnSrcFixityDeclsEnv fix_decls
= getGblEnv `thenM` \ gbl_env -> = getGblEnv `thenM` \ gbl_env ->
foldlM rnFixityDeclEnv (tcg_fix_env gbl_env) foldlM rnFixityDeclEnv (tcg_fix_env gbl_env)
...@@ -169,24 +174,15 @@ rnSrcFixityDeclsEnv fix_decls ...@@ -169,24 +174,15 @@ rnSrcFixityDeclsEnv fix_decls
traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_` traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_`
returnM fix_env returnM fix_env
rnFixityDeclEnv :: FixityEnv -> LFixitySig RdrName -> RnM FixityEnv rnFixityDeclEnv :: FixityEnv -> LFixitySig Name -> RnM FixityEnv
rnFixityDeclEnv fix_env (L loc (FixitySig rdr_name fixity)) rnFixityDeclEnv fix_env (L loc (FixitySig (L nameLoc name) fixity))
= setSrcSpan loc $ = case lookupNameEnv fix_env name of
-- GHC extension: look up both the tycon and data con Just (FixItem _ _ loc')
-- for con-like things -> do addLocErr (L nameLoc name) (dupFixityDecl loc')
-- If neither are in scope, report an error; otherwise return fix_env
-- add both to the fixity env Nothing
addLocM lookupLocalDataTcNames rdr_name `thenM` \ names -> -> return (extendNameEnv fix_env name fix_item)
foldlM add fix_env names where fix_item = FixItem (nameOccName name) fixity nameLoc
where
add fix_env name
= case lookupNameEnv fix_env name of
Just (FixItem _ _ loc')
-> addLocErr rdr_name (dupFixityDecl loc') `thenM_`
returnM fix_env
Nothing -> returnM (extendNameEnv fix_env name fix_item)
where
fix_item = FixItem (nameOccName name) fixity (getLoc rdr_name)
pprFixEnv :: FixityEnv -> SDoc pprFixEnv :: FixityEnv -> SDoc
pprFixEnv env pprFixEnv env
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment