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

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