Commit 0f930ba2 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Move expansion of 'assert' from renamer to typechecker

This improves error messages when there is a type error,
fixing Trac #9774
parent 303776ab
......@@ -79,17 +79,11 @@ rnExpr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
finishHsVar :: Name -> RnM (HsExpr Name, FreeVars)
-- Separated from rnExpr because it's also used
-- when renaming infix expressions
-- See Note [Adding the implicit parameter to 'assert']
finishHsVar name
= do { this_mod <- getModule
; when (nameIsLocalOrFrom this_mod name) $
checkThLocalName name
; ignore_asserts <- goptM Opt_IgnoreAsserts
; if ignore_asserts || not (name `hasKey` assertIdKey)
then return (HsVar name, unitFV name)
else do { e <- mkAssertErrorExpr
; return (e, unitFV name) } }
; return (HsVar name, unitFV name) }
rnExpr (HsVar v)
= do { mb_name <- lookupOccRn_maybe v
......@@ -1141,36 +1135,6 @@ segsToStmts empty_rec_stmt ((defs, uses, fwds, ss) : segs) fvs_later
-- The ones needed after the RecStmt
\end{code}
%************************************************************************
%* *
\subsubsection{Assertion utils}
%* *
%************************************************************************
\begin{code}
srcSpanPrimLit :: DynFlags -> SrcSpan -> HsExpr Name
srcSpanPrimLit dflags span
= HsLit (HsStringPrim (unsafeMkByteString (showSDocOneLine dflags (ppr span))))
mkAssertErrorExpr :: RnM (HsExpr Name)
-- Return an expression for (assertError "Foo.hs:27")
mkAssertErrorExpr
= do sloc <- getSrcSpanM
dflags <- getDynFlags
return (HsApp (L sloc (HsVar assertErrorName))
(L sloc (srcSpanPrimLit dflags sloc)))
\end{code}
Note [Adding the implicit parameter to 'assert']
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The renamer transforms (assert e1 e2) to (assert "Foo.hs:27" e1 e2).
By doing this in the renamer we allow the typechecker to just see the
expanded application and do the right thing. But it's not really
the Right Thing because there's no way to "undo" if you want to see
the original source code. We'll have fix this in due course, when
we care more about being able to reconstruct the exact original
program.
%************************************************************************
%* *
\subsubsection{Errors}
......
......@@ -48,7 +48,7 @@ import Var
import VarSet
import VarEnv
import TysWiredIn
import TysPrim( intPrimTy )
import TysPrim( intPrimTy, addrPrimTy )
import PrimOp( tagToEnumKey )
import PrelNames
import DynFlags
......@@ -1063,34 +1063,54 @@ tcInferIdWithOrig :: CtOrigin -> Name -> TcM (HsExpr TcId, TcRhoType)
-- Look up an occurrence of an Id, and instantiate it (deeply)
tcInferIdWithOrig orig id_name
= do { id <- lookup_id
; (id_expr, id_rho) <- instantiateOuter orig id
; (wrap, rho) <- deeplyInstantiate orig id_rho
; return (mkHsWrap wrap id_expr, rho) }
| id_name `hasKey` assertIdKey
= do { dflags <- getDynFlags
; if gopt Opt_IgnoreAsserts dflags
then normal_case
else assert_case dflags }
| otherwise
= normal_case
where
lookup_id :: TcM TcId
lookup_id
= do { thing <- tcLookup id_name
; case thing of
ATcId { tct_id = id }
-> do { check_naughty id -- Note [Local record selectors]
; checkThLocalId id
; return id }
AGlobal (AnId id)
-> do { check_naughty id; return id }
-- A global cannot possibly be ill-staged
-- nor does it need the 'lifting' treatment
-- hence no checkTh stuff here
AGlobal (AConLike cl) -> case cl of
RealDataCon con -> return (dataConWrapId con)
PatSynCon ps -> case patSynWrapper ps of
Nothing -> failWithTc (bad_patsyn ps)
Just id -> return id
other -> failWithTc (bad_lookup other) }
normal_case
= do { id <- lookup_id id_name
; (id_expr, id_rho) <- instantiateOuter orig id
; (wrap, rho) <- deeplyInstantiate orig id_rho
; return (mkHsWrap wrap id_expr, rho) }
assert_case dflags -- See Note [Adding the implicit parameter to 'assert']
= do { sloc <- getSrcSpanM
; assert_error_id <- lookup_id assertErrorName
; (id_expr, id_rho) <- instantiateOuter orig assert_error_id
; case tcSplitFunTy_maybe id_rho of {
Nothing -> pprPanic "assert type" (ppr id_rho) ;
Just (arg_ty, res_ty) -> ASSERT( arg_ty `tcEqType` addrPrimTy )
do { return (HsApp (L sloc id_expr)
(L sloc (srcSpanPrimLit dflags sloc)), res_ty) } } }
lookup_id :: Name -> TcM TcId
lookup_id id_name
= do { thing <- tcLookup id_name
; case thing of
ATcId { tct_id = id }
-> do { check_naughty id -- Note [Local record selectors]
; checkThLocalId id
; return id }
AGlobal (AnId id)
-> do { check_naughty id; return id }
-- A global cannot possibly be ill-staged
-- nor does it need the 'lifting' treatment
-- hence no checkTh stuff here
AGlobal (AConLike cl) -> case cl of
RealDataCon con -> return (dataConWrapId con)
PatSynCon ps -> case patSynWrapper ps of
Nothing -> failWithTc (bad_patsyn ps)
Just id -> return id
other -> failWithTc (bad_lookup other) }
where
bad_lookup thing = ppr thing <+> ptext (sLit "used where a value identifer was expected")
bad_patsyn name = ppr name <+> ptext (sLit "used in an expression, but it's a non-bidirectional pattern synonym")
......@@ -1099,6 +1119,10 @@ tcInferIdWithOrig orig id_name
| isNaughtyRecordSelector id = failWithTc (naughtyRecordSel id)
| otherwise = return ()
srcSpanPrimLit :: DynFlags -> SrcSpan -> HsExpr TcId
srcSpanPrimLit dflags span
= HsLit (HsStringPrim (unsafeMkByteString (showSDocOneLine dflags (ppr span))))
------------------------
instantiateOuter :: CtOrigin -> TcId -> TcM (HsExpr TcId, TcSigmaType)
-- Do just the first level of instantiation of an Id
......@@ -1123,6 +1147,14 @@ instantiateOuter orig id
(tvs, theta, tau) = tcSplitSigmaTy (idType id)
\end{code}
Note [Adding the implicit parameter to 'assert']
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The typechecker transforms (assert e1 e2) to (assertError "Foo.hs:27"
e1 e2). This isn't really the Right Thing because there's no way to
"undo" if you want to see the original source code in the typechecker
output. We'll have fix this in due course, when we care more about
being able to reconstruct the exact original program.
Note [Multiple instantiation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We are careful never to make a MethodInst that has, as its meth_id, another MethodInst.
......
module T9774 where
import Control.Exception
foo = putStrLn (assert True 'a')
T9774.hs:5:29:
Couldn't match type ‘Char’ with ‘[Char]’
Expected type: String
Actual type: Char
In the second argument of ‘assert’, namely ‘'a'’
In the first argument of ‘putStrLn’, namely ‘(assert True 'a')’
In the expression: putStrLn (assert True 'a')
......@@ -342,3 +342,4 @@ test('T9415', normal, compile_fail, [''])
test('T9612', normal, compile_fail, [''])
test('T9634', normal, compile_fail, [''])
test('T9739', normal, compile_fail, [''])
test('T9774', normal, compile_fail, [''])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment