buildPatSyn :: Name -> Bool
            -> (Id,Bool) -> Maybe (Id, Bool)
            -> ([TyVarBinder], ThetaType) -- ^ Univ and req
            -> ([TyVarBinder], ThetaType) -- ^ Ex and prov
            -> [Type]               -- ^ Argument types
            -> Type                 -- ^ Result type
            -> [FieldLabel]         -- ^ Field labels for
                                    --   a record pattern synonym
            -> PatSyn
buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder
            (univ_tvs, req_theta) (ex_tvs, prov_theta) arg_tys
            pat_ty field_labels
  = -- The assertion checks that the matcher is
    -- compatible with the pattern synonym
    ASSERT2((and [ univ_tvs `equalLength` univ_tvs1
                 , ex_tvs `equalLength` ex_tvs1
                 , pat_ty `eqType` substTy subst pat_ty1
                 , prov_theta `eqTypes` substTys subst prov_theta1
                 , req_theta `eqTypes` substTys subst req_theta1
                 , compareArgTys arg_tys (substTys subst arg_tys1)
                 ])
            , (vcat [ ppr univ_tvs <+> twiddle <+> ppr univ_tvs1
                    , ppr ex_tvs <+> twiddle <+> ppr ex_tvs1
                    , ppr pat_ty <+> twiddle <+> ppr pat_ty1
                    , ppr prov_theta <+> twiddle <+> ppr prov_theta1
                    , ppr req_theta <+> twiddle <+> ppr req_theta1
                    , ppr arg_tys <+> twiddle <+> ppr arg_tys1]))
    mkPatSyn src_name declared_infix
             (univ_tvs, req_theta) (ex_tvs, prov_theta)
             arg_tys pat_ty
             matcher builder field_labels
  where
    ((_:_:univ_tvs1), req_theta1, tau) = tcSplitSigmaTy $ idType matcher_id
    ([pat_ty1, cont_sigma, _], _)      = tcSplitFunTys tau
    (ex_tvs1, prov_theta1, cont_tau)   = tcSplitSigmaTy cont_sigma
    (arg_tys1, _) = (tcSplitFunTys cont_tau)
    twiddle = char '~'
    subst = zipTvSubst (univ_tvs1 ++ ex_tvs1)
                       (mkTyVarTys (binderVars (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


------------------------------------------------------
buildPatSyn :: Name -> Bool
            -> (Id,Bool) -> Maybe (Id, Bool)
            -> ([TyVarBinder], ThetaType) -- ^ Univ and req
            -> ([TyVarBinder], ThetaType) -- ^ Ex and prov
            -> [Type]               -- ^ Argument types
            -> Type                 -- ^ Result type
            -> [FieldLabel]         -- ^ Field labels for
                                    --   a record pattern synonym
            -> PatSyn
buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder
            (univ_tvs, req_theta) (ex_tvs, prov_theta) arg_tys
            pat_ty field_labels
  = -- The assertion checks that the matcher is
    -- compatible with the pattern synonym
    ASSERT2((and [ univ_tvs `equalLength` univ_tvs1
                 , ex_tvs `equalLength` ex_tvs1
                 , pat_ty `eqType` substTy subst pat_ty1
                 , prov_theta `eqTypes` substTys subst prov_theta1
                 , req_theta `eqTypes` substTys subst req_theta1
                 , compareArgTys arg_tys (substTys subst arg_tys1)
                 ])
            , (vcat [ ppr univ_tvs <+> twiddle <+> ppr univ_tvs1
                    , ppr ex_tvs <+> twiddle <+> ppr ex_tvs1
                    , ppr pat_ty <+> twiddle <+> ppr pat_ty1
                    , ppr prov_theta <+> twiddle <+> ppr prov_theta1
                    , ppr req_theta <+> twiddle <+> ppr req_theta1
                    , ppr arg_tys <+> twiddle <+> ppr arg_tys1]))
    mkPatSyn src_name declared_infix
             (univ_tvs, req_theta) (ex_tvs, prov_theta)
             arg_tys pat_ty
             matcher builder field_labels
  where
    ((_:_:univ_tvs1), req_theta1, tau) = tcSplitSigmaTy $ idType matcher_id
    ([pat_ty1, cont_sigma, _], _)      = tcSplitFunTys tau
    (ex_tvs1, prov_theta1, cont_tau)   = tcSplitSigmaTy cont_sigma
    (arg_tys1, _) = (tcSplitFunTys cont_tau)
    twiddle = char '~'
    subst = zipTvSubst (univ_tvs1 ++ ex_tvs1)
                       (mkTyVarTys (binderVars (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


------------------------------------------------------
buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder
            (univ_tvs, req_theta) (ex_tvs, prov_theta) arg_tys
            pat_ty field_labels
  = -- The assertion checks that the matcher is
    -- compatible with the pattern synonym
    ASSERT2((and [ univ_tvs `equalLength` univ_tvs1
                 , ex_tvs `equalLength` ex_tvs1
                 , pat_ty `eqType` substTy subst pat_ty1
                 , prov_theta `eqTypes` substTys subst prov_theta1
                 , req_theta `eqTypes` substTys subst req_theta1
                 , compareArgTys arg_tys (substTys subst arg_tys1)
                 ])
            , (vcat [ ppr univ_tvs <+> twiddle <+> ppr univ_tvs1
                    , ppr ex_tvs <+> twiddle <+> ppr ex_tvs1
                    , ppr pat_ty <+> twiddle <+> ppr pat_ty1
                    , ppr prov_theta <+> twiddle <+> ppr prov_theta1
                    , ppr req_theta <+> twiddle <+> ppr req_theta1
                    , ppr arg_tys <+> twiddle <+> ppr arg_tys1]))
    mkPatSyn src_name declared_infix
             (univ_tvs, req_theta) (ex_tvs, prov_theta)
             arg_tys pat_ty
             matcher builder field_labels
  where
    ((_:_:univ_tvs1), req_theta1, tau) = tcSplitSigmaTy $ idType matcher_id
    ([pat_ty1, cont_sigma, _], _)      = tcSplitFunTys tau
    (ex_tvs1, prov_theta1, cont_tau)   = tcSplitSigmaTy cont_sigma
    (arg_tys1, _) = (tcSplitFunTys cont_tau)
    twiddle = char '~'
    subst = zipTvSubst (univ_tvs1 ++ ex_tvs1)
                       (mkTyVarTys (binderVars (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


------------------------------------------------------