Merge branch 'master' into type-nats
authorIavor S. Diatchki <diatchki@galois.com>
Mon, 20 Jun 2011 17:31:59 +0000 (10:31 -0700)
committerIavor S. Diatchki <diatchki@galois.com>
Mon, 20 Jun 2011 17:31:59 +0000 (10:31 -0700)
Conflicts:
compiler/main/DynFlags.hs
compiler/parser/Lexer.x

1  2 
compiler/iface/BinIface.hs
compiler/iface/IfaceSyn.lhs
compiler/iface/TcIface.lhs
compiler/main/DynFlags.hs
compiler/parser/Lexer.x
compiler/parser/Parser.y.pp
compiler/typecheck/TcErrors.lhs
compiler/typecheck/TcSMonad.lhs
compiler/typecheck/TcSplice.lhs

@@@ -390,7 -390,8 +390,8 @@@ instance Binary ModIface wher
                 mi_rules     = rules,
                 mi_orphan_hash = orphan_hash,
                   mi_vect_info = vect_info,
-                mi_hpc       = hpc_info }) = do
+                mi_hpc       = hpc_info,
+                mi_trust     = trust }) = do
        put_ bh mod
        put_ bh is_boot
        put_ bh iface_hash
        put_ bh orphan_hash
          put_ bh vect_info
        put_ bh hpc_info
+       put_ bh trust
  
     get bh = do
        mod_name  <- get bh
        orphan_hash <- get bh
          vect_info <- get bh
          hpc_info  <- get bh
+         trust     <- get bh
        return (ModIface {
                 mi_module    = mod_name,
                 mi_boot      = is_boot,
                 mi_orphan_hash = orphan_hash,
                   mi_vect_info = vect_info,
                 mi_hpc       = hpc_info,
+                mi_trust     = trust,
                        -- And build the cached values
                 mi_warn_fn   = mkIfaceWarnCache warns,
                 mi_fix_fn    = mkIfaceFixCache fixities,
@@@ -507,12 -511,14 +511,14 @@@ instance Binary Usage wher
          putByte bh 0
        put_ bh (usg_mod usg)
        put_ bh (usg_mod_hash usg)
+       put_ bh (usg_safe     usg)
      put_ bh usg@UsageHomeModule{} = do 
          putByte bh 1
        put_ bh (usg_mod_name usg)
        put_ bh (usg_mod_hash usg)
        put_ bh (usg_exports  usg)
        put_ bh (usg_entities usg)
+       put_ bh (usg_safe     usg)
  
      get bh = do
          h <- getByte bh
            0 -> do
              nm    <- get bh
              mod   <- get bh
-             return UsagePackageModule { usg_mod = nm, usg_mod_hash = mod }
+             safe  <- get bh
+             return UsagePackageModule { usg_mod = nm, usg_mod_hash = mod, usg_safe = safe }
            _ -> do
              nm    <- get bh
              mod   <- get bh
              exps  <- get bh
              ents  <- get bh
+             safe  <- get bh
              return UsageHomeModule { usg_mod_name = nm, usg_mod_hash = mod,
-                             usg_exports = exps, usg_entities = ents }
+                      usg_exports = exps, usg_entities = ents, usg_safe = safe }
  
  instance Binary Warnings where
      put_ bh NoWarnings     = putByte bh 0
@@@ -884,9 -892,6 +892,9 @@@ instance Binary IfaceType wher
      put_ bh (IfacePredTy aq) = do
            putByte bh 5
            put_ bh aq
 +    put_ bh (IfaceLiteralTy n) = do
 +          putByte bh 30
 +          put_ bh n
  
        -- Simple compression for common cases of TyConApp
      put_ bh (IfaceTyConApp IfaceIntTc  [])   = putByte bh 6
      put_ bh (IfaceTyConApp IfaceUnliftedTypeKindTc []) = putByte bh 14
      put_ bh (IfaceTyConApp IfaceUbxTupleKindTc [])     = putByte bh 15
      put_ bh (IfaceTyConApp IfaceArgTypeKindTc [])      = putByte bh 16
 +    put_ bh (IfaceTyConApp IfaceNatKindTc [])          = putByte bh 31
      put_ bh (IfaceTyConApp (IfaceAnyTc k) [])                = do { putByte bh 17; put_ bh k }
  
        -- Generic cases
                      return (IfaceFunTy ag ah)
              5 -> do ap <- get bh
                      return (IfacePredTy ap)
 +              30 -> do n <- get bh
 +                       return (IfaceLiteralTy n)
  
                -- Now the special cases for TyConApp
              6 -> return (IfaceTyConApp IfaceIntTc [])
                14 -> return (IfaceTyConApp IfaceUnliftedTypeKindTc [])
                15 -> return (IfaceTyConApp IfaceUbxTupleKindTc [])
                16 -> return (IfaceTyConApp IfaceArgTypeKindTc [])
 +              31 -> return (IfaceTyConApp IfaceNatKindTc [])
                17 -> do { k <- get bh; return (IfaceTyConApp (IfaceAnyTc k) []) }
  
              18 -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp (IfaceTc tc) tys) }
              19  -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp tc tys) }
              _  -> do { cc <- get bh; tys <- get bh; return (IfaceCoConApp cc tys) }
  
 +instance Binary IfaceTyLit where
 +  put_ bh (IfaceNumberTyLit n)  = putByte bh 1 >> put_ bh n
 +
 +  get bh =
 +    do tag <- getByte bh
 +       case tag of
 +         1 -> do n <- get bh
 +                 return (IfaceNumberTyLit n)
 +
 +
  instance Binary IfaceTyCon where
        -- Int,Char,Bool can't show up here because they can't not be saturated
     put_ bh IfaceIntTc               = putByte bh 1
     put_ bh IfaceUnliftedTypeKindTc = putByte bh 8
     put_ bh IfaceUbxTupleKindTc     = putByte bh 9
     put_ bh IfaceArgTypeKindTc      = putByte bh 10
 +   put_ bh IfaceNatKindTc          = putByte bh 14
     put_ bh (IfaceTupTc bx ar)  = do { putByte bh 11; put_ bh bx; put_ bh ar }
     put_ bh (IfaceTc ext)       = do { putByte bh 12; put_ bh ext }
     put_ bh (IfaceAnyTc k)      = do { putByte bh 13; put_ bh k }
            8 -> return IfaceUnliftedTypeKindTc
            9 -> return IfaceUbxTupleKindTc
            10 -> return IfaceArgTypeKindTc
 +          14 -> return IfaceNatKindTc
          11 -> do { bx <- get bh; ar <- get bh; return (IfaceTupTc bx ar) }
          12 -> do { ext <- get bh; return (IfaceTc ext) }
          _ -> do { k <- get bh; return (IfaceAnyTc k) }
@@@ -1418,14 -1407,15 +1426,15 @@@ instance Binary IfaceFamInst wher
                return (IfaceFamInst fam tys tycon)
  
  instance Binary OverlapFlag where
-     put_ bh NoOverlap  = putByte bh 0
-     put_ bh OverlapOk  = putByte bh 1
-     put_ bh Incoherent = putByte bh 2
+     put_ bh (NoOverlap  b) = putByte bh 0 >> put_ bh b
+     put_ bh (OverlapOk  b) = putByte bh 1 >> put_ bh b
+     put_ bh (Incoherent b) = putByte bh 2 >> put_ bh b
      get bh = do h <- getByte bh
+                 b <- get bh
                case h of
-                 0 -> return NoOverlap
-                 1 -> return OverlapOk
-                 2 -> return Incoherent
+                 0 -> return $ NoOverlap b
+                 1 -> return $ OverlapOk b
+                 2 -> return $ Incoherent b
                  _ -> panic ("get OverlapFlag " ++ show h)
  
  instance Binary IfaceConDecls where
@@@ -1541,4 -1531,7 +1550,7 @@@ instance Binary IfaceVectInfo wher
            a5 <- get bh
            return (IfaceVectInfo a1 a2 a3 a4 a5)
  
+ instance Binary IfaceTrustInfo where
+     put_ bh iftrust = putByte bh $ trustInfoToNum iftrust
+     get bh = getByte bh >>= (return . numToTrustInfo)
  
@@@ -341,7 -341,7 +341,7 @@@ and suppose we are compiling module X
          data T = ...
          instance C S T where ...
  
