\section[TcBinds]{TcBinds}
\begin{code}
-module TcBinds ( tcBindsAndThen, tcTopBinds, tcMonoBinds,
- tcSpecSigs, tcBindWithSigs ) where
+module TcBinds ( tcBindsAndThen, tcTopBinds, tcMonoBinds, tcSpecSigs ) where
#include "HsVersions.h"
\begin{code}
tcTopBinds :: RenamedHsBinds -> TcM (TcMonoBinds, TcLclEnv)
+ -- Note: returning the TcLclEnv is more than we really
+ -- want. The bit we care about is the local bindings
+ -- and the free type variables thereof
tcTopBinds binds
= tc_binds_and_then TopLevel glue binds $
getLclEnv `thenM` \ env ->
-- c) the scope of the binding group (the "in" part)
tcAddScopedTyVars (collectSigTysFromMonoBinds bind) $
- -- TYPECHECK THE SIGNATURES
- mappM tcTySig [sig | sig@(Sig name _ _) <- sigs] `thenM` \ tc_ty_sigs ->
+ tcBindWithSigs top_lvl bind sigs is_rec `thenM` \ (poly_binds, poly_ids) ->
-
- tcBindWithSigs top_lvl bind
- tc_ty_sigs sigs is_rec `thenM` \ (poly_binds, poly_ids) ->
-
- getLIE (
- -- Extend the environment to bind the new polymorphic Ids
- tcExtendLocalValEnv poly_ids $
-
- -- Build bindings and IdInfos corresponding to user pragmas
- tcSpecSigs sigs `thenM` \ prag_binds ->
-
- -- Now do whatever happens next, in the augmented envt
- do_next `thenM` \ thing ->
-
- returnM (prag_binds, thing)
- ) `thenM` \ ((prag_binds, thing), lie) ->
-
case top_lvl of
-
- -- For the top level don't bother will all this bindInstsOfLocalFuns stuff
- -- All the top level things are rec'd together anyway, so it's fine to
- -- leave them to the tcSimplifyTop, and quite a bit faster too
- TopLevel
- -> extendLIEs lie `thenM_`
+ TopLevel -- For the top level don't bother will all this
+ -- bindInstsOfLocalFuns stuff. All the top level
+ -- things are rec'd together anyway, so it's fine to
+ -- leave them to the tcSimplifyTop, and quite a bit faster too
+ --
+ -- Subtle (and ugly) point: furthermore at top level we
+ -- return the TcLclEnv, which contains the LIE var; we
+ -- don't want to return the wrong one!
+ -> tc_body poly_ids `thenM` \ (prag_binds, thing) ->
returnM (combiner (mkMonoBind Recursive (poly_binds `andMonoBinds` prag_binds))
thing)
- NotTopLevel
- -> bindInstsOfLocalFuns lie poly_ids `thenM` \ lie_binds ->
+ NotTopLevel -- For nested bindings we must do teh bindInstsOfLocalFuns thing
+ -> getLIE (tc_body poly_ids) `thenM` \ ((prag_binds, thing), lie) ->
+
-- Create specialisations of functions bound here
+ bindInstsOfLocalFuns lie poly_ids `thenM` \ lie_binds ->
-- We want to keep non-recursive things non-recursive
-- so that we desugar unlifted bindings correctly
-- aren't guaranteed in dependency order (though we could change
-- that); hence the Recursive marker.
thing)
+ where
+ tc_body poly_ids -- Type check the pragmas and "thing inside"
+ = -- Extend the environment to bind the new polymorphic Ids
+ tcExtendLocalValEnv poly_ids $
+
+ -- Build bindings and IdInfos corresponding to user pragmas
+ tcSpecSigs sigs `thenM` \ prag_binds ->
+
+ -- Now do whatever happens next, in the augmented envt
+ do_next `thenM` \ thing ->
+
+ returnM (prag_binds, thing)
\end{code}
tcBindWithSigs
:: TopLevelFlag
-> RenamedMonoBinds
- -> [TcSigInfo]
-> [RenamedSig] -- Used solely to get INLINE, NOINLINE sigs
-> RecFlag
-> TcM (TcMonoBinds, [TcId])
-tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec
- = recoverM (
+tcBindWithSigs top_lvl mbind sigs is_rec
+ = -- TYPECHECK THE SIGNATURES
+ recoverM (returnM []) (
+ mappM tcTySig [sig | sig@(Sig name _ _) <- sigs]
+ ) `thenM` \ tc_ty_sigs ->
+
+ -- SET UP THE MAIN RECOVERY; take advantage of any type sigs
+ recoverM (
-- If typechecking the binds fails, then return with each
-- signature-less binder given type (forall a.a), to minimise subsequent
-- error messages
Just sig -> tcSigPolyId sig -- Signature
Nothing -> mkLocalId name forall_a_a -- No signature
in
+ traceTc (text "tcBindsWithSigs: error recovery" <+> ppr binder_names) `thenM_`
returnM (EmptyMonoBinds, poly_ids)
) $
poly_ids = [poly_id | (_, poly_id, _) <- exports]
dict_tys = map idType zonked_dict_ids
- inlines = mkNameSet [name | InlineSig True name _ loc <- inline_sigs]
+ inlines = mkNameSet [name | InlineSig True name _ loc <- sigs]
-- Any INLINE sig (regardless of phase control)
-- makes the RHS look small
- inline_phases = listToFM [(name, phase) | InlineSig _ name phase _ <- inline_sigs,
+ inline_phases = listToFM [(name, phase) | InlineSig _ name phase _ <- sigs,
not (isAlwaysActive phase)]
-- Set the IdInfo field to control the inline phase
-- AlwaysActive is the default, so don't bother with them