diff options
Diffstat (limited to 'compiler/GHC/Tc/Gen/Pat.hs')
| -rw-r--r-- | compiler/GHC/Tc/Gen/Pat.hs | 39 |
1 files changed, 31 insertions, 8 deletions
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs index a09d77b6f7..b0177319ad 100644 --- a/compiler/GHC/Tc/Gen/Pat.hs +++ b/compiler/GHC/Tc/Gen/Pat.hs @@ -19,7 +19,7 @@ module GHC.Tc.Gen.Pat , newLetBndr , LetBndrSpec(..) , tcCheckPat, tcCheckPat_O, tcInferPat - , tcPats + , tcLMatchPats , addDataConStupidTheta , badFieldCon , polyPatSig @@ -99,11 +99,11 @@ tcLetPat sig_fn no_gen pat pat_ty thing_inside ; tc_lpat pat_ty penv pat thing_inside } ----------------- -tcPats :: HsMatchContext GhcTc - -> [LPat GhcRn] -- Patterns, - -> [Scaled ExpSigmaType] -- and their types - -> TcM a -- and the checker for the body - -> TcM ([LPat GhcTc], a) +tcLMatchPats :: HsMatchContext GhcTc + -> [LMatchPat GhcRn] -- Patterns, + -> [Scaled Type] -- and their types + -> TcM a -- and the checker for the body + -> TcM ([LMatchPat GhcTc], a) -- This is the externally-callable wrapper function -- Typecheck the patterns, extend the environment to bind the variables, @@ -116,8 +116,8 @@ tcPats :: HsMatchContext GhcTc -- 3. Check the body -- 4. Check that no existentials escape -tcPats ctxt pats pat_tys thing_inside - = tc_lpats pat_tys penv pats thing_inside +tcLMatchPats ctxt pats pat_tys thing_inside + = tc_lmatchpats pat_tys penv pats thing_inside where penv = PE { pe_lazy = False, pe_ctxt = LamPat ctxt, pe_orig = PatOrigin } @@ -340,6 +340,21 @@ tc_lpat pat_ty penv (L span pat) thing_inside thing_inside ; return (L span pat', res) } +tc_lmatchpat :: Scaled Type + -> Checker (LMatchPat GhcRn) (LMatchPat GhcTc) +tc_lmatchpat (Scaled mult ty') penv (L l (VisPat x pat)) thing_inside + = do { (pat', res) <- tc_lpat (Scaled mult (Check ty')) penv pat thing_inside + ; return (L l (VisPat x pat'), res) } +tc_lmatchpat ty _ (L l' (InvisTyVarPat x (L l name))) thing_inside + = do { let ty' = scaledThing ty + ; let var = mkLocalIdOrCoVar name Many ty' + ; (res,_) <- tcCheckUsage name ty' $ tcExtendIdEnv1 name var thing_inside + ; return (L l' (InvisTyVarPat x (L l var)),res) + } +tc_lmatchpat (Scaled _ ty) _ (L l' (InvisWildTyPat _)) thing_inside + = do { res <- thing_inside + ; return (L l' (InvisWildTyPat ty), res) } + tc_lpats :: [Scaled ExpSigmaType] -> Checker [LPat GhcRn] [LPat GhcTc] tc_lpats tys penv pats @@ -348,6 +363,14 @@ tc_lpats tys penv pats penv (zipEqual "tc_lpats" pats tys) +tc_lmatchpats :: [Scaled Type] + -> Checker [LMatchPat GhcRn] [LMatchPat GhcTc] +tc_lmatchpats tys penv pats + = assertPpr (equalLength pats tys) (ppr pats $$ ppr tys) $ + tcMultiple (\ penv' (p,t) -> tc_lmatchpat t penv' p) + penv + (zipEqual "tc_lampats" pats tys) + -------------------- -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. checkManyPattern :: Scaled a -> TcM HsWrapper |