diff options
| author | Iavor S. Diatchki <iavor.diatchki@gmail.com> | 2012-05-27 18:32:04 -0700 |
|---|---|---|
| committer | Iavor S. Diatchki <iavor.diatchki@gmail.com> | 2012-05-27 18:32:04 -0700 |
| commit | e0de72c3a3f97113a51dde3b05e816f4b3a1370d (patch) | |
| tree | d34ea3e4e8a4c373025d24f2cd253fbee34359cb | |
| parent | e99d0b083b195949dbf1a7a5bb8dfda105449b67 (diff) | |
| download | haskell-e0de72c3a3f97113a51dde3b05e816f4b3a1370d.tar.gz | |
Improve the error message when using an implicit parameter.
| -rw-r--r-- | compiler/typecheck/TcExpr.lhs | 12 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnTypes.lhs | 2 |
2 files changed, 12 insertions, 2 deletions
diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs index 43b90c2c8d..794af421d4 100644 --- a/compiler/typecheck/TcExpr.lhs +++ b/compiler/typecheck/TcExpr.lhs @@ -63,6 +63,7 @@ import ErrUtils import Outputable import FastString import Control.Monad +import Bag(mapBag) \end{code} %************************************************************************ @@ -179,7 +180,12 @@ tcExpr (NegApp expr neg_expr) res_ty ; return (NegApp expr' neg_expr') } -- We desugar ?x into: ipUse (IPName :: IPName "x") -tcExpr (HsIPVar x) res_ty = tcExpr (unLoc expr) res_ty +tcExpr (HsIPVar x) res_ty = + do (r,cs) <- captureConstraints $ tcExpr (unLoc expr) res_ty + + -- There should be just a single flat wnated `IP` constaint. + emitConstraints $ cs { wc_flat = mapBag setOrigin (wc_flat cs) } + return r where p = L (getLoc x) expr = mkHsApp (p $ HsVar ipUseName) mkIPName @@ -187,6 +193,10 @@ tcExpr (HsIPVar x) res_ty = tcExpr (unLoc expr) res_ty ty = mkHsAppTy (p $ HsTyVar ipNameTyConName) (p $ HsTyLit $ HsStrTy $ hsIPNameFS $ unLoc x) + origin = IPOccOrigin (unLoc x) + updOriginEv ev = ev { ctev_wloc = ctev_wloc ev `setCtLocOrigin` origin } + setOrigin w = w { cc_ev = updOriginEv (cc_ev w) } + tcExpr (HsLam match) res_ty = do { (co_fn, match') <- tcMatchLambda match res_ty ; return (mkHsWrap co_fn (HsLam match')) } diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index b7f62cdd5f..1cae74d5e2 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -1454,7 +1454,7 @@ data CtOrigin | TypeEqOrigin EqOrigin - | IPOccOrigin (IPName Name) -- Occurrence of an implicit parameter + | IPOccOrigin HsIPName -- Occurrence of an implicit parameter | LiteralOrigin (HsOverLit Name) -- Occurrence of a literal | NegateOrigin -- Occurrence of syntactic negation |