ghc/compiler/typecheck/TcPolyType.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
   3 %
   4 \section[TcPolyType]{Typechecking user-specified @PolyTypes@}
   5
   6 \begin{code}
   7 module TcPolyType ( tcPolyType ) where
   8
   9 #include "HsVersions.h"
  10
  11 import TcMonad          -- typechecking monad machinery
  12 import AbsSyn           -- the stuff being typechecked
  13
  14 import AbsUniType       ( mkTyVarTemplateTy, mkSysTyVarTemplate, mkSigmaTy,
  15                           mkForallTy, SigmaType(..)
  16                         )
  17 import CE               ( CE(..) )
  18 import Maybes           ( Maybe(..) )
  19 import TCE              ( TCE(..), UniqFM )
  20 import TVE              -- ( mkTVE, plusTVE, unitTVE, lookupTVE_NoFail, TVE(..) )
  21 import TcContext        ( tcContext )
  22 import TcMonoType       ( tcMonoType )
  23 import Util
  24 \end{code}
  25
  26 The TVE passed into @tcPolyType@ binds type variables which are
  27 in scope; in practice this is always either empty (ordinary type sigs)
  28 or a singleton (class signatures).  @tcPolyType@ generates a type which
  29 is polymorphic in all the {\em other} type varaibles mentioned in the
  30 type.
  31
  32 Very Important Note: when we have a type signature in an interface, say
  33 \begin{verbatim}
  34         f :: a -> b -> a
  35 \end{verbatim}
  36 which of the following polytypes do we return?
  37 \begin{verbatim}
  38         forall a b. a -> b -> a
  39 --or
  40         forall b a. a -> b -> a
  41 \end{verbatim}
  42
  43 It makes a difference, because it affects the order in which f takes
  44 its type arguments.  Now this makes a difference in two ways:
  45 \begin{itemize}
  46 \item
  47 It's essential to get it right if an inlining for f is also exported
  48 by the interface.
  49 \item
  50 It's essential to get it right if the interface tells that there's a specialised
  51 version of f, because specialisations are known by their function-name/type-arg
  52 combinations.
  53 \end{itemize}
  54
  55 By convention, the foralls on a type read in from somewhere (notably interfaces)
  56 are
  57         {\em in alphabetical order of their type variables}
  58
  59 When printing types we make sure that we assign print-names to the forall'd type
  60 variables which are also in alphabetical order.
  61
  62 \begin{code}
  63 tcPolyType :: CE -> TCE -> TVE  -> RenamedPolyType -> Baby_TcM UniType
  64
  65 tcPolyType ce tce tve (ForAllTy tvs ty)
  66   = let
  67         new_tv_tmpls_w_uniqs = map tc_uf_tyvar_template tvs
  68         new_tv_tmpls         = map snd new_tv_tmpls_w_uniqs
  69         new_tve
  70           = foldr plusTVE tve
  71             [ unitTVE u (mkTyVarTemplateTy tv)
  72             | (u, tv) <- new_tv_tmpls_w_uniqs ]
  73     in
  74     tcMonoType ce tce new_tve ty        `thenB_Tc` \ new_ty ->
  75     returnB_Tc (mkForallTy new_tv_tmpls new_ty)
  76   where
  77     tc_uf_tyvar_template (Short u _) = (u, mkSysTyVarTemplate u SLIT("a"))
  78
  79 tcPolyType ce tce tve (OverloadedTy   ctxt ty) = tc_poly ce tce tve ctxt ty
  80 tcPolyType ce tce tve (UnoverloadedTy ty)      = tc_poly ce tce tve []   ty
  81
  82 tc_poly ce tce tve ctxt ty
  83   = let -- BUILD THE NEW TVE
  84         used_tyvar_names        = extractMonoTyNames (==) ty
  85         poly_tyvar_names        = drop_tyvars_if_in_TVE used_tyvar_names
  86
  87         -- Sort them into alphabetical order; see notes above.
  88         sorted_tyvar_names      = sortLt lt_by_string poly_tyvar_names
  89
  90         (local_tve, tyvars, _)  = mkTVE sorted_tyvar_names
  91         new_tve                 = plusTVE tve local_tve
  92     in
  93          -- TYPE CHECK THE CONTEXT AND MONOTYPE
  94     tcContext ce tce new_tve ctxt       `thenB_Tc` \ theta ->
  95     tcMonoType ce tce new_tve ty        `thenB_Tc` \ tau_ty ->
  96
  97          -- BUILD THE POLYTYPE AND RETURN
  98     returnB_Tc (mkSigmaTy tyvars theta tau_ty)
  99  where
 100     drop_tyvars_if_in_TVE [] = []
 101     drop_tyvars_if_in_TVE (n:ns)
 102       = let rest = drop_tyvars_if_in_TVE ns
 103         in
 104         case (lookupTVE_NoFail tve n) of
 105           Just _    -> rest     -- drop it
 106           Nothing   -> n : rest
 107
 108     lt_by_string :: Name -> Name -> Bool
 109     lt_by_string a b = getOccurrenceName a < getOccurrenceName b
 110 \end{code}