diff options
Diffstat (limited to 'compiler/GHC/Tc')
| -rw-r--r-- | compiler/GHC/Tc/Gen/Match.hs | 13 | ||||
| -rw-r--r-- | compiler/GHC/Tc/TyCl/PatSyn.hs | 4 |
2 files changed, 10 insertions, 7 deletions
diff --git a/compiler/GHC/Tc/Gen/Match.hs b/compiler/GHC/Tc/Gen/Match.hs index fb8d58c520..0a85147309 100644 --- a/compiler/GHC/Tc/Gen/Match.hs +++ b/compiler/GHC/Tc/Gen/Match.hs @@ -65,6 +65,7 @@ import GHC.Builtin.Types.Prim import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc +import GHC.Driver.Session ( getDynFlags ) import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name @@ -947,12 +948,12 @@ tcMonadFailOp :: CtOrigin -- match can't fail (so the fail op is Nothing), however, it seems that the -- isIrrefutableHsPat test is still required here for some reason I haven't -- yet determined. -tcMonadFailOp orig pat fail_op res_ty - | isIrrefutableHsPat pat - = return Nothing - | otherwise - = Just . snd <$> (tcSyntaxOp orig fail_op [synKnownType stringTy] - (mkCheckExpType res_ty) $ \_ _ -> return ()) +tcMonadFailOp orig pat fail_op res_ty = do + dflags <- getDynFlags + if isIrrefutableHsPat dflags pat + then return Nothing + else Just . snd <$> (tcSyntaxOp orig fail_op [synKnownType stringTy] + (mkCheckExpType res_ty) $ \_ _ -> return ()) {- Note [Treat rebindable syntax first] diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs index 2fd0669f91..593226db5c 100644 --- a/compiler/GHC/Tc/TyCl/PatSyn.hs +++ b/compiler/GHC/Tc/TyCl/PatSyn.hs @@ -61,6 +61,7 @@ import GHC.Rename.Env import GHC.Data.Bag import GHC.Utils.Misc import GHC.Utils.Error +import GHC.Driver.Session ( getDynFlags ) import Data.Maybe( mapMaybe ) import Control.Monad ( zipWithM ) import Data.List( partition, mapAccumL ) @@ -770,6 +771,7 @@ tcPatSynMatcher (L loc name) lpat prag_fn ; cont <- newSysLocalId (fsLit "cont") Many cont_ty ; fail <- newSysLocalId (fsLit "fail") Many fail_ty + ; dflags <- getDynFlags ; let matcher_tau = mkVisFunTysMany [pat_ty, cont_ty, fail_ty] res_ty matcher_sigma = mkInfSigmaTy (rr_tv:res_tv:univ_tvs) req_theta matcher_tau matcher_id = mkExportedVanillaId matcher_name matcher_sigma @@ -782,7 +784,7 @@ tcPatSynMatcher (L loc name) lpat prag_fn args = map nlVarPat [scrutinee, cont, fail] lwpat = noLoc $ WildPat pat_ty - cases = if isIrrefutableHsPat lpat + cases = if isIrrefutableHsPat dflags lpat then [mkHsCaseAlt lpat cont'] else [mkHsCaseAlt lpat cont', mkHsCaseAlt lwpat fail'] |