Commit b412d823 authored by Matthew Pickering's avatar Matthew Pickering Committed by Ben Gamari

Allow one type signature for multiple pattern synonyms

This makes pattern synonym signatures more consistent with normal
type signatures.

Updates haddock submodule.

Differential Revision: https://phabricator.haskell.org/D2083
parent 81b437bc
......@@ -700,7 +700,7 @@ rep_sigs' sigs = do { sigs1 <- mapM rep_sig sigs ;
rep_sig :: LSig Name -> DsM [(SrcSpan, Core TH.DecQ)]
rep_sig (L loc (TypeSig nms ty)) = mapM (rep_wc_ty_sig sigDName loc ty) nms
rep_sig (L loc (PatSynSig nm ty)) = (:[]) <$> rep_patsyn_ty_sig loc ty nm
rep_sig (L loc (PatSynSig nms ty)) = mapM (rep_patsyn_ty_sig loc ty) nms
rep_sig (L loc (ClassOpSig is_deflt nms ty))
| is_deflt = mapM (rep_ty_sig defaultSigDName loc ty) nms
| otherwise = mapM (rep_ty_sig sigDName loc ty) nms
......
......@@ -375,7 +375,7 @@ cvtDec (TH.PatSynD nm args dir pat)
cvtDec (TH.PatSynSigD nm ty)
= do { nm' <- cNameL nm
; ty' <- cvtPatSynSigTy ty
; returnJustL $ Hs.SigD $ PatSynSig nm' (mkLHsSigType ty') }
; returnJustL $ Hs.SigD $ PatSynSig [nm'] (mkLHsSigType ty') }
----------------
cvtTySynEqn :: Located RdrName -> TySynEqn -> CvtM (LTyFamInstEqn RdrName)
......
......@@ -705,7 +705,7 @@ data Sig name
-- 'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'
-- For details on above see note [Api annotations] in ApiAnnotation
| PatSynSig (Located name) (LHsSigType name)
| PatSynSig [Located name] (LHsSigType name)
-- P :: forall a b. Req => Prov => ty
-- | A signature for a class method
......@@ -901,9 +901,8 @@ ppr_sig (InlineSig var inl) = pragBrackets (ppr inl <+> pprPrefixOcc (unLo
ppr_sig (SpecInstSig _ ty)
= pragBrackets (text "SPECIALIZE instance" <+> ppr ty)
ppr_sig (MinimalSig _ bf) = pragBrackets (pprMinimalSig bf)
ppr_sig (PatSynSig name sig_ty)
= text "pattern" <+> pprPrefixOcc (unLoc name) <+> dcolon
<+> ppr sig_ty
ppr_sig (PatSynSig names sig_ty)
= text "pattern" <+> pprVarSig (map unLoc names) (ppr sig_ty)
instance OutputableBndr name => Outputable (FixitySig name) where
ppr (FixitySig names fixity) = sep [ppr fixity, pprops]
......
......@@ -1194,8 +1194,8 @@ where_decls :: { Located ([AddAnn]
,sL1 $3 (snd $ unLoc $3)) }
pattern_synonym_sig :: { LSig RdrName }
: 'pattern' con '::' sigtype
{% ams (sLL $1 $> $ PatSynSig $2 (mkLHsSigType $4))
: 'pattern' con_list '::' sigtype
{% ams (sLL $1 $> $ PatSynSig (unLoc $2) (mkLHsSigType $4))
[mj AnnPattern $1, mu AnnDcolon $3] }
-----------------------------------------------------------------------------
......
......@@ -558,8 +558,8 @@ mkSigTvFn sigs
= add_scoped_tvs names (hsScopedTvs sig_ty) env
add_scoped_sig (L _ (TypeSig names sig_ty)) env
= add_scoped_tvs names (hsWcScopedTvs sig_ty) env
add_scoped_sig (L _ (PatSynSig name sig_ty)) env
= add_scoped_tvs [name] (hsScopedTvs sig_ty) env
add_scoped_sig (L _ (PatSynSig names sig_ty)) env
= add_scoped_tvs names (hsScopedTvs sig_ty) env
add_scoped_sig _ env = env
add_scoped_tvs :: [Located Name] -> [Name] -> NameEnv [Name] -> NameEnv [Name]
......@@ -925,13 +925,13 @@ renameSig ctxt sig@(MinimalSig s (L l bf))
= do new_bf <- traverse (lookupSigOccRn ctxt sig) bf
return (MinimalSig s (L l new_bf), emptyFVs)
renameSig ctxt sig@(PatSynSig v ty)
= do { v' <- lookupSigOccRn ctxt sig v
renameSig ctxt sig@(PatSynSig vs ty)
= do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
; (ty', fvs) <- rnHsSigType ty_ctxt ty
; return (PatSynSig v' ty', fvs) }
; return (PatSynSig new_vs ty', fvs) }
where
ty_ctxt = GenericCtx (text "a pattern synonym signature for"
<+> quotes (ppr v))
<+> ppr_sig_bndrs vs)
ppr_sig_bndrs :: [Located RdrName] -> SDoc
ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs)
......
......@@ -601,7 +601,7 @@ getTypeSigNames sigs
get_type_sig sig ns =
case sig of
L _ (TypeSig names _) -> extendNameSetList ns (map unLoc names)
L _ (PatSynSig name _) -> extendNameSet ns (unLoc name)
L _ (PatSynSig names _) -> extendNameSetList ns (map unLoc names)
_ -> ns
......
......@@ -196,10 +196,11 @@ tcTySig (L loc (TypeSig names sig_ty))
| L _ name <- names ]
; return (map TcIdSig sigs) }
tcTySig (L loc (PatSynSig (L _ name) sig_ty))
tcTySig (L loc (PatSynSig names sig_ty))
= setSrcSpan loc $
do { tpsi <- tcPatSynSig name sig_ty
; return [TcPatSynSig tpsi] }
do { tpsigs <- sequence [ tcPatSynSig name sig_ty
| L _ name <- names ]
; return (map TcPatSynSig tpsigs) }
tcTySig _ = return []
......
......@@ -4315,14 +4315,19 @@ Note also the following points
- You may specify an explicit *pattern signature*, as we did for
``ExNumPat`` above, to specify the type of a pattern, just as you can
for a function. As usual, the type signature can be less polymorphic
than the inferred type. For example
::
than the inferred type. For example ::
-- Inferred type would be 'a -> [a]'
pattern SinglePair :: (a, a) -> [(a, a)]
pattern SinglePair x = [x]
Just like signatures on value-level bindings, pattern synonym signatures can
apply to more than one pattern. For instance, ::
pattern Left', Right' :: a -> Either a a
pattern Left' x = Left x
pattern Right' x = Right x
- The GHCi :ghci-cmd:`:info` command shows pattern types in this format.
- For a bidirectional pattern synonym, a use of the pattern synonym as
......
{-# LANGUAGE PatternSynonyms #-}
module T11727 where
pattern A,B :: Int
pattern A = 5
pattern B = 5
......@@ -52,6 +52,7 @@ test('T11336', normal, compile, [''])
test('T11367', normal, compile, [''])
test('T11351', normal, compile, [''])
test('T11633', normal, compile, [''])
test('T11727', normal, compile, [''])
test('T11959', expect_broken(11959), multimod_compile, ['T11959', '-v0'])
test('T12094', normal, compile, [''])
test('T11977', normal, compile, [''])
......
Subproject commit f833ba8cdbe6ea9436f9f7bf79494a968e8394f0
Subproject commit 008e61d0c4b10713751c2a1de4958acc75367396
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