-rnIfaceType :: SDoc -> RdrNameHsType -> RnMS s RenamedHsType
-rnIfaceType doc ty
- = rnHsType doc ty `thenRn` \ (ty,_) ->
- returnRn ty
-
-
-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 new_tyvars new_ctxt new_ty,
- cxt_fvs `plusFV` ty_fvs)
-
--- Check that each constraint mentions at least one of the forall'd type variables
--- Since the forall'd type variables are a subset of the free tyvars
--- of the tau-type part, this guarantees that every constraint mentions
--- at least one of the free tyvars in ty
-checkConstraints explicit_forall doc forall_tyvars ctxt ty
- = mapRn check ctxt `thenRn` \ maybe_ctxt' ->
- returnRn (catMaybes maybe_ctxt')
- -- Remove problem ones, to avoid duplicate error message.
- where
- check ct@(_,tys)
- | forall_mentioned = returnRn (Just ct)
- | otherwise = addErrRn (ctxtErr explicit_forall doc forall_tyvars ct ty) `thenRn_`
- returnRn Nothing
- where
- forall_mentioned = foldr ((||) . any (`elem` forall_tyvars) . extractHsTyVars)
- False
- tys
-
-
-rnHsType :: SDoc -> RdrNameHsType -> RnMS s (RenamedHsType, FreeVars)
-
-rnHsType doc (HsForAllTy Nothing ctxt ty)
- -- From 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_tyvars = extractHsTyVars ty
- forall_tyvars = filter (not . (`elemFM` name_env)) mentioned_tyvars
- in
- checkConstraints False doc forall_tyvars ctxt ty `thenRn` \ ctxt' ->
- rnForAll doc (map UserTyVar forall_tyvars) ctxt' ty
-
-rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt ty)
- -- Explicit quantification.
- -- Check that the forall'd tyvars are a subset of the
- -- free tyvars in the tau-type part
- -- That's only a warning... unless the tyvar is constrained by a
- -- context in which case it's an error
- = let
- mentioned_tyvars = extractHsTyVars ty
- constrained_tyvars = [tv | (_,tys) <- ctxt,
- ty <- tys,
- tv <- extractHsTyVars ty]
- dubious_guys = filter (`notElem` mentioned_tyvars) forall_tyvar_names
- (bad_guys, warn_guys) = partition (`elem` constrained_tyvars) dubious_guys
- forall_tyvar_names = map getTyVarName forall_tyvars
- in
- mapRn_ (forAllErr doc ty) bad_guys `thenRn_`
- mapRn_ (forAllWarn doc ty) warn_guys `thenRn_`
- checkConstraints True doc forall_tyvar_names ctxt ty `thenRn` \ ctxt' ->
- rnForAll doc forall_tyvars ctxt' ty
-
-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)