X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fparser%2FRdrHsSyn.lhs;h=fdf97bc1c47a93521d0a40574e75cc9b9dbf7442;hp=03ca542149c8b7e5fb245203662ea146b94d291e;hb=60762c678c83e370609001addc8f52efcd657139;hpb=1e436f2bb208a6c990743afaf17b7c2a93c31742 diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 03ca542..fdf97bc 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -12,7 +12,7 @@ module RdrHsSyn ( mkHsIntegral, mkHsFractional, mkHsIsString, mkHsDo, mkHsSplice, mkTopSpliceDecl, mkClassDecl, mkTyData, mkTyFamily, mkTySynonym, - splitCon, mkInlineSpec, + splitCon, mkInlinePragma, mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp cvBindGroup, @@ -54,9 +54,8 @@ import Class ( FunDep ) import TypeRep ( Kind ) import RdrName ( RdrName, isRdrTyVar, isRdrTc, mkUnqual, rdrNameOcc, isRdrDataCon, isUnqual, getRdrName, setRdrNameSpace ) -import BasicTypes ( maxPrecedence, Activation, RuleMatchInfo, - InlinePragma(..), InlineSpec(..), - alwaysInlineSpec, neverInlineSpec ) +import BasicTypes ( maxPrecedence, Activation(..), RuleMatchInfo, + InlinePragma(..) ) import Lexer import TysWiredIn ( unitTyCon ) import ForeignCall @@ -74,7 +73,7 @@ import Maybes import Control.Applicative ((<$>)) import Text.ParserCombinators.ReadP as ReadP import Data.List ( nubBy ) -import Data.Char ( isAscii, isAlphaNum, isAlpha ) +import Data.Char #include "HsVersions.h" \end{code} @@ -960,13 +959,20 @@ 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) } -mkInlineSpec :: Maybe Activation -> RuleMatchInfo -> Bool -> InlineSpec --- The Maybe is becuase the user can omit the activation spec (and usually does) -mkInlineSpec Nothing match_info True = alwaysInlineSpec match_info - -- INLINE -mkInlineSpec Nothing match_info False = neverInlineSpec match_info - -- NOINLINE -mkInlineSpec (Just act) match_info inl = Inline (InlinePragma act match_info) inl +mkInlinePragma :: Maybe Activation -> RuleMatchInfo -> Bool -> InlinePragma +-- The Maybe is because the user can omit the activation spec (and usually does) +mkInlinePragma mb_act match_info inl + = InlinePragma { inl_inline = inl + , inl_act = act + , inl_rule = match_info } + 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 ----------------------------------------------------------------------------- -- utilities for foreign declarations @@ -979,9 +985,9 @@ mkImport :: CCallConv -> P (HsDecl RdrName) mkImport cconv safety (L loc entity, v, ty) | cconv == PrimCallConv = do - let funcTarget = CFunction (StaticTarget entity) - importSpec = CImport PrimCallConv safety nilFS funcTarget - return (ForD (ForeignImport v ty importSpec)) + let funcTarget = CFunction (StaticTarget entity) + importSpec = CImport PrimCallConv safety nilFS funcTarget + return (ForD (ForeignImport v ty importSpec)) | otherwise = do case parseCImport cconv safety (mkExtName (unLoc v)) (unpackFS entity) of Nothing -> parseError loc "Malformed entity string" @@ -1006,7 +1012,9 @@ parseCImport cconv safety nm str = mk = CImport cconv safety - hdr_char c = isAscii c && (isAlphaNum c || c `elem` "._") + hdr_char c = not (isSpace c) -- header files are filenames, which can contain + -- pretty much any char (depending on the platform), + -- so just accept any non-space character id_char c = isAlphaNum c || c == '_' cimp nm = (ReadP.char '&' >> skipSpaces >> CLabel <$> cid)