dupFieldErr, patSigErr, checkTupSize
) where
-import DynFlags ( DynFlag(Opt_WarnUnusedMatches, Opt_GlasgowExts) )
+import DynFlags ( DynFlag(Opt_WarnUnusedMatches, Opt_GlasgowExts, Opt_ScopedTypeVariables ) )
import HsSyn
import RdrHsSyn ( extractHsRhoRdrTyVars )
import RnHsSyn ( extractHsTyNames, parrTyCon_name, tupleTyCon_name,
listTyCon_name
)
+import RnHsDoc ( rnLHsDoc )
import RnEnv ( lookupOccRn, lookupBndrRn, lookupSyntaxName,
lookupLocatedOccRn, lookupLocatedBndrRn,
lookupLocatedGlobalOccRn, bindTyVarsRn,
= lookupOccRn tyvar `thenM` \ tyvar' ->
returnM (HsTyVar tyvar')
-rnHsType doc (HsOpTy ty1 (L loc op) ty2)
- = setSrcSpan loc (
- lookupOccRn op `thenM` \ op' ->
- let
- l_op' = L loc op'
- in
- lookupTyFixityRn l_op' `thenM` \ fix ->
- rnLHsType doc ty1 `thenM` \ ty1' ->
- rnLHsType doc ty2 `thenM` \ ty2' ->
- mkHsOpTyRn (\t1 t2 -> HsOpTy t1 l_op' t2) (ppr op') fix ty1' ty2'
- )
+rnHsType doc ty@(HsOpTy ty1 (L loc op) ty2)
+ = setSrcSpan loc $
+ do { ty_ops_ok <- doptM Opt_ScopedTypeVariables -- Badly named option
+ ; checkErr ty_ops_ok (opTyErr op ty)
+ ; op' <- lookupOccRn op
+ ; let l_op' = L loc op'
+ ; fix <- lookupTyFixityRn l_op'
+ ; ty1' <- rnLHsType doc ty1
+ ; ty2' <- rnLHsType doc ty2
+ ; mkHsOpTyRn (\t1 t2 -> HsOpTy t1 l_op' t2) (ppr op') fix ty1' ty2' }
rnHsType doc (HsParTy ty)
= rnLHsType doc ty `thenM` \ ty' ->
= do { addErr (ptext SLIT("Type splices are not yet implemented"))
; failM }
+rnHsType doc (HsDocTy ty haddock_doc)
+ = rnLHsType doc ty `thenM` \ ty' ->
+ rnLHsDoc haddock_doc `thenM` \ haddock_doc' ->
+ returnM (HsDocTy ty' haddock_doc')
+
rnLHsTypes doc tys = mappM (rnLHsType doc) tys
\end{code}
= checkPrec op (unLoc p1) False `thenM_`
checkPrec op (unLoc p2) True
- check _ = panic "checkPrecMatch"
+ check _ = return ()
+ -- This can happen. Consider
+ -- a `op` True = ...
+ -- op = ...
+ -- The infix flag comes from the first binding of the group
+ -- but the second eqn has no args (an error, but not discovered
+ -- until the type checker). So we don't want to crash on the
+ -- second eqn.
checkPrec op (ConPatIn op1 (InfixCon _ _)) right
= lookupFixityRn op `thenM` \ op_fix@(Fixity op_prec op_dir) ->
bindLocatedLocalsFV doc_pat bndrs $ \ new_bndrs ->
rnLPats pats `thenM` \ (pats', pat_fvs) ->
thing_inside pats' `thenM` \ (res, res_fvs) ->
-
let
unused_binders = filter (not . (`elemNameSet` res_fvs)) new_bndrs
in
-- -----------------------------------------------------------------------------
-- rnRpats
-rnRpats :: [(Located RdrName, LPat RdrName)]
- -> RnM ([(Located Name, LPat Name)], FreeVars)
+-- Haddock comments for record fields are renamed to Nothing here
+rnRpats :: [HsRecField RdrName (LPat RdrName)]
+ -> RnM ([HsRecField Name (LPat Name)], FreeVars)
rnRpats rpats
= mappM_ field_dup_err dup_fields `thenM_`
mapFvRn rn_rpat rpats `thenM` \ (rpats', fvs) ->
returnM (rpats', fvs)
where
- (_, dup_fields) = removeDups compare [ unLoc f | (f,_) <- rpats ]
+ (_, dup_fields) = removeDups compare [ unLoc f | HsRecField f _ _ <- rpats ]
field_dup_err dups = addErr (dupFieldErr "pattern" dups)
- rn_rpat (field, pat)
+ rn_rpat (HsRecField field pat _)
= lookupLocatedGlobalOccRn field `thenM` \ fieldname ->
rnLPat pat `thenM` \ (pat', fvs) ->
- returnM ((fieldname, pat'), fvs `addOneFV` unLoc fieldname)
+ returnM ((mkRecField fieldname pat'), fvs `addOneFV` unLoc fieldname)
\end{code}
forAllWarn doc ty (L loc tyvar)
= ifOptM Opt_WarnUnusedMatches $
- setSrcSpan loc $
- addWarn (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
- nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
+ addWarnAt loc (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
+ nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
$$
- doc
- )
+ doc)
+
+opTyErr op ty
+ = hang (ptext SLIT("Illegal operator") <+> quotes (ppr op) <+> ptext SLIT("in type") <+> quotes (ppr ty))
+ 2 (parens (ptext SLIT("Use -fscoped-type-variables to allow operators in types")))
bogusCharError c
= ptext SLIT("character literal out of range: '\\") <> char c <> char '\''