diff --git a/Control/Monad.hs b/Control/Monad.hs
index 40f72fc2b7c667959e5533b57176b2c3f1e0f0a3..bf1ab945de3de1cf090862f1637ce6391e526713 100644
--- a/Control/Monad.hs
+++ b/Control/Monad.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 -- |
 -- The "Control.Monad" module provides the 'Functor', 'Monad' and
 -- 'MonadPlus' classes, together with some useful operations on monads.
diff --git a/Data/Array.hs b/Data/Array.hs
index 6bcb356f4f568d542463a2ed0b11839eedca006e..eedf0587f03b9da33891890eae37ecf9540b2d71 100644
--- a/Data/Array.hs
+++ b/Data/Array.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Trustworthy #-}
+#endif
+
 module Data.Array (
     -- * Immutable non-strict arrays
     -- $intro
diff --git a/Data/Bits.hs b/Data/Bits.hs
index 250c42d7bf0b1535580b59ef80944f10e805b8f5..c864e9f25f6d3dbb28e37561294bb8230ee39481 100644
--- a/Data/Bits.hs
+++ b/Data/Bits.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 -- |
 -- This module defines bitwise operations for signed and unsigned
 -- integers.
diff --git a/Data/Char.hs b/Data/Char.hs
index 8c13a996912de032a02e26e59d9a9983c8109b28..f44f68c8a52beecdf9fffb099ee1f9f23b82e54e 100644
--- a/Data/Char.hs
+++ b/Data/Char.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module Data.Char (
     -- * Characters and strings
       Char
diff --git a/Data/Complex.hs b/Data/Complex.hs
index b9676c5f6ef5bc9c22d3db35a40fa8e0f415404b..19473642948576c372eba47ae0a648bc93351a31 100644
--- a/Data/Complex.hs
+++ b/Data/Complex.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module Data.Complex (
         -- * Rectangular form
           Complex((:+))
diff --git a/Data/Int.hs b/Data/Int.hs
index 0f0a310ef3cbdc1eb9550f510f90cd8c2dc9616f..bba330ae8019a0b0144da04cf5460f2fcbd2776d 100644
--- a/Data/Int.hs
+++ b/Data/Int.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module Data.Int (
         -- * Signed integer types
 
diff --git a/Data/Ix.hs b/Data/Ix.hs
index 26fb3c4ed716b06c830d72754c968cc3c3aa73ec..f60c8f7c81e7cbc916b47108cb16afc161b7cbc2 100644
--- a/Data/Ix.hs
+++ b/Data/Ix.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module Data.Ix (
     -- * The 'Ix' class
         Ix
diff --git a/Data/List.hs b/Data/List.hs
index 78f633ff8c7467501f0185b23337bc9d2dfe1125..d7697f18f99f1b6a41aa0c0b0480cb7f3089bcc5 100644
--- a/Data/List.hs
+++ b/Data/List.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module Data.List (
    -- * Basic functions
 
diff --git a/Data/Maybe.hs b/Data/Maybe.hs
index d89b70c53f0c239bd7ead985cf79f3caff0c151a..76a94ce82ff55c749df810fee364dc9e777d544c 100644
--- a/Data/Maybe.hs
+++ b/Data/Maybe.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module Data.Maybe (
    -- * The @Maybe@ type and operations
 
diff --git a/Data/Ratio.hs b/Data/Ratio.hs
index 1d2e027860f0cb8ee5efd16bcfc8d0af388b741d..17337f590a66fe64e08359cb62ddbc4c996d310c 100644
--- a/Data/Ratio.hs
+++ b/Data/Ratio.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module Data.Ratio (
       Ratio
     , Rational
diff --git a/Data/Word.hs b/Data/Word.hs
index 900d85145166c0f2e16da78507bb2cf7c09dc769..5e5da2ee6e8e2464efad03dbd16f08ab77050eff 100644
--- a/Data/Word.hs
+++ b/Data/Word.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module Data.Word (
         -- * Unsigned integral types
 
diff --git a/Foreign/C.hs b/Foreign/C.hs
index 6fb6d9158abf2c4362584681d79e7b6dcdf5d201..b6760daf663f31b4ff6c0eb9015080076a0f5a1e 100644
--- a/Foreign/C.hs
+++ b/Foreign/C.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module Foreign.C (
 
        -- | The module "Foreign.C" combines the interfaces of all
diff --git a/Foreign/C/Error.hs b/Foreign/C/Error.hs
index 0b5540a4a435aafb37090530ceba286aa54691bf..82161672533f7d47b3e334a8b191b25ae39354f6 100644
--- a/Foreign/C/Error.hs
+++ b/Foreign/C/Error.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 -- | The module "Foreign.C.Error" facilitates C-specific error
 -- handling of @errno@.
 module Foreign.C.Error (
diff --git a/Foreign/C/String.hs b/Foreign/C/String.hs
index 021c95bd1115627ec1f8d3799718f7c9bed2cd20..c42b1f3155041560229166c0ce433e8c6f98b8f3 100644
--- a/Foreign/C/String.hs
+++ b/Foreign/C/String.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 -- |
 -- Utilities for primitive marshalling of C strings.
 --
diff --git a/Foreign/C/Types.hs b/Foreign/C/Types.hs
index 7e489adf22d36aebca207b9d32f1c2e3cec12bef..7bfedcb770136f876f001b3730a2bd0df21c7c12 100644
--- a/Foreign/C/Types.hs
+++ b/Foreign/C/Types.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module Foreign.C.Types
         ( -- * Representations of C types
           -- $ctypes
diff --git a/Foreign/Marshal/Alloc.hs b/Foreign/Marshal/Alloc.hs
index 50c43236c382b460b2005b1a92fecc53f00dd725..bd66723ee3033b0ca9aa950594fcabd32a9702d5 100644
--- a/Foreign/Marshal/Alloc.hs
+++ b/Foreign/Marshal/Alloc.hs
@@ -1,3 +1,8 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 {- |
 The module "Foreign.Marshal.Alloc" provides operations to allocate and
 deallocate blocks of raw memory (i.e., unstructured chunks of memory
diff --git a/Foreign/Marshal/Array.hs b/Foreign/Marshal/Array.hs
index a3f643af923ebda2b3a6de88f69b0dbde7c3e6af..ba8335006bd8d61b6814ffac97dffe9518e9ca9e 100644
--- a/Foreign/Marshal/Array.hs
+++ b/Foreign/Marshal/Array.hs
@@ -1,3 +1,8 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 {- |
 The module "Foreign.Marshal.Array" provides operations for marshalling Haskell
 lists into monolithic arrays and vice versa.  Most functions come in two
@@ -61,7 +66,11 @@ module Foreign.Marshal.Array (
   ) where
 import qualified "base" Foreign.Marshal.Array as Base
 import "base" Foreign.Marshal.Array hiding (peekArray)
+#if __GLASGOW_HASKELL__ >= 701
+import "base" Foreign.Safe hiding (peekArray)
+#else
 import "base" Foreign hiding (peekArray)
+#endif
 
 -- |Convert an array of given length into a Haskell list.
 --
diff --git a/Foreign/Marshal/Error.hs b/Foreign/Marshal/Error.hs
index b690c8b71bb5a6f74b97e20ace76b1f8e3d0cd73..3527e816608a23f1f18cd29f27174b8178ad9886 100644
--- a/Foreign/Marshal/Error.hs
+++ b/Foreign/Marshal/Error.hs
@@ -1,3 +1,8 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module Foreign.Marshal.Error (
   throwIf,       -- :: (a -> Bool) -> (a -> String) -> IO a       -> IO a
   throwIf_,      -- :: (a -> Bool) -> (a -> String) -> IO a       -> IO ()
diff --git a/Foreign/Marshal/Utils.hs b/Foreign/Marshal/Utils.hs
index 4a3217fe46508053b63746a945da4c61de2af158..37d8152bbc9146bb21f181ea08f977bd7d68f429 100644
--- a/Foreign/Marshal/Utils.hs
+++ b/Foreign/Marshal/Utils.hs
@@ -1,3 +1,8 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module Foreign.Marshal.Utils (
   -- * General marshalling utilities
 
diff --git a/Foreign/Ptr.hs b/Foreign/Ptr.hs
index 3e1e223ba7ada454a574f73b7843b11b1235a8f9..169015f55f459be54c99c35dc32414cec4355176 100644
--- a/Foreign/Ptr.hs
+++ b/Foreign/Ptr.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 -- | The module "Foreign.Ptr" provides typed pointers to foreign
 -- entities.  We distinguish two kinds of pointers: pointers to data
 -- and pointers to functions.  It is understood that these two kinds
diff --git a/Foreign/StablePtr.hs b/Foreign/StablePtr.hs
index 5fae4b57db2bcc90ac2e1703c4bd60fd72f80397..e62467aa6d74b3a719f82f0bde2e4242d99a54bf 100644
--- a/Foreign/StablePtr.hs
+++ b/Foreign/StablePtr.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module Foreign.StablePtr
         ( -- * Stable references to Haskell values
           StablePtr          -- abstract
diff --git a/Foreign/Storable.hs b/Foreign/Storable.hs
index 2c8823787e48e8d2c11feda9f84889a6840730d0..b57e2230ee430be06608719d9d894a07ac776218 100644
--- a/Foreign/Storable.hs
+++ b/Foreign/Storable.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module Foreign.Storable
         ( Storable(
              sizeOf,         -- :: a -> Int
diff --git a/Numeric.hs b/Numeric.hs
index bb0d97d41568dfa5ab0fd36b295eb972a9f6aff5..28621cd0ed026ca5f7b619ed6f46be854b4db8e6 100644
--- a/Numeric.hs
+++ b/Numeric.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module Numeric (
 
         -- * Showing
diff --git a/Prelude.hs b/Prelude.hs
index 72e53d24f3145efed12bf3d90b93e62fbdd08524..1573a9eb0a47225051120487968fd08dd3122796 100644
--- a/Prelude.hs
+++ b/Prelude.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Trustworthy #-}
+#endif
+
 {-# LANGUAGE NoImplicitPrelude, BangPatterns #-}
 -- |
 -- The Haskell 2010 Prelude: a standard module imported by default
diff --git a/System/Environment.hs b/System/Environment.hs
index 43bfe99508a4962f88b6b0d79e1d75b638c421e5..ffd12ee491bd8657e9a1a8c52a2ac4b5306a217f 100644
--- a/System/Environment.hs
+++ b/System/Environment.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module System.Environment (
       getArgs,       -- :: IO [String]
       getProgName,   -- :: IO String
diff --git a/System/Exit.hs b/System/Exit.hs
index 0b0be5b57e651d8a263fde978f022bf9489d2375..83a5c3690035ab5268b17b0b6a68e29ff05c6f13 100644
--- a/System/Exit.hs
+++ b/System/Exit.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module System.Exit (
       ExitCode(ExitSuccess,ExitFailure)
     , exitWith      -- :: ExitCode -> IO a
diff --git a/System/IO.hs b/System/IO.hs
index 2a8b0c771a01c38c0b951630e5faf41623d93972..a1a8fcc5f7db9b9b25aa7bc3a88ebce6671f9ef8 100644
--- a/System/IO.hs
+++ b/System/IO.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 module System.IO (
     -- * The IO monad
 
diff --git a/System/IO/Error.hs b/System/IO/Error.hs
index 6683e9f3edf56039885436adeaa3e56b409a9393..aedef5d578d74c9df37e292aaf76f5a0a841c155 100644
--- a/System/IO/Error.hs
+++ b/System/IO/Error.hs
@@ -1,3 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
 {-# OPTIONS_GHC -fno-warn-unused-imports #-}
 -- apparent bug in GHC, reports a bogus warning for the Prelude import below
 module System.IO.Error (