[commit: ghc] master: Minor refactoring of user type errors (31b482b)
git at git.haskell.org
git at git.haskell.org
Fri Dec 4 14:21:23 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/31b482bfa68ec8524c4039a33ba55f0aaf02dc0b/ghc
>---------------------------------------------------------------
commit 31b482bfa68ec8524c4039a33ba55f0aaf02dc0b
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Fri Dec 4 12:11:43 2015 +0000
Minor refactoring of user type errors
* Remove unused Kind result of getUserTypeErrorMsg
* Rename isUserErrorTy --> userTypeError_maybe
>---------------------------------------------------------------
31b482bfa68ec8524c4039a33ba55f0aaf02dc0b
compiler/typecheck/TcErrors.hs | 4 ++--
compiler/typecheck/TcRnTypes.hs | 6 +++---
compiler/types/Type.hs | 11 ++++++-----
3 files changed, 11 insertions(+), 10 deletions(-)
diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index 156b1ff..ad389b2 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -499,8 +499,8 @@ mkUserTypeError ctxt ct = mkErrorMsgFromCt ctxt ct
$ important
$ pprUserTypeErrorTy
$ case getUserTypeErrorMsg ct of
- Just (_,msg) -> msg
- Nothing -> pprPanic "mkUserTypeError" (ppr ct)
+ Just msg -> msg
+ Nothing -> pprPanic "mkUserTypeError" (ppr ct)
mkGroupReporter :: (ReportErrCtxt -> [Ct] -> TcM ErrMsg)
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index f66399d..0e8f682 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -1661,14 +1661,14 @@ isTypeHoleCt _ = False
-- 1. TypeError msg
-- 2. TypeError msg ~ Something (and the other way around)
-- 3. C (TypeError msg) (for any parameter of class constraint)
-getUserTypeErrorMsg :: Ct -> Maybe (Kind, Type)
+getUserTypeErrorMsg :: Ct -> Maybe Type
getUserTypeErrorMsg ct
| Just (_,t1,t2) <- getEqPredTys_maybe ctT = oneOf [t1,t2]
| Just (_,ts) <- getClassPredTys_maybe ctT = oneOf ts
- | otherwise = isUserErrorTy ctT
+ | otherwise = userTypeError_maybe ctT
where
ctT = ctPred ct
- oneOf xs = msum (map isUserErrorTy xs)
+ oneOf xs = msum (map userTypeError_maybe xs)
isUserTypeErrorCt :: Ct -> Bool
isUserTypeErrorCt ct = case getUserTypeErrorMsg ct of
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 13ac503..f7493f3 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -39,7 +39,7 @@ module Type (
mkNumLitTy, isNumLitTy,
mkStrLitTy, isStrLitTy,
- isUserErrorTy, pprUserTypeErrorTy,
+ userTypeError_maybe, pprUserTypeErrorTy,
coAxNthLHS,
@@ -460,10 +460,11 @@ isStrLitTy _ = Nothing
-- | Is this type a custom user error?
-- If so, give us the kind and the error message.
-isUserErrorTy :: Type -> Maybe (Kind,Type)
-isUserErrorTy t = do (tc,[k,msg]) <- splitTyConApp_maybe t
- guard (tyConName tc == errorMessageTypeErrorFamName)
- return (k,msg)
+userTypeError_maybe :: Type -> Maybe Type
+userTypeError_maybe t
+ = do { (tc, [_kind, msg]) <- splitTyConApp_maybe t
+ ; guard (tyConName tc == errorMessageTypeErrorFamName)
+ ; return msg }
-- | Render a type corresponding to a user type error into a SDoc.
pprUserTypeErrorTy :: Type -> SDoc
More information about the ghc-commits
mailing list