Commit 9498c50e authored by Alan Zimmerman's avatar Alan Zimmerman Committed by Ben Gamari
Browse files

Renamer now preserves location for IEThingWith list items

Prior to this, in the RenamedSource for

    module Renaming.RenameInExportedType
      (
      MyType (NT)
      ) where

    data MyType = MT Int | NT

The (NT) was given the location of MyType earlier on the line in the
export list.

Also the location was discarded for any field labels, and replaced with
a `noLoc`.

Test Plan: ./validate

Reviewers: bgamari, austin

Reviewed By: bgamari

Subscribers: rwbarton, thomie

GHC Trac Issues: #14189

Differential Revision: https://phabricator.haskell.org/D3968
parent 2bfba9e4
......@@ -302,28 +302,27 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
NoIEWildcard -> return (lname, [], [])
IEWildcard _ -> lookup_ie_all ie l
let name = unLoc lname
subs' = map (replaceLWrappedName l . unLoc) subs
return (IEThingWith (replaceLWrappedName l name) wc subs'
(map noLoc (flds ++ all_flds)),
return (IEThingWith (replaceLWrappedName l name) wc subs
(flds ++ (map noLoc all_flds)),
AvailTC name (name : avails ++ all_avail)
(flds ++ all_flds))
(map unLoc flds ++ all_flds))
lookup_ie _ = panic "lookup_ie" -- Other cases covered earlier
lookup_ie_with :: LIEWrappedName RdrName -> [LIEWrappedName RdrName]
-> RnM (Located Name, [Located Name], [Name], [FieldLabel])
-> RnM (Located Name, [LIEWrappedName Name], [Name],
[Located FieldLabel])
lookup_ie_with (L l rdr) sub_rdrs
= do name <- lookupGlobalOccRn $ ieWrappedName rdr
(non_flds, flds) <- lookupChildrenExport name
(map ieLWrappedName sub_rdrs)
(non_flds, flds) <- lookupChildrenExport name sub_rdrs
if isUnboundName name
then return (L l name, [], [name], [])
else return (L l name, non_flds
, map unLoc non_flds
, map unLoc flds)
, map (ieWrappedName . unLoc) non_flds
, flds)
lookup_ie_all :: IE GhcPs -> LIEWrappedName RdrName
-> RnM (Located Name, [Name], [FieldLabel])
lookup_ie_all ie (L l rdr) =
......@@ -404,8 +403,8 @@ isDoc _ = False
lookupChildrenExport :: Name -> [Located RdrName]
-> RnM ([Located Name], [Located FieldLabel])
lookupChildrenExport :: Name -> [LIEWrappedName RdrName]
-> RnM ([LIEWrappedName Name], [Located FieldLabel])
lookupChildrenExport parent rdr_items =
do
xs <- mapAndReportM doOne rdr_items
......@@ -420,11 +419,11 @@ lookupChildrenExport parent rdr_items =
| ns == tcName = [dataName, tcName]
| otherwise = [ns]
-- Process an individual child
doOne :: Located RdrName
-> RnM (Either (Located Name) (Located FieldLabel))
doOne :: LIEWrappedName RdrName
-> RnM (Either (LIEWrappedName Name) (Located FieldLabel))
doOne n = do
let bareName = unLoc n
let bareName = (ieWrappedName . unLoc) n
lkup v = lookupSubBndrOcc_helper False True
parent (setRdrNameSpace bareName v)
......@@ -446,9 +445,11 @@ lookupChildrenExport parent rdr_items =
traceRn "lookupChildrenExport" (ppr name')
case name' of
NameNotFound -> Left . L (getLoc n) <$> reportUnboundName unboundName
NameNotFound -> do { ub <- reportUnboundName unboundName
; let l = getLoc n
; return (Left (L l (IEName (L l ub))))}
FoundFL fls -> return $ Right (L (getLoc n) fls)
FoundName _p name -> return $ Left (L (getLoc n) name)
FoundName _p name -> return $ Left (replaceLWrappedName n name)
NameErr err_msg -> reportError err_msg >> failM
IncorrectParent p g td gs -> do
mkDcErrMsg p g td gs >>= reportError
......
module T14189
(
MyType (f,NT)
) where
data MyType = MT Int | NT | F { f :: Int }
==================== Renamer ====================
(Just
((,,,)
(HsGroup
(ValBindsOut
[]
[])
[]
[(TyClGroup
[({ T14189.hs:6:1-42 }
(DataDecl
({ T14189.hs:6:6-11 }
{Name: T14189.MyType})
(HsQTvs
[]
[]
{NameSet:
[]})
(Prefix)
(HsDataDefn
(DataType)
({ <no location info> }
[])
(Nothing)
(Nothing)
[({ T14189.hs:6:15-20 }
(ConDeclH98
({ T14189.hs:6:15-16 }
{Name: T14189.MT})
(Nothing)
(Just
({ <no location info> }
[]))
(PrefixCon
[({ T14189.hs:6:18-20 }
(HsTyVar
(NotPromoted)
({ T14189.hs:6:18-20 }
{Name: GHC.Types.Int})))])
(Nothing)))
,({ T14189.hs:6:24-25 }
(ConDeclH98
({ T14189.hs:6:24-25 }
{Name: T14189.NT})
(Nothing)
(Just
({ <no location info> }
[]))
(PrefixCon
[])
(Nothing)))
,({ T14189.hs:6:29-42 }
(ConDeclH98
({ T14189.hs:6:29 }
{Name: T14189.F})
(Nothing)
(Just
({ <no location info> }
[]))
(RecCon
({ T14189.hs:6:31-42 }
[({ T14189.hs:6:33-40 }
(ConDeclField
[({ T14189.hs:6:33 }
(FieldOcc
({ T14189.hs:6:33 }
(Unqual
{OccName: f}))
{Name: T14189.f}))]
({ T14189.hs:6:38-40 }
(HsTyVar
(NotPromoted)
({ T14189.hs:6:38-40 }
{Name: GHC.Types.Int})))
(Nothing)))]))
(Nothing)))]
({ <no location info> }
[]))
(True)
{NameSet:
[{Name: GHC.Types.Int}]}))]
[]
[])]
[]
[]
[]
[]
[]
[]
[]
[]
[])
[({ T14189.hs:1:8-13 }
(ImportDecl
(NoSourceText)
({ T14189.hs:1:8-13 }
{ModuleName: Prelude})
(Nothing)
(False)
(False)
(False)
(True)
(Nothing)
(Nothing)))]
(Just
[((,)
({ T14189.hs:3:3-15 }
(IEThingWith
({ T14189.hs:3:3-8 }
(IEName
({ T14189.hs:3:3-8 }
{Name: T14189.MyType})))
(NoIEWildcard)
[({ T14189.hs:3:13-14 }
(IEName
({ T14189.hs:3:13-14 }
{Name: T14189.NT})))]
[({ T14189.hs:3:11 }
(FieldLabel
{FastString: "f"}
(False)
{Name: T14189.f}))]))
[(AvailTC
{Name: T14189.MyType}
[{Name: T14189.MyType}
,{Name: T14189.NT}]
[(FieldLabel
{FastString: "f"}
(False)
{Name: T14189.f})])])])
(Nothing)))
......@@ -108,3 +108,4 @@ test('DumpParsedAst', normal, compile, ['-dsuppress-uniques -ddump-parsed-a
test('DumpRenamedAst', normal, compile, ['-dsuppress-uniques -ddump-rn-ast'])
test('DumpTypecheckedAst', normal, compile, ['-dsuppress-uniques -ddump-tc-ast'])
test('T13747', normal, compile, [''])
test('T14189', normal, compile, ['-dsuppress-uniques -ddump-rn-ast'])
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