Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : fix-5624
http://hackage.haskell.org/trac/ghc/changeset/d32430222a806d02023c005ba255ab7ac8f249a4 >--------------------------------------------------------------- commit d32430222a806d02023c005ba255ab7ac8f249a4 Author: Jose Pedro Magalhaes <[email protected]> Date: Tue Nov 29 15:07:46 2011 +0000 Implement runtime-coercion-errors Note [Deferring coercion errors to runtime] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ While developing, sometimes it is desirable to allow compilation to succeed even if there are type errors in the code. Consider the following case: module Main where a :: Int a = 'a' main = print "b" Even though `a` is ill-typed, it is not used in the end, so if all that we're interested in is `main` it is handy to be able to ignore the problems in `a`. Since we treat type equalities as evidence, this is relatively simple. Whenever we run into a type mismatch in TcUnify, we normally just emit an error. But it is always safe to defer the mismatch to the main constraint solver. If we do that, `a` will get transformed into co :: Int ~ Char co = ... a :: Int a = 'a' `cast` co The constraint solver would realize that `co` is an insoluble constraint, and emit an error with `reportUnsolved`. But we can also replace the right-hand side of `co` with `error "Deferred type error: Int ~ Char"`. This allows the program to compile, and it will run fine unless we evaluate `a`. This is what `deferErrorsToRuntime` does. It does this by aggregating all the coercion error messages in the program and them getting the relevant ones for each coercion, by comparing the locations of the coercion and the error message. It's a hack, but it means we don't have to entirely rewrite TcErrors: currently error reporting is done by writing into a mutable variable, and not by returning the individual `SDoc`s, as we would need. We are reasonably sure that the error messages will always have the same location as the coercion they originate from because that is basically the only location they can have. compiler/deSugar/DsBinds.lhs | 20 ++++-- compiler/hsSyn/HsBinds.lhs | 19 +++++- compiler/main/DynFlags.hs | 2 + compiler/main/ErrUtils.lhs | 10 +++ compiler/typecheck/TcErrors.lhs | 72 ++++++++++++-------- compiler/typecheck/TcHsSyn.lhs | 3 + compiler/typecheck/TcRnDriver.lhs | 2 +- compiler/typecheck/TcRnTypes.lhs | 8 ++- compiler/typecheck/TcSMonad.lhs | 13 ++-- compiler/typecheck/TcSimplify.lhs | 135 ++++++++++++++++++++++++++++++++---- 10 files changed, 223 insertions(+), 61 deletions(-) Diff suppressed because of size. To see it, use: git show d32430222a806d02023c005ba255ab7ac8f249a4 _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
