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 can be useful to be
able to ignore the problems in a
.
For more motivation and details please refer to the HaskellWiki page or the original paper.
The flag -fdefer-type-errors
controls whether type
errors are deferred to runtime. Type errors will still be emitted as
warnings, but will not prevent compilation.
At runtime, whenever a term containing a type error would need to be evaluated, the error is converted into a runtime exception. Note that type errors are deferred as much as possible during runtime, but invalid coercions are never performed, even when they would ultimately result in a value of the correct type. For example, given the following code:
x :: Int x = 0 y :: Char y = x z :: Int z = y
evaluating z
will result in a runtime type error.
The flag -fdefer-type-errors
works in GHCi as well, with
one exception: for "naked" expressions typed at the prompt, type
errors don't get delayed, so for example:
Prelude> fst (True, 1 == 'a') <interactive>:2:12: No instance for (Num Char) arising from the literal `1' Possible fix: add an instance declaration for (Num Char) In the first argument of `(==)', namely `1' In the expression: 1 == 'a' In the first argument of `fst', namely `(True, 1 == 'a')'
Otherwise, in the common case of a simple type error such as
typing reverse True
at the prompt, you would get a warning and then
an immediately-following type error when the expression is evaluated.
This exception doesn't apply to statements, as the following example demonstrates:
Prelude> let x = (True, 1 == 'a') <interactive>:3:16: Warning: No instance for (Num Char) arising from the literal `1' Possible fix: add an instance declaration for (Num Char) In the first argument of `(==)', namely `1' In the expression: 1 == 'a' In the expression: (True, 1 == 'a') Prelude> fst x True