+ returnM (final_qtvs, dict_binds, sig_dicts)
+
+ where
+ tysig_names = map (idName . tcSigPolyId) sigs
+ is_mono_sig (TySigInfo _ _ theta _ _ _ _) = null theta
+
+ doc = ptext SLIT("type signature(s) for") <+> pprBinders binder_names
+
+-----------------------
+ -- CHECK THAT ALL THE SIGNATURE CONTEXTS ARE UNIFIABLE
+ -- The type signatures on a mutually-recursive group of definitions
+ -- must all have the same context (or none).
+ --
+ -- We unify them because, with polymorphic recursion, their types
+ -- might not otherwise be related. This is a rather subtle issue.
+ -- ToDo: amplify
+checkSigsCtxts sigs@(TySigInfo id1 sig_tvs theta1 _ _ _ src_loc : other_sigs)
+ = addSrcLoc src_loc $
+ mappM_ check_one other_sigs `thenM_`
+ if null theta1 then
+ returnM ([], []) -- Non-overloaded type signatures
+ else
+ newDicts SignatureOrigin theta1 `thenM` \ sig_dicts ->
+ let
+ -- The "sig_avails" is the stuff available. We get that from
+ -- the context of the type signature, BUT ALSO the lie_avail
+ -- so that polymorphic recursion works right (see comments at end of fn)
+ sig_avails = sig_dicts ++ sig_meths
+ in
+ returnM (sig_avails, map instToId sig_dicts)
+ where
+ sig1_dict_tys = map mkPredTy theta1
+ sig_meths = concat [insts | TySigInfo _ _ _ _ _ insts _ <- sigs]
+
+ check_one sig@(TySigInfo id _ theta _ _ _ _)
+ = addErrCtxt (sigContextsCtxt id1 id) $
+ checkTc (equalLength theta theta1) sigContextsErr `thenM_`
+ unifyTauTyLists sig1_dict_tys (map mkPredTy theta)
+
+checkSigsTyVars :: [TcTyVar] -> [TcSigInfo] -> TcM [TcTyVar]
+checkSigsTyVars qtvs sigs
+ = mappM check_one sigs `thenM` \ sig_tvs_s ->
+ let
+ -- Sigh. Make sure that all the tyvars in the type sigs
+ -- appear in the returned ty var list, which is what we are
+ -- going to generalise over. Reason: we occasionally get
+ -- silly types like
+ -- type T a = () -> ()
+ -- f :: T a
+ -- f () = ()
+ -- Here, 'a' won't appear in qtvs, so we have to add it
+
+ sig_tvs = foldr (unionVarSet . mkVarSet) emptyVarSet sig_tvs_s
+ all_tvs = mkVarSet qtvs `unionVarSet` sig_tvs
+ in
+ returnM (varSetElems all_tvs)
+ where
+ check_one (TySigInfo id sig_tyvars sig_theta sig_tau _ _ src_loc)
+ = addSrcLoc src_loc $
+ addErrCtxt (ptext SLIT("When checking the type signature for")
+ <+> quotes (ppr id)) $
+ addErrCtxtM (sigCtxt id sig_tyvars sig_theta sig_tau) $
+ checkSigTyVarsWrt (idFreeTyVars id) sig_tyvars
+\end{code}
+
+@getTyVarsToGen@ decides what type variables to generalise over.
+
+For a "restricted group" -- see the monomorphism restriction
+for a definition -- we bind no dictionaries, and
+remove from tyvars_to_gen any constrained type variables
+
+*Don't* simplify dicts at this point, because we aren't going
+to generalise over these dicts. By the time we do simplify them
+we may well know more. For example (this actually came up)
+ f :: Array Int Int
+ f x = array ... xs where xs = [1,2,3,4,5]
+We don't want to generate lots of (fromInt Int 1), (fromInt Int 2)
+stuff. If we simplify only at the f-binding (not the xs-binding)
+we'll know that the literals are all Ints, and we can just produce
+Int literals!
+
+Find all the type variables involved in overloading, the
+"constrained_tyvars". These are the ones we *aren't* going to
+generalise. We must be careful about doing this:
+
+ (a) If we fail to generalise a tyvar which is not actually
+ constrained, then it will never, ever get bound, and lands
+ up printed out in interface files! Notorious example:
+ instance Eq a => Eq (Foo a b) where ..
+ Here, b is not constrained, even though it looks as if it is.
+ Another, more common, example is when there's a Method inst in
+ the LIE, whose type might very well involve non-overloaded
+ type variables.
+ [NOTE: Jan 2001: I don't understand the problem here so I'm doing
+ the simple thing instead]
+
+ (b) On the other hand, we mustn't generalise tyvars which are constrained,
+ because we are going to pass on out the unmodified LIE, with those
+ tyvars in it. They won't be in scope if we've generalised them.
+
+So we are careful, and do a complete simplification just to find the
+constrained tyvars. We don't use any of the results, except to
+find which tyvars are constrained.
+
+\begin{code}
+isUnRestrictedGroup :: [Name] -- Signatures given for these
+ -> RenamedMonoBinds
+ -> Bool
+
+is_elem v vs = isIn "isUnResMono" v vs
+
+isUnRestrictedGroup sigs (PatMonoBind other _ _) = False
+isUnRestrictedGroup sigs (VarMonoBind v _) = v `is_elem` sigs
+isUnRestrictedGroup sigs (FunMonoBind v _ matches _) = isUnRestrictedMatch matches ||
+ v `is_elem` sigs
+isUnRestrictedGroup sigs (AndMonoBinds mb1 mb2) = isUnRestrictedGroup sigs mb1 &&
+ isUnRestrictedGroup sigs mb2
+isUnRestrictedGroup sigs EmptyMonoBinds = True
+
+isUnRestrictedMatch (Match [] _ _ : _) = False -- No args => like a pattern binding
+isUnRestrictedMatch other = True -- Some args => a function binding