projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix some small things broken with the last merge.
[ghc-hetmet.git]
/
compiler
/
rename
/
RnTypes.lhs
diff --git
a/compiler/rename/RnTypes.lhs
b/compiler/rename/RnTypes.lhs
index
ed3e6d0
..
be90d7d
100644
(file)
--- a/
compiler/rename/RnTypes.lhs
+++ b/
compiler/rename/RnTypes.lhs
@@
-7,7
+7,7
@@
module RnTypes (
-- Type related stuff
rnHsType, rnLHsType, rnLHsTypes, rnContext,
module RnTypes (
-- Type related stuff
rnHsType, rnLHsType, rnLHsTypes, rnContext,
- rnHsSigType, rnHsTypeFVs, rnConDeclFields,
+ rnHsSigType, rnHsTypeFVs, rnConDeclFields, rnLPred,
-- Precence related stuff
mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn,
-- Precence related stuff
mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn,
@@
-31,7
+31,7
@@
import RnEnv
import TcRnMonad
import RdrName
import PrelNames
import TcRnMonad
import RdrName
import PrelNames
-import TypeRep ( funTyConName )
+import TysPrim ( funTyConName )
import Name
import SrcLoc
import NameSet
import Name
import SrcLoc
import NameSet
@@
-116,7
+116,7
@@
rnHsType _ (HsTyVar tyvar) = do
-- Hence the jiggery pokery with ty1
rnHsType doc ty@(HsOpTy ty1 (L loc op) ty2)
= setSrcSpan loc $
-- Hence the jiggery pokery with ty1
rnHsType doc ty@(HsOpTy ty1 (L loc op) ty2)
= setSrcSpan loc $
- do { ops_ok <- doptM Opt_TypeOperators
+ do { ops_ok <- xoptM Opt_TypeOperators
; op' <- if ops_ok
then lookupOccRn op
else do { addErr (opTyErr op ty)
; op' <- if ops_ok
then lookupOccRn op
else do { addErr (opTyErr op ty)
@@
-139,13
+139,6
@@
rnHsType doc (HsRecTy flds)
= do { flds' <- rnConDeclFields doc flds
; return (HsRecTy flds') }
= do { flds' <- rnConDeclFields doc flds
; return (HsRecTy flds') }
-rnHsType _ (HsNumTy i)
- | i == 1 = return (HsNumTy i)
- | otherwise = addErr err_msg >> return (HsNumTy i)
- where
- err_msg = ptext (sLit "Only unit numeric type pattern is valid")
-
-
rnHsType doc (HsFunTy ty1 ty2) = do
ty1' <- rnLHsType doc ty1
-- Might find a for-all as the arg of a function type
rnHsType doc (HsFunTy ty1 ty2) = do
ty1' <- rnLHsType doc ty1
-- Might find a for-all as the arg of a function type
@@
-161,7
+154,7
@@
rnHsType doc (HsListTy ty) = do
return (HsListTy ty')
rnHsType doc (HsKindSig ty k)
return (HsListTy ty')
rnHsType doc (HsKindSig ty k)
- = do { kind_sigs_ok <- doptM Opt_KindSignatures
+ = do { kind_sigs_ok <- xoptM Opt_KindSignatures
; unless kind_sigs_ok (addErr (kindSigErr ty))
; ty' <- rnLHsType doc ty
; return (HsKindSig ty' k) }
; unless kind_sigs_ok (addErr (kindSigErr ty))
; ty' <- rnLHsType doc ty
; return (HsKindSig ty' k) }
@@
-185,9
+178,9
@@
rnHsType doc (HsPredTy pred) = do
pred' <- rnPred doc pred
return (HsPredTy pred')
pred' <- rnPred doc pred
return (HsPredTy pred')
-rnHsType _ (HsSpliceTy sp)
- = do { (sp', _fvs) <- rnSplice sp -- ToDo: deal with fvs
- ; return (HsSpliceTy sp') }
+rnHsType _ (HsSpliceTy sp _ k)
+ = do { (sp', fvs) <- rnSplice sp -- ToDo: deal with fvs
+ ; return (HsSpliceTy sp' fvs k) }
rnHsType doc (HsDocTy ty haddock_doc) = do
ty' <- rnLHsType doc ty
rnHsType doc (HsDocTy ty haddock_doc) = do
ty' <- rnLHsType doc ty
@@
-200,8
+193,9
@@
rnHsType _ ty@(HsQuasiQuoteTy _) = pprPanic "Can't do quasiquotation without GHC
rnHsType doc (HsQuasiQuoteTy qq) = do { ty <- runQuasiQuoteType qq
; rnHsType doc (unLoc ty) }
#endif
rnHsType doc (HsQuasiQuoteTy qq) = do { ty <- runQuasiQuoteType qq
; rnHsType doc (unLoc ty) }
#endif
-rnHsType _ (HsSpliceTyOut {}) = panic "rnHsType"
+rnHsType _ (HsCoreTy ty) = return (HsCoreTy ty)
+--------------
rnLHsTypes :: SDoc -> [LHsType RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) [LHsType Name]
rnLHsTypes doc tys = mapM (rnLHsType doc) tys
rnLHsTypes :: SDoc -> [LHsType RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) [LHsType Name]
rnLHsTypes doc tys = mapM (rnLHsType doc) tys
@@
-209,7
+203,7
@@
rnLHsTypes doc tys = mapM (rnLHsType doc) tys
\begin{code}
\begin{code}
-rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName]
+rnForAll :: SDoc -> HsExplicitFlag -> [LHsTyVarBndr RdrName]
-> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
rnForAll doc _ [] (L _ []) (L _ ty) = rnHsType doc ty
-> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
rnForAll doc _ [] (L _ []) (L _ ty) = rnHsType doc ty
@@
-569,7
+563,7
@@
ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity)
forAllWarn :: SDoc -> LHsType RdrName -> Located RdrName
-> TcRnIf TcGblEnv TcLclEnv ()
forAllWarn doc ty (L loc tyvar)
forAllWarn :: SDoc -> LHsType RdrName -> Located RdrName
-> TcRnIf TcGblEnv TcLclEnv ()
forAllWarn doc ty (L loc tyvar)
- = ifOptM Opt_WarnUnusedMatches $
+ = ifDOptM Opt_WarnUnusedMatches $
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))]
$$
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))]
$$