-rnHsSigType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
- -- rnHsSigType is used for source-language type signatures,
- -- which use *implicit* universal quantification.
-rnHsSigType doc_str ty
- = rnHsType (text "the type signature for" <+> doc_str) ty
-
----------------------------------------
-rnHsType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
-
-rnHsType doc (HsForAllTy Nothing ctxt ty)
- -- Implicit quantifiction in source code (no kinds on tyvars)
- -- Given the signature C => T we universally quantify
- -- over FV(T) \ {in-scope-tyvars}
- = getLocalNameEnv `thenRn` \ name_env ->
- let
- mentioned_in_tau = extractHsTyRdrTyVars ty
- mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
- mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
- forall_tyvars = filter (not . (`elemFM` name_env)) mentioned
- in
- rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
-
-rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
- -- Explicit quantification.
- -- Check that the forall'd tyvars are actually
- -- mentioned in the type, and produce a warning if not
- = let
- mentioned_in_tau = extractHsTyRdrTyVars tau
- mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
- mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
- forall_tyvar_names = hsTyVarNames forall_tyvars
-
- -- Explicitly quantified but not mentioned in ctxt or tau
- warn_guys = filter (`notElem` mentioned) forall_tyvar_names
- in
- mapRn_ (forAllWarn doc tau) warn_guys `thenRn_`
- rnForAll doc forall_tyvars ctxt tau
-
-rnHsType doc (HsTyVar tyvar)
- = lookupOccRn tyvar `thenRn` \ tyvar' ->
- returnRn (HsTyVar tyvar', unitFV tyvar')
-
-rnHsType doc (HsFunTy ty1 ty2)
- = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
- -- Might find a for-all as the arg of a function type
- rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
- -- Or as the result. This happens when reading Prelude.hi
- -- when we find return :: forall m. Monad m -> forall a. a -> m a
- returnRn (HsFunTy ty1' ty2', fvs1 `plusFV` fvs2)
-
-rnHsType doc (HsListTy ty)
- = rnHsType doc ty `thenRn` \ (ty', fvs) ->
- returnRn (HsListTy ty', fvs `addOneFV` listTyCon_name)
-
--- Unboxed tuples are allowed to have poly-typed arguments. These
--- sometimes crop up as a result of CPR worker-wrappering dictionaries.
-rnHsType doc (HsTupleTy (HsTupCon _ boxity) tys)
- -- Don't do lookupOccRn, because this is built-in syntax
- -- so it doesn't need to be in scope
- = mapFvRn (rnHsType doc) tys `thenRn` \ (tys', fvs) ->
- returnRn (HsTupleTy (HsTupCon n' boxity) tys', fvs `addOneFV` n')
- where
- n' = tupleTyCon_name boxity (length tys)
-
-
-rnHsType doc (HsAppTy ty1 ty2)
- = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
- rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
- returnRn (HsAppTy ty1' ty2', fvs1 `plusFV` fvs2)
-
-rnHsType doc (HsPredTy pred)
- = rnPred doc pred `thenRn` \ (pred', fvs) ->
- returnRn (HsPredTy pred', fvs)
-
-rnHsType doc (HsUsgForAllTy uv_rdr ty)
- = bindUVarRn doc uv_rdr $ \ uv_name ->
- rnHsType doc ty `thenRn` \ (ty', fvs) ->
- returnRn (HsUsgForAllTy uv_name ty',
- fvs )
-
-rnHsType doc (HsUsgTy usg ty)
- = newUsg usg `thenRn` \ (usg', usg_fvs) ->
- rnHsType doc ty `thenRn` \ (ty', ty_fvs) ->
- -- A for-all can occur inside a usage annotation
- returnRn (HsUsgTy usg' ty',
- usg_fvs `plusFV` ty_fvs)
- where
- newUsg usg = case usg of
- HsUsOnce -> returnRn (HsUsOnce, emptyFVs)
- HsUsMany -> returnRn (HsUsMany, emptyFVs)
- HsUsVar uv_rdr -> lookupOccRn uv_rdr `thenRn` \ uv_name ->
- returnRn (HsUsVar uv_name, emptyFVs)
-
-rnHsTypes doc tys = mapFvRn (rnHsType doc) tys
-\end{code}
-
-\begin{code}
--- We use lookupOcc here because this is interface file only stuff
--- and we need the workers...
-rnHsTupCon (HsTupCon n boxity)
- = lookupOccRn n `thenRn` \ n' ->
- returnRn (HsTupCon n' boxity, unitFV n')
-
-rnHsTupConWkr (HsTupCon n boxity)
- -- Tuple construtors are for the *worker* of the tuple
- -- Going direct saves needless messing about
- = lookupOccRn (mkRdrNameWkr n) `thenRn` \ n' ->
- returnRn (HsTupCon n' boxity, unitFV n')
-\end{code}
-
-\begin{code}
-rnForAll doc forall_tyvars ctxt ty
- = bindTyVarsFVRn doc forall_tyvars $ \ new_tyvars ->
- rnContext doc ctxt `thenRn` \ (new_ctxt, cxt_fvs) ->
- rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) ->
- returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty,
- cxt_fvs `plusFV` ty_fvs)
-\end{code}
-
-\begin{code}
-rnContext :: SDoc -> RdrNameContext -> RnMS (RenamedContext, FreeVars)
-rnContext doc ctxt
- = mapAndUnzipRn rn_pred ctxt `thenRn` \ (theta, fvs_s) ->
- let
- (_, dups) = removeDupsEq theta
- -- We only have equality, not ordering
- in
- -- Check for duplicate assertions
- -- If this isn't an error, then it ought to be:
- mapRn (addWarnRn . dupClassAssertWarn theta) dups `thenRn_`
- returnRn (theta, plusFVs fvs_s)
- where
- --Someone discovered that @CCallable@ and @CReturnable@
- -- could be used in contexts such as:
- -- foo :: CCallable a => a -> PrimIO Int
- -- Doing this utterly wrecks the whole point of introducing these
- -- classes so we specifically check that this isn't being done.
- rn_pred pred = rnPred doc pred `thenRn` \ (pred', fvs)->
- checkRn (not (bad_pred pred'))
- (naughtyCCallContextErr pred') `thenRn_`
- returnRn (pred', fvs)
-
- bad_pred (HsPClass clas _) = getUnique clas `elem` cCallishClassKeys
- bad_pred other = False
-
-
-rnPred doc (HsPClass clas tys)
- = lookupOccRn clas `thenRn` \ clas_name ->
- rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
- returnRn (HsPClass clas_name tys', fvs `addOneFV` clas_name)
-
-rnPred doc (HsPIParam n ty)
- = newIPName n `thenRn` \ name ->
- rnHsType doc ty `thenRn` \ (ty', fvs) ->
- returnRn (HsPIParam name ty', fvs)
-\end{code}
-
-\begin{code}
-rnFds :: SDoc -> [FunDep RdrName] -> RnMS ([FunDep Name], FreeVars)