compiler/typecheck/TcDefaults.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The AQUA Project, Glasgow University, 1993-1998
   4 %
   5 \section[TcDefaults]{Typechecking \tr{default} declarations}
   6
   7 \begin{code}
   8 module TcDefaults ( tcDefaults ) where
   9
  10 #include "HsVersions.h"
  11
  12 import HsSyn
  13 import Name
  14 import TcRnMonad
  15 import TcEnv
  16 import TcHsType
  17 import TcSimplify
  18 import TcType
  19 import PrelNames
  20 import SrcLoc
  21 import Outputable
  22 \end{code}
  23
  24 \begin{code}
  25 tcDefaults :: [LDefaultDecl Name]
  26            -> TcM (Maybe [Type])    -- Defaulting types to heave
  27                                     -- into Tc monad for later use
  28                                     -- in Disambig.
  29
  30 tcDefaults []
  31   = getDefaultTys               -- No default declaration, so get the
  32                                 -- default types from the envt;
  33                                 -- i.e. use the curent ones
  34                                 -- (the caller will put them back there)
  35         -- It's important not to return defaultDefaultTys here (which
  36         -- we used to do) because in a TH program, tcDefaults [] is called
  37         -- repeatedly, once for each group of declarations between top-level
  38         -- splices.  We don't want to carefully set the default types in
  39         -- one group, only for the next group to ignore them and install
  40         -- defaultDefaultTys
  41
  42 tcDefaults [L locn (DefaultDecl [])]
  43   = returnM (Just [])           -- Default declaration specifying no types
  44
  45 tcDefaults [L locn (DefaultDecl mono_tys)]
  46   = setSrcSpan locn                     $
  47     addErrCtxt defaultDeclCtxt          $
  48     tcLookupClass numClassName          `thenM` \ num_class ->
  49     tcLookupClass isStringClassName             `thenM` \ num_class ->
  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 (Just tau_tys)
  57
  58 tcDefaults decls@(L locn (DefaultDecl _) : _) =
  59     setSrcSpan locn $
  60     failWithTc (dupDefaultDeclErr decls)
  61
  62
  63 tc_default_ty hs_ty
  64  = tcHsSigType DefaultDeclCtxt 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 (L _ (DefaultDecl _) : dup_things)
  73   = hang (ptext SLIT("Multiple default declarations"))
  74       4  (vcat (map pp dup_things))
  75   where
  76     pp (L locn (DefaultDecl _)) = 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