Commit cfcddaae authored by Simon Peyton Jones's avatar Simon Peyton Jones

Make RnEnv.lookupBindGroupOcc work on Orig RdrNames

Such names can come from Template Haskell; see Trac #5700
Easily fixed, happily.

I also renamed lookupSubBndr to lookupSubBndrOcc, which is
more descriptive.
parent bffff2ef
...@@ -20,7 +20,7 @@ module RnEnv ( ...@@ -20,7 +20,7 @@ module RnEnv (
HsSigCtxt(..), lookupLocalDataTcNames, lookupSigOccRn, HsSigCtxt(..), lookupLocalDataTcNames, lookupSigOccRn,
lookupFixityRn, lookupTyFixityRn, lookupFixityRn, lookupTyFixityRn,
lookupInstDeclBndr, lookupSubBndr, greRdrName, lookupInstDeclBndr, lookupSubBndrOcc, greRdrName,
lookupSubBndrGREs, lookupConstructorFields, lookupSubBndrGREs, lookupConstructorFields,
lookupSyntaxName, lookupSyntaxTable, lookupIfThenElse, lookupSyntaxName, lookupSyntaxTable, lookupIfThenElse,
lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe, lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe,
...@@ -267,7 +267,7 @@ lookupInstDeclBndr cls what rdr ...@@ -267,7 +267,7 @@ lookupInstDeclBndr cls what rdr
-- In an instance decl you aren't allowed -- In an instance decl you aren't allowed
-- to use a qualified name for the method -- to use a qualified name for the method
-- (Although it'd make perfect sense.) -- (Although it'd make perfect sense.)
; lookupSubBndr (ParentIs cls) doc rdr } ; lookupSubBndrOcc (ParentIs cls) doc rdr }
where where
doc = what <+> ptext (sLit "of class") <+> quotes (ppr cls) doc = what <+> ptext (sLit "of class") <+> quotes (ppr cls)
...@@ -304,11 +304,11 @@ lookupConstructorFields con_name ...@@ -304,11 +304,11 @@ lookupConstructorFields con_name
-- unambiguous because there is only one field id 'fld' in scope. -- unambiguous because there is only one field id 'fld' in scope.
-- But currently it's rejected. -- But currently it's rejected.
lookupSubBndr :: Parent -- NoParent => just look it up as usual lookupSubBndrOcc :: Parent -- NoParent => just look it up as usual
-- ParentIs p => use p to disambiguate -- ParentIs p => use p to disambiguate
-> SDoc -> RdrName -> SDoc -> RdrName
-> RnM Name -> RnM Name
lookupSubBndr parent doc rdr_name lookupSubBndrOcc parent doc rdr_name
| Just n <- isExact_maybe rdr_name -- This happens in derived code | Just n <- isExact_maybe rdr_name -- This happens in derived code
= lookupExactOcc n = lookupExactOcc n
...@@ -323,6 +323,7 @@ lookupSubBndr parent doc rdr_name ...@@ -323,6 +323,7 @@ lookupSubBndr parent doc rdr_name
-- The latter does pickGREs, but we want to allow 'x' -- The latter does pickGREs, but we want to allow 'x'
-- even if only 'M.x' is in scope -- even if only 'M.x' is in scope
[gre] -> do { addUsedRdrName gre (used_rdr_name gre) [gre] -> do { addUsedRdrName gre (used_rdr_name gre)
-- Add a usage; this is an *occurrence* site
; return (gre_name gre) } ; return (gre_name gre) }
[] -> do { addErr (unknownSubordinateErr doc rdr_name) [] -> do { addErr (unknownSubordinateErr doc rdr_name)
; return (mkUnboundName rdr_name) } ; return (mkUnboundName rdr_name) }
...@@ -669,6 +670,11 @@ lookupBindGroupOcc ctxt what rdr_name ...@@ -669,6 +670,11 @@ lookupBindGroupOcc ctxt what rdr_name
; return (Right n') } -- Maybe we should check the side conditions ; return (Right n') } -- Maybe we should check the side conditions
-- but it's a pain, and Exact things only show -- but it's a pain, and Exact things only show
-- up when you know what you are doing -- up when you know what you are doing
| Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
= do { n' <- lookupOrig rdr_mod rdr_occ
; return (Right n') }
| otherwise | otherwise
= case ctxt of = case ctxt of
HsBootCtxt -> lookup_top HsBootCtxt -> lookup_top
......
...@@ -487,7 +487,7 @@ rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot } ...@@ -487,7 +487,7 @@ rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }
rn_fld pun_ok parent (HsRecField { hsRecFieldId = fld rn_fld pun_ok parent (HsRecField { hsRecFieldId = fld
, hsRecFieldArg = arg , hsRecFieldArg = arg
, hsRecPun = pun }) , hsRecPun = pun })
= do { fld'@(L loc fld_nm) <- wrapLocM (lookupSubBndr parent doc) fld = do { fld'@(L loc fld_nm) <- wrapLocM (lookupSubBndrOcc parent doc) fld
; arg' <- if pun ; arg' <- if pun
then do { checkErr pun_ok (badPun fld) then do { checkErr pun_ok (badPun fld)
; return (L loc (mk_arg (mkRdrUnqual (nameOccName fld_nm)))) } ; return (L loc (mk_arg (mkRdrUnqual (nameOccName fld_nm)))) }
......
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