From 5e05865dffed03c40b5d15831d26f903d5d73ede Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Wed, 20 Jun 2007 16:26:56 +0000 Subject: [PATCH] Use -X for language extensions We've often talked about having a separate flag for language extensions, and now we have one. You can say -XImplicitParams -X=ImplicitParams -Ximplicit-params as you like. These replace the "-f" flags with similar names (though the -f prefix will serve as a synonym for -X for a while). There's an optional "=", and the flag is normalised by removing hyphens and lower-casing, so all the above variants mean the same thing. The nomenclature is intended to match the LANGUAGE pramgas, which are defined by Cabal. So you can also say {-# LANGUAGE ImplicitParams #-} But Cabal doesn't have as many language options as GHC does, so the -X things are a superset of the LANGUAGE things. The optional "=" applies to all flags that take an argument, so you can, for example, say -pgmL=/etc/foo I hope that's ok. (It's an unforced change; just fitted in.) I hope we'll add more -X flags, to replace the portmanteau -fglasgow-exts which does everything! I have updated the manual, but doubtless missed something. --- compiler/main/CmdLineParser.hs | 21 +++--- compiler/main/DynFlags.hs | 132 +++++++++++++++++++++++++-------- docs/users_guide/flags.xml | 78 +++++++++---------- docs/users_guide/glasgow_exts.xml | 148 ++++++++++++++++++++++--------------- 4 files changed, 237 insertions(+), 142 deletions(-) diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs index ac73e94..d237ad7 100644 --- a/compiler/main/CmdLineParser.hs +++ b/compiler/main/CmdLineParser.hs @@ -62,10 +62,11 @@ processOneArg :: OptKind m -> String -> String -> [String] -> Either String (m (), [String]) processOneArg action rest arg args = let dash_arg = '-' : arg + rest_no_eq = dropEq rest in case action of NoArg a -> ASSERT(null rest) Right (a, args) - HasArg f | notNull rest -> Right (f rest, args) + HasArg f | notNull rest_no_eq -> Right (f rest_no_eq, args) | otherwise -> case args of [] -> missingArgErr dash_arg (arg1:args1) -> Right (f arg1, args1) @@ -74,23 +75,23 @@ processOneArg action rest arg args [] -> unknownFlagErr dash_arg (arg1:args1) -> Right (f arg1, args1) - Prefix f | notNull rest -> Right (f rest, args) + Prefix f | notNull rest_no_eq -> Right (f rest_no_eq, args) | otherwise -> unknownFlagErr dash_arg - PrefixPred p f | notNull rest -> Right (f rest, args) - | otherwise -> unknownFlagErr dash_arg + PrefixPred p f | notNull rest_no_eq -> Right (f rest_no_eq, args) + | otherwise -> unknownFlagErr dash_arg PassFlag f | notNull rest -> unknownFlagErr dash_arg | otherwise -> Right (f dash_arg, args) - OptIntSuffix f | null rest -> Right (f Nothing, args) - | Just n <- parseInt rest -> Right (f (Just n), args) + OptIntSuffix f | null rest -> Right (f Nothing, args) + | Just n <- parseInt rest_no_eq -> Right (f (Just n), args) | otherwise -> Left ("malformed integer argument in " ++ dash_arg) - IntSuffix f | Just n <- parseInt rest -> Right (f n, args) + IntSuffix f | Just n <- parseInt rest_no_eq -> Right (f n, args) | otherwise -> Left ("malformed integer argument in " ++ dash_arg) - OptPrefix f -> Right (f rest, args) + OptPrefix f -> Right (f rest_no_eq, args) AnySuffix f -> Right (f dash_arg, args) AnySuffixPred p f -> Right (f dash_arg, args) @@ -109,7 +110,7 @@ arg_ok (NoArg _) rest arg = null rest arg_ok (HasArg _) rest arg = True arg_ok (SepArg _) rest arg = null rest arg_ok (Prefix _) rest arg = notNull rest -arg_ok (PrefixPred p _) rest arg = notNull rest && p rest +arg_ok (PrefixPred p _) rest arg = notNull rest && p (dropEq rest) arg_ok (OptIntSuffix _) rest arg = True arg_ok (IntSuffix _) rest arg = True arg_ok (OptPrefix _) rest arg = True @@ -121,7 +122,7 @@ parseInt :: String -> Maybe Int -- Looks for "433" or "=342", with no trailing gubbins -- n or =n => Just n -- gibberish => Nothing -parseInt s = case reads (dropEq s) of +parseInt s = case reads s of ((n,""):_) -> Just n other -> Nothing diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index c8615da..5a00401 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -68,7 +68,7 @@ import Constants ( mAX_CONTEXT_REDUCTION_DEPTH ) import Panic ( panic, GhcException(..) ) import UniqFM ( UniqFM ) import Util ( notNull, splitLongestPrefix, normalisePath ) -import Maybes ( fromJust, orElse ) +import Maybes ( orElse, fromJust ) import SrcLoc ( SrcSpan ) import Outputable import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) @@ -82,7 +82,7 @@ import Data.List ( isPrefixOf ) import Util ( split ) #endif -import Data.Char ( isUpper ) +import Data.Char ( isUpper, toLower ) import System.IO ( hPutStrLn, stderr ) -- ----------------------------------------------------------------------------- @@ -177,6 +177,8 @@ data DynFlag | Opt_BangPatterns | Opt_TypeFamilies | Opt_OverloadedStrings + | Opt_GADTs + | Opt_RelaxedPolyRec -- -X=RelaxedPolyRec -- optimisation opts | Opt_Strictness @@ -1018,10 +1020,16 @@ dynamic_flags = [ , ( "fglasgow-exts", NoArg (mapM_ setDynFlag glasgowExtsFlags) ) , ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) ) - -- the rest of the -f* and -fno-* flags - , ( "fno-", PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) ) - , ( "f", PrefixPred (\f -> isFFlag f) (\f -> setDynFlag (getFFlag f)) ) + , ( "f", PrefixPred (isFlag fFlags) (\f -> setDynFlag (getFlag fFlags f)) ) + , ( "f", PrefixPred (isNoFlag fFlags) (\f -> unSetDynFlag (getNoFlag fFlags f)) ) + + -- For now, allow -X flags with -f; ToDo: report this as deprecated + , ( "f", PrefixPred (isFlag xFlags) (\f -> setDynFlag (getFlag fFlags f)) ) + + -- the rest of the -X* and -Xno-* flags + , ( "X", PrefixPred (isFlag xFlags) (\f -> setDynFlag (getFlag xFlags f)) ) + , ( "X", PrefixPred (isNoFlag xFlags) (\f -> unSetDynFlag (getNoFlag xFlags f)) ) ] -- these -f flags can all be reversed with -fno- @@ -1046,24 +1054,6 @@ fFlags = [ ( "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 - ( "parr", Opt_PArr ), - ( "th", Opt_TH ), - ( "implicit-prelude", Opt_ImplicitPrelude ), - ( "scoped-type-variables", Opt_ScopedTypeVariables ), - ( "bang-patterns", Opt_BangPatterns ), - ( "overloaded-strings", Opt_OverloadedStrings ), - ( "type-families", Opt_TypeFamilies ), - ( "monomorphism-restriction", Opt_MonomorphismRestriction ), - ( "mono-pat-binds", Opt_MonoPatBinds ), - ( "extended-default-rules", Opt_ExtendedDefaultRules ), - ( "implicit-params", Opt_ImplicitParams ), - ( "allow-overlapping-instances", Opt_AllowOverlappingInstances ), - ( "allow-undecidable-instances", Opt_AllowUndecidableInstances ), - ( "allow-incoherent-instances", Opt_AllowIncoherentInstances ), - ( "generics", Opt_Generics ), ( "strictness", Opt_Strictness ), ( "full-laziness", Opt_FullLaziness ), ( "liberate-case", Opt_LiberateCase ), @@ -1088,15 +1078,85 @@ fFlags = [ ] -glasgowExtsFlags = [ - Opt_GlasgowExts, - Opt_FFI, - Opt_ImplicitParams, - Opt_ScopedTypeVariables, - Opt_TypeFamilies ] +-- These -X flags can all be reversed with -Xno- +xFlags :: [(String, DynFlag)] +xFlags = [ + ( "FI", Opt_FFI ), -- support `-ffi'... + ( "FFI", Opt_FFI ), -- ...and also `-fffi' + ( "ForeignFunctionInterface", Opt_FFI ), -- ...and also `-fffi' + + ( "Arrows", Opt_Arrows ), -- arrow syntax + ( "Parr", Opt_PArr ), + + ( "TH", Opt_TH ), + ( "TemplateHaskelll", Opt_TH ), + + ( "Generics", Opt_Generics ), + + ( "ImplicitPrelude", Opt_ImplicitPrelude ), -- On by default + + ( "OverloadedStrings", Opt_OverloadedStrings ), + ( "GADTs", Opt_GADTs ), + ( "TypeFamilies", Opt_TypeFamilies ), + ( "BangPatterns", Opt_BangPatterns ), + ( "MonomorphismRestriction", Opt_MonomorphismRestriction ), -- On by default + ( "MonoPatBinds", Opt_MonoPatBinds ), -- On by default (which is not strictly H98) + ( "RelaxedPolyRec", Opt_RelaxedPolyRec), + ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules ), + ( "ImplicitParams", Opt_ImplicitParams ), + ( "ScopedTypeVariables", Opt_ScopedTypeVariables ), + ( "AllowOverlappingInstances", Opt_AllowOverlappingInstances ), + ( "AllowUndecidableInstances", Opt_AllowUndecidableInstances ), + ( "AllowIncoherentInstances", Opt_AllowIncoherentInstances ) + ] + +impliedFlags :: [(DynFlag, [DynFlag])] +impliedFlags = [ + ( Opt_GADTs, [Opt_RelaxedPolyRec] ) -- We want type-sig variables to be completely rigid for GADTs + ] + +glasgowExtsFlags = [ Opt_GlasgowExts + , Opt_FFI + , Opt_ImplicitParams + , Opt_ScopedTypeVariables + , Opt_TypeFamilies ] + +------------------ +isNoFlag, isFlag :: [(String,a)] -> String -> Bool + +isFlag flags f = is_flag flags (normaliseFlag f) -isFFlag f = f `elem` (map fst fFlags) -getFFlag f = fromJust (lookup f fFlags) +isNoFlag flags no_f + | Just f <- noFlag_maybe (normaliseFlag no_f) = is_flag flags f + | otherwise = False + +is_flag flags nf = any (\(ff,_) -> normaliseFlag ff == nf) flags + -- nf is normalised alreadly + +------------------ +getFlag, getNoFlag :: [(String,a)] -> String -> a + +getFlag flags f = get_flag flags (normaliseFlag f) + +getNoFlag flags f = getFlag flags (fromJust (noFlag_maybe (normaliseFlag f))) + -- The flag should be a no-flag already + +get_flag flags nf = head [ opt | (ff, opt) <- flags, normaliseFlag ff == nf] + +------------------ +noFlag_maybe :: String -> Maybe String +-- The input is normalised already +noFlag_maybe ('n' : 'o' : f) = Just f +noFlag_maybe other = Nothing + +normaliseFlag :: String -> String +-- Normalise a option flag by +-- * map to lower case +-- * removing hyphens +-- Thus: -X=overloaded-strings or -XOverloadedStrings +normaliseFlag [] = [] +normaliseFlag ('-':s) = normaliseFlag s +normaliseFlag (c:s) = toLower c : normaliseFlag s -- ----------------------------------------------------------------------------- -- Parsing the dynamic flags. @@ -1117,10 +1177,18 @@ upd f = do dfs <- getCmdLineState putCmdLineState $! (f dfs) +-------------------------- setDynFlag, unSetDynFlag :: DynFlag -> DynP () -setDynFlag f = upd (\dfs -> dopt_set dfs f) +setDynFlag f = upd (\dfs -> foldl dopt_set (dopt_set dfs f) deps) + where + deps = [ d | (f', ds) <- impliedFlags, f' == f, d <- ds ] + -- When you set f, set the ones it implies + -- When you un-set f, however, we don't un-set the things it implies + -- (except for -fno-glasgow-exts, which is treated specially) + unSetDynFlag f = upd (\dfs -> dopt_unset dfs f) +-------------------------- setDumpFlag :: DynFlag -> OptKind DynP setDumpFlag dump_flag = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag) diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index 0ef478f..9fb9341 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -596,23 +596,29 @@ - + + Enable most language extensions + dynamic + + + + Enable overlapping instances dynamic - + - + Enable incoherent instances. - Implies + Implies dynamic - + - + Enable undecidable instances dynamic - + n @@ -621,37 +627,31 @@ - + Enable arrow notation extension dynamic - + - or + or Enable foreign function interface (implied by ) dynamic - + - + Enable generic classes dynamic - - - - - Enable most language extensions - dynamic - + - + Enable Implicit Parameters. Implied by . dynamic - + @@ -660,61 +660,61 @@ - + Don't implicitly import Prelude dynamic - + - + Disable the monomorphism restriction dynamic - + - + Make pattern bindings polymorphic dynamic - + - + Use GHCi's extended default rules in a normal module dynamic - + - + Enable overloaded string literals. dynamic - + - + Enable lexically-scoped type variables. Implied by . dynamic - + - + or Enable Template Haskell. No longer implied by . dynamic - + - + Enable type families. dynamic - + - + Enable bang patterns. dynamic - + diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 032d2bc..e7858ce 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -38,11 +38,28 @@ documentation describes all the libraries that come with GHC. extensionsoptions controlling - These flags control what variation of the language are + The language option flag control what variation of the language are permitted. Leaving out all of them gives you standard Haskell 98. - NB. turning on an option that enables special syntax + Generally speaking, all the language options are introduced by "" or ""; + e.g. . Before anything else is done, the string following + "" is normalised by removing hyphens and converting + to lower case. So , , and + are all equivalent. + + + All the language options can be turned off by using the prefix ""; + e.g. "". + + Language options recognised by Cabal can also be enabled using the LANGUAGE pragma, + thus {-# LANGUAGE TemplateHaskell #-} (see >). + + All the language options can be introduced with "" as well as "", + but this is a deprecated feature for backward compatibility. Use the "" + or LANGUAGE-pragma form. + + Turning on an option that enables special syntax might cause working Haskell 98 code to fail to compile, perhaps because it uses a variable name which has become a reserved word. So, together with each option below, we @@ -81,7 +98,8 @@ documentation describes all the libraries that come with GHC. This simultaneously enables all of the extensions to Haskell 98 described in , except where otherwise - noted. + noted. We are trying to move away from this portmanteau flag, + and towards enabling features individaully. New reserved words: forall (only in types), mdo. @@ -95,14 +113,20 @@ documentation describes all the libraries that come with GHC. float##, (#, #), |), {|. + + Implies these specific language options: + , + , + , + , + . - and : - - + and : + This option enables the language extension defined in the @@ -114,7 +138,7 @@ documentation describes all the libraries that come with GHC. - ,: + ,: These two flags control how generalisation is done. @@ -125,8 +149,8 @@ documentation describes all the libraries that come with GHC. - : - + : + Use GHCi's extended default rules in a regular module (). @@ -137,16 +161,16 @@ documentation describes all the libraries that come with GHC. - - + + - - + + - - + + @@ -171,8 +195,8 @@ documentation describes all the libraries that come with GHC. - - + + See . Independent of @@ -190,8 +214,8 @@ documentation describes all the libraries that come with GHC. - - + + See . Independent of @@ -200,13 +224,13 @@ documentation describes all the libraries that come with GHC. - + - -fno-implicit-prelude + -XnoImplicitPrelude option GHC normally imports Prelude.hi files for you. If you'd rather it didn't, then give it a - option. The idea is + option. The idea is that you can then import a Prelude of your own. (But don't call it Prelude; the Haskell module namespace is flat, and you must not conflict with any @@ -221,14 +245,14 @@ documentation describes all the libraries that come with GHC. translation for list comprehensions continues to use Prelude.map etc. - However, does + However, does change the handling of certain built-in syntax: see . - + Enables implicit parameters (see ). Currently also implied by @@ -241,7 +265,7 @@ documentation describes all the libraries that come with GHC. - + Enables overloaded string literals (see ). @@ -249,7 +273,7 @@ documentation describes all the libraries that come with GHC. - + Enables lexically-scoped type variables (see ). Implied by @@ -258,7 +282,7 @@ documentation describes all the libraries that come with GHC. - + , Enables Template Haskell (see ). This flag must @@ -835,7 +859,7 @@ This name is not supported by GHC. hierarchy. It completely defeats that purpose if the literal "1" means "Prelude.fromInteger 1", which is what the Haskell Report specifies. - So the flag causes + So the flag causes the following pieces of built-in syntax to refer to whatever is in scope, not the Prelude versions: @@ -1780,7 +1804,8 @@ and Ralf Hinze's may use different notation to that implemented in GHC. -The rest of this section outlines the extensions to GHC that support GADTs. +The rest of this section outlines the extensions to GHC that support GADTs. The extension is enabled with +. A GADT can only be declared using GADT-style syntax (); @@ -2683,9 +2708,9 @@ makes instance inference go into a loop, because it requires the constraint Nevertheless, GHC allows you to experiment with more liberal rules. If you use -the experimental flag --fallow-undecidable-instances -option, both the Paterson Conditions and the Coverage Condition +the experimental flag +-X=AllowUndecidableInstances, +both the Paterson Conditions and the Coverage Condition (described in ) are lifted. Termination is ensured by having a fixed-depth recursion stack. If you exceed the stack depth you get a sort of backtrace, and the opportunity to increase the stack depth @@ -2701,11 +2726,11 @@ with N. In general, GHC requires that that it be unambiguous which instance declaration should be used to resolve a type-class constraint. This behaviour -can be modified by two flags: --fallow-overlapping-instances +can be modified by two flags: +-X=AllowOverlappingInstances -and --fallow-incoherent-instances +and +-X=AllowIncoherentInstances , as this section discusses. Both these flags are dynamic flags, and can be set on a per-module basis, using an OPTIONS_GHC pragma if desired (). @@ -2733,7 +2758,7 @@ particular constraint matches more than one. -The flag instructs GHC to allow +The flag instructs GHC to allow more than one instance to match, provided there is a most specific one. For example, the constraint C Int [Int] matches instances (A), (C) and (D), but the last is more specific, and hence is chosen. If there is no @@ -2750,22 +2775,22 @@ Suppose that from the RHS of f we get the constraint GHC does not commit to instance (C), because in a particular call of f, b might be instantiate to Int, in which case instance (D) would be more specific still. -So GHC rejects the program. If you add the flag , +So GHC rejects the program. If you add the flag , GHC will instead pick (C), without complaining about the problem of subsequent instantiations. The willingness to be overlapped or incoherent is a property of the instance declaration itself, controlled by the -presence or otherwise of the -and flags when that mdodule is +presence or otherwise of the +and flags when that mdodule is being defined. Neither flag is required in a module that imports and uses the instance declaration. Specifically, during the lookup process: An instance declaration is ignored during the lookup process if (a) a more specific match is found, and (b) the instance declaration was compiled with -. The flag setting for the +. The flag setting for the more-specific instance does not matter. @@ -2773,7 +2798,7 @@ Suppose an instance declaration does not matche the constraint being looked up, does unify with it, so that it might match when the constraint is further instantiated. Usually GHC will regard this as a reason for not committing to some other constraint. But if the instance declaration was compiled with -, GHC will skip the "does-it-unify?" +, GHC will skip the "does-it-unify?" check for that declaration. @@ -2782,18 +2807,18 @@ overlapping instances without the library client having to know. If an instance declaration is compiled without -, +, then that instance can never be overlapped. This could perhaps be inconvenient. Perhaps the rule should instead say that the overlapping instance declaration should be compiled in this way, rather than the overlapped one. Perhaps overlap at a usage site should be permitted regardless of how the instance declarations -are compiled, if the flag is +are compiled, if the flag is used at the usage site. (Mind you, the exact usage site can occasionally be hard to pin down.) We are interested to receive feedback on these points. -The flag implies the - flag, but not vice versa. +The flag implies the + flag, but not vice versa. @@ -2976,7 +3001,7 @@ Boston, Jan 2000. due to Jeff Lewis.) Implicit parameter support is enabled with the option -. +. A variable is called dynamically bound when it is bound by the calling @@ -4064,7 +4089,7 @@ pattern binding must have the same context. For example, this is fine: GHC supports overloaded string literals. Normally a string literal has type String, but with overloaded string -literals enabled (with -foverloaded-strings) +literals enabled (with -X=OverloadedStrings) a string literal has type (IsString a) => a. @@ -4090,7 +4115,7 @@ it explicitly (for exmaple, to give an instance declaration for it), you can imp from module GHC.Exts. -Haskell's defaulting mechanism is extended to cover string literals, when is specified. +Haskell's defaulting mechanism is extended to cover string literals, when is specified. Specifically: @@ -4153,7 +4178,7 @@ wiki page on type families. The material will be moved to this user's guide when it has stabilised. -Type families are enabled by the flag . +Type families are enabled by the flag . @@ -4202,9 +4227,10 @@ Tim Sheard is going to expand it.) Template Haskell has the following new syntactic constructions. You need to use the flag - + or + to switch these syntactic extensions on - ( is no longer implied by + ( is no longer implied by ). @@ -4350,7 +4376,7 @@ pr s = gen (parse s) Now run the compiler (here we are a Cygwin prompt on Windows): -$ ghc --make -fth main.hs -o main.exe +$ ghc --make -X=TemplateHaskell main.hs -o main.exe Run "main.exe" and here is your output: @@ -4439,7 +4465,7 @@ Palgrave, 2003. and the arrows web page at http://www.haskell.org/arrows/. -With the flag, GHC supports the arrow +With the flag, GHC supports the arrow notation described in the second of these papers. What follows is a brief introduction to the notation; it won't make much sense unless you've read Hughes's paper. @@ -4909,7 +4935,7 @@ prime feature description contains more discussion and examples than the material below. -Bang patterns are enabled by the flag . +Bang patterns are enabled by the flag . @@ -6457,7 +6483,7 @@ where clause and over-ride whichever methods you please. Use the flags (to enable the extra syntax), - (to generate extra per-data-type code), + (to generate extra per-data-type code), and (to make the Generics library available. @@ -6666,21 +6692,21 @@ carried out at let and where bindings. Switching off the dreaded Monomorphism Restriction - + Haskell's monomorphism restriction (see Section 4.5.5 of the Haskell Report) can be completely switched off by -. +. Monomorphic pattern bindings - - + + As an experimental change, we are exploring the possibility of making pattern bindings monomorphic; that is, not generalised at all. @@ -6696,7 +6722,7 @@ can be completely switched off by [x] = e -- A pattern binding Experimentally, GHC now makes pattern bindings monomorphic by -default. Use to recover the +default. Use to recover the standard behaviour. -- 1.7.10.4