[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