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