-tcTySigs :: [LSig Name] -> TcM [TcSigInfo]
--- The trick here is that all the signatures should have the same
--- context, and we want to share type variables for that context, so that
--- all the right hand sides agree a common vocabulary for their type
--- constraints
-tcTySigs [] = return []
-tcTySigs (L span (Sig (L _ name) ty) : sigs)
- = do { -- Typecheck the first signature
- ; sigma1 <- setSrcSpan span $
- tcHsSigType (FunSigCtxt name) ty
- ; let id1 = mkLocalId name sigma1
- ; tc_sig1 <- mkTcSig id1
-
- ; tc_sigs <- mapM (tcTySig tc_sig1) sigs
- ; return (tc_sig1 : tc_sigs) }
-
-tcTySig sig1 (L span (Sig (L _ name) ty))
- = setSrcSpan span $
- do { sigma_ty <- tcHsSigType (FunSigCtxt name) ty
- ; (tvs, theta, tau) <- tcSkolType rigid_info sigma_ty
- ; let poly_id = mkLocalId name sigma_ty
- bale_out = failWithTc $
- sigContextsErr (sig_id sig1) name sigma_ty
-
- -- Try to match the context of this signature with
- -- that of the first signature
- ; case tcMatchPreds tvs (sig_theta sig1) theta of {
- Nothing -> bale_out
- ; Just tenv -> do
- ; case check_tvs tenv tvs of
- Nothing -> bale_out
- Just tvs' -> do {
-
- let subst = mkTvSubst tenv
- theta' = substTheta subst theta
- tau' = substTy subst tau
- ; loc <- getInstLoc (SigOrigin rigid_info)
- ; return (TcSigInfo { sig_id = poly_id, sig_tvs = tvs',
- sig_theta = theta', sig_tau = tau',
- sig_loc = loc }) }}}
- where
- rigid_info = SigSkol name
-
- -- Rather tedious check that the type variables
- -- have been matched only with another type variable,
- -- and that two type variables have not been matched
- -- with the same one
- -- A return of Nothing indicates that one of the bad
- -- things has happened
- check_tvs :: TvSubstEnv -> [TcTyVar] -> Maybe [TcTyVar]
- check_tvs tenv [] = Just []
- check_tvs tenv (tv:tvs)
- | Just ty <- lookupVarEnv tenv tv
- = do { tv' <- tcGetTyVar_maybe ty
- ; tvs' <- check_tvs tenv tvs
- ; if tv' `elem` tvs'
- then Nothing
- else Just (tv':tvs') }
- | otherwise
- = do { tvs' <- check_tvs tenv tvs
- ; Just (tv:tvs') }
-\end{code}
-
-\begin{code}
-generalise :: Bool -> [MonoBindInfo] -> [TcSigInfo] -> [Inst]