Commit c33aad1e authored by Matthew Pickering's avatar Matthew Pickering Committed by Ben Gamari
Browse files

Refine ASSERT in buildPatSyn for the nullary case.

For a nullary pattern synonym we add an extra void argument to the
matcher in order to preserve laziness. The check in buildPatSyn
wasn't aware of this special case which was causing the assertion to

Reviewers: austin, simonpj, bgamari

Reviewed By: simonpj, bgamari

Subscribers: simonpj, thomie

Differential Revision:

GHC Trac Issues: #12746

(cherry picked from commit 23143f60)
parent 5c91d076
......@@ -19,6 +19,7 @@ module BuildTyCl (
import IfaceEnv
import FamInstEnv( FamInstEnvs, mkNewTypeCoAxiom )
import TysWiredIn( isCTupleTyConName )
import TysPrim ( voidPrimTy )
import DataCon
import PatSyn
import Var
......@@ -197,7 +198,7 @@ buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder
, pat_ty `eqType` substTy subst pat_ty1
, prov_theta `eqTypes` substTys subst prov_theta1
, req_theta `eqTypes` substTys subst req_theta1
, arg_tys `eqTypes` substTys subst arg_tys1
, compareArgTys arg_tys (substTys subst arg_tys1)
, (vcat [ ppr univ_tvs <+> twiddle <+> ppr univ_tvs1
, ppr ex_tvs <+> twiddle <+> ppr ex_tvs1
......@@ -218,6 +219,13 @@ buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder
subst = zipTvSubst (univ_tvs1 ++ ex_tvs1)
(mkTyVarTys (univ_tvs ++ ex_tvs))
-- For a nullary pattern synonym we add a single void argument to the
-- matcher to preserve laziness in the case of unlifted types.
-- See #12746
compareArgTys :: [Type] -> [Type] -> Bool
compareArgTys [] [x] = x `eqType` voidPrimTy
compareArgTys arg_tys matcher_arg_tys = arg_tys `eqTypes` matcher_arg_tys
type TcMethInfo -- A temporary intermediate, to communicate
-- between tcClassSigs and buildClass.
module T12746 where
import T12746A
foo a = case a of
Foo -> True
_ -> False
{-# LANGUAGE ScopedTypeVariables, PatternSynonyms #-}
module T12746A where
pattern Foo :: Int
pattern Foo = 0x00000001
......@@ -59,3 +59,4 @@ test('T12615', normal, compile, [''])
test('T11987', normal, multimod_compile, ['T11987', '-v0'])
test('T12615', normal, compile, [''])
test('T12698', normal, compile, [''])
test('T12746', normal, multi_compile, ['T12746', [('T12746A.hs', '-c')],'-v0'])
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