ghc/compiler/typecheck/TcBinds.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[TcBinds]{TcBinds}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module TcBinds (
  10         tcTopBindsAndThen, tcLocalBindsAndThen,
  11         tcSigs, doSpecPragma
  12     ) where
  13
  14 --IMPORT_Trace          -- ToDo:rm (debugging)
  15
  16 import TcMonad          -- typechecking monad machinery
  17 import TcMonadFns       ( newLocalsWithOpenTyVarTys,
  18                           newLocalsWithPolyTyVarTys,
  19                           newSpecPragmaId, newSpecId,
  20                           applyTcSubstAndCollectTyVars
  21                         )
  22 import AbsSyn           -- the stuff being typechecked
  23
  24 import AbsUniType       ( isTyVarTy, isGroundTy, isUnboxedDataType,
  25                           isGroundOrTyVarTy, extractTyVarsFromTy,
  26                           UniType
  27                         )
  28 import BackSubst        ( applyTcSubstToBinds )
  29 import E
  30 import Errors           ( topLevelUnboxedDeclErr, specGroundnessErr,
  31                           specCtxtGroundnessErr, Error(..), UnifyErrContext(..)
  32                         )
  33 import GenSpecEtc       ( checkSigTyVars, genBinds, SignatureInfo(..) )
  34 import Id               ( getIdUniType, mkInstId )
  35 import IdInfo           ( SpecInfo(..) )
  36 import Inst
  37 import LIE              ( nullLIE, mkLIE, plusLIE, LIE )
  38 import Maybes           ( assocMaybe, catMaybes, Maybe(..) )
  39 import Spec             ( specTy )
  40 import TVE              ( nullTVE, TVE(..), UniqFM )
  41 import TcMonoBnds       ( tcMonoBinds )
  42 import TcPolyType       ( tcPolyType )
  43 import TcSimplify       ( bindInstsOfLocalFuns )
  44 import Unify            ( unifyTauTy )
  45 import UniqFM           ( emptyUFM ) -- profiling, pragmas only
  46 import Util
  47 \end{code}
  48
  49 %************************************************************************
  50 %*                                                                      *
  51 \subsection{Type-checking top-level bindings}
  52 %*                                                                      *
  53 %************************************************************************
  54
  55 @tcBindsAndThen@ takes a boolean which indicates whether the binding
  56 group is at top level or not.  The difference from inner bindings is
  57 that
  58 \begin{enumerate}
  59 \item
  60 we zero the substitution before each group
  61 \item
  62 we back-substitute after each group.
  63 \end{enumerate}
  64 We still return an LIE, but it is sure to contain nothing but constant
  65 dictionaries, which we resolve at the module level.
  66
  67 @tcTopBinds@ returns an LVE, not, as you might expect, a GVE.  Why?
  68 Because the monomorphism restriction means that is might return some
  69 monomorphic things, with free type variables.  Hence it must be an LVE.
  70
  71 The LIE returned by @tcTopBinds@ may constrain some type variables,
  72 but they are guaranteed to be a subset of those free in the
  73 corresponding returned LVE.
  74
  75 %************************************************************************
  76 %*                                                                      *
  77 \subsection{Type-checking bindings}
  78 %*                                                                      *
  79 %************************************************************************
  80
  81 @tcBindsAndThen@ typechecks a @Binds@.  The "and then" part is because
  82 it needs to know something about the {\em usage} of the things bound,
  83 so that it can create specialisations of them.  So @tcBindsAndThen@
  84 takes a function which, given an extended environment, E, typechecks
  85 the scope of the bindings returning a typechecked thing and (most
  86 important) an LIE.  It is this LIE which is then used as the basis for
  87 specialising the things bound.
  88
  89 @tcBindsAndThen@ also takes a "combiner" which glues together the
  90 bindings and the "thing" to make a new "thing".
  91
  92 The real work is done by @tcBindAndThen@.
  93
  94 Recursive and non-recursive binds are handled in essentially the same
  95 way: because of uniques there are no scoping issues left.  The only
  96 difference is that non-recursive bindings can bind primitive values.
  97
  98 Even for non-recursive binding groups we add typings for each binder
  99 to the LVE for the following reason.  When each individual binding is
 100 checked the type of its LHS is unified with that of its RHS; and
 101 type-checking the LHS of course requires that the binder is in scope.
 102
 103 \begin{code}
 104 tcBindsAndThen
 105         :: Bool
 106         -> E
 107         -> (TypecheckedBinds -> thing -> thing)         -- Combinator
 108         -> RenamedBinds
 109         -> (E -> TcM (thing, LIE, thing_ty))
 110         -> TcM (thing, LIE, thing_ty)
 111
 112 tcBindsAndThen top_level e combiner EmptyBinds do_next
 113   = do_next e           `thenTc` \ (thing, lie, thing_ty) ->
 114     returnTc (combiner EmptyBinds thing, lie, thing_ty)
 115
 116 tcBindsAndThen top_level e combiner (SingleBind bind) do_next
 117   = tcBindAndThen top_level e combiner bind [] do_next
 118
 119 tcBindsAndThen top_level e combiner (BindWith bind sigs) do_next
 120   = tcBindAndThen top_level e combiner bind sigs do_next
 121
 122 tcBindsAndThen top_level e combiner (ThenBinds binds1 binds2) do_next
 123   = tcBindsAndThen top_level e combiner binds1 new_after
 124   where
 125     -- new_after :: E -> TcM (thing, LIE, thing_ty)
 126     -- Can't write this signature, cos it's monomorphic in thing and
 127     -- thing_ty.
 128     new_after e = tcBindsAndThen top_level e combiner binds2 do_next
 129 \end{code}
 130
 131 Simple wrappers for export:
 132 \begin{code}
 133 tcTopBindsAndThen
 134         :: E
 135         -> (TypecheckedBinds -> thing -> thing)         -- Combinator
 136         -> RenamedBinds
 137         -> (E -> TcM (thing, LIE, anything))
 138         -> TcM (thing, LIE, anything)
 139
 140 tcTopBindsAndThen e combiner binds do_next
 141   = tcBindsAndThen True e combiner binds do_next
 142
 143 tcLocalBindsAndThen
 144         :: E
 145         -> (TypecheckedBinds -> thing -> thing)         -- Combinator
 146         -> RenamedBinds
 147         -> (E -> TcM (thing, LIE, thing_ty))
 148         -> TcM (thing, LIE, thing_ty)
 149
 150 tcLocalBindsAndThen e combiner binds do_next
 151   = tcBindsAndThen False e combiner  binds do_next
 152 \end{code}
 153
 154 An aside.  The original version of @tcBindsAndThen@ which lacks a
 155 combiner function, appears below.  Though it is perfectly well
 156 behaved, it cannot be typed by Haskell, because the recursive call is
 157 at a different type to the definition itself.  There aren't too many
 158 examples of this, which is why I thought it worth preserving! [SLPJ]
 159
 160 \begin{pseudocode}
 161 tcBindsAndThen
 162         :: Bool -> E -> RenamedBinds
 163         -> (E -> TcM (thing, LIE, thing_ty))
 164         -> TcM ((TypecheckedBinds, thing), LIE, thing_ty)
 165
 166 tcBindsAndThen top_level e EmptyBinds do_next
 167   = do_next e           `thenTc` \ (thing, lie, thing_ty) ->
 168     returnTc ((EmptyBinds, thing), lie, thing_ty)
 169
 170 tcBindsAndThen top_level e (SingleBind bind) do_next
 171   = tcBindAndThen top_level e bind [] do_next
 172
 173 tcBindsAndThen top_level e (BindWith bind sigs) do_next
 174   = tcBindAndThen top_level e bind sigs do_next
 175
 176 tcBindsAndThen top_level e (ThenBinds binds1 binds2) do_next
 177   = tcBindsAndThen top_level e binds1 new_after
 178         `thenTc` \ ((binds1', (binds2', thing')), lie1, thing_ty) ->
 179
 180     returnTc ((binds1' `ThenBinds` binds2', thing'), lie1, thing_ty)
 181
 182   where
 183     -- new_after :: E -> TcM ((TypecheckedBinds, thing), LIE, thing_ty)
 184     -- Can't write this signature, cos it's monomorphic in thing and thing_ty
 185     new_after e = tcBindsAndThen top_level e binds2 do_next
 186 \end{pseudocode}
 187
 188 %************************************************************************
 189 %*                                                                      *
 190 \subsection{Bind}
 191 %*                                                                      *
 192 %************************************************************************
 193
 194 \begin{code}
 195 tcBindAndThen
 196         :: Bool                                           -- At top level
 197         -> E
 198         -> (TypecheckedBinds -> thing -> thing)           -- Combinator
 199         -> RenamedBind                                    -- The Bind to typecheck
 200         -> [RenamedSig]                                   -- ...and its signatures
 201         -> (E -> TcM (thing, LIE, thing_ty))              -- Thing to type check in
 202                                                           -- augmented envt
 203         -> TcM (thing, LIE, thing_ty)                     -- Results, incl the
 204
 205 tcBindAndThen top_level e combiner bind sigs do_next
 206   =     -- Deal with the bind
 207     tcBind top_level e bind sigs    `thenTc` \ (poly_binds, poly_lie, poly_lve) ->
 208
 209         -- Now do whatever happens next, in the augmented envt
 210     do_next (growE_LVE e poly_lve)  `thenTc` \ (thing, thing_lie, thing_ty) ->
 211     let
 212         bound_ids = map snd poly_lve
 213     in
 214         -- Create specialisations
 215     specialiseBinds bound_ids thing_lie poly_binds poly_lie
 216                                     `thenNF_Tc` \ (final_binds, final_lie) ->
 217         -- All done
 218     returnTc (combiner final_binds thing, final_lie, thing_ty)
 219 \end{code}
 220
 221 \begin{code}
 222 tcBind :: Bool -> E
 223        -> RenamedBind -> [RenamedSig]
 224        -> TcM (TypecheckedBinds, LIE, LVE)      -- LIE is a fixed point of substitution
 225
 226 tcBind False e bind sigs                        -- Not top level
 227   = tcBind_help False e bind sigs
 228
 229 tcBind True  e bind sigs                        -- Top level!
 230   = pruneSubstTc (tvOfE e) (
 231
 232          -- DO THE WORK
 233     tcBind_help True e bind sigs        `thenTc` \ (new_binds, lie, lve) ->
 234
 235 {-  Top-level unboxed values are now allowed
 236     They will be lifted by the Desugarer (see CoreLift.lhs)
 237
 238         -- CHECK FOR PRIMITIVE TOP-LEVEL BINDS
 239         listTc [ checkTc (isUnboxedDataType (getIdUniType id))
 240                          (topLevelUnboxedDeclErr id (getSrcLoc id))
 241                | (_,id) <- lve ]        `thenTc_`
 242 -}
 243
 244     -- Back-substitute over the binds, since we are about to discard
 245     -- a good chunk of the substitution.
 246     applyTcSubstToBinds new_binds       `thenNF_Tc` \ final_binds ->
 247
 248     -- The lie is already a fixed point of the substitution; it just turns out
 249     -- that almost always this happens automatically, and so we made it part of
 250     -- the specification of genBinds.
 251     returnTc (final_binds, lie, lve)
 252     )
 253 \end{code}
 254
 255 \begin{code}
 256 tcBind_help top_level e bind sigs
 257   =     -- Create an LVE binding each identifier to an appropriate type variable
 258     new_locals binders          `thenNF_Tc` \ bound_ids ->
 259     let  lve = binders `zip` bound_ids  in
 260
 261         -- Now deal with type signatures, if any
 262     tcSigs e lve sigs           `thenTc`    \ sig_info ->
 263
 264         -- Check the bindings: this is the point at which we can use
 265         -- error recovery.  If checking the bind fails we just
 266         -- return the empty bindings.  The variables will still be in
 267         -- scope, but bound to completely free type variables, which
 268         -- is just what we want to minimise subsequent error messages.
 269     recoverTc (NonRecBind EmptyMonoBinds, nullLIE)
 270               (tc_bind (growE_LVE e lve) bind)  `thenNF_Tc` \ (bind', lie) ->
 271
 272         -- Notice that genBinds gets the old (non-extended) environment
 273     genBinds top_level e bind' lie lve sig_info `thenTc` \ (binds', lie, lve) ->
 274
 275         -- Add bindings corresponding to SPECIALIZE pragmas in the code
 276     mapAndUnzipTc (doSpecPragma e (assoc "doSpecPragma" lve))
 277                   (get_spec_pragmas sig_info)
 278                         `thenTc` \ (spec_binds_s, spec_lie_s) ->
 279
 280     returnTc (binds' `ThenBinds` (SingleBind (NonRecBind (
 281                 foldr AndMonoBinds EmptyMonoBinds spec_binds_s))),
 282               lie `plusLIE` (foldr plusLIE nullLIE spec_lie_s),
 283               lve)
 284   where
 285     binders = collectBinders bind
 286
 287     new_locals binders
 288       = case bind of
 289           NonRecBind _ -> -- Recursive, so no unboxed types
 290                           newLocalsWithOpenTyVarTys binders
 291
 292           RecBind _    -> -- Non-recursive, so we permit unboxed types
 293                           newLocalsWithPolyTyVarTys binders
 294
 295     get_spec_pragmas sig_info
 296       = catMaybes (map get_pragma_maybe sig_info)
 297       where
 298         get_pragma_maybe s@(ValSpecInfo _ _ _ _) = Just s
 299         get_pragma_maybe _                       = Nothing
 300 \end{code}
 301
 302 \begin{verbatim}
 303         f :: Ord a => [a] -> b -> b
 304         {-# SPECIALIZE f :: [Int] -> b -> b #-}
 305 \end{verbatim}
 306 We generate:
 307 \begin{verbatim}
 308         f@Int = /\ b -> let d1 = ...
 309                         in f Int b d1
 310
 311
 312         h :: Ord a => [a] -> b -> b
 313         {-# SPECIALIZE h :: [Int] -> b -> b #-}
 314
 315         spec_h = /\b -> h [Int] b dListOfInt
 316                         ^^^^^^^^^^^^^^^^^^^^ This bit created by specId
 317 \end{verbatim}
 318
 319 \begin{code}
 320 doSpecPragma :: E
 321              -> (Name -> Id)
 322              -> SignatureInfo
 323              -> TcM (TypecheckedMonoBinds, LIE)
 324
 325 doSpecPragma e name_to_id (ValSpecInfo name spec_ty using src_loc)
 326   = let
 327         main_id = name_to_id name    -- Get the parent Id
 328
 329         main_id_ty = getIdUniType main_id
 330         main_id_free_tyvars = extractTyVarsFromTy main_id_ty
 331         origin = ValSpecOrigin name src_loc
 332         err_ctxt = ValSpecSigCtxt name spec_ty src_loc
 333     in
 334     addSrcLocTc src_loc          (
 335     specTy origin spec_ty `thenNF_Tc` \ (spec_tyvars, spec_dicts, spec_tau) ->
 336
 337         -- Check that the SPECIALIZE pragma had an empty context
 338     checkTc (not (null spec_dicts))
 339             (panic "SPECIALIZE non-empty context (ToDo: msg)") `thenTc_`
 340
 341         -- Make an instance of this id
 342     specTy origin main_id_ty `thenNF_Tc` \ (main_tyvars, main_dicts, main_tau) ->
 343
 344         -- Check that the specialised type is indeed an instance of
 345         -- the inferred type.
 346         -- The unification should leave all type vars which are
 347         -- currently free in the environment still free, and likewise
 348         -- the signature type vars.
 349         -- The only way type vars free in the envt could possibly be affected
 350         -- is if main_id_ty has free type variables.  So we just extract them,
 351         -- and check that they are not constrained in any way by the unification.
 352     applyTcSubstAndCollectTyVars main_id_free_tyvars  `thenNF_Tc` \ free_tyvars' ->
 353     unifyTauTy spec_tau main_tau err_ctxt   `thenTc_`
 354     checkSigTyVars [] (spec_tyvars ++ free_tyvars')
 355                    spec_tau main_tau err_ctxt `thenTc_`
 356
 357         -- Check that the type variables of the polymorphic function are
 358         -- either left polymorphic, or instantiate to ground type.
 359         -- Also check that the overloaded type variables are instantiated to
 360         -- ground type; or equivalently that all dictionaries have ground type
 361     applyTcSubstToTyVars main_tyvars    `thenNF_Tc` \ main_arg_tys ->
 362     applyTcSubstToInsts  main_dicts     `thenNF_Tc` \ main_dicts' ->
 363
 364     checkTc (not (all isGroundOrTyVarTy main_arg_tys))
 365             (specGroundnessErr err_ctxt main_arg_tys)
 366                                         `thenTc_`
 367
 368     checkTc (not (and [isGroundTy ty | (_,ty) <- map getDictClassAndType main_dicts']))
 369             (specCtxtGroundnessErr err_ctxt main_dicts')
 370                                         `thenTc_`
 371
 372         -- Build a suitable binding; depending on whether we were given
 373         -- a value (Maybe Name) to be used as the specialisation.
 374     case using of
 375       Nothing ->
 376
 377             -- Make a specPragmaId to which to bind the new call-instance
 378         newSpecPragmaId name spec_ty Nothing
 379                                         `thenNF_Tc` \ pseudo_spec_id ->
 380         let
 381             pseudo_bind = VarMonoBind pseudo_spec_id pseudo_rhs
 382             pseudo_rhs  = mkTyLam spec_tyvars (mkDictApp (mkTyApp (Var main_id) main_arg_tys)
 383                                                          (map mkInstId main_dicts'))
 384         in
 385         returnTc (pseudo_bind, mkLIE main_dicts')
 386
 387       Just spec_name -> -- use spec_name as the specialisation value ...
 388         let
 389             spec_id      = lookupE_Value e spec_name
 390             spec_id_ty   = getIdUniType spec_id
 391
 392             spec_id_free_tyvars = extractTyVarsFromTy spec_id_ty
 393             spec_id_ctxt = ValSpecSpecIdCtxt name spec_ty spec_name src_loc
 394
 395             spec_tys    = map maybe_ty main_arg_tys
 396             maybe_ty ty | isTyVarTy ty = Nothing
 397                         | otherwise    = Just ty
 398         in
 399             -- Make an instance of the spec_id
 400         specTy origin spec_id_ty `thenNF_Tc` \ (spec_id_tyvars, spec_id_dicts, spec_id_tau) ->
 401
 402             -- Check that the specialised type is indeed an instance of
 403             -- the type inferred for spec_id
 404             -- The unification should leave all type vars which are
 405             -- currently free in the environment still free, and likewise
 406             -- the signature type vars.
 407             -- The only way type vars free in the envt could possibly be affected
 408             -- is if spec_id_ty has free type variables.  So we just extract them,
 409             -- and check that they are not constrained in any way by the unification.
 410         applyTcSubstAndCollectTyVars spec_id_free_tyvars  `thenNF_Tc` \ spec_id_free_tyvars' ->
 411         unifyTauTy spec_tau spec_id_tau spec_id_ctxt      `thenTc_`
 412         checkSigTyVars [] (spec_tyvars ++ spec_id_free_tyvars')
 413                        spec_tau spec_id_tau spec_id_ctxt  `thenTc_`
 414
 415             -- Check that the type variables of the explicit spec_id are
 416             -- either left polymorphic, or instantiate to ground type.
 417             -- Also check that the overloaded type variables are instantiated to
 418             -- ground type; or equivalently that all dictionaries have ground type
 419         applyTcSubstToTyVars spec_id_tyvars     `thenNF_Tc` \ spec_id_arg_tys ->
 420         applyTcSubstToInsts  spec_id_dicts      `thenNF_Tc` \ spec_id_dicts' ->
 421
 422         checkTc (not (all isGroundOrTyVarTy spec_id_arg_tys))
 423                 (specGroundnessErr spec_id_ctxt spec_id_arg_tys)
 424                                                 `thenTc_`
 425
 426         checkTc (not (and [isGroundTy ty | (_,ty) <- map getDictClassAndType spec_id_dicts']))
 427                 (specCtxtGroundnessErr spec_id_ctxt spec_id_dicts')
 428                                                 `thenTc_`
 429
 430             -- Make a local SpecId to bind to applied spec_id
 431         newSpecId main_id spec_tys spec_ty      `thenNF_Tc` \ local_spec_id ->
 432
 433             -- Make a specPragmaId id with a spec_info for local_spec_id
 434             -- This is bound to local_spec_id
 435             -- The SpecInfo will be extracted by the specialiser and
 436             -- used to create a call instance for main_id (which is
 437             -- extracted from the spec_id)
 438             -- NB: the pseudo_local_id must stay in the scope of main_id !!!
 439         let
 440             spec_info = SpecInfo spec_tys (length main_dicts') local_spec_id
 441         in
 442         newSpecPragmaId name spec_ty (Just spec_info)   `thenNF_Tc` \ pseudo_spec_id ->
 443         let
 444             spec_bind   = VarMonoBind local_spec_id spec_rhs
 445             spec_rhs    = mkTyLam spec_tyvars (mkDictApp (mkTyApp (Var spec_id) spec_id_arg_tys)
 446                                                          (map mkInstId spec_id_dicts'))
 447             pseudo_bind = VarMonoBind pseudo_spec_id (Var local_spec_id)
 448         in
 449         returnTc (spec_bind `AndMonoBinds` pseudo_bind, mkLIE spec_id_dicts')
 450     )
 451 \end{code}
 452
 453 \begin{code}
 454 tc_bind :: E
 455         -> RenamedBind
 456         -> TcM (TypecheckedBind, LIE)
 457
 458 tc_bind e (NonRecBind mono_binds)
 459   = tcMonoBinds e mono_binds    `thenTc` \ (mono_binds2, lie) ->
 460     returnTc  (NonRecBind mono_binds2, lie)
 461
 462 tc_bind e (RecBind mono_binds)
 463   = tcMonoBinds e mono_binds    `thenTc` \ (mono_binds2, lie) ->
 464     returnTc  (RecBind mono_binds2, lie)
 465 \end{code}
 466
 467 \begin{code}
 468 specialiseBinds
 469         :: [Id]                 -- Ids bound in this group
 470         -> LIE                  -- LIE of scope of these bindings
 471         -> TypecheckedBinds
 472         -> LIE
 473         -> NF_TcM (TypecheckedBinds, LIE)
 474
 475 specialiseBinds bound_ids lie_of_scope poly_binds poly_lie
 476   = bindInstsOfLocalFuns lie_of_scope bound_ids
 477                                         `thenNF_Tc` \ (lie2, inst_mbinds) ->
 478
 479     returnNF_Tc (poly_binds `ThenBinds` (SingleBind (NonRecBind inst_mbinds)),
 480                  lie2 `plusLIE` poly_lie)
 481 \end{code}
 482
 483 %************************************************************************
 484 %*                                                                      *
 485 \subsection{Signatures}
 486 %*                                                                      *
 487 %************************************************************************
 488
 489 @tcSigs@ checks the signatures for validity, and returns a list of
 490 {\em freshly-instantiated} signatures.  That is, the types are already
 491 split up, and have fresh type variables (not @TyVarTemplate@s)
 492 installed.
 493
 494 \begin{code}
 495 tcSigs :: E -> LVE
 496        -> [RenamedSig]
 497        -> TcM [SignatureInfo]
 498
 499 tcSigs e lve [] = returnTc []
 500
 501 tcSigs e lve (s:ss)
 502   = tc_sig       s      `thenTc` \ sig_info1 ->
 503     tcSigs e lve ss     `thenTc` \ sig_info2 ->
 504     returnTc (sig_info1 : sig_info2)
 505   where
 506     tc_sig (Sig v ty _ src_loc) -- no interesting pragmas on non-iface sigs
 507       = addSrcLocTc src_loc (
 508
 509         babyTcMtoTcM
 510           (tcPolyType (getE_CE e) (getE_TCE e) nullTVE ty) `thenTc` \ sigma_ty ->
 511
 512         let  val = assoc "tcSigs" lve v  in
 513             -- (The renamer/dependency-analyser should have ensured
 514             -- that there are only signatures for which there is a
 515             -- corresponding binding.)
 516
 517             -- Instantiate the type, and unify with the type variable
 518             -- found in the Id.
 519         specTy SignatureOrigin sigma_ty `thenNF_Tc` \ (tyvars, dicts, tau_ty) ->
 520         unifyTauTy (getIdUniType val) tau_ty
 521                    (panic "ToDo: unifyTauTy(tcSigs)") `thenTc_`
 522
 523         returnTc (TySigInfo val tyvars dicts tau_ty src_loc)
 524         )
 525
 526     tc_sig (SpecSig v ty using src_loc)
 527       = addSrcLocTc src_loc (
 528
 529         babyTcMtoTcM
 530           (tcPolyType (getE_CE e) (getE_TCE e) nullTVE ty) `thenTc` \ sigma_ty ->
 531
 532         returnTc (ValSpecInfo v sigma_ty using src_loc)
 533         )
 534
 535     tc_sig (InlineSig v guide locn)
 536       = returnTc (ValInlineInfo v guide locn)
 537
 538     tc_sig (DeforestSig v locn)
 539       = returnTc (ValDeforestInfo v locn)
 540
 541     tc_sig (MagicUnfoldingSig v str locn)
 542       = returnTc (ValMagicUnfoldingInfo v str locn)
 543 \end{code}