Initial checkin of HetMet / -XModalTypes modifications

[ghc-hetmet.git] / compiler / rename / RnTypes.lhs

diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index b275d2d..8405e8c 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,
-       rnHsSigType, rnHsTypeFVs, rnConDeclFields,
+       rnHsSigType, rnHsTypeFVs, rnConDeclFields, rnLPred,
 
        -- Precence related stuff
        mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn,
@@ -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 $ 
-    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)
@@ -161,7 +161,7 @@ rnHsType doc (HsListTy ty) = do
     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) }
@@ -170,6 +170,11 @@ rnHsType doc (HsPArrTy ty) = do
     ty' <- rnLHsType doc ty
     return (HsPArrTy ty')
 
+rnHsType doc (HsModalBoxType ecn ty) = do
+    ecn' <- lookupOccRn ecn
+    ty' <- rnLHsType doc ty
+    return (HsModalBoxType ecn' ty')
+
 -- Unboxed tuples are allowed to have poly-typed arguments.  These
 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
 rnHsType doc (HsTupleTy tup_con tys) = do
@@ -570,7 +575,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)
-  = 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))]
                   $$