X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHeaderInfo.hs;h=d0e30e06175265c97aff0a84bc03542dc0e3d595;hb=28dd45d2429a87c64d472fd2a35c146600ea3ee5;hp=9b92308eaf925d9b128223a7837e672ab487a525;hpb=59e7d08db602d243d3768ce6907e7bfe67a55e1a;p=ghc-hetmet.git diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index 9b92308..d0e30e0 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -17,7 +17,8 @@ module HeaderInfo ( getImports , getOptionsFromFile, getOptions - , optionsErrorMsgs ) where + , optionsErrorMsgs, + checkProcessArgsResult ) where #include "HsVersions.h" @@ -39,23 +40,12 @@ import Panic import Maybes import Bag ( emptyBag, listToBag ) -import Control.Exception +import Exception import Control.Monad import System.Exit import System.IO import Data.List -#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ >= 601 - -- already imported above ---import System.IO ( openBinaryFile ) -#else -import IOExts ( openFileEx, IOModeEx(..) ) -#endif - -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 601 -openBinaryFile fp mode = openFileEx fp (BinaryMode mode) -#endif - getImports :: DynFlags -> StringBuffer -> FilePath -> FilePath -> IO ([Located ModuleName], [Located ModuleName], Located ModuleName) getImports dflags buf filename source_filename = do @@ -80,7 +70,7 @@ getImports dflags buf filename source_filename = do return (source_imps, ordinary_imps, mod) parseError :: SrcSpan -> Message -> a -parseError span err = throwDyn $ mkPlainErrMsg span err +parseError span err = throwErrMsg $ mkPlainErrMsg span err isSourceIdecl :: ImportDecl name -> Bool isSourceIdecl (ImportDecl _ s _ _ _) = s @@ -97,7 +87,7 @@ getOptionsFromFile :: DynFlags -> FilePath -- input file -> IO [Located String] -- options, if any getOptionsFromFile dflags filename - = Control.Exception.bracket + = Exception.bracket (openBinaryFile filename ReadMode) (hClose) (\handle -> @@ -186,6 +176,19 @@ getOptions' dflags buf filename POk state' t -> (buffer state,t):lexAll state' _ -> [(buffer state,L (last_loc state) ITeof)] +----------------------------------------------------------------------------- +-- Complain about non-dynamic flags in OPTIONS pragmas + +checkProcessArgsResult :: [String] -> FilePath -> IO () +checkProcessArgsResult flags filename + = do when (notNull flags) (ghcError (ProgramError ( + showSDoc (hang (text filename <> char ':') + 4 (text "unknown flags in {-# OPTIONS #-} pragma:" <+> + hsep (map text flags))) + ))) + +----------------------------------------------------------------------------- + checkExtension :: Located FastString -> Located String checkExtension (L l ext) -- Checks if a given extension is valid, and if so returns