ghc/compiler/typecheck/TcIfaceSig.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[TcIfaceSig]{Type checking of type signatures in interface files}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module TcIfaceSig ( tcInterfaceSigs ) where
  10
  11 IMP_Ubiq()
  12
  13 import TcMonad          hiding ( rnMtoTcM )
  14 import TcMonoType       ( tcPolyType )
  15
  16 import HsSyn            ( Sig(..), PolyType )
  17 import RnHsSyn          ( RenamedSig(..), RnName(..) )
  18
  19 import CmdLineOpts      ( opt_CompilingPrelude )
  20 import Id               ( mkImported )
  21 --import Name           ( Name(..) )
  22 import Maybes           ( maybeToBool )
  23 import Pretty
  24 import Util             ( panic )
  25
  26
  27 --import TcPragmas      ( tcGenPragmas )
  28 import IdInfo           ( noIdInfo )
  29 tcGenPragmas ty id ps = returnNF_Tc noIdInfo
  30
  31 \end{code}
  32
  33 Ultimately, type signatures in interfaces will have pragmatic
  34 information attached, so it is a good idea to have separate code to
  35 check them.
  36
  37 As always, we do not have to worry about user-pragmas in interface
  38 signatures.
  39
  40 \begin{code}
  41 tcInterfaceSigs :: [RenamedSig] -> TcM s [Id]
  42
  43 tcInterfaceSigs [] = returnTc []
  44
  45 tcInterfaceSigs (Sig name ty pragmas src_loc : sigs)
  46   | has_full_name
  47   = tcAddSrcLoc src_loc         (
  48     tcPolyType ty               `thenTc` \ sigma_ty ->
  49     fixTc ( \ rec_id ->
  50         tcGenPragmas (Just sigma_ty) rec_id pragmas
  51                                 `thenNF_Tc` \ id_info ->
  52         returnTc (mkImported full_name sigma_ty id_info)
  53     ))                          `thenTc` \ id ->
  54     tcInterfaceSigs sigs        `thenTc` \ sigs' ->
  55     returnTc (id:sigs')
  56
  57   | otherwise -- odd name...
  58   = case name of
  59       WiredInId _ | opt_CompilingPrelude
  60         -> tcInterfaceSigs sigs
  61       _ -> tcAddSrcLoc src_loc  $
  62            failTc (ifaceSigNameErr name)
  63   where
  64     has_full_name    = maybeToBool full_name_maybe
  65     (Just full_name) = full_name_maybe
  66     full_name_maybe  = case name of
  67                          RnName     fn  -> Just fn
  68                          RnImplicit fn  -> Just fn
  69                          _              -> Nothing
  70
  71 ifaceSigNameErr name sty
  72   = ppHang (ppStr "Bad name in an interface type signature (a Prelude name?)")
  73          4 (ppr sty name)
  74 \end{code}