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            ( tcLookupGlobal_maybe )
  16 import TcMonoType       ( tcHsType )
  17 import TcSimplify       ( tcSimplifyCheckThetas )
  18
  19 import TysWiredIn       ( integerTy, doubleTy )
  20 import Type             ( Type )
  21 import PrelNames        ( numClassName )
  22 import Outputable
  23 import HscTypes         ( TyThing(..) )
  24 \end{code}
  25
  26 \begin{code}
  27 default_default = [integerTy, doubleTy]
  28
  29 tcDefaults :: [RenamedHsDecl]
  30            -> TcM [Type]            -- defaulting types to heave
  31                                     -- into Tc monad for later use
  32                                     -- in Disambig.
  33 tcDefaults decls = tc_defaults [default_decl | DefD default_decl <- decls]
  34
  35 tc_defaults [] = returnTc default_default
  36
  37 tc_defaults [DefaultDecl [] locn]
  38   = returnTc []         -- no defaults
  39
  40 tc_defaults [DefaultDecl mono_tys locn]
  41   = tcLookupGlobal_maybe numClassName   `thenNF_Tc` \ maybe_num ->
  42     case maybe_num of
  43         Just (AClass num_class) -> common_case num_class
  44         other                   -> returnTc []
  45                 -- In the Nothing case, Num has not been sucked in, so the
  46                 -- defaults will never be used; so simply discard the default decl.
  47                 -- This slightly benefits modules that don't use any
  48                 -- numeric stuff at all, by avoid the necessity of
  49                 -- always sucking in Num
  50   where
  51     common_case num_class
  52       = tcAddSrcLoc locn $
  53         mapTc tcHsType mono_tys `thenTc` \ tau_tys ->
  54
  55                 -- Check that all the types are instances of Num
  56                 -- We only care about whether it worked or not
  57         tcAddErrCtxt defaultDeclCtxt            $
  58         tcSimplifyCheckThetas
  59                     [{- Nothing given -}]
  60                     [ (num_class, [ty]) | ty <- tau_tys ]       `thenTc_`
  61
  62         returnTc tau_tys
  63
  64
  65 tc_defaults decls@(DefaultDecl _ loc : _) =
  66     tcAddSrcLoc loc $
  67     failWithTc (dupDefaultDeclErr decls)
  68
  69
  70 defaultDeclCtxt =  ptext SLIT("when checking that each type in a default declaration")
  71                     $$ ptext SLIT("is an instance of class Num")
  72
  73
  74 dupDefaultDeclErr (DefaultDecl _ locn1 : dup_things)
  75   = hang (ptext SLIT("Multiple default declarations"))
  76       4  (vcat (map pp dup_things))
  77   where
  78     pp (DefaultDecl _ locn) = ptext SLIT("here was another default declaration") <+> ppr locn
  79 \end{code}
  80