import Constants
import Outputable
-import Control.Monad ( when )
+import Control.Monad
import Data.Char ( ord )
+import System.Exit
#include "HsVersions.h"
}
-- 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"
| Opt_WarnDeprecations
| Opt_WarnDodgyImports
| Opt_WarnOrphans
+ | Opt_WarnTabs
-- language opts
| Opt_AllowOverlappingInstances
( "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
#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 )
, appendStringBuffers )
import SrcLoc
import FastString ( mkFastString )
-import DynFlags ( DynFlags )
+import DynFlags
import ErrUtils
import Util
import Outputable
import Distribution.Compiler
import Control.Exception
+import Control.Monad
+import System.Exit
import System.IO
import Data.List
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
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 )
import Bag ( unitBag )
import Control.Monad
+import System.Exit
import System.IO
import Data.IORef
\end{code}
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"
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.
Token(..), lexer, pragState, mkPState, PState(..),
P(..), ParseResult(..), getSrcLoc,
failLocMsgP, failSpanMsgP, srcParseFail,
+ getMessages,
popContext, pushCurrentContext, setLastToken, setSrcLoc,
getLexState, popLexState, pushLexState,
extension, glaExtsEnabled, bangPatEnabled
#include "HsVersions.h"
-import ErrUtils ( Message )
+import Bag
+import ErrUtils
import Outputable
import StringBuffer
import FastString
import Ctype
import Util ( maybePrefixMatch, readRational )
+import Control.Monad
import Data.Bits
import Data.Char ( chr, isSpace )
import Data.Ratio
}
$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
-- 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.
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
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.
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,
mkPState buf loc flags =
PState {
buffer = buf,
+ dflags = flags,
+ messages = emptyMessages,
last_loc = mkSrcSpan loc loc,
last_offs = 0,
last_len = 0,
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
</row>
<row>
+ <entry><option>-fwarn-tabs</option></entry>
+ <entry>warn if there are tabs in the source file</entry>
+ <entry>dynamic</entry>
+ <entry><option>-fno-warn-tabs</option></entry>
+ </row>
+
+ <row>
<entry><option>-fwarn-type-defaults</option></entry>
<entry>warn when defaulting happens</entry>
<entry>dynamic</entry>
</varlistentry>
<varlistentry>
+ <term><option>-fwarn-tabs</option>:</term>
+ <listitem>
+ <indexterm><primary><option>-fwarn-tabs</option></primary></indexterm>
+ <indexterm><primary>tabs, warning</primary></indexterm>
+ <para>Have the compiler warn if there are tabs in your source
+ file.</para>
+
+ <para>This warning is off by default.</para>
+ </listitem>
+ </varlistentry>
+
+ <varlistentry>
<term><option>-fwarn-type-defaults</option>:</term>
<listitem>
<indexterm><primary><option>-fwarn-type-defaults</option></primary></indexterm>