diff options
Diffstat (limited to 'compiler/hsSyn/HsExpr.hs')
| -rw-r--r-- | compiler/hsSyn/HsExpr.hs | 35 |
1 files changed, 27 insertions, 8 deletions
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index 6e02df7438..158993eb2e 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -502,7 +502,14 @@ data HsExpr id -- For details on above see note [Api annotations] in ApiAnnotation | ELazyPat (LHsExpr id) -- ~ pattern - | HsType (LHsType id) -- Explicit type argument; e.g f {| Int |} x y + -- | Use for type application in expressions. + -- 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt' + + -- For details on above see note [Api annotations] in ApiAnnotation + | HsType (LHsWcType id) -- Explicit type argument; e.g f @Int x y + -- NB: Has wildcards, but no implicit quant. + + | HsTypeOut (LHsWcType Name) -- just for pretty-printing --------------------------------------- -- Finally, HsWrap appears only in typechecker output @@ -762,7 +769,10 @@ ppr_expr (HsSCC _ (StringLiteral _ lbl) expr) pprParendExpr expr ] ppr_expr (HsWrap co_fn e) = pprHsWrapper (pprExpr e) co_fn -ppr_expr (HsType id) = ppr id +ppr_expr (HsType (HsWC { hswc_body = ty })) + = char '@' <> pprParendHsType (unLoc ty) +ppr_expr (HsTypeOut (HsWC { hswc_body = ty })) + = char '@' <> pprParendHsType (unLoc ty) ppr_expr (HsSpliceE s) = pprSplice s ppr_expr (HsBracket b) = pprHsBracket b @@ -864,6 +874,8 @@ hsExprNeedsParens (HsTcBracketOut {}) = False hsExprNeedsParens (HsDo sc _ _) | isListCompExpr sc = False hsExprNeedsParens (HsRecFld{}) = False +hsExprNeedsParens (HsType {}) = False +hsExprNeedsParens (HsTypeOut {}) = False hsExprNeedsParens _ = True @@ -970,10 +982,10 @@ data HsCmd id -- For details on above see note [Api annotations] in ApiAnnotation - | HsCmdCast TcCoercionN -- A simpler version of HsWrap in HsExpr + | HsCmdWrap HsWrapper (HsCmd id) -- If cmd :: arg1 --> res - -- co :: arg1 ~ arg2 - -- Then (HsCmdCast co cmd) :: arg2 --> res + -- wrap :: arg1 "->" arg2 + -- Then (HsCmdWrap wrap cmd) :: arg2 --> res deriving (Typeable) deriving instance (DataId id) => Data (HsCmd id) @@ -1054,9 +1066,9 @@ ppr_cmd (HsCmdLet (L _ binds) cmd) = sep [hang (ptext (sLit "let")) 2 (pprBinds binds), hang (ptext (sLit "in")) 2 (ppr cmd)] -ppr_cmd (HsCmdDo (L _ stmts) _) = pprDo ArrowExpr stmts -ppr_cmd (HsCmdCast co cmd) = sep [ ppr_cmd cmd - , ptext (sLit "|>") <+> ppr co ] +ppr_cmd (HsCmdDo (L _ stmts) _) = pprDo ArrowExpr stmts + +ppr_cmd (HsCmdWrap w cmd) = pprHsWrapper (ppr_cmd cmd) w ppr_cmd (HsCmdArrApp arrow arg _ HsFirstOrderApp True) = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg] @@ -1186,6 +1198,13 @@ isInfixMatch match = case m_fixity match of isEmptyMatchGroup :: MatchGroup id body -> Bool isEmptyMatchGroup (MG { mg_alts = ms }) = null $ unLoc ms +-- | Is there only one RHS in this group? +isSingletonMatchGroup :: MatchGroup id body -> Bool +isSingletonMatchGroup (MG { mg_alts = L _ [match] }) + | L _ (Match { m_grhss = GRHSs { grhssGRHSs = [_] } }) <- match + = True +isSingletonMatchGroup _ = False + matchGroupArity :: MatchGroup id body -> Arity -- Precondition: MatchGroup is non-empty -- This is called before type checking, when mg_arg_tys is not set |