diff options
| -rw-r--r-- | compiler/hsSyn/Convert.lhs | 85 | ||||
| -rw-r--r-- | compiler/hsSyn/HsExpr.lhs | 77 | ||||
| -rw-r--r-- | compiler/hsSyn/HsPat.lhs | 39 | ||||
| -rw-r--r-- | compiler/hsSyn/HsTypes.lhs | 6 | ||||
| -rw-r--r-- | compiler/hsSyn/HsUtils.lhs | 60 |
5 files changed, 157 insertions, 110 deletions
diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs index 6f44199aba..7a86c8180f 100644 --- a/compiler/hsSyn/Convert.lhs +++ b/compiler/hsSyn/Convert.lhs @@ -95,6 +95,9 @@ failWith m = CvtM (\_ -> Left m) returnL :: a -> CvtM (Located a) returnL x = CvtM (\loc -> Right (L loc x)) +wrapParL :: (Located a -> a) -> a -> CvtM a +wrapParL add_par x = CvtM (\loc -> Right (add_par (L loc x))) + wrapMsg :: (Show a, TH.Ppr a) => String -> a -> CvtM b -> CvtM b -- E.g wrapMsg "declaration" dec thing wrapMsg what item (CvtM m) @@ -464,8 +467,8 @@ cvtl e = wrapL (cvt e) cvt (LamE ps e) = do { ps' <- cvtPats ps; e' <- cvtl e ; return $ HsLam (mkMatchGroup [mkSimpleMatch ps' e']) } cvt (TupE [e]) = do { e' <- cvtl e; return $ HsPar e' } - -- Note [Dropping constructors] - -- Singleton tuples treated like nothing (just parens) + -- Note [Dropping constructors] + -- Singleton tuples treated like nothing (just parens) cvt (TupE es) = do { es' <- mapM cvtl es; return $ ExplicitTuple (map Present es') Boxed } cvt (UnboxedTupE es) = do { es' <- mapM cvtl es; return $ ExplicitTuple (map Present es') Unboxed } cvt (CondE x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z; @@ -483,20 +486,27 @@ cvtl e = wrapL (cvt e) | Just s <- allCharLs xs = do { l' <- cvtLit (StringL s); return (HsLit l') } -- Note [Converting strings] | otherwise = do { xs' <- mapM cvtl xs; return $ ExplicitList void xs' } + + -- Infix expressions cvt (InfixE (Just x) s (Just y)) = do { x' <- cvtl x; s' <- cvtl s; y' <- cvtl y - ; x'' <- returnL (HsPar x'); y'' <- returnL (HsPar y') - ; e' <- returnL $ OpApp x'' s' undefined y'' - ; return $ HsPar e' } + ; wrapParL HsPar $ + OpApp (mkLHsPar x') s' undefined (mkLHsPar y') } + -- Parenthesise both arguments and result, + -- to ensure this operator application does + -- does not get re-associated + -- See Note [Operator association] cvt (InfixE Nothing s (Just y)) = do { s' <- cvtl s; y' <- cvtl y - ; sec <- returnL $ SectionR s' y' - ; return $ HsPar sec } + ; wrapParL HsPar $ SectionR s' y' } + -- See Note [Sections in HsSyn] in HsExpr cvt (InfixE (Just x) s Nothing ) = do { x' <- cvtl x; s' <- cvtl s - ; sec <- returnL $ SectionL x' s' - ; return $ HsPar sec } + ; wrapParL HsPar $ SectionL x' s' } + cvt (InfixE Nothing s Nothing ) = do { s' <- cvtl s; return $ HsPar s' } -- Can I indicate this is an infix thing? -- Note [Dropping constructors] + cvt (UInfixE x s y) = do { x' <- cvtl x; cvtOpApp x' s y } -- Note [Converting UInfix] + cvt (ParensE e) = do { e' <- cvtl e; return $ HsPar e' } cvt (SigE e t) = do { e' <- cvtl e; t' <- cvtType t ; return $ ExprWithTySig e' t' } @@ -534,8 +544,16 @@ cvtDD (FromThenR x y) = do { x' <- cvtl x; y' <- cvtl y; return $ FromThen x cvtDD (FromToR x y) = do { x' <- cvtl x; y' <- cvtl y; return $ FromTo x' y' } cvtDD (FromThenToR x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z; return $ FromThenTo x' y' z' } -{- Note [Converting UInfix] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Operator assocation] +We must be quite careful about adding parens: + * Infix (UInfix ...) op arg Needs parens round the first arg + * Infix (Infix ...) op arg Needs parens round the first arg + * UInfix (UInfix ...) op arg No parens for first arg + * UInfix (Infix ...) op arg Needs parens round first arg + + +Note [Converting UInfix] +~~~~~~~~~~~~~~~~~~~~~~~~ When converting @UInfixE@ and @UInfixP@ values, we want to readjust the trees to reflect the fixities of the underlying operators: @@ -697,31 +715,32 @@ cvtPat pat = wrapL (cvtp pat) cvtp :: TH.Pat -> CvtM (Hs.Pat RdrName) cvtp (TH.LitP l) - | overloadedLit l = do { l' <- cvtOverLit l - ; return (mkNPat l' Nothing) } + | overloadedLit l = do { l' <- cvtOverLit l + ; return (mkNPat l' Nothing) } -- Not right for negative patterns; -- need to think about that! - | otherwise = do { l' <- cvtLit l; return $ Hs.LitPat l' } -cvtp (TH.VarP s) = do { s' <- vName s; return $ Hs.VarPat s' } -cvtp (TupP [p]) = do { p' <- cvtPat p; return $ ParPat p' } -- Note [Dropping constructors] -cvtp (TupP ps) = do { ps' <- cvtPats ps; return $ TuplePat ps' Boxed void } + | otherwise = do { l' <- cvtLit l; return $ Hs.LitPat l' } +cvtp (TH.VarP s) = do { s' <- vName s; return $ Hs.VarPat s' } +cvtp (TupP [p]) = do { p' <- cvtPat p; return $ ParPat p' } -- Note [Dropping constructors] +cvtp (TupP ps) = do { ps' <- cvtPats ps; return $ TuplePat ps' Boxed void } cvtp (UnboxedTupP ps) = do { ps' <- cvtPats ps; return $ TuplePat ps' Unboxed void } -cvtp (ConP s ps) = do { s' <- cNameL s; ps' <- cvtPats ps; return $ ConPatIn s' (PrefixCon ps') } -cvtp (InfixP p1 s p2) = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2 - ; p1'' <- returnL (ParPat p1'); p2'' <- returnL (ParPat p2') - ; p <- returnL $ ConPatIn s' (InfixCon p1'' p2'') - ; return $ ParPat p } -cvtp (UInfixP p1 s p2)= do { p1' <- cvtPat p1; cvtOpAppP p1' s p2 } -- Note [Converting UInfix] -cvtp (ParensP p) = do { p' <- cvtPat p; return $ ParPat p' } -cvtp (TildeP p) = do { p' <- cvtPat p; return $ LazyPat p' } -cvtp (BangP p) = do { p' <- cvtPat p; return $ BangPat p' } -cvtp (TH.AsP s p) = do { s' <- vNameL s; p' <- cvtPat p; return $ AsPat s' p' } -cvtp TH.WildP = return $ WildPat void -cvtp (RecP c fs) = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs - ; return $ ConPatIn c' $ Hs.RecCon (HsRecFields fs' Nothing) } -cvtp (ListP ps) = do { ps' <- cvtPats ps; return $ ListPat ps' void } -cvtp (SigP p t) = do { p' <- cvtPat p; t' <- cvtType t; return $ SigPatIn p' t' } -cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p; return $ ViewPat e' p' void } +cvtp (ConP s ps) = do { s' <- cNameL s; ps' <- cvtPats ps + ; return $ ConPatIn s' (PrefixCon ps') } +cvtp (InfixP p1 s p2) = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2 + ; wrapParL ParPat $ + ConPatIn s' (InfixCon (mkParPat p1') (mkParPat p2')) } + -- See Note [Operator association] +cvtp (UInfixP p1 s p2) = do { p1' <- cvtPat p1; cvtOpAppP p1' s p2 } -- Note [Converting UInfix] +cvtp (ParensP p) = do { p' <- cvtPat p; return $ ParPat p' } +cvtp (TildeP p) = do { p' <- cvtPat p; return $ LazyPat p' } +cvtp (BangP p) = do { p' <- cvtPat p; return $ BangPat p' } +cvtp (TH.AsP s p) = do { s' <- vNameL s; p' <- cvtPat p; return $ AsPat s' p' } +cvtp TH.WildP = return $ WildPat void +cvtp (RecP c fs) = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs + ; return $ ConPatIn c' $ Hs.RecCon (HsRecFields fs' Nothing) } +cvtp (ListP ps) = do { ps' <- cvtPats ps; return $ ListPat ps' void } +cvtp (SigP p t) = do { p' <- cvtPat p; t' <- cvtType t; return $ SigPatIn p' t' } +cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p; return $ ViewPat e' p' void } cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (HsRecField RdrName (LPat RdrName)) cvtPatFld (s,p) diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs index 35bb17b10b..4179423c3f 100644 --- a/compiler/hsSyn/HsExpr.lhs +++ b/compiler/hsSyn/HsExpr.lhs @@ -120,11 +120,11 @@ data HsExpr id | NegApp (LHsExpr id) -- negated expr (SyntaxExpr id) -- Name of 'negate' - | HsPar (LHsExpr id) -- parenthesised expr + | HsPar (LHsExpr id) -- Parenthesised expr; see Note [Parens in HsSyn] - | SectionL (LHsExpr id) -- operand + | SectionL (LHsExpr id) -- operand; see Note [Sections in HsSyn] (LHsExpr id) -- operator - | SectionR (LHsExpr id) -- operator + | SectionR (LHsExpr id) -- operator; see Note [Sections in HsSyn] (LHsExpr id) -- operand | ExplicitTuple -- Used for explicit tuples and sections thereof @@ -300,6 +300,28 @@ type PendingSplice = (Name, LHsExpr Id) -- Typechecked splices, waiting to be -- pasted back in by the desugarer \end{code} +Note [Parens in HsSyn] +~~~~~~~~~~~~~~~~~~~~~~ +HsPar (and ParPat in patterns, HsParTy in types) is used as follows + + * Generally HsPar is optional; the pretty printer adds parens where + necessary. Eg (HsApp f (HsApp g x)) is fine, and prints 'f (g x)' + + * HsPars are pretty printed as '( .. )' regardless of whether + or not they are strictly necssary + + * HsPars are respected when rearranging operator fixities. + So a * (b + c) means what it says (where the parens are an HsPar) + +Note [Sections in HsSyn] +~~~~~~~~~~~~~~~~~~~~~~~~ +Sections should always appear wrapped in an HsPar, thus + HsPar (SectionR ...) +The parser parses sections in a wider variety of situations +(See Note [Parsing sections]), but the renamer checks for those +parens. This invariant makes pretty-printing easier; we don't need +a special case for adding the parens round sections. + Note [Rebindable if] ~~~~~~~~~~~~~~~~~~~~ The rebindable syntax for 'if' is a bit special, because when @@ -400,8 +422,7 @@ ppr_expr (SectionR op expr) pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext (sLit "x_")]) 4 ((<>) pp_expr rparen) - pp_infixly v - = (sep [pprHsInfix v, pp_expr]) + pp_infixly v = sep [pprHsInfix v, pp_expr] ppr_expr (ExplicitTuple exprs boxity) = tupleParens boxity (fcat (ppr_tup_args exprs)) @@ -557,29 +578,33 @@ pprDebugParendExpr expr pprParendExpr :: OutputableBndr id => LHsExpr id -> SDoc pprParendExpr expr - = let - pp_as_was = pprLExpr expr + | hsExprNeedsParens (unLoc expr) = parens (pprLExpr expr) + | otherwise = pprLExpr expr -- Using pprLExpr makes sure that we go 'deeper' -- I think that is usually (always?) right - in - case unLoc expr of - ArithSeq {} -> pp_as_was - PArrSeq {} -> pp_as_was - HsLit {} -> pp_as_was - HsOverLit {} -> pp_as_was - HsVar {} -> pp_as_was - HsIPVar {} -> pp_as_was - ExplicitTuple {} -> pp_as_was - ExplicitList {} -> pp_as_was - ExplicitPArr {} -> pp_as_was - HsPar {} -> pp_as_was - HsBracket {} -> pp_as_was - HsBracketOut _ [] -> pp_as_was - HsDo sc _ _ - | isListCompExpr sc -> pp_as_was - _ -> parens pp_as_was - -isAtomicHsExpr :: HsExpr id -> Bool -- A single token + +hsExprNeedsParens :: HsExpr id -> Bool +-- True of expressions for which '(e)' and 'e' +-- mean the same thing +hsExprNeedsParens (ArithSeq {}) = False +hsExprNeedsParens (PArrSeq {}) = False +hsExprNeedsParens (HsLit {}) = False +hsExprNeedsParens (HsOverLit {}) = False +hsExprNeedsParens (HsVar {}) = False +hsExprNeedsParens (HsIPVar {}) = False +hsExprNeedsParens (ExplicitTuple {}) = False +hsExprNeedsParens (ExplicitList {}) = False +hsExprNeedsParens (ExplicitPArr {}) = False +hsExprNeedsParens (HsPar {}) = False +hsExprNeedsParens (HsBracket {}) = False +hsExprNeedsParens (HsBracketOut _ []) = False +hsExprNeedsParens (HsDo sc _ _) + | isListCompExpr sc = False +hsExprNeedsParens _ = True + + +isAtomicHsExpr :: HsExpr id -> Bool +-- True of a single token isAtomicHsExpr (HsVar {}) = True isAtomicHsExpr (HsLit {}) = True isAtomicHsExpr (HsOverLit {}) = True diff --git a/compiler/hsSyn/HsPat.lhs b/compiler/hsSyn/HsPat.lhs index 7fb5f72533..71dfe1d969 100644 --- a/compiler/hsSyn/HsPat.lhs +++ b/compiler/hsSyn/HsPat.lhs @@ -68,6 +68,7 @@ data Pat id | LazyPat (LPat id) -- Lazy pattern | AsPat (Located id) (LPat id) -- As pattern | ParPat (LPat id) -- Parenthesised pattern + -- See Note [Parens in HsSyn] in HsExpr | BangPat (LPat id) -- Bang pattern ------------ Lists, tuples, arrays --------------- @@ -238,17 +239,8 @@ pprParendLPat :: (OutputableBndr name) => LPat name -> SDoc pprParendLPat (L _ p) = pprParendPat p pprParendPat :: (OutputableBndr name) => Pat name -> SDoc -pprParendPat p | patNeedsParens p = parens (pprPat p) - | otherwise = pprPat p - -patNeedsParens :: Pat name -> Bool -patNeedsParens (ConPatIn _ d) = not (null (hsConPatArgs d)) -patNeedsParens (ConPatOut { pat_args = d }) = not (null (hsConPatArgs d)) -patNeedsParens (SigPatIn {}) = True -patNeedsParens (SigPatOut {}) = True -patNeedsParens (ViewPat {}) = True -patNeedsParens (CoPat {}) = True -patNeedsParens _ = False +pprParendPat p | hsPatNeedsParens p = parens (pprPat p) + | otherwise = pprPat p pprPat :: (OutputableBndr name) => Pat name -> SDoc pprPat (VarPat var) = pprPatBndr var @@ -268,8 +260,9 @@ pprPat (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts, = getPprStyle $ \ sty -> -- Tiresome; in TcBinds.tcRhs we print out a if debugStyle sty then -- typechecked Pat in an error message, -- and we want to make sure it prints nicely - ppr con <+> sep [ hsep (map pprPatBndr tvs) <+> hsep (map pprPatBndr dicts), - ppr binds, pprConArgs details] + ppr con <> braces (sep [ hsep (map pprPatBndr (tvs ++ dicts)) + , ppr binds]) + <+> pprConArgs details else pprUserCon con details pprPat (LitPat s) = ppr s @@ -438,29 +431,29 @@ isIrrefutableHsPat pat urk pat = pprPanic "isIrrefutableHsPat:" (ppr pat) hsPatNeedsParens :: Pat a -> Bool +hsPatNeedsParens (NPlusKPat {}) = True +hsPatNeedsParens (QuasiQuotePat {}) = True +hsPatNeedsParens (ConPatIn _ ds) = conPatNeedsParens ds +hsPatNeedsParens p@(ConPatOut {}) = conPatNeedsParens (pat_args p) +hsPatNeedsParens (SigPatIn {}) = True +hsPatNeedsParens (SigPatOut {}) = True +hsPatNeedsParens (ViewPat {}) = True +hsPatNeedsParens (CoPat {}) = True hsPatNeedsParens (WildPat {}) = False hsPatNeedsParens (VarPat {}) = False hsPatNeedsParens (LazyPat {}) = False hsPatNeedsParens (BangPat {}) = False -hsPatNeedsParens (CoPat {}) = True hsPatNeedsParens (ParPat {}) = False hsPatNeedsParens (AsPat {}) = False -hsPatNeedsParens (ViewPat {}) = True -hsPatNeedsParens (SigPatIn {}) = True -hsPatNeedsParens (SigPatOut {}) = True hsPatNeedsParens (TuplePat {}) = False hsPatNeedsParens (ListPat {}) = False hsPatNeedsParens (PArrPat {}) = False -hsPatNeedsParens (ConPatIn _ ds) = conPatNeedsParens ds -hsPatNeedsParens (ConPatOut {}) = True hsPatNeedsParens (LitPat {}) = False hsPatNeedsParens (NPat {}) = False -hsPatNeedsParens (NPlusKPat {}) = True -hsPatNeedsParens (QuasiQuotePat {}) = True conPatNeedsParens :: HsConDetails a b -> Bool conPatNeedsParens (PrefixCon args) = not (null args) -conPatNeedsParens (InfixCon {}) = False -conPatNeedsParens (RecCon {}) = False +conPatNeedsParens (InfixCon {}) = True +conPatNeedsParens (RecCon {}) = True \end{code} diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs index d565c96d29..35cdb7ee5e 100644 --- a/compiler/hsSyn/HsTypes.lhs +++ b/compiler/hsSyn/HsTypes.lhs @@ -161,13 +161,9 @@ data HsType name | HsOpTy (LHsType name) (Located name) (LHsType name) - | HsParTy (LHsType name) + | HsParTy (LHsType name) -- See Note [Parens in HsSyn] in HsExpr -- Parenthesis preserved for the precedence re-arrangement in RnTypes -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c! - -- - -- However, NB that toHsType doesn't add HsParTys (in an effort to keep - -- interface files smaller), so when printing a HsType we may need to - -- add parens. | HsPredTy (HsPred name) -- Only used in the type of an instance -- declaration, eg. Eq [a] -> Eq a diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs index 6ddbd99bd4..3ae566d935 100644 --- a/compiler/hsSyn/HsUtils.lhs +++ b/compiler/hsSyn/HsUtils.lhs @@ -22,6 +22,7 @@ module HsUtils( mkHsWrap, mkLHsWrap, mkHsWrapCo, mkLHsWrapCo, coToHsWrapper, mkHsDictLet, mkHsLams, mkHsOpApp, mkHsDo, mkHsComp, mkHsWrapPat, mkHsWrapPatCo, + mkLHsPar, nlHsTyApp, nlHsVar, nlHsLit, nlHsApp, nlHsApps, nlHsIntLit, nlHsVarApps, nlHsDo, nlHsOpApp, nlHsLam, nlHsPar, nlHsIf, nlHsCase, nlList, @@ -35,7 +36,7 @@ module HsUtils( -- Patterns mkNPat, mkNPlusKPat, nlVarPat, nlLitPat, nlConVarPat, nlConPat, nlInfixConPat, - nlNullaryConPat, nlWildConPat, nlWildPat, nlTuplePat, + nlNullaryConPat, nlWildConPat, nlWildPat, nlTuplePat, mkParPat, -- Types mkHsAppTy, userHsTyVarBndrs, @@ -120,15 +121,50 @@ unguardedGRHSs rhs = GRHSs (unguardedRHS rhs) emptyLocalBinds unguardedRHS :: LHsExpr id -> [LGRHS id] unguardedRHS rhs@(L loc _) = [L loc (GRHS [] rhs)] +mkMatchGroup :: [LMatch id] -> MatchGroup id +mkMatchGroup matches = MatchGroup matches placeHolderType + mkHsAppTy :: LHsType name -> LHsType name -> LHsType name mkHsAppTy t1 t2 = addCLoc t1 t2 (HsAppTy t1 t2) mkHsApp :: LHsExpr name -> LHsExpr name -> LHsExpr name mkHsApp e1 e2 = addCLoc e1 e2 (HsApp e1 e2) +mkHsLam :: [LPat id] -> LHsExpr id -> LHsExpr id +mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches)) + where + matches = mkMatchGroup [mkSimpleMatch pats body] + +mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr Id -> LHsExpr Id +mkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars <.> mkWpLams dicts) expr + +mkHsConApp :: DataCon -> [Type] -> [HsExpr Id] -> LHsExpr Id +-- Used for constructing dictionary terms etc, so no locations +mkHsConApp data_con tys args + = foldl mk_app (nlHsTyApp (dataConWrapId data_con) tys) args + where + mk_app f a = noLoc (HsApp f (noLoc a)) + +mkSimpleHsAlt :: LPat id -> LHsExpr id -> LMatch id +-- A simple lambda with a single pattern, no binds, no guards; pre-typechecking +mkSimpleHsAlt pat expr + = mkSimpleMatch [pat] expr + nlHsTyApp :: name -> [Type] -> LHsExpr name nlHsTyApp fun_id tys = noLoc (HsWrap (mkWpTyApps tys) (HsVar fun_id)) +--------- Adding parens --------- +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 le) + | otherwise = le + +mkParPat :: LPat name -> LPat name +mkParPat lp@(L loc p) | hsPatNeedsParens p = L loc (ParPat lp) + | otherwise = lp + +--------- HsWrappers: type args, dict args, casts --------- mkLHsWrap :: HsWrapper -> LHsExpr id -> LHsExpr id mkLHsWrap co_fn (L loc e) = L loc (mkHsWrap co_fn e) @@ -156,31 +192,9 @@ mkHsWrapPatCo :: Coercion -> Pat id -> Type -> Pat id mkHsWrapPatCo (Refl _) pat _ = pat mkHsWrapPatCo co pat ty = CoPat (WpCast co) pat ty -mkHsLam :: [LPat id] -> LHsExpr id -> LHsExpr id -mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches)) - where - matches = mkMatchGroup [mkSimpleMatch pats body] - -mkMatchGroup :: [LMatch id] -> MatchGroup id -mkMatchGroup matches = MatchGroup matches placeHolderType - -mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr Id -> LHsExpr Id -mkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars <.> mkWpLams dicts) expr - mkHsDictLet :: TcEvBinds -> LHsExpr Id -> LHsExpr Id mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr -mkHsConApp :: DataCon -> [Type] -> [HsExpr Id] -> LHsExpr Id --- Used for constructing dictionary terms etc, so no locations -mkHsConApp data_con tys args - = foldl mk_app (nlHsTyApp (dataConWrapId data_con) tys) args - where - mk_app f a = noLoc (HsApp f (noLoc a)) - -mkSimpleHsAlt :: LPat id -> LHsExpr id -> LMatch id --- A simple lambda with a single pattern, no binds, no guards; pre-typechecking -mkSimpleHsAlt pat expr - = mkSimpleMatch [pat] expr ------------------------------- -- These are the bits of syntax that contain rebindable names |