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