diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2015-12-20 10:56:24 +0200 |
|---|---|---|
| committer | Alan Zimmerman <alan.zimm@gmail.com> | 2015-12-21 12:12:57 +0200 |
| commit | d8ed20c8772bee5eb83719c804121374157cf9b6 (patch) | |
| tree | 4f53ebe4f80271474b3d1ea6c48e30ba982a0916 /compiler/rename/RnPat.hs | |
| parent | 850710ab8c0fe69ea053d48583071fe1e5ffd067 (diff) | |
| download | haskell-d8ed20c8772bee5eb83719c804121374157cf9b6.tar.gz | |
Add Location to RdrName in FieldOcc
Summary:
Post #11019, there have been some new instances of RdrName that are not
located, in particular
```#!hs
data FieldOcc name = FieldOcc { rdrNameFieldOcc :: RdrName
, selectorFieldOcc :: PostRn name name
}
data AmbiguousFieldOcc name
= Unambiguous RdrName (PostRn name name)
| Ambiguous RdrName (PostTc name name)
deriving (Typeable)
```
Add locations to them
Updates haddock submodule to match
Test Plan: ./validate
Reviewers: goldfire, hvr, bgamari, austin
Reviewed By: hvr
Subscribers: hvr, thomie, mpickering
Differential Revision: https://phabricator.haskell.org/D1670
GHC Trac Issues: #11258
Diffstat (limited to 'compiler/rename/RnPat.hs')
| -rw-r--r-- | compiler/rename/RnPat.hs | 19 |
1 files changed, 12 insertions, 7 deletions
diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs index ff25bda1cd..38c832c182 100644 --- a/compiler/rename/RnPat.hs +++ b/compiler/rename/RnPat.hs @@ -556,7 +556,8 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) rn_fld :: Bool -> Maybe Name -> LHsRecField RdrName (Located arg) -> RnM (LHsRecField Name (Located arg)) - rn_fld pun_ok parent (L l (HsRecField { hsRecFieldLbl = L loc (FieldOcc lbl _) + rn_fld pun_ok parent (L l (HsRecField { hsRecFieldLbl + = L loc (FieldOcc (L ll lbl) _) , hsRecFieldArg = arg , hsRecPun = pun })) = do { sel <- setSrcSpan loc $ lookupRecFieldOcc parent doc lbl @@ -564,7 +565,8 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) then do { checkErr pun_ok (badPun (L loc lbl)) ; return (L loc (mk_arg loc lbl)) } else return arg - ; return (L l (HsRecField { hsRecFieldLbl = L loc (FieldOcc lbl sel) + ; return (L l (HsRecField { hsRecFieldLbl + = L loc (FieldOcc (L ll lbl) sel) , hsRecFieldArg = arg' , hsRecPun = pun })) } @@ -617,7 +619,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) ; addUsedGREs (map thdOf3 dot_dot_gres) ; return [ L loc (HsRecField - { hsRecFieldLbl = L loc (FieldOcc arg_rdr sel) + { hsRecFieldLbl = L loc (FieldOcc (L loc arg_rdr) sel) , hsRecFieldArg = L loc (mk_arg loc arg_rdr) , hsRecPun = False }) | (lbl, sel, _) <- dot_dot_gres @@ -694,9 +696,11 @@ rnHsRecUpdFields flds Right [FieldOcc _ sel_name] -> fvs `addOneFV` sel_name Right _ -> fvs lbl' = case sel of - Left sel_name -> L loc (Unambiguous lbl sel_name) - Right [FieldOcc lbl sel_name] -> L loc (Unambiguous lbl sel_name) - Right _ -> L loc (Ambiguous lbl PlaceHolder) + Left sel_name -> + L loc (Unambiguous (L loc lbl) sel_name) + Right [FieldOcc lbl sel_name] -> + L loc (Unambiguous lbl sel_name) + Right _ -> L loc (Ambiguous (L loc lbl) PlaceHolder) ; return (L l (HsRecField { hsRecFieldLbl = lbl' , hsRecFieldArg = arg'' @@ -714,7 +718,8 @@ getFieldIds :: [LHsRecField Name arg] -> [Name] getFieldIds flds = map (unLoc . hsRecFieldSel . unLoc) flds getFieldLbls :: [LHsRecField id arg] -> [RdrName] -getFieldLbls flds = map (rdrNameFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds +getFieldLbls flds + = map (unLoc . rdrNameFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds getFieldUpdLbls :: [LHsRecUpdField id] -> [RdrName] getFieldUpdLbls flds = map (rdrNameAmbiguousFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds |