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            ( DefaultDecl(..) )
  12 import Name             ( Name )
  13 import TcRnMonad
  14 import TcEnv            ( tcLookupGlobal_maybe )
  15 import TcMonoType       ( tcHsType )
  16 import TcSimplify       ( tcSimplifyDefault )
  17 import TcType           ( Type, mkClassPred, isTauTy )
  18 import PrelNames        ( numClassName )
  19 import Outputable
  20 import HscTypes         ( TyThing(..) )
  21 \end{code}
  22
  23 \begin{code}
  24 tcDefaults :: [DefaultDecl Name]
  25            -> TcM [Type]            -- Defaulting types to heave
  26                                     -- into Tc monad for later use
  27                                     -- in Disambig.
  28
  29 tcDefaults []
  30   = getDefaultTys               -- No default declaration, so get the
  31                                 -- default types from the envt;
  32                                 -- i.e. use the curent ones
  33                                 -- (the caller will put them back there)
  34         -- It's important not to return defaultDefaultTys here (which
  35         -- we used to do) because in a TH program, tcDefaults [] is called
  36         -- repeatedly, once for each group of declarations between top-level
  37         -- splices.  We don't want to carefully set the default types in
  38         -- one group, only for the next group to ignore them and install
  39         -- defaultDefaultTys
  40
  41 tcDefaults [DefaultDecl [] locn]
  42   = returnM []                  -- Default declaration specifying no types
  43
  44 tcDefaults [DefaultDecl mono_tys locn]
  45   = tcLookupGlobal_maybe numClassName   `thenM` \ maybe_num ->
  46     case maybe_num of
  47         Just (AClass num_class) -> common_case num_class
  48         other                   -> returnM []
  49                 -- In the Nothing case, Num has not been sucked in, so the
  50                 -- defaults will never be used; so simply discard the default decl.
  51                 -- This slightly benefits modules that don't use any
  52                 -- numeric stuff at all, by avoid the necessity of
  53                 -- always sucking in Num
  54   where
  55     common_case num_class
  56       = addSrcLoc locn          $
  57         addErrCtxt defaultDeclCtxt      $
  58         mappM tc_default_ty mono_tys    `thenM` \ tau_tys ->
  59
  60                 -- Check that all the types are instances of Num
  61                 -- We only care about whether it worked or not
  62         tcSimplifyDefault [mkClassPred num_class [ty] | ty <- tau_tys]  `thenM_`
  63
  64         returnM tau_tys
  65
  66 tcDefaults decls@(DefaultDecl _ loc : _) =
  67     addSrcLoc loc $
  68     failWithTc (dupDefaultDeclErr decls)
  69
  70
  71 tc_default_ty hs_ty
  72  = tcHsType hs_ty                               `thenM` \ ty ->
  73    checkTc (isTauTy ty) (polyDefErr hs_ty)      `thenM_`
  74    returnM ty
  75
  76 defaultDeclCtxt =  ptext SLIT("when checking that each type in a default declaration")
  77                     $$ ptext SLIT("is an instance of class Num")
  78
  79
  80 dupDefaultDeclErr (DefaultDecl _ locn1 : dup_things)
  81   = hang (ptext SLIT("Multiple default declarations"))
  82       4  (vcat (map pp dup_things))
  83   where
  84     pp (DefaultDecl _ locn) = ptext SLIT("here was another default declaration") <+> ppr locn
  85
  86 polyDefErr ty
  87   = hang (ptext SLIT("Illegal polymorphic type in default declaration") <> colon) 4 (ppr ty)
  88 \end{code}
  89