Commit 7cbba64b authored by simonmar's avatar simonmar
Browse files

[project @ 2003-09-10 16:44:03 by simonmar]

New flags for individual syntax extensions:

  -fth                enables template haskell
  -fimplicit-params   enables implicit parameters

These extensions are still implied by -fglasgow-exts, but they can now
be switched off individually with -fno-th and -fno-implicit-params
respectively.  Also, -fno-ffi now works as expected.

I cleaned up the interface to the lexer a bit while I was here.
parent 868973ac
......@@ -293,6 +293,8 @@ data DynFlag
| Opt_PArr -- syntactic support for parallel arrays
| Opt_With -- deprecated keyword for implicit parms
| Opt_Arrows -- Arrow-notation syntax
| Opt_TH
| Opt_ImplicitParams
| Opt_Generics
| Opt_NoImplicitPrelude
......
-----------------------------------------------------------------------------
-- $Id: DriverFlags.hs,v 1.123 2003/09/04 11:08:47 simonmar Exp $
-- $Id: DriverFlags.hs,v 1.124 2003/09/10 16:44:05 simonmar Exp $
--
-- Driver flags
--
......@@ -424,6 +424,9 @@ dynamic_flags = [
, ( "fvia-C", NoArg (setLang HscC) )
, ( "filx", NoArg (setLang HscILX) )
, ( "fglasgow-exts", NoArg (mapM_ setDynFlag glasgowExtsFlags) )
, ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) )
-- "active negatives"
, ( "fno-implicit-prelude", NoArg (setDynFlag Opt_NoImplicitPrelude) )
, ( "fno-monomorphism-restriction",
......@@ -451,18 +454,21 @@ fFlags = [
( "warn-unused-imports", Opt_WarnUnusedImports ),
( "warn-unused-matches", Opt_WarnUnusedMatches ),
( "warn-deprecations", Opt_WarnDeprecations ),
( "glasgow-exts", Opt_GlasgowExts ),
( "fi", Opt_FFI ), -- support `-ffi'...
( "ffi", Opt_FFI ), -- ...and also `-fffi'
( "with", Opt_With ), -- with keyword
( "arrows", Opt_Arrows ), -- arrow syntax
( "parr", Opt_PArr ),
( "th", Opt_TH ),
( "implicit-params", Opt_ImplicitParams ),
( "allow-overlapping-instances", Opt_AllowOverlappingInstances ),
( "allow-undecidable-instances", Opt_AllowUndecidableInstances ),
( "allow-incoherent-instances", Opt_AllowIncoherentInstances ),
( "generics", Opt_Generics )
]
glasgowExtsFlags = [ Opt_GlasgowExts, Opt_FFI, Opt_TH, Opt_ImplicitParams ]
isFFlag f = f `elem` (map fst fFlags)
getFFlag f = fromJust (lookup f fFlags)
......
......@@ -38,8 +38,7 @@ import HsSyn
import RdrName ( nameRdrName )
import StringBuffer ( hGetStringBuffer )
import Parser
import Lexer ( P(..), ParseResult(..), ExtFlags(..),
mkPState, showPFailed )
import Lexer ( P(..), ParseResult(..), mkPState, showPFailed )
import SrcLoc ( mkSrcLoc )
import TcRnDriver ( checkOldIface, tcRnModule, tcRnExtCore, tcRnIface )
import RnEnv ( extendOrigNameCache )
......@@ -388,10 +387,9 @@ myParseModule dflags src_filename
_scc_ "Parser" do
buf <- hGetStringBuffer src_filename
let exts = mkExtFlags dflags
loc = mkSrcLoc (mkFastString src_filename) 1 0
let loc = mkSrcLoc (mkFastString src_filename) 1 0
case unP parseModule (mkPState buf loc exts) of {
case unP parseModule (mkPState buf loc dflags) of {
PFailed l1 l2 err -> do { hPutStrLn stderr (showPFailed l1 l2 err);
return Nothing };
......@@ -510,10 +508,9 @@ hscParseStmt dflags str
buf <- stringToStringBuffer str
let exts = mkExtFlags dflags
loc = mkSrcLoc FSLIT("<interactive>") 1 0
let loc = mkSrcLoc FSLIT("<interactive>") 1 0
case unP parseStmt (mkPState buf loc exts) of {
case unP parseStmt (mkPState buf loc dflags) of {
PFailed l1 l2 err -> do { hPutStrLn stderr (showPFailed l1 l2 err);
return Nothing };
......@@ -566,10 +563,8 @@ hscThing hsc_env pcs0 ic str
myParseIdentifier dflags str
= do buf <- stringToStringBuffer str
let exts = mkExtFlags dflags
loc = mkSrcLoc FSLIT("<interactive>") 1 0
case unP parseIdentifier (mkPState buf loc exts) of
let loc = mkSrcLoc FSLIT("<interactive>") 1 0
case unP parseIdentifier (mkPState buf loc dflags) of
PFailed l1 l2 err -> do { hPutStrLn stderr (showPFailed l1 l2 err);
return Nothing }
......@@ -670,11 +665,4 @@ initExternalPackageState
initOrigNames :: OrigNameCache
initOrigNames = foldl extendOrigNameCache emptyModuleEnv knownKeyNames
mkExtFlags dflags
= ExtFlags { glasgowExtsEF = dopt Opt_GlasgowExts dflags,
ffiEF = dopt Opt_FFI dflags,
withEF = dopt Opt_With dflags,
arrowsEF = dopt Opt_Arrows dflags,
parrEF = dopt Opt_PArr dflags}
\end{code}
......@@ -5,6 +5,7 @@ module ParsePkgConf( loadPackageConfig ) where
import Packages ( PackageConfig(..), defaultPackageConfig )
import Lexer
import CmdLineOpts
import FastString
import StringBuffer
import SrcLoc
......@@ -96,12 +97,7 @@ loadPackageConfig :: FilePath -> IO [PackageConfig]
loadPackageConfig conf_filename = do
buf <- hGetStringBuffer conf_filename
let loc = mkSrcLoc (mkFastString conf_filename) 1 0
exts = ExtFlags {glasgowExtsEF = False,
ffiEF = False,
arrowsEF = False,
withEF = False,
parrEF = False}
case unP parse (mkPState buf loc exts) of
case unP parse (mkPState buf loc defaultDynFlags) of
PFailed l1 l2 err -> do
throwDyn (InstallationError (showPFailed l1 l2 err))
......
......@@ -22,7 +22,7 @@
{
module Lexer (
Token(..), Token__(..), lexer, ExtFlags(..), mkPState, showPFailed,
Token(..), Token__(..), lexer, mkPState, showPFailed,
P(..), ParseResult(..), setSrcLocFor, getSrcLoc,
failMsgP, failLocMsgP, srcParseFail,
popContext, pushCurrentContext,
......@@ -38,6 +38,7 @@ import FastString
import FastTypes
import SrcLoc
import UniqFM
import CmdLineOpts
import Ctype
import Util ( maybePrefixMatch )
......@@ -185,27 +186,40 @@ $white_no_nl+ ;
-- "special" symbols
<0,glaexts> {
"[:" / { ifExtension parrEnabled } { token ITopabrack }
":]" / { ifExtension parrEnabled } { token ITcpabrack }
}
<0,glaexts> {
"[|" / { ifExtension thEnabled } { token ITopenExpQuote }
"[e|" / { ifExtension thEnabled } { token ITopenExpQuote }
"[p|" / { ifExtension thEnabled } { token ITopenPatQuote }
"[d|" / { ifExtension thEnabled } { layout_token ITopenDecQuote }
"[t|" / { ifExtension thEnabled } { token ITopenTypQuote }
"|]" / { ifExtension thEnabled } { token ITcloseQuote }
\$ @varid / { ifExtension thEnabled } { skip_one_varid ITidEscape }
"$(" / { ifExtension thEnabled } { token ITparenEscape }
}
<0,glaexts> {
"(|" / { ifExtension arrowsEnabled } { special IToparenbar }
"|)" / { ifExtension arrowsEnabled } { special ITcparenbar }
}
<0,glaexts> {
\? @varid / { ifExtension ipEnabled } { skip_one_varid ITdupipvarid }
\% @varid / { ifExtension ipEnabled } { skip_one_varid ITsplitipvarid }
}
<glaexts> {
"(#" { token IToubxparen }
"#)" { token ITcubxparen }
"[:" { token ITopabrack }
":]" { token ITcpabrack }
"{|" { token ITocurlybar }
"|}" { token ITccurlybar }
"[|" { token ITopenExpQuote }
"[e|" { token ITopenExpQuote }
"[p|" { token ITopenPatQuote }
"[d|" { layout_token ITopenDecQuote }
"[t|" { token ITopenTypQuote }
"|]" { token ITcloseQuote }
}
<0,glaexts> {
"(|" / { \b _ _ _ -> arrowsEnabled b} { special IToparenbar }
"|)" / { \b _ _ _ -> arrowsEnabled b} { special ITcparenbar }
\( { special IToparen }
\) { special ITcparen }
\[ { special ITobrack }
......@@ -218,13 +232,6 @@ $white_no_nl+ ;
\} { close_brace }
}
<glaexts> {
\? @varid { skip_one_varid ITdupipvarid }
\% @varid { skip_one_varid ITsplitipvarid }
\$ @varid { skip_one_varid ITidEscape }
"$(" { token ITparenEscape }
}
<0,glaexts> {
@qual @varid { check_qvarid }
@qual @conid { idtoken qconid }
......@@ -592,6 +599,8 @@ pop_and act loc end buf len = do popLexState; act loc end buf len
notFollowedBy char _ _ _ (_,buf) = atEnd buf || currentChar buf /= char
ifExtension pred bits _ _ _ = pred bits
{-
nested comments require traversing by hand, they can't be parsed
using regular expressions.
......@@ -1198,6 +1207,8 @@ ffiBit = 1
parrBit = 2
withBit = 3
arrowsBit = 4
thBit = 5
ipBit = 6
glaExtsEnabled, ffiEnabled, parrEnabled :: Int -> Bool
glaExtsEnabled flags = testBit flags glaExtsBit
......@@ -1205,23 +1216,13 @@ ffiEnabled flags = testBit flags ffiBit
withEnabled flags = testBit flags withBit
parrEnabled flags = testBit flags parrBit
arrowsEnabled flags = testBit flags arrowsBit
-- convenient record-based bitmap for the interface to the rest of the world
--
-- NB: `glasgowExtsEF' implies `ffiEF' (see `mkPState' below)
--
data ExtFlags = ExtFlags {
glasgowExtsEF :: Bool,
ffiEF :: Bool,
withEF :: Bool,
parrEF :: Bool,
arrowsEF :: Bool
}
thEnabled flags = testBit flags thBit
ipEnabled flags = testBit flags ipBit
-- create a parse state
--
mkPState :: StringBuffer -> SrcLoc -> ExtFlags -> PState
mkPState buf loc exts =
mkPState :: StringBuffer -> SrcLoc -> DynFlags -> PState
mkPState buf loc flags =
PState {
buffer = buf,
last_loc = loc,
......@@ -1233,12 +1234,13 @@ mkPState buf loc exts =
-- we begin in the layout state if toplev_layout is set
}
where
bitmap = glaExtsBit `setBitIf` glasgowExtsEF exts
.|. ffiBit `setBitIf` (ffiEF exts
|| glasgowExtsEF exts)
.|. withBit `setBitIf` withEF exts
.|. parrBit `setBitIf` parrEF exts
.|. arrowsBit `setBitIf` arrowsEF exts
bitmap = glaExtsBit `setBitIf` dopt Opt_GlasgowExts flags
.|. ffiBit `setBitIf` dopt Opt_FFI flags
.|. withBit `setBitIf` dopt Opt_With flags
.|. parrBit `setBitIf` dopt Opt_PArr flags
.|. arrowsBit `setBitIf` dopt Opt_Arrows flags
.|. thBit `setBitIf` dopt Opt_TH flags
.|. ipBit `setBitIf` dopt Opt_ImplicitParams flags
--
setBitIf :: Int -> Bool -> Int
b `setBitIf` cond | cond = bit b
......
......@@ -640,12 +640,13 @@ readIface :: Module -> String -> IsBootInterface -> TcRn m (Either Exception Par
-- Just x <=> successfully found and parsed
readIface mod file_path is_hi_boot_file
= ioToTcRn (tryMost (read_iface mod file_path is_hi_boot_file))
= do dflags <- getDOpts
ioToTcRn (tryMost (read_iface mod dflags file_path is_hi_boot_file))
read_iface mod file_path is_hi_boot_file
read_iface mod dflags file_path is_hi_boot_file
| is_hi_boot_file -- Read ascii
= do { buffer <- hGetStringBuffer file_path ;
case unP parseIface (mkPState buffer loc exts) of
case unP parseIface (mkPState buffer loc dflags) of
POk _ iface | wanted_mod_name == actual_mod_name
-> return iface
| otherwise
......@@ -664,11 +665,6 @@ read_iface mod file_path is_hi_boot_file
= readBinIface file_path
where
exts = ExtFlags {glasgowExtsEF = True,
ffiEF = True,
arrowsEF = True,
withEF = True,
parrEF = True}
loc = mkSrcLoc (mkFastString file_path) 1 0
\end{code}
......
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