From 7cbba64b65967d947f5b028c80c0e2320376aabd Mon Sep 17 00:00:00 2001 From: simonmar Date: Wed, 10 Sep 2003 16:44:05 +0000 Subject: [PATCH] [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. --- ghc/compiler/main/CmdLineOpts.lhs | 2 + ghc/compiler/main/DriverFlags.hs | 10 ++++- ghc/compiler/main/HscMain.lhs | 26 ++++-------- ghc/compiler/main/ParsePkgConf.y | 8 +--- ghc/compiler/parser/Lexer.x | 84 +++++++++++++++++++------------------ ghc/compiler/rename/RnHiFiles.lhs | 12 ++---- 6 files changed, 66 insertions(+), 76 deletions(-) diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index 6cf2f3d..2d0718b 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -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 diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index 1189f10..337cad7 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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) diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index 02465bf..ed6f405 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -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("") 1 0 + let loc = mkSrcLoc FSLIT("") 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("") 1 0 - - case unP parseIdentifier (mkPState buf loc exts) of + let loc = mkSrcLoc FSLIT("") 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} diff --git a/ghc/compiler/main/ParsePkgConf.y b/ghc/compiler/main/ParsePkgConf.y index 62813d3..cfecbca 100644 --- a/ghc/compiler/main/ParsePkgConf.y +++ b/ghc/compiler/main/ParsePkgConf.y @@ -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)) diff --git a/ghc/compiler/parser/Lexer.x b/ghc/compiler/parser/Lexer.x index 344f0c4..0bff597 100644 --- a/ghc/compiler/parser/Lexer.x +++ b/ghc/compiler/parser/Lexer.x @@ -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 } +} + { "(#" { 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 } } - { - \? @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 diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs index 977b80f..3ef8c26 100644 --- a/ghc/compiler/rename/RnHiFiles.lhs +++ b/ghc/compiler/rename/RnHiFiles.lhs @@ -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} -- 1.7.10.4