Skip to content
Snippets Groups Projects
Commit 49b6b494 authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Ian Lynagh
Browse files

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