ghc/compiler/typecheck/TcDefaults.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1998
   3 %
   4 \section[TcDefaults]{Typechecking \tr{default} declarations}
   5
   6 \begin{code}
   7 module TcDefaults ( tcDefaults ) where
   8
   9 #include "HsVersions.h"
  10
  11 import HsSyn            ( HsDecl(..), DefaultDecl(..) )
  12 import RnHsSyn          ( RenamedHsDecl )
  13
  14 import TcMonad
  15 import TcEnv            ( tcLookupClassByKey_maybe )
  16 import TcMonoType       ( tcHsType )
  17 import TcSimplify       ( tcSimplifyCheckThetas )
  18
  19 import TysWiredIn       ( integerTy, doubleTy )
  20 import Type             ( Type )
  21 import Unique           ( numClassKey )
  22 import Outputable
  23 \end{code}
  24
  25 \begin{code}
  26 default_default = [integerTy, doubleTy]
  27
  28 tcDefaults :: [RenamedHsDecl]
  29            -> TcM s [Type]          -- defaulting types to heave
  30                                     -- into Tc monad for later use
  31                                     -- in Disambig.
  32 tcDefaults decls = tc_defaults [default_decl | DefD default_decl <- decls]
  33
  34 tc_defaults [] = returnTc default_default
  35
  36 tc_defaults [DefaultDecl [] locn]
  37   = returnTc []         -- no defaults
  38
  39 tc_defaults [DefaultDecl mono_tys locn]
  40   = tcLookupClassByKey_maybe numClassKey        `thenNF_Tc` \ maybe_num ->
  41     case maybe_num of {
  42         Nothing ->      -- Num has not been sucked in, so the defaults will
  43                         -- never be used; so simply discard the default decl.
  44                         -- This slightly benefits modules that don't use any
  45                         -- numeric stuff at all, by avoid the necessity of
  46                         -- always sucking in Num
  47                 returnTc [] ;
  48
  49         Just num ->     -- The common case
  50
  51     tcAddSrcLoc locn $
  52     mapTc tcHsType mono_tys     `thenTc` \ tau_tys ->
  53
  54             -- Check that all the types are instances of Num
  55             -- We only care about whether it worked or not
  56     tcAddErrCtxt defaultDeclCtxt                $
  57     tcSimplifyCheckThetas
  58                 [{- Nothing given -}]
  59                 [ (num, [ty]) | ty <- tau_tys ] `thenTc_`
  60
  61     returnTc tau_tys
  62     }
  63
  64 tc_defaults decls@(DefaultDecl _ loc : _) =
  65     tcAddSrcLoc loc $
  66     failWithTc (dupDefaultDeclErr decls)
  67
  68
  69 defaultDeclCtxt =  ptext SLIT("when checking that each type in a default declaration")
  70                     $$ ptext SLIT("is an instance of class Num")
  71
  72
  73 dupDefaultDeclErr (DefaultDecl _ locn1 : dup_things)
  74   = hang (ptext SLIT("Multiple default declarations"))
  75       4  (vcat (map pp dup_things))
  76   where
  77     pp (DefaultDecl _ locn) = ptext SLIT("here was another default declaration") <+> ppr locn
  78 \end{code}
  79