diff options
Diffstat (limited to 'compiler/hsSyn/HsUtils.hs')
| -rw-r--r-- | compiler/hsSyn/HsUtils.hs | 115 |
1 files changed, 61 insertions, 54 deletions
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index 2cac819579..ff2bd6e8aa 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -140,8 +140,8 @@ from their components, compared with the nl* functions below which just attach noSrcSpan to everything. -} -mkHsPar :: LHsExpr id -> LHsExpr id -mkHsPar e = L (getLoc e) (HsPar e) +mkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) +mkHsPar e = L (getLoc e) (HsPar noExt e) mkSimpleMatch :: HsMatchContext (NameOrRdrName (IdP id)) -> [LPat id] -> Located (body id) @@ -174,20 +174,21 @@ mkLocatedList :: [Located a] -> Located [Located a] mkLocatedList [] = noLoc [] mkLocatedList ms = L (combineLocs (head ms) (last ms)) ms -mkHsApp :: LHsExpr name -> LHsExpr name -> LHsExpr name -mkHsApp e1 e2 = addCLoc e1 e2 (HsApp e1 e2) +mkHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) +mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExt e1 e2) -mkHsAppType :: LHsExpr name -> LHsWcType name -> LHsExpr name -mkHsAppType e t = addCLoc e (hswc_body t) (HsAppType e t) +mkHsAppType :: LHsExpr GhcRn -> LHsWcType GhcRn -> LHsExpr GhcRn +mkHsAppType e t = addCLoc e (hswc_body t) (HsAppType t e) -mkHsAppTypes :: LHsExpr name -> [LHsWcType name] -> LHsExpr name +mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn 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) (HsAppTypeOut e t) +mkHsAppTypeOut e t = addCLoc e (hswc_body t) (HsAppType t e) mkHsLam :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs -mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches)) +mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam noExt matches)) where matches = mkMatchGroup Generated [mkSimpleMatch LambdaExpr pats' body] @@ -203,17 +204,19 @@ mkHsCaseAlt :: LPat id -> (Located (body id)) -> LMatch id (Located (body id)) mkHsCaseAlt pat expr = mkSimpleMatch CaseAlt [pat] expr -nlHsTyApp :: IdP name -> [Type] -> LHsExpr name -nlHsTyApp fun_id tys = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar (noLoc fun_id))) +nlHsTyApp :: IdP (GhcPass id) -> [Type] -> LHsExpr (GhcPass id) +nlHsTyApp fun_id tys + = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar noExt (noLoc fun_id))) -nlHsTyApps :: IdP name -> [Type] -> [LHsExpr name] -> LHsExpr name +nlHsTyApps :: IdP (GhcPass id) -> [Type] -> [LHsExpr (GhcPass id)] + -> LHsExpr (GhcPass id) nlHsTyApps fun_id tys xs = foldl nlHsApp (nlHsTyApp fun_id tys) xs --------- Adding parens --------- -mkLHsPar :: LHsExpr name -> LHsExpr name +mkLHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -- 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 le) +mkLHsPar le@(L loc e) | hsExprNeedsParens e = L loc (HsPar noExt le) | otherwise = le mkParPat :: LPat (GhcPass name) -> LPat (GhcPass name) @@ -261,14 +264,14 @@ mkHsIsString src s = OverLit noExt (HsIsString src s) noExpr noRebindableInfo :: PlaceHolder noRebindableInfo = PlaceHolder -- Just another placeholder; -mkHsDo ctxt stmts = HsDo ctxt (mkLocatedList stmts) placeHolderType +mkHsDo ctxt stmts = HsDo noExt ctxt (mkLocatedList stmts) mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt]) where last_stmt = L (getLoc expr) $ mkLastStmt expr mkHsIf :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> HsExpr (GhcPass p) -mkHsIf c a b = HsIf (Just noSyntaxExpr) c a b +mkHsIf c a b = HsIf noExt (Just noSyntaxExpr) c a b mkNPat lit neg = NPat noExt lit neg noSyntaxExpr mkNPlusKPat id lit @@ -328,9 +331,8 @@ 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 id -> IdP id -> LHsExpr id -> HsExpr id -mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar (noLoc op))) - (error "mkOpApp:fixity") e2 +mkHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs +mkHsOpApp e1 op e2 = OpApp noExt e1 (noLoc (HsVar noExt (noLoc op))) e2 unqualSplice :: RdrName unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice")) @@ -339,10 +341,11 @@ mkUntypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs mkUntypedSplice hasParen e = HsUntypedSplice hasParen unqualSplice e mkHsSpliceE :: SpliceDecoration -> LHsExpr GhcPs -> HsExpr GhcPs -mkHsSpliceE hasParen e = HsSpliceE (mkUntypedSplice hasParen e) +mkHsSpliceE hasParen e = HsSpliceE noExt (mkUntypedSplice hasParen e) mkHsSpliceTE :: SpliceDecoration -> LHsExpr GhcPs -> HsExpr GhcPs -mkHsSpliceTE hasParen e = HsSpliceE (HsTypedSplice hasParen unqualSplice e) +mkHsSpliceTE hasParen e + = HsSpliceE noExt (HsTypedSplice hasParen unqualSplice e) mkHsSpliceTy :: SpliceDecoration -> LHsExpr GhcPs -> HsType GhcPs mkHsSpliceTy hasParen e = HsSpliceTy noExt @@ -383,18 +386,18 @@ userHsTyVarBndrs loc bndrs = [ L loc (UserTyVar noExt (L loc v)) ************************************************************************ -} -nlHsVar :: IdP id -> LHsExpr id -nlHsVar n = noLoc (HsVar (noLoc n)) +nlHsVar :: IdP (GhcPass id) -> LHsExpr (GhcPass id) +nlHsVar n = noLoc (HsVar noExt (noLoc n)) -- NB: Only for LHsExpr **Id** nlHsDataCon :: DataCon -> LHsExpr GhcTc -nlHsDataCon con = noLoc (HsConLikeOut (RealDataCon con)) +nlHsDataCon con = noLoc (HsConLikeOut noExt (RealDataCon con)) -nlHsLit :: HsLit p -> LHsExpr p -nlHsLit n = noLoc (HsLit n) +nlHsLit :: HsLit (GhcPass p) -> LHsExpr (GhcPass p) +nlHsLit n = noLoc (HsLit noExt n) nlHsIntLit :: Integer -> LHsExpr (GhcPass p) -nlHsIntLit n = noLoc (HsLit (HsInt noExt (mkIntegralLit n))) +nlHsIntLit n = noLoc (HsLit noExt (HsInt noExt (mkIntegralLit n))) nlVarPat :: IdP (GhcPass id) -> LPat (GhcPass id) nlVarPat n = noLoc (VarPat noExt (noLoc n)) @@ -402,10 +405,11 @@ nlVarPat n = noLoc (VarPat noExt (noLoc n)) nlLitPat :: HsLit GhcPs -> LPat GhcPs nlLitPat l = noLoc (LitPat noExt l) -nlHsApp :: LHsExpr id -> LHsExpr id -> LHsExpr id -nlHsApp f x = noLoc (HsApp f (mkLHsPar x)) +nlHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) +nlHsApp f x = noLoc (HsApp noExt f (mkLHsPar x)) -nlHsSyntaxApps :: SyntaxExpr id -> [LHsExpr id] -> LHsExpr id +nlHsSyntaxApps :: SyntaxExpr (GhcPass id) -> [LHsExpr (GhcPass id)] + -> LHsExpr (GhcPass id) nlHsSyntaxApps (SyntaxExpr { syn_expr = fun , syn_arg_wraps = arg_wraps , syn_res_wrap = res_wrap }) args @@ -417,13 +421,14 @@ nlHsSyntaxApps (SyntaxExpr { syn_expr = fun = mkLHsWrap res_wrap (foldl nlHsApp (noLoc fun) (zipWithEqual "nlHsSyntaxApps" mkLHsWrap arg_wraps args)) -nlHsApps :: IdP id -> [LHsExpr id] -> LHsExpr id +nlHsApps :: IdP (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id) nlHsApps f xs = foldl nlHsApp (nlHsVar f) xs -nlHsVarApps :: IdP id -> [IdP id] -> LHsExpr id -nlHsVarApps f xs = noLoc (foldl mk (HsVar (noLoc f)) (map (HsVar . noLoc) 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)) where - mk f a = HsApp (noLoc f) (noLoc a) + mk f a = HsApp noExt (noLoc f) (noLoc a) nlConVarPat :: RdrName -> [RdrName] -> LPat GhcPs nlConVarPat con vars = nlConPat con (map nlVarPat vars) @@ -463,26 +468,28 @@ nlHsDo :: HsStmtContext Name -> [LStmt GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs nlHsDo ctxt stmts = noLoc (mkHsDo ctxt stmts) -nlHsOpApp :: LHsExpr id -> IdP id -> LHsExpr id -> LHsExpr id +nlHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs nlHsOpApp e1 op e2 = noLoc (mkHsOpApp e1 op e2) nlHsLam :: LMatch GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs -nlHsPar :: LHsExpr id -> LHsExpr id -nlHsIf :: LHsExpr id -> LHsExpr id -> LHsExpr id -> LHsExpr id +nlHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) +nlHsIf :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) + -> LHsExpr (GhcPass id) nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs nlList :: [LHsExpr GhcPs] -> LHsExpr GhcPs -nlHsLam match = noLoc (HsLam (mkMatchGroup Generated [match])) -nlHsPar e = noLoc (HsPar e) +nlHsLam match = noLoc (HsLam noExt (mkMatchGroup Generated [match])) +nlHsPar e = noLoc (HsPar noExt 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 Nothing cond true false) +nlHsIf cond true false = noLoc (HsIf noExt Nothing cond true false) -nlHsCase expr matches = noLoc (HsCase expr (mkMatchGroup Generated matches)) -nlList exprs = noLoc (ExplicitList placeHolderType Nothing exprs) +nlHsCase expr matches + = noLoc (HsCase noExt expr (mkMatchGroup Generated matches)) +nlList exprs = noLoc (ExplicitList noExt Nothing exprs) nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) nlHsTyVar :: IdP (GhcPass p) -> LHsType (GhcPass p) @@ -502,12 +509,12 @@ Tuples. All these functions are *pre-typechecker* because they lack types on the tuple. -} -mkLHsTupleExpr :: [LHsExpr a] -> LHsExpr a +mkLHsTupleExpr :: [LHsExpr (GhcPass a)] -> LHsExpr (GhcPass a) -- Makes a pre-typechecker boxed tuple, deals with 1 case mkLHsTupleExpr [e] = e -mkLHsTupleExpr es = noLoc $ ExplicitTuple (map (noLoc . Present) es) Boxed +mkLHsTupleExpr es = noLoc $ ExplicitTuple noExt (map (noLoc . Present) es) Boxed -mkLHsVarTuple :: [IdP a] -> LHsExpr a +mkLHsVarTuple :: [IdP (GhcPass a)] -> LHsExpr (GhcPass a) mkLHsVarTuple ids = mkLHsTupleExpr (map nlHsVar ids) nlTuplePat :: [LPat GhcPs] -> Boxity -> LPat GhcPs @@ -522,10 +529,10 @@ mkLHsPatTup [lpat] = lpat mkLHsPatTup lpats = L (getLoc (head lpats)) $ TuplePat noExt lpats Boxed -- The Big equivalents for the source tuple expressions -mkBigLHsVarTup :: [IdP id] -> LHsExpr id +mkBigLHsVarTup :: [IdP (GhcPass id)] -> LHsExpr (GhcPass id) mkBigLHsVarTup ids = mkBigLHsTup (map nlHsVar ids) -mkBigLHsTup :: [LHsExpr id] -> LHsExpr id +mkBigLHsTup :: [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id) mkBigLHsTup = mkChunkified mkLHsTupleExpr -- The Big equivalents for the source tuple patterns @@ -728,25 +735,25 @@ to make those work. * * ********************************************************************* -} -mkLHsWrap :: HsWrapper -> LHsExpr id -> LHsExpr id +mkLHsWrap :: HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass 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 id -> HsExpr id +mkHsWrap :: HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass 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 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 mkHsWrapCo :: TcCoercionN -- A Nominal coercion a ~N b - -> HsExpr id -> HsExpr id + -> HsExpr (GhcPass id) -> HsExpr (GhcPass id) mkHsWrapCo co e = mkHsWrap (mkWpCastN co) e mkHsWrapCoR :: TcCoercionR -- A Representational coercion a ~R b - -> HsExpr id -> HsExpr id + -> HsExpr (GhcPass id) -> HsExpr (GhcPass id) mkHsWrapCoR co e = mkHsWrap (mkWpCastR co) e -mkLHsWrapCo :: TcCoercionN -> LHsExpr id -> LHsExpr id +mkLHsWrapCo :: TcCoercionN -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) mkLHsWrapCo co (L loc e) = L loc (mkHsWrapCo co e) mkHsCmdWrap :: HsWrapper -> HsCmd id -> HsCmd id |