Implement DuplicateRecordFields

This implements DuplicateRecordFields, the first part of the
OverloadedRecordFields extension, as described at
https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields

This includes fairly wide-ranging changes in order to allow multiple
records within the same module to use the same field names.  Note that
it does *not* allow record selector functions to be used if they are
ambiguous, and it does not have any form of type-based disambiguation
for selectors (but it does for updates). Subsequent parts will make
overloading selectors possible using orthogonal extensions, as
described on the wiki pages.  This part touches quite a lot of the
codebase, and requires changes to several GHC API datatypes in order
to distinguish between field labels (which may be overloaded) and
selector function names (which are always unique).

The Haddock submodule has been adapted to compile with the GHC API
changes, but it will need further work to properly support modules
that use the DuplicateRecordFields extension.

Test Plan: New tests added in testsuite/tests/overloadedrecflds; these
will be extended once the other parts are implemented.

Reviewers: goldfire, bgamari, simonpj, austin

Subscribers: sjcjoosten, haggholm, mpickering, bgamari, tibbe, thomie,
goldfire

Differential Revision: https://phabricator.haskell.org/D761

2 files changed, 13 insertions, 7 deletions

diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 9245deb459..e24d1cbcea 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1916,7 +1916,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 (unLoc $2)) $4 ($1 `mplus` $5)))
+                      (ConDeclField (reverse (map (fmap (flip FieldOcc PlaceHolder)) (unLoc $2))) $4 ($1 `mplus` $5)))
                    [mj AnnDcolon $3] }
 
 -- We allow the odd-looking 'inst_type' in a deriving clause, so that
@@ -2658,13 +2658,13 @@ fbinds1 :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
         | '..'                          { ([mj AnnDotdot $1],([],   True)) }
 
 fbind   :: { LHsRecField RdrName (LHsExpr RdrName) }
-        : qvar '=' texp {% ams  (sLL $1 $> $ HsRecField $1 $3             False)
+        : qvar '=' texp {% ams  (sLL $1 $> $ HsRecField (fmap 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 $1 placeHolderPunRhs True }
+        | qvar          { sLL $1 $> $ HsRecField (fmap mkFieldOcc $1) placeHolderPunRhs True }
                         -- In the punning case, use a place-holder
                         -- The renamer fills in the final value
 
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index a83f6b36da..8bc4f6c076 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -225,7 +225,8 @@ mkDataFamInst loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_
        ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
        ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
        ; return (L loc (DataFamInstD (
-                  DataFamInstDecl { dfid_tycon = tc, dfid_pats = mkHsWithBndrs tparams
+                  DataFamInstDecl { dfid_tycon = tc
+                                  , dfid_pats = mkHsWithBndrs tparams
                                   , dfid_defn = defn, dfid_fvs = placeHolderNames }))) }
 
 mkTyFamInst :: SrcSpan
@@ -1177,14 +1178,19 @@ mkRecConstrOrUpdate
 mkRecConstrOrUpdate (L l (HsVar c)) _ (fs,dd)
   | isRdrDataCon c
   = return (RecordCon (L l c) noPostTcExpr (mk_rec_fields fs dd))
-mkRecConstrOrUpdate exp _ (fs,dd)
-  = return (RecordUpd exp (mk_rec_fields fs dd)
+mkRecConstrOrUpdate exp@(L l _) _ (fs,dd)
+  | dd        = parseErrorSDoc l (text "You cannot use `..' in a record update")
+  | otherwise = return (RecordUpd exp (map (fmap mk_rec_upd_field) fs)
                       PlaceHolder PlaceHolder PlaceHolder)
 
 mk_rec_fields :: [LHsRecField id arg] -> Bool -> HsRecFields id arg
 mk_rec_fields fs False = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
 mk_rec_fields fs True  = HsRecFields { rec_flds = fs, rec_dotdot = Just (length fs) }
 
+mk_rec_upd_field :: HsRecField RdrName (LHsExpr RdrName) -> HsRecUpdField RdrName
+mk_rec_upd_field (HsRecField (L loc (FieldOcc rdr _)) arg pun)
+  = HsRecField (L loc (Unambiguous rdr PlaceHolder)) arg pun
+
 mkInlinePragma :: String -> (InlineSpec, RuleMatchInfo) -> Maybe Activation
                -> InlinePragma
 -- The (Maybe Activation) is because the user can omit
@@ -1320,7 +1326,7 @@ mkModuleImpExp n@(L l name) subs =
       | isVarNameSpace (rdrNameSpace name) -> IEVar       n
       | otherwise                          -> IEThingAbs  (L l name)
     ImpExpAll                              -> IEThingAll  (L l name)
-    ImpExpList xs                          -> IEThingWith (L l name) xs
+    ImpExpList xs                          -> IEThingWith (L l name) xs []
 
 mkTypeImpExp :: Located RdrName   -- TcCls or Var name space
              -> P (Located RdrName)