+
+%************************************************************************
+%* *
+\subsection{tcMonoBind}
+%* *
+%************************************************************************
+
+@tcMonoBinds@ deals with a single @MonoBind@.
+The signatures have been dealt with already.
+
+\begin{code}
+tcMonoBinds :: RenamedMonoBinds
+ -> [TcSigInfo]
+ -> RecFlag
+ -> TcM s (TcMonoBinds,
+ LIE, -- LIE required
+ [Name], -- Bound names
+ [TcId]) -- Corresponding monomorphic bound things
+
+tcMonoBinds mbinds tc_ty_sigs is_rec
+ = tc_mb_pats mbinds `thenTc` \ (complete_it, lie_req_pat, tvs, ids, lie_avail) ->
+ let
+ id_list = bagToList ids
+ (names, mono_ids) = unzip id_list
+
+ -- This last defn is the key one:
+ -- extend the val envt with bindings for the
+ -- things bound in this group, overriding the monomorphic
+ -- ids with the polymorphic ones from the pattern
+ extra_val_env = case is_rec of
+ Recursive -> map mk_bind id_list
+ NonRecursive -> []
+ in
+ -- Don't know how to deal with pattern-bound existentials yet
+ checkTc (isEmptyBag tvs && isEmptyBag lie_avail)
+ (existentialExplode mbinds) `thenTc_`
+
+ -- *Before* checking the RHSs, but *after* checking *all* the patterns,
+ -- extend the envt with bindings for all the bound ids;
+ -- and *then* override with the polymorphic Ids from the signatures
+ -- That is the whole point of the "complete_it" stuff.
+ --
+ -- There's a further wrinkle: we have to delay extending the environment
+ -- until after we've dealt with any pattern-bound signature type variables
+ -- Consider f (x::a) = ...f...
+ -- We're going to check that a isn't unified with anything in the envt,
+ -- so f itself had better not be! So we pass the envt binding f into
+ -- complete_it, which extends the actual envt in TcMatches.tcMatch, after
+ -- dealing with the signature tyvars
+
+ complete_it extra_val_env `thenTc` \ (mbinds', lie_req_rhss) ->
+
+ returnTc (mbinds', lie_req_pat `plusLIE` lie_req_rhss, names, mono_ids)
+ where
+
+ -- This function is used when dealing with a LHS binder; we make a monomorphic
+ -- version of the Id. We check for type signatures
+ tc_pat_bndr name pat_ty
+ = case maybeSig tc_ty_sigs name of
+ Nothing
+ -> newLocalId (getOccName name) pat_ty (getSrcLoc name)
+
+ Just (TySigInfo _ _ _ _ _ mono_id _ _)
+ -> tcAddSrcLoc (getSrcLoc name) $
+ unifyTauTy (idType mono_id) pat_ty `thenTc_`
+ returnTc mono_id
+
+ mk_bind (name, mono_id) = case maybeSig tc_ty_sigs name of
+ Nothing -> (name, mono_id)
+ Just (TySigInfo name poly_id _ _ _ _ _ _) -> (name, poly_id)
+
+ tc_mb_pats EmptyMonoBinds
+ = returnTc (\ xve -> returnTc (EmptyMonoBinds, emptyLIE), emptyLIE, emptyBag, emptyBag, emptyLIE)
+
+ tc_mb_pats (AndMonoBinds mb1 mb2)
+ = tc_mb_pats mb1 `thenTc` \ (complete_it1, lie_req1, tvs1, ids1, lie_avail1) ->
+ tc_mb_pats mb2 `thenTc` \ (complete_it2, lie_req2, tvs2, ids2, lie_avail2) ->
+ let
+ complete_it xve = complete_it1 xve `thenTc` \ (mb1', lie1) ->
+ complete_it2 xve `thenTc` \ (mb2', lie2) ->
+ returnTc (AndMonoBinds mb1' mb2', lie1 `plusLIE` lie2)