Implement fuzzy matching for the renamer
[ghc-hetmet.git] / compiler / main / DynFlags.hs
index 116ff32..6167980 100644 (file)
@@ -133,6 +133,7 @@ data DynFlag
    | Opt_D_dump_foreign
    | Opt_D_dump_inlinings
    | Opt_D_dump_rule_firings
+   | Opt_D_dump_rule_rewrites
    | Opt_D_dump_occur_anal
    | Opt_D_dump_parsed
    | Opt_D_dump_rn
@@ -268,6 +269,7 @@ data DynFlag
    | Opt_BuildingCabalPackage
    | Opt_SSE2
    | Opt_GhciSandbox
+   | Opt_HelpfulErrors
 
        -- temporary flags
    | Opt_RunCPS
@@ -303,7 +305,7 @@ data ExtensionFlag
    | Opt_ForeignFunctionInterface
    | Opt_UnliftedFFITypes
    | Opt_GHCForeignImportPrim
-   | Opt_PArr                           -- Syntactic support for parallel arrays
+   | Opt_ParallelArrays                 -- Syntactic support for parallel arrays
    | Opt_Arrows                         -- Arrow-notation syntax
    | Opt_TemplateHaskell
    | Opt_QuasiQuotes
@@ -320,6 +322,7 @@ data ExtensionFlag
    | Opt_RecordPuns
    | Opt_ViewPatterns
    | Opt_GADTs
+   | Opt_GADTSyntax
    | Opt_NPlusKPatterns
    | Opt_DoAndIfThenElse
    | Opt_RebindableSyntax
@@ -356,11 +359,12 @@ data ExtensionFlag
    | Opt_ImpredicativeTypes
    | Opt_TypeOperators
    | Opt_PackageImports
-   | Opt_NewQualifiedOperators
    | Opt_ExplicitForAll
    | Opt_AlternativeLayoutRule
    | Opt_AlternativeLayoutRuleTransitional
    | Opt_DatatypeContexts
+   | Opt_NondecreasingIndentation
+   | Opt_RelaxedLayout
    deriving (Eq, Show)
 
 -- | Contains not only a collection of 'DynFlag's but also a plethora of
@@ -794,6 +798,7 @@ languageExtensions Nothing
       -- In due course I'd like Opt_MonoLocalBinds to be on by default
       -- But NB it's implied by GADTs etc
       -- SLPJ September 2010
+    : Opt_NondecreasingIndentation -- This has been on by default for some time
     : languageExtensions (Just Haskell2010)
 
 languageExtensions (Just Haskell98)
@@ -1228,6 +1233,7 @@ dynamic_flags = [
   , Flag "ddump-foreign"           (setDumpFlag Opt_D_dump_foreign)
   , Flag "ddump-inlinings"         (setDumpFlag Opt_D_dump_inlinings)
   , Flag "ddump-rule-firings"      (setDumpFlag Opt_D_dump_rule_firings)
+  , Flag "ddump-rule-rewrites"     (setDumpFlag Opt_D_dump_rule_rewrites)
   , Flag "ddump-occur-anal"        (setDumpFlag Opt_D_dump_occur_anal)
   , Flag "ddump-parsed"            (setDumpFlag Opt_D_dump_parsed)
   , Flag "ddump-rn"                (setDumpFlag Opt_D_dump_rn)
@@ -1345,13 +1351,13 @@ dynamic_flags = [
   , Flag "fglasgow-exts"    (NoArg (enableGlasgowExts >> deprecate "Use individual extensions instead"))
   , Flag "fno-glasgow-exts" (NoArg (disableGlasgowExts >> deprecate "Use individual extensions instead"))
  ]
- ++ map (mkFlag True  "f"    setDynFlag  ) fFlags
- ++ map (mkFlag False "fno-" unSetDynFlag) fFlags
- ++ map (mkFlag True  "f"    setExtensionFlag  ) fLangFlags
- ++ map (mkFlag False "fno-" unSetExtensionFlag) fLangFlags
- ++ map (mkFlag True  "X"    setExtensionFlag  ) xFlags
- ++ map (mkFlag False "XNo"  unSetExtensionFlag) xFlags
- ++ map (mkFlag True  "X"    setLanguage) languageFlags
+ ++ map (mkFlag turnOn  "f"    setDynFlag  ) fFlags
+ ++ map (mkFlag turnOff "fno-" unSetDynFlag) fFlags
+ ++ map (mkFlag turnOn  "f"    setExtensionFlag  ) fLangFlags
+ ++ map (mkFlag turnOff "fno-" unSetExtensionFlag) fLangFlags
+ ++ map (mkFlag turnOn  "X"    setExtensionFlag  ) xFlags
+ ++ map (mkFlag turnOff "XNo"  unSetExtensionFlag) xFlags
+ ++ map (mkFlag turnOn  "X"    setLanguage) languageFlags
 
 package_flags :: [Flag (CmdLineP DynFlags)]
 package_flags = [
@@ -1368,37 +1374,39 @@ package_flags = [
                                                   ; deprecate "Use -package instead" }))
   ]
 
