Commit 5dd6b13c authored by Ryan Scott's avatar Ryan Scott

Disallow bang/lazy patterns in the RHSes of implicitly bidirectional patsyns

Summary:
GHC was allowing implicitly bidirectional pattern synonyms with bang
patterns and irrefutable patterns in the RHS, like so:

```lang=haskell
pattern StrictJust a = Just !a
```

This has multiple problems:

1. `Just !a` isn't a valid expression, so it feels strange to allow it in an
   implicitly bidirectional pattern synonym.
2. `StrictJust` doesn't provide the strictness properties one would expect
   from a strict constructor. (One could imagine a design where the
   `StrictJust` builder infers a bang pattern for its pattern variable, but
   accomplishing this inference in a way that accounts for all possible
   patterns on the RHS, including other pattern synonyms, is somewhat
   awkward, so we do not pursue this design.)

We nip these issues in the bud by simply disallowing bang/irrefutable patterns
on the RHS.

Test Plan: make test TEST="T14112 unidir"

Reviewers: simonpj, austin, bgamari

Reviewed By: simonpj

Subscribers: rwbarton, thomie

GHC Trac Issues: #14112

Differential Revision: https://phabricator.haskell.org/D3896
parent 6330b0b0
......@@ -574,7 +574,7 @@ tcPatSynBuilderBind (PSB { psb_id = L loc name, psb_def = lpat
mb_match_group
= case dir of
ExplicitBidirectional explicit_mg -> Right explicit_mg
ImplicitBidirectional -> fmap mk_mg (tcPatToExpr args lpat)
ImplicitBidirectional -> fmap mk_mg (tcPatToExpr name args lpat)
Unidirectional -> panic "tcPatSynBuilderBind"
mk_mg :: LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn)
......@@ -621,7 +621,8 @@ add_void need_dummy_arg ty
| need_dummy_arg = mkFunTy voidPrimTy ty
| otherwise = ty
tcPatToExpr :: [Located Name] -> LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn)
tcPatToExpr :: Name -> [Located Name] -> LPat GhcRn
-> Either MsgDoc (LHsExpr GhcRn)
-- Given a /pattern/, return an /expression/ that builds a value
-- that matches the pattern. E.g. if the pattern is (Just [x]),
-- the expression is (Just [x]). They look the same, but the
......@@ -630,7 +631,7 @@ tcPatToExpr :: [Located Name] -> LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn)
--
-- Returns (Left r) if the pattern is not invertible, for reason r.
-- See Note [Builder for a bidirectional pattern synonym]
tcPatToExpr args pat = go pat
tcPatToExpr name args pat = go pat
where
lhsVars = mkNameSet (map unLoc args)
......@@ -667,8 +668,6 @@ tcPatToExpr args pat = go pat
| otherwise
= Left (quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym")
go1 (ParPat pat) = fmap HsPar $ go pat
go1 (LazyPat pat) = go1 (unLoc pat)
go1 (BangPat pat) = go1 (unLoc pat)
go1 (PArrPat pats ptt) = do { exprs <- mapM go pats
; return $ ExplicitPArr ptt exprs }
go1 (ListPat pats ptt reb) = do { exprs <- mapM go pats
......@@ -689,7 +688,28 @@ tcPatToExpr args pat = go pat
go1 (SplicePat (HsSpliced _ (HsSplicedPat pat)))
= go1 pat
go1 (SplicePat (HsSpliced{})) = panic "Invalid splice variety"
go1 p = Left (text "pattern" <+> quotes (ppr p) <+> text "is not invertible")
-- The following patterns are not invertible.
go1 p@(BangPat {}) = notInvertible p -- #14112
go1 p@(LazyPat {}) = notInvertible p
go1 p@(WildPat {}) = notInvertible p
go1 p@(AsPat {}) = notInvertible p
go1 p@(ViewPat {}) = notInvertible p
go1 p@(NPlusKPat {}) = notInvertible p
go1 p@(SplicePat (HsTypedSplice {})) = notInvertible p
go1 p@(SplicePat (HsUntypedSplice {})) = notInvertible p
go1 p@(SplicePat (HsQuasiQuote {})) = notInvertible p
notInvertible p = Left $
text "Pattern" <+> quotes (ppr p) <+> text "is not invertible"
$+$ hang (text "Suggestion: instead use an explicitly bidirectional"
<+> text "pattern synonym, e.g.")
2 (hang (text "pattern" <+> pp_name <+> pp_args <+> larrow
<+> ppr pat <+> text "where")
2 (pp_name <+> pp_args <+> equals <+> text "..."))
where
pp_name = ppr name
pp_args = hsep (map ppr args)
{- Note [Builder for a bidirectional pattern synonym]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
......@@ -27,6 +27,20 @@ Language
wish to; this is quite like how regular datatypes with a kind signature can omit
some type variables.
- Implicitly bidirectional pattern synonyms no longer allow bang patterns
(``!``) or irrefutable patterns (``~``) on the right-hand side. Previously,
this was allowed, although the bang patterns and irrefutable patterns would
be silently ignored when used in an expression context. This is now a proper
error, and explicitly bidirectional pattern synonyms should be used in their
stead. That is, instead of using this (which is an error): ::
data StrictJust a = Just !a
Use this: ::
data StrictJust a <- Just !a where
StrictJust !a = Just a
Compiler
~~~~~~~~
......
......@@ -5096,6 +5096,21 @@ We can then use ``HeadC`` in both expression and pattern contexts. In a pattern
context it will match the head of any list with length at least one. In an
expression context it will construct a singleton list.
Explicitly bidirectional pattern synonyms offer greater flexibility than
implicitly bidirectional ones in terms of the syntax that is permitted. For
instance, the following is not a legal implicitly bidirectional pattern
synonym: ::
pattern StrictJust a = Just !a
This is illegal because the use of :ghc-flag:`-XBangPatterns` on the right-hand
sides prevents it from being a well formed expression. However, constructing a
strict pattern synonym is quite possible with an explicitly bidirectional
pattern synonym: ::
pattern StrictJust a <- Just !a where
StrictJust !a = Just a
The table below summarises where each kind of pattern synonym can be used.
+---------------+----------------+---------------+---------------------------+
......@@ -7158,7 +7173,7 @@ Unlike with ordinary data definitions, the result kind of a data family
does not need to be ``*``: it can alternatively be a kind variable
(with :ghc-flag:`-XPolyKinds`). Data instances' kinds must end in
``*``, however.
.. _data-instance-declarations:
Data instance declarations
......
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
module T14112 where
pattern MyJust1 a = Just !a
T14112.hs:5:21: error:
Invalid right-hand side of bidirectional pattern synonym ‘MyJust1’:
Pattern ‘!a’ is not invertible
Suggestion: instead use an explicitly bidirectional pattern synonym, e.g.
pattern MyJust1 a <- Just !a where MyJust1 a = ...
RHS pattern: Just !a
......@@ -36,4 +36,5 @@ test('T12819', normal, compile_fail, [''])
test('UnliftedPSBind', normal, compile_fail, [''])
test('T13349', normal, compile_fail, [''])
test('T13470', normal, compile_fail, [''])
test('T14112', normal, compile_fail, [''])
test('T14114', normal, compile_fail, [''])
unidir.hs:4:18: error:
Invalid right-hand side of bidirectional pattern synonym ‘Head’:
pattern ‘_’ is not invertible
Pattern ‘_’ is not invertible
Suggestion: instead use an explicitly bidirectional pattern synonym, e.g.
pattern Head x <- x : _ where Head x = ...
RHS pattern: x : _
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