- If we base the instance verion on T, I'm worried that changing S to S'
+ If we base the instance version on T, I'm worried that changing S to S'
  would change T's version, but not S or S'.  But an importing module might
  not depend on T, and so might not be recompiled even though the new instance
  (C S' T) might be relevant.  I have not been able to make a concrete example,
@@@ -788,7 -788,6 +788,7 @@@ freeNamesIfType (IfaceTyConApp tc ts) 
  freeNamesIfType (IfaceForAllTy tv t)  =
     freeNamesIfTvBndr tv &&& freeNamesIfType t
  freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 +freeNamesIfType (IfaceLiteralTy _)    = emptyNameSet
  freeNamesIfType (IfaceCoConApp tc ts) = 
     freeNamesIfCo tc &&& fnList freeNamesIfType ts
  
@@@ -265,10 -265,10 +265,10 @@@ typecheckIface ifac
        ; writeMutVar tc_env_var type_env
  
                -- Now do those rules, instances and annotations
-       ; insts     <- mapM tcIfaceInst    (mi_insts     iface)
+       ; insts     <- mapM tcIfaceInst (mi_insts iface)
        ; fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
        ; rules     <- tcIfaceRules ignore_prags (mi_rules iface)
-       ; anns      <- tcIfaceAnnotations  (mi_anns iface)
+       ; anns      <- tcIfaceAnnotations (mi_anns iface)
  
                  -- Vectorisation information
          ; vect_info <- tcIfaceVectInfo (mi_module iface) type_env 
@@@ -590,11 -590,11 +590,11 @@@ look at it
  \begin{code}
  tcIfaceInst :: IfaceInst -> IfL Instance
  tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
-                        ifInstCls = cls, ifInstTys = mb_tcs })
-   = do        { dfun    <- forkM (ptext (sLit "Dict fun") <+> ppr dfun_occ) $
-                    tcIfaceExtId dfun_occ
-         ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
-       ; return (mkImportedInstance cls mb_tcs' dfun oflag) }
+                               ifInstCls = cls, ifInstTys = mb_tcs })
+   = do { dfun    <- forkM (ptext (sLit "Dict fun") <+> ppr dfun_occ) $
+                      tcIfaceExtId dfun_occ
+        ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
+        ; return (mkImportedInstance cls mb_tcs' dfun oflag) }
  
  tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
  tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon, 
@@@ -792,7 -792,6 +792,7 @@@ tcIfaceVectInfo mod typeEnv (IfaceVectI
  \begin{code}
  tcIfaceType :: IfaceType -> IfL Type
  tcIfaceType (IfaceTyVar n)        = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
 +tcIfaceType (IfaceLiteralTy l)    = do { l <- tcIfaceTyLit l; return (LiteralTy l) }
  tcIfaceType (IfaceAppTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
  tcIfaceType (IfaceFunTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
  tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkTyConApp tc' ts') }
@@@ -815,12 -814,6 +815,12 @@@ tcIfacePred tc (IfaceEqPred t1 t2
  -----------------------------------------
  tcIfaceCtxt :: IfaceContext -> IfL ThetaType
  tcIfaceCtxt sts = mapM (tcIfacePred tcIfaceType) sts
 +
 +
 +-----------------------------------------
 +tcIfaceTyLit :: IfaceTyLit -> IfL TyLit
 +tcIfaceTyLit (IfaceNumberTyLit n) = return (NumberTyLit n)
 +
  \end{code}
  
  %************************************************************************
@@@ -840,7 -833,6 +840,7 @@@ tcIfaceCo (IfaceForAllTy tv t)  = bindI
                                    mkForAllCo tv' <$> tcIfaceCo t
  -- tcIfaceCo (IfacePredTy co)      = mkPredCo <$> tcIfacePred tcIfaceCo co
  tcIfaceCo (IfacePredTy _)      = panic "tcIfaceCo"
 +tcIfaceCo t@(IfaceLiteralTy _) = mkReflCo <$> tcIfaceType t
  
  tcIfaceCoApp :: IfaceCoCon -> [IfaceType] -> IfL Coercion
  tcIfaceCoApp IfaceReflCo    [t]     = Refl         <$> tcIfaceType t
@@@ -1253,7 -1245,6 +1253,7 @@@ tcIfaceTyCon IfaceOpenTypeKindTc     = 
  tcIfaceTyCon IfaceUnliftedTypeKindTc = return unliftedTypeKindTyCon
  tcIfaceTyCon IfaceArgTypeKindTc      = return argTypeKindTyCon
  tcIfaceTyCon IfaceUbxTupleKindTc     = return ubxTupleKindTyCon
 +tcIfaceTyCon IfaceNatKindTc          = return natKindTyCon
  
  -- Even though we are in an interface file, we want to make
  -- sure the instances and RULES of this tycon are loaded 
@@@ -32,6 -32,11 +32,11 @@@ module DynFlags 
          DPHBackend(..), dphPackageMaybe,
          wayNames,
  
+         -- ** SafeHaskell
+         SafeHaskellMode(..),
+         safeHaskellOn, safeLanguageOn,
+         safeDirectImpsReq, safeImplicitImpsReq,
          Settings(..),
          ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings,
          extraGccViaCFlags, systemPackageConfig,
@@@ -53,8 -58,8 +58,8 @@@
          doingTickyProfiling,
  
          -- ** Parsing DynFlags
-         parseDynamicFlags,
-         parseDynamicNoPackageFlags,
+         parseDynamicFlagsCmdLine,
+         parseDynamicFilePragma,
          allFlags,
  
          supportedLanguagesAndExtensions,
@@@ -282,6 -287,7 +287,7 @@@ data DynFla
     | Opt_SplitObjs
     | Opt_StgStats
     | Opt_HideAllPackages
+    | Opt_DistrustAllPackages
     | Opt_PrintBindResult
     | Opt_Haddock
     | Opt_HaddockOptions
  
  data Language = Haskell98 | Haskell2010
  
+ -- | The various SafeHaskell modes
+ data SafeHaskellMode
+    = Sf_None
+    | Sf_SafeImports
+    | Sf_SafeLanguage
+    | Sf_Trustworthy
+    | Sf_TrustworthyWithSafeLanguage
+    | Sf_Safe
+    deriving (Eq)
+ instance Outputable SafeHaskellMode where
+     ppr Sf_None = ptext $ sLit "None"
+     ppr Sf_SafeImports = ptext $ sLit "SafeImports"
+     ppr Sf_SafeLanguage = ptext $ sLit "SafeLanguage"
+     ppr Sf_Trustworthy = ptext $ sLit "Trustworthy"
+     ppr Sf_TrustworthyWithSafeLanguage = ptext $ sLit "Trustworthy + SafeLanguage"
+     ppr Sf_Safe = ptext $ sLit "Safe"
  data ExtensionFlag
     = Opt_Cpp
     | Opt_OverlappingInstances
     | Opt_DatatypeContexts
     | Opt_NondecreasingIndentation
     | Opt_RelaxedLayout
 +   | Opt_TypeNaturals
     deriving (Eq, Show)
  
  -- | Contains not only a collection of 'DynFlag's but also a plethora of
@@@ -512,6 -535,8 +536,8 @@@ data DynFlags = DynFlags 
    flags                 :: [DynFlag],
    -- Don't change this without updating extensionFlags:
    language              :: Maybe Language,
+   -- | Safe Haskell mode
+   safeHaskell           :: SafeHaskellMode,
    -- Don't change this without updating extensionFlags:
    extensions            :: [OnOff ExtensionFlag],
    -- extensionFlags should always be equal to
@@@ -710,10 -735,12 +736,12 @@@ doingTickyProfiling _ = opt_Tick
    -- static.  If the way flags were made dynamic, we could fix this.
  
  data PackageFlag
-   = ExposePackage  String
+   = ExposePackage   String
    | ExposePackageId String
-   | HidePackage    String
-   | IgnorePackage  String
+   | HidePackage     String
+   | IgnorePackage   String
+   | TrustPackage    String
+   | DistrustPackage String
    deriving Eq
  
  defaultHscTarget :: HscTarget
@@@ -832,6 -859,7 +860,7 @@@ defaultDynFlags mySettings 
          haddockOptions = Nothing,
          flags = defaultFlags,
          language = Nothing,
+         safeHaskell = Sf_None,
          extensions = [],
          extensionFlags = flattenExtensionFlags Nothing [],
  
@@@ -941,6 -969,7 +970,7 @@@ xopt_unset dfs 
        in dfs { extensions = onoffs,
                 extensionFlags = flattenExtensionFlags (language dfs) onoffs }
  
+ -- | Set the Haskell language standard to use
  setLanguage :: Language -> DynP ()
  setLanguage l = upd f
      where f dfs = let mLang = Just l
                           extensionFlags = flattenExtensionFlags mLang oneoffs
                       }
  
+ safeLanguageOn :: DynFlags -> Bool
+ safeLanguageOn dflags = s == Sf_SafeLanguage
+                      || s == Sf_TrustworthyWithSafeLanguage
+                      || s == Sf_Safe
+                           where s = safeHaskell dflags
+ -- | Test if SafeHaskell is on in some form
+ safeHaskellOn :: DynFlags -> Bool
+ safeHaskellOn dflags = safeHaskell dflags /= Sf_None
+ -- | Set a 'SafeHaskell' flag
+ setSafeHaskell :: SafeHaskellMode -> DynP ()
+ setSafeHaskell s = updM f
+     where f dfs = do
+               let sf = safeHaskell dfs
+               safeM <- combineSafeFlags sf s
+               return $ dfs { safeHaskell = safeM }
+ -- | Are all direct imports required to be safe for this SafeHaskell mode?
+ -- Direct imports are when the code explicitly imports a module
+ safeDirectImpsReq :: DynFlags -> Bool
+ safeDirectImpsReq = safeLanguageOn
+ -- | Are all implicit imports required to be safe for this SafeHaskell mode?
+ -- Implicit imports are things in the prelude. e.g System.IO when print is used.
+ safeImplicitImpsReq :: DynFlags -> Bool
+ safeImplicitImpsReq = safeLanguageOn
+ -- | Combine two SafeHaskell modes correctly. Used for dealing with multiple flags.
+ -- This makes SafeHaskell very much a monoid but for now I prefer this as I don't
+ -- want to export this functionality from the module but do want to export the
+ -- type constructors.
+ combineSafeFlags :: SafeHaskellMode -> SafeHaskellMode -> DynP SafeHaskellMode
+ combineSafeFlags a b =
+     case (a,b) of
+         (Sf_None, sf) -> return sf
+         (sf, Sf_None) -> return sf
+         (Sf_SafeImports, sf) -> return sf
+         (sf, Sf_SafeImports) -> return sf
+         (Sf_SafeLanguage, Sf_Safe) -> err
+         (Sf_Safe, Sf_SafeLanguage) -> err
+         (Sf_SafeLanguage, Sf_Trustworthy) -> return Sf_TrustworthyWithSafeLanguage
+         (Sf_Trustworthy, Sf_SafeLanguage) -> return Sf_TrustworthyWithSafeLanguage
+         (Sf_TrustworthyWithSafeLanguage, Sf_Trustworthy)  -> return Sf_TrustworthyWithSafeLanguage
+         (Sf_TrustworthyWithSafeLanguage, Sf_SafeLanguage) -> return Sf_TrustworthyWithSafeLanguage
+         (Sf_Trustworthy, Sf_TrustworthyWithSafeLanguage)  -> return Sf_TrustworthyWithSafeLanguage
+         (Sf_SafeLanguage, Sf_TrustworthyWithSafeLanguage) -> return Sf_TrustworthyWithSafeLanguage
+         (Sf_Trustworthy, Sf_Safe) -> err
+         (Sf_Safe, Sf_Trustworthy) -> err
+         (a,b) | a == b -> return a
+               | otherwise -> err
+     where err = do
+               let s = "Incompatible SafeHaskell flags! (" ++ showPpr a ++ ", " ++ showPpr b ++ ")"
+               addErr s
+               return $ panic s -- Just for saftey instead of returning say, a
  -- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
  getOpts :: DynFlags             -- ^ 'DynFlags' to retrieve the options from
          -> (DynFlags -> [a])    -- ^ Relevant record accessor: one of the @opt_*@ accessors
@@@ -1053,6 -1145,7 +1146,7 @@@ data Optio
                        -- transformed (e.g., "/out=")
                String  -- the filepath/filename portion
   | Option     String
+  deriving ( Eq )
  
  showOpt :: Option -> String
  showOpt (FileOption pre f) = pre ++ f
@@@ -1108,26 -1201,27 +1202,27 @@@ getStgToDo dflag
  -- the parsed 'DynFlags', the left-over arguments, and a list of warnings.
  -- Throws a 'UsageError' if errors occurred during parsing (such as unknown
  -- flags or missing arguments).
- parseDynamicFlags :: Monad m =>
+ parseDynamicFlagsCmdLine :: Monad m =>
                       DynFlags -> [Located String]
                    -> m (DynFlags, [Located String], [Located String])
                       -- ^ Updated 'DynFlags', left-over arguments, and
                       -- list of warnings.
- parseDynamicFlags dflags args = parseDynamicFlags_ dflags args True
+ parseDynamicFlagsCmdLine dflags args = parseDynamicFlags dflags args True
  
- -- | Like 'parseDynamicFlags' but does not allow the package flags (-package,
- -- -hide-package, -ignore-package, -hide-all-packages, -package-conf).
- parseDynamicNoPackageFlags :: Monad m =>
+ -- | Like 'parseDynamicFlagsCmdLine' but does not allow the package flags
+ -- (-package, -hide-package, -ignore-package, -hide-all-packages, -package-conf).
+ -- Used to parse flags set in a modules pragma.
+ parseDynamicFilePragma :: Monad m =>
                       DynFlags -> [Located String]
                    -> m (DynFlags, [Located String], [Located String])
                       -- ^ Updated 'DynFlags', left-over arguments, and
                       -- list of warnings.
- parseDynamicNoPackageFlags dflags args = parseDynamicFlags_ dflags args False
+ parseDynamicFilePragma dflags args = parseDynamicFlags dflags args False
  
- parseDynamicFlags_ :: Monad m =>
+ parseDynamicFlags :: Monad m =>
                        DynFlags -> [Located String] -> Bool
                    -> m (DynFlags, [Located String], [Located String])
- parseDynamicFlags_ dflags0 args pkg_flags = do
+ parseDynamicFlags dflags0 args cmdline = do
    -- XXX Legacy support code
    -- We used to accept things like
    --     optdep-f  -optdepdepend
        args' = f args
  
        -- Note: -ignore-package (package_flags) must precede -i* (dynamic_flags)
-       flag_spec | pkg_flags = package_flags ++ dynamic_flags
+       flag_spec | cmdline   = package_flags ++ dynamic_flags
                  | otherwise = dynamic_flags
  
+   let safeLevel = if safeLanguageOn dflags0
+                      then determineSafeLevel cmdline else NeverAllowed
    let ((leftover, errs, warns), dflags1)
-           = runCmdLine (processArgs flag_spec args') dflags0
+           = runCmdLine (processArgs flag_spec args' safeLevel cmdline) dflags0
    when (not (null errs)) $ ghcError $ errorsToGhcException errs
  
-   return (dflags1, leftover, warns)
+   -- check for disabled flags in safe haskell
+   -- Hack: unfortunately flags that are completely disabled can't be stopped from being
+   -- enabled on the command line before a -XSafe or -XSafeLanguage flag is encountered.
+   -- the easiest way to fix this is to just check that they aren't enabled now. The down
+   -- side is that flags marked as NeverAllowed must also be checked here placing a sync
+   -- burden on the ghc hacker.
+   let (dflags2, sh_warns) = if (safeLanguageOn dflags1)
+                                 then shFlagsDisallowed dflags1
+                                 else (dflags1, [])
+   return (dflags2, leftover, sh_warns ++ warns)
+ -- | Extensions that can't be enabled at all when compiling in Safe mode
+ -- checkSafeHaskellFlags :: MonadIO m => DynFlags -> m ()
+ shFlagsDisallowed :: DynFlags -> (DynFlags, [Located String])
+ shFlagsDisallowed dflags = foldl check_method (dflags, []) bad_flags
+     where
+         check_method (df, warns) (test,str,fix)
+             | test df   = (fix df, warns ++ safeFailure str)
+             | otherwise = (df, warns)
+         bad_flags = [(xopt Opt_GeneralizedNewtypeDeriving, "-XGeneralizedNewtypeDeriving",
+                      flip xopt_unset Opt_GeneralizedNewtypeDeriving),
+                      (xopt Opt_TemplateHaskell, "-XTemplateHaskell",
+                      flip xopt_unset Opt_TemplateHaskell)]
+         safeFailure str = [L noSrcSpan $ "Warning: " ++ str ++ " is not allowed in"
+                                       ++ " SafeHaskell; ignoring " ++ str]
  
  
  {- **********************************************************************
@@@ -1165,301 -1288,301 +1289,301 @@@ allFlags = map ('-':) 
             map ("f"++) flags' ++
             map ("X"++) supportedExtensions
      where ok (PrefixPred _ _) = False
-           ok _ = True
-           flags = [ name | (name, _, _) <- fFlags ]
-           flags' = [ name | (name, _, _) <- fLangFlags ]
+           ok _   = True
+           flags  = [ name | (name, _, _, _) <- fFlags ]
+           flags' = [ name | (name, _, _, _) <- fLangFlags ]
  
  --------------- The main flags themselves ------------------
  dynamic_flags :: [Flag (CmdLineP DynFlags)]
  dynamic_flags = [
-     Flag "n"        (NoArg (addWarn "The -n flag is deprecated and no longer has any effect"))
-   , Flag "cpp"      (NoArg (setExtensionFlag Opt_Cpp)) 
-   , Flag "F"        (NoArg (setDynFlag Opt_Pp)) 
-   , Flag "#include" 
+     flagA "n"        (NoArg (addWarn "The -n flag is deprecated and no longer has any effect"))
+   , flagA "cpp"      (NoArg (setExtensionFlag Opt_Cpp)) 
+   , flagA "F"        (NoArg (setDynFlag Opt_Pp)) 
+   , flagA "#include" 
           (HasArg (\s -> do { addCmdlineHCInclude s
                             ; addWarn "-#include and INCLUDE pragmas are deprecated: They no longer have any effect" }))
-   , Flag "v"        (OptIntSuffix setVerbosity)
+   , flagA "v"        (OptIntSuffix setVerbosity)
  
          ------- Specific phases  --------------------------------------------
      -- need to appear before -pgmL to be parsed as LLVM flags.
-   , Flag "pgmlo"          (hasArg (\f -> alterSettings (\s -> s { sPgm_lo  = (f,[])})))
-   , Flag "pgmlc"          (hasArg (\f -> alterSettings (\s -> s { sPgm_lc  = (f,[])})))
-   , Flag "pgmL"           (hasArg (\f -> alterSettings (\s -> s { sPgm_L   = f})))
-   , Flag "pgmP"           (hasArg setPgmP)
-   , Flag "pgmF"           (hasArg (\f -> alterSettings (\s -> s { sPgm_F   = f})))
-   , Flag "pgmc"           (hasArg (\f -> alterSettings (\s -> s { sPgm_c   = (f,[])})))
-   , Flag "pgmm"           (HasArg (\_ -> addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release"))
-   , Flag "pgms"           (hasArg (\f -> alterSettings (\s -> s { sPgm_s   = (f,[])})))
-   , Flag "pgma"           (hasArg (\f -> alterSettings (\s -> s { sPgm_a   = (f,[])})))
-   , Flag "pgml"           (hasArg (\f -> alterSettings (\s -> s { sPgm_l   = (f,[])})))
-   , Flag "pgmdll"         (hasArg (\f -> alterSettings (\s -> s { sPgm_dll = (f,[])})))
-   , Flag "pgmwindres"     (hasArg (\f -> alterSettings (\s -> s { sPgm_windres = f})))
+   , flagA "pgmlo"          (hasArg (\f -> alterSettings (\s -> s { sPgm_lo  = (f,[])})))
+   , flagA "pgmlc"          (hasArg (\f -> alterSettings (\s -> s { sPgm_lc  = (f,[])})))
+   , flagA "pgmL"           (hasArg (\f -> alterSettings (\s -> s { sPgm_L   = f})))
+   , flagA "pgmP"           (hasArg setPgmP)
+   , flagA "pgmF"           (hasArg (\f -> alterSettings (\s -> s { sPgm_F   = f})))
+   , flagA "pgmc"           (hasArg (\f -> alterSettings (\s -> s { sPgm_c   = (f,[])})))
+   , flagA "pgmm"           (HasArg (\_ -> addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release"))
+   , flagA "pgms"           (hasArg (\f -> alterSettings (\s -> s { sPgm_s   = (f,[])})))
+   , flagA "pgma"           (hasArg (\f -> alterSettings (\s -> s { sPgm_a   = (f,[])})))
+   , flagA "pgml"           (hasArg (\f -> alterSettings (\s -> s { sPgm_l   = (f,[])})))
+   , flagA "pgmdll"         (hasArg (\f -> alterSettings (\s -> s { sPgm_dll = (f,[])})))
+   , flagA "pgmwindres"     (hasArg (\f -> alterSettings (\s -> s { sPgm_windres = f})))
  
      -- need to appear before -optl/-opta to be parsed as LLVM flags.
-   , Flag "optlo"          (hasArg (\f -> alterSettings (\s -> s { sOpt_lo  = f : sOpt_lo s})))
-   , Flag "optlc"          (hasArg (\f -> alterSettings (\s -> s { sOpt_lc  = f : sOpt_lc s})))
-   , Flag "optL"           (hasArg (\f -> alterSettings (\s -> s { sOpt_L   = f : sOpt_L s})))
-   , Flag "optP"           (hasArg addOptP)
-   , Flag "optF"           (hasArg (\f -> alterSettings (\s -> s { sOpt_F   = f : sOpt_F s})))
-   , Flag "optc"           (hasArg (\f -> alterSettings (\s -> s { sOpt_c   = f : sOpt_c s})))
-   , Flag "optm"           (hasArg (\f -> alterSettings (\s -> s { sOpt_m   = f : sOpt_m s})))
-   , Flag "opta"           (hasArg (\f -> alterSettings (\s -> s { sOpt_a   = f : sOpt_a s})))
-   , Flag "optl"           (hasArg addOptl)
-   , Flag "optwindres"     (hasArg (\f -> alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s})))
-   , Flag "split-objs"
+   , flagA "optlo"          (hasArg (\f -> alterSettings (\s -> s { sOpt_lo  = f : sOpt_lo s})))
+   , flagA "optlc"          (hasArg (\f -> alterSettings (\s -> s { sOpt_lc  = f : sOpt_lc s})))
+   , flagA "optL"           (hasArg (\f -> alterSettings (\s -> s { sOpt_L   = f : sOpt_L s})))
+   , flagA "optP"           (hasArg addOptP)
+   , flagA "optF"           (hasArg (\f -> alterSettings (\s -> s { sOpt_F   = f : sOpt_F s})))
+   , flagA "optc"           (hasArg (\f -> alterSettings (\s -> s { sOpt_c   = f : sOpt_c s})))
+   , flagA "optm"           (hasArg (\f -> alterSettings (\s -> s { sOpt_m   = f : sOpt_m s})))
+   , flagA "opta"           (hasArg (\f -> alterSettings (\s -> s { sOpt_a   = f : sOpt_a s})))
+   , flagA "optl"           (hasArg addOptl)
+   , flagA "optwindres"     (hasArg (\f -> alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s})))
+   , flagA "split-objs"
           (NoArg (if can_split 
                   then setDynFlag Opt_SplitObjs
                   else addWarn "ignoring -fsplit-objs"))
  
          -------- ghc -M -----------------------------------------------------
-   , Flag "dep-suffix"     (hasArg addDepSuffix)
-   , Flag "optdep-s"       (hasArgDF addDepSuffix "Use -dep-suffix instead")
-   , Flag "dep-makefile"   (hasArg setDepMakefile)
-   , Flag "optdep-f"       (hasArgDF setDepMakefile "Use -dep-makefile instead")
-   , Flag "optdep-w"       (NoArg  (deprecate "doesn't do anything"))
-   , Flag "include-pkg-deps"         (noArg (setDepIncludePkgDeps True))
-   , Flag "optdep--include-prelude"  (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
-   , Flag "optdep--include-pkg-deps" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
-   , Flag "exclude-module"           (hasArg addDepExcludeMod)
-   , Flag "optdep--exclude-module"   (hasArgDF addDepExcludeMod "Use -exclude-module instead")
-   , Flag "optdep-x"                 (hasArgDF addDepExcludeMod "Use -exclude-module instead")
+   , flagA "dep-suffix"     (hasArg addDepSuffix)
+   , flagA "optdep-s"       (hasArgDF addDepSuffix "Use -dep-suffix instead")
+   , flagA "dep-makefile"   (hasArg setDepMakefile)
+   , flagA "optdep-f"       (hasArgDF setDepMakefile "Use -dep-makefile instead")
+   , flagA "optdep-w"       (NoArg  (deprecate "doesn't do anything"))
+   , flagA "include-pkg-deps"         (noArg (setDepIncludePkgDeps True))
+   , flagA "optdep--include-prelude"  (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
+   , flagA "optdep--include-pkg-deps" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
+   , flagA "exclude-module"           (hasArg addDepExcludeMod)
+   , flagA "optdep--exclude-module"   (hasArgDF addDepExcludeMod "Use -exclude-module instead")
+   , flagA "optdep-x"                 (hasArgDF addDepExcludeMod "Use -exclude-module instead")
  
          -------- Linking ----------------------------------------------------
-   , Flag "no-link"            (noArg (\d -> d{ ghcLink=NoLink }))
-   , Flag "shared"             (noArg (\d -> d{ ghcLink=LinkDynLib }))
-   , Flag "dynload"            (hasArg parseDynLibLoaderMode)
-   , Flag "dylib-install-name" (hasArg setDylibInstallName)
+   , flagA "no-link"            (noArg (\d -> d{ ghcLink=NoLink }))
+   , flagA "shared"             (noArg (\d -> d{ ghcLink=LinkDynLib }))
+   , flagA "dynload"            (hasArg parseDynLibLoaderMode)
+   , flagA "dylib-install-name" (hasArg setDylibInstallName)
  
          ------- Libraries ---------------------------------------------------
-   , Flag "L"   (Prefix addLibraryPath)
-   , Flag "l"   (hasArg (addOptl . ("-l" ++)))
+   , flagA "L"   (Prefix addLibraryPath)
+   , flagA "l"   (hasArg (addOptl . ("-l" ++)))
  
          ------- Frameworks --------------------------------------------------
          -- -framework-path should really be -F ...
-   , Flag "framework-path" (HasArg addFrameworkPath)
-   , Flag "framework"      (hasArg addCmdlineFramework)
+   , flagA "framework-path" (HasArg addFrameworkPath)
+   , flagA "framework"      (hasArg addCmdlineFramework)
  
          ------- Output Redirection ------------------------------------------
-   , Flag "odir"              (hasArg setObjectDir)
-   , Flag "o"                 (SepArg (upd . setOutputFile . Just))
-   , Flag "ohi"               (hasArg (setOutputHi . Just ))
-   , Flag "osuf"              (hasArg setObjectSuf)
-   , Flag "hcsuf"             (hasArg setHcSuf)
-   , Flag "hisuf"             (hasArg setHiSuf)
-   , Flag "hidir"             (hasArg setHiDir)
-   , Flag "tmpdir"            (hasArg setTmpDir)
-   , Flag "stubdir"           (hasArg setStubDir)
-   , Flag "outputdir"         (hasArg setOutputDir)
-   , Flag "ddump-file-prefix" (hasArg (setDumpPrefixForce . Just))
+   , flagA "odir"              (hasArg setObjectDir)
+   , flagA "o"                 (SepArg (upd . setOutputFile . Just))
+   , flagA "ohi"               (hasArg (setOutputHi . Just ))
+   , flagA "osuf"              (hasArg setObjectSuf)
+   , flagA "hcsuf"             (hasArg setHcSuf)
+   , flagA "hisuf"             (hasArg setHiSuf)
+   , flagA "hidir"             (hasArg setHiDir)
+   , flagA "tmpdir"            (hasArg setTmpDir)
+   , flagA "stubdir"           (hasArg setStubDir)
+   , flagA "outputdir"         (hasArg setOutputDir)
+   , flagA "ddump-file-prefix" (hasArg (setDumpPrefixForce . Just))
  
          ------- Keeping temporary files -------------------------------------
       -- These can be singular (think ghc -c) or plural (think ghc --make)
-   , Flag "keep-hc-file"     (NoArg (setDynFlag Opt_KeepHcFiles))
-   , Flag "keep-hc-files"    (NoArg (setDynFlag Opt_KeepHcFiles))
-   , Flag "keep-s-file"      (NoArg (setDynFlag Opt_KeepSFiles))
-   , Flag "keep-s-files"     (NoArg (setDynFlag Opt_KeepSFiles))
-   , Flag "keep-raw-s-file"  (NoArg (addWarn "The -keep-raw-s-file flag does nothing; it will be removed in a future GHC release"))
-   , Flag "keep-raw-s-files" (NoArg (addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release"))
-   , Flag "keep-llvm-file"   (NoArg (setDynFlag Opt_KeepLlvmFiles))
-   , Flag "keep-llvm-files"  (NoArg (setDynFlag Opt_KeepLlvmFiles))
+   , flagA "keep-hc-file"     (NoArg (setDynFlag Opt_KeepHcFiles))
+   , flagA "keep-hc-files"    (NoArg (setDynFlag Opt_KeepHcFiles))
+   , flagA "keep-s-file"      (NoArg (setDynFlag Opt_KeepSFiles))
+   , flagA "keep-s-files"     (NoArg (setDynFlag Opt_KeepSFiles))
+   , flagA "keep-raw-s-file"  (NoArg (addWarn "The -keep-raw-s-file flag does nothing; it will be removed in a future GHC release"))
+   , flagA "keep-raw-s-files" (NoArg (addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release"))
+   , flagA "keep-llvm-file"   (NoArg (setDynFlag Opt_KeepLlvmFiles))
+   , flagA "keep-llvm-files"  (NoArg (setDynFlag Opt_KeepLlvmFiles))
       -- This only makes sense as plural
-   , Flag "keep-tmp-files"   (NoArg (setDynFlag Opt_KeepTmpFiles))
+   , flagA "keep-tmp-files"   (NoArg (setDynFlag Opt_KeepTmpFiles))
  
          ------- Miscellaneous ----------------------------------------------
-   , Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages))
-   , Flag "no-hs-main"     (NoArg (setDynFlag Opt_NoHsMain))
-   , Flag "with-rtsopts"   (HasArg setRtsOpts)
-   , Flag "rtsopts"        (NoArg (setRtsOptsEnabled RtsOptsAll))
-   , Flag "rtsopts=all"    (NoArg (setRtsOptsEnabled RtsOptsAll))
-   , Flag "rtsopts=some"   (NoArg (setRtsOptsEnabled RtsOptsSafeOnly))
-   , Flag "rtsopts=none"   (NoArg (setRtsOptsEnabled RtsOptsNone))
-   , Flag "no-rtsopts"     (NoArg (setRtsOptsEnabled RtsOptsNone))
-   , Flag "main-is"        (SepArg setMainIs)
-   , Flag "haddock"        (NoArg (setDynFlag Opt_Haddock))
-   , Flag "haddock-opts"   (hasArg addHaddockOpts)
-   , Flag "hpcdir"         (SepArg setOptHpcDir)
+   , flagA "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages))
+   , flagA "no-hs-main"     (NoArg (setDynFlag Opt_NoHsMain))
+   , flagA "with-rtsopts"   (HasArg setRtsOpts)
+   , flagA "rtsopts"        (NoArg (setRtsOptsEnabled RtsOptsAll))
+   , flagA "rtsopts=all"    (NoArg (setRtsOptsEnabled RtsOptsAll))
+   , flagA "rtsopts=some"   (NoArg (setRtsOptsEnabled RtsOptsSafeOnly))
+   , flagA "rtsopts=none"   (NoArg (setRtsOptsEnabled RtsOptsNone))
+   , flagA "no-rtsopts"     (NoArg (setRtsOptsEnabled RtsOptsNone))
+   , flagA "main-is"        (SepArg setMainIs)
+   , flagA "haddock"        (NoArg (setDynFlag Opt_Haddock))
+   , flagA "haddock-opts"   (hasArg addHaddockOpts)
+   , flagA "hpcdir"         (SepArg setOptHpcDir)
  
          ------- recompilation checker --------------------------------------
-   , Flag "recomp"         (NoArg (do { unSetDynFlag Opt_ForceRecomp
+   , flagA "recomp"         (NoArg (do { unSetDynFlag Opt_ForceRecomp
                                       ; deprecate "Use -fno-force-recomp instead" }))
-   , Flag "no-recomp"      (NoArg (do { setDynFlag Opt_ForceRecomp
+   , flagA "no-recomp"      (NoArg (do { setDynFlag Opt_ForceRecomp
                                       ; deprecate "Use -fforce-recomp instead" }))
  
          ------ HsCpp opts ---------------------------------------------------
-   , Flag "D"              (AnySuffix (upd . addOptP))
-   , Flag "U"              (AnySuffix (upd . addOptP))
+   , flagA "D"              (AnySuffix (upd . addOptP))
+   , flagA "U"              (AnySuffix (upd . addOptP))
  
          ------- Include/Import Paths ----------------------------------------
-   , Flag "I"              (Prefix    addIncludePath)
-   , Flag "i"              (OptPrefix addImportPath)
+   , flagA "I"              (Prefix    addIncludePath)
+   , flagA "i"              (OptPrefix addImportPath)
  
          ------ Debugging ----------------------------------------------------
-   , Flag "dstg-stats"     (NoArg (setDynFlag Opt_StgStats))
-   , Flag "ddump-cmm"               (setDumpFlag Opt_D_dump_cmm)
-   , Flag "ddump-raw-cmm"           (setDumpFlag Opt_D_dump_raw_cmm)
-   , Flag "ddump-cmmz"              (setDumpFlag Opt_D_dump_cmmz)
-   , Flag "ddump-cmmz-pretty"       (setDumpFlag Opt_D_dump_cmmz_pretty)
-   , Flag "ddump-cmmz-cbe"          (setDumpFlag Opt_D_dump_cmmz_cbe)
-   , Flag "ddump-cmmz-spills"       (setDumpFlag Opt_D_dump_cmmz_spills)
-   , Flag "ddump-cmmz-proc"         (setDumpFlag Opt_D_dump_cmmz_proc)
-   , Flag "ddump-cmmz-rewrite"      (setDumpFlag Opt_D_dump_cmmz_rewrite)
-   , Flag "ddump-cmmz-dead"         (setDumpFlag Opt_D_dump_cmmz_dead)
-   , Flag "ddump-cmmz-stub"         (setDumpFlag Opt_D_dump_cmmz_stub)
-   , Flag "ddump-cmmz-sp"           (setDumpFlag Opt_D_dump_cmmz_sp)
-   , Flag "ddump-cmmz-procmap"      (setDumpFlag Opt_D_dump_cmmz_procmap)
-   , Flag "ddump-cmmz-split"        (setDumpFlag Opt_D_dump_cmmz_split)
-   , Flag "ddump-cmmz-lower"        (setDumpFlag Opt_D_dump_cmmz_lower)
-   , Flag "ddump-cmmz-info"         (setDumpFlag Opt_D_dump_cmmz_info)
-   , Flag "ddump-cmmz-cafs"         (setDumpFlag Opt_D_dump_cmmz_cafs)
-   , Flag "ddump-core-stats"        (setDumpFlag Opt_D_dump_core_stats)
-   , Flag "ddump-cps-cmm"           (setDumpFlag Opt_D_dump_cps_cmm)
-   , Flag "ddump-cvt-cmm"           (setDumpFlag Opt_D_dump_cvt_cmm)
-   , Flag "ddump-asm"               (setDumpFlag Opt_D_dump_asm)
-   , Flag "ddump-asm-native"        (setDumpFlag Opt_D_dump_asm_native)
-   , Flag "ddump-asm-liveness"      (setDumpFlag Opt_D_dump_asm_liveness)
-   , Flag "ddump-asm-coalesce"      (setDumpFlag Opt_D_dump_asm_coalesce)
-   , Flag "ddump-asm-regalloc"      (setDumpFlag Opt_D_dump_asm_regalloc)
-   , Flag "ddump-asm-conflicts"     (setDumpFlag Opt_D_dump_asm_conflicts)
-   , Flag "ddump-asm-regalloc-stages" (setDumpFlag Opt_D_dump_asm_regalloc_stages)
-   , Flag "ddump-asm-stats"         (setDumpFlag Opt_D_dump_asm_stats)
-   , Flag "ddump-asm-expanded"      (setDumpFlag Opt_D_dump_asm_expanded)
-   , Flag "ddump-llvm"              (NoArg (do { setObjTarget HscLlvm
-                                               ; setDumpFlag' Opt_D_dump_llvm}))
-   , Flag "ddump-cpranal"           (setDumpFlag Opt_D_dump_cpranal)
-   , Flag "ddump-deriv"             (setDumpFlag Opt_D_dump_deriv)
-   , Flag "ddump-ds"                (setDumpFlag Opt_D_dump_ds)
-   , Flag "ddump-flatC"             (setDumpFlag Opt_D_dump_flatC)
-   , 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)
-   , Flag "ddump-core-pipeline"     (setDumpFlag Opt_D_dump_core_pipeline)
-   , Flag "ddump-simpl"             (setDumpFlag Opt_D_dump_simpl)
-   , Flag "ddump-simpl-iterations"  (setDumpFlag Opt_D_dump_simpl_iterations)
-   , Flag "ddump-simpl-phases"      (OptPrefix setDumpSimplPhases)
-   , Flag "ddump-spec"              (setDumpFlag Opt_D_dump_spec)
-   , Flag "ddump-prep"              (setDumpFlag Opt_D_dump_prep)
-   , Flag "ddump-stg"               (setDumpFlag Opt_D_dump_stg)
-   , Flag "ddump-stranal"           (setDumpFlag Opt_D_dump_stranal)
-   , Flag "ddump-tc"                (setDumpFlag Opt_D_dump_tc)
-   , Flag "ddump-types"             (setDumpFlag Opt_D_dump_types)
-   , Flag "ddump-rules"             (setDumpFlag Opt_D_dump_rules)
-   , Flag "ddump-cse"               (setDumpFlag Opt_D_dump_cse)
-   , Flag "ddump-worker-wrapper"    (setDumpFlag Opt_D_dump_worker_wrapper)
-   , Flag "ddump-rn-trace"          (setDumpFlag Opt_D_dump_rn_trace)
-   , Flag "ddump-if-trace"          (setDumpFlag Opt_D_dump_if_trace)
-   , Flag "ddump-cs-trace"          (setDumpFlag Opt_D_dump_cs_trace)
-   , Flag "ddump-tc-trace"          (setDumpFlag Opt_D_dump_tc_trace)
-   , Flag "ddump-vt-trace"          (setDumpFlag Opt_D_dump_vt_trace)
-   , Flag "ddump-splices"           (setDumpFlag Opt_D_dump_splices)
-   , Flag "ddump-rn-stats"          (setDumpFlag Opt_D_dump_rn_stats)
-   , Flag "ddump-opt-cmm"           (setDumpFlag Opt_D_dump_opt_cmm)
-   , Flag "ddump-simpl-stats"       (setDumpFlag Opt_D_dump_simpl_stats)
-   , Flag "ddump-bcos"              (setDumpFlag Opt_D_dump_BCOs)
-   , Flag "dsource-stats"           (setDumpFlag Opt_D_source_stats)
-   , Flag "dverbose-core2core"      (NoArg (do { setVerbosity (Just 2)
-                                               ; setVerboseCore2Core }))
-   , Flag "dverbose-stg2stg"        (setDumpFlag Opt_D_verbose_stg2stg)
-   , Flag "ddump-hi"                (setDumpFlag Opt_D_dump_hi)
-   , Flag "ddump-minimal-imports"   (setDumpFlag Opt_D_dump_minimal_imports)
-   , Flag "ddump-vect"              (setDumpFlag Opt_D_dump_vect)
-   , Flag "ddump-hpc"               (setDumpFlag Opt_D_dump_hpc)
-   , Flag "ddump-mod-cycles"        (setDumpFlag Opt_D_dump_mod_cycles)
-   , Flag "ddump-view-pattern-commoning" (setDumpFlag Opt_D_dump_view_pattern_commoning)
-   , Flag "ddump-to-file"           (setDumpFlag Opt_DumpToFile)
-   , Flag "ddump-hi-diffs"          (setDumpFlag Opt_D_dump_hi_diffs)
-   , Flag "ddump-rtti"            (setDumpFlag Opt_D_dump_rtti)
-   , Flag "dcore-lint"              (NoArg (setDynFlag Opt_DoCoreLinting))
-   , Flag "dstg-lint"               (NoArg (setDynFlag Opt_DoStgLinting))
-   , Flag "dcmm-lint"               (NoArg (setDynFlag Opt_DoCmmLinting))
-   , Flag "dasm-lint"               (NoArg (setDynFlag Opt_DoAsmLinting))
-   , Flag "dshow-passes"            (NoArg (do forceRecompile
-                                               setVerbosity (Just 2)))
-   , Flag "dfaststring-stats"       (NoArg (setDynFlag Opt_D_faststring_stats))
+   , flagA "dstg-stats"     (NoArg (setDynFlag Opt_StgStats))
+   , flagA "ddump-cmm"               (setDumpFlag Opt_D_dump_cmm)
+   , flagA "ddump-raw-cmm"           (setDumpFlag Opt_D_dump_raw_cmm)
+   , flagA "ddump-cmmz"              (setDumpFlag Opt_D_dump_cmmz)
+   , flagA "ddump-cmmz-pretty"       (setDumpFlag Opt_D_dump_cmmz_pretty)
+   , flagA "ddump-cmmz-cbe"          (setDumpFlag Opt_D_dump_cmmz_cbe)
+   , flagA "ddump-cmmz-spills"       (setDumpFlag Opt_D_dump_cmmz_spills)
+   , flagA "ddump-cmmz-proc"         (setDumpFlag Opt_D_dump_cmmz_proc)
+   , flagA "ddump-cmmz-rewrite"      (setDumpFlag Opt_D_dump_cmmz_rewrite)
+   , flagA "ddump-cmmz-dead"         (setDumpFlag Opt_D_dump_cmmz_dead)
+   , flagA "ddump-cmmz-stub"         (setDumpFlag Opt_D_dump_cmmz_stub)
+   , flagA "ddump-cmmz-sp"           (setDumpFlag Opt_D_dump_cmmz_sp)
+   , flagA "ddump-cmmz-procmap"      (setDumpFlag Opt_D_dump_cmmz_procmap)
+   , flagA "ddump-cmmz-split"        (setDumpFlag Opt_D_dump_cmmz_split)
+   , flagA "ddump-cmmz-lower"        (setDumpFlag Opt_D_dump_cmmz_lower)
+   , flagA "ddump-cmmz-info"         (setDumpFlag Opt_D_dump_cmmz_info)
+   , flagA "ddump-cmmz-cafs"         (setDumpFlag Opt_D_dump_cmmz_cafs)
+   , flagA "ddump-core-stats"        (setDumpFlag Opt_D_dump_core_stats)
+   , flagA "ddump-cps-cmm"           (setDumpFlag Opt_D_dump_cps_cmm)
+   , flagA "ddump-cvt-cmm"           (setDumpFlag Opt_D_dump_cvt_cmm)
+   , flagA "ddump-asm"               (setDumpFlag Opt_D_dump_asm)
+   , flagA "ddump-asm-native"        (setDumpFlag Opt_D_dump_asm_native)
+   , flagA "ddump-asm-liveness"      (setDumpFlag Opt_D_dump_asm_liveness)
+   , flagA "ddump-asm-coalesce"      (setDumpFlag Opt_D_dump_asm_coalesce)
+   , flagA "ddump-asm-regalloc"      (setDumpFlag Opt_D_dump_asm_regalloc)
+   , flagA "ddump-asm-conflicts"     (setDumpFlag Opt_D_dump_asm_conflicts)
+   , flagA "ddump-asm-regalloc-stages" (setDumpFlag Opt_D_dump_asm_regalloc_stages)
+   , flagA "ddump-asm-stats"         (setDumpFlag Opt_D_dump_asm_stats)
+   , flagA "ddump-asm-expanded"      (setDumpFlag Opt_D_dump_asm_expanded)
+   , flagA "ddump-llvm"              (NoArg (do { setObjTarget HscLlvm
+                                                ; setDumpFlag' Opt_D_dump_llvm}))
+   , flagA "ddump-cpranal"           (setDumpFlag Opt_D_dump_cpranal)
+   , flagA "ddump-deriv"             (setDumpFlag Opt_D_dump_deriv)
+   , flagA "ddump-ds"                (setDumpFlag Opt_D_dump_ds)
+   , flagA "ddump-flatC"             (setDumpFlag Opt_D_dump_flatC)
+   , flagA "ddump-foreign"           (setDumpFlag Opt_D_dump_foreign)
+   , flagA "ddump-inlinings"         (setDumpFlag Opt_D_dump_inlinings)
+   , flagA "ddump-rule-firings"      (setDumpFlag Opt_D_dump_rule_firings)
+   , flagA "ddump-rule-rewrites"     (setDumpFlag Opt_D_dump_rule_rewrites)
+   , flagA "ddump-occur-anal"        (setDumpFlag Opt_D_dump_occur_anal)
+   , flagA "ddump-parsed"            (setDumpFlag Opt_D_dump_parsed)
+   , flagA "ddump-rn"                (setDumpFlag Opt_D_dump_rn)
+   , flagA "ddump-core-pipeline"     (setDumpFlag Opt_D_dump_core_pipeline)
+   , flagA "ddump-simpl"             (setDumpFlag Opt_D_dump_simpl)
+   , flagA "ddump-simpl-iterations"  (setDumpFlag Opt_D_dump_simpl_iterations)
+   , flagA "ddump-simpl-phases"      (OptPrefix setDumpSimplPhases)
+   , flagA "ddump-spec"              (setDumpFlag Opt_D_dump_spec)
+   , flagA "ddump-prep"              (setDumpFlag Opt_D_dump_prep)
+   , flagA "ddump-stg"               (setDumpFlag Opt_D_dump_stg)
+   , flagA "ddump-stranal"           (setDumpFlag Opt_D_dump_stranal)
+   , flagA "ddump-tc"                (setDumpFlag Opt_D_dump_tc)
+   , flagA "ddump-types"             (setDumpFlag Opt_D_dump_types)
+   , flagA "ddump-rules"             (setDumpFlag Opt_D_dump_rules)
+   , flagA "ddump-cse"               (setDumpFlag Opt_D_dump_cse)
+   , flagA "ddump-worker-wrapper"    (setDumpFlag Opt_D_dump_worker_wrapper)
+   , flagA "ddump-rn-trace"          (setDumpFlag Opt_D_dump_rn_trace)
+   , flagA "ddump-if-trace"          (setDumpFlag Opt_D_dump_if_trace)
+   , flagA "ddump-cs-trace"          (setDumpFlag Opt_D_dump_cs_trace)
+   , flagA "ddump-tc-trace"          (setDumpFlag Opt_D_dump_tc_trace)
+   , flagA "ddump-vt-trace"          (setDumpFlag Opt_D_dump_vt_trace)
+   , flagA "ddump-splices"           (setDumpFlag Opt_D_dump_splices)
+   , flagA "ddump-rn-stats"          (setDumpFlag Opt_D_dump_rn_stats)
+   , flagA "ddump-opt-cmm"           (setDumpFlag Opt_D_dump_opt_cmm)
+   , flagA "ddump-simpl-stats"       (setDumpFlag Opt_D_dump_simpl_stats)
+   , flagA "ddump-bcos"              (setDumpFlag Opt_D_dump_BCOs)
+   , flagA "dsource-stats"           (setDumpFlag Opt_D_source_stats)
+   , flagA "dverbose-core2core"      (NoArg (do { setVerbosity (Just 2)
+                                                ; setVerboseCore2Core }))
+   , flagA "dverbose-stg2stg"        (setDumpFlag Opt_D_verbose_stg2stg)
+   , flagA "ddump-hi"                (setDumpFlag Opt_D_dump_hi)
+   , flagA "ddump-minimal-imports"   (setDumpFlag Opt_D_dump_minimal_imports)
+   , flagA "ddump-vect"              (setDumpFlag Opt_D_dump_vect)
+   , flagA "ddump-hpc"               (setDumpFlag Opt_D_dump_hpc)
+   , flagA "ddump-mod-cycles"        (setDumpFlag Opt_D_dump_mod_cycles)
+   , flagA "ddump-view-pattern-commoning" (setDumpFlag Opt_D_dump_view_pattern_commoning)
+   , flagA "ddump-to-file"           (setDumpFlag Opt_DumpToFile)
+   , flagA "ddump-hi-diffs"          (setDumpFlag Opt_D_dump_hi_diffs)
+   , flagA "ddump-rtti"           (setDumpFlag Opt_D_dump_rtti)
+   , flagA "dcore-lint"              (NoArg (setDynFlag Opt_DoCoreLinting))
+   , flagA "dstg-lint"               (NoArg (setDynFlag Opt_DoStgLinting))
+   , flagA "dcmm-lint"               (NoArg (setDynFlag Opt_DoCmmLinting))
+   , flagA "dasm-lint"               (NoArg (setDynFlag Opt_DoAsmLinting))
+   , flagA "dshow-passes"            (NoArg (do forceRecompile
+                                                setVerbosity (Just 2)))
+   , flagA "dfaststring-stats"       (NoArg (setDynFlag Opt_D_faststring_stats))
  
          ------ Machine dependant (-m<blah>) stuff ---------------------------
  
-   , Flag "monly-2-regs" (NoArg (addWarn "The -monly-2-regs flag does nothing; it will be removed in a future GHC release"))
-   , Flag "monly-3-regs" (NoArg (addWarn "The -monly-3-regs flag does nothing; it will be removed in a future GHC release"))
-   , Flag "monly-4-regs" (NoArg (addWarn "The -monly-4-regs flag does nothing; it will be removed in a future GHC release"))
-   , Flag "msse2"        (NoArg (setDynFlag Opt_SSE2))
+   , flagA "monly-2-regs" (NoArg (addWarn "The -monly-2-regs flag does nothing; it will be removed in a future GHC release"))
+   , flagA "monly-3-regs" (NoArg (addWarn "The -monly-3-regs flag does nothing; it will be removed in a future GHC release"))
+   , flagA "monly-4-regs" (NoArg (addWarn "The -monly-4-regs flag does nothing; it will be removed in a future GHC release"))
+   , flagA "msse2"        (NoArg (setDynFlag Opt_SSE2))
  
       ------ Warning opts -------------------------------------------------
-   , Flag "W"      (NoArg (mapM_ setDynFlag   minusWOpts))
-   , Flag "Werror" (NoArg (setDynFlag         Opt_WarnIsError))
-   , Flag "Wwarn"  (NoArg (unSetDynFlag       Opt_WarnIsError))
-   , Flag "Wall"   (NoArg (mapM_ setDynFlag   minusWallOpts))
-   , Flag "Wnot"   (NoArg (do { mapM_ unSetDynFlag minusWallOpts
+   , flagA "W"      (NoArg (mapM_ setDynFlag   minusWOpts))
+   , flagA "Werror" (NoArg (setDynFlag         Opt_WarnIsError))
+   , flagA "Wwarn"  (NoArg (unSetDynFlag       Opt_WarnIsError))
+   , flagA "Wall"   (NoArg (mapM_ setDynFlag   minusWallOpts))
+   , flagA "Wnot"   (NoArg (do { mapM_ unSetDynFlag minusWallOpts
                               ; deprecate "Use -w instead" }))
-   , Flag "w"      (NoArg (mapM_ unSetDynFlag minuswRemovesOpts))
+   , flagA "w"      (NoArg (mapM_ unSetDynFlag minuswRemovesOpts))
          
          ------ Plugin flags ------------------------------------------------
-   , Flag "fplugin"     (hasArg addPluginModuleName)
-   , Flag "fplugin-opt" (hasArg addPluginModuleNameOption)
+   , flagA "fplugin"     (hasArg addPluginModuleName)
+   , flagA "fplugin-opt" (hasArg addPluginModuleNameOption)
      
          ------ Optimisation flags ------------------------------------------
-   , Flag "O"      (noArgM (setOptLevel 1))
-   , Flag "Onot"   (noArgM (\dflags -> do deprecate "Use -O0 instead"
-                                          setOptLevel 0 dflags))
-   , Flag "Odph"   (noArgM setDPHOpt)
-   , Flag "O"      (optIntSuffixM (\mb_n -> setOptLevel (mb_n `orElse` 1)))
+   , flagA "O"      (noArgM (setOptLevel 1))
+   , flagA "Onot"   (noArgM (\dflags -> do deprecate "Use -O0 instead"
+                                           setOptLevel 0 dflags))
+   , flagA "Odph"   (noArgM setDPHOpt)
+   , flagA "O"      (optIntSuffixM (\mb_n -> setOptLevel (mb_n `orElse` 1)))
                  -- If the number is missing, use 1
  
-   , Flag "fsimplifier-phases"          (intSuffix (\n d -> d{ simplPhases = n }))
-   , Flag "fmax-simplifier-iterations"  (intSuffix (\n d -> d{ maxSimplIterations = n }))
-   , Flag "fspec-constr-threshold"      (intSuffix (\n d -> d{ specConstrThreshold = Just n }))
-   , Flag "fno-spec-constr-threshold"   (noArg (\d -> d{ specConstrThreshold = Nothing }))
-   , Flag "fspec-constr-count"          (intSuffix (\n d -> d{ specConstrCount = Just n }))
-   , Flag "fno-spec-constr-count"       (noArg (\d -> d{ specConstrCount = Nothing }))
-   , Flag "fliberate-case-threshold"    (intSuffix (\n d -> d{ liberateCaseThreshold = Just n }))
-   , Flag "fno-liberate-case-threshold" (noArg (\d -> d{ liberateCaseThreshold = Nothing }))
-   , Flag "frule-check"                 (SepArg (\s -> upd (\d -> d{ ruleCheck = Just s })))
-   , Flag "fcontext-stack"              (intSuffix (\n d -> d{ ctxtStkDepth = n }))
-   , Flag "fstrictness-before"          (intSuffix (\n d -> d{ strictnessBefore = n : strictnessBefore d }))
-   , Flag "ffloat-lam-args"             (intSuffix (\n d -> d{ floatLamArgs = Just n }))
-   , Flag "ffloat-all-lams"             (noArg (\d -> d{ floatLamArgs = Nothing }))
+   , flagA "fsimplifier-phases"          (intSuffix (\n d -> d{ simplPhases = n }))
+   , flagA "fmax-simplifier-iterations"  (intSuffix (\n d -> d{ maxSimplIterations = n }))
+   , flagA "fspec-constr-threshold"      (intSuffix (\n d -> d{ specConstrThreshold = Just n }))
+   , flagA "fno-spec-constr-threshold"   (noArg (\d -> d{ specConstrThreshold = Nothing }))
+   , flagA "fspec-constr-count"          (intSuffix (\n d -> d{ specConstrCount = Just n }))
+   , flagA "fno-spec-constr-count"       (noArg (\d -> d{ specConstrCount = Nothing }))
+   , flagA "fliberate-case-threshold"    (intSuffix (\n d -> d{ liberateCaseThreshold = Just n }))
+   , flagA "fno-liberate-case-threshold" (noArg (\d -> d{ liberateCaseThreshold = Nothing }))
+   , flagA "frule-check"                 (SepArg (\s -> upd (\d -> d{ ruleCheck = Just s })))
+   , flagA "fcontext-stack"              (intSuffix (\n d -> d{ ctxtStkDepth = n }))
+   , flagA "fstrictness-before"          (intSuffix (\n d -> d{ strictnessBefore = n : strictnessBefore d }))
+   , flagA "ffloat-lam-args"             (intSuffix (\n d -> d{ floatLamArgs = Just n }))
+   , flagA "ffloat-all-lams"             (noArg (\d -> d{ floatLamArgs = Nothing }))
  
          ------ Profiling ----------------------------------------------------
  
    -- XXX Should the -f* flags be deprecated?
    -- They don't seem to be documented
-   , Flag "fauto-sccs-on-all-toplevs"             (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
-   , Flag "auto-all"                              (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
-   , Flag "no-auto-all"                           (NoArg (unSetDynFlag Opt_AutoSccsOnAllToplevs))
-   , Flag "fauto-sccs-on-exported-toplevs"  (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
-   , Flag "auto"                            (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
-   , Flag "no-auto"                         (NoArg (unSetDynFlag Opt_AutoSccsOnExportedToplevs))
-   , Flag "fauto-sccs-on-individual-cafs"   (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
-   , Flag "caf-all"                         (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
-   , Flag "no-caf-all"                      (NoArg (unSetDynFlag Opt_AutoSccsOnIndividualCafs))
+   , flagA "fauto-sccs-on-all-toplevs"            (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
+   , flagA "auto-all"                             (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
+   , flagA "no-auto-all"                          (NoArg (unSetDynFlag Opt_AutoSccsOnAllToplevs))
+   , flagA "fauto-sccs-on-exported-toplevs"  (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
+   , flagA "auto"                            (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
+   , flagA "no-auto"                         (NoArg (unSetDynFlag Opt_AutoSccsOnExportedToplevs))
+   , flagA "fauto-sccs-on-individual-cafs"   (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
+   , flagA "caf-all"                         (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
+   , flagA "no-caf-all"                      (NoArg (unSetDynFlag Opt_AutoSccsOnIndividualCafs))
  
          ------ DPH flags ----------------------------------------------------
  
-   , Flag "fdph-seq"         (NoArg (setDPHBackend DPHSeq))
-   , Flag "fdph-par"         (NoArg (setDPHBackend DPHPar))
-   , Flag "fdph-this"        (NoArg (setDPHBackend DPHThis))
-   , Flag "fdph-none"        (NoArg (setDPHBackend DPHNone))
+   , flagA "fdph-seq"         (NoArg (setDPHBackend DPHSeq))
+   , flagA "fdph-par"         (NoArg (setDPHBackend DPHPar))
+   , flagA "fdph-this"        (NoArg (setDPHBackend DPHThis))
+   , flagA "fdph-none"        (NoArg (setDPHBackend DPHNone))
  
          ------ Compiler flags -----------------------------------------------
  
-   , Flag "fasm"             (NoArg (setObjTarget HscAsm))
-   , Flag "fvia-c"           (NoArg
+   , flagA "fasm"             (NoArg (setObjTarget HscAsm))
+   , flagA "fvia-c"           (NoArg
           (addWarn "The -fvia-c flag does nothing; it will be removed in a future GHC release"))
-   , Flag "fvia-C"           (NoArg
+   , flagA "fvia-C"           (NoArg
           (addWarn "The -fvia-C flag does nothing; it will be removed in a future GHC release"))
-   , Flag "fllvm"            (NoArg (setObjTarget HscLlvm))
-   , Flag "fno-code"         (NoArg (do upd $ \d -> d{ ghcLink=NoLink }
-                                        setTarget HscNothing))
-   , Flag "fbyte-code"       (NoArg (setTarget HscInterpreted))
-   , Flag "fobject-code"     (NoArg (setTarget defaultHscTarget))
-   , Flag "fglasgow-exts"    (NoArg (enableGlasgowExts >> deprecate "Use individual extensions instead"))
-   , Flag "fno-glasgow-exts" (NoArg (disableGlasgowExts >> deprecate "Use individual extensions instead"))
+   , flagA "fllvm"            (NoArg (setObjTarget HscLlvm))
+   , flagA "fno-code"         (NoArg (do { upd $ \d -> d{ ghcLink=NoLink }
+                                         ; setTarget HscNothing }))
+   , flagA "fbyte-code"       (NoArg (setTarget HscInterpreted))
+   , flagA "fobject-code"     (NoArg (setTarget defaultHscTarget))
+   , flagA "fglasgow-exts"    (NoArg (enableGlasgowExts >> deprecate "Use individual extensions instead"))
+   , flagA "fno-glasgow-exts" (NoArg (disableGlasgowExts >> deprecate "Use individual extensions instead"))
   ]
   ++ map (mkFlag turnOn  "f"    setDynFlag  ) fFlags
   ++ map (mkFlag turnOff "fno-" unSetDynFlag) fFlags
   ++ map (mkFlag turnOn  "X"    setExtensionFlag  ) xFlags
   ++ map (mkFlag turnOff "XNo"  unSetExtensionFlag) xFlags
   ++ map (mkFlag turnOn  "X"    setLanguage) languageFlags
+  ++ map (mkFlag turnOn  "X"    setSafeHaskell) safeHaskellFlags
  
  package_flags :: [Flag (CmdLineP DynFlags)]
  package_flags = [
          ------- Packages ----------------------------------------------------
-     Flag "package-conf"         (HasArg extraPkgConf_)
-   , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
-   , Flag "package-name"       (hasArg setPackageName)
-   , Flag "package-id"         (HasArg exposePackageId)
-   , Flag "package"            (HasArg exposePackage)
-   , Flag "hide-package"       (HasArg hidePackage)
-   , Flag "hide-all-packages"  (NoArg (setDynFlag Opt_HideAllPackages))
-   , Flag "ignore-package"     (HasArg ignorePackage)
-   , Flag "syslib"             (HasArg (\s -> do { exposePackage s
-                                                   ; deprecate "Use -package instead" }))
+     -- specifying these to be flagC is redundant since they are actually
+     -- static flags, but best to do this anyway.
+     flagC "package-conf"          (HasArg extraPkgConf_)
+   , flagC "no-user-package-conf"  (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
+   , flagC "package-name"                (hasArg setPackageName)
+   , flagC "package-id"                  (HasArg exposePackageId)
+   , flagC "package"                     (HasArg exposePackage)
+   , flagC "hide-package"                (HasArg hidePackage)
+   , flagC "hide-all-packages"           (NoArg (setDynFlag Opt_HideAllPackages))
+   , flagC "ignore-package"              (HasArg ignorePackage)
+   , flagC "syslib"                      (HasArg (\s -> do { exposePackage s
+                                                     ; deprecate "Use -package instead" }))
+   , flagC "trust"                 (HasArg trustPackage)
+   , flagC "distrust"              (HasArg distrustPackage)
+   , flagC "distrust-all-packages" (NoArg (setDynFlag Opt_DistrustAllPackages))
    ]
  
  type TurnOnFlag = Bool   -- True  <=> we are turning the flag on
@@@ -1491,6 -1620,7 +1621,7 @@@ turnOff :: TurnOnFlag; turnOff = Fals
  
  type FlagSpec flag
     = ( String -- Flag in string form
+      , FlagSafety
       , flag     -- Flag in internal form
       , TurnOnFlag -> DynP ())    -- Extra action to run when the flag is found
                                   -- Typically, emit a warning or error
@@@ -1500,8 -1630,8 +1631,8 @@@ mkFlag :: TurnOnFlag            -- ^ Tr
         -> (flag -> DynP ())   -- ^ What to do when the flag is found
         -> FlagSpec flag               -- ^ Specification of this particular flag
         -> Flag (CmdLineP DynFlags)
- mkFlag turn_on flagPrefix f (name, flag, extra_action)
-     = Flag (flagPrefix ++ name) (NoArg (f flag >> extra_action turn_on))
+ mkFlag turn_on flagPrefix f (name, fsafe, flag, extra_action)
+     = Flag (flagPrefix ++ name) fsafe (NoArg (f flag >> extra_action turn_on))
  
  deprecatedForExtension :: String -> TurnOnFlag -> DynP ()
  deprecatedForExtension lang turn_on
@@@ -1522,232 -1652,244 +1653,245 @@@ nop _ = return (
  -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
  fFlags :: [FlagSpec DynFlag]
  fFlags = [
-   ( "warn-dodgy-foreign-imports",       Opt_WarnDodgyForeignImports, nop ),
-   ( "warn-dodgy-exports",               Opt_WarnDodgyExports, nop ),
-   ( "warn-dodgy-imports",               Opt_WarnDodgyImports, nop ),
-   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports, nop ),
-   ( "warn-hi-shadowing",                Opt_WarnHiShadows, nop ),
-   ( "warn-implicit-prelude",            Opt_WarnImplicitPrelude, nop ),
-   ( "warn-incomplete-patterns",         Opt_WarnIncompletePatterns, nop ),
-   ( "warn-incomplete-uni-patterns",     Opt_WarnIncompleteUniPatterns, nop ),
-   ( "warn-incomplete-record-updates",   Opt_WarnIncompletePatternsRecUpd, nop ),
-   ( "warn-missing-fields",              Opt_WarnMissingFields, nop ),
-   ( "warn-missing-import-lists",        Opt_WarnMissingImportList, nop ),
-   ( "warn-missing-methods",             Opt_WarnMissingMethods, nop ),
-   ( "warn-missing-signatures",          Opt_WarnMissingSigs, nop ),
-   ( "warn-missing-local-sigs",          Opt_WarnMissingLocalSigs, nop ),
-   ( "warn-name-shadowing",              Opt_WarnNameShadowing, nop ),
-   ( "warn-overlapping-patterns",        Opt_WarnOverlappingPatterns, nop ),
-   ( "warn-type-defaults",               Opt_WarnTypeDefaults, nop ),
-   ( "warn-monomorphism-restriction",    Opt_WarnMonomorphism, nop ),
-   ( "warn-unused-binds",                Opt_WarnUnusedBinds, nop ),
-   ( "warn-unused-imports",              Opt_WarnUnusedImports, nop ),
-   ( "warn-unused-matches",              Opt_WarnUnusedMatches, nop ),
-   ( "warn-warnings-deprecations",       Opt_WarnWarningsDeprecations, nop ),
-   ( "warn-deprecations",                Opt_WarnWarningsDeprecations, nop ),
-   ( "warn-deprecated-flags",            Opt_WarnDeprecatedFlags, nop ),
-   ( "warn-orphans",                     Opt_WarnOrphans, nop ),
-   ( "warn-identities",                  Opt_WarnIdentities, nop ),
-   ( "warn-auto-orphans",                Opt_WarnAutoOrphans, nop ),
-   ( "warn-tabs",                        Opt_WarnTabs, nop ),
-   ( "warn-unrecognised-pragmas",        Opt_WarnUnrecognisedPragmas, nop ),
-   ( "warn-lazy-unlifted-bindings",      Opt_WarnLazyUnliftedBindings, nop),
-   ( "warn-unused-do-bind",              Opt_WarnUnusedDoBind, nop ),
-   ( "warn-wrong-do-bind",               Opt_WarnWrongDoBind, nop ),
-   ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, nop ),
-   ( "print-explicit-foralls",           Opt_PrintExplicitForalls, nop ),
-   ( "strictness",                       Opt_Strictness, nop ),
-   ( "specialise",                       Opt_Specialise, nop ),
-   ( "float-in",                         Opt_FloatIn, nop ),
-   ( "static-argument-transformation",   Opt_StaticArgumentTransformation, nop ),
-   ( "full-laziness",                    Opt_FullLaziness, nop ),
-   ( "liberate-case",                    Opt_LiberateCase, nop ),
-   ( "spec-constr",                      Opt_SpecConstr, nop ),
-   ( "cse",                              Opt_CSE, nop ),
-   ( "ignore-interface-pragmas",         Opt_IgnoreInterfacePragmas, nop ),
-   ( "omit-interface-pragmas",           Opt_OmitInterfacePragmas, nop ),
-   ( "expose-all-unfoldings",            Opt_ExposeAllUnfoldings, nop ),
-   ( "do-lambda-eta-expansion",          Opt_DoLambdaEtaExpansion, nop ),
-   ( "ignore-asserts",                   Opt_IgnoreAsserts, nop ),
-   ( "do-eta-reduction",                 Opt_DoEtaReduction, nop ),
-   ( "case-merge",                       Opt_CaseMerge, nop ),
-   ( "unbox-strict-fields",              Opt_UnboxStrictFields, nop ),
-   ( "method-sharing",                   Opt_MethodSharing, 
+   ( "warn-dodgy-foreign-imports",       AlwaysAllowed, Opt_WarnDodgyForeignImports, nop ),
+   ( "warn-dodgy-exports",               AlwaysAllowed, Opt_WarnDodgyExports, nop ),
+   ( "warn-dodgy-imports",               AlwaysAllowed, Opt_WarnDodgyImports, nop ),
+   ( "warn-duplicate-exports",           AlwaysAllowed, Opt_WarnDuplicateExports, nop ),
+   ( "warn-hi-shadowing",                AlwaysAllowed, Opt_WarnHiShadows, nop ),
+   ( "warn-implicit-prelude",            AlwaysAllowed, Opt_WarnImplicitPrelude, nop ),
+   ( "warn-incomplete-patterns",         AlwaysAllowed, Opt_WarnIncompletePatterns, nop ),
+   ( "warn-incomplete-uni-patterns",     AlwaysAllowed, Opt_WarnIncompleteUniPatterns, nop ),
+   ( "warn-incomplete-record-updates",   AlwaysAllowed, Opt_WarnIncompletePatternsRecUpd, nop ),
+   ( "warn-missing-fields",              AlwaysAllowed, Opt_WarnMissingFields, nop ),
+   ( "warn-missing-import-lists",        AlwaysAllowed, Opt_WarnMissingImportList, nop ),
+   ( "warn-missing-methods",             AlwaysAllowed, Opt_WarnMissingMethods, nop ),
+   ( "warn-missing-signatures",          AlwaysAllowed, Opt_WarnMissingSigs, nop ),
+   ( "warn-missing-local-sigs",          AlwaysAllowed, Opt_WarnMissingLocalSigs, nop ),
+   ( "warn-name-shadowing",              AlwaysAllowed, Opt_WarnNameShadowing, nop ),
+   ( "warn-overlapping-patterns",        AlwaysAllowed, Opt_WarnOverlappingPatterns, nop ),
+   ( "warn-type-defaults",               AlwaysAllowed, Opt_WarnTypeDefaults, nop ),
+   ( "warn-monomorphism-restriction",    AlwaysAllowed, Opt_WarnMonomorphism, nop ),
+   ( "warn-unused-binds",                AlwaysAllowed, Opt_WarnUnusedBinds, nop ),
+   ( "warn-unused-imports",              AlwaysAllowed, Opt_WarnUnusedImports, nop ),
+   ( "warn-unused-matches",              AlwaysAllowed, Opt_WarnUnusedMatches, nop ),
+   ( "warn-warnings-deprecations",       AlwaysAllowed, Opt_WarnWarningsDeprecations, nop ),
+   ( "warn-deprecations",                AlwaysAllowed, Opt_WarnWarningsDeprecations, nop ),
+   ( "warn-deprecated-flags",            AlwaysAllowed, Opt_WarnDeprecatedFlags, nop ),
+   ( "warn-orphans",                     AlwaysAllowed, Opt_WarnOrphans, nop ),
+   ( "warn-identities",                  AlwaysAllowed, Opt_WarnIdentities, nop ),
+   ( "warn-auto-orphans",                AlwaysAllowed, Opt_WarnAutoOrphans, nop ),
+   ( "warn-tabs",                        AlwaysAllowed, Opt_WarnTabs, nop ),
+   ( "warn-unrecognised-pragmas",        AlwaysAllowed, Opt_WarnUnrecognisedPragmas, nop ),
+   ( "warn-lazy-unlifted-bindings",      AlwaysAllowed, Opt_WarnLazyUnliftedBindings, nop),
+   ( "warn-unused-do-bind",              AlwaysAllowed, Opt_WarnUnusedDoBind, nop ),
+   ( "warn-wrong-do-bind",               AlwaysAllowed, Opt_WarnWrongDoBind, nop ),
+   ( "warn-alternative-layout-rule-transitional", AlwaysAllowed, Opt_WarnAlternativeLayoutRuleTransitional, nop ),
+   ( "print-explicit-foralls",           AlwaysAllowed, Opt_PrintExplicitForalls, nop ),
+   ( "strictness",                       AlwaysAllowed, Opt_Strictness, nop ),
+   ( "specialise",                       AlwaysAllowed, Opt_Specialise, nop ),
+   ( "float-in",                         AlwaysAllowed, Opt_FloatIn, nop ),
+   ( "static-argument-transformation",   AlwaysAllowed, Opt_StaticArgumentTransformation, nop ),
+   ( "full-laziness",                    AlwaysAllowed, Opt_FullLaziness, nop ),
+   ( "liberate-case",                    AlwaysAllowed, Opt_LiberateCase, nop ),
+   ( "spec-constr",                      AlwaysAllowed, Opt_SpecConstr, nop ),
+   ( "cse",                              AlwaysAllowed, Opt_CSE, nop ),
+   ( "ignore-interface-pragmas",         AlwaysAllowed, Opt_IgnoreInterfacePragmas, nop ),
+   ( "omit-interface-pragmas",           AlwaysAllowed, Opt_OmitInterfacePragmas, nop ),
+   ( "expose-all-unfoldings",            AlwaysAllowed, Opt_ExposeAllUnfoldings, nop ),
+   ( "do-lambda-eta-expansion",          AlwaysAllowed, Opt_DoLambdaEtaExpansion, nop ),
+   ( "ignore-asserts",                   AlwaysAllowed, Opt_IgnoreAsserts, nop ),
+   ( "do-eta-reduction",                 AlwaysAllowed, Opt_DoEtaReduction, nop ),
+   ( "case-merge",                       AlwaysAllowed, Opt_CaseMerge, nop ),
+   ( "unbox-strict-fields",              AlwaysAllowed, Opt_UnboxStrictFields, nop ),
+   ( "method-sharing",                   AlwaysAllowed, Opt_MethodSharing, 
       \_ -> deprecate "doesn't do anything any more"),
       -- Remove altogether in GHC 7.2
-   ( "dicts-cheap",                      Opt_DictsCheap, nop ),
-   ( "excess-precision",                 Opt_ExcessPrecision, nop ),
-   ( "eager-blackholing",                Opt_EagerBlackHoling, nop ),
-   ( "print-bind-result",                Opt_PrintBindResult, nop ),
-   ( "force-recomp",                     Opt_ForceRecomp, nop ),
-   ( "hpc-no-auto",                      Opt_Hpc_No_Auto, nop ),
-   ( "rewrite-rules",                    Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ),
-   ( "enable-rewrite-rules",             Opt_EnableRewriteRules, nop ),
-   ( "break-on-exception",               Opt_BreakOnException, nop ),
-   ( "break-on-error",                   Opt_BreakOnError, nop ),
-   ( "print-evld-with-show",             Opt_PrintEvldWithShow, nop ),
-   ( "print-bind-contents",              Opt_PrintBindContents, nop ),
-   ( "run-cps",                          Opt_RunCPS, nop ),
-   ( "run-cpsz",                         Opt_RunCPSZ, nop ),
-   ( "new-codegen",                      Opt_TryNewCodeGen, nop ),
-   ( "convert-to-zipper-and-back",       Opt_ConvertToZipCfgAndBack, nop ),
-   ( "vectorise",                        Opt_Vectorise, nop ),
-   ( "regs-graph",                       Opt_RegsGraph, nop ),
-   ( "regs-iterative",                   Opt_RegsIterative, nop ),
-   ( "gen-manifest",                     Opt_GenManifest, nop ),
-   ( "embed-manifest",                   Opt_EmbedManifest, nop ),
-   ( "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 )
+   ( "dicts-cheap",                      AlwaysAllowed, Opt_DictsCheap, nop ),
+   ( "excess-precision",                 AlwaysAllowed, Opt_ExcessPrecision, nop ),
+   ( "eager-blackholing",                AlwaysAllowed, Opt_EagerBlackHoling, nop ),
+   ( "print-bind-result",                AlwaysAllowed, Opt_PrintBindResult, nop ),
+   ( "force-recomp",                     AlwaysAllowed, Opt_ForceRecomp, nop ),
+   ( "hpc-no-auto",                      AlwaysAllowed, Opt_Hpc_No_Auto, nop ),
+   ( "rewrite-rules",                    AlwaysAllowed, Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ),
+   ( "enable-rewrite-rules",             AlwaysAllowed, Opt_EnableRewriteRules, nop ),
+   ( "break-on-exception",               AlwaysAllowed, Opt_BreakOnException, nop ),
+   ( "break-on-error",                   AlwaysAllowed, Opt_BreakOnError, nop ),
+   ( "print-evld-with-show",             AlwaysAllowed, Opt_PrintEvldWithShow, nop ),
+   ( "print-bind-contents",              AlwaysAllowed, Opt_PrintBindContents, nop ),
+   ( "run-cps",                          AlwaysAllowed, Opt_RunCPS, nop ),
+   ( "run-cpsz",                         AlwaysAllowed, Opt_RunCPSZ, nop ),
+   ( "new-codegen",                      AlwaysAllowed, Opt_TryNewCodeGen, nop ),
+   ( "convert-to-zipper-and-back",       AlwaysAllowed, Opt_ConvertToZipCfgAndBack, nop ),
+   ( "vectorise",                        AlwaysAllowed, Opt_Vectorise, nop ),
+   ( "regs-graph",                       AlwaysAllowed, Opt_RegsGraph, nop ),
+   ( "regs-iterative",                   AlwaysAllowed, Opt_RegsIterative, nop ),
+   ( "gen-manifest",                     AlwaysAllowed, Opt_GenManifest, nop ),
+   ( "embed-manifest",                   AlwaysAllowed, Opt_EmbedManifest, nop ),
+   ( "ext-core",                         AlwaysAllowed, Opt_EmitExternalCore, nop ),
+   ( "shared-implib",                    AlwaysAllowed, Opt_SharedImplib, nop ),
+   ( "ghci-sandbox",                     AlwaysAllowed, Opt_GhciSandbox, nop ),
+   ( "helpful-errors",                   AlwaysAllowed, Opt_HelpfulErrors, nop ),
+   ( "building-cabal-package",           AlwaysAllowed, Opt_BuildingCabalPackage, nop ),
+   ( "implicit-import-qualified",        AlwaysAllowed, Opt_ImplicitImportQualified, nop )
    ]
  
  -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
  fLangFlags :: [FlagSpec ExtensionFlag]
  fLangFlags = [
-   ( "th",                               Opt_TemplateHaskell,
+   ( "th",                               NeverAllowed, Opt_TemplateHaskell,
      deprecatedForExtension "TemplateHaskell" >> checkTemplateHaskellOk ),
-   ( "fi",                               Opt_ForeignFunctionInterface,
+   ( "fi",                               RestrictedFunction, Opt_ForeignFunctionInterface,
      deprecatedForExtension "ForeignFunctionInterface" ),
-   ( "ffi",                              Opt_ForeignFunctionInterface,
+   ( "ffi",                              RestrictedFunction, Opt_ForeignFunctionInterface,
      deprecatedForExtension "ForeignFunctionInterface" ),
-   ( "arrows",                           Opt_Arrows,
+   ( "arrows",                           AlwaysAllowed, Opt_Arrows,
      deprecatedForExtension "Arrows" ),
-   ( "generics",                         Opt_Generics,
+   ( "generics",                         AlwaysAllowed, Opt_Generics,
      deprecatedForExtension "Generics" ),
-   ( "implicit-prelude",                 Opt_ImplicitPrelude,
+   ( "implicit-prelude",                 AlwaysAllowed, Opt_ImplicitPrelude,
      deprecatedForExtension "ImplicitPrelude" ),
-   ( "bang-patterns",                    Opt_BangPatterns,
+   ( "bang-patterns",                    AlwaysAllowed, Opt_BangPatterns,
      deprecatedForExtension "BangPatterns" ),
-   ( "monomorphism-restriction",         Opt_MonomorphismRestriction,
+   ( "monomorphism-restriction",         AlwaysAllowed, Opt_MonomorphismRestriction,
      deprecatedForExtension "MonomorphismRestriction" ),
-   ( "mono-pat-binds",                   Opt_MonoPatBinds,
+   ( "mono-pat-binds",                   AlwaysAllowed, Opt_MonoPatBinds,
      deprecatedForExtension "MonoPatBinds" ),
-   ( "extended-default-rules",           Opt_ExtendedDefaultRules,
+   ( "extended-default-rules",           AlwaysAllowed, Opt_ExtendedDefaultRules,
      deprecatedForExtension "ExtendedDefaultRules" ),
-   ( "implicit-params",                  Opt_ImplicitParams,
+   ( "implicit-params",                  AlwaysAllowed, Opt_ImplicitParams,
      deprecatedForExtension "ImplicitParams" ),
-   ( "scoped-type-variables",            Opt_ScopedTypeVariables,
+   ( "scoped-type-variables",            AlwaysAllowed, Opt_ScopedTypeVariables,
      deprecatedForExtension "ScopedTypeVariables" ),
-   ( "parr",                             Opt_ParallelArrays,
+   ( "parr",                             AlwaysAllowed, Opt_ParallelArrays,
      deprecatedForExtension "ParallelArrays" ),
-   ( "PArr",                             Opt_ParallelArrays,
+   ( "PArr",                             AlwaysAllowed, Opt_ParallelArrays,
      deprecatedForExtension "ParallelArrays" ),
-   ( "allow-overlapping-instances",      Opt_OverlappingInstances,
+   ( "allow-overlapping-instances",      RestrictedFunction, Opt_OverlappingInstances,
      deprecatedForExtension "OverlappingInstances" ),
-   ( "allow-undecidable-instances",      Opt_UndecidableInstances,
+   ( "allow-undecidable-instances",      AlwaysAllowed, Opt_UndecidableInstances,
      deprecatedForExtension "UndecidableInstances" ),
-   ( "allow-incoherent-instances",       Opt_IncoherentInstances,
+   ( "allow-incoherent-instances",       AlwaysAllowed, Opt_IncoherentInstances,
      deprecatedForExtension "IncoherentInstances" )
    ]
  
  supportedLanguages :: [String]
- supportedLanguages = [ name | (name, _, _) <- languageFlags ]
+ supportedLanguages = [ name | (name, _, _, _) <- languageFlags ]
+ supportedLanguageOverlays :: [String]
+ supportedLanguageOverlays = [ name | (name, _, _, _) <- safeHaskellFlags ]
  
  supportedExtensions :: [String]
- supportedExtensions = [ name' | (name, _, _) <- xFlags, name' <- [name, "No" ++ name] ]
+ supportedExtensions = [ name' | (name, _, _, _) <- xFlags, name' <- [name, "No" ++ name] ]
  
  supportedLanguagesAndExtensions :: [String]
- supportedLanguagesAndExtensions = supportedLanguages ++ supportedExtensions
+ supportedLanguagesAndExtensions =
+     supportedLanguages ++ supportedLanguageOverlays ++ supportedExtensions
  
  -- | These -X<blah> flags cannot be reversed with -XNo<blah>
  languageFlags :: [FlagSpec Language]
  languageFlags = [
-   ( "Haskell98",                        Haskell98, nop ),
-   ( "Haskell2010",                      Haskell2010, nop )
+   ( "Haskell98",   AlwaysAllowed, Haskell98, nop ),
+   ( "Haskell2010", AlwaysAllowed, Haskell2010, nop )
    ]
  
+ -- | These -X<blah> flags cannot be reversed with -XNo<blah>
+ -- They are used to place hard requirements on what GHC Haskell language
+ -- features can be used.
+ safeHaskellFlags :: [FlagSpec SafeHaskellMode]
+ safeHaskellFlags = [mkF Sf_SafeImports, mkF' Sf_SafeLanguage,
+                     mkF Sf_Trustworthy, mkF' Sf_Safe]
+     where mkF  flag = (showPpr flag, AlwaysAllowed, flag, nop)
+           mkF' flag = (showPpr flag, EnablesSafe,   flag, nop)
  -- | These -X<blah> flags can all be reversed with -XNo<blah>
  xFlags :: [FlagSpec ExtensionFlag]
  xFlags = [
-   ( "CPP",                              Opt_Cpp, nop ),
-   ( "PostfixOperators",                 Opt_PostfixOperators, nop ),
-   ( "TupleSections",                    Opt_TupleSections, nop ),
-   ( "PatternGuards",                    Opt_PatternGuards, nop ),
-   ( "UnicodeSyntax",                    Opt_UnicodeSyntax, nop ),
-   ( "MagicHash",                        Opt_MagicHash, nop ),
-   ( "PolymorphicComponents",            Opt_PolymorphicComponents, nop ),
-   ( "ExistentialQuantification",        Opt_ExistentialQuantification, nop ),
-   ( "KindSignatures",                   Opt_KindSignatures, nop ),
-   ( "EmptyDataDecls",                   Opt_EmptyDataDecls, nop ),
-   ( "ParallelListComp",                 Opt_ParallelListComp, nop ),
-   ( "TransformListComp",                Opt_TransformListComp, nop ),
-   ( "MonadComprehensions",              Opt_MonadComprehensions, nop),
-   ( "ForeignFunctionInterface",         Opt_ForeignFunctionInterface, nop ),
-   ( "UnliftedFFITypes",                 Opt_UnliftedFFITypes, nop ),
-   ( "GHCForeignImportPrim",             Opt_GHCForeignImportPrim, nop ),
-   ( "LiberalTypeSynonyms",              Opt_LiberalTypeSynonyms, nop ),
-   ( "Rank2Types",                       Opt_Rank2Types, nop ),
-   ( "RankNTypes",                       Opt_RankNTypes, nop ),
-   ( "ImpredicativeTypes",               Opt_ImpredicativeTypes, nop), 
-   ( "TypeOperators",                    Opt_TypeOperators, nop ),
-   ( "RecursiveDo",                      Opt_RecursiveDo,     -- Enables 'mdo'
+   ( "CPP",                              AlwaysAllowed,  Opt_Cpp, nop ),
+   ( "PostfixOperators",                 AlwaysAllowed, Opt_PostfixOperators, nop ),
+   ( "TupleSections",                    AlwaysAllowed, Opt_TupleSections, nop ),
+   ( "PatternGuards",                    AlwaysAllowed, Opt_PatternGuards, nop ),
+   ( "UnicodeSyntax",                    AlwaysAllowed, Opt_UnicodeSyntax, nop ),
+   ( "MagicHash",                        AlwaysAllowed, Opt_MagicHash, nop ),
+   ( "PolymorphicComponents",            AlwaysAllowed, Opt_PolymorphicComponents, nop ),
+   ( "ExistentialQuantification",        AlwaysAllowed, Opt_ExistentialQuantification, nop ),
+   ( "KindSignatures",                   AlwaysAllowed, Opt_KindSignatures, nop ),
+   ( "EmptyDataDecls",                   AlwaysAllowed, Opt_EmptyDataDecls, nop ),
+   ( "ParallelListComp",                 AlwaysAllowed, Opt_ParallelListComp, nop ),
+   ( "TransformListComp",                AlwaysAllowed, Opt_TransformListComp, nop ),
+   ( "MonadComprehensions",              AlwaysAllowed, Opt_MonadComprehensions, nop),
+   ( "ForeignFunctionInterface",   RestrictedFunction, Opt_ForeignFunctionInterface, nop ),
+   ( "UnliftedFFITypes",                 AlwaysAllowed, Opt_UnliftedFFITypes, nop ),
+   ( "GHCForeignImportPrim",             AlwaysAllowed, Opt_GHCForeignImportPrim, nop ),
+   ( "LiberalTypeSynonyms",              AlwaysAllowed, Opt_LiberalTypeSynonyms, nop ),
+   ( "Rank2Types",                       AlwaysAllowed, Opt_Rank2Types, nop ),
+   ( "RankNTypes",                       AlwaysAllowed, Opt_RankNTypes, nop ),
+   ( "ImpredicativeTypes",               AlwaysAllowed, Opt_ImpredicativeTypes, nop), 
+   ( "TypeOperators",                    AlwaysAllowed, Opt_TypeOperators, nop ),
+   ( "RecursiveDo",                      AlwaysAllowed, Opt_RecursiveDo,     -- Enables 'mdo'
      deprecatedForExtension "DoRec"),
-   ( "DoRec",                            Opt_DoRec, nop ),    -- Enables 'rec' keyword 
-   ( "Arrows",                           Opt_Arrows, nop ),
-   ( "ParallelArrays",                   Opt_ParallelArrays, nop ),
-   ( "TemplateHaskell",                  Opt_TemplateHaskell, checkTemplateHaskellOk ),
-   ( "QuasiQuotes",                      Opt_QuasiQuotes, nop ),
-   ( "Generics",                         Opt_Generics,
+   ( "DoRec",                            AlwaysAllowed, Opt_DoRec, nop ),    -- Enables 'rec' keyword 
+   ( "Arrows",                           AlwaysAllowed, Opt_Arrows, nop ),
+   ( "ParallelArrays",                   AlwaysAllowed, Opt_ParallelArrays, nop ),
+   ( "TemplateHaskell",                  NeverAllowed, Opt_TemplateHaskell, checkTemplateHaskellOk ),
+   ( "QuasiQuotes",                      AlwaysAllowed, Opt_QuasiQuotes, nop ),
+   ( "Generics",                         AlwaysAllowed, Opt_Generics,
      \ _ -> deprecate "it does nothing; look into -XDefaultSignatures and -XDeriveGeneric for generic programming support." ),
-   ( "ImplicitPrelude",                  Opt_ImplicitPrelude, nop ),
-   ( "RecordWildCards",                  Opt_RecordWildCards, nop ),
-   ( "NamedFieldPuns",                   Opt_RecordPuns, nop ),
-   ( "RecordPuns",                       Opt_RecordPuns,
+   ( "ImplicitPrelude",                  AlwaysAllowed, Opt_ImplicitPrelude, nop ),
+   ( "RecordWildCards",                  AlwaysAllowed, Opt_RecordWildCards, nop ),
+   ( "NamedFieldPuns",                   AlwaysAllowed, Opt_RecordPuns, nop ),
+   ( "RecordPuns",                       AlwaysAllowed, Opt_RecordPuns,
      deprecatedForExtension "NamedFieldPuns" ),
-   ( "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 ),
-   ( "MonomorphismRestriction",          Opt_MonomorphismRestriction, nop ),
-   ( "NPlusKPatterns",                   Opt_NPlusKPatterns, nop ),
-   ( "DoAndIfThenElse",                  Opt_DoAndIfThenElse, nop ),
-   ( "RebindableSyntax",                 Opt_RebindableSyntax, nop ),
-   ( "MonoPatBinds",                     Opt_MonoPatBinds, nop ),
-   ( "ExplicitForAll",                   Opt_ExplicitForAll, nop ),
-   ( "AlternativeLayoutRule",            Opt_AlternativeLayoutRule, nop ),
-   ( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, nop ),
-   ( "DatatypeContexts",                 Opt_DatatypeContexts,
+   ( "DisambiguateRecordFields",         AlwaysAllowed, Opt_DisambiguateRecordFields, nop ),
+   ( "OverloadedStrings",                AlwaysAllowed, Opt_OverloadedStrings, nop ),
+   ( "GADTs",                            AlwaysAllowed, Opt_GADTs, nop ),
+   ( "GADTSyntax",                       AlwaysAllowed, Opt_GADTSyntax, nop ),
+   ( "ViewPatterns",                     AlwaysAllowed, Opt_ViewPatterns, nop ),
+   ( "TypeFamilies",                     AlwaysAllowed, Opt_TypeFamilies, nop ),
+   ( "BangPatterns",                     AlwaysAllowed, Opt_BangPatterns, nop ),
+   ( "MonomorphismRestriction",          AlwaysAllowed, Opt_MonomorphismRestriction, nop ),
+   ( "NPlusKPatterns",                   AlwaysAllowed, Opt_NPlusKPatterns, nop ),
+   ( "DoAndIfThenElse",                  AlwaysAllowed, Opt_DoAndIfThenElse, nop ),
+   ( "RebindableSyntax",                 AlwaysAllowed, Opt_RebindableSyntax, nop ),
+   ( "MonoPatBinds",                     AlwaysAllowed, Opt_MonoPatBinds, nop ),
+   ( "ExplicitForAll",                   AlwaysAllowed, Opt_ExplicitForAll, nop ),
+   ( "AlternativeLayoutRule",            AlwaysAllowed, Opt_AlternativeLayoutRule, nop ),
+   ( "AlternativeLayoutRuleTransitional",AlwaysAllowed, Opt_AlternativeLayoutRuleTransitional, nop ),
+   ( "DatatypeContexts",                 AlwaysAllowed, Opt_DatatypeContexts,
      \ turn_on -> when turn_on $ deprecate "It was widely considered a misfeature, and has been removed from the Haskell language." ),
-   ( "NondecreasingIndentation",         Opt_NondecreasingIndentation, nop ),
-   ( "RelaxedLayout",                    Opt_RelaxedLayout, nop ),
-   ( "MonoLocalBinds",                   Opt_MonoLocalBinds, nop ),
-   ( "RelaxedPolyRec",                   Opt_RelaxedPolyRec, 
+   ( "NondecreasingIndentation",         AlwaysAllowed, Opt_NondecreasingIndentation, nop ),
+   ( "RelaxedLayout",                    AlwaysAllowed, Opt_RelaxedLayout, nop ),
+   ( "MonoLocalBinds",                   AlwaysAllowed, Opt_MonoLocalBinds, nop ),
+   ( "RelaxedPolyRec",                   AlwaysAllowed, Opt_RelaxedPolyRec, 
      \ turn_on -> if not turn_on 
                   then deprecate "You can't turn off RelaxedPolyRec any more"
                   else return () ),
-   ( "ExtendedDefaultRules",             Opt_ExtendedDefaultRules, nop ),
-   ( "ImplicitParams",                   Opt_ImplicitParams, nop ),
-   ( "ScopedTypeVariables",              Opt_ScopedTypeVariables, nop ),
+   ( "ExtendedDefaultRules",             AlwaysAllowed, Opt_ExtendedDefaultRules, nop ),
+   ( "ImplicitParams",                   AlwaysAllowed, Opt_ImplicitParams, nop ),
+   ( "ScopedTypeVariables",              AlwaysAllowed, Opt_ScopedTypeVariables, nop ),
  
-   ( "PatternSignatures",                Opt_ScopedTypeVariables, 
+   ( "PatternSignatures",                AlwaysAllowed, Opt_ScopedTypeVariables, 
      deprecatedForExtension "ScopedTypeVariables" ),
  
-   ( "UnboxedTuples",                    Opt_UnboxedTuples, nop ),
-   ( "StandaloneDeriving",               Opt_StandaloneDeriving, nop ),
-   ( "DeriveDataTypeable",               Opt_DeriveDataTypeable, nop ),
-   ( "DeriveFunctor",                    Opt_DeriveFunctor, nop ),
-   ( "DeriveTraversable",                Opt_DeriveTraversable, nop ),
-   ( "DeriveFoldable",                   Opt_DeriveFoldable, nop ),
-   ( "DeriveGeneric",                    Opt_DeriveGeneric, nop ),
-   ( "DefaultSignatures",                Opt_DefaultSignatures, nop ),
-   ( "TypeSynonymInstances",             Opt_TypeSynonymInstances, nop ),
-   ( "FlexibleContexts",                 Opt_FlexibleContexts, nop ),
-   ( "FlexibleInstances",                Opt_FlexibleInstances, nop ),
-   ( "ConstrainedClassMethods",          Opt_ConstrainedClassMethods, nop ),
-   ( "MultiParamTypeClasses",            Opt_MultiParamTypeClasses, nop ),
-   ( "FunctionalDependencies",           Opt_FunctionalDependencies, nop ),
-   ( "GeneralizedNewtypeDeriving",       Opt_GeneralizedNewtypeDeriving, nop ),
-   ( "OverlappingInstances",             Opt_OverlappingInstances, nop ),
-   ( "UndecidableInstances",             Opt_UndecidableInstances, nop ),
-   ( "IncoherentInstances",              Opt_IncoherentInstances, nop ),
-   ( "PackageImports",                   Opt_PackageImports, nop ),
-   ( "TypeNaturals",                     Opt_TypeNaturals, nop)
+   ( "UnboxedTuples",                    AlwaysAllowed, Opt_UnboxedTuples, nop ),
+   ( "StandaloneDeriving",               AlwaysAllowed, Opt_StandaloneDeriving, nop ),
+   ( "DeriveDataTypeable",               AlwaysAllowed, Opt_DeriveDataTypeable, nop ),
+   ( "DeriveFunctor",                    AlwaysAllowed, Opt_DeriveFunctor, nop ),
+   ( "DeriveTraversable",                AlwaysAllowed, Opt_DeriveTraversable, nop ),
+   ( "DeriveFoldable",                   AlwaysAllowed, Opt_DeriveFoldable, nop ),
+   ( "DeriveGeneric",                    AlwaysAllowed, Opt_DeriveGeneric, nop ),
+   ( "DefaultSignatures",                AlwaysAllowed, Opt_DefaultSignatures, nop ),
+   ( "TypeSynonymInstances",             AlwaysAllowed, Opt_TypeSynonymInstances, nop ),
+   ( "FlexibleContexts",                 AlwaysAllowed, Opt_FlexibleContexts, nop ),
+   ( "FlexibleInstances",                AlwaysAllowed, Opt_FlexibleInstances, nop ),
+   ( "ConstrainedClassMethods",          AlwaysAllowed, Opt_ConstrainedClassMethods, nop ),
+   ( "MultiParamTypeClasses",            AlwaysAllowed, Opt_MultiParamTypeClasses, nop ),
+   ( "FunctionalDependencies",           AlwaysAllowed, Opt_FunctionalDependencies, nop ),
+   ( "GeneralizedNewtypeDeriving",       AlwaysAllowed, Opt_GeneralizedNewtypeDeriving, nop ),
+   ( "OverlappingInstances",        RestrictedFunction, Opt_OverlappingInstances, nop ),
+   ( "UndecidableInstances",             AlwaysAllowed, Opt_UndecidableInstances, nop ),
+   ( "IncoherentInstances",              AlwaysAllowed, Opt_IncoherentInstances, nop ),
 -  ( "PackageImports",                   AlwaysAllowed, Opt_PackageImports, nop )
++  ( "PackageImports",                   AlwaysAllowed, Opt_PackageImports, nop ),
++  ( "TypeNaturals",                     AlwaysAllowed, Opt_TypeNaturals, nop)
    ]
  
  defaultFlags :: [DynFlag]
@@@ -1802,8 -1944,6 +1946,8 @@@ impliedFlag
      , (Opt_RecordWildCards,     turnOn, Opt_DisambiguateRecordFields)
      
      , (Opt_ParallelArrays, turnOn, Opt_ParallelListComp)
 +    , (Opt_TypeNaturals,        turnOn, Opt_TypeOperators)
 +    , (Opt_TypeNaturals,        turnOn, Opt_KindSignatures)
    ]
  
  optLevelFlags :: [([Int], DynFlag)]
@@@ -2074,7 -2214,8 +2218,8 @@@ addCmdlineHCInclude a = upd (\s -> s{cm
  extraPkgConf_ :: FilePath -> DynP ()
  extraPkgConf_  p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
  
- exposePackage, exposePackageId, hidePackage, ignorePackage :: String -> DynP ()
+ exposePackage, exposePackageId, hidePackage, ignorePackage,
+         trustPackage, distrustPackage :: String -> DynP ()
  exposePackage p =
    upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s })
  exposePackageId p =
@@@ -2083,6 -2224,10 +2228,10 @@@ hidePackage p 
    upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
  ignorePackage p =
    upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
+ trustPackage p = exposePackage p >> -- both trust and distrust also expose a package
+   upd (\s -> s{ packageFlags = TrustPackage p : packageFlags s })
+ distrustPackage p = exposePackage p >>
+   upd (\s -> s{ packageFlags = DistrustPackage p : packageFlags s })
  
  setPackageName :: String -> DynFlags -> DynFlags
  setPackageName p s =  s{ thisPackage = stringToPackageId p }
diff --combined compiler/parser/Lexer.x
@@@ -54,7 -54,7 +54,7 @@@ module Lexer 
     popContext, pushCurrentContext, setLastToken, setSrcLoc,
     activeContext, nextIsEOF,
     getLexState, popLexState, pushLexState,
 -   extension, bangPatEnabled, datatypeContextsEnabled,
 +   extension, bangPatEnabled, datatypeContextsEnabled, typeNaturalsEnabled,
     addWarning,
     lexTokenStream
    ) where
@@@ -661,7 -661,7 +661,7 @@@ reservedWordsFM = listToUFM 
        ( "export",     ITexport,        bit ffiBit),
        ( "label",      ITlabel,         bit ffiBit),
        ( "dynamic",    ITdynamic,       bit ffiBit),
-       ( "safe",       ITsafe,          bit ffiBit),
+       ( "safe",       ITsafe,          bit ffiBit .|. bit safeHaskellBit),
        ( "threadsafe", ITthreadsafe,    bit ffiBit),  -- ToDo: remove
        ( "interruptible", ITinterruptible, bit ffiBit),
        ( "unsafe",     ITunsafe,        bit ffiBit),
@@@ -1807,8 -1807,8 +1807,10 @@@ relaxedLayoutBit :: In
  relaxedLayoutBit = 24
  nondecreasingIndentationBit :: Int
  nondecreasingIndentationBit = 25
- typeNaturalsBit = 26
+ safeHaskellBit :: Int
+ safeHaskellBit = 26
 +typeNaturalsBit :: Int
++typeNaturalsBit = 27
  
  always :: Int -> Bool
  always           _     = True
@@@ -1850,8 -1850,6 +1852,8 @@@ relaxedLayout :: Int -> Boo
  relaxedLayout flags = testBit flags relaxedLayoutBit
  nondecreasingIndentation :: Int -> Bool
  nondecreasingIndentation flags = testBit flags nondecreasingIndentationBit
 +typeNaturalsEnabled :: Int -> Bool
 +typeNaturalsEnabled flags = testBit flags typeNaturalsBit
  
  -- PState for parsing options pragmas
  --
@@@ -1906,7 -1904,7 +1908,8 @@@ mkPState flags buf loc 
                 .|. alternativeLayoutRuleBit `setBitIf` xopt Opt_AlternativeLayoutRule flags
                 .|. relaxedLayoutBit  `setBitIf` xopt Opt_RelaxedLayout flags
                 .|. nondecreasingIndentationBit `setBitIf` xopt Opt_NondecreasingIndentation flags
+                .|. safeHaskellBit    `setBitIf` safeHaskellOn flags
 +               .|. typeNaturalsBit `setBitIf` xopt Opt_TypeNaturals flags
        --
        setBitIf :: Int -> Bool -> Int
        b `setBitIf` cond | cond      = bit b
@@@ -448,8 -448,8 +448,8 @@@ exportlist :: { [LIE RdrName] 
        | exportlist1                           { $1 }
  
  exportlist1 :: { [LIE RdrName] }
 -        : expdoclist export expdoclist ',' exportlist  { $1 ++ ($2 : $3) ++ $5 }
 -      | expdoclist export expdoclist                 { $1 ++ ($2 : $3) }
 +        : expdoclist export expdoclist ',' exportlist  { $1 ++ ($2 ++ $3) ++ $5 }
 +      | expdoclist export expdoclist                 { $1 ++ ($2 ++ $3) }
        | expdoclist                                   { $1 }
  
  expdoclist :: { [LIE RdrName] }
@@@ -461,22 -461,15 +461,22 @@@ exp_doc :: { LIE RdrName 
          | docnamed      { L1 (IEDocNamed ((fst . unLoc) $1)) } 
          | docnext       { L1 (IEDoc (unLoc $1)) }       
                         
 -   -- No longer allow things like [] and (,,,) to be exported
 +   -- NOTE 1: No longer allow things like [] and (,,,) to be exported
     -- They are built in syntax, always available
 -export        :: { LIE RdrName }
 -      :  qvar                         { L1 (IEVar (unLoc $1)) }
 -      |  oqtycon                      { L1 (IEThingAbs (unLoc $1)) }
 -      |  oqtycon '(' '..' ')'         { LL (IEThingAll (unLoc $1)) }
 -      |  oqtycon '(' ')'              { LL (IEThingWith (unLoc $1) []) }
 -      |  oqtycon '(' qcnames ')'      { LL (IEThingWith (unLoc $1) (reverse $3)) }
 -      |  'module' modid               { LL (IEModuleContents (unLoc $2)) }
 +   -- NOTE 2: There is a lot of overlap between value and type names,
 +   -- so, in the general case, we parse everything as values,
 +   -- and post-process the declaration to determine what is being exported.
 +export        :: { [LIE RdrName] }
 +      : qcname opt_subordinates { [L (comb3 $1 $1 $2)
 +                                       (mkExportSpec (unLoc $1) (unLoc $2))] }
 +        | 'type' oqtycons1        { map (fmap IEThingAbs) $2 }
 +      | 'module' modid          { [LL (IEModuleContents (unLoc $2))] }
 +
 +opt_subordinates :: { Located (Maybe Subordinates) }
 +        : {- empty -}             { L0 Nothing }
 +        | '(' '..' ')'            { LL (Just SubordinateAll) }
 +        | '(' ')'               { LL (Just (SubordinateList [])) }
 +        | '(' qcnames ')'         { LL (Just (SubordinateList (reverse $2))) }
  
  qcnames :: { [RdrName] }
        :  qcnames ',' qcname_ext       { unLoc $3 : $1 }
@@@ -507,13 -500,17 +507,17 @@@ importdecls :: { [LImportDecl RdrName] 
        | {- empty -}                           { [] }
  
  importdecl :: { LImportDecl RdrName }
-       : 'import' maybe_src optqualified maybe_pkg modid maybeas maybeimpspec 
-               { L (comb4 $1 $5 $6 $7) (ImportDecl $5 $4 $2 $3 (unLoc $6) (unLoc $7)) }
+       : 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec 
+               { L (comb4 $1 $6 $7 $8) (ImportDecl $6 $5 $2 $3 $4 (unLoc $7) (unLoc $8)) }
  
  maybe_src :: { IsBootInterface }
        : '{-# SOURCE' '#-}'                    { True }
        | {- empty -}                           { False }
  
+ maybe_safe :: { Bool }
+       : 'safe'                                { True }
+       | {- empty -}                           { False }
  maybe_pkg :: { Maybe FastString }
          : STRING                                { Just (getSTRING $1) }
          | {- empty -}                           { Nothing }
@@@ -1034,7 -1031,6 +1038,7 @@@ atype :: { LHsType RdrName 
        | '$(' exp ')'                  { LL $ mkHsSpliceTy $2 }
        | TH_ID_SPLICE                  { LL $ mkHsSpliceTy $ L1 $ HsVar $ 
                                          mkUnqual varName (getTH_ID_SPLICE $1) }
 +        | INTEGER                       {% mkNumberType (L1 (getINTEGER $1)) }
  
  -- An inst_type is what occurs in the head of an instance decl
  --    e.g.  (Foo a, Gaz b) => Wibble a b
@@@ -1090,7 -1086,6 +1094,7 @@@ kind    :: { Located Kind 
  akind :: { Located Kind }
        : '*'                   { L1 liftedTypeKind }
        | '!'                   { L1 unliftedTypeKind }
 +      | tycon                 {% checkKindCon $1 }
        | '(' kind ')'          { LL (unLoc $2) }
  
  
@@@ -1737,10 -1732,6 +1741,10 @@@ gtycon        :: { Located RdrName }  -- A "ge
        | '[' ']'                       { LL $ listTyCon_RDR }
        | '[:' ':]'                     { LL $ parrTyCon_RDR }
  
 +oqtycons1 :: { [Located RdrName] }
 +        : oqtycon                       { [$1] }
 +        | oqtycons1 oqtycon             { $2 : $1 }
 +
  oqtycon :: { Located RdrName }        -- An "ordinary" qualified tycon
        : qtycon                        { $1 }
        | '(' qtyconsym ')'             { LL (unLoc $2) }
@@@ -1763,15 -1754,6 +1767,15 @@@ qtyconsym :: { Located RdrName 
  
  tyconsym :: { Located RdrName }
        : CONSYM                        { L1 $! mkUnqual tcClsName (getCONSYM $1) }
 +        -- Does not include "!", because that is used for strictness marks
 +        -- or ".", because that separates the quantified type vars from the rest
 +        -- or "*", because that's used for kinds  (XXX: Add this)
 +        | VARSYM                      { L1 $! mkUnqual tcClsName (getVARSYM $1) }
 +        | '*'                           { L1 $! mkUnqual tcClsName (fsLit "*") }
 +    
 +
 +
 +
  
  -----------------------------------------------------------------------------
  -- Operators
@@@ -1805,9 -1787,11 +1809,9 @@@ qvaropm :: { Located RdrName 
  
  tyvar   :: { Located RdrName }
  tyvar   : tyvarid             { $1 }
 -      | '(' tyvarsym ')'      { LL (unLoc $2) }
  
  tyvarop :: { Located RdrName }
  tyvarop : '`' tyvarid '`'     { LL (unLoc $2) }
 -      | tyvarsym              { $1 }
        | '.'                   {% parseErrorSDoc (getLoc $1) 
                                      (vcat [ptext (sLit "Illegal symbol '.' in type"), 
                                             ptext (sLit "Perhaps you intended -XRankNTypes or similar flag"),
@@@ -1822,6 -1806,12 +1826,6 @@@ tyvarid        :: { Located RdrName 
        | 'interruptible'       { L1 $! mkUnqual tvName (fsLit "interruptible") }
        | 'threadsafe'          { L1 $! mkUnqual tvName (fsLit "threadsafe") }
  
 -tyvarsym :: { Located RdrName }
 --- Does not include "!", because that is used for strictness marks
 ---             or ".", because that separates the quantified type vars from the rest
 ---             or "*", because that's used for kinds
 -tyvarsym : VARSYM             { L1 $! mkUnqual tvName (getVARSYM $1) }
 -
  -----------------------------------------------------------------------------
  -- Variables 
  
@@@ -562,16 -562,17 +562,17 @@@ reportOverlap ctxt inst_envs orig pred@
             -- Note [Flattening in error message generation]
  
         ; case lookupInstEnv inst_envs clas tys_flat of
-                 ([], _) -> return (Just pred)               -- No match
+                 ([], _, _) -> return (Just pred)            -- No match
                -- The case of exactly one match and no unifiers means a
                -- successful lookup.  That can't happen here, because dicts
                -- only end up here if they didn't match in Inst.lookupInst
-               ([_],[])
+               ([_],[], _)
                 | debugIsOn -> pprPanic "check_overlap" (ppr pred)
                  res          -> do { addErrorReport ctxt (mk_overlap_msg res)
                                     ; return Nothing } }
    where
-     mk_overlap_msg (matches, unifiers)
+     -- Normal overlap error
+     mk_overlap_msg (matches, unifiers, False)
        = ASSERT( not (null matches) )
          vcat [        addArising orig (ptext (sLit "Overlapping instances for") 
                                <+> pprPredTy pred)
                                     vcat [ ptext (sLit "To pick the first instance above, use -XIncoherentInstances"),
                                          ptext (sLit "when compiling the other instance declarations")]
                                else empty])]
-       where
-       ispecs = [ispec | (ispec, _) <- matches]
-         givens = getUserGivens ctxt
-         overlapping_givens = unifiable_givens givens
-         unifiable_givens [] = [] 
-         unifiable_givens (gg:ggs) 
-           | Just ggdoc <- matchable gg 
-           = ggdoc : unifiable_givens ggs 
-           | otherwise 
-           = unifiable_givens ggs 
-         matchable (evvars,gloc) 
-           = case ev_vars_matching of
-                  [] -> Nothing
-                  _  -> Just $ hang (pprTheta ev_vars_matching)
-                                 2 (sep [ ptext (sLit "bound by") <+> ppr (ctLocOrigin gloc)
-                                        , ptext (sLit "at") <+> ppr (ctLocSpan gloc)])
-             where ev_vars_matching = filter ev_var_matches (map evVarPred evvars)
-                   ev_var_matches (ClassP clas' tys')
-                     | clas' == clas
-                     , Just _ <- tcMatchTys (tyVarsOfTypes tys) tys tys'
-                     = True 
-                   ev_var_matches (ClassP clas' tys') =
-                     any ev_var_matches (immSuperClasses clas' tys')
-                   ev_var_matches _ = False
+         where
+             ispecs = [ispec | (ispec, _) <- matches]
+             givens = getUserGivens ctxt
+             overlapping_givens = unifiable_givens givens
+     
+             unifiable_givens [] = [] 
+             unifiable_givens (gg:ggs) 
+               | Just ggdoc <- matchable gg 
+               = ggdoc : unifiable_givens ggs 
+               | otherwise 
+               = unifiable_givens ggs 
+     
+             matchable (evvars,gloc) 
+               = case ev_vars_matching of
+                      [] -> Nothing
+                      _  -> Just $ hang (pprTheta ev_vars_matching)
+                                     2 (sep [ ptext (sLit "bound by") <+> ppr (ctLocOrigin gloc)
+                                            , ptext (sLit "at") <+> ppr (ctLocSpan gloc)])
+                 where ev_vars_matching = filter ev_var_matches (map evVarPred evvars)
+                       ev_var_matches (ClassP clas' tys')
+                         | clas' == clas
+                         , Just _ <- tcMatchTys (tyVarsOfTypes tys) tys tys'
+                         = True 
+                       ev_var_matches (ClassP clas' tys') =
+                         any ev_var_matches (immSuperClasses clas' tys')
+                       ev_var_matches _ = False
+     -- Overlap error because of SafeHaskell (first match should be the most
+     -- specific match)
+     mk_overlap_msg (matches, _unifiers, True)
+       = ASSERT( length matches > 1 )
+         vcat [ addArising orig (ptext (sLit "Unsafe overlapping instances for") 
+                         <+> pprPredTy pred)
+              , sep [ptext (sLit "The matching instance is") <> colon,
+                     nest 2 (pprInstance $ head ispecs)]
+              , vcat [ ptext $ sLit "It is compiled in a Safe module and as such can only"
+                     , ptext $ sLit "overlap instances from the same module, however it"
+                     , ptext $ sLit "overlaps the following instances from different modules:"
+                     , nest 2 (vcat [pprInstances $ tail ispecs])
+                     ]
+              ]
+         where
+             ispecs = [ispec | (ispec, _) <- matches]
  
  
  reportOverlap _ _ _ _ = panic "reportOverlap"    -- Not a ClassP
@@@ -636,7 -654,6 +654,7 @@@ quickFlattenTy :: TcType -> TcM TcTyp
  -- See Note [Flattening in error message generation]
  quickFlattenTy ty | Just ty' <- tcView ty = quickFlattenTy ty'
  quickFlattenTy ty@(TyVarTy {})  = return ty
 +quickFlattenTy ty@(LiteralTy {})= return ty
  quickFlattenTy ty@(ForAllTy {}) = return ty     -- See
  quickFlattenTy ty@(PredTy {})   = return ty     -- Note [Quick-flatten polytypes]
    -- Don't flatten because of the danger or removing a bound variable
@@@ -45,7 -45,6 +45,7 @@@ module TcSMonad 
  
      getInstEnvs, getFamInstEnvs,                -- Getting the environments
      getTopEnv, getGblEnv, getTcEvBinds, getUntouchables,
 +    tcsLookupClass, tcsLookupTyCon,
      getTcEvBindsBag, getTcSContext, getTcSTyBinds, getTcSTyBindsMap,
  
      newFlattenSkolemTy,                         -- Flatten skolems 
@@@ -86,8 -85,7 +86,8 @@@ import FamInstEn
  import qualified TcRnMonad as TcM
  import qualified TcMType as TcM
  import qualified TcEnv as TcM 
 -       ( checkWellStaged, topIdLvl, tcLookupFamInst, tcGetDefaultTys )
 +       ( checkWellStaged, topIdLvl, tcLookupFamInst, tcGetDefaultTys
 +       , tcLookupClass, tcLookupTyCon )
  import Kind
  import TcType
  import DynFlags
@@@ -760,12 -758,6 +760,12 @@@ getTopEnv = wrapTcS $ TcM.getTopEn
  getGblEnv :: TcS TcGblEnv 
  getGblEnv = wrapTcS $ TcM.getGblEnv 
  
 +tcsLookupClass :: Name -> TcS Class
 +tcsLookupClass name = wrapTcS (TcM.tcLookupClass name)
 +
 +tcsLookupTyCon :: Name -> TcS TyCon
 +tcsLookupTyCon name = wrapTcS (TcM.tcLookupTyCon name)
 +
  -- Various smaller utilities [TODO, maybe will be absorbed in the instance matcher]
  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
@@@ -924,13 -916,13 +924,13 @@@ matchClass clas ty
    = do        { let pred = mkClassPred clas tys 
          ; instEnvs <- getInstEnvs
          ; case lookupInstEnv instEnvs clas tys of {
-             ([], unifs)               -- Nothing matches  
+             ([], unifs, _)               -- Nothing matches  
                  -> do { traceTcS "matchClass not matching"
                                   (vcat [ text "dict" <+> ppr pred, 
                                           text "unifs" <+> ppr unifs ]) 
                        ; return MatchInstNo  
                        } ;  
-           ([(ispec, inst_tys)], []) -- A single match 
+           ([(ispec, inst_tys)], [], _) -- A single match 
                -> do   { let dfun_id = is_dfun ispec
                        ; traceTcS "matchClass success"
                                   (vcat [text "dict" <+> ppr pred, 
                                  -- Record that this dfun is needed
                          ; return $ MatchInstSingle (dfun_id, inst_tys)
                          } ;
-           (matches, unifs)          -- More than one matches 
+           (matches, unifs, _)          -- More than one matches 
                -> do   { traceTcS "matchClass multiple matches, deferring choice"
                                   (vcat [text "dict" <+> ppr pred,
                                          text "matches" <+> ppr matches,
@@@ -970,7 -970,7 +970,7 @@@ lookupClassInstances c t
  
        -- Now look up instances
          ; inst_envs <- tcGetInstEnvs
-         ; let (matches, unifies) = lookupInstEnv inst_envs cls tys
+         ; let (matches, unifies, _) = lookupInstEnv inst_envs cls tys
          ; mapM reifyClassInstance (map fst matches ++ unifies) } } }
    where
      doc = ptext (sLit "TcSplice.classInstances")
@@@ -1214,10 -1214,6 +1214,10 @@@ reifyType (TyConApp tc tys) = reify_tc_
  reifyType (AppTy t1 t2)     = do { [r1,r2] <- reifyTypes [t1,t2] ; return (r1 `TH.AppT` r2) }
  reifyType (FunTy t1 t2)     = do { [r1,r2] <- reifyTypes [t1,t2] ; return (TH.ArrowT `TH.AppT` r1 `TH.AppT` r2) }
  reifyType ty@(PredTy {})    = pprPanic "reifyType PredTy" (ppr ty)
 +reifyType (LiteralTy n)     = do { l <- reifyTyLit n; return (TH.LiteralT l) }
 +
 +reifyTyLit :: TypeRep.TyLit -> TcM TH.TyLit
 +reifyTyLit (NumberTyLit n) = return (TH.NumberTL n)
  
  reify_for_all :: TypeRep.Type -> TcM TH.Type
  reify_for_all ty