X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnPat.lhs;h=844a1f90c24d1dbc0c725c91a8d86e78af97c2b3;hp=fffd80f17b816298cb8ec9a592ddb40c3ae86b1c;hb=cbd7463c986d54422de15cb3b56184de116ef7ba;hpb=786932468faac49aafe20b65eabc8bdf465fbc9d diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs index fffd80f..844a1f9 100644 --- a/compiler/rename/RnPat.lhs +++ b/compiler/rename/RnPat.lhs @@ -40,7 +40,7 @@ import TcRnMonad import TcHsSyn ( hsOverLitName ) import RnEnv import RnTypes -import DynFlags ( DynFlag(..) ) +import DynFlags import PrelNames import Constants ( mAX_TUPLE_SIZE ) import Name @@ -245,7 +245,7 @@ rnPat :: HsMatchContext Name -- for error messages -> RnM (a, FreeVars) -- Variables bound by pattern do not -- appear in the result FreeVars rnPat ctxt pat thing_inside - = rnPats ctxt [pat] (\[pat'] -> thing_inside pat') + = rnPats ctxt [pat] (\pats' -> let [pat'] = pats' in thing_inside pat') applyNameMaker :: NameMaker -> Located RdrName -> RnM Name applyNameMaker mk rdr = do { (n, _fvs) <- runCps (newName mk rdr); return n } @@ -299,7 +299,7 @@ rnPatAndThen mk (VarPat rdr) = do { loc <- liftCps getSrcSpanM -- (e.g. in the pattern (x, x -> y) x needs to be bound in the rhs of the tuple) rnPatAndThen mk (SigPatIn pat ty) - = do { patsigs <- liftCps (doptM Opt_ScopedTypeVariables) + = do { patsigs <- liftCps (xoptM Opt_ScopedTypeVariables) ; if patsigs then do { pat' <- rnLPatAndThen mk pat ; ty' <- liftCpsFV (rnHsTypeFVs tvdoc ty) @@ -311,7 +311,7 @@ rnPatAndThen mk (SigPatIn pat ty) rnPatAndThen mk (LitPat lit) | HsString s <- lit - = do { ovlStr <- liftCps (doptM Opt_OverloadedStrings) + = do { ovlStr <- liftCps (xoptM Opt_OverloadedStrings) ; if ovlStr then rnPatAndThen mk (mkNPat (mkHsIsString s placeHolderType) Nothing) else normal_lit } @@ -342,7 +342,7 @@ rnPatAndThen mk (AsPat rdr pat) ; return (AsPat (L (nameSrcSpan new_name) new_name) pat') } rnPatAndThen mk p@(ViewPat expr pat ty) - = do { liftCps $ do { vp_flag <- doptM Opt_ViewPatterns + = do { liftCps $ do { vp_flag <- xoptM Opt_ViewPatterns ; checkErr vp_flag (badViewPat p) } -- Because of the way we're arranging the recursive calls, -- this will be in the right context @@ -367,10 +367,6 @@ rnPatAndThen mk (TuplePat pats boxed _) ; pats' <- rnLPatsAndThen mk pats ; return (TuplePat pats' boxed placeHolderType) } -rnPatAndThen _ (TypePat ty) - = do { ty' <- liftCpsFV $ rnHsTypeFVs (text "In a type pattern") ty - ; return (TypePat ty') } - #ifndef GHCI rnPatAndThen _ p@(QuasiQuotePat {}) = pprPanic "Can't do QuasiQuotePat without GHCi" (ppr p) @@ -453,8 +449,8 @@ rnHsRecFields1 -- of each x=e binding rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) - = do { pun_ok <- doptM Opt_RecordPuns - ; disambig_ok <- doptM Opt_DisambiguateRecordFields + = do { pun_ok <- xoptM Opt_RecordPuns + ; disambig_ok <- xoptM Opt_DisambiguateRecordFields ; parent <- check_disambiguation disambig_ok mb_con ; flds1 <- mapM (rn_fld pun_ok parent) flds ; mapM_ (addErr . dupFieldErr ctxt) dup_flds @@ -490,7 +486,7 @@ rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot } rn_dotdot (Just n) (Just con) flds -- ".." on record con/pat = ASSERT( n == length flds ) do { loc <- getSrcSpanM -- Rather approximate - ; dd_flag <- doptM Opt_RecordWildCards + ; dd_flag <- xoptM Opt_RecordWildCards ; checkErr dd_flag (needFlagDotDot ctxt) ; con_fields <- lookupConstructorFields con