diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2016-06-18 14:51:04 +0100 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2016-06-20 14:50:32 +0100 |
| commit | 0ba34b6bac988228948c65ae11d9e08afe82c878 (patch) | |
| tree | 9adf349c840919ce744e8eecedd5545c8d8e0a2b /compiler/rename | |
| parent | 0e92af91f7246dd8c6f01ccc475f621e8869a423 (diff) | |
| download | haskell-0ba34b6bac988228948c65ae11d9e08afe82c878.tar.gz | |
ApplicativeDo: allow "return $ e"
Summary:
There's a precedent for special-casing $, as we already have special
typing rules for it.
Test Plan: validate; new test cases
Reviewers: ezyang, austin, niteria, bgamari, simonpj, erikd
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2345
GHC Trac Issues: #11835
Diffstat (limited to 'compiler/rename')
| -rw-r--r-- | compiler/rename/RnExpr.hs | 22 |
1 files changed, 13 insertions, 9 deletions
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index c92f69e6e3..f8a53e0689 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -1765,19 +1765,23 @@ needJoin [L loc (LastStmt e _ t)] | Just arg <- isReturnApp e = (False, [L loc (LastStmt arg True t)]) needJoin stmts = (True, stmts) --- | @Just e@, if the expression is @return e@, otherwise @Nothing@ +-- | @Just e@, if the expression is @return e@ or @return $ e@, +-- otherwise @Nothing@ isReturnApp :: LHsExpr Name -> Maybe (LHsExpr Name) isReturnApp (L _ (HsPar expr)) = isReturnApp expr -isReturnApp (L _ (HsApp f arg)) - | is_return f = Just arg - | otherwise = Nothing +isReturnApp (L _ e) = case e of + OpApp l op _ r | is_return l, is_dollar op -> Just r + HsApp f arg | is_return f -> Just arg + _otherwise -> Nothing where - is_return (L _ (HsPar e)) = is_return e - is_return (L _ (HsAppType e _)) = is_return e - is_return (L _ (HsVar (L _ r))) = r == returnMName || r == pureAName + is_var f (L _ (HsPar e)) = is_var f e + is_var f (L _ (HsAppType e _)) = is_var f e + is_var f (L _ (HsVar (L _ r))) = f r -- TODO: I don't know how to get this right for rebindable syntax - is_return _ = False -isReturnApp _ = Nothing + is_var _ _ = False + + is_return = is_var (\n -> n == returnMName || n == pureAName) + is_dollar = is_var (`hasKey` dollarIdKey) {- ************************************************************************ |