- sig_names = [name | (TySigInfo name _ _ _ _ _) <- tc_ty_sigs]
- sig_ids = [id | (TySigInfo _ id _ _ _ _) <- tc_ty_sigs]
-
- tc_mono_binds EmptyMonoBinds = returnTc (EmptyMonoBinds, emptyLIE)
-
- tc_mono_binds (AndMonoBinds mb1 mb2)
- = tc_mono_binds mb1 `thenTc` \ (mb1a, lie1) ->
- tc_mono_binds mb2 `thenTc` \ (mb2a, lie2) ->
- returnTc (AndMonoBinds mb1a mb2a, lie1 `plusLIE` lie2)
-
- tc_mono_binds (FunMonoBind name inf matches locn)
- = tcAddSrcLoc locn $
- tcLookupLocalValueOK "tc_mono_binds" name `thenNF_Tc` \ id ->
-
- -- Before checking the RHS, extend the envt with
- -- bindings for the *polymorphic* Ids from any type signatures
- tcExtendLocalValEnv sig_names sig_ids $
- tcMatchesFun name (idType id) matches `thenTc` \ (matches', lie) ->
-
- returnTc (FunMonoBind (TcId id) inf matches' locn, lie)
-
- tc_mono_binds bind@(PatMonoBind pat grhss_and_binds locn)
- = tcAddSrcLoc locn $
- tcAddErrCtxt (patMonoBindsCtxt bind) $
- tcPat pat `thenTc` \ (pat2, lie_pat, pat_ty) ->
-
- -- Before checking the RHS, but after the pattern, extend the envt with
- -- bindings for the *polymorphic* Ids from any type signatures
- tcExtendLocalValEnv sig_names sig_ids $
- tcGRHSsAndBinds pat_ty grhss_and_binds `thenTc` \ (grhss_and_binds2, lie) ->
- returnTc (PatMonoBind pat2 grhss_and_binds2 locn,
- plusLIE lie_pat lie)
-\end{code}
-
-%************************************************************************
-%* *
-\subsection{Signatures}
-%* *
-%************************************************************************
-
-@tcSigs@ checks the signatures for validity, and returns a list of
-{\em freshly-instantiated} signatures. That is, the types are already
-split up, and have fresh type variables installed. All non-type-signature
-"RenamedSigs" are ignored.
-
-The @TcSigInfo@ contains @TcTypes@ because they are unified with
-the variable's type, and after that checked to see whether they've
-been instantiated.
-
-\begin{code}
-data TcSigInfo s
- = TySigInfo
- Name -- N, the Name in corresponding binding
- (TcIdBndr s) -- *Polymorphic* binder for this value...
- -- Usually has name = N, but doesn't have to.
- [TcTyVar s]
- (TcThetaType s)
- (TcTauType s)
- SrcLoc
-
-
-maybeSig :: [TcSigInfo s] -> Name -> Maybe (TcSigInfo s)
- -- Search for a particular signature
-maybeSig [] name = Nothing
-maybeSig (sig@(TySigInfo sig_name _ _ _ _ _) : sigs) name
- | name == sig_name = Just sig
- | otherwise = maybeSig sigs name
-\end{code}
-
-
-\begin{code}
-tcTySig :: RenamedSig
- -> TcM s (TcSigInfo s)
-
-tcTySig (Sig v ty src_loc)
- = tcAddSrcLoc src_loc $
- tcHsType ty `thenTc` \ sigma_ty ->
-
- -- Convert from Type to TcType
- tcInstSigType sigma_ty `thenNF_Tc` \ sigma_tc_ty ->
- let
- poly_id = mkUserId v sigma_tc_ty
- in
- -- Instantiate this type
- -- It's important to do this even though in the error-free case
- -- we could just split the sigma_tc_ty (since the tyvars don't
- -- unified with anything). But in the case of an error, when
- -- the tyvars *do* get unified with something, we want to carry on
- -- typechecking the rest of the program with the function bound
- -- to a pristine type, namely sigma_tc_ty
- tcInstSigTcType sigma_tc_ty `thenNF_Tc` \ (tyvars, rho) ->
- let
- (theta, tau) = splitRhoTy rho
- -- This splitSigmaTy tries hard to make sure that tau' is a type synonym
- -- wherever possible, which can improve interface files.
- in
- returnTc (TySigInfo v poly_id tyvars theta tau src_loc)
-\end{code}
-
-@checkSigMatch@ does the next step in checking signature matching.
-The tau-type part has already been unified. What we do here is to
-check that this unification has not over-constrained the (polymorphic)
-type variables of the original signature type.
-
-The error message here is somewhat unsatisfactory, but it'll do for
-now (ToDo).
-
-\begin{code}
-checkSigMatch []
- = returnTc (error "checkSigMatch")
-
-checkSigMatch tc_ty_sigs@( sig1@(TySigInfo _ id1 _ theta1 _ _) : all_sigs_but_first )
- = -- CHECK THAT THE SIGNATURE TYVARS AND TAU_TYPES ARE OK
- -- Doesn't affect substitution
- mapTc check_one_sig tc_ty_sigs `thenTc_`
-
- -- 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
- mapTc check_one_cxt all_sigs_but_first `thenTc_`
-
- returnTc theta1
- where
- sig1_dict_tys = mk_dict_tys theta1
- n_sig1_dict_tys = length sig1_dict_tys
-
- check_one_cxt sig@(TySigInfo _ id _ theta _ src_loc)
- = tcAddSrcLoc src_loc $
- tcAddErrCtxt (sigContextsCtxt id1 id) $
- checkTc (length this_sig_dict_tys == n_sig1_dict_tys)
- sigContextsErr `thenTc_`
- unifyTauTyLists sig1_dict_tys this_sig_dict_tys
- where
- this_sig_dict_tys = mk_dict_tys theta
-
- check_one_sig (TySigInfo name id sig_tyvars _ sig_tau src_loc)
- = tcAddSrcLoc src_loc $
- tcAddErrCtxt (sigCtxt id) $
- checkSigTyVars sig_tyvars sig_tau
-
- mk_dict_tys theta = [mkDictTy c ts | (c,ts) <- theta]
-\end{code}
-
-
-@checkSigTyVars@ is used after the type in a type signature has been unified with
-the actual type found. It then checks that the type variables of the type signature
-are
- (a) still all type variables
- eg matching signature [a] against inferred type [(p,q)]
- [then a will be unified to a non-type variable]
-
- (b) still all distinct
- eg matching signature [(a,b)] against inferred type [(p,p)]
- [then a and b will be unified together]
-
- (c) not mentioned in the environment
- eg the signature for f in this:
-
- g x = ... where
- f :: a->[a]
- f y = [x,y]
-
- Here, f is forced to be monorphic by the free occurence of x.
-
-Before doing this, the substitution is applied to the signature type variable.
-
-We used to have the notion of a "DontBind" type variable, which would
-only be bound to itself or nothing. Then points (a) and (b) were
-self-checking. But it gave rise to bogus consequential error messages.
-For example:
-
- f = (*) -- Monomorphic
projects / ghc-hetmet.git / blobdiff