-type FlagSpec flag 
-   = ( String  -- Flag in string form
-     , flag     -- Flag in internal form
-     , Bool -> DynP ())         -- Extra action to run when the flag is found
-                                -- Typically, emit a warning or error
-                                -- True  <=> we are turning the flag on
+type TurnOnFlag = Bool   -- True  <=> we are turning the flag on
                                 -- False <=> we are turning the flag off
+turnOn  :: TurnOnFlag; turnOn = True
+turnOff :: TurnOnFlag; turnOff = False
 
+type FlagSpec flag
+   = ( String  -- Flag in string form
+     , flag     -- Flag in internal form
+     , TurnOnFlag -> DynP ())    -- Extra action to run when the flag is found
+                                 -- Typically, emit a warning or error
 
-mkFlag :: Bool                  -- ^ True <=> it should be turned on
+mkFlag :: TurnOnFlag            -- ^ True <=> it should be turned on
        -> String                -- ^ The flag prefix
        -> (flag -> DynP ())    -- ^ What to do when the flag is found
        -> FlagSpec flag                -- ^ Specification of this particular flag
        -> Flag (CmdLineP DynFlags)
-mkFlag turnOn flagPrefix f (name, flag, extra_action)
-    = Flag (flagPrefix ++ name) (NoArg (f flag >> extra_action turnOn))
+mkFlag turn_on flagPrefix f (name, flag, extra_action)
+    = Flag (flagPrefix ++ name) (NoArg (f flag >> extra_action turn_on))
 
