Commit 06600e74 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Two buglets in record wild-cards (Trac #9436 and #9437)

of named fields, whereas the code in RnPat.rnHsRecFields is
much better set up to do so.

Both easily fixed.
parent ee4501bb
......@@ -1064,11 +1064,11 @@ mkRecConstrOrUpdate
-> ([HsRecField RdrName (LHsExpr RdrName)], Bool)
-> P (HsExpr RdrName)
mkRecConstrOrUpdate (L l (HsVar c)) _ (fs,dd) | isRdrDataCon c
mkRecConstrOrUpdate (L l (HsVar c)) _ (fs,dd)
| isRdrDataCon c
= return (RecordCon (L l c) noPostTcExpr (mk_rec_fields fs dd))
mkRecConstrOrUpdate exp loc (fs,dd)
| null fs = parseErrorSDoc loc (text "Empty record update of:" <+> ppr exp)
| otherwise = return (RecordUpd exp (mk_rec_fields fs dd) [] [] [])
mkRecConstrOrUpdate exp _ (fs,dd)
= return (RecordUpd exp (mk_rec_fields fs dd) [] [] [])
mk_rec_fields :: [HsRecField id arg] -> Bool -> HsRecFields id arg
mk_rec_fields fs False = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
......
......@@ -370,7 +370,7 @@ rnSection other = pprPanic "rnSection" (ppr other)
rnHsRecBinds :: HsRecFieldContext -> HsRecordBinds RdrName
-> RnM (HsRecordBinds Name, FreeVars)
rnHsRecBinds ctxt rec_binds@(HsRecFields { rec_dotdot = dd })
= do { (flds, fvs) <- rnHsRecFields1 ctxt HsVar rec_binds
= do { (flds, fvs) <- rnHsRecFields ctxt HsVar rec_binds
; (flds', fvss) <- mapAndUnzipM rn_field flds
; return (HsRecFields { rec_flds = flds', rec_dotdot = dd },
fvs `plusFV` plusFVs fvss) }
......
......@@ -20,7 +20,7 @@ module RnPat (-- main entry points
-- sometimes we want to make top (qualified) names.
isTopRecNameMaker,
rnHsRecFields1, HsRecFieldContext(..),
rnHsRecFields, HsRecFieldContext(..),
-- CpsRn monad
CpsRn, liftCps,
......@@ -478,7 +478,7 @@ rnHsRecPatsAndThen :: NameMaker
-> HsRecFields RdrName (LPat RdrName)
-> CpsRn (HsRecFields Name (LPat Name))
rnHsRecPatsAndThen mk (L _ con) hs_rec_fields@(HsRecFields { rec_dotdot = dd })
= do { flds <- liftCpsFV $ rnHsRecFields1 (HsRecFieldPat con) VarPat hs_rec_fields
= do { flds <- liftCpsFV $ rnHsRecFields (HsRecFieldPat con) VarPat hs_rec_fields
; flds' <- mapM rn_field (flds `zip` [1..])
; return (HsRecFields { rec_flds = flds', rec_dotdot = dd }) }
where
......@@ -505,7 +505,7 @@ data HsRecFieldContext
| HsRecFieldPat Name
| HsRecFieldUpd
rnHsRecFields1
rnHsRecFields
:: forall arg.
HsRecFieldContext
-> (RdrName -> arg) -- When punning, use this to build a new field
......@@ -518,13 +518,22 @@ rnHsRecFields1
-- When we we've finished, we've renamed the LHS, but not the RHS,
-- of each x=e binding
rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
= do { pun_ok <- xoptM Opt_RecordPuns
; disambig_ok <- xoptM Opt_DisambiguateRecordFields
; parent <- check_disambiguation disambig_ok mb_con
; flds1 <- mapM (rn_fld pun_ok parent) flds
; flds1 <- mapM (rn_fld pun_ok parent) flds
; mapM_ (addErr . dupFieldErr ctxt) dup_flds
; dotdot_flds <- rn_dotdot dotdot mb_con flds1
-- Check for an empty record update e {}
-- NB: don't complain about e { .. }, becuase rn_dotdot has done that already
; case ctxt of
HsRecFieldUpd | Nothing <- dotdot
, null flds
-> addErr emptyUpdateErr
_ -> return ()
; let all_flds | null dotdot_flds = flds1
| otherwise = flds1 ++ dotdot_flds
; return (all_flds, mkFVs (getFieldIds all_flds)) }
......@@ -532,7 +541,7 @@ rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }
mb_con = case ctxt of
HsRecFieldCon con | not (isUnboundName con) -> Just con
HsRecFieldPat con | not (isUnboundName con) -> Just con
_other -> Nothing
_ {- update or isUnboundName con -} -> Nothing
-- The unbound name test is because if the constructor
-- isn't in scope the constructor lookup will add an error
-- add an error, but still return an unbound name.
......@@ -562,7 +571,10 @@ rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }
rn_dotdot Nothing _mb_con _flds -- No ".." at all
= return []
rn_dotdot (Just {}) Nothing _flds -- ".." on record update
= do { addErr (badDotDot ctxt); return [] }
= do { case ctxt of
HsRecFieldUpd -> addErr badDotDot
_ -> return ()
; return [] }
rn_dotdot (Just n) (Just con) flds -- ".." on record construction / pat match
= ASSERT( n == length flds )
do { loc <- getSrcSpanM -- Rather approximate
......@@ -639,8 +651,11 @@ needFlagDotDot :: HsRecFieldContext -> SDoc
needFlagDotDot ctxt = vcat [ptext (sLit "Illegal `..' in record") <+> pprRFC ctxt,
ptext (sLit "Use RecordWildCards to permit this")]
badDotDot :: HsRecFieldContext -> SDoc
badDotDot ctxt = ptext (sLit "You cannot use `..' in a record") <+> pprRFC ctxt
badDotDot :: SDoc
badDotDot = ptext (sLit "You cannot use `..' in a record update")
emptyUpdateErr :: SDoc
emptyUpdateErr = ptext (sLit "Empty record update")
badPun :: Located RdrName -> SDoc
badPun fld = vcat [ptext (sLit "Illegal use of punning for field") <+> quotes (ppr fld),
......
{-# LANGUAGE RecordWildCards #-}
module T9436 where
data T = T { x :: Int }
f :: T -> Int
f (T' { .. }) = x + 1
T9436.hs:8:4:
Not in scope: data constructor ‘T'’
Perhaps you meant ‘T’ (line 5)
{-# LANGUAGE RecordWildCards #-}
module T9437 where
data Foo = Foo { x :: Int }
test :: Foo -> Foo
test foo = foo { .. }
T9437.hs:8:12: You cannot use `..' in a record update
......@@ -116,3 +116,5 @@ test('T9006',
multimod_compile_fail, ['T9006', '-v0'])
test('T9156', normal, compile_fail, [''])
test('T9177', normal, compile_fail, [''])
test('T9436', normal, compile_fail, [''])
test('T9437', normal, compile_fail, [''])
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