summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/hsSyn/Convert.hs21
-rw-r--r--compiler/hsSyn/HsTypes.hs16
-rw-r--r--compiler/hsSyn/HsUtils.hs7
-rw-r--r--compiler/parser/Parser.y6
-rw-r--r--compiler/rename/RnEnv.hs16
-rw-r--r--compiler/rename/RnExpr.hs3
-rw-r--r--compiler/rename/RnNames.hs4
-rw-r--r--compiler/rename/RnPat.hs19
-rw-r--r--compiler/rename/RnSource.hs2
-rw-r--r--compiler/rename/RnTypes.hs2
-rw-r--r--compiler/typecheck/TcExpr.hs27
-rw-r--r--compiler/typecheck/TcPat.hs6
-rw-r--r--compiler/typecheck/TcTyDecls.hs4
m---------utils/haddock0
14 files changed, 81 insertions, 52 deletions
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index ee026e6853..d4e225a8d8 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -475,11 +475,13 @@ cvt_arg (Unpacked, ty)
cvt_id_arg :: (TH.Name, TH.Strict, TH.Type) -> CvtM (LConDeclField RdrName)
cvt_id_arg (i, str, ty)
- = do { i' <- vNameL i
+ = do { L li i' <- vNameL i
; ty' <- cvt_arg (str,ty)
- ; return $ noLoc (ConDeclField { cd_fld_names = [fmap (flip FieldOcc PlaceHolder) i']
- , cd_fld_type = ty'
- , cd_fld_doc = Nothing}) }
+ ; return $ noLoc (ConDeclField
+ { cd_fld_names
+ = [L li $ FieldOcc (L li i') PlaceHolder]
+ , cd_fld_type = ty'
+ , cd_fld_doc = Nothing}) }
cvtDerivs :: TH.Cxt -> CvtM (HsDeriving RdrName)
cvtDerivs [] = return Nothing
@@ -737,10 +739,12 @@ cvtl e = wrapL (cvt e)
cvt (SigE e t) = do { e' <- cvtl e; t' <- cvtType t
; return $ ExprWithTySig e' (mkLHsSigWcType t') }
cvt (RecConE c flds) = do { c' <- cNameL c
- ; flds' <- mapM (cvtFld mkFieldOcc) flds
+ ; flds' <- mapM (cvtFld (mkFieldOcc . noLoc)) flds
; return $ mkRdrRecordCon c' (HsRecFields flds' Nothing) }
cvt (RecUpdE e flds) = do { e' <- cvtl e
- ; flds'<- mapM (cvtFld mkAmbiguousFieldOcc) flds
+ ; flds'
+ <- mapM (cvtFld (mkAmbiguousFieldOcc . noLoc))
+ flds
; return $ mkRdrRecordUpd e' flds' }
cvt (StaticE e) = fmap HsStatic $ cvtl e
cvt (UnboundVarE s) = do { s' <- vName s; return $ HsVar (noLoc s') }
@@ -984,8 +988,9 @@ cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p
cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField RdrName (LPat RdrName))
cvtPatFld (s,p)
- = do { s' <- vNameL s; p' <- cvtPat p
- ; return (noLoc $ HsRecField { hsRecFieldLbl = fmap mkFieldOcc s'
+ = do { L ls s' <- vNameL s; p' <- cvtPat p
+ ; return (noLoc $ HsRecField { hsRecFieldLbl
+ = L ls $ mkFieldOcc (L ls s')
, hsRecFieldArg = p'
, hsRecPun = False}) }
diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs
index df2f0f36f3..1c2d383dbf 100644
--- a/compiler/hsSyn/HsTypes.hs
+++ b/compiler/hsSyn/HsTypes.hs
@@ -675,7 +675,8 @@ type LFieldOcc name = Located (FieldOcc name)
-- | Represents an *occurrence* of an unambiguous field. We store
-- both the 'RdrName' the user originally wrote, and after the
-- renamer, the selector function.
-data FieldOcc name = FieldOcc { rdrNameFieldOcc :: RdrName
+data FieldOcc name = FieldOcc { rdrNameFieldOcc :: Located RdrName
+ -- ^ See Note [Located RdrNames] in HsExpr
, selectorFieldOcc :: PostRn name name
}
deriving Typeable
@@ -686,7 +687,7 @@ deriving instance (Data name, Data (PostRn name name)) => Data (FieldOcc name)
instance Outputable (FieldOcc name) where
ppr = ppr . rdrNameFieldOcc
-mkFieldOcc :: RdrName -> FieldOcc RdrName
+mkFieldOcc :: Located RdrName -> FieldOcc RdrName
mkFieldOcc rdr = FieldOcc rdr PlaceHolder
@@ -699,9 +700,10 @@ mkFieldOcc rdr = FieldOcc rdr PlaceHolder
--
-- See Note [HsRecField and HsRecUpdField] in HsPat and
-- Note [Disambiguating record fields] in TcExpr.
+-- See Note [Located RdrNames] in HsExpr
data AmbiguousFieldOcc name
- = Unambiguous RdrName (PostRn name name)
- | Ambiguous RdrName (PostTc name name)
+ = Unambiguous (Located RdrName) (PostRn name name)
+ | Ambiguous (Located RdrName) (PostTc name name)
deriving (Typeable)
deriving instance ( Data name
, Data (PostRn name name)
@@ -715,12 +717,12 @@ instance OutputableBndr (AmbiguousFieldOcc name) where
pprInfixOcc = pprInfixOcc . rdrNameAmbiguousFieldOcc
pprPrefixOcc = pprPrefixOcc . rdrNameAmbiguousFieldOcc
-mkAmbiguousFieldOcc :: RdrName -> AmbiguousFieldOcc RdrName
+mkAmbiguousFieldOcc :: Located RdrName -> AmbiguousFieldOcc RdrName
mkAmbiguousFieldOcc rdr = Unambiguous rdr PlaceHolder
rdrNameAmbiguousFieldOcc :: AmbiguousFieldOcc name -> RdrName
-rdrNameAmbiguousFieldOcc (Unambiguous rdr _) = rdr
-rdrNameAmbiguousFieldOcc (Ambiguous rdr _) = rdr
+rdrNameAmbiguousFieldOcc (Unambiguous (L _ rdr) _) = rdr
+rdrNameAmbiguousFieldOcc (Ambiguous (L _ rdr) _) = rdr
selectorAmbiguousFieldOcc :: AmbiguousFieldOcc Id -> Id
selectorAmbiguousFieldOcc (Unambiguous _ sel) = sel
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index fb969ebff1..3cfcb06fd0 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -981,7 +981,7 @@ hsConDeclsBinders cons = go id cons
where r' = remSeen (concatMap (cd_fld_names . unLoc) flds)
remSeen' = foldr (.) remSeen
[deleteBy ((==) `on`
- rdrNameFieldOcc . unLoc) v
+ unLoc . rdrNameFieldOcc . unLoc) v
| v <- r']
(ns, fs) = go remSeen' rs
@@ -990,7 +990,10 @@ hsConDeclsBinders cons = go id cons
([L loc (unLoc name)] ++ ns, r' ++ fs)
where r' = remSeen (concatMap (cd_fld_names . unLoc)
(unLoc flds))
- remSeen' = foldr (.) remSeen [deleteBy ((==) `on` rdrNameFieldOcc . unLoc) v | v <- r']
+ remSeen'
+ = foldr (.) remSeen
+ [deleteBy ((==) `on`
+ unLoc . rdrNameFieldOcc . unLoc) v | v <- r']
(ns, fs) = go remSeen' rs
L loc (ConDeclH98 { con_name = name }) ->
([L loc (unLoc name)] ++ ns, fs)
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 6606e3fac1..5ba56239f1 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1948,7 +1948,7 @@ fielddecl :: { LConDeclField RdrName }
-- A list because of f,g :: Int
: maybe_docnext sig_vars '::' ctype maybe_docprev
{% ams (L (comb2 $2 $4)
- (ConDeclField (reverse (map (fmap (flip FieldOcc PlaceHolder)) (unLoc $2))) $4 ($1 `mplus` $5)))
+ (ConDeclField (reverse (map (\ln@(L l n) -> L l $ FieldOcc ln PlaceHolder) (unLoc $2))) $4 ($1 `mplus` $5)))
[mu AnnDcolon $3] }
-- The outer Located is just to allow the caller to
@@ -2701,13 +2701,13 @@ fbinds1 :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
| '..' { ([mj AnnDotdot $1],([], True)) }
fbind :: { LHsRecField RdrName (LHsExpr RdrName) }
- : qvar '=' texp {% ams (sLL $1 $> $ HsRecField (fmap mkFieldOcc $1) $3 False)
+ : qvar '=' texp {% ams (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False)
[mj AnnEqual $2] }
-- RHS is a 'texp', allowing view patterns (Trac #6038)
-- and, incidentaly, sections. Eg
-- f (R { x = show -> s }) = ...
- | qvar { sLL $1 $> $ HsRecField (fmap mkFieldOcc $1) placeHolderPunRhs True }
+ | qvar { sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) placeHolderPunRhs True }
-- In the punning case, use a place-holder
-- The renamer fills in the final value
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 954eebb06b..f2835b87d9 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -912,8 +912,10 @@ lookupGlobalOccRn_overloaded overload_ok rdr_name
[] -> return Nothing
[gre] | isRecFldGRE gre
-> do { addUsedGRE True gre
- ; let fld_occ :: FieldOcc Name
- fld_occ = FieldOcc rdr_name (gre_name gre)
+ ; let
+ fld_occ :: FieldOcc Name
+ fld_occ
+ = FieldOcc (noLoc rdr_name) (gre_name gre)
; return (Just (Right [fld_occ])) }
| otherwise
-> do { addUsedGRE True gre
@@ -921,7 +923,10 @@ lookupGlobalOccRn_overloaded overload_ok rdr_name
gres | all isRecFldGRE gres && overload_ok
-- Don't record usage for ambiguous selectors
-- until we know which is meant
- -> return (Just (Right (map (FieldOcc rdr_name . gre_name) gres)))
+ -> return
+ (Just (Right
+ (map (FieldOcc (noLoc rdr_name) . gre_name)
+ gres)))
gres -> do { addNameClashErrRn rdr_name gres
; return (Just (Left (gre_name (head gres)))) } }
@@ -1452,8 +1457,9 @@ lookupTyFixityRn (L _ n) = lookupFixityRn n
-- 'Name' if @DuplicateRecordFields@ is in use (Trac #1173). If there are
-- multiple possible selectors with different fixities, generate an error.
lookupFieldFixityRn :: AmbiguousFieldOcc Name -> RnM Fixity
-lookupFieldFixityRn (Unambiguous rdr n) = lookupFixityRn' n (rdrNameOcc rdr)
-lookupFieldFixityRn (Ambiguous rdr _) = get_ambiguous_fixity rdr
+lookupFieldFixityRn (Unambiguous (L _ rdr) n)
+ = lookupFixityRn' n (rdrNameOcc rdr)
+lookupFieldFixityRn (Ambiguous (L _ rdr) _) = get_ambiguous_fixity rdr
where
get_ambiguous_fixity :: RdrName -> RnM Fixity
get_ambiguous_fixity rdr_name = do
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index c52073215a..c4e5bb2abe 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -109,7 +109,8 @@ rnExpr (HsVar (L l v))
-> finishHsVar (L l name) ;
Just (Right [f]) -> return (HsRecFld (ambiguousFieldOcc f)
, unitFV (selectorFieldOcc f)) ;
- Just (Right fs@(_:_:_)) -> return (HsRecFld (Ambiguous v PlaceHolder)
+ Just (Right fs@(_:_:_)) -> return (HsRecFld (Ambiguous (L l v)
+ PlaceHolder)
, mkFVs (map selectorFieldOcc fs));
Just (Right []) -> error "runExpr/HsVar" } }
diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 26bef9130e..119efc1c20 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -638,7 +638,7 @@ getLocalNonValBinders fixity_env
find (\ n -> nameOccName n == rdrNameOcc rdr) names
find_con_decl_flds (L _ x)
= map find_con_decl_fld (cd_fld_names x)
- find_con_decl_fld (L _ (FieldOcc rdr _))
+ find_con_decl_fld (L _ (FieldOcc (L _ rdr) _))
= expectJust "getLocalNonValBinders/find_con_decl_fld" $
find (\ fl -> flLabel fl == lbl) flds
where lbl = occNameFS (rdrNameOcc rdr)
@@ -680,7 +680,7 @@ getLocalNonValBinders fixity_env
newRecordSelector :: Bool -> [Name] -> LFieldOcc RdrName -> RnM FieldLabel
newRecordSelector _ [] _ = error "newRecordSelector: datatype has no constructors!"
-newRecordSelector overload_ok (dc:_) (L loc (FieldOcc fld _)) =
+newRecordSelector overload_ok (dc:_) (L loc (FieldOcc (L _ fld) _)) =
do { sel_name <- newTopSrcBinder $ L loc $ mkRdrUnqual sel_occ
; return $ fl { flSelector = sel_name } }
where
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
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index b8db843a99..d6cb2c8ce6 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -1695,7 +1695,7 @@ extendPatSynEnv val_decls local_fix_env thing = do {
bnd_name <- newTopSrcBinder (L bind_loc n)
let rnames = map recordPatSynSelectorId as
mkFieldOcc :: Located RdrName -> LFieldOcc RdrName
- mkFieldOcc (L l name) = L l (FieldOcc name PlaceHolder)
+ mkFieldOcc (L l name) = L l (FieldOcc (L l name) PlaceHolder)
field_occs = map mkFieldOcc rnames
flds <- mapM (newRecordSelector False [bnd_name]) field_occs
return ((bnd_name, flds): names)
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 822f6a9f40..0a1f342a83 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -975,7 +975,7 @@ rnField fl_env doc (L l (ConDeclField names ty haddock_doc))
; return (L l (ConDeclField new_names new_ty new_haddock_doc), fvs) }
where
lookupField :: FieldOcc RdrName -> FieldOcc Name
- lookupField (FieldOcc rdr _) = FieldOcc rdr (flSelector fl)
+ lookupField (FieldOcc (L lr rdr) _) = FieldOcc (L lr rdr) (flSelector fl)
where
lbl = occNameFS $ rdrNameOcc rdr
fl = expectJust "rnField" $ lookupFsEnv fl_env lbl
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 980424225c..008b933e47 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -1261,7 +1261,7 @@ tcInferId :: Name -> TcM (HsExpr TcId, TcRhoType)
tcInferId n = tcInferIdWithOrig (OccurrenceOf n) (nameRdrName n) n
tcInferRecSelId :: AmbiguousFieldOcc Name -> TcM (HsExpr TcId, TcRhoType)
-tcInferRecSelId (Unambiguous lbl sel)
+tcInferRecSelId (Unambiguous (L _ lbl) sel)
= tcInferIdWithOrig (OccurrenceOfRecSel lbl) lbl sel
tcInferRecSelId (Ambiguous lbl _)
= ambiguousSelector lbl
@@ -1643,11 +1643,11 @@ See also Note [HsRecField and HsRecUpdField] in HsPat.
-- Given a RdrName that refers to multiple record fields, and the type
-- of its argument, try to determine the name of the selector that is
-- meant.
-disambiguateSelector :: RdrName -> Type -> RnM Name
-disambiguateSelector rdr parent_type
+disambiguateSelector :: Located RdrName -> Type -> RnM Name
+disambiguateSelector lr@(L _ rdr) parent_type
= do { fam_inst_envs <- tcGetFamInstEnvs
; case tyConOf fam_inst_envs parent_type of
- Nothing -> ambiguousSelector rdr
+ Nothing -> ambiguousSelector lr
Just p ->
do { xs <- lookupParents rdr
; let parent = RecSelData p
@@ -1658,8 +1658,8 @@ disambiguateSelector rdr parent_type
-- This field name really is ambiguous, so add a suitable "ambiguous
-- occurrence" error, then give up.
-ambiguousSelector :: RdrName -> RnM a
-ambiguousSelector rdr
+ambiguousSelector :: Located RdrName -> RnM a
+ambiguousSelector (L _ rdr)
= do { env <- getGlobalRdrEnv
; let gres = lookupGRE_RdrName rdr env
; setErrCtxt [] $ addNameClashErrRn rdr gres
@@ -1757,7 +1757,8 @@ disambiguateRecordBinds record_expr record_tau rbnds res_ty
= do { i <- tcLookupId n
; let L loc af = hsRecFieldLbl upd
lbl = rdrNameAmbiguousFieldOcc af
- ; return $ L l upd { hsRecFieldLbl = L loc (Unambiguous lbl i) } }
+ ; return $ L l upd { hsRecFieldLbl
+ = L loc (Unambiguous (L loc lbl) i) } }
-- Extract the outermost TyCon of a type, if there is one; for
@@ -1851,12 +1852,16 @@ tcRecordUpd con_like arg_tys rbinds = fmap catMaybes $ mapM do_bind rbinds
, hsRecFieldArg = rhs }))
= do { let lbl = rdrNameAmbiguousFieldOcc af
sel_id = selectorAmbiguousFieldOcc af
- f = L loc (FieldOcc lbl (idName sel_id))
+ f = L loc (FieldOcc (L loc lbl) (idName sel_id))
; mb <- tcRecordField con_like flds_w_tys f rhs
; case mb of
Nothing -> return Nothing
- Just (f', rhs') -> return (Just (L l (fld { hsRecFieldLbl = L loc (Unambiguous lbl (selectorFieldOcc (unLoc f')))
- , hsRecFieldArg = rhs' }))) }
+ Just (f', rhs') ->
+ return (Just
+ (L l (fld { hsRecFieldLbl
+ = L loc (Unambiguous (L loc lbl)
+ (selectorFieldOcc (unLoc f')))
+ , hsRecFieldArg = rhs' }))) }
tcRecordField :: ConLike -> Assoc FieldLabelString Type -> LFieldOcc Name -> LHsExpr Name
-> TcM (Maybe (LFieldOcc Id, LHsExpr Id))
@@ -1876,7 +1881,7 @@ tcRecordField con_like flds_w_tys (L loc (FieldOcc lbl sel_name)) rhs
= do { addErrTc (badFieldCon con_like field_lbl)
; return Nothing }
where
- field_lbl = occNameFS $ rdrNameOcc lbl
+ field_lbl = occNameFS $ rdrNameOcc (unLoc lbl)
checkMissingFields :: ConLike -> HsRecordBinds Name -> TcM ()
diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs
index 6b22aa6bf6..f76da5b0d5 100644
--- a/compiler/typecheck/TcPat.hs
+++ b/compiler/typecheck/TcPat.hs
@@ -878,11 +878,13 @@ tcConArgs con_like arg_tys (RecCon (HsRecFields rpats dd)) penv thing_inside
where
tc_field :: Checker (LHsRecField Name (LPat Name))
(LHsRecField TcId (LPat TcId))
- tc_field (L l (HsRecField (L loc (FieldOcc rdr sel)) pat pun)) penv thing_inside
+ tc_field (L l (HsRecField (L loc (FieldOcc (L lr rdr) sel)) pat pun)) penv
+ thing_inside
= do { sel' <- tcLookupId sel
; pat_ty <- setSrcSpan loc $ find_field_ty (occNameFS $ rdrNameOcc rdr)
; (pat', res) <- tcConArg (pat, pat_ty) penv thing_inside
- ; return (L l (HsRecField (L loc (FieldOcc rdr sel')) pat' pun), res) }
+ ; return (L l (HsRecField (L loc (FieldOcc (L lr rdr) sel')) pat'
+ pun), res) }
find_field_ty :: FieldLabelString -> TcM TcType
find_field_ty lbl
diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs
index 01ccae59ba..8c8051935d 100644
--- a/compiler/typecheck/TcTyDecls.hs
+++ b/compiler/typecheck/TcTyDecls.hs
@@ -973,8 +973,8 @@ mkOneRecordSelector all_cons idDetails fl
mk_sel_pat con = ConPatIn (L loc (getName con)) (RecCon rec_fields)
rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing }
rec_field = noLoc (HsRecField
- { hsRecFieldLbl = L loc (FieldOcc (mkVarUnqual lbl)
- sel_name)
+ { hsRecFieldLbl
+ = L loc (FieldOcc (L loc $ mkVarUnqual lbl) sel_name)
, hsRecFieldArg = L loc (VarPat (L loc field_var))
, hsRecPun = False })
sel_lname = L loc sel_name
diff --git a/utils/haddock b/utils/haddock
-Subproject fa03f80d76f1511a811a0209ea7a6a8b6c58704
+Subproject 105869f209f49721794e3ff5e35822178db7289
View Lorry Controller Status