diff options
| author | Sebastian Graf <sebastian.graf@kit.edu> | 2019-10-25 11:20:48 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-10-28 09:22:35 -0400 |
| commit | e951f219597a3e8209abd62f85c717865f7445ca (patch) | |
| tree | f1036c6a31758fb835179fc147ab4830c0b61c20 /compiler/parser | |
| parent | e0e0485634d9a047b43da958c09e3bf6c5937c0f (diff) | |
| download | haskell-e951f219597a3e8209abd62f85c717865f7445ca.tar.gz | |
Use FlexibleInstances for `Outputable (* p)` instead of match-all instances with equality constraints
In #17304, Richard and Simon dicovered that using `-XFlexibleInstances`
for `Outputable` instances of AST data types means users can provide orphan
`Outputable` instances for passes other than `GhcPass`.
Type inference doesn't currently to suffer, and Richard gave an example
in #17304 that shows how rare a case would be where the slightly worse
type inference would matter.
So I went ahead with the refactoring, attempting to fix #17304.
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 11 |
1 files changed, 6 insertions, 5 deletions
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 911bda1efb..cb70078fd3 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -6,6 +6,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE ViewPatterns #-} @@ -2119,7 +2120,7 @@ patBuilderBang bang p = cL (bang `combineSrcSpans` getLoc p) $ PatBuilderBang bang p -instance p ~ GhcPs => Outputable (PatBuilder p) where +instance Outputable (PatBuilder GhcPs) where ppr (PatBuilderPat p) = ppr p ppr (PatBuilderBang _ (L _ p)) = text "!" <+> ppr p ppr (PatBuilderPar (L _ p)) = parens (ppr p) @@ -2128,8 +2129,8 @@ instance p ~ GhcPs => Outputable (PatBuilder p) where ppr (PatBuilderVar v) = ppr v ppr (PatBuilderOverLit l) = ppr l -instance p ~ GhcPs => DisambECP (PatBuilder p) where - type Body (PatBuilder p) = PatBuilder +instance DisambECP (PatBuilder GhcPs) where + type Body (PatBuilder GhcPs) = PatBuilder ecpFromCmd' (dL-> L l c) = addFatalError l $ text "Command syntax in pattern:" <+> ppr c @@ -2140,13 +2141,13 @@ instance p ~ GhcPs => DisambECP (PatBuilder p) where text "Lambda-syntax in pattern." $$ text "Pattern matching on functions is not possible." mkHsLetPV l _ _ = addFatalError l $ text "(let ... in ...)-syntax in pattern" - type InfixOp (PatBuilder p) = RdrName + type InfixOp (PatBuilder GhcPs) = RdrName superInfixOp m = m mkHsOpAppPV l p1 op p2 = do warnSpaceAfterBang op (getLoc p2) return $ cL l $ PatBuilderOpApp p1 op p2 mkHsCasePV l _ _ = addFatalError l $ text "(case ... of ...)-syntax in pattern" - type FunArg (PatBuilder p) = PatBuilder p + type FunArg (PatBuilder GhcPs) = PatBuilder GhcPs superFunArg m = m mkHsAppPV l p1 p2 = return $ cL l (PatBuilderApp p1 p2) mkHsIfPV l _ _ _ _ _ = addFatalError l $ text "(if ... then ... else ...)-syntax in pattern" |