diff options
Diffstat (limited to 'compiler/rename/RnExpr.lhs')
| -rw-r--r-- | compiler/rename/RnExpr.lhs | 20 |
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} |