+rnHsSigType :: SDoc -> RdrNameHsType -> RnMS s (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
+
+rnIfaceType :: SDoc -> RdrNameHsType -> RnMS s RenamedHsType
+rnIfaceType doc ty
+ = rnHsType doc ty `thenRn` \ (ty,_) ->
+ returnRn ty
+
+rnHsType :: SDoc -> RdrNameHsType -> RnMS s (RenamedHsType, FreeVars)
+
+rnHsType doc (HsForAllTy [] ctxt ty)
+ -- From source code (no kinds on tyvars)
+
+ -- Given the signature C => T we universally quantify
+ -- over FV(T) \ {in-scope-tyvars}
+ --
+ -- We insist that the universally quantified type vars is a superset of FV(C)
+ -- It follows that FV(T) is a superset of FV(C), so that the context constrains
+ -- no type variables that don't appear free in the tau-type part.
+
+ = getLocalNameEnv `thenRn` \ name_env ->
+ let
+ mentioned_tyvars = extractHsTyVars ty
+ forall_tyvars = filter (not . (`elemFM` name_env)) mentioned_tyvars
+
+ ctxt_w_ftvs :: [((RdrName,[RdrNameHsType]), [RdrName])]
+ ctxt_w_ftvs = [ (constraint, foldr ((++) . extractHsTyVars) [] tys)
+ | constraint@(_,tys) <- ctxt]
+
+ -- A 'non-poly constraint' is one that does not mention *any*
+ -- of the forall'd type variables
+ non_poly_constraints = filter non_poly ctxt_w_ftvs
+ non_poly (c,ftvs) = not (any (`elem` forall_tyvars) ftvs)
+
+ -- A 'non-mentioned' constraint is one that mentions a
+ -- type variable that does not appear in 'ty'
+ non_mentioned_constraints = filter non_mentioned ctxt_w_ftvs
+ non_mentioned (c,ftvs) = any (not . (`elem` mentioned_tyvars)) ftvs
+
+ -- Zap the context if there's a problem, to avoid duplicate error message.
+ ctxt' | null non_poly_constraints && null non_mentioned_constraints = ctxt
+ | otherwise = []
+ in
+ mapRn (ctxtErr1 doc forall_tyvars ty) non_poly_constraints `thenRn_`
+ mapRn (ctxtErr2 doc ty) non_mentioned_constraints `thenRn_`
+
+ (bindTyVarsFVRn doc (map UserTyVar forall_tyvars) $ \ new_tyvars ->
+ rnContext doc ctxt' `thenRn` \ (new_ctxt, cxt_fvs) ->
+ rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) ->
+ returnRn (mkHsForAllTy new_tyvars new_ctxt new_ty,
+ cxt_fvs `plusFV` ty_fvs)
+ )
+
+rnHsType doc (HsForAllTy tvs ctxt ty)
+ -- tvs are non-empty, hence must be from an interface file
+ -- (tyvars may be kinded)
+ = bindTyVarsFVRn doc tvs $ \ new_tyvars ->
+ rnContext doc ctxt `thenRn` \ (new_ctxt, cxt_fvs) ->
+ rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) ->
+ returnRn (mkHsForAllTy new_tyvars new_ctxt new_ty,
+ cxt_fvs `plusFV` ty_fvs)
+
+rnHsType doc (MonoTyVar tyvar)
+ = lookupOccRn tyvar `thenRn` \ tyvar' ->
+ returnRn (MonoTyVar tyvar', unitFV tyvar')
+
+rnHsType doc (MonoFunTy ty1 ty2)
+ = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
+ rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
+ returnRn (MonoFunTy ty1' ty2', fvs1 `plusFV` fvs2)
+
+rnHsType doc (MonoListTy ty)
+ = addImplicitOccRn listTyCon_name `thenRn_`
+ rnHsType doc ty `thenRn` \ (ty', fvs) ->
+ returnRn (MonoListTy ty', fvs `addOneFV` listTyCon_name)
+
+rnHsType doc (MonoTupleTy tys boxed)
+ = addImplicitOccRn tup_con_name `thenRn_`
+ rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
+ returnRn (MonoTupleTy tys' boxed, fvs `addOneFV` tup_con_name)
+ where
+ tup_con_name = tupleTyCon_name boxed (length tys)