-deprecatedForExtension :: String -> Bool -> DynP ()
+deprecatedForExtension :: String -> TurnOnFlag -> DynP ()
 deprecatedForExtension lang turn_on
     = deprecate ("use -X"  ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead")
     where 
       flag | turn_on    = lang
            | otherwise = "No"++lang
 
-useInstead :: String -> Bool -> DynP ()
+useInstead :: String -> TurnOnFlag -> DynP ()
 useInstead flag turn_on
   = deprecate ("Use -f" ++ no ++ flag ++ " instead")
   where
     no = if turn_on then "" else "no-"
 
-nop :: Bool -> DynP ()
+nop :: TurnOnFlag -> DynP ()
 nop _ = return ()
 
 -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
@@ -1481,6 +1489,7 @@ fFlags = [
   ( "ext-core",                         Opt_EmitExternalCore, nop ),
   ( "shared-implib",                    Opt_SharedImplib, nop ),
   ( "ghci-sandbox",                     Opt_GhciSandbox, nop ),
+  ( "helpful-errors",                   Opt_HelpfulErrors, nop ),
   ( "building-cabal-package",           Opt_BuildingCabalPackage, nop ),
   ( "implicit-import-qualified",        Opt_ImplicitImportQualified, nop )
   ]
@@ -1512,8 +1521,10 @@ fLangFlags = [
     deprecatedForExtension "ImplicitParams" ),
   ( "scoped-type-variables",            Opt_ScopedTypeVariables,
     deprecatedForExtension "ScopedTypeVariables" ),
-  ( "parr",                             Opt_PArr,
-    deprecatedForExtension "PArr" ),
+  ( "parr",                             Opt_ParallelArrays,
+    deprecatedForExtension "ParallelArrays" ),
+  ( "PArr",                             Opt_ParallelArrays,
+    deprecatedForExtension "ParallelArrays" ),
   ( "allow-overlapping-instances",      Opt_OverlappingInstances,
     deprecatedForExtension "OverlappingInstances" ),
   ( "allow-undecidable-instances",      Opt_UndecidableInstances,
@@ -1565,7 +1576,7 @@ xFlags = [
     deprecatedForExtension "DoRec"),
   ( "DoRec",                            Opt_DoRec, nop ),
   ( "Arrows",                           Opt_Arrows, nop ),
-  ( "PArr",                             Opt_PArr, nop ),
+  ( "ParallelArrays",                   Opt_ParallelArrays, nop ),
   ( "TemplateHaskell",                  Opt_TemplateHaskell, checkTemplateHaskellOk ),
   ( "QuasiQuotes",                      Opt_QuasiQuotes, nop ),
   ( "Generics",                         Opt_Generics, nop ),
@@ -1577,6 +1588,7 @@ xFlags = [
   ( "DisambiguateRecordFields",         Opt_DisambiguateRecordFields, nop ),
   ( "OverloadedStrings",                Opt_OverloadedStrings, nop ),
   ( "GADTs",                            Opt_GADTs, nop ),
+  ( "GADTSyntax",                       Opt_GADTSyntax, nop ),
   ( "ViewPatterns",                     Opt_ViewPatterns, nop ),
   ( "TypeFamilies",                     Opt_TypeFamilies, nop ),
   ( "BangPatterns",                     Opt_BangPatterns, nop ),
@@ -1589,6 +1601,8 @@ xFlags = [
   ( "AlternativeLayoutRule",            Opt_AlternativeLayoutRule, nop ),
   ( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, nop ),
   ( "DatatypeContexts",                 Opt_DatatypeContexts, nop ),
+  ( "NondecreasingIndentation",         Opt_NondecreasingIndentation, nop ),
+  ( "RelaxedLayout",                    Opt_RelaxedLayout, nop ),
   ( "MonoLocalBinds",                   Opt_MonoLocalBinds, nop ),
   ( "RelaxedPolyRec",                   Opt_RelaxedPolyRec, 
     \ turn_on -> if not turn_on 
@@ -1617,9 +1631,7 @@ xFlags = [
   ( "OverlappingInstances",             Opt_OverlappingInstances, nop ),
   ( "UndecidableInstances",             Opt_UndecidableInstances, nop ),
   ( "IncoherentInstances",              Opt_IncoherentInstances, nop ),
-  ( "PackageImports",                   Opt_PackageImports, nop ),
-  ( "NewQualifiedOperators",            Opt_NewQualifiedOperators,
-    \_ -> deprecate "The new qualified operator syntax was rejected by Haskell'" )
+  ( "PackageImports",                   Opt_PackageImports, nop )
   ]
 
 defaultFlags :: [DynFlag]
@@ -1634,7 +1646,8 @@ defaultFlags
       Opt_GenManifest,
       Opt_EmbedManifest,
       Opt_PrintBindContents,
-      Opt_GhciSandbox
+      Opt_GhciSandbox,
+      Opt_HelpfulErrors
     ]
 
     ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
@@ -1642,30 +1655,32 @@ defaultFlags
 
     ++ standardWarnings
 
-impliedFlags :: [(ExtensionFlag, ExtensionFlag)]
+impliedFlags :: [(ExtensionFlag, TurnOnFlag, ExtensionFlag)]
 impliedFlags
-  = [ (Opt_RankNTypes,                Opt_ExplicitForAll)
-    , (Opt_Rank2Types,                Opt_ExplicitForAll)
-    , (Opt_ScopedTypeVariables,       Opt_ExplicitForAll)
-    , (Opt_LiberalTypeSynonyms,       Opt_ExplicitForAll)
-    , (Opt_ExistentialQuantification, Opt_ExplicitForAll)
-    , (Opt_PolymorphicComponents,     Opt_ExplicitForAll)
+  = [ (Opt_RankNTypes,                turnOn, Opt_ExplicitForAll)
+    , (Opt_Rank2Types,                turnOn, Opt_ExplicitForAll)
+    , (Opt_ScopedTypeVariables,       turnOn, Opt_ExplicitForAll)
+    , (Opt_LiberalTypeSynonyms,       turnOn, Opt_ExplicitForAll)
+    , (Opt_ExistentialQuantification, turnOn, Opt_ExplicitForAll)
+    , (Opt_PolymorphicComponents,     turnOn, Opt_ExplicitForAll)
+    , (Opt_FlexibleInstances,         turnOn, Opt_TypeSynonymInstances)
 
-    , (Opt_RebindableSyntax,          Opt_ImplicitPrelude)
+    , (Opt_RebindableSyntax, turnOff, Opt_ImplicitPrelude)      -- NB: turn off!
 
-    , (Opt_GADTs,                  Opt_MonoLocalBinds)
-    , (Opt_TypeFamilies,           Opt_MonoLocalBinds)
+    , (Opt_GADTs,            turnOn, Opt_GADTSyntax)
+    , (Opt_GADTs,            turnOn, Opt_MonoLocalBinds)
+    , (Opt_TypeFamilies,     turnOn, Opt_MonoLocalBinds)
 
-    , (Opt_TypeFamilies,        Opt_KindSignatures)  -- Type families use kind signatures
+    , (Opt_TypeFamilies,     turnOn, Opt_KindSignatures)  -- Type families use kind signatures
                                                     -- all over the place
 
-    , (Opt_ImpredicativeTypes,  Opt_RankNTypes)
+    , (Opt_ImpredicativeTypes,  turnOn, Opt_RankNTypes)
 
        -- Record wild-cards implies field disambiguation
        -- Otherwise if you write (C {..}) you may well get
        -- stuff like " 'a' not in scope ", which is a bit silly
        -- if the compiler has just filled in field 'a' of constructor 'C'
-    , (Opt_RecordWildCards,     Opt_DisambiguateRecordFields)
+    , (Opt_RecordWildCards,     turnOn, Opt_DisambiguateRecordFields)
   ]
 
 optLevelFlags :: [([Int], DynFlag)]
@@ -1860,16 +1875,18 @@ unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
 --------------------------
 setExtensionFlag, unSetExtensionFlag :: ExtensionFlag -> DynP ()
 setExtensionFlag f = do { upd (\dfs -> xopt_set dfs f)
-                        ; mapM_ setExtensionFlag deps }
+                        ; sequence_ deps }
   where
-    deps = [ d | (f', d) <- impliedFlags, f' == f ]
+    deps = [ if turn_on then setExtensionFlag   d
+                        else unSetExtensionFlag d
+           | (f', turn_on, d) <- impliedFlags, f' == f ]
         -- When you set f, set the ones it implies
         -- NB: use setExtensionFlag recursively, in case the implied flags
         --     implies further flags
-        -- When you un-set f, however, we don't un-set the things it implies
-        --      (except for -fno-glasgow-exts, which is treated specially)
 
 unSetExtensionFlag f = upd (\dfs -> xopt_unset dfs f)
+   -- When you un-set f, however, we don't un-set the things it implies
+   --      (except for -fno-glasgow-exts, which is treated specially)
 
 --------------------------
 setDumpFlag' :: DynFlag -> DynP ()
@@ -2272,8 +2289,6 @@ compilerInfo = [("Project name",                String cProjectName),
                 ("Have interpreter",            String cGhcWithInterpreter),
                 ("Object splitting",            String cSplitObjs),
                 ("Have native code generator",  String cGhcWithNativeCodeGen),
-                ("Have llvm code generator",    String cGhcWithLlvmCodeGen),
-                ("Use archives for ghci",       String (show cUseArchivesForGhci)),
                 ("Support SMP",                 String cGhcWithSMP),
                 ("Unregisterised",              String cGhcUnregisterised),
                 ("Tables next to code",         String cGhcEnableTablesNextToCode),