From: Ian Lynagh Date: Fri, 12 Jan 2007 16:47:32 +0000 (+0000) Subject: Add a warning for tabs in source files X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=6e2021202c3eec0c95a9d0b7c355559f2630d380 Add a warning for tabs in source files --- diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 20edd51..8679ff2 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -46,8 +46,9 @@ import Panic import Constants import Outputable -import Control.Monad ( when ) +import Control.Monad import Data.Char ( ord ) +import System.Exit #include "HsVersions.h" } @@ -918,9 +919,12 @@ parseCmmFile dflags filename = do -- in there we don't want. case unP cmmParse init_state of PFailed span err -> do printError span err; return Nothing - POk _ code -> do + POk pst code -> do cmm <- initC dflags no_module (getCmm (unEC code initEnv [] >> return ())) - dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprCmms [cmm]) + let ms = getMessages pst + printErrorsAndWarnings dflags ms + when (errorsFound dflags ms) $ exitWith (ExitFailure 1) + dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprCmms [cmm]) return (Just cmm) where no_module = panic "parseCmmFile: no module" diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index d05b8b2..3e9ca8f 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -156,6 +156,7 @@ data DynFlag | Opt_WarnDeprecations | Opt_WarnDodgyImports | Opt_WarnOrphans + | Opt_WarnTabs -- language opts | Opt_AllowOverlappingInstances @@ -1032,6 +1033,7 @@ fFlags = [ ( "warn-unused-matches", Opt_WarnUnusedMatches ), ( "warn-deprecations", Opt_WarnDeprecations ), ( "warn-orphans", Opt_WarnOrphans ), + ( "warn-tabs", Opt_WarnTabs ), ( "fi", Opt_FFI ), -- support `-ffi'... ( "ffi", Opt_FFI ), -- ...and also `-fffi' ( "arrows", Opt_Arrows ), -- arrow syntax diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index 090af1f..e124e37 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -15,8 +15,7 @@ module HeaderInfo ( getImportsFromFile, getImports #include "HsVersions.h" import Parser ( parseHeader ) -import Lexer ( P(..), ParseResult(..), mkPState, pragState - , lexer, Token(..), PState(..) ) +import Lexer import FastString import HsSyn ( ImportDecl(..), HsModule(..) ) import Module ( ModuleName, moduleName ) @@ -25,7 +24,7 @@ import StringBuffer ( StringBuffer(..), hGetStringBuffer, hGetStringBufferBlock , appendStringBuffers ) import SrcLoc import FastString ( mkFastString ) -import DynFlags ( DynFlags ) +import DynFlags import ErrUtils import Util import Outputable @@ -37,6 +36,8 @@ import Bag ( emptyBag, listToBag ) import Distribution.Compiler import Control.Exception +import Control.Monad +import System.Exit import System.IO import Data.List @@ -65,7 +66,10 @@ getImports dflags buf filename = do let loc = mkSrcLoc (mkFastString filename) 1 0 case unP parseHeader (mkPState buf loc dflags) of PFailed span err -> parseError span err - POk _ rdr_module -> + POk pst rdr_module -> do + let ms = getMessages pst + printErrorsAndWarnings dflags ms + when (errorsFound dflags ms) $ exitWith (ExitFailure 1) case rdr_module of L _ (HsModule mb_mod _ imps _ _ _ _ _) -> let diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs index 041ea15..cafba83 100644 --- a/compiler/main/HscMain.lhs +++ b/compiler/main/HscMain.lhs @@ -54,7 +54,7 @@ import HsSyn ( HsModule, LHsBinds, HsGroup, LIE, LImportDecl, HsDoc, import SrcLoc ( Located(..) ) import StringBuffer ( hGetStringBuffer, stringToStringBuffer ) import Parser -import Lexer ( P(..), ParseResult(..), mkPState ) +import Lexer import SrcLoc ( mkSrcLoc ) import TcRnDriver ( tcRnModule, tcRnExtCore ) import TcIface ( typecheckIface ) @@ -93,6 +93,7 @@ import UniqFM ( emptyUFM ) import Bag ( unitBag ) import Control.Monad +import System.Exit import System.IO import Data.IORef \end{code} @@ -737,8 +738,12 @@ myParseModule dflags src_filename maybe_src_buf PFailed span err -> return (Left (mkPlainErrMsg span err)); - POk _ rdr_module -> do { + POk pst rdr_module -> do { + let {ms = getMessages pst}; + printErrorsAndWarnings dflags ms; + when (errorsFound dflags ms) $ exitWith (ExitFailure 1); + dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr rdr_module) ; dumpIfSet_dyn dflags Opt_D_source_stats "Source Statistics" @@ -893,7 +898,11 @@ hscParseThing parser dflags str PFailed span err -> do { printError span err; return Nothing }; - POk _ thing -> do { + POk pst thing -> do { + + let {ms = getMessages pst}; + printErrorsAndWarnings dflags ms; + when (errorsFound dflags ms) $ exitWith (ExitFailure 1); --ToDo: can't free the string buffer until we've finished this -- compilation sweep and all the identifiers have gone away. diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 49dabf0..4238938 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -25,6 +25,7 @@ module Lexer ( Token(..), lexer, pragState, mkPState, PState(..), P(..), ParseResult(..), getSrcLoc, failLocMsgP, failSpanMsgP, srcParseFail, + getMessages, popContext, pushCurrentContext, setLastToken, setSrcLoc, getLexState, popLexState, pushLexState, extension, glaExtsEnabled, bangPatEnabled @@ -32,7 +33,8 @@ module Lexer ( #include "HsVersions.h" -import ErrUtils ( Message ) +import Bag +import ErrUtils import Outputable import StringBuffer import FastString @@ -43,6 +45,7 @@ import DynFlags import Ctype import Util ( maybePrefixMatch, readRational ) +import Control.Monad import Data.Bits import Data.Char ( chr, isSpace ) import Data.Ratio @@ -56,8 +59,9 @@ import Compat.Unicode ( GeneralCategory(..), generalCategory, isPrint, isUpper ) } $unispace = \x05 -$whitechar = [\ \t\n\r\f\v\xa0 $unispace] +$whitechar = [\ \n\r\f\v\xa0 $unispace] $white_no_nl = $whitechar # \n +$tab = \t $ascdigit = 0-9 $unidigit = \x03 @@ -108,6 +112,7 @@ haskell :- -- everywhere: skip whitespace and comments $white_no_nl+ ; +$tab+ { warn Opt_WarnTabs (text "Tab character") } -- Everywhere: deal with nested comments. We explicitly rule out -- pragmas, "{-#", so that we don't accidentally treat them as comments. @@ -1299,6 +1304,14 @@ getCharOrFail = do Just (c,i) -> do setInput i; return c -- ----------------------------------------------------------------------------- +-- Warnings + +warn :: DynFlag -> SDoc -> Action +warn option warning span _buf _len = do + addWarning option (mkWarnMsg span alwaysQualify warning) + lexToken + +-- ----------------------------------------------------------------------------- -- The Parse Monad data LayoutContext @@ -1316,6 +1329,8 @@ data ParseResult a data PState = PState { buffer :: StringBuffer, + dflags :: DynFlags, + messages :: Messages, last_loc :: SrcSpan, -- pos of previous token last_offs :: !Int, -- offset of the previous token from the -- beginning of the current line. @@ -1500,6 +1515,10 @@ pragState :: StringBuffer -> SrcLoc -> PState pragState buf loc = PState { buffer = buf, + messages = emptyMessages, + -- XXX defaultDynFlags is not right, but we don't have a real + -- dflags handy + dflags = defaultDynFlags, last_loc = mkSrcSpan loc loc, last_offs = 0, last_len = 0, @@ -1517,6 +1536,8 @@ mkPState :: StringBuffer -> SrcLoc -> DynFlags -> PState mkPState buf loc flags = PState { buffer = buf, + dflags = flags, + messages = emptyMessages, last_loc = mkSrcSpan loc loc, last_offs = 0, last_len = 0, @@ -1543,6 +1564,15 @@ mkPState buf loc flags = b `setBitIf` cond | cond = bit b | otherwise = 0 +addWarning :: DynFlag -> WarnMsg -> P () +addWarning option w + = P $ \s@PState{messages=(ws,es), dflags=d} -> + let ws' = if dopt option d then ws `snocBag` w else ws + in POk s{messages=(ws', es)} () + +getMessages :: PState -> Messages +getMessages PState{messages=ms} = ms + getContext :: P [LayoutContext] getContext = P $ \s@PState{context=ctx} -> POk s ctx diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index a993b42..9c65282 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -814,6 +814,13 @@ + + warn if there are tabs in the source file + dynamic + + + + warn when defaulting happens dynamic diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml index 0168123..c09fa35 100644 --- a/docs/users_guide/using.xml +++ b/docs/users_guide/using.xml @@ -1097,6 +1097,18 @@ f "2" = 2 + : + + + tabs, warning + Have the compiler warn if there are tabs in your source + file. + + This warning is off by default. + + + + :