X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fparser%2FRdrHsSyn.lhs;h=49036d97c1414c1e46da016b2cc0f7eaf2db6f79;hb=16b9e80dc14db24509f051f294b5b51943285090;hp=149eae4723ad147ec660a528ebce9fb268da51a2;hpb=e3d0f33551f53f8f78739faf168a6bb94f676c0d;p=ghc-hetmet.git

diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 149eae4..49036d9 100644
--- 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,12 +122,14 @@ 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 (extract_tv loc ecn acc)
       HsTupleTy _ tys          	-> extract_ltys tys acc
       HsFunTy ty1 ty2          	-> extract_lty ty1 (extract_lty ty2 acc)
       HsPredTy p		-> extract_pred p acc
       HsOpTy ty1 (L loc tv) ty2 -> extract_tv loc tv (extract_lty ty1 (extract_lty ty2 acc))
       HsParTy ty               	-> extract_lty ty acc
-      HsNumTy _                 -> acc
+      HsNumTy {}                -> acc
+      HsCoreTy {}               -> acc  -- The type is closed
       HsQuasiQuoteTy {}	        -> acc  -- Quasi quotes mention no type variables
       HsSpliceTy {}           	-> acc	-- Type splices mention no type variables
       HsKindSig ty _            -> extract_lty ty acc
@@ -675,6 +677,7 @@ checkAPat :: DynFlags -> SrcSpan -> HsExpr RdrName -> P (Pat RdrName)
 checkAPat dynflags loc e0 = case e0 of
    EWildPat -> return (WildPat placeHolderType)
    HsVar x  -> return (VarPat x)
+   HsHetMetBrak _ p -> checkAPat dynflags loc (unLoc p)
    HsLit l  -> return (LitPat l)
 
    -- Overloaded numeric patterns (e.g. f 0 x = x)
@@ -706,7 +709,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
@@ -803,6 +806,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)
@@ -832,7 +837,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
@@ -936,9 +941,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
@@ -946,11 +951,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