Commit 44eaf25c authored by simonmar's avatar simonmar
Browse files

[project @ 2005-04-19 15:28:35 by simonmar]

- DriverPipeline.compile: report errors in GHC_OPTIONS pragmas using the
  Message callback, and give them a proper line number.

- GHC.checkModule: read the GHC_OPTIONS pragma, and report errors
  appropriately.
parent 1996af43
......@@ -22,7 +22,8 @@ module DriverPipeline (
-- DLL building
doMkDLL,
getOptionsFromStringBuffer, -- used in module GHC
getOptionsFromStringBuffer, -- used in module GHC
optionsErrorMsgs, -- ditto
) where
#include "HsVersions.h"
......@@ -50,6 +51,9 @@ import Maybes ( expectJust )
import Ctype ( is_ident )
import StringBuffer ( StringBuffer(..), lexemeToString )
import ParserCoreUtils ( getCoreModuleName )
import SrcLoc ( srcLocSpan, mkSrcLoc )
import FastString ( mkFastString )
import Bag ( listToBag, emptyBag )
import EXCEPTION
import DATA_IOREF ( readIORef, writeIORef, IORef )
......@@ -127,8 +131,11 @@ compile hsc_env msg_act mod_summary maybe_old_linkable old_iface mod_index nmods
-- It might be better to cache the flags in the ml_hspp_file field,say
let hspp_buf = expectJust "compile:hspp_buf" (ms_hspp_buf mod_summary)
opts = getOptionsFromStringBuffer hspp_buf
(dflags1,unhandled_flags) <- parseDynamicFlags dflags0 opts
checkProcessArgsResult unhandled_flags input_fn
(dflags1,unhandled_flags) <- parseDynamicFlags dflags0 (map snd opts)
if (not (null unhandled_flags))
then do msg_act (optionsErrorMsgs unhandled_flags opts input_fn)
return CompErrs
else do
let (basename, _) = splitFilename input_fn
......@@ -1307,22 +1314,22 @@ getOptionsFromSource file
return (opts ++ rest)
| otherwise -> return []
getOptionsFromStringBuffer :: StringBuffer -> [String]
getOptionsFromStringBuffer :: StringBuffer -> [(Int,String)]
getOptionsFromStringBuffer buffer@(StringBuffer _ len# _) =
let
ls = lines (lexemeToString buffer (I# len#)) -- lazy, so it's ok
in
look ls
look 1 ls
where
look [] = []
look (l':ls) = do
look i [] = []
look i (l':ls) = do
let l = removeSpaces l'
case () of
() | null l -> look ls
| prefixMatch "#" l -> look ls
| prefixMatch "{-# LINE" l -> look ls -- -}
() | null l -> look (i+1) ls
| prefixMatch "#" l -> look (i+1) ls
| prefixMatch "{-# LINE" l -> look (i+1) ls -- -}
| Just opts <- matchOptions l
-> opts ++ look ls
-> zip (repeat i) opts ++ look (i+1) ls
| otherwise -> []
-- detect {-# OPTIONS_GHC ... #-}. For the time being, we accept OPTIONS
......@@ -1351,6 +1358,19 @@ matchOptions s
| otherwise = Nothing
optionsErrorMsgs :: [String] -> [(Int,String)] -> FilePath -> Messages
optionsErrorMsgs unhandled_flags flags_lines filename
= (emptyBag, listToBag (map mkMsg unhandled_flags_lines))
where
unhandled_flags_lines = [ (l,f) | f <- unhandled_flags,
(l,f') <- flags_lines, f == f' ]
mkMsg (line,flag) =
ErrUtils.mkPlainErrMsg (srcLocSpan loc) $
text "unknown flag in {-# OPTIONS #-} pragma:" <+> text flag
where
loc = mkSrcLoc (mkFastString filename) line 0
-- ToDo: we need a better SrcSpan here
-- -----------------------------------------------------------------------------
-- Misc.
......
......@@ -155,7 +155,7 @@ import DataCon ( DataCon )
import Name ( Name, getName, nameModule_maybe )
import RdrName ( RdrName, gre_name, globalRdrEnvElts )
import NameEnv ( nameEnvElts )
import SrcLoc ( Located(..) )
import SrcLoc ( Located(..), mkSrcLoc, srcLocSpan )
import DriverPipeline
import DriverPhases ( Phase(..), isHaskellSrcFilename, startPhase )
import GetImports ( getImports )
......@@ -179,6 +179,8 @@ import SysTools ( cleanTempFilesExcept )
import BasicTypes ( SuccessFlag(..), succeeded, failed )
import Maybes ( orElse, expectJust, mapCatMaybes )
import TcType ( tcSplitSigmaTy, isDictTy )
import Bag ( unitBag, emptyBag )
import FastString ( mkFastString )
import Directory ( getModificationTime, doesFileExist )
import Maybe ( isJust, isNothing, fromJust, fromMaybe, catMaybes )
......@@ -652,7 +654,21 @@ checkModule session@(Session ref) mod msg_act = do
case [ ms | ms <- mg, ms_mod ms == mod ] of
[] -> return Nothing
(ms:_) -> do
r <- hscFileCheck hsc_env msg_act ms
-- Add in the OPTIONS from the source file This is nasty:
-- we've done this once already, in the compilation manager
-- It might be better to cache the flags in the
-- ml_hspp_file field, say
let dflags0 = hsc_dflags hsc_env
hspp_buf = expectJust "GHC.checkModule" (ms_hspp_buf ms)
opts = getOptionsFromStringBuffer hspp_buf
(dflags1,leftovers) <- parseDynamicFlags dflags0 (map snd opts)
if (not (null leftovers))
then do let filename = fromJust (ml_hs_file (ms_location ms))
msg_act (optionsErrorMsgs leftovers opts filename)
return Nothing
else do
r <- hscFileCheck hsc_env{hsc_dflags=dflags1} msg_act ms
case r of
HscFail ->
return Nothing
......@@ -1398,7 +1414,7 @@ preprocessFile dflags src_fn (Just (buf, time))
let
local_opts = getOptionsFromStringBuffer buf
--
(dflags', errs) <- parseDynamicFlags dflags local_opts
(dflags', errs) <- parseDynamicFlags dflags (map snd local_opts)
let
needs_preprocessing
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment