ghc/compiler/typecheck/TcDefaults.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1995
   3 %
   4 \section[TcDefaults]{Typechecking \tr{default} declarations}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module TcDefaults ( tcDefaults ) where
  10
  11 import TcMonad
  12 import AbsSyn
  13
  14 import AbsPrel          ( intTy, doubleTy, unitTy )
  15 import AbsUniType       ( UniType
  16                           IF_ATTACK_PRAGMAS(COMMA cmpUniType)
  17                         )
  18 import CE               ( lookupCE, CE(..) )
  19 import E
  20 import Inst
  21 import Name
  22 import TcMonoType       ( tcMonoType )
  23 import TcSimplify       ( tcSimplifyCheckThetas )
  24 import TVE
  25 import Unique           ( numClassKey, Unique )
  26 import Util
  27 \end{code}
  28
  29 \begin{code}
  30 tcDefaults :: E
  31            -> [RenamedDefaultDecl]
  32            -> TcM [UniType]         -- defaulting types to heave
  33                                     -- into Tc monad for later use
  34                                     -- in Disambig.
  35
  36 tcDefaults _ []
  37   = returnTc [intTy, doubleTy] -- language-specified default `default'
  38
  39 tcDefaults e [DefaultDecl mono_tys locn]
  40   = let
  41         ce  = getE_CE  e
  42         tce = getE_TCE e
  43         tve = nullTVE
  44
  45         num_clas = lookupCE ce (PreludeClass numClassKey (panic "tcDefaults"))
  46     in
  47     babyTcMtoTcM (mapB_Tc (tcMonoType ce tce tve) mono_tys) `thenTc` \ tau_tys ->
  48
  49         -- compensate for extreme parser hack: `default ()' actually
  50         -- sends the *type* () through to here.  Squash it.
  51     case tau_tys of
  52       [ty] | ty == unitTy -> returnTc []
  53
  54       _  -> -- (Back to your regularly scheduled programming...)
  55
  56             -- Check that all the types are instances of Num
  57
  58         tcSimplifyCheckThetas (DefaultDeclOrigin locn)
  59                          [ (num_clas, ty) | ty <- tau_tys ] `thenTc` \ _ ->
  60             -- We only care about whether it worked or not
  61
  62         returnTc tau_tys -- caller will bung them into Tc monad
  63
  64 tcDefaults _ (_:_)
  65   = error "ERROR: You can only have one `default' declaration per module."
  66     -- ToDo: proper error msg.
  67 \end{code}