From 314bc31489f1f4cd69e913c3b1e33236b2bdf553 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Tue, 21 Nov 2017 14:28:58 -0500 Subject: Revert "trees that grow" work As documented in #14490, the Data instances currently blow up compilation time by too much to stomach. Alan will continue working on this in a branch and we will perhaps merge to 8.2 before 8.2.1 to avoid having to perform painful cherry-picks in 8.2 minor releases. Reverts haddock submodule. This reverts commit 47ad6578ea460999b53eb4293c3a3b3017a56d65. This reverts commit e3ec2e7ae94524ebd111963faf34b84d942265b4. This reverts commit 438dd1cbba13d35f3452b4dcef3f94ce9a216905. This reverts commit 0ff152c9e633accca48815e26e59d1af1fe44ceb. --- compiler/hsSyn/HsUtils.hs | 439 +++++++++++++++++++++------------------------- 1 file changed, 203 insertions(+), 236 deletions(-) (limited to 'compiler/hsSyn/HsUtils.hs') diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index e5f0fb6187..8e17994993 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -50,7 +50,7 @@ module HsUtils( -- Patterns mkNPat, mkNPlusKPat, nlVarPat, nlLitPat, nlConVarPat, nlConVarPatName, nlConPat, nlConPatName, nlInfixConPat, nlNullaryConPat, nlWildConPat, nlWildPat, - nlWildPatName, nlTuplePat, mkParPat, nlParPat, + nlWildPatName, nlWildPatId, nlTuplePat, mkParPat, nlParPat, mkBigLHsVarTup, mkBigLHsTup, mkBigLHsVarPatTup, mkBigLHsPatTup, -- Types @@ -140,8 +140,8 @@ from their components, compared with the nl* functions below which just attach noSrcSpan to everything. -} -mkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -mkHsPar e = L (getLoc e) (HsPar noExt e) +mkHsPar :: LHsExpr id -> LHsExpr id +mkHsPar e = L (getLoc e) (HsPar e) mkSimpleMatch :: HsMatchContext (NameOrRdrName (IdP id)) -> [LPat id] -> Located (body id) @@ -174,21 +174,20 @@ mkLocatedList :: [Located a] -> Located [Located a] mkLocatedList [] = noLoc [] mkLocatedList ms = L (combineLocs (head ms) (last ms)) ms -mkHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExt e1 e2) +mkHsApp :: LHsExpr name -> LHsExpr name -> LHsExpr name +mkHsApp e1 e2 = addCLoc e1 e2 (HsApp e1 e2) -mkHsAppType :: LHsExpr GhcRn -> LHsWcType GhcRn -> LHsExpr GhcRn -mkHsAppType e t = addCLoc e (hswc_body t) (HsAppType t e) +mkHsAppType :: LHsExpr name -> LHsWcType name -> LHsExpr name +mkHsAppType e t = addCLoc e (hswc_body t) (HsAppType e t) -mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn +mkHsAppTypes :: LHsExpr name -> [LHsWcType name] -> LHsExpr name mkHsAppTypes = foldl mkHsAppType --- AZ:TODO this can go, in favour of mkHsAppType. ? mkHsAppTypeOut :: LHsExpr GhcTc -> LHsWcType GhcRn -> LHsExpr GhcTc -mkHsAppTypeOut e t = addCLoc e (hswc_body t) (HsAppType t e) +mkHsAppTypeOut e t = addCLoc e (hswc_body t) (HsAppTypeOut e t) mkHsLam :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs -mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam noExt matches)) +mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches)) where matches = mkMatchGroup Generated [mkSimpleMatch LambdaExpr pats body] @@ -203,35 +202,35 @@ mkHsCaseAlt :: LPat id -> (Located (body id)) -> LMatch id (Located (body id)) mkHsCaseAlt pat expr = mkSimpleMatch CaseAlt [pat] expr -nlHsTyApp :: IdP (GhcPass id) -> [Type] -> LHsExpr (GhcPass id) -nlHsTyApp fun_id tys - = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar noExt (noLoc fun_id))) +nlHsTyApp :: IdP name -> [Type] -> LHsExpr name +nlHsTyApp fun_id tys = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar (noLoc fun_id))) -nlHsTyApps :: IdP (GhcPass id) -> [Type] -> [LHsExpr (GhcPass id)] - -> LHsExpr (GhcPass id) +nlHsTyApps :: IdP name -> [Type] -> [LHsExpr name] -> LHsExpr name nlHsTyApps fun_id tys xs = foldl nlHsApp (nlHsTyApp fun_id tys) xs --------- Adding parens --------- -mkLHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) +mkLHsPar :: LHsExpr name -> LHsExpr name -- Wrap in parens if hsExprNeedsParens says it needs them -- So 'f x' becomes '(f x)', but '3' stays as '3' -mkLHsPar le@(L loc e) | hsExprNeedsParens e = L loc (HsPar noExt le) +mkLHsPar le@(L loc e) | hsExprNeedsParens e = L loc (HsPar le) | otherwise = le -mkParPat :: LPat (GhcPass name) -> LPat (GhcPass name) -mkParPat lp@(L loc p) | hsPatNeedsParens p = L loc (ParPat noExt lp) +mkParPat :: LPat name -> LPat name +mkParPat lp@(L loc p) | hsPatNeedsParens p = L loc (ParPat lp) | otherwise = lp -nlParPat :: LPat (GhcPass name) -> LPat (GhcPass name) -nlParPat p = noLoc (ParPat noExt p) +nlParPat :: LPat name -> LPat name +nlParPat p = noLoc (ParPat p) ------------------------------- -- These are the bits of syntax that contain rebindable names -- See RnEnv.lookupSyntaxName -mkHsIntegral :: IntegralLit -> HsOverLit GhcPs -mkHsFractional :: FractionalLit -> HsOverLit GhcPs -mkHsIsString :: SourceText -> FastString -> HsOverLit GhcPs +mkHsIntegral :: IntegralLit -> PostTc GhcPs Type + -> HsOverLit GhcPs +mkHsFractional :: FractionalLit -> PostTc GhcPs Type -> HsOverLit GhcPs +mkHsIsString :: SourceText -> FastString -> PostTc GhcPs Type + -> HsOverLit GhcPs mkHsDo :: HsStmtContext Name -> [ExprLStmt GhcPs] -> HsExpr GhcPs mkHsComp :: HsStmtContext Name -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> HsExpr GhcPs @@ -240,72 +239,60 @@ mkNPat :: Located (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> Pat GhcPs mkNPlusKPat :: Located RdrName -> Located (HsOverLit GhcPs) -> Pat GhcPs -mkLastStmt :: SourceTextX (GhcPass idR) - => Located (bodyR (GhcPass idR)) - -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR))) +mkLastStmt :: SourceTextX idR + => Located (bodyR idR) -> StmtLR idL idR (Located (bodyR idR)) mkBodyStmt :: Located (bodyR GhcPs) -> StmtLR idL GhcPs (Located (bodyR GhcPs)) -mkBindStmt :: (SourceTextX (GhcPass idR), - PostTc (GhcPass idR) Type ~ PlaceHolder) - => LPat (GhcPass idL) -> Located (bodyR (GhcPass idR)) - -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR))) +mkBindStmt :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder) + => LPat idL -> Located (bodyR idR) + -> StmtLR idL idR (Located (bodyR idR)) mkTcBindStmt :: LPat GhcTc -> Located (bodyR GhcTc) -> StmtLR GhcTc GhcTc (Located (bodyR GhcTc)) -emptyRecStmt :: StmtLR (GhcPass idL) GhcPs bodyR +emptyRecStmt :: StmtLR idL GhcPs bodyR emptyRecStmtName :: StmtLR GhcRn GhcRn bodyR emptyRecStmtId :: StmtLR GhcTc GhcTc bodyR mkRecStmt :: [LStmtLR idL GhcPs bodyR] -> StmtLR idL GhcPs bodyR -mkHsIntegral i = OverLit noExt (HsIntegral i) noExpr -mkHsFractional f = OverLit noExt (HsFractional f) noExpr -mkHsIsString src s = OverLit noExt (HsIsString src s) noExpr +mkHsIntegral i = OverLit (HsIntegral i) noRebindableInfo noExpr +mkHsFractional f = OverLit (HsFractional f) noRebindableInfo noExpr +mkHsIsString src s = OverLit (HsIsString src s) noRebindableInfo noExpr noRebindableInfo :: PlaceHolder -noRebindableInfo = placeHolder -- Just another placeholder; +noRebindableInfo = PlaceHolder -- Just another placeholder; -mkHsDo ctxt stmts = HsDo noExt ctxt (mkLocatedList stmts) +mkHsDo ctxt stmts = HsDo ctxt (mkLocatedList stmts) placeHolderType mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt]) where last_stmt = L (getLoc expr) $ mkLastStmt expr -mkHsIf :: SourceTextX (GhcPass p) - => LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) - -> HsExpr (GhcPass p) -mkHsIf c a b = HsIf noExt (Just noSyntaxExpr) c a b - -mkNPat lit neg = NPat noExt lit neg noSyntaxExpr -mkNPlusKPat id lit - = NPlusKPat noExt id lit (unLoc lit) noSyntaxExpr noSyntaxExpr - -mkTransformStmt :: (SourceTextX (GhcPass idR), - PostTc (GhcPass idR) Type ~ PlaceHolder) - => [ExprLStmt (GhcPass idL)] -> LHsExpr (GhcPass idR) - -> StmtLR (GhcPass idL) (GhcPass idR) (LHsExpr (GhcPass idL)) -mkTransformByStmt :: (SourceTextX (GhcPass idR), - PostTc (GhcPass idR) Type ~ PlaceHolder) - => [ExprLStmt (GhcPass idL)] -> LHsExpr (GhcPass idR) - -> LHsExpr (GhcPass idR) - -> StmtLR (GhcPass idL) (GhcPass idR) (LHsExpr (GhcPass idL)) -mkGroupUsingStmt :: (SourceTextX (GhcPass idR), - PostTc (GhcPass idR) Type ~ PlaceHolder) - => [ExprLStmt (GhcPass idL)] -> LHsExpr (GhcPass idR) - -> StmtLR (GhcPass idL) (GhcPass idR) (LHsExpr (GhcPass idL)) -mkGroupByUsingStmt :: (SourceTextX (GhcPass idR), - PostTc (GhcPass idR) Type ~ PlaceHolder) - => [ExprLStmt (GhcPass idL)] -> LHsExpr (GhcPass idR) - -> LHsExpr (GhcPass idR) - -> StmtLR (GhcPass idL) (GhcPass idR) (LHsExpr (GhcPass idL)) - -emptyTransStmt :: (SourceTextX (GhcPass idR), - PostTc (GhcPass idR) Type ~ PlaceHolder) - => StmtLR idL (GhcPass idR) (LHsExpr (GhcPass idR)) +mkHsIf :: SourceTextX p => LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p +mkHsIf c a b = HsIf (Just noSyntaxExpr) c a b + +mkNPat lit neg = NPat lit neg noSyntaxExpr placeHolderType +mkNPlusKPat id lit = NPlusKPat id lit (unLoc lit) noSyntaxExpr noSyntaxExpr placeHolderType + +mkTransformStmt :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder) + => [ExprLStmt idL] -> LHsExpr idR + -> StmtLR idL idR (LHsExpr idL) +mkTransformByStmt :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder) + => [ExprLStmt idL] -> LHsExpr idR -> LHsExpr idR + -> StmtLR idL idR (LHsExpr idL) +mkGroupUsingStmt :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder) + => [ExprLStmt idL] -> LHsExpr idR + -> StmtLR idL idR (LHsExpr idL) +mkGroupByUsingStmt :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder) + => [ExprLStmt idL] -> LHsExpr idR -> LHsExpr idR + -> StmtLR idL idR (LHsExpr idL) + +emptyTransStmt :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder) + => StmtLR idL idR (LHsExpr idR) emptyTransStmt = TransStmt { trS_form = panic "emptyTransStmt: form" , trS_stmts = [], trS_bndrs = [] , trS_by = Nothing, trS_using = noLoc noExpr , trS_ret = noSyntaxExpr, trS_bind = noSyntaxExpr - , trS_bind_arg_ty = placeHolder + , trS_bind_arg_ty = PlaceHolder , trS_fmap = noExpr } mkTransformStmt ss u = emptyTransStmt { trS_form = ThenForm, trS_stmts = ss, trS_using = u } mkTransformByStmt ss u b = emptyTransStmt { trS_form = ThenForm, trS_stmts = ss, trS_using = u, trS_by = Just b } @@ -314,12 +301,12 @@ mkGroupByUsingStmt ss b u = emptyTransStmt { trS_form = GroupForm, trS_stmts = s mkLastStmt body = LastStmt body False noSyntaxExpr mkBodyStmt body = BodyStmt body noSyntaxExpr noSyntaxExpr placeHolderType -mkBindStmt pat body = BindStmt pat body noSyntaxExpr noSyntaxExpr placeHolder +mkBindStmt pat body = BindStmt pat body noSyntaxExpr noSyntaxExpr PlaceHolder mkTcBindStmt pat body = BindStmt pat body noSyntaxExpr noSyntaxExpr unitTy -- don't use placeHolderTypeTc above, because that panics during zonking -emptyRecStmt' :: forall idL idR body. SourceTextX (GhcPass idR) => - PostTc (GhcPass idR) Type -> StmtLR (GhcPass idL) (GhcPass idR) body +emptyRecStmt' :: forall idL idR body. SourceTextX idR => + PostTc idR Type -> StmtLR idL idR body emptyRecStmt' tyVal = RecStmt { recS_stmts = [], recS_later_ids = [] @@ -338,29 +325,28 @@ mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts } ------------------------------- --- A useful function for building @OpApps@. The operator is always a -- variable, and we don't know the fixity yet. -mkHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs -mkHsOpApp e1 op e2 = OpApp noExt e1 (noLoc (HsVar noExt (noLoc op))) e2 +mkHsOpApp :: LHsExpr id -> IdP id -> LHsExpr id -> HsExpr id +mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar (noLoc op))) + (error "mkOpApp:fixity") e2 unqualSplice :: RdrName unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice")) mkUntypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs -mkUntypedSplice hasParen e = HsUntypedSplice noExt hasParen unqualSplice e +mkUntypedSplice hasParen e = HsUntypedSplice hasParen unqualSplice e mkHsSpliceE :: SpliceDecoration -> LHsExpr GhcPs -> HsExpr GhcPs -mkHsSpliceE hasParen e = HsSpliceE noExt (mkUntypedSplice hasParen e) +mkHsSpliceE hasParen e = HsSpliceE (mkUntypedSplice hasParen e) mkHsSpliceTE :: SpliceDecoration -> LHsExpr GhcPs -> HsExpr GhcPs -mkHsSpliceTE hasParen e - = HsSpliceE noExt (HsTypedSplice noExt hasParen unqualSplice e) +mkHsSpliceTE hasParen e = HsSpliceE (HsTypedSplice hasParen unqualSplice e) mkHsSpliceTy :: SpliceDecoration -> LHsExpr GhcPs -> HsType GhcPs -mkHsSpliceTy hasParen e = HsSpliceTy noExt - (HsUntypedSplice noExt hasParen unqualSplice e) +mkHsSpliceTy hasParen e + = HsSpliceTy (HsUntypedSplice hasParen unqualSplice e) placeHolderKind mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs -mkHsQuasiQuote quoter span quote - = HsQuasiQuote noExt unqualSplice quoter span quote +mkHsQuasiQuote quoter span quote = HsQuasiQuote unqualSplice quoter span quote unqualQuasiQuote :: RdrName unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote")) @@ -375,15 +361,13 @@ mkHsStringPrimLit fs = HsStringPrim noSourceText (fastStringToByteString fs) ------------- -userHsLTyVarBndrs :: SrcSpan -> [Located (IdP (GhcPass p))] - -> [LHsTyVarBndr (GhcPass p)] +userHsLTyVarBndrs :: SrcSpan -> [Located (IdP name)] -> [LHsTyVarBndr name] -- Caller sets location -userHsLTyVarBndrs loc bndrs = [ L loc (UserTyVar noExt v) | v <- bndrs ] +userHsLTyVarBndrs loc bndrs = [ L loc (UserTyVar v) | v <- bndrs ] -userHsTyVarBndrs :: SrcSpan -> [IdP (GhcPass p)] -> [LHsTyVarBndr (GhcPass p)] +userHsTyVarBndrs :: SrcSpan -> [IdP name] -> [LHsTyVarBndr name] -- Caller sets location -userHsTyVarBndrs loc bndrs = [ L loc (UserTyVar noExt (L loc v)) - | v <- bndrs ] +userHsTyVarBndrs loc bndrs = [ L loc (UserTyVar (L loc v)) | v <- bndrs ] {- @@ -394,30 +378,29 @@ userHsTyVarBndrs loc bndrs = [ L loc (UserTyVar noExt (L loc v)) ************************************************************************ -} -nlHsVar :: IdP (GhcPass id) -> LHsExpr (GhcPass id) -nlHsVar n = noLoc (HsVar noExt (noLoc n)) +nlHsVar :: IdP id -> LHsExpr id +nlHsVar n = noLoc (HsVar (noLoc n)) -- NB: Only for LHsExpr **Id** nlHsDataCon :: DataCon -> LHsExpr GhcTc -nlHsDataCon con = noLoc (HsConLikeOut noExt (RealDataCon con)) +nlHsDataCon con = noLoc (HsConLikeOut (RealDataCon con)) -nlHsLit :: HsLit (GhcPass p) -> LHsExpr (GhcPass p) -nlHsLit n = noLoc (HsLit noExt n) +nlHsLit :: HsLit p -> LHsExpr p +nlHsLit n = noLoc (HsLit n) -nlHsIntLit :: Integer -> LHsExpr (GhcPass p) -nlHsIntLit n = noLoc (HsLit noExt (HsInt noExt (mkIntegralLit n))) +nlHsIntLit :: HasDefaultX p => Integer -> LHsExpr p +nlHsIntLit n = noLoc (HsLit (HsInt def (mkIntegralLit n))) -nlVarPat :: IdP (GhcPass id) -> LPat (GhcPass id) -nlVarPat n = noLoc (VarPat noExt (noLoc n)) +nlVarPat :: IdP id -> LPat id +nlVarPat n = noLoc (VarPat (noLoc n)) -nlLitPat :: HsLit GhcPs -> LPat GhcPs -nlLitPat l = noLoc (LitPat noExt l) +nlLitPat :: HsLit p -> LPat p +nlLitPat l = noLoc (LitPat l) -nlHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -nlHsApp f x = noLoc (HsApp noExt f (mkLHsPar x)) +nlHsApp :: LHsExpr id -> LHsExpr id -> LHsExpr id +nlHsApp f x = noLoc (HsApp f (mkLHsPar x)) -nlHsSyntaxApps :: SyntaxExpr (GhcPass id) -> [LHsExpr (GhcPass id)] - -> LHsExpr (GhcPass id) +nlHsSyntaxApps :: SyntaxExpr id -> [LHsExpr id] -> LHsExpr id nlHsSyntaxApps (SyntaxExpr { syn_expr = fun , syn_arg_wraps = arg_wraps , syn_res_wrap = res_wrap }) args @@ -429,14 +412,13 @@ nlHsSyntaxApps (SyntaxExpr { syn_expr = fun = mkLHsWrap res_wrap (foldl nlHsApp (noLoc fun) (zipWithEqual "nlHsSyntaxApps" mkLHsWrap arg_wraps args)) -nlHsApps :: IdP (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id) +nlHsApps :: IdP id -> [LHsExpr id] -> LHsExpr id nlHsApps f xs = foldl nlHsApp (nlHsVar f) xs -nlHsVarApps :: IdP (GhcPass id) -> [IdP (GhcPass id)] -> LHsExpr (GhcPass id) -nlHsVarApps f xs = noLoc (foldl mk (HsVar noExt (noLoc f)) - (map ((HsVar noExt) . noLoc) xs)) +nlHsVarApps :: IdP id -> [IdP id] -> LHsExpr id +nlHsVarApps f xs = noLoc (foldl mk (HsVar (noLoc f)) (map (HsVar . noLoc) xs)) where - mk f a = HsApp noExt (noLoc f) (noLoc a) + mk f a = HsApp (noLoc f) (noLoc a) nlConVarPat :: RdrName -> [RdrName] -> LPat GhcPs nlConVarPat con vars = nlConPat con (map nlVarPat vars) @@ -462,49 +444,50 @@ nlWildConPat con = noLoc (ConPatIn (noLoc (getRdrName con)) nlWildPat))) nlWildPat :: LPat GhcPs -nlWildPat = noLoc (WildPat noExt ) -- Pre-typechecking +nlWildPat = noLoc (WildPat placeHolderType ) -- Pre-typechecking nlWildPatName :: LPat GhcRn -nlWildPatName = noLoc (WildPat noExt ) -- Pre-typechecking +nlWildPatName = noLoc (WildPat placeHolderType ) -- Pre-typechecking + +nlWildPatId :: LPat GhcTc +nlWildPatId = noLoc (WildPat placeHolderTypeTc ) -- Post-typechecking nlHsDo :: HsStmtContext Name -> [LStmt GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs nlHsDo ctxt stmts = noLoc (mkHsDo ctxt stmts) -nlHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs +nlHsOpApp :: LHsExpr id -> IdP id -> LHsExpr id -> LHsExpr id nlHsOpApp e1 op e2 = noLoc (mkHsOpApp e1 op e2) nlHsLam :: LMatch GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs -nlHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -nlHsIf :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) - -> LHsExpr (GhcPass id) +nlHsPar :: LHsExpr id -> LHsExpr id +nlHsIf :: LHsExpr id -> LHsExpr id -> LHsExpr id -> LHsExpr id nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs nlList :: [LHsExpr GhcPs] -> LHsExpr GhcPs -nlHsLam match = noLoc (HsLam noExt (mkMatchGroup Generated [match])) -nlHsPar e = noLoc (HsPar noExt e) +nlHsLam match = noLoc (HsLam (mkMatchGroup Generated [match])) +nlHsPar e = noLoc (HsPar e) -- Note [Rebindable nlHsIf] -- nlHsIf should generate if-expressions which are NOT subject to -- RebindableSyntax, so the first field of HsIf is Nothing. (#12080) -nlHsIf cond true false = noLoc (HsIf noExt Nothing cond true false) +nlHsIf cond true false = noLoc (HsIf Nothing cond true false) -nlHsCase expr matches - = noLoc (HsCase noExt expr (mkMatchGroup Generated matches)) -nlList exprs = noLoc (ExplicitList noExt Nothing exprs) +nlHsCase expr matches = noLoc (HsCase expr (mkMatchGroup Generated matches)) +nlList exprs = noLoc (ExplicitList placeHolderType Nothing exprs) -nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) -nlHsTyVar :: IdP (GhcPass p) -> LHsType (GhcPass p) -nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) -nlHsParTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) +nlHsAppTy :: LHsType name -> LHsType name -> LHsType name +nlHsTyVar :: IdP name -> LHsType name +nlHsFunTy :: LHsType name -> LHsType name -> LHsType name +nlHsParTy :: LHsType name -> LHsType name -nlHsAppTy f t = noLoc (HsAppTy noExt f t) -nlHsTyVar x = noLoc (HsTyVar noExt NotPromoted (noLoc x)) -nlHsFunTy a b = noLoc (HsFunTy noExt a b) -nlHsParTy t = noLoc (HsParTy noExt t) +nlHsAppTy f t = noLoc (HsAppTy f t) +nlHsTyVar x = noLoc (HsTyVar NotPromoted (noLoc x)) +nlHsFunTy a b = noLoc (HsFunTy a b) +nlHsParTy t = noLoc (HsParTy t) -nlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p) +nlHsTyConApp :: IdP name -> [LHsType name] -> LHsType name nlHsTyConApp tycon tys = foldl nlHsAppTy (nlHsTyVar tycon) tys {- @@ -512,38 +495,37 @@ Tuples. All these functions are *pre-typechecker* because they lack types on the tuple. -} -mkLHsTupleExpr :: [LHsExpr (GhcPass a)] -> LHsExpr (GhcPass a) +mkLHsTupleExpr :: [LHsExpr a] -> LHsExpr a -- Makes a pre-typechecker boxed tuple, deals with 1 case mkLHsTupleExpr [e] = e -mkLHsTupleExpr es - = noLoc $ ExplicitTuple noExt (map (noLoc . (Present noExt)) es) Boxed +mkLHsTupleExpr es = noLoc $ ExplicitTuple (map (noLoc . Present) es) Boxed -mkLHsVarTuple :: [IdP (GhcPass a)] -> LHsExpr (GhcPass a) +mkLHsVarTuple :: [IdP a] -> LHsExpr a mkLHsVarTuple ids = mkLHsTupleExpr (map nlHsVar ids) -nlTuplePat :: [LPat GhcPs] -> Boxity -> LPat GhcPs -nlTuplePat pats box = noLoc (TuplePat noExt pats box) +nlTuplePat :: [LPat id] -> Boxity -> LPat id +nlTuplePat pats box = noLoc (TuplePat pats box []) missingTupArg :: HsTupArg GhcPs -missingTupArg = Missing noExt +missingTupArg = Missing placeHolderType -mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn -mkLHsPatTup [] = noLoc $ TuplePat noExt [] Boxed +mkLHsPatTup :: [LPat id] -> LPat id +mkLHsPatTup [] = noLoc $ TuplePat [] Boxed [] mkLHsPatTup [lpat] = lpat -mkLHsPatTup lpats = L (getLoc (head lpats)) $ TuplePat noExt lpats Boxed +mkLHsPatTup lpats = L (getLoc (head lpats)) $ TuplePat lpats Boxed [] -- The Big equivalents for the source tuple expressions -mkBigLHsVarTup :: [IdP (GhcPass id)] -> LHsExpr (GhcPass id) +mkBigLHsVarTup :: [IdP id] -> LHsExpr id mkBigLHsVarTup ids = mkBigLHsTup (map nlHsVar ids) -mkBigLHsTup :: [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id) +mkBigLHsTup :: [LHsExpr id] -> LHsExpr id mkBigLHsTup = mkChunkified mkLHsTupleExpr -- The Big equivalents for the source tuple patterns -mkBigLHsVarPatTup :: [IdP GhcRn] -> LPat GhcRn +mkBigLHsVarPatTup :: [IdP id] -> LPat id mkBigLHsVarPatTup bs = mkBigLHsPatTup (map nlVarPat bs) -mkBigLHsPatTup :: [LPat GhcRn] -> LPat GhcRn +mkBigLHsPatTup :: [LPat id] -> LPat id mkBigLHsPatTup = mkChunkified mkLHsPatTup -- $big_tuples @@ -650,18 +632,16 @@ typeToLHsType ty | isPredTy arg , (theta, tau) <- tcSplitPhiTy ty = noLoc (HsQualTy { hst_ctxt = noLoc (map go theta) - , hst_xqual = noExt , hst_body = go tau }) go (FunTy arg res) = nlHsFunTy (go arg) (go res) go ty@(ForAllTy {}) | (tvs, tau) <- tcSplitForAllTys ty = noLoc (HsForAllTy { hst_bndrs = map go_tv tvs - , hst_xforall = noExt , hst_body = go tau }) go (TyVarTy tv) = nlHsTyVar (getRdrName tv) go (AppTy t1 t2) = nlHsAppTy (go t1) (go t2) - go (LitTy (NumTyLit n)) = noLoc $ HsTyLit noExt (HsNumTy noSourceText n) - go (LitTy (StrTyLit s)) = noLoc $ HsTyLit noExt (HsStrTy noSourceText s) + go (LitTy (NumTyLit n)) = noLoc $ HsTyLit (HsNumTy noSourceText n) + go (LitTy (StrTyLit s)) = noLoc $ HsTyLit (HsStrTy noSourceText s) go (TyConApp tc args) = nlHsTyConApp (getRdrName tc) (map go args') where args' = filterOutInvisibleTypes tc args @@ -672,7 +652,7 @@ typeToLHsType ty -- so we must remove them here (Trac #8563) go_tv :: TyVar -> LHsTyVarBndr GhcPs - go_tv tv = noLoc $ KindedTyVar noExt (noLoc (getRdrName tv)) + go_tv tv = noLoc $ KindedTyVar (noLoc (getRdrName tv)) (go (tyVarKind tv)) @@ -682,41 +662,41 @@ typeToLHsType ty * * ********************************************************************* -} -mkLHsWrap :: HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) +mkLHsWrap :: HsWrapper -> LHsExpr id -> LHsExpr id mkLHsWrap co_fn (L loc e) = L loc (mkHsWrap co_fn e) -- Avoid (HsWrap co (HsWrap co' _)). -- See Note [Detecting forced eta expansion] in DsExpr -mkHsWrap :: HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id) +mkHsWrap :: HsWrapper -> HsExpr id -> HsExpr id mkHsWrap co_fn e | isIdHsWrapper co_fn = e -mkHsWrap co_fn (HsWrap _ co_fn' e) = mkHsWrap (co_fn <.> co_fn') e -mkHsWrap co_fn e = HsWrap noExt co_fn e +mkHsWrap co_fn (HsWrap co_fn' e) = mkHsWrap (co_fn <.> co_fn') e +mkHsWrap co_fn e = HsWrap co_fn e mkHsWrapCo :: TcCoercionN -- A Nominal coercion a ~N b - -> HsExpr (GhcPass id) -> HsExpr (GhcPass id) + -> HsExpr id -> HsExpr id mkHsWrapCo co e = mkHsWrap (mkWpCastN co) e mkHsWrapCoR :: TcCoercionR -- A Representational coercion a ~R b - -> HsExpr (GhcPass id) -> HsExpr (GhcPass id) + -> HsExpr id -> HsExpr id mkHsWrapCoR co e = mkHsWrap (mkWpCastR co) e -mkLHsWrapCo :: TcCoercionN -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) +mkLHsWrapCo :: TcCoercionN -> LHsExpr id -> LHsExpr id mkLHsWrapCo co (L loc e) = L loc (mkHsWrapCo co e) -mkHsCmdWrap :: HsWrapper -> HsCmd (GhcPass p) -> HsCmd (GhcPass p) +mkHsCmdWrap :: HsWrapper -> HsCmd id -> HsCmd id mkHsCmdWrap w cmd | isIdHsWrapper w = cmd - | otherwise = HsCmdWrap noExt w cmd + | otherwise = HsCmdWrap w cmd -mkLHsCmdWrap :: HsWrapper -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p) +mkLHsCmdWrap :: HsWrapper -> LHsCmd id -> LHsCmd id mkLHsCmdWrap w (L loc c) = L loc (mkHsCmdWrap w c) -mkHsWrapPat :: HsWrapper -> Pat (GhcPass id) -> Type -> Pat (GhcPass id) +mkHsWrapPat :: HsWrapper -> Pat id -> Type -> Pat id mkHsWrapPat co_fn p ty | isIdHsWrapper co_fn = p - | otherwise = CoPat noExt co_fn p ty + | otherwise = CoPat co_fn p ty -mkHsWrapPatCo :: TcCoercionN -> Pat (GhcPass id) -> Type -> Pat (GhcPass id) +mkHsWrapPatCo :: TcCoercionN -> Pat id -> Type -> Pat id mkHsWrapPatCo co pat ty | isTcReflCo co = pat - | otherwise = CoPat noExt (mkWpCastN co) pat ty + | otherwise = CoPat (mkWpCastN co) pat ty mkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr @@ -789,16 +769,14 @@ mkPrefixFunRhs n = FunRhs { mc_fun = n , mc_strictness = NoSrcStrict } ------------ -mkMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p))) - -> [LPat (GhcPass p)] -> LHsExpr (GhcPass p) - -> Located (HsLocalBinds (GhcPass p)) - -> LMatch (GhcPass p) (LHsExpr (GhcPass p)) +mkMatch :: HsMatchContext (NameOrRdrName (IdP p)) -> [LPat p] -> LHsExpr p + -> Located (HsLocalBinds p) -> LMatch p (LHsExpr p) mkMatch ctxt pats expr lbinds = noLoc (Match { m_ctxt = ctxt , m_pats = map paren pats , m_grhss = GRHSs (unguardedRHS noSrcSpan expr) lbinds }) where - paren lp@(L l p) | hsPatNeedsParens p = L l (ParPat noExt lp) + paren lp@(L l p) | hsPatNeedsParens p = L l (ParPat lp) | otherwise = lp {- @@ -886,15 +864,13 @@ isBangedHsBind (PatBind {pat_lhs = pat}) isBangedHsBind _ = False -collectLocalBinders :: HsLocalBindsLR (GhcPass idL) (GhcPass idR) - -> [IdP (GhcPass idL)] +collectLocalBinders :: HsLocalBindsLR idL idR -> [IdP idL] collectLocalBinders (HsValBinds binds) = collectHsIdBinders binds -- No pattern synonyms here collectLocalBinders (HsIPBinds _) = [] collectLocalBinders EmptyLocalBinds = [] -collectHsIdBinders, collectHsValBinders - :: HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)] +collectHsIdBinders, collectHsValBinders :: HsValBindsLR idL idR -> [IdP idL] -- Collect Id binders only, or Ids + pattern synonyms, respectively collectHsIdBinders = collect_hs_val_binders True collectHsValBinders = collect_hs_val_binders False @@ -910,11 +886,9 @@ collectHsBindListBinders :: [LHsBindLR idL idR] -> [IdP idL] -- Same as collectHsBindsBinders, but works over a list of bindings collectHsBindListBinders = foldr (collect_bind False . unLoc) [] -collect_hs_val_binders :: Bool -> HsValBindsLR (GhcPass idL) (GhcPass idR) - -> [IdP (GhcPass idL)] -collect_hs_val_binders ps (ValBinds _ binds _) = collect_binds ps binds [] -collect_hs_val_binders ps (XValBindsLR (NValBinds binds _)) - = collect_out_binds ps binds +collect_hs_val_binders :: Bool -> HsValBindsLR idL idR -> [IdP idL] +collect_hs_val_binders ps (ValBindsIn binds _) = collect_binds ps binds [] +collect_hs_val_binders ps (ValBindsOut binds _) = collect_out_binds ps binds collect_out_binds :: Bool -> [(RecFlag, LHsBinds p)] -> [IdP p] collect_out_binds ps = foldr (collect_binds ps . snd) [] @@ -929,7 +903,7 @@ collect_bind _ (FunBind { fun_id = L _ f }) acc = f : acc collect_bind _ (VarBind { var_id = f }) acc = f : acc collect_bind _ (AbsBinds { abs_exports = dbinds }) acc = map abe_poly dbinds ++ acc -- I don't think we want the binders from the abe_binds - + -- The only time we collect binders from a typechecked -- binding (hence see AbsBinds) is in zonking in TcHsSyn collect_bind omitPatSyn (PatSynBind (PSB { psb_id = L _ ps })) acc | omitPatSyn = acc @@ -944,27 +918,23 @@ collectMethodBinders binds = foldrBag (get . unLoc) [] binds -- Someone else complains about non-FunBinds ----------------- Statements -------------------------- -collectLStmtsBinders :: [LStmtLR (GhcPass idL) (GhcPass idR) body] - -> [IdP (GhcPass idL)] +collectLStmtsBinders :: [LStmtLR idL idR body] -> [IdP idL] collectLStmtsBinders = concatMap collectLStmtBinders -collectStmtsBinders :: [StmtLR (GhcPass idL) (GhcPass idR) body] - -> [IdP (GhcPass idL)] +collectStmtsBinders :: [StmtLR idL idR body] -> [IdP idL] collectStmtsBinders = concatMap collectStmtBinders -collectLStmtBinders :: LStmtLR (GhcPass idL) (GhcPass idR) body - -> [IdP (GhcPass idL)] +collectLStmtBinders :: LStmtLR idL idR body -> [IdP idL] collectLStmtBinders = collectStmtBinders . unLoc -collectStmtBinders :: StmtLR (GhcPass idL) (GhcPass idR) body - -> [IdP (GhcPass idL)] +collectStmtBinders :: StmtLR idL idR body -> [IdP idL] -- Id Binders for a Stmt... [but what about pattern-sig type vars]? collectStmtBinders (BindStmt pat _ _ _ _)= collectPatBinders pat collectStmtBinders (LetStmt (L _ binds)) = collectLocalBinders binds collectStmtBinders (BodyStmt {}) = [] collectStmtBinders (LastStmt {}) = [] -collectStmtBinders (ParStmt xs _ _ _) = collectLStmtsBinders - $ [s | ParStmtBlock _ ss _ _ <- xs, s <- ss] +collectStmtBinders (ParStmt xs _ _ _) = collectLStmtsBinders + $ [s | ParStmtBlock ss _ _ <- xs, s <- ss] collectStmtBinders (TransStmt { trS_stmts = stmts }) = collectLStmtsBinders stmts collectStmtBinders (RecStmt { recS_stmts = ss }) = collectLStmtsBinders ss collectStmtBinders ApplicativeStmt{} = [] @@ -982,33 +952,33 @@ collect_lpat :: LPat pass -> [IdP pass] -> [IdP pass] collect_lpat (L _ pat) bndrs = go pat where - go (VarPat _ (L _ var)) = var : bndrs + go (VarPat (L _ var)) = var : bndrs go (WildPat _) = bndrs - go (LazyPat _ pat) = collect_lpat pat bndrs - go (BangPat _ pat) = collect_lpat pat bndrs - go (AsPat _ (L _ a) pat) = a : collect_lpat pat bndrs - go (ViewPat _ _ pat) = collect_lpat pat bndrs - go (ParPat _ pat) = collect_lpat pat bndrs + go (LazyPat pat) = collect_lpat pat bndrs + go (BangPat pat) = collect_lpat pat bndrs + go (AsPat (L _ a) pat) = a : collect_lpat pat bndrs + go (ViewPat _ pat _) = collect_lpat pat bndrs + go (ParPat pat) = collect_lpat pat bndrs - go (ListPat _ pats _ _) = foldr collect_lpat bndrs pats - go (PArrPat _ pats) = foldr collect_lpat bndrs pats - go (TuplePat _ pats _) = foldr collect_lpat bndrs pats - go (SumPat _ pat _ _) = collect_lpat pat bndrs + go (ListPat pats _ _) = foldr collect_lpat bndrs pats + go (PArrPat pats _) = foldr collect_lpat bndrs pats + go (TuplePat pats _ _) = foldr collect_lpat bndrs pats + go (SumPat pat _ _ _) = collect_lpat pat bndrs go (ConPatIn _ ps) = foldr collect_lpat bndrs (hsConPatArgs ps) go (ConPatOut {pat_args=ps}) = foldr collect_lpat bndrs (hsConPatArgs ps) -- See Note [Dictionary binders in ConPatOut] - go (LitPat _ _) = bndrs - go (NPat {}) = bndrs - go (NPlusKPat _ (L _ n) _ _ _ _)= n : bndrs + go (LitPat _) = bndrs + go (NPat {}) = bndrs + go (NPlusKPat (L _ n) _ _ _ _ _)= n : bndrs - go (SigPat _ pat) = collect_lpat pat bndrs + go (SigPatIn pat _) = collect_lpat pat bndrs + go (SigPatOut pat _) = collect_lpat pat bndrs - go (SplicePat _ (HsSpliced _ _ (HsSplicedPat pat))) + go (SplicePat (HsSpliced _ (HsSplicedPat pat))) = go pat - go (SplicePat _ _) = bndrs - go (CoPat _ _ pat _) = go pat - go (XPat {}) = bndrs + go (SplicePat _) = bndrs + go (CoPat _ pat _) = go pat {- Note [Dictionary binders in ConPatOut] See also same Note in DsArrows @@ -1057,7 +1027,7 @@ hsTyClForeignBinders tycl_decls foreign_decls foldMap (foldMap hsLInstDeclBinders . group_instds) tycl_decls) where getSelectorNames :: ([Located Name], [LFieldOcc GhcRn]) -> [Name] - getSelectorNames (ns, fs) = map unLoc ns ++ map (extFieldOcc . unLoc) fs + getSelectorNames (ns, fs) = map unLoc ns ++ map (selectorFieldOcc.unLoc) fs ------------------- hsLTyClDeclBinders :: Located (TyClDecl pass) @@ -1092,11 +1062,11 @@ hsForeignDeclsBinders foreign_decls ------------------- -hsPatSynSelectors :: HsValBinds (GhcPass p) -> [IdP (GhcPass p)] +hsPatSynSelectors :: HsValBinds p -> [IdP p] -- Collects record pattern-synonym selectors only; the pattern synonym -- names are collected by collectHsValBinders. -hsPatSynSelectors (ValBinds _ _ _) = panic "hsPatSynSelectors" -hsPatSynSelectors (XValBindsLR (NValBinds binds _)) +hsPatSynSelectors (ValBindsIn _ _) = panic "hsPatSynSelectors" +hsPatSynSelectors (ValBindsOut binds _) = foldrBag addPatSynSelector [] . unionManyBags $ map snd binds addPatSynSelector:: LHsBind p -> [IdP p] -> [IdP p] @@ -1153,11 +1123,11 @@ hsConDeclsBinders cons = go id cons L loc (ConDeclGADT { con_names = names , con_type = HsIB { hsib_body = res_ty}}) -> case tau of - L _ (HsFunTy _ - (L _ (HsAppsTy _ - [L _ (HsAppPrefix _ (L _ (HsRecTy _ flds)))])) _) + L _ (HsFunTy + (L _ (HsAppsTy + [L _ (HsAppPrefix (L _ (HsRecTy flds)))])) _res_ty) -> record_gadt flds - L _ (HsFunTy _ (L _ (HsRecTy _ flds)) _res_ty) + L _ (HsFunTy (L _ (HsRecTy flds)) _res_ty) -> record_gadt flds _other -> (map (L loc . unLoc) names ++ ns, fs) @@ -1218,16 +1188,13 @@ The main purpose is to find names introduced by record wildcards so that we can warning the user when they don't use those names (#4404) -} -lStmtsImplicits :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))] - -> NameSet +lStmtsImplicits :: [LStmtLR GhcRn idR (Located (body idR))] -> NameSet lStmtsImplicits = hs_lstmts where - hs_lstmts :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))] - -> NameSet + hs_lstmts :: [LStmtLR GhcRn idR (Located (body idR))] -> NameSet hs_lstmts = foldr (\stmt rest -> unionNameSet (hs_stmt (unLoc stmt)) rest) emptyNameSet - hs_stmt :: StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR))) - -> NameSet + hs_stmt :: StmtLR GhcRn idR (Located (body idR)) -> NameSet hs_stmt (BindStmt pat _ _ _ _) = lPatImplicits pat hs_stmt (ApplicativeStmt args _ _) = unionNameSets (map do_arg args) where do_arg (_, ApplicativeArgOne pat _ _) = lPatImplicits pat @@ -1235,8 +1202,7 @@ lStmtsImplicits = hs_lstmts hs_stmt (LetStmt binds) = hs_local_binds (unLoc binds) hs_stmt (BodyStmt {}) = emptyNameSet hs_stmt (LastStmt {}) = emptyNameSet - hs_stmt (ParStmt xs _ _ _) = hs_lstmts [s | ParStmtBlock _ ss _ _ <- xs - , s <- ss] + hs_stmt (ParStmt xs _ _ _) = hs_lstmts [s | ParStmtBlock ss _ _ <- xs, s <- ss] hs_stmt (TransStmt { trS_stmts = stmts }) = hs_lstmts stmts hs_stmt (RecStmt { recS_stmts = ss }) = hs_lstmts ss @@ -1244,10 +1210,10 @@ lStmtsImplicits = hs_lstmts hs_local_binds (HsIPBinds _) = emptyNameSet hs_local_binds EmptyLocalBinds = emptyNameSet -hsValBindsImplicits :: HsValBindsLR GhcRn (GhcPass idR) -> NameSet -hsValBindsImplicits (XValBindsLR (NValBinds binds _)) +hsValBindsImplicits :: HsValBindsLR GhcRn idR -> NameSet +hsValBindsImplicits (ValBindsOut binds _) = foldr (unionNameSet . lhsBindsImplicits . snd) emptyNameSet binds -hsValBindsImplicits (ValBinds _ binds _) +hsValBindsImplicits (ValBindsIn binds _) = lhsBindsImplicits binds lhsBindsImplicits :: LHsBindsLR GhcRn idR -> NameSet @@ -1263,17 +1229,18 @@ lPatImplicits = hs_lpat hs_lpats = foldr (\pat rest -> hs_lpat pat `unionNameSet` rest) emptyNameSet - hs_pat (LazyPat _ pat) = hs_lpat pat - hs_pat (BangPat _ pat) = hs_lpat pat - hs_pat (AsPat _ _ pat) = hs_lpat pat - hs_pat (ViewPat _ _ pat) = hs_lpat pat - hs_pat (ParPat _ pat) = hs_lpat pat - hs_pat (ListPat _ pats _ _) = hs_lpats pats - hs_pat (PArrPat _ pats) = hs_lpats pats - hs_pat (TuplePat _ pats _) = hs_lpats pats - - hs_pat (SigPat _ pat) = hs_lpat pat - hs_pat (CoPat _ _ pat _) = hs_pat pat + hs_pat (LazyPat pat) = hs_lpat pat + hs_pat (BangPat pat) = hs_lpat pat + hs_pat (AsPat _ pat) = hs_lpat pat + hs_pat (ViewPat _ pat _) = hs_lpat pat + hs_pat (ParPat pat) = hs_lpat pat + hs_pat (ListPat pats _ _) = hs_lpats pats + hs_pat (PArrPat pats _) = hs_lpats pats + hs_pat (TuplePat pats _ _) = hs_lpats pats + + hs_pat (SigPatIn pat _) = hs_lpat pat + hs_pat (SigPatOut pat _) = hs_lpat pat + hs_pat (CoPat _ pat _) = hs_pat pat hs_pat (ConPatIn _ ps) = details ps hs_pat (ConPatOut {pat_args=ps}) = details ps -- cgit v1.2.1