projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Layout and type synonyms only
[ghc-hetmet.git]
/
compiler
/
hsSyn
/
HsExpr.lhs
diff --git
a/compiler/hsSyn/HsExpr.lhs
b/compiler/hsSyn/HsExpr.lhs
index
d213158
..
bbb2712
100644
(file)
--- a/
compiler/hsSyn/HsExpr.lhs
+++ b/
compiler/hsSyn/HsExpr.lhs
@@
-15,7
+15,6
@@
import HsDecls
import HsPat
import HsLit
import HsTypes
import HsPat
import HsLit
import HsTypes
-import HsImpExp
import HsBinds
-- others:
import HsBinds
-- others:
@@
-160,7
+159,7
@@
data HsExpr id
| RecordUpd (LHsExpr id)
(HsRecordBinds id)
[DataCon] -- Filled in by the type checker to the
| RecordUpd (LHsExpr id)
(HsRecordBinds id)
[DataCon] -- Filled in by the type checker to the
- -- *non-empty* list of DataCons that have
+ -- _non-empty_ list of DataCons that have
-- all the upd'd fields
[PostTcType] -- Argument types of *input* record type
[PostTcType] -- and *output* record type
-- all the upd'd fields
[PostTcType] -- Argument types of *input* record type
[PostTcType] -- and *output* record type
@@
-198,7
+197,7
@@
data HsExpr id
| HsBracketOut (HsBracket Name) -- Output of the type checker is
-- the *original*
[PendingSplice] -- renamed expression, plus
| HsBracketOut (HsBracket Name) -- Output of the type checker is
-- the *original*
[PendingSplice] -- renamed expression, plus
- -- *typechecked* splices to be
+ -- _typechecked_ splices to be
-- pasted back in by the desugarer
| HsSpliceE (HsSplice id)
-- pasted back in by the desugarer
| HsSpliceE (HsSplice id)
@@
-346,7
+345,7
@@
ppr_expr (OpApp e1 op _ e2)
= hang (ppr op) 2 (sep [pp_e1, pp_e2])
pp_infixly v
= hang (ppr op) 2 (sep [pp_e1, pp_e2])
pp_infixly v
- = sep [nest 2 pp_e1, pprInfix v, nest 2 pp_e2]
+ = sep [nest 2 pp_e1, pprHsInfix v, nest 2 pp_e2]
ppr_expr (NegApp e _) = char '-' <+> pprDebugParendExpr e
ppr_expr (NegApp e _) = char '-' <+> pprDebugParendExpr e
@@
-359,7
+358,7
@@
ppr_expr (SectionL expr op)
pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
4 (hsep [pp_expr, ptext (sLit "x_ )")])
pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
4 (hsep [pp_expr, ptext (sLit "x_ )")])
- pp_infixly v = (sep [pp_expr, pprInfix v])
+ pp_infixly v = (sep [pp_expr, pprHsInfix v])
ppr_expr (SectionR op expr)
= case unLoc op of
ppr_expr (SectionR op expr)
= case unLoc op of
@@
-371,7
+370,7
@@
ppr_expr (SectionR op expr)
pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext (sLit "x_")])
4 ((<>) pp_expr rparen)
pp_infixly v
pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext (sLit "x_")])
4 ((<>) pp_expr rparen)
pp_infixly v
- = (sep [pprInfix v, pp_expr])
+ = (sep [pprHsInfix v, pp_expr])
--avoid using PatternSignatures for stage1 code portability
ppr_expr exprType@(HsLam matches)
--avoid using PatternSignatures for stage1 code portability
ppr_expr exprType@(HsLam matches)
@@
-379,8
+378,8
@@
ppr_expr exprType@(HsLam matches)
where idType :: HsExpr id -> HsMatchContext id; idType = undefined
ppr_expr exprType@(HsCase expr matches)
where idType :: HsExpr id -> HsMatchContext id; idType = undefined
ppr_expr exprType@(HsCase expr matches)
- = sep [ sep [ptext (sLit "case"), nest 4 (ppr expr), ptext (sLit "of")],
- nest 2 (pprMatches (CaseAlt `asTypeOf` idType exprType) matches) ]
+ = sep [ sep [ptext (sLit "case"), nest 4 (ppr expr), ptext (sLit "of {")],
+ nest 2 (pprMatches (CaseAlt `asTypeOf` idType exprType) matches <+> char '}') ]
where idType :: HsExpr id -> HsMatchContext id; idType = undefined
ppr_expr (HsIf e1 e2 e3)
where idType :: HsExpr id -> HsMatchContext id; idType = undefined
ppr_expr (HsIf e1 e2 e3)
@@
-477,7
+476,7
@@
ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False)
= hsep [ppr_lexpr arg, ptext (sLit ">>-"), ppr_lexpr arrow]
ppr_expr (HsArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
= hsep [ppr_lexpr arg, ptext (sLit ">>-"), ppr_lexpr arrow]
ppr_expr (HsArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
- = sep [pprCmdArg (unLoc arg1), hsep [pprInfix v, pprCmdArg (unLoc arg2)]]
+ = sep [pprCmdArg (unLoc arg1), hsep [pprHsInfix v, pprCmdArg (unLoc arg2)]]
ppr_expr (HsArrForm op _ args)
= hang (ptext (sLit "(|") <> ppr_lexpr op)
4 (sep (map (pprCmdArg.unLoc) args) <> ptext (sLit "|)"))
ppr_expr (HsArrForm op _ args)
= hang (ptext (sLit "(|") <> ppr_lexpr op)
4 (sep (map (pprCmdArg.unLoc) args) <> ptext (sLit "|)"))
@@
-491,12
+490,6
@@
pprCmdArg (HsCmdTop cmd _ _ _)
instance OutputableBndr id => Outputable (HsCmdTop id) where
ppr = pprCmdArg
instance OutputableBndr id => Outputable (HsCmdTop id) where
ppr = pprCmdArg
--- Put a var in backquotes if it's not an operator already
-pprInfix :: Outputable name => name -> SDoc
-pprInfix v | isOperator ppr_v = ppr_v
- | otherwise = char '`' <> ppr_v <> char '`'
- where ppr_v = ppr v
-
-- add parallel array brackets around a document
--
pa_brackets :: SDoc -> SDoc
-- add parallel array brackets around a document
--
pa_brackets :: SDoc -> SDoc
@@
-670,9
+663,12
@@
data Match id
-- Nothing after typechecking
(GRHSs id)
-- Nothing after typechecking
(GRHSs id)
+isEmptyMatchGroup :: MatchGroup id -> Bool
+isEmptyMatchGroup (MatchGroup ms _) = null ms
+
matchGroupArity :: MatchGroup id -> Arity
matchGroupArity (MatchGroup [] _)
matchGroupArity :: MatchGroup id -> Arity
matchGroupArity (MatchGroup [] _)
- = panic "matchGroupArity" -- MatchGroup is never empty
+ = panic "matchGroupArity" -- Precondition: MatchGroup is non-empty
matchGroupArity (MatchGroup (match:matches) _)
= ASSERT( all ((== n_pats) . length . hsLMatchPats) matches )
-- Assertion just checks that all the matches have the same number of pats
matchGroupArity (MatchGroup (match:matches) _)
= ASSERT( all ((== n_pats) . length . hsLMatchPats) matches )
-- Assertion just checks that all the matches have the same number of pats