ghc: implement OverloadedRecordFieldswip/orf

This fully implements the new ORF extension, developed during the Google
Summer of Code 2013, and as described on the wiki:

  https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields

This also updates the Haddock submodule.

Reviewed-by: Simon Peyton Jones <simonpj@microsoft.com>
Signed-off-by: Austin Seipp <austin@well-typed.com>

1 files changed, 17 insertions, 3 deletions

diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 01e8a4492d..e3d2a10642 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -102,19 +102,28 @@ finishHsVar name
                 ; return (e, unitFV name) } }
 
 rnExpr (HsVar v)
-  = do { mb_name <- lookupOccRn_maybe v
+  = do { mb_name <- lookupOccRn_overloaded v
        ; case mb_name of {
            Nothing -> do { opt_TypeHoles <- woptM Opt_WarnTypedHoles
                          ; if opt_TypeHoles && startsWithUnderscore (rdrNameOcc v)
                            then return (HsUnboundVar v, emptyFVs)
                            else do { n <- reportUnboundName v; finishHsVar n } } ;
-           Just name
+           Just (Left name)
               | name == nilDataConName -- Treat [] as an ExplicitList, so that
                                        -- OverloadedLists works correctly
               -> rnExpr (ExplicitList placeHolderType Nothing [])
 
               | otherwise
-              -> finishHsVar name }}
+              -> finishHsVar name ;
+           Just (Right (fld, xs)) ->
+               do { overloaded <- xoptM Opt_OverloadedRecordFields
+                  ; if overloaded
+                    then do { when (isQual v && length xs > 1) $
+                                  addErrTc $ qualifiedOverloadedRecordField v
+                            ; return (HsOverloadedRecFld fld, mkFVs (map snd xs)) }
+                    else case xs of
+                         [(_, name)] -> return (HsSingleRecFld v name, unitFV name)
+                         _           -> error "rnExpr/HsVar" } } }
 
 rnExpr (HsIPVar v)
   = return (HsIPVar v, emptyFVs)
@@ -1362,4 +1371,9 @@ badIpBinds :: Outputable a => SDoc -> a -> SDoc
 badIpBinds what binds
   = hang (ptext (sLit "Implicit-parameter bindings illegal in") <+> what)
          2 (ppr binds)
+
+qualifiedOverloadedRecordField :: RdrName -> SDoc
+qualifiedOverloadedRecordField v
+  = hang (ptext (sLit "Overloaded record field should not be qualified:"))
+       2 (quotes (ppr v))
 \end{code}