X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHeaderInfo.hs;h=90c6155788d3217d0a1e714706c1a0b36544651c;hb=f8c52d7fde2d7408b4f734251c373f8d3e2c558e;hp=717a847cbaf570b32e78e71ccd0716e777ec9230;hpb=e7f1092c0b5efe110006638faf9c6e40b22a6ccc;p=ghc-hetmet.git diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index 717a847..90c6155 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -8,6 +8,13 @@ -- ----------------------------------------------------------------------------- +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module HeaderInfo ( getImportsFromFile, getImports , getOptionsFromFile, getOptions , optionsErrorMsgs ) where @@ -33,9 +40,6 @@ import Panic import Maybes import Bag ( emptyBag, listToBag ) -import Distribution.Compiler -import Distribution.Version - import Control.Exception import Control.Monad import System.Exit @@ -178,16 +182,13 @@ getOptions' buf filename checkExtension :: Located FastString -> Located String checkExtension (L l ext) - = case reads (unpackFS ext) of - [] -> languagePragParseError l - (okExt,""):_ -> - case readVersion cProjectVersion of - Just version -> - case extensionsToGHCFlag version [okExt] of - ([],[opt]) -> L l opt - _ -> unsupportedExtnError l okExt - Nothing -> - panic ("Can't parse version: " ++ show cProjectVersion) +-- Checks if a given extension is valid, and if so returns +-- its corresponding flag. Otherwise it throws an exception. + = let ext' = unpackFS ext in + if ext' `elem` supportedLanguages + || ext' `elem` (map ("No"++) supportedLanguages) + then L l ("-X"++ext') + else unsupportedExtnError l ext' languagePragParseError loc = pgmError (showSDoc (mkLocMessage loc ( @@ -196,7 +197,7 @@ languagePragParseError loc = unsupportedExtnError loc unsup = pgmError (showSDoc (mkLocMessage loc ( text "unsupported extension: " <> - (text.show) unsup))) + text unsup))) optionsErrorMsgs :: [String] -> [Located String] -> FilePath -> Messages