Commit d782694f authored by eir@cis.upenn.edu's avatar eir@cis.upenn.edu

Fix #9066.

When splicing in a fixity declaration, look for both term-level things
and type-level things. This requires some changes elsewhere in the
code to allow for more flexibility when looking up Exact names, which
can be assigned the wrong namespace during fixity declaration
conversion.

See the ticket for more info.
parent 1d35c856
...@@ -157,9 +157,14 @@ setRdrNameSpace :: RdrName -> NameSpace -> RdrName ...@@ -157,9 +157,14 @@ setRdrNameSpace :: RdrName -> NameSpace -> RdrName
setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ) setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ) setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ) setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
setRdrNameSpace (Exact n) ns = ASSERT( isExternalName n ) setRdrNameSpace (Exact n) ns
Orig (nameModule n) | isExternalName n
(setOccNameSpace ns (nameOccName n)) = Orig (nameModule n) occ
| otherwise -- This can happen when quoting and then splicing a fixity
-- declaration for a type
= Exact $ mkSystemNameAt (nameUnique n) occ (nameSrcSpan n)
where
occ = setOccNameSpace ns (nameOccName n)
-- demoteRdrName lowers the NameSpace of RdrName. -- demoteRdrName lowers the NameSpace of RdrName.
-- see Note [Demotion] in OccName -- see Note [Demotion] in OccName
......
...@@ -172,7 +172,11 @@ cvtDec (TH.SigD nm typ) ...@@ -172,7 +172,11 @@ cvtDec (TH.SigD nm typ)
; returnJustL $ Hs.SigD (TypeSig [nm'] ty') } ; returnJustL $ Hs.SigD (TypeSig [nm'] ty') }
cvtDec (TH.InfixD fx nm) cvtDec (TH.InfixD fx nm)
= do { nm' <- vNameL nm -- fixity signatures are allowed for variables, constructors, and types
-- the renamer automatically looks for types during renaming, even when
-- the RdrName says it's a variable or a constructor. So, just assume
-- it's a variable or constructor and proceed.
= do { nm' <- vcNameL nm
; returnJustL (Hs.SigD (FixSig (FixitySig nm' (cvtFixity fx)))) } ; returnJustL (Hs.SigD (FixSig (FixitySig nm' (cvtFixity fx)))) }
cvtDec (PragmaD prag) cvtDec (PragmaD prag)
...@@ -521,7 +525,7 @@ cvtPragmaD (AnnP target exp) ...@@ -521,7 +525,7 @@ cvtPragmaD (AnnP target exp)
n' <- tconName n n' <- tconName n
return (TypeAnnProvenance n') return (TypeAnnProvenance n')
ValueAnnotation n -> do ValueAnnotation n -> do
n' <- if isVarName n then vName n else cName n n' <- vcName n
return (ValueAnnProvenance n') return (ValueAnnProvenance n')
; returnJustL $ Hs.AnnD $ HsAnnotation target' exp' ; returnJustL $ Hs.AnnD $ HsAnnotation target' exp'
} }
...@@ -1071,9 +1075,10 @@ cvtFractionalLit r = FL { fl_text = show (fromRational r :: Double), fl_value = ...@@ -1071,9 +1075,10 @@ cvtFractionalLit r = FL { fl_text = show (fromRational r :: Double), fl_value =
-------------------------------------------------------------------- --------------------------------------------------------------------
-- variable names -- variable names
vNameL, cNameL, tconNameL :: TH.Name -> CvtM (Located RdrName) vNameL, cNameL, vcNameL, tconNameL :: TH.Name -> CvtM (Located RdrName)
vName, cName, tName, tconName :: TH.Name -> CvtM RdrName vName, cName, vcName, tName, tconName :: TH.Name -> CvtM RdrName
-- Variable names
vNameL n = wrapL (vName n) vNameL n = wrapL (vName n)
vName n = cvtName OccName.varName n vName n = cvtName OccName.varName n
...@@ -1081,6 +1086,10 @@ vName n = cvtName OccName.varName n ...@@ -1081,6 +1086,10 @@ vName n = cvtName OccName.varName n
cNameL n = wrapL (cName n) cNameL n = wrapL (cName n)
cName n = cvtName OccName.dataName n cName n = cvtName OccName.dataName n
-- Variable *or* constructor names; check by looking at the first char
vcNameL n = wrapL (vcName n)
vcName n = if isVarName n then vName n else cName n
-- Type variable names -- Type variable names
tName n = cvtName OccName.tvName n tName n = cvtName OccName.tvName n
......
...@@ -309,9 +309,21 @@ lookupTopBndrRn_maybe rdr_name ...@@ -309,9 +309,21 @@ lookupTopBndrRn_maybe rdr_name
----------------------------------------------- -----------------------------------------------
-- | Lookup an @Exact@ @RdrName@. See Note [Looking up Exact RdrNames].
-- This adds an error if the name cannot be found.
lookupExactOcc :: Name -> RnM Name lookupExactOcc :: Name -> RnM Name
-- See Note [Looking up Exact RdrNames]
lookupExactOcc name lookupExactOcc name
= do { result <- lookupExactOcc_either name
; case result of
Left err -> do { addErr err
; return name }
Right name' -> return name' }
-- | Lookup an @Exact@ @RdrName@. See Note [Looking up Exact RdrNames].
-- This never adds an error, but it may return one.
lookupExactOcc_either :: Name -> RnM (Either MsgDoc Name)
-- See Note [Looking up Exact RdrNames]
lookupExactOcc_either name
| Just thing <- wiredInNameTyThing_maybe name | Just thing <- wiredInNameTyThing_maybe name
, Just tycon <- case thing of , Just tycon <- case thing of
ATyCon tc -> Just tc ATyCon tc -> Just tc
...@@ -319,10 +331,10 @@ lookupExactOcc name ...@@ -319,10 +331,10 @@ lookupExactOcc name
_ -> Nothing _ -> Nothing
, isTupleTyCon tycon , isTupleTyCon tycon
= do { checkTupSize (tyConArity tycon) = do { checkTupSize (tyConArity tycon)
; return name } ; return (Right name) }
| isExternalName name | isExternalName name
= return name = return (Right name)
| otherwise | otherwise
= do { env <- getGlobalRdrEnv = do { env <- getGlobalRdrEnv
...@@ -337,23 +349,23 @@ lookupExactOcc name ...@@ -337,23 +349,23 @@ lookupExactOcc name
; case gres of ; case gres of
[] -> -- See Note [Splicing Exact names] [] -> -- See Note [Splicing Exact names]
do { lcl_env <- getLocalRdrEnv do { lcl_env <- getLocalRdrEnv
; unless (name `inLocalRdrEnvScope` lcl_env) $ ; if name `inLocalRdrEnvScope` lcl_env
then return (Right name)
else
#ifdef GHCI #ifdef GHCI
do { th_topnames_var <- fmap tcg_th_topnames getGblEnv do { th_topnames_var <- fmap tcg_th_topnames getGblEnv
; th_topnames <- readTcRef th_topnames_var ; th_topnames <- readTcRef th_topnames_var
; unless (name `elemNameSet` th_topnames) ; if name `elemNameSet` th_topnames
(addErr exact_nm_err) then return (Right name)
else return (Left exact_nm_err)
} }
#else /* !GHCI */ #else /* !GHCI */
addErr exact_nm_err return (Left exact_nm_err)
#endif /* !GHCI */ #endif /* !GHCI */
; return name
} }
[gre] -> return (gre_name gre) [gre] -> return (Right (gre_name gre))
(gre:_) -> do {addErr dup_nm_err _ -> return (Left dup_nm_err)
; return (gre_name gre)
}
-- We can get more than one GRE here, if there are multiple -- We can get more than one GRE here, if there are multiple
-- bindings for the same name. Sometimes they are caught later -- bindings for the same name. Sometimes they are caught later
-- by findLocalDupsRdrEnv, like in this example (Trac #8932): -- by findLocalDupsRdrEnv, like in this example (Trac #8932):
...@@ -1034,10 +1046,11 @@ lookupBindGroupOcc :: HsSigCtxt ...@@ -1034,10 +1046,11 @@ lookupBindGroupOcc :: HsSigCtxt
-- See Note [Looking up signature names] -- See Note [Looking up signature names]
lookupBindGroupOcc ctxt what rdr_name lookupBindGroupOcc ctxt what rdr_name
| Just n <- isExact_maybe rdr_name | Just n <- isExact_maybe rdr_name
= do { n' <- lookupExactOcc n = lookupExactOcc_either n -- allow for the possibility of missing Exacts;
; return (Right n') } -- Maybe we should check the side conditions -- see Note [dataTcOccs and Exact Names]
-- but it's a pain, and Exact things only show -- Maybe we should check the side conditions
-- up when you know what you are doing -- but it's a pain, and Exact things only show
-- up when you know what you are doing
| Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
= do { n' <- lookupOrig rdr_mod rdr_occ = do { n' <- lookupOrig rdr_mod rdr_occ
...@@ -1114,10 +1127,8 @@ lookupLocalTcNames ctxt what rdr_name ...@@ -1114,10 +1127,8 @@ lookupLocalTcNames ctxt what rdr_name
dataTcOccs :: RdrName -> [RdrName] dataTcOccs :: RdrName -> [RdrName]
-- Return both the given name and the same name promoted to the TcClsName -- Return both the given name and the same name promoted to the TcClsName
-- namespace. This is useful when we aren't sure which we are looking at. -- namespace. This is useful when we aren't sure which we are looking at.
-- See also Note [dataTcOccs and Exact Names]
dataTcOccs rdr_name dataTcOccs rdr_name
| Just n <- isExact_maybe rdr_name
, not (isBuiltInSyntax n) -- See Note [dataTcOccs and Exact Names]
= [rdr_name]
| isDataOcc occ || isVarOcc occ | isDataOcc occ || isVarOcc occ
= [rdr_name, rdr_name_tc] = [rdr_name, rdr_name_tc]
| otherwise | otherwise
...@@ -1130,8 +1141,12 @@ dataTcOccs rdr_name ...@@ -1130,8 +1141,12 @@ dataTcOccs rdr_name
Note [dataTcOccs and Exact Names] Note [dataTcOccs and Exact Names]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exact RdrNames can occur in code generated by Template Haskell, and generally Exact RdrNames can occur in code generated by Template Haskell, and generally
those references are, well, exact, so it's wrong to return the TyClsName too. those references are, well, exact. However, the TH `Name` type isn't expressive
But there is an awkward exception for built-in syntax. Example in GHCi enough to always track the correct namespace information, so we sometimes get
the right Unique but wrong namespace. Thus, we still have to do the double-lookup
for Exact RdrNames.
There is also an awkward situation for built-in syntax. Example in GHCi
:info [] :info []
This parses as the Exact RdrName for nilDataCon, but we also want This parses as the Exact RdrName for nilDataCon, but we also want
the list type constructor. the list type constructor.
......
...@@ -336,5 +336,4 @@ test('T8953', normal, compile, ['-v0']) ...@@ -336,5 +336,4 @@ test('T8953', normal, compile, ['-v0'])
test('T9084', normal, compile_fail, ['-v0']) test('T9084', normal, compile_fail, ['-v0'])
test('T9738', normal, compile, ['-v0']) test('T9738', normal, compile, ['-v0'])
test('T9081', normal, compile, ['-v0']) test('T9081', normal, compile, ['-v0'])
test('T9066', expect_broken(9066), compile, ['-v0']) test('T9066', normal, compile, ['-v0'])
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