mkFunTy, mkFunTys, exactTyVarsOfTypes,
tidyOpenTypes )
import VarSet ( elemVarSet, mkVarSet )
-import Kind ( liftedTypeKind )
+import Kind ( liftedTypeKind, openTypeKind )
import TcUnify ( boxySplitTyConApp, boxySplitListTy,
unBox, stripBoxyType, zapToMonotype,
boxyMatchTypes, boxyUnify, boxyUnifyList, checkSigTyVarsWrt )
= do { let init_state = PS { pat_ctxt = ctxt, pat_reft = emptyTvSubst }
; (pats', ex_tvs, res) <- tc_lpats init_state pats tys $ \ pstate' ->
- thing_inside (refineType (pat_reft pstate') res_ty)
+ refineEnvironment (pat_reft pstate') $
+ thing_inside (refineType (pat_reft pstate') res_ty)
; tcCheckExistentialPat ctxt pats' ex_tvs tys res_ty
; ifM (null pats) (zapToMonotype pat_ty) -- c.f. ExplicitPArr in TcExpr
; return (PArrPat pats' elt_ty, pats_tvs, res) }
-tc_pat pstate (TuplePat pats boxity) pat_ty thing_inside
+tc_pat pstate (TuplePat pats boxity _) pat_ty thing_inside
= do { arg_tys <- boxySplitTyConApp (tupleTyCon boxity (length pats)) pat_ty
; (pats', pats_tvs, res) <- tc_lpats pstate pats arg_tys thing_inside
-- so that we can experiment with lazy tuple-matching.
-- This is a pretty odd place to make the switch, but
-- it was easy to do.
- ; let unmangled_result = TuplePat pats' boxity
+ ; let unmangled_result = TuplePat pats' boxity pat_ty
possibly_mangled_result
| opt_IrrefutableTuples && isBoxed boxity = LazyPat (noLoc unmangled_result)
| otherwise = unmangled_result
find_inst tv
| not (tv `elemVarSet` res_tvs) = return (mkTyVarTy tv)
| Just boxy_ty <- lookupTyVar subst tv = return boxy_ty
- | otherwise = do { tv <- newBoxyTyVar
+ | otherwise = do { tv <- newBoxyTyVar openTypeKind
; return (mkTyVarTy tv) }
; pat_tys' <- mapM find_inst pat_tvs
-- to refine the environment or pstate
-> do { traceTc trace_msg
; thing_inside pstate pat_tvs' }
- | otherwise -- New bindings affect the context, so refine
- -- the environment and pstate
- -> refineEnvironment (pat_reft pstate') $
- do { traceTc trace_msg
+ | otherwise -- New bindings affect the context, so pass down pstate'.
+ -- DO NOT refine the envt, because we might be inside a
+ -- lazy pattern
+ -> do { traceTc trace_msg
; thing_inside pstate' pat_tvs' }
where
pat_tvs' = map (substTyVar new_subst) pat_tvs