X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHeaderInfo.hs;h=d21eeac860f3b6a7a6d06e70575dbd4b5e82abad;hb=0e6ff027979263c36703f26da836a784fe1606a2;hp=e16c2ce562b07e7b25acd3b274ad06cefe5165b5;hpb=4917397e279b0aa755eb09e1ca62913237132895;p=ghc-hetmet.git diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index e16c2ce..d21eeac 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -57,7 +57,7 @@ getImports :: GhcMonad m => -- ^ The source imports, normal imports, and the module name. getImports dflags buf filename source_filename = do let loc = mkSrcLoc (mkFastString filename) 1 1 - case unP parseHeader (mkPState buf loc dflags) of + case unP parseHeader (mkPState dflags buf loc) of PFailed span err -> parseError span err POk pst rdr_module -> do let _ms@(_warns, errs) = getMessages pst @@ -228,6 +228,9 @@ getOptions' toks parseToks (open:xs) | ITlanguage_prag <- getToken open = parseLanguage xs + parseToks (x:xs) + | ITdocCommentNext _ <- getToken x + = parseToks xs parseToks _ = [] parseLanguage (L loc (ITconid fs):rest) = checkExtension (L loc fs) : @@ -263,8 +266,7 @@ checkExtension (L l ext) -- 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) + if ext' `elem` supportedLanguagesAndExtensions then L l ("-X"++ext') else unsupportedExtnError l ext' @@ -281,7 +283,9 @@ unsupportedExtnError :: SrcSpan -> String -> a unsupportedExtnError loc unsup = throw $ mkSrcErr $ unitBag $ mkPlainErrMsg loc $ - text "Unsupported extension: " <> text unsup + text "Unsupported extension: " <> text unsup $$ + if null suggestions then empty else text "Perhaps you meant" <+> quotedListWithOr (map text suggestions) + where suggestions = fuzzyMatch unsup supportedLanguagesAndExtensions optionsErrorMsgs :: [String] -> [Located String] -> FilePath -> Messages