Initial checkin of HetMet / -XModalTypes modifications

[ghc-hetmet.git] / compiler / parser / RdrHsSyn.lhs

diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 7d806ed..ed11fd8 100644 (file)
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -55,7 +55,7 @@ import TypeRep          ( Kind )
 import RdrName         ( RdrName, isRdrTyVar, isRdrTc, mkUnqual, rdrNameOcc, 
                          isRdrDataCon, isUnqual, getRdrName, setRdrNameSpace )
 import BasicTypes      ( maxPrecedence, Activation(..), RuleMatchInfo,
-                          InlinePragma(..) )
+                          InlinePragma(..), InlineSpec(..) )
 import Lexer
 import TysWiredIn      ( unitTyCon ) 
 import ForeignCall
@@ -122,6 +122,7 @@ extract_lty (L loc ty) acc
       HsAppTy ty1 ty2                  -> extract_lty ty1 (extract_lty ty2 acc)
       HsListTy ty                      -> extract_lty ty acc
       HsPArrTy ty                      -> extract_lty ty acc
+      HsModalBoxType ecn ty    -> extract_lty ty acc
       HsTupleTy _ tys                  -> extract_ltys tys acc
       HsFunTy ty1 ty2                  -> extract_lty ty1 (extract_lty ty2 acc)
       HsPredTy p               -> extract_pred p acc
@@ -707,7 +708,7 @@ checkAPat dynflags loc e0 = case e0 of
    -- n+k patterns
    OpApp (L nloc (HsVar n)) (L _ (HsVar plus)) _ 
         (L _ (HsOverLit lit@(OverLit {ol_val = HsIntegral {}})))
-                     | dopt Opt_NPlusKPatterns dynflags && (plus == plus_RDR)
+                     | xopt Opt_NPlusKPatterns dynflags && (plus == plus_RDR)
                      -> return (mkNPlusKPat (L nloc n) lit)
    
    OpApp l op _fix r  -> do l <- checkLPat l
@@ -804,6 +805,8 @@ checkValSig
        :: LHsExpr RdrName
        -> LHsType RdrName
        -> P (Sig RdrName)
+checkValSig (L l (HsHetMetBrak _ e)) ty 
+  = checkValSig e ty
 checkValSig (L l (HsVar v)) ty 
   | isUnqual v && not (isDataOcc (rdrNameOcc v))
   = return (TypeSig (L l v) ty)
@@ -833,7 +836,7 @@ checkDoAndIfThenElse :: LHsExpr RdrName
 checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
  | semiThen || semiElse
     = do pState <- getPState
-         unless (dopt Opt_DoAndIfThenElse (dflags pState)) $ do
+         unless (xopt Opt_DoAndIfThenElse (dflags pState)) $ do
              parseErrorSDoc (combineLocs guardExpr elseExpr)
                             (text "Unexpected semi-colons in conditional:"
                           $$ nest 4 expr
@@ -937,9 +940,9 @@ mk_rec_fields :: [HsRecField id arg] -> Bool -> HsRecFields id arg
 mk_rec_fields fs False = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
 mk_rec_fields fs True  = HsRecFields { rec_flds = fs, rec_dotdot = Just (length fs) }
 
-mkInlinePragma :: Maybe Activation -> RuleMatchInfo -> Bool -> InlinePragma
+mkInlinePragma :: (InlineSpec, RuleMatchInfo) -> Maybe Activation -> InlinePragma
 -- The Maybe is because the user can omit the activation spec (and usually does)
-mkInlinePragma mb_act match_info inl 
+mkInlinePragma (inl, match_info) mb_act
   = InlinePragma { inl_inline = inl
                  , inl_sat    = Nothing
                  , inl_act    = act
@@ -947,11 +950,10 @@ mkInlinePragma mb_act match_info inl
   where
     act = case mb_act of
             Just act -> act
-            Nothing | inl       -> AlwaysActive
-                    | otherwise -> NeverActive
-        -- If no specific phase is given then:
-       --   NOINLINE => NeverActive
-        --   INLINE   => Active
+            Nothing  -> -- No phase specified
+                        case inl of
+                          NoInline -> NeverActive
+                          _other   -> AlwaysActive
 
 -----------------------------------------------------------------------------
 -- utilities for foreign declarations